nf_fread4d_mod::nf_fread4d Interface Reference

Public Member Functions
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)
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)

Detailed Description

Definition at line 71 of file nf_fread4d.F.

Member Function/Subroutine Documentation

nf90_fread4d()

integer function nf_fread4d_mod::nf_fread4d::nf90_fread4d	(	integer, intent(in)	ng,
		integer, intent(in)	model,
		character (len=*), intent(in)	ncname,
		integer, intent(in)	ncid,
		character (len=*), intent(in)	ncvname,
		integer, intent(in)	ncvarid,
		integer, intent(in)	tindex,
		integer, intent(in)	gtype,
		integer, dimension(4), intent(in)	vsize,
		integer, intent(in)	lbi,
		integer, intent(in)	ubi,
		integer, intent(in)	lbj,
		integer, intent(in)	ubj,
		integer, intent(in)	lbk,
		integer, intent(in)	ubk,
		integer, intent(in)	lbt,
		integer, intent(in)	ubt,
		real(dp), intent(in)	ascl,
		real(r8), intent(out)	amin,
		real(r8), intent(out)	amax,
		real(r8), dimension(lbi:,lbj:), intent(in)	amask,
		real(r8), dimension(lbi:,lbj:,lbk:,lbt:), intent(out)	adat,
		integer(i8b), intent(out), optional	checksum )

Definition at line 83 of file nf_fread4d.F.

!***********************************************************************
!
      USE mod_netcdf
!
      USE distribute_mod, ONLY : mp_bcasti, mp_reduce
# if defined MASKING && defined READ_WATER
      USE distribute_mod, ONLY : mp_collect
# endif
      USE get_bounds_mod, ONLY : tile_bounds_1d
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, model, ncid, ncvarid, tindex, gtype
      integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk, LBt, UBt
      integer, intent(in) :: Vsize(4)
!
      integer(i8b), intent(out), optional :: checksum
!
      real(dp), intent(in)  :: Ascl
      real(r8), intent(out) :: Amin
      real(r8), intent(out) :: Amax
!
      character (len=*), intent(in) :: ncname
      character (len=*), intent(in) :: ncvname
!
# ifdef ASSUMED_SHAPE
#  ifdef MASKING
      real(r8), intent(in) :: Amask(LBi:,LBj:)
#  endif
      real(r8), intent(out) :: Adat(LBi:,LBj:,LBk:,LBt:)
# else
#  ifdef MASKING
      real(r8), intent(in) :: Amask(LBi:UBi,LBj:UBj)
#  endif
      real(r8), intent(out) :: Adat(LBi:UBi,LBj:UBj,LBk:UBk,LBt:UBt)
# endif
!
!  Local variable declarations.
!
      logical :: Lchecksum
      logical, dimension(3) :: foundit
!
      integer :: i, ic, ij, j, jc, k, kc, l, lc, np, Npts
      integer :: Imin, Imax, Isize, Jmin, Jmax, Jsize, IJsize
      integer :: Istr, Iend
      integer :: Ioff, Joff, Koff, Loff
      integer :: Ilen, Jlen, Klen, Llen, IJlen
      integer :: Cgrid, MyType, ghost, status, wtype
 
      integer, dimension(5) :: start, total
!
      real(r8) :: Afactor, Aoffset, Aspval
 
      real(r8), parameter :: IniVal= 0.0_r8
 
      real(r8), dimension(2) :: rbuffer
      real(r8), dimension(3) :: AttValue
 
# if defined MASKING && defined READ_WATER
      real(r8), allocatable :: A2d(:)
# endif
      real(r8), allocatable :: wrk(:)
!
      character (len= 3), dimension(2) :: op_handle
      character (len=12), dimension(3) :: AttName
 
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__//", nf90_fread4d"
!
!-----------------------------------------------------------------------
!  Set starting and ending indices to process.
!-----------------------------------------------------------------------
!
      status=nf90_noerr
!
!  Set first and last grid point according to staggered C-grid
!  classification. Set the offsets for variables with starting
!  zero-index.  Recall the NetCDF does not support a zero-index.
!
!  Notice that (Imin,Jmin) and (Imax,Jmax) are the corner of the
!  computational tile. If ghost=0, ghost points are not processed.
!  They will be processed elsewhere by the appropriate call to any
!  of the routines in "mp_exchange.F".  If ghost=1, the ghost points
!  are read.
!
# ifdef NO_READ_GHOST
      ghost=0                        ! non-overlapping, no ghost points
# else
      IF (model.eq.iadm) THEN
        ghost=0                      ! non-overlapping, no ghost points
      ELSE
        ghost=1                      ! overlapping, read ghost points
      END IF
# endif
 
      mytype=gtype
 
      SELECT CASE (abs(mytype))
        CASE (p2dvar, p3dvar)
          cgrid=1
          isize=iobounds(ng)%xi_psi
          jsize=iobounds(ng)%eta_psi
        CASE (r2dvar, r3dvar, w3dvar)
          cgrid=2
          isize=iobounds(ng)%xi_rho
          jsize=iobounds(ng)%eta_rho
        CASE (u2dvar, u3dvar)
          cgrid=3
          isize=iobounds(ng)%xi_u
          jsize=iobounds(ng)%eta_u
        CASE (v2dvar, v3dvar)
          cgrid=4
          isize=iobounds(ng)%xi_v
          jsize=iobounds(ng)%eta_v
        CASE DEFAULT
          cgrid=2
          isize=iobounds(ng)%xi_rho
          jsize=iobounds(ng)%eta_rho
      END SELECT
 
      imin=bounds(ng)%Imin(cgrid,ghost,myrank)
      imax=bounds(ng)%Imax(cgrid,ghost,myrank)
      jmin=bounds(ng)%Jmin(cgrid,ghost,myrank)
      jmax=bounds(ng)%Jmax(cgrid,ghost,myrank)
 
      ilen=imax-imin+1
      jlen=jmax-jmin+1
      klen=ubk-lbk+1
      llen=ubt-lbt+1
!
!  Check if the following attributes: "scale_factor", "add_offset", and
!  "_FillValue" are present in the input NetCDF variable:
!
!  If the "scale_value" attribute is present, the data is multiplied by
!  this factor after reading.
!  If the "add_offset" attribute is present, this value is added to the
!  data after reading.
!  If both "scale_factor" and "add_offset" attributes are present, the
!  data are first scaled before the offset is added.
!  If the "_FillValue" attribute is present, the data having this value
!  is treated as missing and it is replaced with zero. This feature it
!  is usually related with the land/sea masking.
!
      attname(1)='scale_factor'
      attname(2)='add_offset  '
      attname(3)='_FillValue  '
 
      CALL netcdf_get_fatt (ng, model, ncname, ncvarid, attname,        &
     &                      attvalue, foundit,                          &
     &                      ncid = ncid)
      IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
        status=ioerror
        RETURN
      END IF
 
      IF (.not.foundit(1)) THEN
        afactor=1.0_r8
      ELSE
        afactor=attvalue(1)
      END IF
 
      IF (.not.foundit(2)) THEN
        aoffset=0.0_r8
      ELSE
        aoffset=attvalue(2)
      END IF
 
      IF (.not.foundit(3)) THEN
        aspval=spval_check
      ELSE
        aspval=attvalue(3)
      END IF
!
!  Initialize checsum value.
!
      IF (PRESENT(checksum)) THEN
        lchecksum=.true.
        checksum=0_i8b
      ELSE
        lchecksum=.false.
      END IF
!
!-----------------------------------------------------------------------
!  Parallel I/O: Read in tile data from requested field and scale it.
!                Processing both water and land points.
!-----------------------------------------------------------------------
!
      IF (gtype.gt.0) THEN
!
!  Set offsets due the NetCDF dimensions. Recall that some output
!  variables not always start at one.
!
        SELECT CASE (abs(mytype))
          CASE (p2dvar, p3dvar)
            ioff=0
            joff=0
          CASE (r2dvar, r3dvar, w3dvar)
            ioff=1
            joff=1
          CASE (u2dvar, u3dvar)
            ioff=0
            joff=1
          CASE (v2dvar, v3dvar)
            ioff=1
            joff=0
          CASE DEFAULT
            ioff=1
            joff=1
        END SELECT
 
        IF (lbk.eq.0) THEN
          koff=1
        ELSE
          koff=0
        END IF
 
        IF (lbt.eq.0) THEN
          loff=1
        ELSE
          loff=0
        END IF
 
        npts=ilen*jlen*klen*llen
!
!  Allocate scratch work array.
!
        IF (.not.allocated(wrk)) THEN
          allocate ( wrk(npts) )
          wrk=0.0_r8
        END IF
!
!  Read in data: all parallel nodes read their own tile data.
!
        start(1)=imin+ioff
        total(1)=ilen
        start(2)=jmin+joff
        total(2)=jlen
        start(3)=lbk+koff
        total(3)=klen
        start(4)=lbt+loff
        total(4)=llen
        start(5)=tindex
        total(5)=1
 
        status=nf90_get_var(ncid, ncvarid, wrk, start, total)
!
!  Scale read data and process fill values, if any.  Compute minimum
!  and maximum values.
!
        IF (status.eq.nf90_noerr) THEN
          amin=spval
          amax=-spval
          DO i=1,npts
            IF (abs(wrk(i)).ge.abs(aspval)) THEN
              wrk(i)=0.0_r8                   ! masked with _FillValue
            ELSE
              wrk(i)=ascl*(afactor*wrk(i)+aoffset)
              amin=min(amin,wrk(i))
              amax=max(amax,wrk(i))
            END IF
          END DO
          IF ((abs(amin).ge.abs(aspval)).and.                           &
     &        (abs(amax).ge.abs(aspval))) THEN
            amin=0.0_r8                       ! the entire data is all
            amax=0.0_r8                       ! field value, _FillValue
          END IF
!
!  Set minimum and maximum values: global reduction.
!
          rbuffer(1)=amin
          op_handle(1)='MIN'
          rbuffer(2)=amax
          op_handle(2)='MAX'
          CALL mp_reduce (ng, model, 2, rbuffer, op_handle)
          amin=rbuffer(1)
          amax=rbuffer(2)
!
!  Unpack read data.
!
          ic=0
          DO l=lbt,ubt
            DO k=lbk,ubk
              DO j=jmin,jmax
                DO i=imin,imax
                  ic=ic+1
                  adat(i,j,k,l)=wrk(ic)
                END DO
              END DO
            END DO
          END DO
        ELSE
          exit_flag=2
          ioerror=status
        END IF
      END IF
 
# if defined MASKING && defined READ_WATER
!
!-----------------------------------------------------------------------
!  Parallel I/O: Read in tile data from requested field and scale it.
!                Processing water points only.
!-----------------------------------------------------------------------
!
      IF (gtype.lt.0) THEN
!
!  Set number of points to process, grid type switch, and offsets due
!  array packing into 1D array in column-major order.
!
        SELECT CASE (abs(mytype))
          CASE (p3dvar)
            ijlen=iobounds(ng)%xy_psi
            wtype=p2dvar
            ioff=0
            joff=1
          CASE (r3dvar, w3dvar)
            ijlen=iobounds(ng)%xy_rho
            wtype=r2dvar
            ioff=1
            joff=0
          CASE (u3dvar)
            ijlen=iobounds(ng)%xy_u
            wtype=u2dvar
            ioff=0
            joff=0
          CASE (v3dvar)
            ijlen=iobounds(ng)%xy_v
            wtype=v2dvar
            ioff=1
            joff=1
          CASE DEFAULT
            ijlen=iobounds(ng)%xy_rho
            wtype=r2dvar
            ioff=1
            joff=0
        END SELECT
 
        IF (lbk.eq.0) THEN
          koff=0
        ELSE
          koff=1
        END IF
 
        IF (lbt.eq.0) THEN
          loff=1
        ELSE
          loff=0
        END IF
 
        npts=ijlen*klen*llen
        ijsize=isize*jsize
!
!  Allocate scratch work arrays.
!
        IF (.not.allocated(a2d)) THEN
          allocate ( a2d(ijsize) )
        END IF
        IF (.not.allocated(wrk)) THEN
          allocate ( wrk(npts) )
          wrk=inival
        END IF
!
!  Read in data: all parallel nodes read a segment of the 1D data.
!  Recall that water points are pack in the NetCDF file in a single
!  dimension.
!
        CALL tile_bounds_1d (ng, myrank, npts, istr, iend)
 
        start(1)=istr
        total(1)=iend-istr+1
        start(2)=1
        total(2)=tindex
 
        status=nf90_get_var(ncid, ncvarid, wrk(istr:), start, total)
!
!  Global reduction of work array.  We need this because the packing
!  of the water point only affects the model tile partition.
!
        IF (status.eq.nf90_noerr) THEN
          CALL mp_collect (ng, model, npts, inival, wrk)
!
!  Scale read data and process fill values, if any.  Compute minimum
!  and maximum values.
!
          amin=spval
          amax=-spval
          DO i=1,npts
            IF (abs(wrk(i)).ge.abs(aspval)) THEN
              wrk(i)=0.0_r8             ! set _FillValue to zero
            ELSE
              wrk(i)=ascl*(afactor*wrk(i)+aoffset)
              amin=min(amin,wrk(i))
              amax=max(amax,wrk(i))
            END IF
          END DO
          IF ((abs(amin).ge.abs(aspval)).and.                           &
     &        (abs(amax).ge.abs(aspval))) THEN
            amin=0.0_r8                       ! the entire data is all
            amax=0.0_r8                       ! field value, _FillValue
          END IF
!
!  Unpack read data.  This is tricky in parallel I/O.  The cheapeast
!  thing to do is reconstruct a packed 2D global array and then select
!  the appropriate values for the tile.
!
          DO l=lbt,ubt
            lc=(l-loff)*ijlen*klen
            DO k=lbk,ubk
              kc=(k-koff)*ijlen+lc
              a2d=inival
              DO np=1,ijlen
                ij=scalars(ng)%IJwater(np,wtype)
                a2d(ij)=wrk(np+kc)
              END DO
              DO j=jmin,jmax
                jc=(j-joff)*isize
                DO i=imin,imax
                  ij=i+ioff+jc
                  adat(i,j,k,l)=a2d(ij)
                END DO
              END DO
            END DO
          END DO
        ELSE
          exit_flag=2
          ioerror=status
        END IF
      END IF
# endif
!
!-----------------------------------------------------------------------
!  Deallocate scratch work vector.
!-----------------------------------------------------------------------
!
# if defined MASKING && defined READ_WATER
      IF (allocated(a2d)) THEN
        deallocate (a2d)
      END IF
# endif
 
      IF (allocated(wrk)) THEN
        deallocate (wrk)
      END IF
!
      RETURN

References mod_param::bounds, mod_scalars::exit_flag, strings_mod::founderror(), get_hash_mod::get_hash(), mod_param::iadm, mod_parallel::inpthread, mod_param::iobounds, mod_iounits::ioerror, mod_param::lm, mod_param::mm, distribute_mod::mp_scatter2d(), distribute_mod::mp_scatter3d(), mod_parallel::myrank, mod_param::nghostpoints, mod_scalars::noerror, mod_param::p2dvar, mod_param::p3dvar, mod_param::r2dvar, mod_param::r3dvar, mod_scalars::scalars, mod_scalars::spval, mod_scalars::spval_check, get_bounds_mod::tile_bounds_1d(), mod_param::u2dvar, mod_param::u3dvar, mod_param::v2dvar, mod_param::v3dvar, and mod_param::w3dvar.

Here is the call graph for this function:

pio_fread4d()

integer function nf_fread4d_mod::nf_fread4d::pio_fread4d	(	integer, intent(in)	ng,
		integer, intent(in)	model,
		character (len=*), intent(in)	ncname,
		type (file_desc_t), intent(inout)	piofile,
		character (len=*), intent(in)	ncvname,
		type (my_vardesc), intent(inout)	piovar,
		integer, intent(in)	tindex,
		type (io_desc_t), intent(inout)	piodesc,
		integer, dimension(4), intent(in)	vsize,
		integer, intent(in)	lbi,
		integer, intent(in)	ubi,
		integer, intent(in)	lbj,
		integer, intent(in)	ubj,
		integer, intent(in)	lbk,
		integer, intent(in)	ubk,
		integer, intent(in)	lbt,
		integer, intent(in)	ubt,
		real(dp), intent(in)	ascl,
		real(r8), intent(out)	amin,
		real(r8), intent(out)	amax,
		real(r8), dimension(lbi:,lbj:), intent(in)	amask,
		real(r8), dimension(lbi:,lbj:,lbk:,lbt:), intent(out)	adat,
		integer(i8b), intent(out), optional	checksum )

Definition at line 958 of file nf_fread4d.F.

!***********************************************************************
!
      USE mod_pio_netcdf
!
      USE distribute_mod, ONLY : mp_reduce
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, model, tindex
      integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk, LBt, UBt
      integer, intent(in) :: Vsize(4)
!
      integer(i8b), intent(out), optional :: checksum
!
      real(dp), intent(in)  :: Ascl
      real(r8), intent(out) :: Amin
      real(r8), intent(out) :: Amax
!
      character (len=*), intent(in) :: ncname
      character (len=*), intent(in) :: ncvname
!
# ifdef ASSUMED_SHAPE
#  ifdef MASKING
      real(r8), intent(in) :: Amask(LBi:,LBj:)
#  endif
      real(r8), intent(out) :: Adat(LBi:,LBj:,LBk:,LBt:)
# else
#  ifdef MASKING
      real(r8), intent(in) :: Amask(LBi:UBi,LBj:UBj)
#  endif
      real(r8), intent(out) :: Adat(LBi:UBi,LBj:UBj,LBk:UBk,LBt:UBt)
# endif
!
      TYPE (File_desc_t), intent(inout) :: pioFile
      TYPE (IO_Desc_t),   intent(inout) :: pioDesc
      TYPE (My_VarDesc),  intent(inout) :: pioVar
!
!  Local variable declarations.
!
      logical :: Lchecksum
      logical, dimension(3) :: foundit
!
      integer :: i, j, k, l, Npts, status
      integer :: Is, Ie, Js, Je
      integer :: Imin, Imax, Jmin, Jmax
      integer :: Cgrid, ghost, dkind, gtype
 
      integer, dimension(5) :: start, total
!
      real(r8) :: Afactor, Aoffset, Aspval, Avalue
      real(r8) :: my_Amin, my_Amax
 
      real(r8), dimension(3) :: AttValue
      real(r8), dimension(2) :: rbuffer
!
      real(r4), pointer :: Awrk4(:,:,:,:)        ! single precision
      real(r8), pointer :: Awrk8(:,:,:,:)        ! double precision
      real(r8), allocatable :: Cwrk(:)           ! used for checksum
!
      character (len=12), dimension(3) :: AttName
      character (len= 3), dimension(2) :: op_handle
 
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__//", pio_fread4d"
!
!-----------------------------------------------------------------------
!  Set starting and ending indices to process.
!-----------------------------------------------------------------------
!
      status=pio_noerr
      amin=spval
      amax=-spval
      my_amin=spval
      my_amax=-spval
!
!  Set global (interior plus boundary) starting and ending grid cell
!  indices in the I- and J-directions according to staggered C-grid
!  classification.
!
      dkind=piovar%dkind
      gtype=piovar%gtype
!
      SELECT CASE (abs(gtype))
        CASE (p2dvar, p3dvar)
          cgrid=1                                         ! PSI-points
          is=iobounds(ng)%ILB_psi
          ie=iobounds(ng)%IUB_psi
          js=iobounds(ng)%JLB_psi
          je=iobounds(ng)%JUB_psi
        CASE (l4dvar, r2dvar, r3dvar, w3dvar)
          cgrid=2                                         ! RHO-points
          is=iobounds(ng)%ILB_rho
          ie=iobounds(ng)%IUB_rho
          js=iobounds(ng)%JLB_rho
          je=iobounds(ng)%JUB_rho
        CASE (u2dvar, u3dvar)
          cgrid=3                                         ! U-points
          is=iobounds(ng)%ILB_u
          ie=iobounds(ng)%IUB_u
          js=iobounds(ng)%JLB_u
          je=iobounds(ng)%JUB_u
        CASE (v2dvar, v3dvar)
          cgrid=4                                         ! V-points
          is=iobounds(ng)%ILB_v
          ie=iobounds(ng)%IUB_v
          js=iobounds(ng)%JLB_v
          je=iobounds(ng)%JUB_v
        CASE DEFAULT
          cgrid=2                                         ! RHO-points
          is=iobounds(ng)%ILB_rho
          ie=iobounds(ng)%IUB_rho
          js=iobounds(ng)%JLB_rho
          je=iobounds(ng)%JUB_rho
      END SELECT
!
!  Set the tile computational I- and J-bounds (no ghost points).
!
      ghost=0
      imin=bounds(ng)%Imin(cgrid,ghost,myrank)
      imax=bounds(ng)%Imax(cgrid,ghost,myrank)
      jmin=bounds(ng)%Jmin(cgrid,ghost,myrank)
      jmax=bounds(ng)%Jmax(cgrid,ghost,myrank)
!
!  Check if the following attributes: "scale_factor", "add_offset", and
!  "_FillValue" are present in the input NetCDF variable:
!
!  If the "scale_value" attribute is present, the data is multiplied by
!  this factor after reading.
!  If the "add_offset" attribute is present, this value is added to the
!  data after reading.
!  If both "scale_factor" and "add_offset" attributes are present, the
!  data are first scaled before the offset is added.
!  If the "_FillValue" attribute is present, the data having this value
!  is treated as missing and it is replaced with zero. This feature it
!  is usually related with the land/sea masking.
!
      attname(1)='scale_factor'
      attname(2)='add_offset  '
      attname(3)='_FillValue  '
 
      CALL pio_netcdf_get_fatt (ng, model, ncname, piovar%vd, attname,  &
     &                          attvalue, foundit,                      &
     &                          piofile = piofile)
      IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
        status=ioerror
        RETURN
      END IF
 
      IF (.not.foundit(1)) THEN
        afactor=1.0_r8
      ELSE
        afactor=attvalue(1)
      END IF
 
      IF (.not.foundit(2)) THEN
        aoffset=0.0_r8
      ELSE
        aoffset=attvalue(2)
      END IF
 
      IF (.not.foundit(3)) THEN
        aspval=spval_check
      ELSE
        aspval=attvalue(3)
      END IF
!
!  Initialize checsum value.
!
      IF (PRESENT(checksum)) THEN
        lchecksum=.true.
        checksum=0_i8b
      ELSE
        lchecksum=.false.
      END IF
!
!-----------------------------------------------------------------------
!  Read in requested field and scale it.
!-----------------------------------------------------------------------
!
!  Allocate and initialize local array used for reading. The local array
!  needs to be of the same precision as "A" and its IO decomposition
!  descriptor "pioDesc".
!
      IF (dkind.eq.pio_double) THEN                 ! double precision
        IF (.not.associated(awrk8)) THEN
          allocate ( awrk8(imin:imax, jmin:jmax, lbk:ubk, lbt:ubt) )
        END IF
        awrk8=0.0_r8
      ELSE                                          ! single precision
        IF (.not.associated(awrk4)) THEN
          allocate ( awrk4(imin:imax, jmin:jmax, lbk:ubk, lbt:ubt) )
        END IF
        awrk4=0.0_r4
      END IF
!
!  Set unlimited time dimension record to write, if any.
!
      IF (tindex.gt.0) THEN
        CALL pio_setframe (piofile,                                     &
     &                     piovar%vd,                                   &
     &                     int(tindex, kind=pio_offset_kind))
      END IF
!
!  Read in double precision data from NetCDF file.
!
      IF (dkind.eq.pio_double) THEN
        CALL pio_read_darray (piofile,                                  &
     &                        piovar%vd,                                &
     &                        piodesc,                                  &
     &                        awrk8(imin:,jmin:,lbk:,lbt:),             &
     &                        status)
!
        DO l=lbt,ubt
          DO k=lbk,ubk
            DO j=jmin,jmax
              DO i=imin,imax
                IF (abs(awrk8(i,j,k,l)).ge.abs(aspval)) THEN
                  adat(i,j,k,l)=0.0_r8          ! masked with _FillValue
                ELSE
                  avalue=ascl*(afactor*awrk8(i,j,k,l)+aoffset)
                  adat(i,j,k,l)=avalue
                  my_amin=min(my_amin,avalue)
                  my_amax=max(my_amax,avalue)
                END IF
              END DO
            END DO
          END DO
        END DO
        IF (associated(awrk8)) deallocate (awrk8)
!
!  Read in and load single precision data from NetCDF file.
!
      ELSE
        CALL pio_read_darray (piofile,                                  &
     &                        piovar%vd,                                &
     &                        piodesc,                                  &
     &                        awrk4(imin:,jmin:,lbk:,lbt:),             &
     &                        status)
!
        DO l=lbt,ubt
          DO k=lbk,ubk
            DO j=jmin,jmax
              DO i=imin,imax
                IF (abs(awrk4(i,j,k,l)).ge.abs(aspval)) THEN
                  adat(i,j,k,l)=0.0_r8          ! masked with _FillValue
                ELSE
                  avalue=real(ascl*(afactor*awrk4(i,j,k,l)+aoffset),r8)
                  adat(i,j,k,l)=avalue
                  my_amin=real(min(my_amin,avalue),r8)
                  my_amax=real(max(my_amax,avalue),r8)
                END IF
              END DO
            END DO
          END DO
        END DO
        IF (associated(awrk4)) deallocate (awrk4)
      END IF
!
!  If requested, compute input data checksum value.
!  (TODO: parallel gathering of checksum)
!
      IF (lchecksum) THEN
        npts=(imax-imin+1)*(jmax-jmin+1)*(ubk-lbk+1)*(ubt-lbt+1)
        IF (.not.allocated(cwrk)) allocate ( cwrk(npts) )
        cwrk=pack(adat(imin:imax, jmin:jmax, lbk:ubk, lbt:ubt), .true.)
        CALL get_hash (cwrk, npts, checksum, .true.)
        IF (allocated(cwrk)) deallocate (cwrk)
      END IF
!
!  Compute global minimum and maximum values.
!
      rbuffer(1)=my_amin
      rbuffer(2)=my_amax
      op_handle(1)='MIN'
      op_handle(2)='MAX'
      CALL mp_reduce (ng, model, 2, rbuffer, op_handle)
      amin=rbuffer(1)
      amax=rbuffer(2)
!
      IF ((abs(amin).ge.abs(spval)).and.                                &
     &    (abs(amax).ge.abs(spval))) THEN
        amin=0.0_r8                           ! the entire data is all
        amax=0.0_r8                           ! field value, _FillValue
      END IF                                  ! and was zeroth out
!
      RETURN

References mod_param::bounds, mod_scalars::exit_flag, strings_mod::founderror(), get_hash_mod::get_hash(), mod_param::iobounds, mod_iounits::ioerror, mod_param::l4dvar, mod_parallel::myrank, mod_scalars::noerror, mod_param::p2dvar, mod_param::p3dvar, mod_param::r2dvar, mod_param::r3dvar, mod_scalars::spval, mod_scalars::spval_check, mod_param::u2dvar, mod_param::u3dvar, mod_param::v2dvar, mod_param::v3dvar, and mod_param::w3dvar.

Here is the call graph for this function:

---

The documentation for this interface was generated from the following file:

• ROMS/Utility/nf_fread4d.F