psmile_common.F90

Go to the documentation of this file.
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

Generated on 18 Mar 2011 for Oasis4 by  doxygen 1.6.1