20#if defined PIO_LIB && defined DISTRIBUTE
27#if defined PIO_LIB && defined DISTRIBUTE
35#if defined PIO_LIB && defined DISTRIBUTE
73#if defined PIO_LIB && defined DISTRIBUTE
80#if defined PARALLEL_IO && defined DISTRIBUTE
85 & tindex, gtype, Vsize, &
86 & LBi, UBi, LBj, UBj, LBk, UBk, LBt, UBt, &
92 & checksum)
RESULT (status)
98# if defined MASKING && defined READ_WATER
105 integer,
intent(in) :: ng, model, ncid, ncvarid, tindex, gtype
106 integer,
intent(in) :: lbi, ubi, lbj, ubj, lbk, ubk, lbt, ubt
107 integer,
intent(in) :: vsize(4)
109 integer(i8b),
intent(out),
optional :: checksum
111 real(dp),
intent(in) :: ascl
112 real(r8),
intent(out) :: amin
113 real(r8),
intent(out) :: amax
115 character (len=*),
intent(in) :: ncname
116 character (len=*),
intent(in) :: ncvname
120 real(r8),
intent(in) :: amask(lbi:,lbj:)
122 real(r8),
intent(out) :: adat(lbi:,lbj:,lbk:,lbt:)
125 real(r8),
intent(in) :: amask(lbi:ubi,lbj:ubj)
127 real(r8),
intent(out) :: adat(lbi:ubi,lbj:ubj,lbk:ubk,lbt:ubt)
133 logical,
dimension(3) :: foundit
135 integer :: i, ic, ij, j, jc, k, kc, l, lc, np, npts
136 integer :: imin, imax, isize, jmin, jmax, jsize, ijsize
137 integer :: istr, iend
138 integer :: ioff, joff, koff, loff
139 integer :: ilen, jlen, klen, llen, ijlen
140 integer :: cgrid, mytype, ghost, status, wtype
142 integer,
dimension(5) :: start, total
144 real(r8) :: afactor, aoffset, aspval
146 real(r8),
parameter :: inival= 0.0_r8
148 real(r8),
dimension(2) :: rbuffer
149 real(r8),
dimension(3) :: attvalue
151# if defined MASKING && defined READ_WATER
152 real(r8),
allocatable :: a2d(:)
154 real(r8),
allocatable :: wrk(:)
156 character (len= 3),
dimension(2) :: op_handle
157 character (len=12),
dimension(3) :: attname
159 character (len=*),
parameter :: myfile = &
160 & __FILE__//
", nf90_fread4d"
181 IF (model.eq.
iadm)
THEN
190 SELECT CASE (abs(mytype))
236 attname(1)=
'scale_factor'
237 attname(2)=
'add_offset '
238 attname(3)=
'_FillValue '
241 & attvalue, foundit, &
248 IF (.not.foundit(1))
THEN
254 IF (.not.foundit(2))
THEN
260 IF (.not.foundit(3))
THEN
268 IF (
PRESENT(checksum))
THEN
285 SELECT CASE (abs(mytype))
315 npts=ilen*jlen*klen*llen
319 IF (.not.
allocated(wrk))
THEN
320 allocate ( wrk(npts) )
337 status=nf90_get_var(ncid, ncvarid, wrk, start, total)
342 IF (status.eq.nf90_noerr)
THEN
346 IF (abs(wrk(i)).ge.abs(aspval))
THEN
349 wrk(i)=ascl*(afactor*wrk(i)+aoffset)
350 amin=min(amin,wrk(i))
351 amax=max(amax,wrk(i))
354 IF ((abs(amin).ge.abs(aspval)).and. &
355 & (abs(amax).ge.abs(aspval)))
THEN
366 CALL mp_reduce (ng, model, 2, rbuffer, op_handle)
378 adat(i,j,k,l)=wrk(ic)
389# if defined MASKING && defined READ_WATER
401 SELECT CASE (abs(mytype))
446 IF (.not.
allocated(a2d))
THEN
447 allocate ( a2d(ijsize) )
449 IF (.not.
allocated(wrk))
THEN
450 allocate ( wrk(npts) )
465 status=nf90_get_var(ncid, ncvarid, wrk(istr:), start, total)
470 IF (status.eq.nf90_noerr)
THEN
471 CALL mp_collect (ng, model, npts, inival, wrk)
479 IF (abs(wrk(i)).ge.abs(aspval))
THEN
482 wrk(i)=ascl*(afactor*wrk(i)+aoffset)
483 amin=min(amin,wrk(i))
484 amax=max(amax,wrk(i))
487 IF ((abs(amin).ge.abs(aspval)).and. &
488 & (abs(amax).ge.abs(aspval)))
THEN
498 lc=(l-loff)*ijlen*klen
503 ij=
scalars(ng)%IJwater(np,wtype)
510 adat(i,j,k,l)=a2d(ij)
526# if defined MASKING && defined READ_WATER
527 IF (
allocated(a2d))
THEN
532 IF (
allocated(wrk))
THEN
544 & ncvname, ncvarid, &
545 & tindex, gtype, Vsize, &
546 & LBi, UBi, LBj, UBj, LBk, UBk, LBt, UBt, &
547 & Ascl, Amin, Amax, &
552 & checksum)
RESULT (status)
568 integer,
intent(in) :: ng, model, ncid, ncvarid, tindex, gtype
569 integer,
intent(in) :: lbi, ubi, lbj, ubj, lbk, ubk, lbt, ubt
570 integer,
intent(in) :: vsize(4)
572 integer(i8b),
intent(out),
optional :: checksum
574 real(dp),
intent(in) :: ascl
575 real(r8),
intent(out) :: amin
576 real(r8),
intent(out) :: amax
578 character (len=*),
intent(in) :: ncname
579 character (len=*),
intent(in) :: ncvname
583 real(r8),
intent(in) :: amask(lbi:,lbj:)
585 real(r8),
intent(out) :: adat(lbi:,lbj:,lbk:,lbt:)
588 real(r8),
intent(in) :: amask(lbi:ubi,lbj:ubj)
590 real(r8),
intent(out) :: adat(lbi:ubi,lbj:ubj,lbk:ubk,lbt:ubt)
596 logical,
dimension(3) :: foundit
598 integer :: i, j, k, ic, fourth, npts, nwpts, status, wtype
599 integer :: is, ie, js, je
600 integer :: imin, imax, jmin, jmax
601 integer :: ilen, jlen, klen, ijlen, koff, loff
602 integer :: cgrid, mytype, ghost
606 integer,
dimension(5) :: start, total
608 real(r8) :: afactor, aoffset, aspval
610 real(r8),
dimension(3) :: attvalue
612 real(r8),
allocatable :: cwrk(:)
614# if defined INLINE_2DIO && defined DISTRIBUTE
615 real(r8),
dimension(2+(Lm(ng)+2)*(Mm(ng)+2)) :: wrk
617 real(r8),
dimension(2+(Lm(ng)+2)*(Mm(ng)+2)*(UBk-LBk+1)) :: wrk
620 character (len=12),
dimension(3) :: attname
622 character (len=*),
parameter :: myfile = &
623 & __FILE__//
", nf90_fread4d"
639 SELECT CASE (abs(mytype))
712 attname(1)=
'scale_factor'
713 attname(2)=
'add_offset '
714 attname(3)=
'_FillValue '
717 & attvalue, foundit, &
724 IF (.not.foundit(1))
THEN
730 IF (.not.foundit(2))
THEN
736 IF (.not.foundit(3))
THEN
752 IF (model.eq.
iadm)
THEN
759# if defined READ_WATER && defined MASKING
764 SELECT CASE (abs(mytype))
781 nwpts=(
lm(ng)+2)*(
mm(ng)+2)
782# if !(defined INLINE_2DIO && defined DISTRIBUTE)
794 IF (
PRESENT(checksum))
THEN
808 IF (mytype.gt.0)
THEN
820# if !(defined INLINE_2DIO && defined DISTRIBUTE)
823# if defined READ_WATER && defined MASKING
825 start(1)=1+(fourth+loff-1)*npts
831# if defined INLINE_2DIO && defined DISTRIBUTE
842 status=nf90_get_var(ncid, ncvarid, wrk, start, total)
843 IF (status.eq.nf90_noerr)
THEN
845 IF (abs(wrk(i)).ge.abs(aspval))
THEN
848 wrk(i)=ascl*(afactor*wrk(i)+aoffset)
849 amin=min(amin,wrk(i))
850 amax=max(amax,wrk(i))
853 IF ((abs(amin).ge.abs(aspval)).and. &
854 & (abs(amax).ge.abs(aspval)))
THEN
866 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
882 & nghost, mytype, amin, amax, &
883# if defined READ_WATER && defined MASKING
884 & nwpts,
scalars(ng)%IJwater(:,wtype), &
886 & npts, wrk, adat(:,:,k,fourth))
889 CALL mp_scatter3d (ng, model, lbi, ubi, lbj, ubj, lbk, ubk, &
890 & nghost, mytype, amin, amax, &
891# if defined READ_WATER && defined MASKING
892 & nwpts,
scalars(ng)%IJwater(:,wtype), &
894 & npts, wrk, adat(:,:,:,fourth))
901 IF (mytype.gt.0)
THEN
907 adat(i,j,k,fourth)=wrk(ic)
911# if defined MASKING || defined READ_WATER
917 IF (amask(i,j).gt.0.0_r8)
THEN
919 adat(i,j,k,fourth)=wrk(ic)
921 adat(i,j,k,fourth)=0.0_r8
937 npts=(imax-imin+1)*(jmax-jmin+1)*(ubk-lbk+1)*(ubt-lbt+1)
938 IF (.not.
allocated(cwrk))
allocate ( cwrk(npts) )
939 cwrk=pack(adat(imin:imax, jmin:jmax, lbk:ubk, lbt:ubt), .true.)
940 CALL get_hash (cwrk, npts, checksum, .true.)
942 npts=(ie-is+1)*(je-js+1)*(ubk-lbk+1)*(ubt-lbt+1)
943 IF (.not.
allocated(cwrk))
allocate ( cwrk(npts) )
944 cwrk=pack(adat(is:ie, js:je, lbk:ubk, lbt:ubt), .true.)
945 CALL get_hash (cwrk, npts, checksum)
947 IF (
allocated(cwrk))
deallocate (cwrk)
955#if defined PIO_LIB && defined DISTRIBUTE
960 & tindex, pioDesc, Vsize, &
961 & LBi, UBi, LBj, UBj, LBk, UBk, LBt, UBt, &
962 & Ascl, Amin, Amax, &
967 & checksum)
RESULT (status)
976 integer,
intent(in) :: ng, model, tindex
977 integer,
intent(in) :: lbi, ubi, lbj, ubj, lbk, ubk, lbt, ubt
978 integer,
intent(in) :: vsize(4)
980 integer(i8b),
intent(out),
optional :: checksum
982 real(dp),
intent(in) :: ascl
983 real(r8),
intent(out) :: amin
984 real(r8),
intent(out) :: amax
986 character (len=*),
intent(in) :: ncname
987 character (len=*),
intent(in) :: ncvname
991 real(r8),
intent(in) :: amask(lbi:,lbj:)
993 real(r8),
intent(out) :: adat(lbi:,lbj:,lbk:,lbt:)
996 real(r8),
intent(in) :: amask(lbi:ubi,lbj:ubj)
998 real(r8),
intent(out) :: adat(lbi:ubi,lbj:ubj,lbk:ubk,lbt:ubt)
1001 TYPE (file_desc_t),
intent(inout) :: piofile
1002 TYPE (io_desc_t),
intent(inout) :: piodesc
1007 logical :: lchecksum
1008 logical,
dimension(3) :: foundit
1010 integer :: i, j, k, l, npts, status
1011 integer :: is, ie, js, je
1012 integer :: imin, imax, jmin, jmax
1013 integer :: cgrid, ghost, dkind, gtype
1015 integer,
dimension(5) :: start, total
1017 real(r8) :: afactor, aoffset, aspval, avalue
1018 real(r8) :: my_amin, my_amax
1020 real(r8),
dimension(3) :: attvalue
1021 real(r8),
dimension(2) :: rbuffer
1023 real(r4),
pointer :: awrk4(:,:,:,:)
1024 real(r8),
pointer :: awrk8(:,:,:,:)
1025 real(r8),
allocatable :: cwrk(:)
1027 character (len=12),
dimension(3) :: attname
1028 character (len= 3),
dimension(2) :: op_handle
1030 character (len=*),
parameter :: myfile = &
1031 & __FILE__//
", pio_fread4d"
1050 SELECT CASE (abs(gtype))
1104 attname(1)=
'scale_factor'
1105 attname(2)=
'add_offset '
1106 attname(3)=
'_FillValue '
1109 & attvalue, foundit, &
1110 & piofile = piofile)
1116 IF (.not.foundit(1))
THEN
1122 IF (.not.foundit(2))
THEN
1128 IF (.not.foundit(3))
THEN
1136 IF (
PRESENT(checksum))
THEN
1151 IF (dkind.eq.pio_double)
THEN
1152 IF (.not.
associated(awrk8))
THEN
1153 allocate ( awrk8(imin:imax, jmin:jmax, lbk:ubk, lbt:ubt) )
1157 IF (.not.
associated(awrk4))
THEN
1158 allocate ( awrk4(imin:imax, jmin:jmax, lbk:ubk, lbt:ubt) )
1165 IF (tindex.gt.0)
THEN
1166 CALL pio_setframe (piofile, &
1168 & int(tindex, kind=pio_offset_kind))
1173 IF (dkind.eq.pio_double)
THEN
1174 CALL pio_read_darray (piofile, &
1177 & awrk8(imin:,jmin:,lbk:,lbt:), &
1184 IF (abs(awrk8(i,j,k,l)).ge.abs(aspval))
THEN
1185 adat(i,j,k,l)=0.0_r8
1187 avalue=ascl*(afactor*awrk8(i,j,k,l)+aoffset)
1188 adat(i,j,k,l)=avalue
1189 my_amin=min(my_amin,avalue)
1190 my_amax=max(my_amax,avalue)
1196 IF (
associated(awrk8))
deallocate (awrk8)
1201 CALL pio_read_darray (piofile, &
1204 & awrk4(imin:,jmin:,lbk:,lbt:), &
1211 IF (abs(awrk4(i,j,k,l)).ge.abs(aspval))
THEN
1212 adat(i,j,k,l)=0.0_r8
1214 avalue=real(ascl*(afactor*awrk4(i,j,k,l)+aoffset),r8)
1215 adat(i,j,k,l)=avalue
1216 my_amin=real(min(my_amin,avalue),r8)
1217 my_amax=real(max(my_amax,avalue),r8)
1223 IF (
associated(awrk4))
deallocate (awrk4)
1230 npts=(imax-imin+1)*(jmax-jmin+1)*(ubk-lbk+1)*(ubt-lbt+1)
1231 IF (.not.
allocated(cwrk))
allocate ( cwrk(npts) )
1232 cwrk=pack(adat(imin:imax, jmin:jmax, lbk:ubk, lbt:ubt), .true.)
1233 CALL get_hash (cwrk, npts, checksum, .true.)
1234 IF (
allocated(cwrk))
deallocate (cwrk)
1243 CALL mp_reduce (ng, model, 2, rbuffer, op_handle)
1247 IF ((abs(amin).ge.abs(
spval)).and. &
1248 & (abs(amax).ge.abs(
spval)))
THEN
subroutine mp_scatter3d(ng, model, lbi, ubi, lbj, ubj, lbk, ubk, nghost, gtype, amin, amax, nwpts, ij_water, npts, a, awrk)
subroutine mp_scatter2d(ng, model, lbi, ubi, lbj, ubj, nghost, gtype, amin, amax, nwpts, ij_water, npts, a, awrk)
subroutine, public tile_bounds_1d(ng, tile, imax, istr, iend)
subroutine, public get_hash(a, asize, hash, lreduce)
type(t_bounds), dimension(:), allocatable bounds
integer, parameter r3dvar
integer, parameter l4dvar
type(t_iobounds), dimension(:), allocatable iobounds
integer, parameter u3dvar
integer, dimension(:), allocatable lm
integer, parameter u2dvar
integer, parameter w3dvar
integer, parameter p2dvar
integer, dimension(:), allocatable mm
integer, parameter r2dvar
integer, parameter v2dvar
integer, parameter p3dvar
integer, parameter v3dvar
real(dp), parameter spval
real(dp), parameter spval_check
type(t_scalars), dimension(:), allocatable scalars
integer function pio_fread4d(ng, model, ncname, piofile, ncvname, piovar, tindex, piodesc, vsize, lbi, ubi, lbj, ubj, lbk, ubk, lbt, ubt, ascl, amin, amax, amask, adat, checksum)
integer function nf90_fread4d(ng, model, ncname, ncid, ncvname, ncvarid, tindex, gtype, vsize, lbi, ubi, lbj, ubj, lbk, ubk, lbt, ubt, ascl, amin, amax, amask, adat, checksum)
logical function, public founderror(flag, noerr, line, routine)