get_3dfldr.F File Reference

#include "cppdefs.h"

Include dependency graph for get_3dfldr.F:

Go to the source code of this file.

Functions/Subroutines
subroutine	get_3dfldr (ng, model, ifield, ncid, piofile, nfiles, s, update, lbi, ubi, lbj, ubj, lbk, ubk, iout, irec, fmask, fout)
subroutine	get_3dfldr_nf90 (ng, model, ifield, ncid, nfiles, s, update, lbi, ubi, lbj, ubj, lbk, ubk, iout, irec, fmask, fout)
subroutine	get_3dfldr_pio (ng, model, ifield, piofile, nfiles, s, update, lbi, ubi, lbj, ubj, lbk, ubk, iout, irec, fmask, fout)

Function/Subroutine Documentation

get_3dfldr()

subroutine get_3dfldr	(	integer, intent(in)	ng,
		integer, intent(in)	model,
		integer, intent(in)	ifield,
		integer, intent(inout)	ncid,
		type (file_desc_t), intent(inout)	piofile,
		integer, intent(in)	nfiles,
		type(t_io), dimension(nfiles), intent(inout)	s,
		logical, intent(out)	update,
		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)	iout,
		integer, intent(in)	irec,
		real(r8), dimension(lbi:ubi,lbj:ubj), intent(in)	fmask,
		real(r8), dimension(lbi:ubi,lbj:ubj,lbk:ubk,iout), intent(inout)	fout )

Definition at line 3 of file get_3dfldr.F.

!
!git $Id$
!================================================== Hernan G. Arango ===
!  Copyright (c) 2002-2025 The ROMS Group                              !
!    Licensed under a MIT/X style license                              !
!    See License_ROMS.md                                               !
!=======================================================================
!                                                                      !
!  This routine reads in requested 3D field (point or grided) from     !
!  specified NetCDF file. Backward time processing.                    !
!                                                                      !
!  On Input:                                                           !
!                                                                      !
!     ng         Nested grid number.                                   !
!     model      Calling model identifier.                             !
!     ifield     Field ID.                                             !
!     ncid       NetCDF file ID.                                       !
# if defined PIO_LIB && defined DISTRIBUTE
!     pioFile    PIO file descriptor structure, TYPE(file_desc_t)      !
!                  pioFile%fh         file handler                     !
!                  pioFile%iosystem   IO system descriptor (struct)    !
# endif
!     nfiles     Number of input NetCDF files.                         !
!     S          I/O derived type structure, TYPE(T_IO).               !
!     LBi        I-dimension Lower bound.                              !
!     UBi        I-dimension Upper bound.                              !
!     LBj        J-dimension Lower bound.                              !
!     UBj        J-dimension Upper bound.                              !
!     LBk        K-dimension Lower bound.                              !
!     UBk        K-dimension Upper bound.                              !
!     Iout       Size of the outer dimension,  if any.  Otherwise,     !
!                  Iout must be set to one by the calling program.     !
!     Irec       Number of 3D field records to read.                   !
!     Fmask      Land/Sea mask, if any.                                !
!                                                                      !
!  On Output:                                                          !
!                                                                      !
!     Fout       Read field.                                           !
!     update     Switch indicating reading of the requested field      !
!                  the current time step.                              !
!                                                                      !
!=======================================================================
!
      USE mod_param
      USE mod_parallel
      USE mod_iounits
      USE mod_ncparam
      USE mod_scalars
!
      USE strings_mod, ONLY : founderror
!
      implicit none
!
!  Imported variable declarations.
!
      logical, intent(out) :: update
!
      integer, intent(in) :: ng, model, ifield, nfiles
      integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
      integer, intent(in) :: Iout, Irec
      integer, intent(inout) :: ncid
!
# if defined PIO_LIB && defined DISTRIBUTE
      TYPE (File_desc_t), intent(inout) :: pioFile
# endif
      TYPE(T_IO), intent(inout) :: S(nfiles)
!
# ifdef MASKING
      real(r8), intent(in) :: Fmask(LBi:UBi,LBj:UBj)
# endif
      real(r8), intent(inout) :: Fout(LBi:UBi,LBj:UBj,LBk:UBk,Iout)
!
!  Local variable declarations.
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__
!
!-----------------------------------------------------------------------
!  Read in requested 3D field for backward time processing according
!  to IO type.
!-----------------------------------------------------------------------
!
      SELECT CASE (s(1)%IOtype)
        CASE (io_nf90)
          CALL get_3dfldr_nf90 (ng, model, ifield, ncid,                &
     &                          nfiles, s, update,                      &
     &                          lbi, ubi, lbj, ubj, lbk, ubk,           &
     &                          iout, irec,                             &
# ifdef MASKING
     &                          fmask,                                  &
# endif
     &                          fout)
 
# if defined PIO_LIB && defined DISTRIBUTE
        CASE (io_pio)
          CALL get_3dfldr_pio (ng, model, ifield, piofile,              &
     &                         nfiles, s, update,                       &
     &                         lbi, ubi, lbj, ubj, lbk, ubk,            &
     &                         iout, irec,                              &
#  ifdef MASKING
     &                         fmask,                                   &
#  endif
     &                         fout)
# endif
        CASE DEFAULT
          IF (master) WRITE (stdout,10) s(1)%IOtype
          exit_flag=2
      END SELECT
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
  10  FORMAT (' GET_3DFLDR - Illegal inpput type, io_type = ',i0,       &
     &        /,14x,'Check KeyWord ''INP_LIB'' in ''roms.in''.')
!
      RETURN

References mod_scalars::exit_flag, strings_mod::founderror(), get_3dfldr_nf90(), get_3dfldr_pio(), mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_parallel::master, mod_scalars::noerror, and mod_iounits::stdout.

Referenced by ad_get_data().

Here is the call graph for this function:

Here is the caller graph for this function:

get_3dfldr_nf90()

subroutine get_3dfldr_nf90	(	integer, intent(in)	ng,
		integer, intent(in)	model,
		integer, intent(in)	ifield,
		integer, intent(inout)	ncid,
		integer, intent(in)	nfiles,
		type(t_io), dimension(nfiles), intent(inout)	s,
		logical, intent(out)	update,
		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)	iout,
		integer, intent(in)	irec,
		real(r8), dimension(lbi:ubi,lbj:ubj), intent(in)	fmask,
		real(r8), dimension(lbi:ubi,lbj:ubj,lbk:ubk,iout), intent(inout)	fout )

Definition at line 131 of file get_3dfldr.F.

!***********************************************************************
!
      USE mod_param
      USE mod_parallel
      USE mod_iounits
      USE mod_ncparam
      USE mod_netcdf
      USE mod_scalars
!
      USE dateclock_mod,  ONLY : time_string
      USE inquiry_mod,    ONLY : inquiry
      USE nf_fread3d_mod, ONLY : nf_fread3d
      USE strings_mod,    ONLY : founderror
!
      implicit none
!
!  Imported variable declarations.
!
      logical, intent(out) :: update
!
      integer, intent(in) :: ng, model, ifield, nfiles
      integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
      integer, intent(in) :: Iout, Irec
      integer, intent(inout) :: ncid
!
      TYPE(T_IO), intent(inout) :: S(nfiles)
!
# ifdef MASKING
      real(r8), intent(in) :: Fmask(LBi:UBi,LBj:UBj)
# endif
      real(r8), intent(inout) :: Fout(LBi:UBi,LBj:UBj,LBk:UBk,Iout)
!
!  Local variable declarations.
!
      logical :: Lgridded, Linquire, Liocycle, Lmulti, Lonerec
!
      integer :: Nrec, Tid, Tindex, Trec, Vid, Vtype
      integer :: i, job, lend, lstr, lvar, status
      integer :: Vsize(4)
# ifdef CHECKSUM
      integer(i8b) :: Fhash
# endif
!
      real(r8) :: Fmax, Fmin, Fval, my_Fmin, my_Fmax
 
      real(dp) :: Clength, Tdelta, Tend
      real(dp) :: Tmax, Tmin, Tmono, Tscale, Tstr
      real(dp) :: Tsec, Tval
!
      character (len=22) :: t_code
 
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__//", get_3dfldr_nf90"
!
      sourcefile=myfile
!
!-----------------------------------------------------------------------
!  Initialize.
!-----------------------------------------------------------------------
!
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Determine if inquiring about the field to process in input NetCDF
!  file(s).  This usually happens on first call or when the field
!  time records are split (saved) in several multi-files.
!
      linquire=.false.
      lmulti=.false.
      IF (iic(ng).eq.0) linquire=.true.
      IF (.not.linquire.and.                                            &
     &    ((iinfo(10,ifield,ng).gt.1).and.                              &
     &     (linfo( 5,ifield,ng).or.                                     &
     &     (finfo( 1,ifield,ng)*day2sec.gt.time(ng))))) THEN
        linquire=.true.
        lmulti=.true.
      END IF
!
!  If appropriate, inquire about the contents of input NetCDF file and
!  fill information arrays.
!
!  Also, if appropriate, deactivate the Linfo(5,ifield,ng) switch after
!  the query for the LOWER snapshot interpolant from previous multifile
!  in the list. The switch was activated previously to indicate the
!  processing of the FIRST record of the file for the UPPER snapshot
!  interpolant.
!
      IF (linquire) THEN
        job=-3
        CALL inquiry (ng, model, job, iout, irec, 1, ifield, ncid,      &
     &                lmulti, nfiles, s)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        IF (linfo(5,ifield,ng)) THEN
          linfo(5,ifield,ng)=.false.
        END IF
      END IF
!
!-----------------------------------------------------------------------
!  If appropriate, read in new data.
!-----------------------------------------------------------------------
!
# ifdef CHECKSUM
      fhash=0_i8b
# endif
      update=.false.
      tmono=finfo(7,ifield,ng)
!
      IF ((tmono.gt.time(ng)).or.(iic(ng).eq.0).or.                     &
     &    (iic(ng).eq.ntstart(ng))) THEN
!
!  Load properties for requested field from information arrays.
!
        lgridded=linfo(1,ifield,ng)
        liocycle=linfo(2,ifield,ng)
        lonerec =linfo(3,ifield,ng)
        vtype   =iinfo(1,ifield,ng)
        vid     =iinfo(2,ifield,ng)
        tid     =iinfo(3,ifield,ng)
        nrec    =iinfo(4,ifield,ng)
        vsize(1)=iinfo(5,ifield,ng)
        vsize(2)=iinfo(6,ifield,ng)
        vsize(3)=iinfo(7,ifield,ng)
        tindex  =iinfo(8,ifield,ng)
        trec    =iinfo(9,ifield,ng)
        tmin    =finfo(1,ifield,ng)
        tmax    =finfo(2,ifield,ng)
        clength =finfo(5,ifield,ng)
        tscale  =finfo(6,ifield,ng)
        ncfile  =cinfo(ifield,ng)
!
        IF (liocycle) THEN
          trec=mod(trec,nrec)-1
          IF (trec.le.0) trec=nrec+trec
        ELSE
          trec=trec-1
        END IF
        iinfo(9,ifield,ng)=trec
!
        IF ((1.le.trec).and.(trec.le.nrec)) THEN
!
!  Set rolling index for two-time record storage of input data.  If
!  "Iout" is unity, input data is stored in timeless array by the
!  calling program.  If Irec > 1, this routine is used to read a 3D
!  field varying in another non-time dimension.
!
          IF (irec.eq.1) THEN
            IF (iout.eq.1) THEN
              tindex=1
            ELSE
              tindex=3-tindex
            END IF
            iinfo(8,ifield,ng)=tindex
          END IF
!
!  Read in time coordinate and scale it to day units.
!
          IF (tid.ge.0) THEN
            CALL netcdf_get_time (ng, model, ncfile, tname(ifield),     &
     &                            rclock%DateNumber, tval,              &
     &                            ncid = ncid,                          &
     &                            start = (/trec/),                     &
     &                            total = (/1/))
            IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
              IF (master) WRITE (stdout,40) trim(tname(ifield)), trec
              RETURN
            END IF
          END IF
          tval=tval*tscale
          vtime(tindex,ifield,ng)=tval
!
!  Activate switch Linfo(5,ifield,ng) if processing the FIRST record of
!  the file for the UPPER time snapshot. We need to get the LOWER time
!  snapshot from previous multifile.
!
          IF ((trec.eq.1).and.(tval*day2sec.ge.time(ng))) THEN
            linfo(5,ifield,ng)=.true.
          END IF
!
!  Read in 3D-grided or point data.
!
          IF (vid.ge.0) THEN
            IF (lgridded) THEN
              fmin=spval
              fmax=-spval
              IF (irec.gt.1) THEN
                DO i=1,irec
                  status=nf_fread3d(ng, model, ncfile, ncid,            &
     &                              vname(1,ifield), vid,               &
     &                              i, vtype, vsize,                    &
     &                              lbi, ubi, lbj, ubj, lbk, ubk,       &
     &                              fscale(ifield,ng),                  &
     &                              my_fmin, my_fmax,                   &
# ifdef MASKING
     &                              fmask,                              &
# endif
# ifdef CHECKSUM
     &                              fout(:,:,:,i),                      &
     &                              checksum = fhash)
# else
     &                              fout(:,:,:,i))
# endif
                  fmin=min(fmin,my_fmin)
                  fmax=max(fmax,my_fmax)
                END DO
                finfo(8,ifield,ng)=fmin
                finfo(9,ifield,ng)=fmax
              ELSE
                status=nf_fread3d(ng, model, ncfile, ncid,              &
     &                            vname(1,ifield), vid,                 &
     &                            trec, vtype, vsize,                   &
     &                            lbi, ubi, lbj, ubj, lbk, ubk,         &
     &                            fscale(ifield,ng), fmin, fmax,        &
# ifdef MASKING
     &                            fmask,                                &
# endif
# ifdef CHECKSUM
     &                            fout(:,:,:,tindex),                   &
     &                            checksum = fhash)
# else
     &                            fout(:,:,:,tindex))
# endif
                finfo(8,ifield,ng)=fmin
                finfo(9,ifield,ng)=fmax
              END IF
            ELSE
              CALL netcdf_get_fvar (ng, model, ncfile, vname(1,ifield), &
     &                              fval,                               &
     &                              ncid = ncid,                        &
     &                              start = (/trec/),                   &
     &                              total = (/1/))
              fval=fval*fscale(ifield,ng)
              fpoint(tindex,ifield,ng)=fval
              fmin=fval
              fmax=fval
            END IF
            IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
              IF (master) THEN
                WRITE (stdout,40) trim(vname(1,ifield)), trec
              END IF
              RETURN
            END IF
            IF (master) THEN
              IF (irec.gt.1) THEN
                WRITE (stdout,50) trim(vname(2,ifield)), ng, fmin, fmax
              ELSE
                lstr=scan(ncfile,'/',back=.true.)+1
                lend=len_trim(ncfile)
                lvar=min(46,len_trim(vname(2,ifield)))
                tsec=tval*day2sec
                CALL time_string (tsec, t_code)
                WRITE (stdout,60) vname(2,ifield)(1:lvar), t_code,      &
     &                            ng, trec, tindex, ncfile(lstr:lend),  &
     &                            tmin, tmax, tval, fmin, fmax
              END IF
#ifdef CHECKSUM
              WRITE (stdout,70) fhash
#endif
            END IF
            update=.true.
          END IF
        END IF
!
!  Decrease the local time variable "Tmono" by the interval between
!  snapshots. If the interval is negative, indicating cycling, add in
!  a cycle length.  Load time value (sec) into "Tintrp" which used
!  during interpolation between snapshots.
!
        IF (.not.lonerec) THEN
          tdelta=vtime(3-tindex,ifield,ng)-vtime(tindex,ifield,ng)
          IF (liocycle.and.(tdelta.lt.0.0_r8)) THEN
            tdelta=tdelta+clength
          END IF
          tmono=tmono-tdelta*day2sec
          finfo(7,ifield,ng)=tmono
          tintrp(tindex,ifield,ng)=tmono
        END IF
      END IF
!
  10  FORMAT (/,' GET_3DFLDR_NF90 - unable to find dimension ',a,       &
     &        /,19x,'for variable: ',a,/,19x,'in file: ',a,             &
     &        /,19x,'file is not CF compliant...')
  20  FORMAT (/,' GET_3DFLDR_NF90  - unable to find requested',         &
     &        ' variable: ',a,/,19x,'in input NetCDF file: ',a)
  30  FORMAT (/,' GET_3DFLDR_NF90 - unable to open input NetCDF',       &
     &        ' file: ',a)
  40  FORMAT (/,' GET_3DFLDR_NF90 - error while reading variable: ',a,  &
     &        2x,' at TIME index = ',i0)
  50  FORMAT (2x,'GET_3DFLDR_NF90  - ',a,/,22x,'(Grid = ',i2.2,         &
     &        ', Min = ',1p,e15.8,0p,' Max = ',1p,e15.8,0p,')')
  60  FORMAT (2x,'GET_3DFLDR_NF90  - ',a,',',t75,a,/,22x,               &
     &        '(Grid=',i2.2,', Rec=',i0,', Index=',i1,                  &
     &        ', File: ',a,')',/,22x,                                   &
     &        '(Tmin= ', f15.4, ' Tmax= ', f15.4,')',                   &
     &        t71, 't = ', f15.4 ,/,22x,                                &
     &        '(Min = ', 1p,e15.8,0p,' Max = ',1p,e15.8,0p,')')
# ifdef CHECKSUM
  70  FORMAT (22x,'(CheckSum = ',i0,')')
# endif
!
      RETURN

References mod_ncparam::cinfo, mod_scalars::day2sec, mod_scalars::exit_flag, mod_ncparam::finfo, strings_mod::founderror(), mod_ncparam::fpoint, mod_ncparam::fscale, mod_scalars::iic, mod_ncparam::iinfo, mod_ncparam::linfo, mod_parallel::master, mod_iounits::ncfile, mod_scalars::noerror, mod_scalars::ntstart, mod_scalars::rclock, mod_iounits::sourcefile, mod_scalars::spval, mod_iounits::stdout, mod_scalars::time, dateclock_mod::time_string(), mod_ncparam::tintrp, mod_ncparam::tname, mod_ncparam::vname, and mod_ncparam::vtime.

Referenced by get_3dfldr().

Here is the call graph for this function:

Here is the caller graph for this function:

get_3dfldr_pio()

subroutine get_3dfldr_pio	(	integer, intent(in)	ng,
		integer, intent(in)	model,
		integer, intent(in)	ifield,
		type (file_desc_t), intent(inout)	piofile,
		integer, intent(in)	nfiles,
		type(t_io), dimension(nfiles), intent(inout)	s,
		logical, intent(out)	update,
		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)	iout,
		integer, intent(in)	irec,
		real(r8), dimension(lbi:ubi,lbj:ubj), intent(in)	fmask,
		real(r8), dimension(lbi:ubi,lbj:ubj,lbk:ubk,iout), intent(inout)	fout )

Definition at line 443 of file get_3dfldr.F.

!***********************************************************************
!
      USE mod_param
      USE mod_parallel
      USE mod_iounits
      USE mod_ncparam
      USE mod_pio_netcdf
      USE mod_scalars
!
      USE dateclock_mod,  ONLY : time_string
      USE inquiry_mod,    ONLY : inquiry
      USE nf_fread3d_mod, ONLY : nf_fread3d
      USE strings_mod,    ONLY : founderror
!
      implicit none
!
!  Imported variable declarations.
!
      logical, intent(out) :: update
!
      integer, intent(in) :: ng, model, ifield, nfiles
      integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
      integer, intent(in) :: Iout, Irec
!
      TYPE (File_desc_t), intent(inout) :: pioFile
      TYPE(T_IO), intent(inout) :: S(nfiles)
!
#  ifdef MASKING
      real(r8), intent(in) :: Fmask(LBi:UBi,LBj:UBj)
#  endif
      real(r8), intent(inout) :: Fout(LBi:UBi,LBj:UBj,LBk:UBk,Iout)
!
!  Local variable declarations.
!
      logical :: Lgridded, Linquire, Liocycle, Lmulti, Lonerec
!
      integer :: Nrec, Tindex, Trec, Vtype
      integer :: i, job, lend, lstr, lvar, status
      integer :: Vsize(4)
#  ifdef CHECKSUM
      integer(i8b) :: Fhash
#  endif
!
      real(r8) :: Fmax, Fmin, Fval, my_Fmin, my_Fmax
 
      real(dp) :: Clength, Tdelta, Tend
      real(dp) :: Tmax, Tmin, Tmono, Tscale, Tstr
      real(dp) :: Tsec, Tval
!
      character (len=22) :: t_code
 
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__//", get_3dfldr_pio"
!
      TYPE (IO_Desc_t), pointer :: ioDesc
      TYPE (My_VarDesc) :: TpioVar, VpioVar
!
      sourcefile=myfile
!
!-----------------------------------------------------------------------
!  Initialize.
!-----------------------------------------------------------------------
!
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Determine if inquiring about the field to process in input NetCDF
!  file(s).  This usually happens on first call or when the field
!  time records are split (saved) in several multi-files.
!
      linquire=.false.
      lmulti=.false.
      IF (iic(ng).eq.0) linquire=.true.
      IF (.not.linquire.and.                                            &
     &    ((iinfo(10,ifield,ng).gt.1).and.                              &
     &     (linfo( 5,ifield,ng).or.                                     &
     &     (finfo( 1,ifield,ng)*day2sec.gt.time(ng))))) THEN
        linquire=.true.
        lmulti=.true.
      END IF
!
!  If appropriate, inquire about the contents of input NetCDF file and
!  fill information arrays.
!
!  Also, if appropriate, deactivate the Linfo(5,ifield,ng) switch after
!  the query for the LOWER snapshot interpolant from previous multifile
!  in the list. The switch was activated previously to indicate the
!  processing of the FIRST record of the file for the UPPER snapshot
!  interpolant.
!
      IF (linquire) THEN
        job=-3
        CALL inquiry (ng, model, job, iout, irec, 1, ifield, piofile,   &
     &                lmulti, nfiles, s)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        IF (linfo(5,ifield,ng)) THEN
          linfo(5,ifield,ng)=.false.
        END IF
      END IF
!
!-----------------------------------------------------------------------
!  If appropriate, read in new data.
!-----------------------------------------------------------------------
!
#  ifdef CHECKSUM
      fhash=0_i8b
#  endif
      update=.false.
      tmono=finfo(7,ifield,ng)
!
      IF ((tmono.gt.time(ng)).or.(iic(ng).eq.0).or.                     &
     &    (iic(ng).eq.ntstart(ng))) THEN
!
!  Load properties for requested field from information arrays.
!
        lgridded=linfo(1,ifield,ng)
        liocycle=linfo(2,ifield,ng)
        lonerec =linfo(3,ifield,ng)
        vtype   =iinfo(1,ifield,ng)
        vpiovar =dinfo(1,ifield,ng)
        tpiovar =dinfo(2,ifield,ng)
        nrec    =iinfo(4,ifield,ng)
        vsize(1)=iinfo(5,ifield,ng)
        vsize(2)=iinfo(6,ifield,ng)
        vsize(3)=iinfo(7,ifield,ng)
        tindex  =iinfo(8,ifield,ng)
        trec    =iinfo(9,ifield,ng)
        tmin    =finfo(1,ifield,ng)
        tmax    =finfo(2,ifield,ng)
        clength =finfo(5,ifield,ng)
        tscale  =finfo(6,ifield,ng)
        ncfile  =cinfo(ifield,ng)
!
        IF (liocycle) THEN
          trec=mod(trec,nrec)-1
          IF (trec.le.0) trec=nrec+trec
        ELSE
          trec=trec-1
        END IF
        iinfo(9,ifield,ng)=trec
!
        IF ((1.le.trec).and.(trec.le.nrec)) THEN
!
!  Set rolling index for two-time record storage of input data.  If
!  "Iout" is unity, input data is stored in timeless array by the
!  calling program.  If Irec > 1, this routine is used to read a 3D
!  field varying in another non-time dimension.
!
          IF (irec.eq.1) THEN
            IF (iout.eq.1) THEN
              tindex=1
            ELSE
              tindex=3-tindex
            END IF
            iinfo(8,ifield,ng)=tindex
          END IF
!
!  Read in time coordinate and scale it to day units.
!
          IF (tpiovar%vd%varID.ge.0) THEN
            CALL pio_netcdf_get_time (ng, model, ncfile, tname(ifield), &
     &                                rclock%DateNumber, tval,          &
     &                                piofile = piofile,                &
     &                                start = (/trec/),                 &
     &                                total = (/1/))
            IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
              IF (master) WRITE (stdout,40) trim(tname(ifield)), trec
              RETURN
            END IF
          END IF
          tval=tval*tscale
          vtime(tindex,ifield,ng)=tval
!
!  Activate switch Linfo(5,ifield,ng) if processing the FIRST record of
!  the file for the UPPER time snapshot. We need to get the LOWER time
!  snapshot from previous multifile.
!
          IF ((trec.eq.1).and.(tval*day2sec.ge.time(ng))) THEN
            linfo(5,ifield,ng)=.true.
          END IF
!
!  Read in 3D-grided or point data.
!
          IF (vpiovar%vd%varID.ge.0) THEN
            SELECT CASE (vtype)
#  ifdef SEDIMENT
              CASE (b3dvar)
                IF (kind(fout).eq.8) THEN
                  iodesc => iodesc_dp_b3dvar(ng)
                ELSE
                  iodesc => iodesc_sp_b3dvar(ng)
                END IF
#  endif
#  if defined DIAGNOSTICS_BIO && defined ECOSIM
              CASE (l3dvar)
                IF (kind(fout).eq.8) THEN
                  iodesc => iodesc_dp_l3dvar(ng)
                ELSE
                  iodesc => iodesc_sp_l3dvar(ng)
                END IF
#  endif
              CASE (p3dvar)
                IF (kind(fout).eq.8) THEN
                  iodesc => iodesc_dp_p3dvar(ng)
                ELSE
                  iodesc => iodesc_sp_p3dvar(ng)
                END IF
              CASE (r3dvar)
                IF (kind(fout).eq.8) THEN
                  iodesc => iodesc_dp_r3dvar(ng)
                ELSE
                  iodesc => iodesc_sp_r3dvar(ng)
                END IF
              CASE (u3dvar)
                IF (kind(fout).eq.8) THEN
                  iodesc => iodesc_dp_u3dvar(ng)
                ELSE
                  iodesc => iodesc_sp_u3dvar(ng)
                END IF
              CASE (v3dvar)
                IF (kind(fout).eq.8) THEN
                  iodesc => iodesc_dp_v3dvar(ng)
                ELSE
                  iodesc => iodesc_sp_v3dvar(ng)
                END IF
              CASE (w3dvar)
                IF (kind(fout).eq.8) THEN
                  iodesc => iodesc_dp_w3dvar(ng)
                ELSE
                  iodesc => iodesc_sp_w3dvar(ng)
                END IF
            END SELECT
!
            IF (lgridded) THEN
              fmin=spval
              fmax=-spval
              IF (irec.gt.1) THEN
                DO i=1,irec
                  status=nf_fread3d(ng, model, ncfile, piofile,         &
     &                              vname(1,ifield), vpiovar,           &
     &                              i, iodesc, vsize,                   &
     &                              lbi, ubi, lbj, ubj, lbk, ubk,       &
     &                              fscale(ifield,ng),                  &
     &                              my_fmin, my_fmax,                   &
#  ifdef MASKING
     &                              fmask,                              &
#  endif
#  ifdef CHECKSUM
     &                              fout(:,:,:,i),                      &
     &                              checksum = fhash)
#  else
     &                              fout(:,:,:,i))
#  endif
                  fmin=min(fmin,my_fmin)
                  fmax=min(fmax,my_fmax)
                END DO
                finfo(8,ifield,ng)=fmin
                finfo(9,ifield,ng)=fmax
              ELSE
                status=nf_fread3d(ng, model, ncfile, piofile,           &
     &                            vname(1,ifield), vpiovar,             &
     &                            trec, iodesc, vsize,                  &
     &                            lbi, ubi, lbj, ubj, lbk, ubk,         &
     &                            fscale(ifield,ng), fmin, fmax,        &
#  ifdef MASKING
     &                            fmask,                                &
#  endif
#  ifdef CHECKSUM
     &                            fout(:,:,:,tindex),                   &
     &                            checksum = fhash)
#  else
     &                            fout(:,:,:,tindex))
#  endif
                finfo(8,ifield,ng)=fmin
                finfo(9,ifield,ng)=fmax
              END IF
            ELSE
              CALL pio_netcdf_get_fvar (ng, model, ncfile,              &
     &                                  vname(1,ifield), fval,          &
     &                                  piofile = piofile,              &
     &                                  start = (/trec/),               &
     &                                  total = (/1/))
              fval=fval*fscale(ifield,ng)
              fpoint(tindex,ifield,ng)=fval
              fmin=fval
              fmax=fval
            END IF
            IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
              IF (master) THEN
                WRITE (stdout,40) trim(vname(1,ifield)), trec
              END IF
              RETURN
            END IF
            IF (master) THEN
              IF (irec.gt.1) THEN
                WRITE (stdout,50) trim(vname(2,ifield)), ng, fmin, fmax
              ELSE
                lstr=scan(ncfile,'/',back=.true.)+1
                lend=len_trim(ncfile)
                lvar=min(46,len_trim(vname(2,ifield)))
                tsec=tval*day2sec
                CALL time_string (tsec, t_code)
                WRITE (stdout,60) vname(2,ifield)(1:lvar), t_code,      &
     &                            ng, trec, tindex, ncfile(lstr:lend),  &
     &                            tmin, tmax, tval, fmin, fmax
              END IF
# ifdef CHECKSUM
              WRITE (stdout,70) fhash
# endif
            END IF
            update=.true.
          END IF
        END IF
!
!  Decrease the local time variable "Tmono" by the interval between
!  snapshots. If the interval is negative, indicating cycling, add in
!  a cycle length.  Load time value (sec) into "Tintrp" which used
!  during interpolation between snapshots.
!
        IF (.not.lonerec) THEN
          tdelta=vtime(3-tindex,ifield,ng)-vtime(tindex,ifield,ng)
          IF (liocycle.and.(tdelta.lt.0.0_r8)) THEN
            tdelta=tdelta+clength
          END IF
          tmono=tmono-tdelta*day2sec
          finfo(7,ifield,ng)=tmono
          tintrp(tindex,ifield,ng)=tmono
        END IF
      END IF
!
  10  FORMAT (/,' GET_3DFLDR_PIO - unable to find dimension ',a,        &
     &        /,18x,'for variable: ',a,/,18x,'in file: ',a,             &
     &        /,18x,'file is not CF compliant...')
  20  FORMAT (/,' GET_3DFLDR_PIO - unable to find requested',           &
     &        ' variable: ',a,/,18x,'in input NetCDF file: ',a)
  30  FORMAT (/,' GET_3DFLDR_PIO - unable to open input NetCDF',        &
     &        ' file: ',a)
  40  FORMAT (/,' GET_3DFLDR_PIO - error while reading variable: ',a,   &
     &        2x,' at TIME index = ',i0)
  50  FORMAT (2x,'GET_3DFLDR_PIO   - ',a,/,22x,'(Grid = ',i2.2,         &
     &        ', Min = ',1p,e15.8,0p,' Max = ',1p,e15.8,0p,')')
  60  FORMAT (2x,'GET_3DFLDR_PIO   - ',a,',',t75,a,/,22x,               &
     &        '(Grid=',i2.2,', Rec=',i0,', Index=',i1,                  &
     &        ', File: ',a,')',/,22x,                                   &
     &        '(Tmin= ', f15.4, ' Tmax= ', f15.4,')',                   &
     &        t71, 't = ', f15.4 ,/,22x,                                &
     &        '(Min = ', 1p,e15.8,0p,' Max = ',1p,e15.8,0p,')')
#  ifdef CHECKSUM
  70  FORMAT (22x,'(CheckSum = ',i0,')')
#  endif
!
      RETURN

References mod_param::b3dvar, mod_ncparam::cinfo, mod_scalars::day2sec, mod_ncparam::dinfo, mod_scalars::exit_flag, mod_ncparam::finfo, strings_mod::founderror(), mod_ncparam::fpoint, mod_ncparam::fscale, mod_scalars::iic, mod_ncparam::iinfo, mod_pio_netcdf::iodesc_dp_b3dvar, mod_pio_netcdf::iodesc_dp_l3dvar, mod_pio_netcdf::iodesc_dp_p3dvar, mod_pio_netcdf::iodesc_dp_r3dvar, mod_pio_netcdf::iodesc_dp_u3dvar, mod_pio_netcdf::iodesc_dp_v3dvar, mod_pio_netcdf::iodesc_dp_w3dvar, mod_pio_netcdf::iodesc_sp_b3dvar, mod_pio_netcdf::iodesc_sp_l3dvar, mod_pio_netcdf::iodesc_sp_p3dvar, mod_pio_netcdf::iodesc_sp_r3dvar, mod_pio_netcdf::iodesc_sp_u3dvar, mod_pio_netcdf::iodesc_sp_v3dvar, mod_pio_netcdf::iodesc_sp_w3dvar, mod_param::l3dvar, mod_ncparam::linfo, mod_parallel::master, mod_iounits::ncfile, mod_scalars::noerror, mod_scalars::ntstart, mod_param::p3dvar, mod_param::r3dvar, mod_scalars::rclock, mod_iounits::sourcefile, mod_scalars::spval, mod_iounits::stdout, mod_scalars::time, dateclock_mod::time_string(), mod_ncparam::tintrp, mod_ncparam::tname, mod_param::u3dvar, mod_param::v3dvar, mod_ncparam::vname, mod_ncparam::vtime, and mod_param::w3dvar.

Referenced by get_3dfldr().

Here is the call graph for this function:

Here is the caller graph for this function: