inquiry.F

Go to the documentation of this file.

#include "cppdefs.h"
      MODULE inquiry_mod
!
!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 inquires about the contents of input data from NetCDF  !
!  files.                                                              !
!                                                                      !
!  On Input:                                                           !
!                                                                      !
!     ng         Nested grid number.                                   !
!     model      Calling model identifier.                             !
!     job        Processing job (adjoint model tasks are negative):    !
!                  job = -1, 1    process non-grided field             !
!                  job = -2, 2    process 2D field                     !
!                  job = -3, 3    process 3D field                     !
!     Iout       Size of the outer dimension. Usually, when processing !
!                  data between time snapshots Iout=2. Otherwise,      !
!                  Iout=1 in the calling program.                      !
!     Irec       Number of field records to process. Usually, Irec=1   !
!                  except when processing special fields.              !
!     Mrec       Size of the record dimension when processing          !
!                  non-gridded fields, ABS(job)=1.                     !
!     ifield     Field ID.                                             !
!     ncid       NetCDF file ID.                                       !
#if defined PIO_LIB && defined DISTRIBUTE
!or   pioFile    PIO file descriptor structure, TYPE(file_desc_t)      !
!                  pioFile%fh         file handler                     !
!                  pioFile%iosystem   IO system descriptor (struct)    !
#endif
!     Lmulti     Switch to process a multi-file field. That is, the    !
!                  time records are split in several NetCDF files.     !
!     nfiles     Number of input NetCDF files.                         !
!     S          I/O derived type structure, TYPE(T_IO).               !
!                                                                      !
!  On Output:                                                          !
!                                                                      !
!     ncid       NetCDF file ID.                                       !
!     S          Updated I/O derived type structure, TYPE(T_IO).       !
!                                                                      !
!=======================================================================
!
      USE mod_param
      USE mod_parallel
      USE mod_iounits
      USE mod_ncparam
      USE mod_netcdf
#if defined PIO_LIB && defined DISTRIBUTE
      USE mod_pio_netcdf
#endif
      USE mod_scalars
!
      USE get_cycle_mod, ONLY : get_cycle
      USE strings_mod,   ONLY : founderror, lowercase
!
      implicit none
!
!  Interface for same name routine overloading.
!
      INTERFACE inquiry
        MODULE PROCEDURE inquiry_nf90
#if defined PIO_LIB && defined DISTRIBUTE
        MODULE PROCEDURE inquiry_pio
#endif
      END INTERFACE inquiry
!
      CONTAINS
!
!***********************************************************************
      SUBROUTINE inquiry_nf90 (ng, model, job, Iout, Irec, Mrec,        &
     &                         ifield, ncid, Lmulti, nfiles, S)
!***********************************************************************
!
!  Imported variable declarations.
!
      logical, intent(in) :: Lmulti
!
      integer, intent(in) :: ng, model, job, ifield, nfiles
      integer, intent(in) :: Iout, Irec, Mrec
      integer, intent(inout) :: ncid
!
      TYPE (T_IO), intent(inout) :: S(nfiles)
!
!  Local variable declarations.
!
      logical :: CloseFile, Liocycle, Lgridded, Lonerec
      logical :: foundit, got_var, got_time, special
!
      integer :: Fcount, Nrec, Tid, Tindex, Trec, Vid, Vtype
      integer :: i, ifile, lstr, my_ncid, nvatt, nvdim
      integer :: Vsize(4)
!
      real(dp) :: Clength, Tend, Tmax, Tmin, Tmono, Tscale, Tstr, Tval
      real(dp) :: scale
!
      character (len=1  ), parameter :: blank = ' '
      character (len=3  ) :: label
      character (len=256) :: Fname
 
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__//", inquiry_nf90"
!
      sourcefile=myfile
!
!-----------------------------------------------------------------------
!  On first call, inquire about the contents of input NetCDF file.
!-----------------------------------------------------------------------
!
!  Intialize local variables.
!
      vid=-1
      tid=-1
      nrec=0
      liocycle=.false.
      lgridded=.false.
      lonerec=.false.
      got_var=.false.
      got_time=.false.
      label=s(1)%label(1:3)
      vtype=iinfo(1,ifield,ng)
!
!  Clear ncfile module variable.
!
      DO i=1,len(ncfile)
        ncfile(i:i)=blank
      END DO
!
!  If multi-files, increase (decrease if backward logic) file counter
!  and set new file names.
!
      IF (lmulti) THEN
        DO ifile=1,nfiles
          IF (trim(cinfo(ifield,ng)).eq.trim(s(ifile)%name)) THEN
            IF (job.gt.0) THEN
              fcount=s(ifile)%Fcount+1
            ELSE
              fcount=s(ifile)%Fcount-1
            END IF
            IF ((1.gt.fcount).and.(fcount.gt.s(ifile)%Nfiles)) THEN
              IF (master) THEN
                WRITE (stdout,10) trim(vname(1,ifield)),                &
     &                            fcount, s(ifile)%Nfiles
              END IF
              exit_flag=4
              IF (founderror(exit_flag, noerror,                        &
     &                       __line__, myfile)) RETURN
            END IF
            s(ifile)%Fcount=fcount
            s(ifile)%name=trim(s(ifile)%files(fcount))
            CALL netcdf_close (ng, model, ncid)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
            IF (label(1:3).eq.'FRC') THEN
              frcids(ifile,ng)=-1
              s(ifile)%ncid=-1
            END IF
            IF (label(1:3).eq.'BRY') THEN
              bryids(ifile,ng)=-1
              s(ifile)%ncid=-1
            END IF
            IF (label(1:3).eq.'CLM') THEN
              clmids(ifile,ng)=-1
              s(ifile)%ncid=-1
            END IF
            EXIT
          ELSE                       ! S(ifile)%name and Fcount already
            fcount=s(ifile)%Fcount   ! updated in first field processed
          END IF                     ! for current new file
        END DO
      ELSE
        fcount=s(1)%Fcount
      END IF
      IF (fcount.eq.0) THEN
        IF (master) THEN
          WRITE (stdout,20) fcount, label, trim(vname(1,ifield))
        END IF
        exit_flag=4
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END IF
!
!  If several input NetCDF files (nfiles>1), scan files until the
!  requested variable is found.
!
      foundit=.false.
      query: DO ifile=1,nfiles
        fname=s(ifile)%name
!
!  Open NetCDF file for reading.
!
        IF (s(ifile)%ncid.eq.-1) THEN
          CALL netcdf_open (ng, model, fname, 0, my_ncid)
          IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
            IF (master) WRITE (stdout,60) trim(fname)
            RETURN
          END IF
          closefile=.true.
        ELSE
          my_ncid=s(ifile)%ncid
          closefile=.false.
        END IF
!
!  Inquire about the dimensions and check for consistency.
!
        CALL netcdf_check_dim (ng, model, fname,                        &
     &                         ncid = my_ncid)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Inquire about requested variable.
!
        CALL netcdf_inq_var (ng, model, fname,                          &
     &                       ncid = my_ncid,                            &
     &                       myvarname = trim(vname(1,ifield)),         &
     &                       searchvar = foundit,                       &
     &                       varid = vid,                               &
     &                       nvardim = nvdim,                           &
     &                       nvaratt = nvatt)
 
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Determine if gridded or point data.  Set variable dimensions.
!
        IF (foundit) THEN
          got_var=.true.
          ncfile=fname
          IF ((nvdim.gt.1).and.(abs(job).gt.1)) THEN
            lgridded=.true.
          END IF
          vsize=0
          DO i=1,nvdim
            vsize(i)=var_dsize(i)
          END DO
        ELSE
          IF (.not.lmulti) THEN
            ncfile=fname                    ! need for error report
          END IF
        END IF
!
!  If "scale_factor" attribute is present for a variable, the data are
!  to be multiplied by this factor.  Check if only water points are
!  available.
!
        IF (foundit) THEN
          DO i=1,nvatt
            IF (trim(var_aname(i)).eq.'scale_factor') THEN
              scale=var_afloat(i)
              finfo(10,ifield,ng)=scale
            ELSE IF (trim(var_aname(i)).eq.'water_points') THEN
              iinfo(1,ifield,ng)=-abs(iinfo(1,ifield,ng))
              vtype=iinfo(1,ifield,ng)
            END IF
          END DO
        END IF
!
!  Check if processing special 2D fields with additional dimensions
!  (for example, tides).
!
        IF (foundit.and.(abs(job).eq.2)) THEN
          special=.false.
          DO i=1,nvdim
            IF (index(trim(var_dname(i)),'period').ne.0) THEN
              special=.true.
            END IF
          END DO
          linfo(4,ifield,ng)=special
        END IF
!
!  Inquire about associated time dimension, if any, and get number of
!  available time records.
!
        IF (foundit) THEN
          IF (len_trim(vname(5,ifield)).gt.0) THEN
            tname(ifield)=trim(vname(5,ifield))
            DO i=1,nvdim
              IF (var_dname(i).eq.trim(tname(ifield))) THEN
                nrec=var_dsize(i)
                got_time=.true.
              END IF
            END DO
          END IF
!
!  If the associated time variable is different to that specified in
!  "varinfo.yaml" (Nrec still zero), reset associated time-variable name
!  to that specified in the "time" attribute.  If founded, also check
!  for a C-language null termination character in the time variable
!  string, which is possible in NetCDF files generated from C-programs.
!
          IF (nrec.eq.0) THEN
            DO i=1,nvatt
              IF (trim(var_aname(i)).eq.'time') THEN
                tname(ifield)=trim(var_achar(i))
                got_time=.true.
              END IF
            END DO
            IF (got_time) THEN
              lstr=len_trim(tname(ifield))
              DO i=1,n_dim
                IF (trim(dim_name(i)).eq.tname(ifield)(1:lstr)) THEN
                  nrec=dim_size(i)
                ELSE IF (trim(dim_name(i)).eq.                          &
     &                   tname(ifield)(1:lstr-1)) THEN  ! There is a C
                  nrec=dim_size(i)                      ! language null
                  tname(ifield)=tname(ifield)(1:lstr-1) ! termination
                END IF                                  ! character
              END DO
            END IF
          END IF
!
!  If Nrec=0, input file is not CF compliant, check variable dimension
!  to see if the dimension contains the "time" string.
!
          IF (got_time.and.(nrec.eq.0)) THEN
            DO i=1,n_vdim
              IF (index(trim(lowercase(var_dname(i))),'time').ne.0) THEN
                nrec=var_dsize(i)
              END IF
            END DO
          END IF
          IF (got_time.and.(nrec.eq.0)) THEN
            IF (master) WRITE (stdout,30) trim(tname(ifield)),          &
     &                                    trim(vname(1,ifield)),        &
     &                                    trim(fname)
            exit_flag=4
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
        END IF
        IF (abs(job).eq.1) THEN
          IF ((iout.eq.1).and.(nrec.gt.mrec)) THEN
            IF (master) WRITE (stdout,40) trim(vname(1,ifield)),        &
     &                                    mrec, nrec
            exit_flag=4
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
        END IF
!
!  Determine initial time record to read and cycling switch.
!
        IF (foundit) THEN
          CALL get_cycle (ng, model, ifield, job, lmulti,               &
     &                    ncfile, my_ncid, tname(ifield), nrec,         &
     &                    tdays(ng), tid, liocycle, clength, trec,      &
     &                    tstr, tend, tmin, tmax,  tscale)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          sourcefile=myfile
        END IF
!
!  Store variable information into global information arrays.  Also
!  fill some structure values.
!
        IF (foundit) THEN
          ncid=my_ncid
          linfo( 1,ifield,ng)=lgridded
          linfo( 2,ifield,ng)=liocycle
          iinfo( 2,ifield,ng)=vid
          iinfo( 3,ifield,ng)=tid
          iinfo( 4,ifield,ng)=nrec
          iinfo( 5,ifield,ng)=vsize(1)
          iinfo( 6,ifield,ng)=vsize(2)
          iinfo( 7,ifield,ng)=vsize(3)
          iinfo(10,ifield,ng)=s(ifile)%Nfiles
          iinfo(11,ifield,ng)=nvdim
          finfo(1,ifield,ng)=tmin
          finfo(2,ifield,ng)=tmax
          finfo(3,ifield,ng)=tstr
          finfo(4,ifield,ng)=tend
          finfo(5,ifield,ng)=clength
          finfo(6,ifield,ng)=tscale
          s(ifile)%Nrec(fcount)=nrec
          s(ifile)%time_min(fcount)=tmin
          s(ifile)%time_max(fcount)=tmax
          EXIT query
        END IF
!
!  Close input NetCDF file if opened during the query.  Files opened
!  outside the query loop remain open.  This is done to avoid opening
!  too many files.
!
        IF (closefile) THEN
          CALL netcdf_close (ng, model, my_ncid, fname, .false.)
        END IF
      END DO query
!
!  Terminate execution requested variables are not found.
!
      IF (.not.got_var) THEN
        IF ((nfiles.gt.1).and.(label(1:3).eq.'FRC')) THEN
          IF (master) THEN
            WRITE (stdout,50) trim(vname(1,ifield)), 'files:'
            DO i=1,nfiles
              WRITE (stdout,'(15x,a)') trim(s(i)%name)
            END DO
          END IF
        ELSE IF ((nfiles.gt.1).and.(label(1:3).eq.'BRY')) THEN
          IF (master) THEN
            WRITE (stdout,50) trim(vname(1,ifield)), 'files:'
            DO i=1,nfiles
              WRITE (stdout,'(15x,a)') trim(s(i)%name)
            END DO
          END IF
        ELSE IF ((nfiles.gt.1).and.(label(1:3).eq.'CLM')) THEN
          IF (master) THEN
            WRITE (stdout,50) trim(vname(1,ifield)), 'files:'
            DO i=1,nfiles
              WRITE (stdout,'(15x,a)') trim(s(i)%name)
            END DO
          END IF
        ELSE
          lstr=len_trim(ncfile)
          IF (master) THEN
            WRITE (stdout,50) trim(vname(1,ifield)), 'file:'
            IF (lstr.gt.0) THEN
              WRITE (stdout,'(15x,a)') trim(ncfile)
            ELSE
              WRITE (stdout,'(15x,a,a)') 'file name is blank, ',        &
     &                                   'cannot be determined.'
            END IF
          END IF
        END IF
        exit_flag=2
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END IF
      IF (.not.got_time) THEN
        IF ((nfiles.gt.1).and.(label(1:3).eq.'FRC')) THEN
          IF (master) THEN
            WRITE (stdout,50) trim(tname(ifield)), 'files:'
            DO i=1,nfiles
              WRITE (stdout,'(15x,a)') trim(s(i)%name)
            END DO
          END IF
        ELSE IF ((nfiles.gt.1).and.(label(1:3).eq.'BRY')) THEN
          IF (master) THEN
            WRITE (stdout,50) trim(tname(ifield)), 'files:'
            DO i=1,nfiles
              WRITE (stdout,'(15x,a)') trim(s(i)%name)
            END DO
          END IF
        ELSE IF ((nfiles.gt.1).and.(label(1:3).eq.'CLM')) THEN
          IF (master) THEN
            WRITE (stdout,50) trim(tname(ifield)), 'files:'
            DO i=1,nfiles
              WRITE (stdout,'(15x,a)') trim(s(i)%name)
            END DO
          END IF
        ELSE
          lstr=len_trim(ncfile)
          IF (master) THEN
            WRITE (stdout,50) trim(tname(ifield)), 'file:'
            IF (lstr.gt.0) THEN
               WRITE (stdout,'(15x,a)') trim(ncfile)
            ELSE
              WRITE (stdout,'(15x,a,a)') 'file name is blank, ',        &
     &                                   'cannot be determined.'
            END IF
          END IF
        END IF
        exit_flag=2
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END IF
!
!  If processing model forcing (multiple files allowed), check if file
!  for requested field (based on ncid) has been already opened and get
!  its ID from the association table (FRCids).
!
      IF (label(1:3).eq.'FRC') THEN
        DO ifile=1,nfiles
          IF ((trim(ncfile).eq.trim(s(ifile)%name)).and.                &
     &        (frcids(ifile,ng).ne.-1).and.                             &
     &        (ncid.ne.frcids(ifile,ng))) THEN
            ncid=frcids(ifile,ng)
            EXIT
          END IF
        END DO
      END IF
      IF (label(1:3).eq.'BRY') THEN
        DO ifile=1,nfiles
          IF ((trim(ncfile).eq.trim(s(ifile)%name)).and.                &
     &        (bryids(ifile,ng).ne.-1).and.                             &
     &        (ncid.ne.bryids(ifile,ng))) THEN
            ncid=bryids(ifile,ng)
            EXIT
          END IF
        END DO
      END IF
      IF (label(1:3).eq.'CLM') THEN
        DO ifile=1,nfiles
          IF ((trim(ncfile).eq.trim(s(ifile)%name)).and.                &
     &        (clmids(ifile,ng).ne.-1).and.                             &
     &        (ncid.ne.clmids(ifile,ng))) THEN
            ncid=clmids(ifile,ng)
            EXIT
          END IF
        END DO
      END IF
!
!  If appropriate, open input NetCDF file for reading.
!  (HGA: it is not needed since file was already open and
!        ncid=my_ncid was assigned above.
!
      IF (ncid.eq.-1) THEN
        CALL netcdf_open (ng, model, ncfile, 0, ncid)
        IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
           IF (master) WRITE (stdout,60) trim(ncfile)
          RETURN
        END IF
      END IF
!
!  If processing model forcing, load ID into association table (FRCids).
!
      IF (label(1:3).eq.'FRC') THEN
        DO ifile=1,nfiles
          IF (trim(ncfile).eq.trim(s(ifile)%name)) THEN
            frcids(ifile,ng)=ncid
            s(ifile)%ncid=ncid
            EXIT
          END IF
        END DO
      ELSE IF (label(1:3).eq.'BRY') THEN
        DO ifile=1,nfiles
          IF (trim(ncfile).eq.trim(s(ifile)%name)) THEN
            bryids(ifile,ng)=ncid
            s(ifile)%ncid=ncid
            EXIT
          END IF
        END DO
      ELSE IF (label(1:3).eq.'CLM') THEN
        DO ifile=1,nfiles
          IF (trim(ncfile).eq.trim(s(ifile)%name)) THEN
            clmids(ifile,ng)=ncid
            s(ifile)%ncid=ncid
            EXIT
          END IF
        END DO
      ELSE
        s(1)%ncid=ncid
      END IF
      cinfo(ifield,ng)=trim(ncfile)
!
!  The strategy here is to create a local, monotonically increasing
!  time variable so the interpolation between snapshots is trivial
!  when cycling forcing fields. Subtract one to time record counter
!  "Trec" to avoid doing special case at initialization. If the
!  job task is negative, the logic is backaward in time for the
!  adjoint model.
!
      IF (.not.lmulti) THEN
        IF (job.lt.0) THEN            ! backward time logic, adjoint
          IF (irec.eq.1) THEN
            tindex=iout
          ELSE
            tindex=iinfo(8,ifield,ng)
          END IF
          IF (liocycle) THEN
            IF (trec.eq.nrec) THEN
              IF (tdays(ng).lt.tmax) THEN
                tmono=tend
              ELSE
                tmono=tend+(tdays(ng)-mod(tdays(ng),clength))
              END IF
            ELSE
              IF (tdays(ng).gt.clength) THEN
                tmono=tend+(tdays(ng)-mod(tdays(ng),clength))
              ELSE
                tmono=tend
              END IF
            END IF
            trec=trec+2
          ELSE
            tmono=tend
            trec=trec+1
            CALL netcdf_get_time (ng, model, ncfile, tname(ifield),     &
     &                            rclock%DateNumber, tval,              &
     &                            ncid = ncid,                          &
     &                            start = (/trec-1/),                   &
     &                            total = (/1/))
            IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
              IF (master) WRITE (stdout,70) trim(tname(ifield)), trec
              RETURN
            END IF
            tval=tval*tscale
            IF (tval.lt.tend) THEN
              trec=trec+1
            END IF
          END IF
        ELSE                          ! forward time logic
          IF (irec.eq.1) THEN
            tindex=iout
          ELSE
            tindex=1
          END IF
          IF (liocycle) THEN
            IF (trec.eq.nrec) THEN
              IF (tdays(ng).lt.tmax) THEN
                tmono=tstr-clength
              ELSE
                tmono=tdays(ng)+(tstr-clength)
                IF (tstr.eq.tmax) THEN
                  tmono=tmono+(tmin-mod(tdays(ng)+tmin,clength))
                ELSE
                  tmono=tmono+(tstr-mod(tdays(ng)+tstr,clength))
                END IF
              END IF
            ELSE
              IF (tdays(ng).gt.clength) THEN
                tmono=tdays(ng)-mod(tdays(ng)-tstr,clength)
              ELSE
                tmono=tstr
              END IF
            END IF
          ELSE
            tmono=tstr
          END IF
          trec=trec-1
        END IF
        tmono=tmono*day2sec
        iinfo(8,ifield,ng)=tindex
        iinfo(9,ifield,ng)=trec
        finfo(7,ifield,ng)=tmono
      ELSE
        iinfo(9,ifield,ng)=trec
      END IF
!
!  Set switch for one time record dataset. In this case, the input
!  data is always the same and time interpolation is not performed.
!
      IF (nrec.eq.1) lonerec=.true.
      linfo(3,ifield,ng)=lonerec
      tindex=iinfo(8,ifield,ng)
      IF (job.lt.0) THEN
        vtime(tindex,ifield,ng)=finfo(4,ifield,ng)
      ELSE
        vtime(tindex,ifield,ng)=finfo(3,ifield,ng)
      END IF
!
  10  FORMAT (/,' INQUIRY_NF90 - out of range multi-files counter for', &
     &        ' variable: ',a,/,16x,'Fcount = ',i0,                     &
     &        ',   Expected range: 1 - ',i0)
  20  FORMAT (/,' INQUIRY_NF90 - unable to assign file counter, ',      &
     &        'Fcount = ',i0,/,16x,'while processing structure: ',a,    &
     &        /,16x,'and variable; ',a)
  30  FORMAT (/,' INQUIRY_NF90 - unable to find dimension ',a,          &
     &        /,16x,'for variable: ',a,/,16x,'in file: ',a,             &
     &        /,16x,'file is not CF compliant...')
  40  FORMAT (/,' INQUIRY_NF90 - too small dimension for variable ',a,  &
     &        ': ',i0,2x,i0)
  50  FORMAT (/,' INQUIRY_NF90 - unable to find requested variable: ',  &
     &        a,/,16x,'in ',a)
  60  FORMAT (/,' INQUIRY_NF90 - unable to open input NetCDF file: ',a)
  70  FORMAT (/,' INQUIRY_NF90 - error while reading variable: ',a,2x,  &
     &        ' at TIME index = ',i0)
!
      RETURN
      END SUBROUTINE inquiry_nf90
 
# if defined PIO_LIB && defined DISTRIBUTE
!
!***********************************************************************
      SUBROUTINE inquiry_pio (ng, model, job, Iout, Irec, Mrec,         &
     &                        ifield, pioFile, Lmulti, nfiles, S)
!***********************************************************************
!
!  Imported variable declarations.
!
      logical, intent(in) :: Lmulti
!
      integer, intent(in) :: ng, model, job, ifield, nfiles
      integer, intent(in) :: Iout, Irec, Mrec
!
      TYPE (File_desc_t), intent(inout) :: pioFile
      TYPE (T_IO),        intent(inout) :: S(nfiles)
!
!  Local variable declarations.
!
      logical :: CloseFile, Liocycle, Lgridded, Lonerec
      logical :: foundit, got_var, got_time, special
!
      integer :: Fcount, Nrec, Tindex, Trec, Vtype
      integer :: i, ifile, lstr, nvatt, nvdim
      integer :: Vsize(4)
!
      real(dp) :: Clength, Tend, Tmax, Tmin, Tmono, Tscale, Tstr, Tval
      real(dp) :: scale
!
      character (len=1  ), parameter :: blank = ' '
      character (len=3  ) :: label
      character (len=256) :: Fname
 
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__//", inquiry_pio"
!
      TYPE (File_desc_t) :: my_pioFile
      TYPE (Var_desc_t)  :: pioVar, TpioVar
!
      sourcefile=myfile
!
!-----------------------------------------------------------------------
!  On first call, inquire about the contents of input NetCDF file.
!-----------------------------------------------------------------------
!
!  Intialize local variables.
!
      piovar%varID=-1
      tpiovar%varID=-1
      nrec=0
      liocycle=.false.
      lgridded=.false.
      lonerec=.false.
      got_var=.false.
      got_time=.false.
      label=s(1)%label(1:3)
      vtype=iinfo(1,ifield,ng)
!
!  Clear ncfile module variable.
!
      DO i=1,len(ncfile)
        ncfile(i:i)=blank
      END DO
!
!  If multi-files, increase (decrease if backward logic) file counter
!  and set new file names.
!
      IF (lmulti) THEN
        DO ifile=1,nfiles
          IF (trim(cinfo(ifield,ng)).eq.trim(s(ifile)%name)) THEN
            IF (job.gt.0) THEN
              fcount=s(ifile)%Fcount+1
            ELSE
              fcount=s(ifile)%Fcount-1
            END IF
            IF ((1.gt.fcount).and.(fcount.gt.s(ifile)%Nfiles)) THEN
              IF (master) THEN
                WRITE (stdout,10) trim(vname(1,ifield)),                &
     &                            fcount, s(ifile)%Nfiles
              END IF
              exit_flag=4
              IF (founderror(exit_flag, noerror,                        &
     &                       __line__, myfile)) RETURN
            END IF
            s(ifile)%Fcount=fcount
            s(ifile)%name=trim(s(ifile)%files(fcount))
            CALL pio_netcdf_close (ng, model, piofile)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
            IF (label(1:3).eq.'FRC') THEN
              frcdesc(ifile,ng)%fh=-1
              s(ifile)%pioFile%fh=-1
            END IF
            IF (label(1:3).eq.'BRY') THEN
              brydesc(ifile,ng)%fh=-1
              s(ifile)%pioFile%fh=-1
            END IF
            IF (label(1:3).eq.'CLM') THEN
              clmdesc(ifile,ng)%fh=-1
              s(ifile)%pioFile%fh=-1
            END IF
            EXIT
          ELSE                       ! S(ifile)%name and Fcount already
            fcount=s(ifile)%Fcount   ! updated in first field processed
          END IF                     ! for current new file
        END DO
      ELSE
        fcount=s(1)%Fcount
      END IF
      IF (fcount.eq.0) THEN
        IF (master) THEN
          WRITE (stdout,20) fcount, label, trim(vname(1,ifield))
        END IF
        exit_flag=4
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END IF
!
!  If several input NetCDF files (nfiles>1), scan files until the
!  requested variable is found.
!
      foundit=.false.
      query: DO ifile=1,nfiles
        fname=s(ifile)%name
!
!  Open NetCDF file for reading.
!
        IF (s(ifile)%pioFile%fh.eq.-1) THEN
          CALL pio_netcdf_open (ng, model, fname, 0, my_piofile)
          IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
            IF (master) WRITE (stdout,60) trim(fname)
            RETURN
          END IF
          closefile=.true.
        ELSE
          my_piofile=s(ifile)%pioFile
          closefile=.false.
        END IF
!
!  Inquire about the dimensions and check for consistency.
!
        CALL pio_netcdf_check_dim (ng, model, fname,                    &
     &                             piofile = my_piofile)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Inquire about requested variable.
!
        CALL pio_netcdf_inq_var (ng, model, fname,                      &
     &                           piofile = my_piofile,                  &
     &                           myvarname = trim(vname(1,ifield)),     &
     &                           searchvar = foundit,                   &
     &                           piovar = piovar,                       &
     &                           nvardim = nvdim,                       &
     &                           nvaratt = nvatt)
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
!  Determine if gridded or point data.  Set variable dimensions.
!
        IF (foundit) THEN
          got_var=.true.
          ncfile=fname
          IF ((nvdim.gt.1).and.(abs(job).gt.1)) THEN
            lgridded=.true.
          END IF
          vsize=0
          DO i=1,nvdim
            vsize(i)=var_dsize(i)
          END DO
        ELSE
          IF (.not.lmulti) THEN
            ncfile=fname                    ! need for error report
          END IF
        END IF
!
!  If "scale_factor" attribute is present for a variable, the data are
!  to be multiplied by this factor.  Check if only water points are
!  available.
!
        IF (foundit) THEN
          DO i=1,nvatt
            IF (trim(var_aname(i)).eq.'scale_factor') THEN
              scale=var_afloat(i)
              finfo(10,ifield,ng)=scale
            ELSE IF (trim(var_aname(i)).eq.'water_points') THEN
              iinfo(1,ifield,ng)=-abs(iinfo(1,ifield,ng))
              vtype=iinfo(1,ifield,ng)
            END IF
          END DO
        END IF
!
!  Check if processing special 2D fields with additional dimensions
!  (for example, tides).
!
        IF (foundit.and.(abs(job).eq.2)) THEN
          special=.false.
          DO i=1,nvdim
            IF (index(trim(var_dname(i)),'period').ne.0) THEN
              special=.true.
            END IF
          END DO
          linfo(4,ifield,ng)=special
        END IF
!
!  Inquire about associated time dimension, if any, and get number of
!  available time records.
!
        IF (foundit) THEN
          IF (len_trim(vname(5,ifield)).gt.0) THEN
            tname(ifield)=trim(vname(5,ifield))
            DO i=1,nvdim
              IF (var_dname(i).eq.trim(tname(ifield))) THEN
                nrec=var_dsize(i)
                got_time=.true.
              END IF
            END DO
          END IF
!
!  If the associated time variable is different to that specified in
!  "varinfo.yaml" (Nrec still zero), reset associated time-variable name
!  to that specified in the "time" attribute.  If founded, also check
!  for a C-language null termination character in the time variable
!  string, which is possible in NetCDF files generated from C-programs.
!
          IF (nrec.eq.0) THEN
            DO i=1,nvatt
              IF (trim(var_aname(i)).eq.'time') THEN
                tname(ifield)=trim(var_achar(i))
                got_time=.true.
              END IF
            END DO
            IF (got_time) THEN
              lstr=len_trim(tname(ifield))
              DO i=1,n_dim
                IF (trim(dim_name(i)).eq.tname(ifield)(1:lstr)) THEN
                  nrec=dim_size(i)
                ELSE IF (trim(dim_name(i)).eq.                          &
     &                   tname(ifield)(1:lstr-1)) THEN  ! There is a C
                  nrec=dim_size(i)                      ! language null
                  tname(ifield)=tname(ifield)(1:lstr-1) ! termination
                END IF                                  ! character
              END DO
            END IF
          END IF
!
!  If Nrec=0, input file is not CF compliant, check variable dimension
!  to see if the dimension contains the "time" string.
!
          IF (got_time.and.(nrec.eq.0)) THEN
            DO i=1,n_vdim
              IF (index(trim(lowercase(var_dname(i))),'time').ne.0) THEN
                nrec=var_dsize(i)
              END IF
            END DO
          END IF
          IF (got_time.and.(nrec.eq.0)) THEN
            IF (master) WRITE (stdout,30) trim(tname(ifield)),          &
     &                                    trim(vname(1,ifield)),        &
     &                                    trim(fname)
            exit_flag=4
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
        END IF
        IF (abs(job).eq.1) THEN
          IF ((iout.eq.1).and.(nrec.gt.mrec)) THEN
            IF (master) WRITE (stdout,40) trim(vname(1,ifield)),        &
     &                                    mrec, nrec
            exit_flag=4
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
        END IF
!
!  Determine initial time record to read and cycling switch.
!
        IF (foundit) THEN
          CALL get_cycle (ng, model, ifield, job, lmulti,               &
     &                    ncfile, my_piofile, tname(ifield), nrec,      &
     &                    tdays(ng), tpiovar, liocycle, clength, trec,  &
     &                    tstr, tend, tmin, tmax,  tscale)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          sourcefile=myfile
        END IF
!
!  Store variable information into global information arrays.  Also
!  fill some structure values.
!
        IF (foundit) THEN
          piofile=my_piofile
          dinfo( 1,ifield,ng)%vd=piovar
          dinfo( 1,ifield,ng)%dkind=pio_type
          dinfo( 1,ifield,ng)%gtype=vtype
          dinfo( 2,ifield,ng)%vd=tpiovar
          dinfo( 1,ifield,ng)%dkind=pio_tout
          dinfo( 2,ifield,ng)%gtype=0
          linfo( 1,ifield,ng)=lgridded
          linfo( 2,ifield,ng)=liocycle
          iinfo( 4,ifield,ng)=nrec
          iinfo( 5,ifield,ng)=vsize(1)
          iinfo( 6,ifield,ng)=vsize(2)
          iinfo( 7,ifield,ng)=vsize(3)
          iinfo(10,ifield,ng)=s(ifile)%Nfiles
          iinfo(11,ifield,ng)=nvdim
          finfo(1,ifield,ng)=tmin
          finfo(2,ifield,ng)=tmax
          finfo(3,ifield,ng)=tstr
          finfo(4,ifield,ng)=tend
          finfo(5,ifield,ng)=clength
          finfo(6,ifield,ng)=tscale
          s(ifile)%Nrec(fcount)=nrec
          s(ifile)%time_min(fcount)=tmin
          s(ifile)%time_max(fcount)=tmax
          EXIT query
        END IF
!
!  Close input NetCDF file if opened during the query.  Files opened
!  outside the query loop remain open.  This is done to avoid opening
!  too many files.
!
        IF (closefile) THEN
          CALL pio_netcdf_close (ng, model, my_piofile, fname, .false.)
        END IF
      END DO query
!
!  Terminate execution requested variables are not found.
!
      IF (.not.got_var) THEN
        IF ((nfiles.gt.1).and.(label(1:3).eq.'FRC')) THEN
          IF (master) THEN
            WRITE (stdout,50) trim(vname(1,ifield)), 'files:'
            DO i=1,nfiles
              WRITE (stdout,'(15x,a)') trim(s(i)%name)
            END DO
          END IF
        ELSE IF ((nfiles.gt.1).and.(label(1:3).eq.'BRY')) THEN
          IF (master) THEN
            WRITE (stdout,50) trim(vname(1,ifield)), 'files:'
            DO i=1,nfiles
              WRITE (stdout,'(15x,a)') trim(s(i)%name)
            END DO
          END IF
        ELSE IF ((nfiles.gt.1).and.(label(1:3).eq.'CLM')) THEN
          IF (master) THEN
            WRITE (stdout,50) trim(vname(1,ifield)), 'files:'
            DO i=1,nfiles
              WRITE (stdout,'(15x,a)') trim(s(i)%name)
            END DO
          END IF
        ELSE
          lstr=len_trim(ncfile)
          IF (master) THEN
            WRITE (stdout,50) trim(vname(1,ifield)), 'file:'
            IF (lstr.gt.0) THEN
              WRITE (stdout,'(15x,a)') trim(ncfile)
            ELSE
              WRITE (stdout,'(15x,a,a)') 'file name is blank, ',        &
     &                                   'cannot be determined.'
            END IF
          END IF
        END IF
        exit_flag=2
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END IF
      IF (.not.got_time) THEN
        IF ((nfiles.gt.1).and.(label(1:3).eq.'FRC')) THEN
          IF (master) THEN
            WRITE (stdout,50) trim(tname(ifield)), 'files:'
            DO i=1,nfiles
              WRITE (stdout,'(15x,a)') trim(s(i)%name)
            END DO
          END IF
        ELSE IF ((nfiles.gt.1).and.(label(1:3).eq.'BRY')) THEN
          IF (master) THEN
            WRITE (stdout,50) trim(tname(ifield)), 'files:'
            DO i=1,nfiles
              WRITE (stdout,'(15x,a)') trim(s(i)%name)
            END DO
          END IF
        ELSE IF ((nfiles.gt.1).and.(label(1:3).eq.'CLM')) THEN
          IF (master) THEN
            WRITE (stdout,50) trim(tname(ifield)), 'files:'
            DO i=1,nfiles
              WRITE (stdout,'(15x,a)') trim(s(i)%name)
            END DO
          END IF
        ELSE
          lstr=len_trim(ncfile)
          IF (master) THEN
            WRITE (stdout,50) trim(tname(ifield)), 'file:'
            IF (lstr.gt.0) THEN
               WRITE (stdout,'(15x,a)') trim(ncfile)
            ELSE
              WRITE (stdout,'(15x,a,a)') 'file name is blank, ',        &
     &                                   'cannot be determined.'
            END IF
          END IF
        END IF
        exit_flag=2
        IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
      END IF
!
!  If processing model forcing (multiple files allowed), check if file
!  for requested field (based on pioFile) has been already opened and
!  get its file descriptor from the association table (FRCdesc).
!
      IF (label(1:3).eq.'FRC') THEN
        DO ifile=1,nfiles
          IF ((trim(ncfile).eq.trim(s(ifile)%name)).and.                &
     &        (frcdesc(ifile,ng)%fh.ne.-1).and.                         &
     &        (piofile%fh.ne.frcdesc(ifile,ng)%fh)) THEN
            piofile=frcdesc(ifile,ng)
            EXIT
          END IF
        END DO
      END IF
      IF (label(1:3).eq.'BRY') THEN
        DO ifile=1,nfiles
          IF ((trim(ncfile).eq.trim(s(ifile)%name)).and.                &
     &        (brydesc(ifile,ng)%fh.ne.-1).and.                         &
     &        (piofile%fh.ne.brydesc(ifile,ng)%fh)) THEN
            piofile=brydesc(ifile,ng)
            EXIT
          END IF
        END DO
      END IF
      IF (label(1:3).eq.'CLM') THEN
        DO ifile=1,nfiles
          IF ((trim(ncfile).eq.trim(s(ifile)%name)).and.                &
     &        (clmdesc(ifile,ng)%fh.ne.-1).and.                         &
     &        (piofile%fh.ne.clmdesc(ifile,ng)%fh)) THEN
            piofile=clmdesc(ifile,ng)
            EXIT
          END IF
        END DO
      END IF
!
!  If appropriate, open input NetCDF file for reading.
!  (HGA: it is not needed since file was already open and
!        pioFile=my_pioFile was assigned above.
!
      IF (piofile%fh.eq.-1) THEN
        CALL pio_netcdf_open (ng, model, ncfile, 0, piofile)
        IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
           IF (master) WRITE (stdout,60) trim(ncfile)
          RETURN
        END IF
      END IF
!
!  If processing model forcing, load ID into association table (FRCids).
!
      IF (label(1:3).eq.'FRC') THEN
        DO ifile=1,nfiles
          IF (trim(ncfile).eq.trim(s(ifile)%name)) THEN
            frcdesc(ifile,ng)=piofile
            s(ifile)%pioFile=piofile
            EXIT
          END IF
        END DO
      ELSE IF (label(1:3).eq.'BRY') THEN
        DO ifile=1,nfiles
          IF (trim(ncfile).eq.trim(s(ifile)%name)) THEN
            brydesc(ifile,ng)=piofile
            s(ifile)%pioFile=piofile
            EXIT
          END IF
        END DO
      ELSE IF (label(1:3).eq.'CLM') THEN
        DO ifile=1,nfiles
          IF (trim(ncfile).eq.trim(s(ifile)%name)) THEN
            clmdesc(ifile,ng)=piofile
            s(ifile)%pioFile=piofile
            EXIT
          END IF
        END DO
      ELSE
        s(1)%pioFile=piofile
      END IF
      cinfo(ifield,ng)=trim(ncfile)
!
!  The strategy here is to create a local, monotonically increasing
!  time variable so the interpolation between snapshots is trivial
!  when cycling forcing fields. Subtract one to time record counter
!  "Trec" to avoid doing special case at initialization. If the
!  job task is negative, the logic is backaward in time for the
!  adjoint model.
!
      IF (.not.lmulti) THEN
        IF (job.lt.0) THEN            ! backward time logic, adjoint
          IF (irec.eq.1) THEN
            tindex=iout
          ELSE
            tindex=iinfo(8,ifield,ng)
          END IF
          IF (liocycle) THEN
            IF (trec.eq.nrec) THEN
              IF (tdays(ng).lt.tmax) THEN
                tmono=tend
              ELSE
                tmono=tend+(tdays(ng)-mod(tdays(ng),clength))
              END IF
            ELSE
              IF (tdays(ng).gt.clength) THEN
                tmono=tend+(tdays(ng)-mod(tdays(ng),clength))
              ELSE
                tmono=tend
              END IF
            END IF
            trec=trec+2
          ELSE
            tmono=tend
            trec=trec+1
            CALL pio_netcdf_get_time (ng, model, ncfile, tname(ifield), &
     &                                rclock%DateNumber, tval,          &
     &                                piofile = piofile,                &
     &                                start = (/trec-1/),               &
     &                                total = (/1/))
            IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
              IF (master) WRITE (stdout,70) trim(tname(ifield)), trec
              RETURN
            END IF
            tval=tval*tscale
            IF (tval.lt.tend) THEN
              trec=trec+1
            END IF
          END IF
        ELSE                          ! forward time logic
          IF (irec.eq.1) THEN
            tindex=iout
          ELSE
            tindex=1
          END IF
          IF (liocycle) THEN
            IF (trec.eq.nrec) THEN
              IF (tdays(ng).lt.tmax) THEN
                tmono=tstr-clength
              ELSE
                tmono=tdays(ng)+(tstr-clength)
                IF (tstr.eq.tmax) THEN
                  tmono=tmono+(tmin-mod(tdays(ng)+tmin,clength))
                ELSE
                  tmono=tmono+(tstr-mod(tdays(ng)+tstr,clength))
                END IF
              END IF
            ELSE
              IF (tdays(ng).gt.clength) THEN
                tmono=tdays(ng)-mod(tdays(ng)-tstr,clength)
              ELSE
                tmono=tstr
              END IF
            END IF
          ELSE
            tmono=tstr
          END IF
          trec=trec-1
        END IF
        tmono=tmono*day2sec
        iinfo(8,ifield,ng)=tindex
        iinfo(9,ifield,ng)=trec
        finfo(7,ifield,ng)=tmono
      ELSE
        iinfo(9,ifield,ng)=trec
      END IF
!
!  Set switch for one time record dataset. In this case, the input
!  data is always the same and time interpolation is not performed.
!
      IF (nrec.eq.1) lonerec=.true.
      linfo(3,ifield,ng)=lonerec
      tindex=iinfo(8,ifield,ng)
      IF (job.lt.0) THEN
        vtime(tindex,ifield,ng)=finfo(4,ifield,ng)
      ELSE
        vtime(tindex,ifield,ng)=finfo(3,ifield,ng)
      END IF
!
  10  FORMAT (/,' INQUIRY_PIO  - out of range multi-files counter for', &
     &        ' variable: ',a,/,16x,'Fcount = ',i0,                     &
     &        ',   Expected range: 1 - ',i0)
  20  FORMAT (/,' INQUIRY_PIO  - unable to assign file counter, ',      &
     &        'Fcount = ',i0,/,16x,'while processing structure: ',a,    &
     &        /,16x,'and variable; ',a)
  30  FORMAT (/,' INQUIRY_PIO  - unable to find dimension ',a,          &
     &        /,16x,'for variable: ',a,/,16x,'in file: ',a,             &
     &        /,16x,'file is not CF compliant...')
  40  FORMAT (/,' INQUIRY_PIO  - too small dimension for variable ',a,  &
     &        ': ',i0,2x,i0)
  50  FORMAT (/,' INQUIRY_PIO  - unable to find requested variable: ',  &
     &        a,/,16x,'in ',a)
  60  FORMAT (/,' INQUIRY_PIO  - unable to open input NetCDF file: ',a)
  70  FORMAT (/,' INQUIRY_PIO  - error while reading variable: ',a,2x,  &
     &        ' at TIME index = ',i0)
!
      RETURN
      END SUBROUTINE inquiry_pio
# endif
 
      END MODULE inquiry_mod