nf_fread3d_bry_mod::nf_fread3d_bry Interface Reference

Public Member Functions
integer function	nf90_fread3d_bry (ng, model, ncname, ncid, ncvname, ncvarid, tindex, gtype, lbij, ubij, lbk, ubk, nrec, ascl, amin, amax, abry, checksum)
integer function	pio_fread3d_bry (ng, model, ncname, piofile, ncvname, piovar, tindex, piodesc, lbij, ubij, lbk, ubk, nrec, ascl, amin, amax, abry, checksum)

Detailed Description

Definition at line 71 of file nf_fread3d_bry.F.

Member Function/Subroutine Documentation

nf90_fread3d_bry()

integer function nf_fread3d_bry_mod::nf_fread3d_bry::nf90_fread3d_bry	(	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, intent(in)	lbij,
		integer, intent(in)	ubij,
		integer, intent(in)	lbk,
		integer, intent(in)	ubk,
		integer, intent(in)	nrec,
		real(dp), intent(in)	ascl,
		real(r8), intent(out)	amin,
		real(r8), intent(out)	amax,
		real(r8), dimension(lbij:,:,:,:), intent(out)	abry,
		integer(i8b), intent(out), optional	checksum )

Definition at line 81 of file nf_fread3d_bry.F.

!***********************************************************************
!
      USE mod_netcdf
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, model, ncid, ncvarid, tindex, gtype
      integer, intent(in) :: LBij, UBij, LBk, UBk, Nrec
!
      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
      real(r8), intent(out) :: Abry(LBij:,:,:,:)
#else
      real(r8), intent(out) :: Abry(LBij:UBij,LBk:UBk,4,Nrec)
#endif
!
!  Local variable declarations.
!
      logical :: Lchecksum
      logical, dimension(3) :: foundit
      logical, dimension(4) :: bounded
!
      integer :: ghost, i, ib, ij, ir, j, k, tile
      integer :: IorJ, IJKlen, Imin, Imax, Jmin, Jmax, Klen, Npts
      integer :: Cgrid, Istr, Iend, Jstr, Jend
      integer, dimension(5) :: start, total
 
      integer :: status
!
      real(r8) :: Afactor, Aoffset, Aspval
!
      real(r8), allocatable :: Cwrk(:)           ! used for checksum
 
      real(r8), dimension(3) :: AttValue
 
#if !defined PARALLEL_IO && defined DISTRIBUTE
      real(r8), dimension(3) :: rbuffer
#endif
      real(r8), dimension(LBij:UBij,LBk:UBk,4,Nrec) :: wrk
!
      character (len=12), dimension(3) :: AttName
 
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__//", nf90_fread3d_bry"
!
!-----------------------------------------------------------------------
!  Set starting and ending indices to process.
!-----------------------------------------------------------------------
!
      status=nf90_noerr
!
!  Set first and last grid point according to staggered C-grid
!  classification.
!
!  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.
!
      IF (model.eq.iadm) THEN
        ghost=0                      ! non-overlapping, no ghost points
      ELSE
        ghost=1                      ! overlapping, read ghost points
      END IF
 
      SELECT CASE (gtype)
        CASE (p2dvar, p3dvar)
          cgrid=1
        CASE (r2dvar, r3dvar)
          cgrid=2
        CASE (u2dvar, u3dvar)
          cgrid=3
        CASE (v2dvar, v3dvar)
          cgrid=4
        CASE DEFAULT
          cgrid=2
      END SELECT
 
#ifdef DISTRIBUTE
      tile=myrank
      imin=bounds(ng)%Imin(cgrid,ghost,tile)
      imax=bounds(ng)%Imax(cgrid,ghost,tile)
      jmin=bounds(ng)%Jmin(cgrid,ghost,tile)
      jmax=bounds(ng)%Jmax(cgrid,ghost,tile)
#else
      tile=-1
      imin=lbij
      imax=ubij
      jmin=lbij
      jmax=ubij
#endif
      iorj=iobounds(ng)%IorJ
      klen=ubk-lbk+1
      ijklen=iorj*klen
      npts=ijklen*4*nrec
!
!  Get tile bounds.
!
      istr=bounds(ng)%Istr(tile)
      iend=bounds(ng)%Iend(tile)
      jstr=bounds(ng)%Jstr(tile)
      jend=bounds(ng)%Jend(tile)
!
!  Set switch to process boundary data by their associated tiles.
!
      bounded(iwest )=domain(ng)%Western_Edge (tile)
      bounded(ieast )=domain(ng)%Eastern_Edge (tile)
      bounded(isouth)=domain(ng)%Southern_Edge(tile)
      bounded(inorth)=domain(ng)%Northern_Edge(tile)
!
!  Set NetCDF dimension counters for processing requested field.
!
      start(1)=1
      total(1)=iorj
      start(2)=1
      total(2)=klen
      start(3)=1
      total(3)=4
      start(4)=1
      total(4)=nrec
      start(5)=tindex
      total(5)=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 a 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
!
!-----------------------------------------------------------------------
!  Read in requested data and scale it.
!-----------------------------------------------------------------------
!
      wrk=0.0_r8
 
      IF (inpthread) THEN
        status=nf90_get_var(ncid, ncvarid, wrk(lbij:,lbk:,:,:),         &
     &                      start, total)
        IF (status.eq.nf90_noerr) THEN
          amin=spval
          amax=-spval
          DO ir=1,nrec
            DO ib=1,4
              DO k=lbk,ubk
                DO ij=lbij,ubij
                  IF (abs(wrk(ij,k,ib,ir)).ge.abs(aspval)) THEN
                    wrk(ij,k,ib,ir)=0.0_r8
                  ELSE
                    wrk(ij,k,ib,ir)=ascl*                               &
     &                              (afactor*wrk(ij,k,ib,ir)+aoffset)
                    amin=min(amin,wrk(ij,k,ib,ir))
                    amax=max(amax,wrk(ij,k,ib,ir))
                  END IF
                END DO
              END DO
            END DO
          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
!
          IF (lchecksum) THEN
            npts=(ubij-lbij+1)*(ubk-lbk+1)*nrec*4
            IF (.not.allocated(cwrk)) allocate ( cwrk(npts) )
            cwrk=pack(wrk(lbij:ubij, lbk:ubk, 1:4, 1:nrec), .true.)
            CALL get_hash (cwrk, npts, checksum)
            IF (allocated(cwrk)) deallocate (cwrk)
          END IF
        END IF
      END IF
 
#if !defined PARALLEL_IO && defined DISTRIBUTE
!
      rbuffer(1)=real(status,r8)
      rbuffer(2)=amin
      rbuffer(3)=amax
      CALL mp_bcastf (ng, model, rbuffer)
      status=int(rbuffer(1))
      amin=rbuffer(2)
      amax=rbuffer(3)
#endif
!
      IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
        exit_flag=2
        ioerror=status
        RETURN
      END IF
 
#if !defined PARALLEL_IO && defined DISTRIBUTE
!
!  Broadcast data to all spawned nodes.
!
      CALL mp_bcastf (ng, model, wrk)
#endif
!
!-----------------------------------------------------------------------
!  Unpack read data.
!-----------------------------------------------------------------------
!
      abry=0.0_r8
 
      DO ir=1,nrec
        DO ib=1,4
          IF (bounded(ib)) THEN
            IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
              DO k=lbk,ubk
                DO j=jmin,jmax
                  abry(j,k,ib,ir)=wrk(j,k,ib,ir)
                END DO
              END DO
            ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
              DO k=lbk,ubk
                DO i=imin,imax
                  abry(i,k,ib,ir)=wrk(i,k,ib,ir)
                END DO
              END DO
            END IF
          END IF
        END DO
      END DO
!
      RETURN

References mod_param::bounds, mod_param::domain, mod_scalars::exit_flag, strings_mod::founderror(), get_hash_mod::get_hash(), mod_param::iadm, mod_scalars::ieast, mod_scalars::inorth, mod_parallel::inpthread, mod_param::iobounds, mod_iounits::ioerror, mod_scalars::isouth, mod_scalars::iwest, 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, and mod_param::v3dvar.

Here is the call graph for this function:

pio_fread3d_bry()

integer function nf_fread3d_bry_mod::nf_fread3d_bry::pio_fread3d_bry	(	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, intent(in)	lbij,
		integer, intent(in)	ubij,
		integer, intent(in)	lbk,
		integer, intent(in)	ubk,
		integer, intent(in)	nrec,
		real(dp), intent(in)	ascl,
		real(r8), intent(out)	amin,
		real(r8), intent(out)	amax,
		real(r8), dimension(lbij:,:,:,:), intent(out)	abry,
		integer(i8b), intent(out), optional	checksum )

Definition at line 371 of file nf_fread3d_bry.F.

!***********************************************************************
!
      USE mod_pio_netcdf
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, model, tindex
      integer, intent(in) :: LBij, UBij, LBk, UBk, Nrec
!
      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
      real(r8), intent(out) :: Abry(LBij:,:,:,:)
# else
      real(r8), intent(out) :: Abry(LBij:UBij,LBk:UBk,4,Nrec)
# 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
      logical, dimension(4) :: bounded
!
      integer :: i, ib, ij, ir, j, k
      integer :: Cgrid, dkind, ghost, gtype, tile
      integer :: IorJ, IJKlen, Imin, Imax, Jmin, Jmax, Klen, Npts
      integer :: Istr, Iend, Jstr, Jend
      integer, dimension(5) :: start, total
 
      integer :: status
!
      real(r8) :: Afactor, Aoffset, Aspval
!
      real(r8), allocatable :: Cwrk(:)           ! used for checksum
 
      real(r8), dimension(3) :: AttValue
 
      real(r8), allocatable :: wrk(:,:,:,:)
!
      character (len=12), dimension(3) :: AttName
 
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__//", pio_fread3d_bry"
!
!-----------------------------------------------------------------------
!  Set starting and ending indices to process.
!-----------------------------------------------------------------------
!
      status=pio_noerr
!
!  Set first and last grid point according to staggered C-grid
!  classification.
!
!  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.
!
      IF (model.eq.iadm) THEN
        ghost=0                      ! non-overlapping, no ghost points
      ELSE
        ghost=1                      ! overlapping, read ghost points
      END IF
      dkind=piovar%dkind
      gtype=piovar%gtype
!
      SELECT CASE (gtype)
        CASE (p2dvar, p3dvar)
          cgrid=1
        CASE (r2dvar, r3dvar)
          cgrid=2
        CASE (u2dvar, u3dvar)
          cgrid=3
        CASE (v2dvar, v3dvar)
          cgrid=4
        CASE DEFAULT
          cgrid=2
      END SELECT
!
      tile=myrank
      imin=bounds(ng)%Imin(cgrid,ghost,tile)
      imax=bounds(ng)%Imax(cgrid,ghost,tile)
      jmin=bounds(ng)%Jmin(cgrid,ghost,tile)
      jmax=bounds(ng)%Jmax(cgrid,ghost,tile)
!
      iorj=iobounds(ng)%IorJ
      klen=ubk-lbk+1
      ijklen=iorj*klen
      npts=ijklen*4*nrec
!
!  Get tile bounds.
!
      istr=bounds(ng)%Istr(tile)
      iend=bounds(ng)%Iend(tile)
      jstr=bounds(ng)%Jstr(tile)
      jend=bounds(ng)%Jend(tile)
!
!  Set switch to process boundary data by their associated tiles.
!
      bounded(iwest )=domain(ng)%Western_Edge (tile)
      bounded(ieast )=domain(ng)%Eastern_Edge (tile)
      bounded(isouth)=domain(ng)%Southern_Edge(tile)
      bounded(inorth)=domain(ng)%Northern_Edge(tile)
!
!  Set NetCDF dimension counters for processing requested field.
!
      start(1)=1
      total(1)=iorj
      start(2)=1
      total(2)=klen
      start(3)=1
      total(3)=4
      start(4)=1
      total(4)=nrec
      start(5)=tindex
      total(5)=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 a 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 data and scale it.
!-----------------------------------------------------------------------
!
      IF (.not.allocated(wrk)) THEN
        allocate ( wrk(0:iorj-1,lbk:ubk,4,nrec) )
        wrk=0.0_r8
      END IF
!
      status=pio_get_var(piofile, piovar%vd, start, total,              &
     &                   wrk(0:,lbk:,:,:))
      IF (status.eq.pio_noerr) THEN
        amin=spval
        amax=-spval
        DO ir=1,nrec
          DO ib=1,4
            DO k=lbk,ubk
              DO ij=0,iorj-1
                IF (abs(wrk(ij,k,ib,ir)).ge.abs(aspval)) THEN
                  wrk(ij,k,ib,ir)=0.0_r8
                ELSE
                  wrk(ij,k,ib,ir)=ascl*(afactor*wrk(ij,k,ib,ir)+aoffset)
                  amin=min(amin,wrk(ij,k,ib,ir))
                  amax=max(amax,wrk(ij,k,ib,ir))
                END IF
              END DO
            END DO
          END DO
        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
!
        IF (lchecksum) THEN
          npts=(ubij-lbij+1)*(ubk-lbk+1)*nrec*4
          IF (.not.allocated(cwrk)) allocate ( cwrk(npts) )
          cwrk=pack(wrk(lbij:ubij, lbk:ubk, 1:4, 1:nrec), .true.)
          CALL get_hash (cwrk, npts, checksum)
          IF (allocated(cwrk)) deallocate (cwrk)
        END IF
      END IF
!
      IF (founderror(status, pio_noerr, __line__, myfile)) THEN
        exit_flag=2
        ioerror=status
        RETURN
      END IF
!
!-----------------------------------------------------------------------
!  Unpack read data.
!-----------------------------------------------------------------------
!
      abry=0.0_r8
 
      DO ir=1,nrec
        DO ib=1,4
          IF (bounded(ib)) THEN
            IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
              DO k=lbk,ubk
                DO j=jmin,jmax
                  abry(j,k,ib,ir)=wrk(j,k,ib,ir)
                END DO
              END DO
            ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
              DO k=lbk,ubk
                DO i=imin,imax
                  abry(i,k,ib,ir)=wrk(i,k,ib,ir)
                END DO
              END DO
            END IF
          END IF
        END DO
      END DO
!
!  Deallocate local array.
!
      IF (allocated(wrk)) deallocate (wrk)
!
      RETURN

References mod_param::bounds, mod_param::domain, mod_scalars::exit_flag, strings_mod::founderror(), get_hash_mod::get_hash(), mod_param::iadm, mod_scalars::ieast, mod_scalars::inorth, mod_param::iobounds, mod_iounits::ioerror, mod_scalars::isouth, mod_scalars::iwest, 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, and mod_param::v3dvar.

Here is the call graph for this function:

---

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

• ROMS/Utility/nf_fread3d_bry.F