00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011 subroutine psmile_send_req_subgrid (msg_intersections, &
00012 dest, tag, ierror)
00013
00014
00015
00016 use PRISM_constants
00017
00018 use PSMILe, dummy_interface => PSMILe_Send_req_subgrid
00019
00020 implicit none
00021
00022
00023
00024 Type (enddef_msg_intersections), Intent (In) :: msg_intersections
00025
00026
00027
00028 Integer, Intent (In) :: dest
00029
00030
00031
00032
00033 Integer, Intent (In) :: tag
00034
00035
00036
00037
00038
00039 integer, Intent (Out) :: ierror
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049 integer :: grid_id
00050
00051
00052
00053 integer :: sendreq (nd_msgint)
00054 integer :: method_id, method_type
00055 Type (Coords_Block), Pointer :: coords_pointer
00056
00057
00058
00059 Type (Corner_Block), Pointer :: corner_pointer
00060
00061
00062
00063
00064 integer, parameter :: nerrp = 1
00065 integer :: ierrp (nerrp)
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087 Character(len=len_cvs_string), save :: mycvs =
00088 '$Id: psmile_send_req_subgrid.F90 2787 2010-11-29 16:51:32Z hanke $'
00089
00090
00091
00092
00093
00094 grid_id = msg_intersections%tgt_grid_id
00095 method_id = msg_intersections%first_tgt_method_id
00096
00097 #ifdef VERBOSE
00098 print 9990, trim(ch_id), grid_id, method_id, dest
00099
00100 call psmile_flushstd
00101 #endif /* VERBOSE */
00102
00103 #ifdef PRISM_ASSERTION
00104
00105
00106
00107 if (method_id < 1 .or. method_id > Number_of_Methods_allocated) then
00108 print *, trim(ch_id), "method id =", method_id, Number_of_Methods_allocated
00109 call psmile_assert ( __FILE__, __LINE__, &
00110 "invalid method id")
00111 endif
00112
00113 if (grid_id /= Methods(method_id)%grid_id) then
00114 call psmile_assert ( __FILE__, __LINE__, &
00115 "inconsistent grid id's")
00116 endif
00117 #endif
00118
00119 method_type = Methods(method_id)%method_type
00120
00121 if (Grids(grid_id)%grid_type == PRISM_Gridless) then
00122
00123
00124
00125
00126
00127 call psmile_send_req_mask (msg_intersections, &
00128 dest, tag, ierror)
00129
00130
00131
00132
00133
00134 else if ( msg_intersections%requires_conserv_remap == PSMILe_conserv2D .or. &
00135 msg_intersections%requires_conserv_remap == PSMILe_conserv3D ) then
00136
00137 corner_pointer => Grids(grid_id)%corner_pointer
00138
00139 if (corner_pointer%corner_datatype == MPI_REAL) then
00140
00141
00142
00143 call psmile_send_req_corners_real (msg_intersections, &
00144 dest, tag, ierror)
00145
00146 else if (corner_pointer%corner_datatype == MPI_DOUBLE_PRECISION) then
00147
00148
00149
00150 call psmile_send_req_corners_dble (msg_intersections, &
00151 dest, tag, ierror)
00152
00153 #if defined ( PRISM_QUAD_TYPE )
00154 else if (corner_pointer%corner_datatype == MPI_REAL16) then
00155
00156
00157
00158 call psmile_send_req_corner_quad (msg_intersections, &
00159 dest, tag, ierror)
00160 #endif
00161
00162 else
00163
00164
00165
00166 ierrp (1) = corner_pointer%corner_datatype
00167 ierror = PRISM_Error_Internal
00168 call psmile_error ( ierror, 'unsupported data type', &
00169 ierrp, 1, __FILE__, __LINE__ )
00170 endif
00171
00172
00173
00174
00175
00176 else if (method_type == PSMILe_PointMethod) then
00177
00178 coords_pointer => Methods(method_id)%coords_pointer
00179
00180 if (coords_pointer%coords_datatype == MPI_REAL) then
00181
00182
00183
00184 call psmile_send_req_coords_real (msg_intersections, &
00185 dest, tag, ierror)
00186
00187 else if (coords_pointer%coords_datatype == MPI_DOUBLE_PRECISION) then
00188
00189
00190
00191 call psmile_send_req_coords_dble (msg_intersections, &
00192 dest, tag, ierror)
00193
00194 #if defined ( PRISM_QUAD_TYPE )
00195 else if (coords_pointer%coords_datatype == MPI_REAL16) then
00196
00197
00198
00199 call psmile_send_req_coords_quad (msg_intersections, &
00200 dest, tag, ierror)
00201
00202 #endif
00203
00204 else
00205
00206
00207
00208 ierrp (1) = coords_pointer%coords_datatype
00209 ierror = PRISM_Error_Internal
00210 call psmile_error ( ierror, 'unsupported data type', &
00211 ierrp, 1, __FILE__, __LINE__ )
00212 endif
00213
00214
00215
00216
00217
00218 else if (method_type == PSMILe_VectorPointMethod) then
00219
00220 ierrp (1) = method_type
00221 ierror = PRISM_Error_Internal
00222 call psmile_error ( ierror, 'Vector Method is currently not supported', &
00223 ierrp, 1, __FILE__, __LINE__ )
00224
00225
00226
00227
00228
00229 else if (method_type == PSMILe_SubgridMethod) then
00230
00231 ierrp (1) = method_type
00232 ierror = PRISM_Error_Internal
00233 call psmile_error ( ierror, 'Subgrid Method is currently not supported', &
00234 ierrp, 1, __FILE__, __LINE__ )
00235
00236
00237
00238
00239
00240 else
00241
00242 ierrp (1) = method_type
00243 ierror = PRISM_Error_Internal
00244 call psmile_error ( ierror, 'unsupported method type', &
00245 ierrp, 1, __FILE__, __LINE__ )
00246 endif
00247
00248
00249
00250 #ifdef VERBOSE
00251 print 9980, trim(ch_id), grid_id, dest, ierror
00252
00253 call psmile_flushstd
00254 #endif /* VERBOSE */
00255
00256
00257
00258 9990 format (1x, a, ': psmile_send_req_subgrid: grid_id =', i3, &
00259 '; method id =', i4, '; dest =', i4)
00260 9980 format (1x, a, ': psmile_send_req_subgrid: grid_id =', i3, &
00261 '; eof dest =', i3, ', ierror =', i4)
00262
00263 end subroutine PSMILe_Send_req_subgrid