nf_fwrite3d_bry_mod::nf_fwrite3d_bry Interface Reference

Public Member Functions
integer function	nf90_fwrite3d_bry (ng, model, ncname, ncid, ncvname, ncvarid, tindex, gtype, lbij, ubij, lbk, ubk, nrec, ascl, abry, extractfield, minvalue, maxvalue)
integer function	pio_fwrite3d_bry (ng, model, ncname, piofile, ncvname, piovar, tindex, piodesc, lbij, ubij, lbk, ubk, nrec, ascl, abry, minvalue, maxvalue)

Detailed Description

Definition at line 81 of file nf_fwrite3d_bry.F.

Member Function/Subroutine Documentation

nf90_fwrite3d_bry()

integer function nf_fwrite3d_bry_mod::nf_fwrite3d_bry::nf90_fwrite3d_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), dimension(lbij:,lbk:,:,:), intent(in)	abry,
		integer, intent(in), optional	extractfield,
		real(r8), intent(out), optional	minvalue,
		real(r8), intent(out), optional	maxvalue )

Definition at line 91 of file nf_fwrite3d_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, intent(in), optional :: ExtractField
!
      real(dp), intent(in) :: Ascl
!
      character (len=*), intent(in) :: ncname
      character (len=*), intent(in) :: ncvname
!
# ifdef ASSUMED_SHAPE
      real(r8), intent(in) :: Abry(LBij:,LBk:,:,:)
# else
      real(r8), intent(in) :: Abry(LBij:UBij,LBk:UBk,4,Nrec)
# endif
      real(r8), intent(out), optional :: MinValue
      real(r8), intent(out), optional :: MaxValue
!
!  Local variable declarations.
!
      integer :: IorJ, IJKlen, Klen, Npts, i, tile
      integer :: Extract_Flag
      integer :: status
 
      integer, dimension(5) :: start, total
!
      real(r8), parameter :: Aspv = 0.0_r8
 
      real(r8), dimension((UBij-LBij+1)*(UBk-LBk+1)*4*Nrec) :: Awrk
!
!-----------------------------------------------------------------------
!  Initialize local variables.
!-----------------------------------------------------------------------
!
      status=nf90_noerr
!
!  Set parallel tile.
!
#  ifdef DISTRIBUTE
      tile=myrank
#  else
      tile=-1
#  endif
!
!  Set length of boundary data as the value of greater of I- or
!  j-dimension.
!
      iorj=iobounds(ng)%IorJ
      klen=ubk-lbk+1
      ijklen=iorj*klen
      npts=ijklen*4*nrec
!
!  If appropriate, set the field extraction flag to the provided grid
!  geometry through interpolation or decimation.
!
      IF (PRESENT(extractfield)) THEN
        extract_flag=extractfield
      ELSE
        extract_flag=0
      END IF
!
!  Initialize local array to avoid denormalized numbers. This
!  facilitates processing and debugging.
!
      awrk=0.0_r8
!
!-----------------------------------------------------------------------
!  Pack 2D boundary data into 1D array.
!-----------------------------------------------------------------------
!
      CALL pack_boundary3d (ng, model, tile,                            &
     &                      gtype, ncvname, tindex,                     &
     &                      extract_flag,                               &
     &                      lbij, ubij, lbk, ubk, nrec,                 &
     &                      ascl, abry,                                 &
     &                      start, total, npts, awrk)
!
!-----------------------------------------------------------------------
!  If applicable, compute output field minimum and maximum values.
!-----------------------------------------------------------------------
!
      IF (PRESENT(minvalue)) THEN
        IF (outthread) THEN
          minvalue=spval
          maxvalue=-spval
          DO i=1,npts
            IF (abs(awrk(i)).lt.spval) THEN
              minvalue=min(minvalue,awrk(i))
              maxvalue=max(maxvalue,awrk(i))
            END IF
          END DO
        END IF
      END IF
!
!-----------------------------------------------------------------------
!  Write output buffer into NetCDF file.
!-----------------------------------------------------------------------
!
      status=nf90_noerr
      IF (outthread) THEN
        status=nf90_put_var(ncid, ncvarid, awrk, start, total)
      END IF
 
# ifdef DISTRIBUTE
!
!-----------------------------------------------------------------------
!  Broadcast IO error flag to all nodes.
!-----------------------------------------------------------------------
!
      CALL mp_bcasti (ng, model, status)
# endif
!
      RETURN

References mod_param::iobounds, mod_parallel::myrank, mod_parallel::outthread, pack_field_mod::pack_boundary3d(), and mod_scalars::spval.

Here is the call graph for this function:

pio_fwrite3d_bry()

integer function nf_fwrite3d_bry_mod::nf_fwrite3d_bry::pio_fwrite3d_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), dimension(lbij:,lbk:,:,:), intent(in)	abry,
		real(r8), intent(out), optional	minvalue,
		real(r8), intent(out), optional	maxvalue )

Definition at line 222 of file nf_fwrite3d_bry.F.

!***********************************************************************
!
      USE mod_pio_netcdf
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, model, tindex
      integer, intent(in) :: LBij, UBij, LBk, UBk, Nrec
!
      real(dp), intent(in) :: Ascl
!
      character (len=*), intent(in) :: ncname
      character (len=*), intent(in) :: ncvname
!
#  ifdef ASSUMED_SHAPE
      real(r8), intent(in) :: Abry(LBij:,LBk:,:,:)
#  else
      real(r8), intent(in) :: Abry(LBij:UBij,LBk:UBk,4,Nrec)
#  endif
      real(r8), intent(out), optional :: MinValue
      real(r8), intent(out), optional :: MaxValue
!
      TYPE (File_desc_t), intent(inout) :: pioFile
      TYPE (IO_Desc_t),   intent(inout) :: pioDesc
      TYPE (My_VarDesc),  intent(inout) :: pioVar
!
!  Local variable declarations.
!
      logical, dimension(4) :: bounded
!
      integer :: bc, i, ib, ic, ir, j, k, kc, rc
      integer :: dkind, 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), parameter :: Aspv = 0.0_r8
 
      real(r8), dimension((UBij-LBij+1)*(UBk-LBk+1)*4*Nrec) :: Awrk
!
!-----------------------------------------------------------------------
!  Set starting and ending indices to process.
!-----------------------------------------------------------------------
!
      status=pio_noerr
!
!  Set tile starting and ending bounds.
!
      tile=myrank
      dkind=piovar%dkind
      gtype=piovar%gtype
!
      SELECT CASE (gtype)
        CASE (p2dvar, p3dvar)
          imin=bounds(ng)%Istr (tile)
          imax=bounds(ng)%Iend (tile)
          jmin=bounds(ng)%Jstr (tile)
          jmax=bounds(ng)%Jend (tile)
        CASE (r2dvar, r3dvar)
          imin=bounds(ng)%IstrR(tile)
          imax=bounds(ng)%IendR(tile)
          jmin=bounds(ng)%JstrR(tile)
          jmax=bounds(ng)%JendR(tile)
        CASE (u2dvar, u3dvar)
          imin=bounds(ng)%Istr (tile)
          imax=bounds(ng)%IendR(tile)
          jmin=bounds(ng)%JstrR(tile)
          jmax=bounds(ng)%JendR(tile)
        CASE (v2dvar, v3dvar)
          imin=bounds(ng)%IstrR(tile)
          imax=bounds(ng)%IendR(tile)
          jmin=bounds(ng)%Jstr (tile)
          jmax=bounds(ng)%JendR(tile)
        CASE DEFAULT
          imin=bounds(ng)%IstrR(tile)
          imax=bounds(ng)%IendR(tile)
          jmin=bounds(ng)%JstrR(tile)
          jmax=bounds(ng)%JendR(tile)
      END SELECT
!
      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
!
!-----------------------------------------------------------------------
!  Pack and scale output data.
!-----------------------------------------------------------------------
!
      awrk=aspv
!
      DO ir=1,nrec
        rc=(ir-1)*ijklen*4
        DO ib=1,4
          IF (bounded(ib)) THEN
            bc=(ib-1)*ijklen+rc
            IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
              DO k=lbk,ubk
                kc=(k-lbk)*iorj+bc
                DO j=jmin,jmax
                  ic=1+(j-lbij)+kc
                  awrk(ic)=abry(j,k,ib,ir)*ascl
#  ifdef POSITIVE_ZERO
                  IF (abs(awrk(ic)).eq.0.0_r8) THEN
                    awrk(ic)=0.0_r8               ! impose positive zero
                  END IF
#  endif
                END DO
              END DO
            ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
              DO k=lbk,ubk
                kc=(k-lbk)*iorj+bc
                DO i=imin,imax
                  ic=1+(i-lbij)+kc
                  awrk(ic)=abry(i,k,ib,ir)*ascl
#  ifdef POSITIVE_ZERO
                  IF (abs(awrk(ic)).eq.0.0_r8) THEN
                    awrk(ic)=0.0_r8               ! impose positive zero
                  END IF
#  endif
                END DO
              END DO
            END IF
          END IF
        END DO
      END DO
!
!  Collect data from all spawned processes.
!
      CALL mp_collect (ng, model, npts, aspv, awrk)
!
!-----------------------------------------------------------------------
!  If applicable, compute output field minimum and maximum values.
!-----------------------------------------------------------------------
!
      IF (PRESENT(minvalue)) THEN
        minvalue=spval
        maxvalue=-spval
        DO i=1,npts
          IF (abs(awrk(i)).lt.spval) THEN
            minvalue=min(minvalue,awrk(i))
            maxvalue=max(maxvalue,awrk(i))
          END IF
        END DO
      END IF
!
!-----------------------------------------------------------------------
!  Write output buffer into NetCDF file.
!-----------------------------------------------------------------------
!
      status=pio_put_var(piofile, piovar%vd, start, total, awrk)
!
      RETURN

References mod_param::bounds, mod_param::domain, mod_scalars::ieast, mod_scalars::inorth, mod_param::iobounds, mod_scalars::isouth, mod_scalars::iwest, mod_parallel::myrank, mod_param::p2dvar, mod_param::p3dvar, mod_param::r2dvar, mod_param::r3dvar, mod_scalars::spval, mod_param::u2dvar, mod_param::u3dvar, mod_param::v2dvar, and mod_param::v3dvar.

---

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

• ROMS/Utility/nf_fwrite3d_bry.F