222 istart2, iend2, jstart2, jend2)
223 type(fmsnetcdffile_t),
intent(in) :: fileobj
224 integer,
dimension(:),
intent(inout) :: tile1, tile2
225 integer,
dimension(:),
intent(inout) :: istart1, iend1, jstart1, jend1
226 integer,
dimension(:),
intent(inout) :: istart2, iend2, jstart2, jend2
227 character(len=MAX_NAME),
allocatable :: gridtiles(:)
228 character(len=MAX_NAME),
allocatable :: contacts(:)
229 character(len=MAX_NAME),
allocatable :: contacts_index(:)
230 character(len=MAX_NAME) :: strlist(8)
231 integer :: ntiles, n, m, ncontacts, nstr, ios
232 integer :: i1_type, j1_type, i2_type, j2_type
236 allocate(gridtiles(ntiles))
237 if(mpp_pe()==mpp_root_pe())
then
240 gridtiles(n)(m:m) =
" "
244 call read_data(fileobj,
'gridtiles', gridtiles)
248 allocate(contacts(ncontacts), contacts_index(ncontacts))
249 if(mpp_pe()==mpp_root_pe())
then
252 contacts(n)(m:m) =
" "
253 contacts_index(n)(m:m) =
" "
257 call read_data(fileobj,
"contacts", contacts)
258 call read_data(fileobj,
"contact_index", contacts_index)
261 nstr = parse_string(contacts(n),
":", strlist)
263 "mosaic_mod(get_mosaic_contact): number of elements in contact seperated by :/:: should be 4")
266 if(trim(gridtiles(m)) == trim(strlist(2)) )
then
274 "mosaic_mod(get_mosaic_contact):the first tile name specified in contact is not found in tile list")
278 if(trim(gridtiles(m)) == trim(strlist(4)) )
then
286 "mosaic_mod(get_mosaic_contact):the second tile name specified in contact is not found in tile list")
288 nstr = parse_string(contacts_index(n),
":,", strlist)
290 if(mpp_pe()==mpp_root_pe())
then
291 print*,
"nstr is ", nstr
292 print*,
"contacts is ", contacts_index(n)
294 print*,
"strlist is ", trim(strlist(m))
298 "mosaic_mod(get_mosaic_contact): number of elements in contact_index seperated by :/, should be 8")
300 read(strlist(1), *, iostat=ios) istart1(n)
302 "mosaic_mod(get_mosaic_contact): Error in reading istart1")
303 read(strlist(2), *, iostat=ios) iend1(n)
305 "mosaic_mod(get_mosaic_contact): Error in reading iend1")
306 read(strlist(3), *, iostat=ios) jstart1(n)
308 "mosaic_mod(get_mosaic_contact): Error in reading jstart1")
309 read(strlist(4), *, iostat=ios) jend1(n)
311 "mosaic_mod(get_mosaic_contact): Error in reading jend1")
312 read(strlist(5), *, iostat=ios) istart2(n)
314 "mosaic_mod(get_mosaic_contact): Error in reading istart2")
315 read(strlist(6), *, iostat=ios) iend2(n)
317 "mosaic_mod(get_mosaic_contact): Error in reading iend2")
318 read(strlist(7), *, iostat=ios) jstart2(n)
320 "mosaic_mod(get_mosaic_contact): Error in reading jstart2")
321 read(strlist(8), *, iostat=ios) jend2(n)
323 "mosaic_mod(get_mosaic_contact): Error in reading jend2")
325 i1_type = transfer_to_model_index(istart1(n), iend1(n), x_refine)
326 j1_type = transfer_to_model_index(jstart1(n), jend1(n), y_refine)
327 i2_type = transfer_to_model_index(istart2(n), iend2(n), x_refine)
328 j2_type = transfer_to_model_index(jstart2(n), jend2(n), y_refine)
330 if( i1_type == 0 .AND. j1_type == 0 )
call mpp_error(fatal, &
331 "mosaic_mod(get_mosaic_contact): istart1==iend1 and jstart1==jend1")
332 if( i2_type == 0 .AND. j2_type == 0 )
call mpp_error(fatal, &
333 "mosaic_mod(get_mosaic_contact): istart2==iend2 and jstart2==jend2")
334 if( i1_type + j1_type .NE. i2_type + j2_type )
call mpp_error(fatal, &
335 "mosaic_mod(get_mosaic_contact): It is not a line or overlap contact")
339 deallocate(gridtiles)
340 if(ncontacts>0)
deallocate(contacts, contacts_index)
subroutine, public get_mosaic_contact(fileobj, tile1, tile2, istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2)
Get contact information from mosaic_file Example usage: call get_mosaic_contact(mosaic_file,...
integer function, dimension(size(domain%tile_id(:))) mpp_get_tile_id(domain)
Returns the tile_id on current pe.
integer function mpp_get_current_ntile(domain)
Returns number of tile on current pe.
The domain2D type contains all the necessary information to define the global, compute and data domai...