80 #ifndef __NO_4BYTE_REALS
88 #ifndef __NO_4BYTE_REALS
96 #ifndef __NO_4BYTE_REALS
104 #ifndef __NO_4BYTE_REALS
113 integer(kind=ip_intwp_p),
parameter :: mgrid = 100
114 integer(kind=ip_intwp_p),
save :: writing_grids_call=0
118 character(len=ic_med) :: gridname
119 integer(kind=ip_i4_p) :: partid
120 integer(kind=ip_i4_p) :: nx
121 integer(kind=ip_i4_p) :: ny
122 integer(kind=ip_i4_p) :: nc
124 logical :: corner_set
129 logical :: terminated
130 real(kind=ip_realwp_p),
allocatable :: lon(:,:)
131 real(kind=ip_realwp_p),
allocatable :: lat(:,:)
132 real(kind=ip_realwp_p),
allocatable :: clon(:,:,:)
133 real(kind=ip_realwp_p),
allocatable :: clat(:,:,:)
134 real(kind=ip_realwp_p),
allocatable :: angle(:,:)
135 real(kind=ip_realwp_p),
allocatable :: area(:,:)
136 integer(kind=ip_i4_p) ,
allocatable :: mask(:,:)
139 integer(kind=ip_intwp_p),
public,
save :: prism_ngrid = 0
144 #include <netcdf.inc>
160 integer(kind=ip_intwp_p) :: n
161 character(len=*),
parameter :: subname =
'(oasis_print_grid_data)'
168 write(nulprt,*) subname,trim(prism_grid(n)%gridname),
' size',prism_grid(n)%nx,prism_grid(n)%ny
169 write(nulprt,*) subname,trim(prism_grid(n)%gridname),
' set ',prism_grid(n)%grid_set, &
170 prism_grid(n)%corner_set, prism_grid(n)%angle_set, prism_grid(n)%area_set, prism_grid(n)%mask_set
171 if (prism_grid(n)%partid > 0 .and. prism_grid(n)%partid < prism_npart)
then
172 write(nulprt,*) subname,
'partid ',trim(prism_grid(n)%gridname),prism_grid(n)%partid, &
173 trim(prism_part(prism_grid(n)%partid)%partname)
175 write(nulprt,*) subname,
'partid ',trim(prism_grid(n)%gridname),prism_grid(n)%partid
177 if (prism_grid(n)%grid_set)
write(nulprt,*) subname,trim(prism_grid(n)%gridname),
' lon ', &
178 size(prism_grid(n)%lon,dim=1),
size(prism_grid(n)%lon,dim=2), &
179 minval(prism_grid(n)%lon),maxval(prism_grid(n)%lon)
180 if (prism_grid(n)%grid_set)
write(nulprt,*) subname,trim(prism_grid(n)%gridname),
' lat ', &
181 size(prism_grid(n)%lat,dim=1),
size(prism_grid(n)%lat,dim=2), &
182 minval(prism_grid(n)%lat),maxval(prism_grid(n)%lat)
183 if (prism_grid(n)%corner_set)
write(nulprt,*) subname,trim(prism_grid(n)%gridname),
' clon ', &
184 size(prism_grid(n)%clon,dim=1),
size(prism_grid(n)%clon,dim=2), &
185 minval(prism_grid(n)%clon),maxval(prism_grid(n)%clon)
186 if (prism_grid(n)%corner_set)
write(nulprt,*) subname,trim(prism_grid(n)%gridname),
' clat ', &
187 size(prism_grid(n)%clat,dim=1),
size(prism_grid(n)%clat,dim=2), &
188 minval(prism_grid(n)%clat),maxval(prism_grid(n)%clat)
189 if (prism_grid(n)%angle_set)
write(nulprt,*) subname,trim(prism_grid(n)%gridname),
' angl ', &
190 size(prism_grid(n)%angle,dim=1),
size(prism_grid(n)%angle,dim=2), &
191 minval(prism_grid(n)%angle),maxval(prism_grid(n)%angle)
192 if (prism_grid(n)%mask_set)
write(nulprt,*) subname,trim(prism_grid(n)%gridname),
' mask ', &
193 size(prism_grid(n)%mask,dim=1),
size(prism_grid(n)%mask,dim=2), &
194 minval(prism_grid(n)%mask),maxval(prism_grid(n)%mask)
195 if (prism_grid(n)%area_set)
write(nulprt,*) subname,trim(prism_grid(n)%gridname),
' area ', &
196 size(prism_grid(n)%area,dim=1),
size(prism_grid(n)%area,dim=2), &
197 minval(prism_grid(n)%area),maxval(prism_grid(n)%area)
212 integer(kind=ip_intwp_p),
intent (OUT) :: iwrite
215 character(len=*),
parameter :: subname =
'(oasis_start_grids_writing)'
220 if (oasis_debug >= 15)
then
221 write(nulprt,*) subname,
' prism_ngrid = ',prism_ngrid
224 if (prism_ngrid == 0)
then
225 prism_grid(:)%gridname =
'unSet'
226 prism_grid(:)%nx = -1
227 prism_grid(:)%ny = -1
228 prism_grid(:)%grid_set = .false.
229 prism_grid(:)%corner_set = .false.
230 prism_grid(:)%angle_set = .false.
231 prism_grid(:)%area_set = .false.
232 prism_grid(:)%mask_set = .false.
233 prism_grid(:)%written = .false.
234 prism_grid(:)%terminated = .false.
235 prism_grid(:)%partid = -1
257 character(len=*),
intent (in) :: cgrid
258 integer(kind=ip_intwp_p),
intent (in) :: nx
259 integer(kind=ip_intwp_p),
intent (in) :: ny
260 real(kind=ip_double_p),
intent (in) :: lon(:,:)
261 real(kind=ip_double_p),
intent (in) :: lat(:,:)
262 integer(kind=ip_intwp_p),
intent (in),
optional :: partid
264 integer(kind=ip_intwp_p) :: GRIDID
265 integer(kind=ip_intwp_p) :: ierror
266 integer(kind=ip_intwp_p) :: lnx,lny
267 character(len=*),
parameter :: subname =
'(oasis_write_grid_r8)'
272 if (oasis_debug >= 15)
then
273 write(nulprt,*) subname,
' size = ',trim(cgrid),nx,ny
278 lnx =
size(lon,dim=1)
279 lny =
size(lon,dim=2)
281 allocate(prism_grid(gridid)%lon(lnx,lny),stat=ierror)
282 IF (ierror /= 0)
WRITE(nulprt,*) subname,
' model :',compid,
' proc :',&
283 mpi_rank_local,
' WARNING lon alloc'
285 lnx =
size(lat,dim=1)
286 lny =
size(lat,dim=2)
288 allocate(prism_grid(gridid)%lat(lnx,lny),stat=ierror)
289 if (ierror /= 0)
write(nulprt,*) subname,
' model :',compid,
' proc :',&
290 mpi_rank_local,
' WARNING lat alloc'
292 prism_grid(gridid)%lon = lon
293 prism_grid(gridid)%lat = lat
294 prism_grid(gridid)%grid_set = .true.
296 if (
present(partid))
then
297 if (prism_grid(gridid)%partid > 0 .and. prism_grid(gridid)%partid /= partid)
then
298 write(nulprt,*) subname,estr,
'partid inconsistency',gridid,prism_grid(gridid)%partid,partid
301 prism_grid(gridid)%partid = partid
302 if (oasis_debug >= 15)
then
303 write(nulprt,*) subname,
' partid = ',trim(cgrid),partid
324 character(len=*),
intent (in) :: cgrid
325 integer(kind=ip_intwp_p),
intent (in) :: nx
326 integer(kind=ip_intwp_p),
intent (in) :: ny
327 real(kind=ip_single_p),
intent (in) :: lon(:,:)
328 real(kind=ip_single_p),
intent (in) :: lat(:,:)
329 integer(kind=ip_intwp_p),
intent (in),
optional :: partid
331 real(kind=ip_double_p),
allocatable :: lon8(:,:)
332 real(kind=ip_double_p),
allocatable :: lat8(:,:)
333 integer(kind=ip_intwp_p) :: ierror
334 integer(kind=ip_intwp_p) :: lpartid
335 integer(kind=ip_intwp_p) :: lnx,lny
336 character(len=*),
parameter :: subname =
'(oasis_write_grid_r4)'
341 if (oasis_debug >= 15)
then
342 write(nulprt,*) subname,
' size = ',trim(cgrid),nx,ny
346 if (
present(partid))
then
349 if (oasis_debug >= 15)
then
350 write(nulprt,*) subname,
' partid = ',trim(cgrid),lpartid
353 lnx =
size(lon,dim=1)
354 lny =
size(lon,dim=2)
356 allocate(lon8(lnx,lny),stat=ierror)
357 IF (ierror /= 0)
WRITE(nulprt,*) subname,
' model :',compid,
' proc :',&
358 mpi_rank_local,
' WARNING lon alloc'
360 lnx =
size(lat,dim=1)
361 lny =
size(lat,dim=2)
363 allocate(lat8(lnx,lny),stat=ierror)
364 if (ierror /= 0)
write(nulprt,*) subname,
' model :',compid,
' proc :',&
365 mpi_rank_local,
' WARNING lat alloc'
389 character(len=*),
intent (in) :: cgrid
390 integer(kind=ip_intwp_p),
intent (in) :: nx
391 integer(kind=ip_intwp_p),
intent (in) :: ny
392 real(kind=ip_double_p),
intent (in) :: angle(:,:)
393 integer(kind=ip_intwp_p),
intent (in),
optional :: partid
395 integer(kind=ip_intwp_p) :: GRIDID
396 integer(kind=ip_intwp_p) :: ierror
397 integer(kind=ip_intwp_p) :: lnx,lny
398 character(len=*),
parameter :: subname =
'(oasis_write_angle_r8)'
403 if (oasis_debug >= 15)
then
404 write(nulprt,*) subname,
' size = ',trim(cgrid),nx,ny
409 lnx =
size(angle,dim=1)
410 lny =
size(angle,dim=2)
412 allocate(prism_grid(gridid)%angle(lnx,lny),stat=ierror)
413 if (ierror /= 0)
write(nulprt,*) subname,
' model :',compid,
' proc :',&
414 mpi_rank_local,
' WARNING angle alloc'
416 prism_grid(gridid)%angle = angle
417 prism_grid(gridid)%angle_set = .true.
418 if (
present(partid))
then
419 if (prism_grid(gridid)%partid > 0 .and. prism_grid(gridid)%partid /= partid)
then
420 write(nulprt,*) subname,estr,
'partid inconsistency',gridid,prism_grid(gridid)%partid,partid
423 prism_grid(gridid)%partid = partid
424 if (oasis_debug >= 15)
then
425 write(nulprt,*) subname,
' partid = ',trim(cgrid),partid
445 character(len=*),
intent (in) :: cgrid
446 integer(kind=ip_intwp_p),
intent (in) :: nx
447 integer(kind=ip_intwp_p),
intent (in) :: ny
448 real(kind=ip_single_p),
intent (in) :: angle(:,:)
449 integer(kind=ip_intwp_p),
intent (in),
optional :: partid
451 real(kind=ip_double_p),
allocatable :: angle8(:,:)
452 integer(kind=ip_intwp_p) :: ierror
453 integer(kind=ip_intwp_p) :: lpartid
454 integer(kind=ip_intwp_p) :: lnx,lny
455 character(len=*),
parameter :: subname =
'(oasis_write_angle_r4)'
460 if (oasis_debug >= 15)
then
461 write(nulprt,*) subname,
' size = ',trim(cgrid),nx,ny
465 if (
present(partid))
then
468 if (oasis_debug >= 15)
then
469 write(nulprt,*) subname,
' partid = ',trim(cgrid),lpartid
472 lnx =
size(angle,dim=1)
473 lny =
size(angle,dim=2)
475 allocate(angle8(lnx,lny),stat=ierror)
476 if (ierror /= 0)
write(nulprt,*) subname,
' model :',compid,
' proc :',&
477 mpi_rank_local,
' WARNING angle8 alloc'
501 character(len=*),
intent (in) :: cgrid
502 integer(kind=ip_intwp_p),
intent (in) :: nx
503 integer(kind=ip_intwp_p),
intent (in) :: ny
504 integer(kind=ip_intwp_p),
intent (in) :: nc
505 real(kind=ip_double_p),
intent (in) :: clon(:,:,:)
506 real(kind=ip_double_p),
intent (in) :: clat(:,:,:)
507 integer(kind=ip_intwp_p),
intent (in),
optional :: partid
509 integer(kind=ip_intwp_p) :: GRIDID
510 integer(kind=ip_intwp_p) :: ierror
511 integer(kind=ip_intwp_p) :: lnx,lny
512 character(len=*),
parameter :: subname =
'(oasis_write_corner_r8)'
517 if (oasis_debug >= 15)
then
518 write(nulprt,*) subname,
' size = ',trim(cgrid),nx,ny
523 lnx =
size(clon,dim=1)
524 lny =
size(clon,dim=2)
526 allocate(prism_grid(gridid)%clon(lnx,lny,nc),stat=ierror)
527 if (ierror /= 0)
write(nulprt,*) subname,
' model :',compid,
' proc :',&
528 mpi_rank_local,
' WARNING clon alloc'
530 lnx =
size(clat,dim=1)
531 lny =
size(clat,dim=2)
533 allocate(prism_grid(gridid)%clat(lnx,lny,nc),stat=ierror)
534 if (ierror /= 0)
write(nulprt,*) subname,
' model :',compid,
' proc :',&
535 mpi_rank_local,
' WARNING clat alloc'
537 prism_grid(gridid)%nc = nc
538 prism_grid(gridid)%clon = clon
539 prism_grid(gridid)%clat = clat
540 prism_grid(gridid)%corner_set = .true.
541 if (
present(partid))
then
542 if (prism_grid(gridid)%partid > 0 .and. prism_grid(gridid)%partid /= partid)
then
543 write(nulprt,*) subname,estr,
'partid inconsistency',gridid,prism_grid(gridid)%partid,partid
546 prism_grid(gridid)%partid = partid
547 if (oasis_debug >= 15)
then
548 write(nulprt,*) subname,
' partid = ',trim(cgrid),partid
569 character(len=*),
intent (in) :: cgrid
570 integer(kind=ip_intwp_p),
intent (in) :: nx
571 integer(kind=ip_intwp_p),
intent (in) :: ny
572 integer(kind=ip_intwp_p),
intent (in) :: nc
573 real(kind=ip_single_p),
intent (in) :: clon(:,:,:)
574 real(kind=ip_single_p),
intent (in) :: clat(:,:,:)
575 integer(kind=ip_intwp_p),
intent (in),
optional :: partid
577 real(kind=ip_double_p),
allocatable :: clon8(:,:,:),clat8(:,:,:)
578 integer(kind=ip_intwp_p) :: ierror
579 integer(kind=ip_intwp_p) :: lpartid
580 integer(kind=ip_intwp_p) :: lnx,lny
581 character(len=*),
parameter :: subname =
'(oasis_write_corner_r4)'
586 if (oasis_debug >= 15)
then
587 write(nulprt,*) subname,
' size = ',trim(cgrid),nx,ny
591 if (
present(partid))
then
594 if (oasis_debug >= 15)
then
595 write(nulprt,*) subname,
' partid = ',trim(cgrid),lpartid
598 lnx =
size(clon,dim=1)
599 lny =
size(clon,dim=2)
601 allocate(clon8(lnx,lny,nc),stat=ierror)
602 if (ierror /= 0)
write(nulprt,*) subname,
' model :',compid,
' proc :',&
603 mpi_rank_local,
' WARNING clon8 alloc'
605 lnx =
size(clat,dim=1)
606 lny =
size(clat,dim=2)
608 allocate(clat8(lnx,lny,nc),stat=ierror)
609 if (ierror /= 0)
write(nulprt,*) subname,
' model :',compid,
' proc :',&
610 mpi_rank_local,
' WARNING clat8 alloc'
636 character(len=*),
intent (in) :: cgrid
637 integer(kind=ip_intwp_p),
intent (in) :: nx
638 integer(kind=ip_intwp_p),
intent (in) :: ny
639 integer(kind=ip_intwp_p),
intent (in) :: mask(:,:)
640 integer(kind=ip_intwp_p),
intent (in),
optional :: partid
642 integer(kind=ip_intwp_p) :: GRIDID
643 integer(kind=ip_intwp_p) :: ierror
644 integer(kind=ip_intwp_p) :: lnx,lny
645 character(len=*),
parameter :: subname =
'(oasis_write_mask)'
650 if (oasis_debug >= 15)
then
651 write(nulprt,*) subname,
' size = ',trim(cgrid),nx,ny
656 lnx =
size(mask,dim=1)
657 lny =
size(mask,dim=2)
659 allocate(prism_grid(gridid)%mask(lnx,lny),stat=ierror)
660 if (ierror /= 0)
write(nulprt,*) subname,
' model :',compid,
' proc :',&
661 mpi_rank_local,
' WARNING mask alloc'
663 prism_grid(gridid)%mask = mask
664 prism_grid(gridid)%mask_set = .true.
665 if (
present(partid))
then
666 if (prism_grid(gridid)%partid > 0 .and. prism_grid(gridid)%partid /= partid)
then
667 write(nulprt,*) subname,estr,
'partid inconsistency',gridid,prism_grid(gridid)%partid,partid
670 prism_grid(gridid)%partid = partid
671 if (oasis_debug >= 15)
then
672 write(nulprt,*) subname,
' partid = ',trim(cgrid),partid
693 character(len=*),
intent (in) :: cgrid
694 integer(kind=ip_intwp_p),
intent (in) :: nx
695 integer(kind=ip_intwp_p),
intent (in) :: ny
696 real(kind=ip_double_p),
intent (in) :: area(:,:)
697 integer(kind=ip_intwp_p),
intent (in),
optional :: partid
699 integer(kind=ip_intwp_p) :: GRIDID
700 integer(kind=ip_intwp_p) :: ierror
701 integer(kind=ip_intwp_p) :: lnx,lny
702 character(len=*),
parameter :: subname =
'(oasis_write_area_r8)'
707 if (oasis_debug >= 15)
then
708 write(nulprt,*) subname,
' size = ',trim(cgrid),nx,ny
713 lnx =
size(area,dim=1)
714 lny =
size(area,dim=2)
716 allocate(prism_grid(gridid)%area(lnx,lny),stat=ierror)
717 if (ierror /= 0)
write(nulprt,*) subname,
' model :',compid,
' proc :',&
718 mpi_rank_local,
' WARNING area alloc'
720 prism_grid(gridid)%area = area
721 prism_grid(gridid)%area_set = .true.
722 if (
present(partid))
then
723 if (prism_grid(gridid)%partid > 0 .and. prism_grid(gridid)%partid /= partid)
then
724 write(nulprt,*) subname,estr,
'partid inconsistency',gridid,prism_grid(gridid)%partid,partid
727 prism_grid(gridid)%partid = partid
728 if (oasis_debug >= 15)
then
729 write(nulprt,*) subname,
' partid = ',trim(cgrid),partid
750 character(len=*),
intent (in) :: cgrid
751 integer(kind=ip_intwp_p),
intent (in) :: nx
752 integer(kind=ip_intwp_p),
intent (in) :: ny
753 real(kind=ip_single_p),
intent (in) :: area(:,:)
754 integer(kind=ip_intwp_p),
intent (in),
optional :: partid
756 real(kind=ip_double_p),
allocatable :: area8(:,:)
757 integer(kind=ip_intwp_p) :: ierror
758 integer(kind=ip_intwp_p) :: lpartid
759 integer(kind=ip_intwp_p) :: lnx,lny
760 character(len=*),
parameter :: subname =
'(oasis_write_area_r4)'
765 if (oasis_debug >= 15)
then
766 write(nulprt,*) subname,
' size = ',trim(cgrid),nx,ny
770 if (
present(partid))
then
773 if (oasis_debug >= 15)
then
774 write(nulprt,*) subname,
' partid = ',trim(cgrid),lpartid
777 lnx =
size(area,dim=1)
778 lny =
size(area,dim=2)
780 allocate(area8(lnx,lny),stat=ierror)
781 if (ierror /= 0)
write(nulprt,*) subname,
' model :',compid,
' proc :',&
782 mpi_rank_local,
' WARNING area8 alloc'
803 integer(kind=ip_i4_p) :: n
804 character(len=*),
parameter :: subname =
'(oasis_terminate_grids_writing)'
808 if (oasis_debug >= 15)
then
809 write(nulprt,*) subname,
' prism_ngrid = ',prism_ngrid
813 prism_grid(n)%terminated = .true.
840 character(len=ic_med) :: filename
841 character(len=ic_med) :: fldname
842 character(len=ic_med) :: cgrid
844 integer(kind=ip_i4_p) :: m,n,n1,g,p
845 integer(kind=ip_i4_p) :: partid
846 integer(kind=ip_i4_p) :: taskid
847 integer(kind=ip_i4_p) :: nx,ny,nc
848 integer(kind=ip_i4_p) :: tnx,tny
849 logical :: partid_grid
850 logical :: active_task
851 logical :: write_task
852 real(kind=ip_realwp_p),
allocatable :: rloc(:,:)
853 real(kind=ip_realwp_p),
allocatable :: rglo(:,:)
854 real(kind=ip_realwp_p),
allocatable :: r3glo(:,:,:)
855 integer(kind=ip_i4_p) ,
allocatable :: iglo(:,:)
856 integer(kind=ip_intwp_p) :: gcnt
858 character(len=ic_med) ,
pointer :: gname0(:),gname(:)
859 character(len=ic_lvar2) ,
pointer :: pname0(:),pname(:)
860 logical,
parameter :: local_timers_on = .false.
861 character(len=*),
parameter :: undefined_partname =
'(UnDeFiNeD_PArtnaME)'
862 character(len=*),
parameter :: subname =
'(oasis_write2files)'
868 call
oasis_mpi_bcast(writing_grids_call,mpi_comm_local,subname//
'writing_grids_call')
869 if (writing_grids_call .eq. 1)
then
872 allocate(gname0(prism_ngrid))
873 allocate(pname0(prism_ngrid))
875 gname0(n) = prism_grid(n)%gridname
876 if (prism_grid(n)%partid > 0 .and. prism_grid(n)%partid <= prism_npart)
then
877 pname0(n) = prism_part(prism_grid(n)%partid)%partname
878 elseif (prism_grid(n)%partid == -1)
then
879 pname0(n) = undefined_partname
881 write(nulprt,*) subname,estr,
'illegal partition id for grid ',trim(prism_grid(n)%gridname),prism_grid(n)%partid
886 linp2=pname0,lout2=pname,spval2=undefined_partname)
896 if (pname(n) /= undefined_partname)
then
898 if (pname(n) == prism_part(p)%partname .and. prism_part(p)%mpicom /= mpi_comm_null)
then
901 if (prism_grid(g)%gridname == gname(n)) found = .true.
903 if (.not. found)
then
904 write(nulprt,*) subname,estr,
'grid with partition not defined on all partition tasks: ',trim(gname(n))
920 if (prism_grid(n)%terminated)
then
921 if (prism_grid(n)%gridname == gname(g))
then
924 partid = prism_grid(n)%partid
925 prism_grid(n)%written = .true.
933 active_task = .false.
935 if (pname(g) == undefined_partname)
then
936 partid_grid = .false.
937 if (mpi_rank_local == 0) active_task = .true.
938 if (mpi_rank_local == 0) write_task = .true.
941 if (partid > 0 .and. partid <= prism_npart)
then
943 if (prism_part(partid)%mpicom /= mpi_comm_null) active_task = .true.
944 if (prism_part(partid)%rank == taskid) write_task = .true.
945 elseif (partid == -1)
then
946 active_task = .false.
949 write(nulprt,*) subname,estr,
'illegal partid for grid:',trim(gname(g)),trim(pname(g)),partid
954 if (oasis_debug >= 15)
then
955 write(nulprt,*) subname,
' ',trim(gname(g)),
':',trim(pname(g)),
': partid_grid=', &
956 partid_grid,
'active_task=',active_task,
'write_task=',write_task
959 if (active_task)
then
961 nx = prism_grid(n)%nx
962 ny = prism_grid(n)%ny
963 nc = prism_grid(n)%nc
965 allocate(rglo(nx,ny))
971 if (prism_grid(n)%grid_set)
then
972 if (tnx <= 0 .or. tny <= 0)
then
973 tnx =
size(prism_grid(n)%lon,dim=1)
974 tny =
size(prism_grid(n)%lon,dim=2)
976 if (
size(prism_grid(n)%lon,dim=1) /= tnx .or. &
977 size(prism_grid(n)%lon,dim=2) /= tny .or. &
978 size(prism_grid(n)%lat,dim=1) /= tnx .or. &
979 size(prism_grid(n)%lat,dim=2) /= tny )
then
980 write(nulprt,*) subname,estr,
'inconsistent array size lon/lat ',tnx,tny, &
981 size(prism_grid(n)%lon,dim=1),
size(prism_grid(n)%lon,dim=2), &
982 size(prism_grid(n)%lat,dim=1),
size(prism_grid(n)%lat,dim=2)
990 filename =
'grids.nc'
991 fldname = trim(cgrid)//
'.lon'
992 if (partid_grid)
then
995 rglo = prism_grid(n)%lon
1003 filename =
'grids.nc'
1004 fldname = trim(cgrid)//
'.lat'
1005 if (partid_grid)
then
1008 rglo = prism_grid(n)%lat
1013 if (prism_grid(n)%corner_set)
then
1014 if (tnx <= 0 .or. tny <= 0)
then
1015 tnx =
size(prism_grid(n)%clon,dim=1)
1016 tny =
size(prism_grid(n)%clon,dim=2)
1018 if (
size(prism_grid(n)%clon,dim=1) /= tnx .or. &
1019 size(prism_grid(n)%clon,dim=2) /= tny .or. &
1020 size(prism_grid(n)%clat,dim=1) /= tnx .or. &
1021 size(prism_grid(n)%clat,dim=2) /= tny )
then
1022 write(nulprt,*) subname,estr,
'inconsistent array size clon/clat ',tnx,tny, &
1023 size(prism_grid(n)%clon,dim=1),
size(prism_grid(n)%clon,dim=2), &
1024 size(prism_grid(n)%clat,dim=1),
size(prism_grid(n)%clat,dim=2)
1032 allocate(r3glo(nx,ny,nc))
1033 filename =
'grids.nc'
1034 fldname = trim(cgrid)//
'.clo'
1035 if (partid_grid)
then
1036 allocate(rloc(tnx,tny))
1038 rloc(:,:) = prism_grid(n)%clon(:,:,n1)
1040 r3glo(:,:,n1) = rglo(:,:)
1044 r3glo = prism_grid(n)%clon
1052 filename =
'grids.nc'
1053 fldname = trim(cgrid)//
'.cla'
1054 if (partid_grid)
then
1055 allocate(rloc(tnx,tny))
1057 rloc(:,:) = prism_grid(n)%clat(:,:,n1)
1059 r3glo(:,:,n1) = rglo(:,:)
1063 r3glo = prism_grid(n)%clat
1069 if (prism_grid(n)%area_set)
then
1070 if (tnx <= 0 .or. tny <= 0)
then
1071 tnx =
size(prism_grid(n)%area,dim=1)
1072 tny =
size(prism_grid(n)%area,dim=2)
1074 if (
size(prism_grid(n)%area,dim=1) /= tnx .or. &
1075 size(prism_grid(n)%area,dim=2) /= tny )
then
1076 write(nulprt,*) subname,estr,
'inconsistent array size area ',tnx,tny, &
1077 size(prism_grid(n)%area,dim=1),
size(prism_grid(n)%area,dim=2)
1085 filename =
'areas.nc'
1086 fldname = trim(cgrid)//
'.srf'
1087 if (partid_grid)
then
1090 rglo = prism_grid(n)%area
1095 if (prism_grid(n)%angle_set)
then
1096 if (tnx <= 0 .or. tny <= 0)
then
1097 tnx =
size(prism_grid(n)%angle,dim=1)
1098 tny =
size(prism_grid(n)%angle,dim=2)
1100 if (
size(prism_grid(n)%angle,dim=1) /= tnx .or. &
1101 size(prism_grid(n)%angle,dim=2) /= tny )
then
1102 write(nulprt,*) subname,estr,
'inconsistent array size angle ',tnx,tny, &
1103 size(prism_grid(n)%angle,dim=1),
size(prism_grid(n)%angle,dim=2)
1111 filename =
'grids.nc'
1112 fldname = trim(cgrid)//
'.ang'
1113 if (partid_grid)
then
1116 rglo = prism_grid(n)%angle
1121 if (prism_grid(n)%mask_set)
then
1122 if (tnx <= 0 .or. tny <= 0)
then
1123 tnx =
size(prism_grid(n)%mask,dim=1)
1124 tny =
size(prism_grid(n)%mask,dim=2)
1126 if (
size(prism_grid(n)%mask,dim=1) /= tnx .or. &
1127 size(prism_grid(n)%mask,dim=2) /= tny )
then
1128 write(nulprt,*) subname,estr,
'inconsistent array size mask ',tnx,tny, &
1129 size(prism_grid(n)%mask,dim=1),
size(prism_grid(n)%mask,dim=2)
1137 allocate(iglo(nx,ny))
1138 filename =
'masks.nc'
1139 fldname = trim(cgrid)//
'.msk'
1140 if (partid_grid)
then
1141 allocate(rloc(tnx,tny))
1142 rloc = prism_grid(n)%mask
1147 iglo = prism_grid(n)%mask
1162 deallocate(gname,pname)
1181 character(len=*),
intent (in) :: cgrid
1182 integer(kind=ip_intwp_p),
intent (in) :: nx
1183 integer(kind=ip_intwp_p),
intent (in) :: ny
1184 integer(kind=ip_intwp_p),
intent(out) :: gridID
1186 integer(kind=ip_intwp_p) :: n
1187 character(len=*),
parameter :: subname =
'(oasis_findgrid)'
1193 do n = 1,prism_ngrid
1194 if (trim(cgrid) == trim(prism_grid(n)%gridname))
then
1197 if (nx /= prism_grid(gridid)%nx .or. ny /= prism_grid(gridid)%ny)
then
1198 write(nulprt,*) subname,estr,
'in predefined grid size = ',nx,ny, &
1199 prism_grid(gridid)%nx,prism_grid(gridid)%ny
1205 if (gridid < 1)
then
1206 prism_ngrid = prism_ngrid+1
1207 gridid = prism_ngrid
1210 prism_grid(gridid)%gridname = trim(cgrid)
1211 prism_grid(gridid)%nx = nx
1212 prism_grid(gridid)%ny = ny
1225 real(kind=ip_realwp_p),
intent(in) :: aloc(:,:)
1226 real(kind=ip_realwp_p),
intent(inout) :: aglo(:,:)
1227 integer(kind=ip_i4_p) ,
intent(in) :: partid
1228 integer(kind=ip_i4_p) ,
intent(in) :: taskid
1230 type(mct_avect) :: avloc,avglo
1231 integer(kind=ip_i4_p) :: i,j,n
1232 integer(kind=ip_i4_p) :: lnx,lny,gnx,gny
1233 character(len=*),
parameter :: subname =
'(oasis_grid_loc2glo)'
1238 if (prism_part(partid)%mpicom /= mpi_comm_null)
then
1240 lnx =
size(aloc,dim=1)
1241 lny =
size(aloc,dim=2)
1242 gnx =
size(aglo,dim=1)
1243 gny =
size(aglo,dim=2)
1244 call mct_avect_init(avloc,rlist=
'field',lsize=lnx*lny)
1250 avloc%rattr(1,n) = aloc(i,j)
1254 call mct_avect_gather(avloc,avglo,prism_part(partid)%pgsmap,taskid,prism_part(partid)%mpicom)
1256 if (prism_part(partid)%rank == taskid)
then
1261 aglo(i,j) = avglo%rattr(1,n)
1264 call mct_avect_clean(avglo)
1267 call mct_avect_clean(avloc)
subroutine, public oasis_debug_exit(string)
Used when a subroutine is exited, write info to log file at some debug level.
OASIS partition data and methods.
Generic interface to support writing 4 or 8 byte reals.
subroutine oasis_findgrid(cgrid, nx, ny, gridID)
Local interface to find gridID for a specified grid name.
Generic overloaded interface into MPI max reduction.
Provides a generic and simpler interface into MPI calls for OASIS.
Generic overloaded interface into MPI broadcast.
Generic interface to support writing 4 or 8 byte reals.
subroutine, public oasis_timer_start(timer_label, barrier)
Start a timer.
subroutine, public oasis_timer_stop(timer_label)
Stop a timer.
Provides a common location for several OASIS variables.
Generic interface to support writing 4 or 8 byte reals.
subroutine, public oasis_mpi_reducelists(linp1, comm, cntout, lout1, callstr, fastcheck, fastcheckout, linp2, lout2, spval2, linp3, lout3, spval3)
Custom method for reducing MPI lists across pes for OASIS.
subroutine, public oasis_io_write_3dgridfld_fromroot(filename, fldname, fld, nx, ny, nc)
Write a 3d real array named field from the root task to a file.
subroutine, public oasis_debug_enter(string)
Used when a subroutine is entered, write info to log file at some debug level.
Generic interface to support writing 4 or 8 byte reals.
Generic overloaded interface into MPI min reduction.
subroutine oasis_grid_loc2glo(aloc, aglo, partid, taskid)
Local routine that gathers the local array using partition information.
subroutine, public oasis_terminate_grids_writing()
User interface to indicate user defined grids are done.
subroutine oasis_write_angle_r8(cgrid, nx, ny, angle, partid)
User interface to set angle for 8 byte reals.
subroutine, public oasis_mpi_chkerr(rcode, string)
Checks MPI error codes and aborts.
subroutine, public oasis_write2files()
Interface that actually writes fields to grid files.
Performance timer methods.
subroutine oasis_write_corner_r8(cgrid, nx, ny, nc, clon, clat, partid)
User interface to set corner latitudes and longitudes for 8 byte reals.
subroutine, public oasis_write_mask(cgrid, nx, ny, mask, partid)
User interface to set integer mask values.
subroutine, public oasis_abort(id_compid, cd_routine, cd_message)
OASIS abort method, publically available to users.
subroutine oasis_write_grid_r8(cgrid, nx, ny, lon, lat, partid)
User interface to set latitudes and longitudes for 8 byte reals.
subroutine, public oasis_print_grid_data()
Print grid information to log file.
subroutine, public oasis_io_write_2dgridfld_fromroot(filename, fldname, fld, nx, ny)
Write a real array named field from the root task to a file.
subroutine, public oasis_start_grids_writing(iwrite)
User interface to initialize grid writing.
Model grid data for creating mapping data and conserving fields.
subroutine, public oasis_mpi_barrier(comm, string)
Call MPI_BARRIER for a particular communicator.
OASIS grid data and methods.
subroutine oasis_write_area_r8(cgrid, nx, ny, area, partid)
User interface to set area values for 8 byte reals.
subroutine, public oasis_io_write_2dgridint_fromroot(filename, fldname, fld, nx, ny)
Write an integer array named field from the root task to a file.
subroutine oasis_write_area_r4(cgrid, nx, ny, area, partid)
User interface to set area values for 4 byte reals.
Provides reusable IO routines for OASIS.
subroutine oasis_write_grid_r4(cgrid, nx, ny, lon, lat, partid)
User interface to set latitudes and longitudes for 4 byte reals.
subroutine oasis_write_corner_r4(cgrid, nx, ny, nc, clon, clat, partid)
User interface to set corner latitudes and longitudes for 4 byte reals.
subroutine oasis_write_angle_r4(cgrid, nx, ny, angle, partid)
User interface to set angle for 4 byte reals.