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