21#if defined PIO_LIB && defined DISTRIBUTE
27#if defined PIO_LIB && defined DISTRIBUTE
35#if defined PIO_LIB && defined DISTRIBUTE
79#if defined PIO_LIB && defined DISTRIBUTE
86#if defined PARALLEL_IO && defined DISTRIBUTE
90 & ncvarid, tindex, gtype, &
91 & LBi, UBi, LBj, UBj, Ascl, &
98 & MinValue, MaxValue)
RESULT (status)
103# if defined WRITE_WATER && defined MASKING
111 logical,
intent(in),
optional :: setfillval
113 integer,
intent(in) :: ng, model, ncid, ncvarid, tindex, gtype
114 integer,
intent(in) :: ifield
115 integer,
intent(in) :: lbi, ubi, lbj, ubj
117 integer,
intent(in),
optional :: extractfield
119 real(dp),
intent(in) :: ascl
123 real(r8),
intent(in) :: amask(lbi:,lbj:)
125 real(r8),
intent(in) :: adat(lbi:,lbj:)
128 real(r8),
intent(in) :: amask(lbi:ubi,lbj:ubj)
130 real(r8),
intent(in) :: adat(lbi:ubi,lbj:ubj)
132 real(r8),
intent(out),
optional :: minvalue
133 real(r8),
intent(out),
optional :: maxvalue
139 integer :: extract_flag
140 integer :: i, ic, j, jc, npts
141 integer :: imin, imax, jmin, jmax
142 integer :: ioff, joff
143 integer :: istr, iend
144 integer :: ilen, isize, jlen, jsize, ijlen
148 integer,
dimension(3) :: start, total
150 real(r8),
parameter :: inival = 0.0_r8
152 real(r8),
allocatable :: awrk(:)
165 SELECT CASE (abs(mytype))
210 IF (
PRESENT(setfillval))
THEN
222 IF (
PRESENT(extractfield))
THEN
223 extract_flag=extractfield
240 SELECT CASE (abs(mytype))
261 IF (.not.
allocated(awrk))
THEN
262 allocate ( awrk(npts) )
272 awrk(ic)=adat(i,j)*ascl
274 IF (abs(awrk(ic)).eq.0.0_r8)
THEN
279 IF ((amask(i,j).eq.0.0_r8).and.landfill)
THEN
295 status=nf90_put_var(ncid, ncvarid, awrk, start, total)
298# if defined WRITE_WATER && defined MASKING
308 SELECT CASE (abs(mytype))
329 IF (.not.
allocated(awrk))
THEN
330 allocate ( awrk(npts) )
342 awrk(ic)=adat(i,j)*ascl
344 IF (abs(awrk(ic)).eq.0.0_r8)
THEN
348 IF (amask(i,j).eq.0.0_r8)
THEN
356 CALL mp_collect (ng, model, npts, inival, awrk)
362 IF (awrk(i).lt.
spval)
THEN
379 status=nf90_put_var(ncid, ncvarid, awrk(istr:), start, total)
387 IF (
allocated(awrk))
THEN
399 & ncvarid, tindex, gtype, &
400 & LBi, UBi, LBj, UBj, Ascl, &
407 & MinValue, MaxValue)
RESULT (status)
422 logical,
intent(in),
optional :: setfillval
424 integer,
intent(in) :: ng, model, ncid, ncvarid, tindex, gtype
425 integer,
intent(in) :: ifield
426 integer,
intent(in) :: lbi, ubi, lbj, ubj
428 integer,
intent(in),
optional :: extractfield
430 real(dp),
intent(in) :: ascl
434 real(r8),
intent(in) :: amask(lbi:,lbj:)
436 real(r8),
intent(in) :: adat(lbi:,lbj:)
439 real(r8),
intent(in) :: amask(lbi:ubi,lbj:ubj)
441 real(r8),
intent(in) :: adat(lbi:ubi,lbj:ubj)
443 real(r8),
intent(out),
optional :: minvalue
444 real(r8),
intent(out),
optional :: maxvalue
450 integer :: extract_flag
451 integer :: npts, i, tile
454 integer,
dimension(3) :: start, total
456 real(r8),
dimension((Lm(ng)+2)*(Mm(ng)+2)) :: awrk
480 IF (
PRESENT(setfillval))
THEN
492 IF (
PRESENT(extractfield))
THEN
493 extract_flag=extractfield
502 stats % checksum=0_i8b
520 & gtype, ifield, tindex, &
521 & landfill, extract_flag, &
522 & lbi, ubi, lbj, ubj, &
527 & start, total, npts, awrk)
533 IF (
PRESENT(minvalue))
THEN
538 IF (abs(awrk(i)).lt.
spval)
THEN
539 minvalue=min(minvalue,awrk(i))
540 maxvalue=max(maxvalue,awrk(i))
551 status=nf90_put_var(ncid, ncvarid, awrk, start, total)
562 & lbi, ubi, lbj, ubj, &
569 WRITE (stdout,10) trim(
vname(1,ifield)), stats%min, stats%max, &
571 10
FORMAT (4x,
'- ',a,
':',t35,
'Min = ',1p,e15.8,
', Max = ', &
572 & 1p,e15.8,
', CheckSum = ',i0)
588#if defined PIO_LIB && defined DISTRIBUTE
592 & pioVar, tindex, pioDesc, &
593 & LBi, UBi, LBj, UBj, Ascl, &
600 & MinValue, MaxValue)
RESULT (status)
612 logical,
intent(in),
optional :: setfillval
614 integer,
intent(in) :: ng, model, tindex
615 integer,
intent(in) :: ifield
616 integer,
intent(in) :: lbi, ubi, lbj, ubj
618 integer,
intent(in),
optional :: extractfield
620 real(dp),
intent(in) :: ascl
624 real(r8),
intent(in) :: amask(lbi:,lbj:)
626 real(r8),
intent(in) :: adat(lbi:,lbj:)
629 real(r8),
intent(in) :: amask(lbi:ubi,lbj:ubj)
631 real(r8),
intent(in) :: adat(lbi:ubi,lbj:ubj)
633 real(r8),
intent(out),
optional :: minvalue
634 real(r8),
intent(out),
optional :: maxvalue
636 TYPE (file_desc_t),
intent(inout) :: piofile
637 TYPE (io_desc_t),
intent(inout) :: piodesc
638 TYPE (my_vardesc),
intent(inout) :: piovar
642 logical :: landfill, lminmax
644 logical,
pointer :: lwater(:,:)
646 integer :: extract_flag
647 integer :: i, j, tile
648 integer :: imin, imax, jmin, jmax
649 integer :: cgrid, dkind, ghost, gtype
652 integer,
dimension(3) :: start, total
654 real(r8),
dimension(2) :: rbuffer
656 real(r4),
pointer :: awrk4(:,:)
657 real(r8),
pointer :: awrk8(:,:)
664 character (len= 3),
dimension(2) :: op_handle
699 IF (
PRESENT(minvalue))
THEN
701 IF (.not.
associated(lwater))
THEN
702 allocate ( lwater(lbi:ubi,lbj:ubj) )
712 IF (
PRESENT(setfillval))
THEN
724 IF (
PRESENT(extractfield))
THEN
725 extract_flag=extractfield
734 stats % checksum=0_i8b
749 IF (dkind.eq.pio_double)
THEN
750 IF (.not.
associated(awrk8))
THEN
751 allocate ( awrk8(lbi:ubi,lbj:ubj) )
757 awrk8(i,j)=adat(i,j)*ascl
759 IF((amask(i,j).eq.0.0_r8).and.landfill)
THEN
761 IF (lminmax) lwater(i,j)=.false.
767 rbuffer(1)=minval(awrk8, mask=lwater)
768 rbuffer(2)=maxval(awrk8, mask=lwater)
771 IF (.not.
associated(awrk4))
THEN
772 allocate ( awrk4(lbi:ubi,lbj:ubj) )
778 awrk4(i,j)=real(adat(i,j)*ascl, r4)
781 IF((amask(i,j).eq.0.0_r8).and.landfill)
THEN
782 awrk4(i,j)=real(
spval, r4)
783 IF (lminmax) lwater(i,j)=.false.
789 rbuffer(1)=real(minval(awrk4, mask=lwater),r8)
790 rbuffer(2)=real(maxval(awrk4, mask=lwater),r8)
796 IF (tindex.gt.0)
THEN
797 CALL pio_setframe (piofile, &
799 & int(tindex, kind=pio_offset_kind))
804 IF (dkind.eq.pio_double)
THEN
805 CALL pio_write_darray (piofile, &
808 & awrk8(imin:imax,jmin:jmax), &
811 CALL pio_write_darray (piofile, &
814 & awrk4(imin:imax,jmin:jmax), &
831 & lbi, ubi, lbj, ubj, &
838 WRITE (stdout,10) trim(
vname(1,ifield)), stats%min, stats%max, &
840 10
FORMAT (4x,
'- ',a,
':',t35,
'Min = ',1p,e15.8,
', Max = ', &
841 & 1p,e15.8,
', CheckSum = ',i0)
852 CALL mp_reduce (ng, model, 2, rbuffer, op_handle)
855 IF (
associated(lwater))
deallocate (lwater)
860 IF (dkind.eq.pio_double)
THEN
861 IF (
associated(awrk8))
deallocate (awrk8)
863 IF (
associated(awrk4))
deallocate (awrk4)
subroutine mp_gather2d(ng, model, lbi, ubi, lbj, ubj, tindex, gtype, ascl, amask, a, npts, awrk, setfillval)
subroutine, public tile_bounds_1d(ng, tile, imax, istr, iend)
character(len=maxlen), dimension(6, 0:nv) vname
type(t_bounds), dimension(:), allocatable bounds
integer, parameter r3dvar
type(t_iobounds), dimension(:), allocatable iobounds
integer, parameter u3dvar
integer, parameter u2dvar
integer, parameter p2dvar
integer, parameter r2dvar
integer, parameter v2dvar
integer, parameter p3dvar
integer, parameter v3dvar
real(dp), parameter spval
integer function pio_fwrite2d(ng, model, piofile, ifield, piovar, tindex, piodesc, lbi, ubi, lbj, ubj, ascl, amask, adat, setfillval, extractfield, minvalue, maxvalue)
integer function nf90_fwrite2d(ng, model, ncid, ifield, ncvarid, tindex, gtype, lbi, ubi, lbj, ubj, ascl, amask, adat, setfillval, extractfield, minvalue, maxvalue)
subroutine, public pack_field2d(ng, model, tile, gtype, ifield, tindex, landfill, extract_flag, lbi, ubi, lbj, ubj, amask, ascl, adat, start, total, npts, awrk)
subroutine, public stats_2dfld(ng, tile, model, gtype, s, extract_flag, lbi, ubi, lbj, ubj, f, fmask, debug)