00001 ! ----------------- PRISM module file psmile_common.F90 --------------- 00002 ! 00003 ! $Id: psmile_common.F90 3246 2011-06-23 12:43:21Z coquart $ 00004 ! $Author: coquart $ 00005 ! 00006 !----------------------------------------------------------------------- 00007 ! Copyright 2006-2010, CERFACS, Toulouse, France. 00008 ! Copyright 2006-2010, SGI Germany, Munich, Germany. 00009 ! Copyright 2006-2010, NEC Europe Ltd., London, UK. 00010 ! All rights reserved. Use is subject to OASIS4 license terms. 00011 !----------------------------------------------------------------------- 00012 !BOP 00013 ! 00014 ! !MODULE: psmile_common 00015 ! 00016 Module psmile_common 00017 00018 #ifdef NAG_COMPILER 00019 use mpi 00020 #endif 00021 ! 00022 implicit none 00023 ! 00024 ! !USES: 00025 ! 00026 ! MPI include file 00027 ! 00028 #ifndef NAG_COMPILER 00029 #include <mpif.h> 00030 #endif 00031 ! 00032 ! PSMILe internal named parameters 00033 #include "psmile.inc" 00034 ! 00035 ! !DESCRIPTION: 00036 ! 00037 ! Some derived types, global variables used by both PSMILe and 00038 ! driver routines. 00039 ! 00040 ! !REVISION HISTORY: 00041 ! 00042 ! Date Programmer Description 00043 ! ---------- ---------- ----------- 00044 ! 01.12.05 J. Ghattas Extracted part from psmile.F90 00045 ! 00046 !EOP 00047 ! 00048 !======================================================================= 00049 ! Type definitions 00050 !======================================================================= 00051 ! 00052 ! The definitions of derived types 00053 ! integer_vector, real_vector, dble_vector, quad_vector 00054 ! are required/used to define vectors of pointers. 00055 ! 00056 Type integer_vector 00057 Integer, Pointer :: vector (:) 00058 End Type integer_vector 00059 00060 Type logical_vector 00061 Logical, Pointer :: vector (:) 00062 End Type logical_vector 00063 00064 Type real_vector 00065 Real, Pointer :: vector (:) 00066 End Type real_vector 00067 00068 Type dble_vector 00069 Double Precision, Pointer :: vector (:) 00070 End Type dble_vector 00071 00072 #if defined ( PRISM_QUAD_TYPE ) 00073 Type quad_vector 00074 Real (kind=PRISM_QUAD_TYPE), Pointer :: vector (:) 00075 End Type quad_vector 00076 #endif 00077 00078 Type integer_vector_2d 00079 Integer, Pointer :: vector (:,:) 00080 End Type integer_vector_2d 00081 00082 Type logical_vector_2d 00083 Logical, Pointer :: vector (:,:) 00084 End Type logical_vector_2d 00085 00086 Type real_vector_2d 00087 Real, Pointer :: vector (:,:) 00088 End Type real_vector_2d 00089 00090 Type dble_vector_2d 00091 Double Precision, Pointer :: vector (:,:) 00092 End Type dble_vector_2d 00093 00094 #if defined ( PRISM_QUAD_TYPE ) 00095 Type quad_vector_2d 00096 Real (kind=PRISM_QUAD_TYPE), Pointer :: vector (:,:) 00097 End Type quad_vector_2d 00098 #endif 00099 00100 Type integer_vector_3d 00101 Integer, Pointer :: vector (:,:,:) 00102 End Type integer_vector_3d 00103 00104 Type logical_vector_3d 00105 Logical, Pointer :: vector (:,:,:) 00106 End Type logical_vector_3d 00107 00108 Type real_vector_3d 00109 Real, Pointer :: vector (:,:,:) 00110 End Type real_vector_3d 00111 00112 Type dble_vector_3d 00113 Double Precision, Pointer :: vector (:,:,:) 00114 End Type dble_vector_3d 00115 00116 #if defined ( PRISM_QUAD_TYPE ) 00117 Type quad_vector_3d 00118 Real (kind=PRISM_QUAD_TYPE), Pointer :: vector (:,:,:) 00119 End Type quad_vector_3d 00120 #endif 00121 00122 ! ======================================================================= 00123 ! 00124 ! Derived type enddef_msg_intersections 00125 ! 00126 ! "enddef_msg_intersections" contains information gathered by 00127 ! psmile_find_intersect on intersections. It is exchanged by converting 00128 ! it to a sendable integer array using the routines 00129 ! psmile_pack_msg_intersections and psmile_unpack_msg_intersections. 00130 ! 00131 ! remark: this type definition should be in module psmile, however F90 00132 ! does not know "import", therefore it cannot be there... 00133 ! 00134 00135 ! remask: prefixes src (source) and tgt (target) refer to 00136 ! the direction of the associated transients not 00137 ! to sender or receiver of a message 00138 00139 type enddef_intersection_info 00140 integer :: src_all_extents_grid_id, 00141 tgt_all_extents_grid_id, 00142 intersection (2, ndim_3d) 00143 end type enddef_intersection_info 00144 00145 type enddef_field_info 00146 integer :: tgt_method_id, 00147 tgt_var_id, 00148 tgt_mask_id, 00149 transient_in_id, ! global_transi_id (id_trans_in, located in target process) 00150 transient_out_id, ! remote_transi_id (id_trans_out, located in source process) 00151 requires_conserv_remap ! conservative remapping required yes(1)/no(0) 00152 end type enddef_field_info 00153 00154 type enddef_msg_intersections 00155 integer :: src_comp_id, 00156 tgt_comp_id, 00157 src_grid_id, 00158 tgt_grid_id, 00159 first_src_all_extents_grid_id, 00160 first_tgt_all_extents_grid_id, 00161 method_type, 00162 method_datatype, 00163 all_comp_infos_comp_idx, 00164 num_vars, 00165 num_parts, 00166 relative_msg_tag 00167 type (enddef_field_info) :: field_info 00168 type (enddef_intersection_info), pointer :: intersections(:) 00169 end type enddef_msg_intersections 00170 00171 ! ======================================================================= 00172 ! 00173 ! Derived type enddef_msg_locations 00174 ! 00175 ! "enddef_msg_locations" contains the basic information the target 00176 ! requires to receive the results of the local/global search on the 00177 ! source processes 00178 ! 00179 ! remark: this type definition should be in module psmile, however F90 00180 ! does not know "import", therefore it cannot be there... 00181 ! 00182 00183 type enddef_msg_locations 00184 00185 integer :: requires_conserv_remap 00186 00187 ! data for results of conservative remapping 00188 integer :: msg_len, 00189 transi_out_id, 00190 src_rank 00191 00192 ! shared data 00193 integer :: transi_in_id 00194 00195 ! data for point based search 00196 integer :: tgt_method_id, 00197 tgt_var_id, 00198 relative_msg_tag, 00199 num_locs_coupler, 00200 num_locs_direct, 00201 further_msg_flag, 00202 epio_id, 00203 trs_rank, 00204 num_points_direct, 00205 num_areas_direct 00206 00207 end type enddef_msg_locations 00208 00209 ! ======================================================================= 00210 ! 00211 ! Derived type enddef_msg_extra 00212 ! TODO: => move to psmile.inc 00213 ! 00214 ! "enddef_msg_extra" contains the basic information for a source to 00215 ! receive data from other sources of points that require extra search 00216 ! (global search) 00217 ! 00218 ! remark: this type definition should be in module psmile, however F90 00219 ! does not know "import", therefore it cannot be there... 00220 ! 00221 00222 type enddef_msg_extra 00223 00224 ! general data 00225 integer :: reqest_type, !PSMILe_Finalize_extra_search, PSMILE_Trilinear, PSMILe_nnghbr3D, ... 00226 datatype, 00227 len_int_data, ! Length of buffer "ibuf" containing the integer data. 00228 len_coord_data, ! Length of buffer "buf" containing the real/double precision data. 00229 global_comp_id, 00230 transi_out_id, 00231 num_volumes, ! Number of control volumes sent 00232 num_int_per_vol, ! Number of integer data items per control volume sent 00233 num_items_per_coord 00234 00235 ! partition data 00236 logical :: partition_avail ! Is data on global offset available ? 00237 integer :: partition(ndim_3d) ! IJK-Index of global offset (partition) 00238 00239 ! data for global search 00240 integer :: num_neigh, ! num_neigh (Number of interpolation bases) 00241 local_grid_id, ! local grid id on destination process 00242 idx_req ! Number of the request 00243 00244 end type enddef_msg_extra 00245 00246 ! ======================================================================= 00247 ! 00248 ! Derived type Enddef_action 00249 ! 00250 ! "Enddef_action" is a structure internally used by PRISM_Enddef in order 00251 ! to store the information on open requests to be fulfilled in 00252 ! "psmile_get_intersect". 00253 ! 00254 ! msgint = Receive buffer for messages on intersections 00255 ! msg_received_inter = unpacked msgint buffer 00256 ! msgreq = Receive buffer for requests for grid coordinates 00257 ! msg_requested_inter = unpacked msgreq buffer 00258 ! msg_extra = Receive buffer for extra requests 00259 ! msg_sel = Receive buffer for answers on selected (nearest neighbour points) 00260 ! 00261 ! nreq = Number of requests 00262 ! 00263 ! n_answer = Number of answers containing requests for grid data received. 00264 ! If no grid data was required, the receiving process doesn't 00265 ! send an answer. This are "nnull" messages. 00266 ! n_answer2recv = Number of answers to be received. 00267 ! 00268 ! n_selected = Number of outstanding receives for messages 00269 ! on selected nearest neighbour points. 00270 ! 00271 ! n_fin = Number of finalize messages received for global search. 00272 ! n_fin2recv = Number of finalize messages to be received. 00273 ! 00274 ! n = Number of intersections received. 00275 ! ninter = Number of intersections to be received. 00276 ! lastag = Tag for receive of interactions 00277 ! intersect_ranks = contains the ranks of all processes which will send 00278 ! an intersection message to the local one 00279 ! 00280 ! nloc_recv = Number of processes which have sent the locations for 00281 ! all grid functions (fields). 00282 ! 00283 ! lrequest = MPI requests for open requests to be fulfilled 00284 ! lrequest (1) = reqtag : Request to send grid data 00285 ! lrequest (2) = lastag : Receive data on grid intersection 00286 ! lrequest (3) = grdtag : Receive grid data 00287 ! lrequest (4) = exttag : Extra request to search data 00288 ! lrequest (5) = seltag : Request to receive info on seleted points 00289 ! of nearest neighbour search 00290 ! lrequest (ndreq+1:nreq) = loctag+: Receive data on locations found 00291 ! 00292 ! recv_req = MPI request for next receive of grid data 00293 ! grid2receive = Have grid coordinations to be received ? 00294 ! 00295 00296 Type Enddef_action 00297 Integer, Pointer :: lrequest (:) 00298 Integer, Pointer :: recv_req (:) 00299 Integer, Pointer :: loc_messages (:, :) 00300 Integer :: msgint (nd_msgint) 00301 Integer :: msgreq (nd_msgint) 00302 Integer :: msg_extra (msg_extra_size) 00303 Integer :: msg_sel (nd_msgsel) 00304 00305 Integer :: nreq 00306 ! 00307 Integer :: n 00308 Integer :: ninter 00309 Integer :: lastag 00310 #define CONS_REMAP_DEADLOCK_WORKAROUND 00311 #ifdef CONS_REMAP_DEADLOCK_WORKAROUND 00312 Integer, Pointer :: intersect_ranks(:) 00313 #endif 00314 ! 00315 Integer :: nmyint 00316 Integer :: n_answer 00317 Integer :: n_answer2recv 00318 Integer, Pointer :: n_answer2recv_per_grid(:) 00319 Integer :: n_fin 00320 Integer :: n_fin2recv 00321 Integer :: nloc_recv 00322 Integer :: n_selected 00323 Logical :: grid2receive 00324 00325 End Type Enddef_action 00326 00327 ! ======================================================================= 00328 ! 00329 ! Derived type Enddef_mg 00330 ! ---------------------- 00331 ! 00332 ! Enddef_mg is a structure internally used by PRISM_Enddef in order 00333 ! to store the information on multigrid levels created. 00334 ! 00335 ! levdim = Dimension of the grid level 00336 ! The dimensions of full arrays are (0:levdim(1), 0:levdim(2), 00337 ! 0:levdim(3)) 00338 ! 00339 ! Derived type Enddef_search 00340 ! -------------------------- 00341 ! 00342 ! Enddef_search is a structure which is internally used by PRISM_enddef 00343 ! in order to store the information on the coordinates to be searched. 00344 ! 00345 ! method_type = Method type of the coordinates (to be searched) 00346 ! in the target (sending) process. 00347 ! grid_type = Grid type of coordinates in the target process. 00348 ! datatype = MPI Datatype of coordinates sent and to be searched. 00349 ! 00350 ! range = Ranges (sub-blocks) of the coordinates in indices of target process. 00351 ! Dimension: range (2, ndim_3d, npart) 00352 ! shape = Dimensions of the coordinates in indices of target process. 00353 ! currently equal to range since the data is sent 00354 ! Dimension: shape (2, ndim_3d, npart) 00355 ! dim_size = size of coordinate vectors for each dimension to be searched 00356 ! Dimension: dim_size (ndim_3d, npart) 00357 ! 00358 ! sender = Id of sending process in communicator "comm_psmile" 00359 ! msgint = Integer vector containing the request sent for the search 00360 ! of "npart" intersections. 00361 ! (cf. msgint in psmile.inc) 00362 ! 00363 ! search_real = 00364 ! search_dble = 00365 ! search_quad = Pointers to the coordinates to be searched. 00366 ! Dimension: search_real (ndim_3d, npart) 00367 ! 00368 ! search_mask = Mask points 00369 ! Dimension: search_mask (npart) 00370 ! 00371 ! Derived type Enddef_global_search 00372 ! --------------------------------- 00373 ! 00374 ! Enddef_global_search is a structure which is internally used by PRISM_enddef 00375 ! in order to store information on data and locations 00376 ! which are additionally searched in entire domain of the application. 00377 ! 00378 ! n_liste = Number of points in list "neigh_3d" 00379 ! neigh_3d = Indices of locations to be sent to destination process 00380 ! which are required for the interpolation by the coupler. 00381 ! Dimension: neigh_3d (ndim_3d, 1:n_liste) 00382 ! 00383 ! n_found = Total number of points found (may be multiple counted) 00384 ! index_found = Indices in "neigh_3d" of points found. 00385 ! The sequence in "index_found" corresponds to the 00386 ! significant code in "ibuf(5,1:n_send)" 00387 ! (cf. PSMILe_Trili_3d_extra_off). 00388 ! Dimension: index_found (1:n_found) 00389 ! 00390 ! 00391 Type Enddef_mg_real 00392 00393 Type (real_vector) :: chmin (ndim_3d) 00394 Type (real_vector) :: chmax (ndim_3d) 00395 Type (real_vector) :: midp (ndim_3d) 00396 00397 End Type Enddef_mg_real 00398 00399 Type Enddef_mg_double 00400 00401 Type (dble_vector) :: chmin (ndim_3d) 00402 Type (dble_vector) :: chmax (ndim_3d) 00403 Type (dble_vector) :: midp (ndim_3d) 00404 00405 End Type Enddef_mg_double 00406 00407 Type Enddef_mg 00408 Integer :: levdim (ndim_3d) 00409 00410 Type(Enddef_mg_real), Pointer :: real_arrays 00411 Type(Enddef_mg_double), Pointer :: double_arrays 00412 #if defined ( PRISM_QUAD_TYPE ) 00413 Type(Enddef_mg_quad), Pointer :: quad_arrays 00414 #endif 00415 End Type Enddef_mg 00416 00417 Type Enddef_search_data 00418 Type (real_vector), Pointer :: search_real (:, :) 00419 Type (dble_vector), Pointer :: search_dble (:, :) 00420 #if defined ( PRISM_QUAD_TYPE ) 00421 Type (quad_vector), Pointer :: search_quad (:, :) 00422 #endif 00423 Integer, Pointer :: dim_size (:, :) 00424 00425 Integer :: grid_type 00426 Integer :: datatype 00427 Integer, Pointer :: range (:, :, :) 00428 Integer, Pointer :: shape (:, :, :) 00429 00430 Integer :: npart 00431 End Type Enddef_search_data 00432 00433 Type Enddef_search 00434 Integer :: method_type 00435 00436 Integer, Pointer :: msgint (:) 00437 Type (enddef_msg_intersections) :: msg_intersections 00438 Integer :: len_msg 00439 Integer :: sender 00440 Integer, Pointer :: boundary_cell (:, :) 00441 00442 Type (Enddef_search_data) :: search_data 00443 00444 Type (logical_vector), Pointer :: search_mask (:) 00445 Type (integer_vector), Pointer :: global_index(:) 00446 00447 End Type Enddef_search 00448 00449 Type Enddef_global_search 00450 Type (enddef_msg_extra) :: msg_extra 00451 00452 Integer, Pointer :: ibuf (:) 00453 Real, Pointer :: rbuf (:) 00454 Double Precision, Pointer :: dbuf (:) 00455 #if defined ( PRISM_QUAD_TYPE ) 00456 Real (kind=PRISM_QUAD_TYPE), Pointer :: qbuf (:) 00457 #endif 00458 00459 Integer, Pointer :: neigh_3d (:, :) 00460 Integer, Pointer :: index_found (:) 00461 00462 Integer :: sender 00463 Integer :: n_liste, n_found 00464 End Type Enddef_global_search 00465 00466 ! ======================================================================= 00467 ! 00468 ! Derived type Enddef_comp 00469 ! 00470 ! Enddef_comp is a structure internally used by PRISM_Enddef in order 00471 ! to store the information on components. 00472 ! 00473 ! Number_of_Grids_vector : Number of Grids to be coupled 00474 ! per process of component communicator. 00475 ! (sequence corresponds to the ranks) 00476 ! psmile_ranks : Ranks in communicator "comm_psmile". 00477 ! 00478 ! all_extents : Extents of all grids collected 00479 ! (sequence corresponds to the ranks) 00480 ! Dimension : all_extents (2, ndim_3d, 1:n_total) 00481 ! with ntotal = SUM(Number_of_Grids_Vector) 00482 ! all_extent_infos : Info's on the extents with 00483 ! all_extent_infos (1, :) = Local grid id (= extent id) 00484 ! all_extent_infos (2, :) = grid type 00485 ! all_extent_infos (3, :) = Transformation code 00486 ! all_extent_infos (4, :) = Global grid id 00487 ! Dimension : all_extent_infos (nd_extent_infos, 00488 ! 1:n_total) 00489 ! 00490 ! global_comp_id : Global component id 00491 ! comp_id : Local component id 00492 ! size : Number of processes within the component 00493 ! communicator 00494 ! 00495 Type Enddef_extent_info 00496 Integer :: local_grid_id, ! local grid id on respective process 00497 global_grid_id, 00498 grid_type, 00499 tr_code ! code which allows to transform coordinates 00500 ! associated to this extent to be transformed 00501 ! into the common grid space 00502 ! (see psmile_transform_extent.F90) 00503 00504 Real (PSMILe_float_kind) :: extent (2, ndim_3d) 00505 End Type Enddef_extent_info 00506 00507 Type Enddef_comp 00508 00509 Integer, Pointer :: Number_of_Grids_vector (:) 00510 Integer, Pointer :: psmile_ranks (:) 00511 Type (Enddef_extent_info), Pointer :: all_extent_infos (:) 00512 00513 Integer :: global_comp_id 00514 Integer :: comp_id 00515 Integer :: size 00516 00517 End Type Enddef_comp 00518 00519 ! ======================================================================= 00520 ! 00521 ! Derived type Extra_search_info 00522 ! 00523 ! Extra_search_info is a structure internally used by PRISM_Enddef 00524 ! in order to store the information on locations which require additional 00525 ! search. 00526 ! 00527 ! global_search = Is global search required ? 00528 ! 00529 ! n_extra = Total number of locations which require additional search. 00530 ! len_extra = Number of locations which require additional search 00531 ! per partition. 00532 ! Dimension : len_extra (npart) 00533 ! indices = Indices of the extra points in entire list of all points to be 00534 ! searched (i.e. for all parts "ipart") 00535 ! (cf. routine PSMILE_Neigh_extra_points) 00536 ! Dimension : indices (npart) 00537 ! 00538 ! dist_dble = Distance for nearest neighbour search (only used if 00539 ! global search is required). 00540 ! The storage sequence corresponds to "indices". 00541 ! Dimension : dist_dble (n_extra, num_neigh) 00542 ! (contains the distance from the n_extra points to the num_neigh 00543 ! nearest neighbours in the local ?partition/block? in km) 00544 ! cos_search_dble = Transformed cos values of extra points to be searched 00545 ! by nearest neighbour search. 00546 ! Dimension : cos_search_dble (n_extra, lat) 00547 ! sin_search_dble = Transformed sin values of extra points to be searched 00548 ! by nearest neighbour search. 00549 ! Dimension : sin_search_dble (n_extra, lat) 00550 ! z_search_dble = Transformed z values of extra points to be searched 00551 ! by nearest neighbour search. 00552 ! Dimension : z_search_dble (n_extra) 00553 ! 00554 ! dist_real = Distance for nearest neighbour search (only used if 00555 ! global search is required). 00556 ! The storage sequence corresponds to "indices". 00557 ! Dimension : dist_real (n_extra, num_neigh) 00558 ! cos_search_real = Transformed cos values of extra points to be searched 00559 ! by nearest neighbour search. 00560 ! Dimension : cos_search_real (n_extra, lat) 00561 ! sin_search_real = Transformed sin values of extra points to be searched 00562 ! by nearest neighbour search. 00563 ! Dimension : sin_search_real (n_extra, lat) 00564 ! z_search_real = Transformed z values of extra points to be searched 00565 ! by nearest neighbour search. 00566 ! Dimension : z_search_real (n_extra) 00567 ! 00568 ! n_req = Total number of locations which require global search. 00569 ! len_req = Number of points which require global search. 00570 ! indices_req = Indices of points which require global search. 00571 ! required = Code for the extra points which are additionally required. 00572 ! 00573 ! dble_bufs = Pointer to receive buffers containing the coordinate data 00574 ! sent from coinciding process of global search. 00575 ! Dimension: dble_bufs (nrecv) 00576 ! real_bufs = Pointer to receive buffers containing the coordinate data 00577 ! sent from coinciding process of global search. 00578 ! Dimension: real_bufs (nrecv) 00579 ! 00580 ! global_maker = Is used for marking/identifying points/cells which are 00581 ! found by global search 00582 ! 00583 ! TODO: Indices pro partition abspeichern ! 00584 ! Wert der Indices in local zu srclocs machen 00585 ! 00586 00587 Type Extra_search_info 00588 Integer :: nrecv 00589 Integer, Pointer :: len_extra (:) 00590 Integer, Pointer :: len_req (:) 00591 00592 Integer, Pointer :: indices (:) 00593 ! 00594 Type (integer_vector), Pointer :: indices_req (:) 00595 Type (integer_vector), Pointer :: required (:) 00596 ! 00597 Type (logical_vector), Pointer :: log_bufs (:) 00598 Type (dble_vector), Pointer :: dble_bufs (:) 00599 Type (real_vector), Pointer :: real_bufs (:) 00600 #if defined ( PRISM_QUAD_TYPE ) 00601 Type (quad_vector), Pointer :: quad_bufs (:) 00602 #endif 00603 ! 00604 Double Precision, Pointer :: dist_dble (:, :) 00605 Double Precision, Pointer :: cos_search_dble (:, :) 00606 Double Precision, Pointer :: sin_search_dble (:, :) 00607 Double Precision, Pointer :: z_search_dble (:) 00608 ! 00609 Real, Pointer :: dist_real (:, :) 00610 Real, Pointer :: cos_search_real (:, :) 00611 Real, Pointer :: sin_search_real (:, :) 00612 Real, Pointer :: z_search_real (:) 00613 ! 00614 #if defined ( PRISM_QUAD_TYPE ) 00615 Real (kind=PRISM_QUAD_TYPE), Pointer :: dist_quad (:) 00616 Real (kind=PRISM_QUAD_TYPE), Pointer :: cos_search_quad (:, :) 00617 Real (kind=PRISM_QUAD_TYPE), Pointer :: sin_search_quad (:, :) 00618 Real (kind=PRISM_QUAD_TYPE), Pointer :: z_search_quad (:, :) 00619 #endif 00620 ! 00621 Integer :: n_extra, n_req 00622 Logical :: global_search 00623 Integer :: global_marker 00624 End Type Extra_search_info 00625 00626 Type Select_search_info 00627 Integer, Pointer :: used (:) 00628 Double Precision, Pointer :: dble_buf (:) 00629 Real, Pointer :: real_buf (:) 00630 #if defined ( PRISM_QUAD_TYPE ) 00631 Real (kind=PRISM_QUAD_TYPE), Pointer :: quad_buf (:) 00632 #endif 00633 Integer :: n_liste 00634 Integer :: sender 00635 Integer :: index 00636 Integer :: method_id 00637 00638 Integer :: num_req 00639 00640 Integer :: msg_id 00641 End Type Select_search_info 00642 00643 ! ======================================================================= 00644 ! 00645 ! Derived type Split_Information 00646 ! 00647 ! n_split = Number of methods cells to be split 00648 ! indices = Indices (i,j,k) of n_split method cells to be split 00649 ! 00650 Type Split_Information 00651 Integer :: n_split 00652 00653 Integer, Pointer :: indices (:, :) 00654 End Type Split_Information 00655 00656 ! ======================================================================= 00657 ! 00658 ! Derived type Extra_search_nn 00659 ! 00660 ! Extra_search_nn is a structure internally used by psmile_mg_searh_nneigh_* 00661 ! in order to store the information on locations which require additional 00662 ! search. We start at the 3rd coarsest level. 00663 ! 00664 ! location : control volume index on the 3rd coarsest level 00665 ! that is selected for further search 00666 ! leni, lenj, lenk : lenghts of arrays on the 3rd coarsest level 00667 ! sin/cos_ccorner_lon/lat : cos and sin of corners on the 3rd coarsest level 00668 ! sin/cos_cmidp_lon/lat : cos and sin of mid points on the rd coarsest level 00669 ! sin/cos_fmidp_lon/lat : cos and sin of mid points on the finest level 00670 00671 Type Extra_search_real 00672 00673 Type (real_vector) :: sin_ccorner_lon(8) 00674 Type (real_vector) :: sin_ccorner_lat(8) 00675 Type (real_vector) :: cos_ccorner_lon(8) 00676 Type (real_vector) :: cos_ccorner_lat(8) 00677 00678 Type (real_vector) :: sin_cmidp_lon 00679 Type (real_vector) :: sin_cmidp_lat 00680 Type (real_vector) :: cos_cmidp_lon 00681 Type (real_vector) :: cos_cmidp_lat 00682 00683 Type (real_vector) :: sin_fmidp_lon 00684 Type (real_vector) :: sin_fmidp_lat 00685 Type (real_vector) :: cos_fmidp_lon 00686 Type (real_vector) :: cos_fmidp_lat 00687 00688 Real, Pointer :: radius(:) 00689 00690 End Type Extra_search_real 00691 00692 Type Extra_search_dble 00693 00694 Type (dble_vector) :: sin_ccorner_lon(8) 00695 Type (dble_vector) :: sin_ccorner_lat(8) 00696 Type (dble_vector) :: cos_ccorner_lon(8) 00697 Type (dble_vector) :: cos_ccorner_lat(8) 00698 00699 Type (dble_vector) :: sin_cmidp_lon 00700 Type (dble_vector) :: sin_cmidp_lat 00701 Type (dble_vector) :: cos_cmidp_lon 00702 Type (dble_vector) :: cos_cmidp_lat 00703 00704 Type (dble_vector) :: sin_fmidp_lon 00705 Type (dble_vector) :: sin_fmidp_lat 00706 Type (dble_vector) :: cos_fmidp_lon 00707 Type (dble_vector) :: cos_fmidp_lat 00708 00709 Real (PSMILe_float_kind), Pointer :: radius(:) 00710 00711 End Type Extra_search_dble 00712 00713 Type Extra_search_nn 00714 00715 Integer :: leni 00716 Integer :: lenj 00717 Integer :: lenk 00718 Integer :: location 00719 00720 End Type Extra_search_nn 00721 00722 ! ======================================================================= 00723 ! 00724 ! Send_information and Recv_information are strcutures containing data for 00725 ! exchange of variables located on the method/grid. 00726 ! 00727 ! ??? Die wahl des Communicators muss man sich noch mal ueberlegen 00728 ! 00729 ! Derived type Send_information 00730 ! 00731 ! dest = Rank of destination process. 00732 ! Direct send: rank in communicator "comm_psmile" 00733 ! Coupler send: rank in communicator "comm_coupler" 00734 ! 00735 ! remote_method_id = (Local) Method id in the destination process "dest" 00736 ! 00737 ! epio_id = Id of EPIO returned by the transformer 00738 ! (only significant for transfer to/from transformer) 00739 ! 00740 ! nloc = Total number of locations to be sent. 00741 ! nparts = Number of partitions to be sent. 00742 ! nars = Number of clustered areas to be sent. 00743 ! Dimension: nars (1:nvec, 1:nparts) 00744 ! npoints = Number of points to be sent. 00745 ! Dimension: npoints (1:nvec, 1:nparts) 00746 ! nvec = Number of pointers generated in pointer vectors 00747 ! "srcars" and "srclocs". 00748 ! = Number of entries in "npoints" and "nars" 00749 ! 00750 ! srcars = Clustered areas of 00751 ! source locations (indices in range of source block 00752 ! Dimension : srcars (2, 3, n3dar) 00753 ! srclocs = Source locations (indices in range of source block) 00754 ! which have to be sent. 00755 ! The number of entries depends on the method type of 00756 ! method "method_id". 00757 ! ?! Immer als 3d vectoren abspeichern wie dstijk ?! 00758 ! dstijk = Locations (indices in range of destination block) 00759 ! where the transferred values have to be stored. 00760 ! Dimension: dstijk (ndim_3d, nloc) 00761 ! virtual = Info's whether the point searched was found in a 00762 ! virtual (code of location in virtual cell). 00763 ! Currently only used for GaussReduced Grids. 00764 ! dstars = Clustered areas of 00765 ! destination locations (indices in range of destination block 00766 ! Dimension : dstars (2, 3, n3dar) 00767 00768 ! 00769 ! Derived type Recv_information 00770 ! 00771 ! source = Rank of source process. 00772 ! Direct receive: rank in communicator "comm_psmile" 00773 ! Coupler receive: rank in communicator "comm_coupler" 00774 ! nloc = Total number of locations to be received. 00775 ! 00776 ! dstijk = Locations (indices in range of destination block) 00777 ! where the transferred values have to be stored. 00778 ! Dimension: dstijk (ndim_3d, nloc) 00779 ! 00780 ! For sends to the coupler process: 00781 ! 00782 ! send_entire_valid_shape = Can the entire valid shape be transferred 00783 ! to the coupler process. 00784 ! = .true. : Yes; in this case, list_entries are not generated 00785 ! = .false.: No; list entries are generated. 00786 ! list_entries = Translation from 1d-index in compact list into 00787 ! 3-dimensional index within the valid shape of the block 00788 ! (grid_valid_shape). 00789 ! Dimension: list_entries (n_list-num2recv) 00790 ! n_list = Number of entries to be transferred for interpolation 00791 ! base to the coupler process. 00792 ! 00793 ! nrecv = Number of messages to be received 00794 ! (from coinciding processes of the same application) 00795 ! before data can be transferred to the coupler. 00796 ! These receives are required by the global search. 00797 ! num2recv = Total number of data items to be received 00798 ! (from coinciding processes of the same application) 00799 ! before data can be transferred to the coupler. 00800 ! These data items are required by the global search. 00801 ! = SUM (len_sent(1:nrecv)) 00802 ! len_sent = Number of data items sent 00803 ! by coinciding process of global search. 00804 ! = Size of corresponding "dble_bufs" or "real_bufs" vector. 00805 ! Dimension: len_sent (nrecv) 00806 ! sender_global = Rank of the sender in communicator "comm_psmile" 00807 ! which sends the data found in global search. 00808 ! Dimension: sender_global (nrecv) 00809 ! msg_id = This ID is provided by sender_global in order to 00810 ! identify the respective message. 00811 ! 00812 ! Derived type Send_field_information 00813 ! 00814 ! trans_out_id = Id of transient for communication with transformer 00815 ! (only significant for transfer to/from transformer) 00816 ! send_info_index = Index in send_infos_direct (:) or send_infos_coupler 00817 ! containing the data for the send to the application 00818 ! process or transformer. 00819 ! 00820 ! Derived type Recv_field_information 00821 ! 00822 ! trans_in_id = Id of transient for communication with transformer 00823 ! send_info_index = Index in recv_infos_direct (:) or recv_infos_coupler 00824 ! containing the data for the receive from the application 00825 ! process or transformer. 00826 ! nar = Number of clustered areas 00827 ! dstars = Clustered areas 00828 ! Dimension: (2, ndim_3d, nar) 00829 ! 00830 ! 00831 Type Send_information 00832 Integer :: dest 00833 Integer :: remote_method_id 00834 Integer :: epio_id 00835 Integer :: trs_rank 00836 Integer :: nloc 00837 Integer :: nvec 00838 Integer :: nparts 00839 Logical :: send_entire_valid_shape 00840 Integer :: n_list 00841 Type (integer_vector), Pointer :: srcars (:, :) 00842 Type (integer_vector), Pointer :: srclocs (:, :) 00843 Type (integer_vector), Pointer :: virtual (:, :) 00844 Type (logical_vector), Pointer :: msklocs (:, :) 00845 Integer, Pointer :: npoints (:, :) 00846 Integer, Pointer :: nextra (:, :) 00847 Integer, Pointer :: nars (:, :) 00848 Integer, Pointer :: dstijk (:, :) ! Raus 00849 Integer, Pointer :: dstars (:, :, :) ! Raus 00850 Integer, Pointer :: list_entries (:, :) 00851 00852 Integer :: nrecv, num2recv 00853 Integer, Pointer :: sender_global (:) 00854 Integer, Pointer :: len_sent (:) 00855 Integer, Pointer :: msg_id (:) 00856 End Type Send_information 00857 00858 Type Recv_information 00859 Integer :: source 00860 Integer :: epio_id 00861 Integer :: trs_rank 00862 Integer :: nloc 00863 Integer :: npoints 00864 Integer :: nar 00865 Integer, Pointer :: dstijk (:, :) 00866 Integer, Pointer :: dstars (:, :, :) 00867 End Type Recv_information 00868 00869 Type Send_appl_information 00870 Integer :: dest 00871 Integer :: nloc 00872 Integer, Pointer :: neigh_3d (:, :) 00873 Integer :: msg_id 00874 End Type Send_appl_information 00875 00876 Type Send_field_information 00877 Integer :: trans_out_id 00878 Integer :: send_info_index 00879 End Type Send_field_information 00880 00881 Type Recv_field_information 00882 Integer :: trans_in_id 00883 Integer :: recv_info_index 00884 End Type Recv_field_information 00885 ! 00886 ! 00887 ! ======================================================================= 00888 ! 00889 ! Application definition 00890 ! 00891 ! 00892 ! 00893 ! name : name of the application 00894 ! args : Arguments required 00895 ! sequence_number : position of the application in the setting 00896 ! stand_alone : indicates whether application is running stand alone 00897 ! comm_user : Communicator returned for components in user applications 00898 ! comm : PSMILe internal communicator over the processes of 00899 ! the current application/executable. 00900 ! rank : Rank in communicator "comm" 00901 ! 00902 Type Application 00903 Character (len=max_name) :: name 00904 Character (len=max_name) :: args 00905 Integer :: sequence_number 00906 Logical :: stand_alone 00907 Integer :: comm_user 00908 Integer :: comm 00909 Integer :: rank 00910 Integer :: size 00911 End Type Application 00912 ! 00913 !======================================================================= 00914 ! Global attributes 00915 !======================================================================= 00916 !rr Save 00917 00918 ! Appl : Pointer to application type vector 00919 ! 00920 Type (Application) :: Appl 00921 00922 !======================================================================= 00923 ! User-defined MPI reduction operations 00924 !======================================================================= 00925 00926 Integer :: PSMILE_MPI_SUMDD !SUM MPI reduce operation for double double 00927 ! 00928 !======================================================================= 00929 ! Interfaces 00930 !======================================================================= 00931 ! 00932 Interface 00933 subroutine psmile_char2buf (ibuf, ndibuf, ipos, string) 00934 Character(len=*), Intent (In) :: string 00935 Integer, Intent (In) :: ndibuf 00936 Integer, Intent (InOut) :: ipos 00937 Integer, Intent (InOut) :: ibuf (ndibuf) 00938 End Subroutine 00939 00940 subroutine psmile_int2char (number, string, ipos) 00941 Integer, Intent (In) :: number 00942 Character(len=*), Intent (InOut) :: string 00943 Integer, Intent (InOut) :: ipos 00944 End Subroutine 00945 00946 subroutine psmile_abort 00947 End Subroutine 00948 00949 subroutine psmile_error_common (ierror, string, ierrp, nerrp, file, line) 00950 Character (len=*), Intent (In) :: file, string 00951 Integer, Intent (In) :: line, ierror, nerrp 00952 Integer, Intent (In) :: ierrp (nerrp) 00953 End Subroutine 00954 00955 End Interface 00956 00957 Contains 00958 00959 subroutine psmile_nullify_enddef_search(search) 00960 Type(Enddef_search), Intent(Inout) :: search 00961 00962 Nullify(search%search_data%range) 00963 Nullify(search%search_data%shape) 00964 Nullify(search%search_data%dim_size) 00965 Nullify(search%msgint) 00966 Nullify(search%boundary_cell) 00967 Nullify(search%search_data%search_real) 00968 Nullify(search%search_data%search_dble) 00969 Nullify(search%search_mask) 00970 Nullify(search%global_index) 00971 End Subroutine PSMILe_nullify_Enddef_search 00972 00973 End Module psmile_common
1.6.1