WebSVN – lagranto.wrf – Diff – /branches/met.nps.monterey/lib/libcdfio.f


      subroutine clscdf (cdfid, error)
c-----------------------------------------------------------------------
c     Purpose:
c        This routine closes an open netCDF file.
c     Aguments :
c        cdfid  int  input   the id of the file to be closed.
c        error  int  output  indicates possible errors found in this
c                            routine.
c                            error = 0   no errors detected.
c                            error = 1   error detected.
c     History:
c        Nov. 91  PPM  UW  Created.
c-----------------------------------------------------------------------
 
      include "netcdf.inc"
 
c     Argument declarations.
      integer      cdfid, error
 
c     Local variable declarations.
      integer      ncopts
 
c     Get current value of error options.
      call ncgopt (ncopts)
 
c     Make sure netCDF errors do not abort execution.
      call ncpopt (NCVERBOS)
 
c     Close requested file.
      call ncclos (cdfid, error)
 
c     Reset error options.
      call ncpopt (ncopts)
 
      end
 
 
      subroutine crecdf (filnam, cdfid, phymin, phymax, ndim, cfn, 
     &                   error) 
c-----------------------------------------------------------------------
c     Purpose:
c        This routine is called to create a netCDF file for use with 
c        the UWGAP plotting package.
c           Any netCDF file written to must be closed with the call
c        'call clscdf(cdfid,error)', where cdfid and error are
c        as in the argumentlist below. 
c     Arguments:
c        filnam  char  input   the user-supplied netCDF file name.
c        cdfid   int   output  the file-identifier
c        phymin  real  input   the minimum physical dimension of the
c                              entire physical domain along each axis.
c                              phymin is dimensioned (ndim)
c        phymax  real  input   the maximum physical dimension of the
c                              entire physical domain along each axis.
c                              phymax is dimensioned (ndim)
c        ndim    int   input   the number of dimensions in the file
c                              (i.e. number of elements in phymin,
c                              phymax)
c        cfn     char  input   constants file name 
c                              ('0' = no constants file).
c        error   int   output  indicates possible errors found in this
c                              routine.
c                              error = 0   no errors detected.
c                              error = 1   error detected.
c     History:
c        Nov. 91  PPM  UW  Created cr3df.
c        Jan. 92  CS   UW  Created crecdf.
c-----------------------------------------------------------------------
 
      include "netcdf.inc"
 
c     Argument declarations.
      integer        MAXDIM
      parameter      (MAXDIM=4)
      integer        ndim, error
      character *(*) filnam,cfn
      real           phymin(*), phymax(*)
 
c     Local variable declarations.
      character *(20) attnam
      character *(1)  chrid(MAXDIM)
      integer         cdfid, k, ibeg, iend, lenfil, ncopts
      data            chrid/'x','y','z','a'/
 
c     Get current value of error options, and make sure netCDF-errors do
c     not abort execution
      call ncgopt (ncopts)
      call ncpopt(NCVERBOS)
 
c     Initially set error to indicate no errors.
      error = 0
 
c     create the netCDF file
      cdfid = nccre (trim(filnam), NCCLOB, error)
      if (error.ne.0) go to 920
 
c     define global attributes
      do k=1,ndim
        attnam(1:3)='dom'
        attnam(4:4)=chrid(k)
        attnam(5:7)='min'
        attnam=attnam(1:7)
        call ncapt(cdfid,NCGLOBAL,attnam,NCFLOAT,1,phymin(k),error)
        if (error.gt.0) goto 920
 
        attnam(1:3)='dom'
        attnam(4:4)=chrid(k)
        attnam(5:7)='max'
        attnam=attnam(1:7)
        call ncapt(cdfid,NCGLOBAL,attnam,NCFLOAT,1,phymax(k),error)
        if (error.gt.0) goto 920
      enddo
 
c     define constants file name
      if (cfn.ne.'0') then
        call ncaptc (cdfid, NCGLOBAL, 'constants_file_name',
c    &             NCCHAR, len_trim(cfn)+1, cfn // char(0) , error)
     &             NCCHAR, len_trim(cfn), cfn , error)
        if (error.gt.0) goto 920
      endif
 
c     End variable definitions.
      call ncendf (cdfid, error)
      if (error.gt.0) goto 920
 
c     normal exit
      call ncpopt (ncopts)
      return
 
c     error exit
 920  write (6, *) 'ERROR: An error occurred while attempting to ',
     &             'create the data file in subroutine crecdf.'
      call ncpopt (ncopts)
      call ncclos (cdfid, error)
      end
 
      subroutine opncdf(filnam, cdfid,
     &                 phymin, phymax, ndim, varnam, nvar, cfn, error) 
c-----------------------------------------------------------------------
c     Purpose:
c        This routine is called to open a netCDF file for read and write
c        with the UWGAP plotting package. 
c     Arguments:
c        filnam  char  input   the user-supplied netCDF file name.
c        cdfid   int   output  the file-identifier
c        phymin  real  output  the minimum physical dimension of the
c                              entire physical domain along each axis.
c                              phymin is dimensioned (ndim)
c        phymax  real  output  the maximum physical dimension of the
c                              entire physical domain along each axis.
c                              phymax is dimensioned (ndim)
c        ndim    int   output  the number of dimensions in the file
c                              (i.e. number of elements in phymin,
c                              phymax)
c        varnam  char  output  an array containing the variable names.
c                              varnam is dimensioned (nvar).
c        nvar    int   output  the number of variables in the file
c        cfn     char  output  constants file name 
c                              ('0'=no constants file).
c        error   int   output  indicates possible errors found in this
c                              routine.
c                              error = 0   no errors detected.
c                              error = 1   error detected.
c     History:
c        Nov. 91  PPM  UW  Created cr3df.
c        Jan. 92  CS   UW  Created opncdf.
c-----------------------------------------------------------------------
 
      include "netcdf.inc"
 
c     Argument declarations.
      integer        MAXDIM
      parameter      (MAXDIM=4)
      integer        ndim, nvar, error
      character *(*) filnam, varnam(*),cfn
      real           phymin(*), phymax(*)
 
c     Local variable declarations.
      character *(20) attnam,vnam
      character *(1)  chrid(MAXDIM)
      integer         cdfid, i,k
      integer         ncopts, ndims,ngatts,recdim
      integer         nvdims,vartyp,nvatts,vardim(MAXDIM)
      real            attval
      integer         lenstr
      data            chrid/'x','y','z','a'/
      data            lenstr/80/
 
c     Get current value of error options and make sure netCDF-errors do 
c     not abort execution
      call ncgopt (ncopts)
      call ncpopt(NCVERBOS)
 
c     Initially set error to indicate no errors.
      error = 0
 
c     open the netCDF file for write
      cdfid = ncopn (trim(filnam), NCWRITE, error)
      if (error.ne.0) then
c       try to open the netCDF file for read
        cdfid = ncopn (trim(filnam), NCNOWRIT, error)
        if (error.ne.0) go to 920
      endif
 
c     inquire for number of variables
      call ncinq(cdfid,ndims,nvar,ngatts,recdim,error)
      if (error.eq.1) goto 920
 
c     read the variables
      do i=1,nvar
        call ncvinq(cdfid,i,varnam(i),vartyp,nvdims,vardim,
     &                         nvatts,error)
        if (vartyp.ne.NCFLOAT) error=1
        if (error.gt.0) goto 920
      enddo
 
c     get global attributes
      k=0
  100 continue
        k=k+1
        attnam(1:3)='dom'
        attnam(4:4)=chrid(k)
        attnam(5:7)='min'
        attnam=attnam(1:7)
 
c       switch off error message
        call ncpopt(0)
 
c       check whether dimension k is present
        call ncagt(cdfid,NCGLOBAL,attnam,attval,error)
        if (error.gt.0) goto 110
        phymin(k)=attval
 
        attnam(1:3)='dom'
        attnam(4:4)=chrid(k)
        attnam(5:7)='max'
        attnam=attnam(1:7)
        call ncagt(cdfid,NCGLOBAL,attnam,attval,error)
        if (error.gt.0) goto 920
        phymax(k)=attval
      if (k.lt.3) goto 100
      k=k+1
 
c     define ndim-parameter
 110  continue
      ndim=k-1
      error=0
 
c     switch on error messages
      call ncpopt(NCVERBOS)
 
c     get constants file name
c      call ncagt(cdfid,NCGLOBAL,'constants_file_name',cfn,error)
c     ! chrigel
      call ncagtc(cdfid,NCGLOBAL,'constants_file_name',cfn,lenstr,error)
      if (error.gt.0) cfn='0'
 
c     normal exit
      call ncpopt (ncopts)
      return
 
c     error exit
 920  write (6, *) 'ERROR: An error occurred while attempting to ',
     &             'read the data file in subroutine opncdf.'
      call ncclos (cdfid, error)
      call ncpopt (ncopts)
      end
 
 
      subroutine readcdf(filnam, cdfid,
     &                 phymin, phymax, ndim, varnam, nvar, cfn, error) 
c-----------------------------------------------------------------------
c     Purpose:
c        This routine is called to open a netCDF file for read 
c        with the UWGAP plotting package. 
c     Arguments:
c        filnam  char  input   the user-supplied netCDF file name.
c        cdfid   int   output  the file-identifier
c        phymin  real  output  the minimum physical dimension of the
c                              entire physical domain along each axis.
c                              phymin is dimensioned (ndim)
c        phymax  real  output  the maximum physical dimension of the
c                              entire physical domain along each axis.
c                              phymax is dimensioned (ndim)
c        ndim    int   output  the number of dimensions in the file
c                              (i.e. number of elements in phymin,
c                              phymax)
c        varnam  char  output  an array containing the variable names.
c                              varnam is dimensioned (nvar).
c        nvar    int   output  the number of variables in the file
c        cfn     char  output  constants file name 
c                              ('0'=no constants file).
c        error   int   output  indicates possible errors found in this
c                              routine.
c                              error = 0   no errors detected.
c                              error = 1   error detected.
c     History:
c        Nov. 91  PPM  UW  Created cr3df.
c        Jan. 92  CS   UW  Created opncdf.
c-----------------------------------------------------------------------
 
      include "netcdf.inc"
 
c     Argument declarations.
      integer        MAXDIM
      parameter      (MAXDIM=4)
      integer        ndim, nvar, error
      character *(*) filnam, varnam(*),cfn
      real           phymin(*), phymax(*)
 
 
c     Local variable declarations.
      character *(20) attnam
      character *(1)  chrid(MAXDIM)
      integer         cdfid, i,k
      integer         ncopts, ndims,ngatts,recdim
      integer         nvdims,vartyp,nvatts,vardim(MAXDIM)
      real            attval
      integer         lenstr
      data            chrid/'x','y','z','a'/
      data            lenstr/80/
 
c     Get current value of error options.
      call ncgopt (ncopts)
 
c     make sure netCDF-errors do not abort execution
      call ncpopt(NCVERBOS)
 
c     Initially set error to indicate no errors.
      error = 0
 
c     open the netCDF file for read
      cdfid = ncopn (trim(filnam), NCNOWRIT, error)
      if (error.ne.0) go to 920
 
c     inquire for number of variables
      call ncinq(cdfid,ndims,nvar,ngatts,recdim,error)
      if (error.eq.1) goto 920
 
c     read the variables
      do i=1,nvar
        call ncvinq(cdfid,i,varnam(i),vartyp,nvdims,vardim,
     &                         nvatts,error)
        if (vartyp.ne.NCFLOAT) error=1
c       print *,varnam(i),nvdims,nvatts
        if (error.gt.0) goto 920
      enddo
 
c     get global attributes
      k=0
  100 continue
        k=k+1
        attnam(1:3)='dom'
        attnam(4:4)=chrid(k)
        attnam(5:7)='min'
        attnam=attnam(1:7)
 
c       switch off error message
        call ncpopt(0)
 
c       check whether dimension k is present
        call ncagt(cdfid,NCGLOBAL,attnam,attval,error)
        if (error.gt.0) goto 110
        phymin(k)=attval
 
        attnam(1:3)='dom'
        attnam(4:4)=chrid(k)
        attnam(5:7)='max'
        attnam=attnam(1:7)
        call ncagt(cdfid,NCGLOBAL,attnam,attval,error)
        if (error.gt.0) goto 920
        phymax(k)=attval
      if (k.lt.4) goto 100
      k=k+1
 
c     define ndim-parameter
 110  continue
      ndim=k-1
      error=0
 
c     switch on error messages
      call ncpopt(NCVERBOS)
 
c     get constants file name
c      call ncagt(cdfid,NCGLOBAL,'constants_file_name',cfn,error)
c     ! chrigel
      call ncagtc(cdfid,NCGLOBAL,'constants_file_name',cfn,lenstr,error)
      if (error.gt.0) cfn='0'
c     print *,cfn
 
c     normal exit
      call ncpopt (ncopts)
      return
 
c     error exit
 920  write (6, *) 'ERROR: An error occurred while attempting to ',
     &             'read the data file in subroutine opncdf.'
      call ncclos (cdfid, error)
      call ncpopt (ncopts)
      end
 
 
 
      subroutine getcdf (cdfid, varnam, ndim, misdat, 
     &                       vardim, varmin, varmax, stag, dat, error)
c-----------------------------------------------------------------------
c     Purpose:
c        This routine is called to get a variable and its attributes
c        from a netCDF file for use with the UWGAP plotting package. 
c        It is assumed that the data is floating-point data. Prior to
c        calling this routine, the file must be opened with a call to
c        opncdf.
c     Arguments:
c        cdfid   int   input   file-identifier
c                              (can be obtained by calling routine 
c                              opncdf)
c        varnam  char  input   the user-supplied variable name.
c                              (can be obtained by calling routine 
c                              opncdf)
c        ndim    int   output  the number of dimensions (ndim<=4)
c        misdat  real  output  missing data value for the variable. 
c        vardim  int   output  the dimensions of the variable.
c                              is dimensioned at least (ndim). 
c        varmin  real  output  the location in physical space of the
c                              origin of each variable.
c                              is dimensioned at least Min(ndim,3). 
c        varmax  real  output  the extent of each variable in physical
c                              space.
c                              is dimensioned at least Min(ndim,3). 
c        stag    real  output  the grid staggering for each variable.
c                              is dimensioned at least Min(ndim,3). 
c        dat     real  output  data-array dimensioned suffiecently 
c                              large, at least 
c                              vardim(1)* ... vardim(ndim)
c        error   int   output  indicates possible errors found in this
c                              routine.
c                              error = 0   no errors detected.
c                              error = 1   error detected.
c     History:
c        Nov. 91  PPM  UW  Created cr3df.
c        Jan. 92  CS   UW  Created getcdf.
c-----------------------------------------------------------------------
 
      include "netcdf.inc"
 
c     Argument declarations.
      integer        MAXDIM
      parameter      (MAXDIM=4)
      character *(*) varnam
      integer        vardim(*), ndim, error, cdfid
      real           misdat,  stag(*), varmin(*), varmax(*), dat(*)
 
c     Local variable declarations.
      character *(20) dimnam(100),attnam
      character *(1)  chrid(MAXDIM)
      integer         id,i,k,corner(MAXDIM)
      integer         ndims,nvars,ngatts,recdim,dimsiz(100)
      integer         vartyp,nvatts, ncopts
      data            chrid/'x','y','z','a'/
      data            corner/1,1,1,1/
 
c     Get current value of error options, and make sure netCDF-errors do 
c     not abort execution 
      call ncgopt (ncopts)
      call ncpopt(NCVERBOS)
 
c     Initially set error to indicate no errors.
      error = 0
 
c     inquire for number of dimensions
      call ncinq(cdfid,ndims,nvars,ngatts,recdim,error)
      if (error.eq.1) goto 920
 
c     read dimension-table
      do i=1,ndims 
        call ncdinq(cdfid,i,dimnam(i),dimsiz(i),error)
        if (error.gt.0) goto 920
      enddo
 
c     get id of the variable
      id=ncvid(cdfid,varnam,error)
      if (error.eq.1) goto 910
 
c     inquire about variable
      call ncvinq(cdfid,id,varnam,vartyp,ndim,vardim,nvatts,error)
      if (vartyp.ne.NCFLOAT) error=1
      if (error.gt.0) goto 920
 
c     Make sure ndim <= MAXDIM.
      if (ndim.gt.MAXDIM) then
         error = 1
         go to 900
      endif
 
c     get dimensions from dimension-table
      do k=1,ndim 
        vardim(k)=dimsiz(vardim(k))
      enddo
 
c     get attributes
      do k=1,min0(ndim,3)
c       get staggering
        attnam(1:1)=chrid(k)
        attnam(2:5)='stag'
        attnam=attnam(1:5)
        call ncagt(cdfid,id,attnam,stag(k),error)
        if (error.gt.0) goto 920
c       get min postion
        attnam(1:1)=chrid(k)
        attnam(2:4)='min'
        attnam=attnam(1:4)
        call ncagt(cdfid,id,attnam,varmin(k),error)
        if (error.gt.0) goto 920
c       get max position     
        attnam(1:1)=chrid(k)
        attnam(2:4)='max'
        attnam=attnam(1:4)
        call ncagt(cdfid,id,attnam,varmax(k),error)
        if (error.gt.0) goto 920     
      enddo
 
c     get missing data value
      call ncagt(cdfid,id,'missing_data',misdat,error)
      if (error.gt.0) goto 920     
 
c     get data
      call ncvgt(cdfid,id,corner,vardim,dat,error)
      if (error.gt.0) goto 920
 
c     normal exit
      call ncpopt (ncopts)
      return
 
 
c     Error exits.
 900  write (6, *) 'ERROR: When calling getcdf, the number of ',
     &             'variable dimensions must be less or equal 4.'
      call ncpopt (ncopts)
      call ncclos (cdfid, error)
      return
 
 910  write (6, *) 'ERROR: The selected variable could not be found ',       
     &             'in the file by getcdf.'
      call ncpopt (ncopts)
      call ncclos (cdfid, error)
      return
 
 920  write (6, *) 'ERROR: An error occurred while attempting to ',
     &             'read the data file in subroutine getcdf.'
      call ncpopt (ncopts)
      call ncclos (cdfid, error)
      return
 
      end
 
 
      subroutine putcdf (cdfid, varnam, ndim, misdat, 
     &                       vardim, varmin, varmax, stag, dat, error)
c-----------------------------------------------------------------------
c     Purpose:
c        This routine is called to put a variable and its attributes
c        onto a netCDF file for use with the UWGAP plotting package. 
c        It is assumed that the data is floating-point data. Prior to 
c        calling this routine, the file must be created (crecdf) or
c        opened (opncdf). 
c           Any netCDF file written to must be closed with the call
c        call ncclos(cdfid,error), where cdfid and error are
c        as in the argumentlist below.
c     Arguments:
c        cdfid   int   input   file-identifier
c                              (can be obtained by calling routine 
c                              opncdf)
c        varnam  char  input   the user-supplied variable name.
c                              (can be obtained by calling routine 
c                              opncdf)
c        ndim    int   input   the number of dimensions (ndim<=4)
c        misdat  real  input   missing data value for the variable. 
c        vardim  int   input   the dimensions of the variable.
c                              is dimensioned at least (ndim). 
c        varmin  real  input   the location in physical space of the
c                              origin of each variable.
c                              is dimensioned at least Min(ndim,3). 
c        varmax  real  input   the extent of each variable in physical
c                              space.
c                              is dimensioned at least Min(ndim,3).  
c        stag    real  input   the grid staggering for each variable.
c                              is dimensioned at least Min(ndim,3).  
c        dat     real  input   data-array dimensioned suffiecently 
c                              large, at least 
c                              vardim(1)* ... vardim(ndim)
c        error   int   output  indicates possible errors found in this
c                              routine.
c                              error = 0   no errors detected.
c                              error = 1   error detected.
c     History:
c        Nov. 91  PPM  UW  Created cr3df, wr3df.
c        Jan. 92  CS   UW  Created putcdf.
c-----------------------------------------------------------------------
 
      include "netcdf.inc"
 
c     Argument declarations.
      integer        MAXDIM
      parameter      (MAXDIM=4)
      character *(*) varnam
      integer        vardim(*), ndim, error, cdfid
      real           misdat,  stag(*), varmin(*), varmax(*), dat(*)
 
c     Local variable declarations.
      character *(20) dimnam,attnam,dimchk
      character *(1)  chrid(MAXDIM)
      character *(20) dimnams(MAXNCDIM)
      integer         dimvals(MAXNCDIM)
      integer         numdims,numvars,numgats,dimulim
      integer         id,did(MAXDIM),i,k,corner(MAXDIM)
      integer         ncopts
      integer         ibeg,iend
      data            chrid/'x','y','z','t'/
      data            corner/1,1,1,1/
 
c     Get current value of error options.
      call ncgopt (ncopts)
 
c     make sure netCDF-errors do not abort execution
      call ncpopt(NCVERBOS)
 
c     Initially set error to indicate no errors.
      error = 0
 
c     Make sure ndim <= MAXDIM.
      if (ndim.gt.MAXDIM) then
         error = 1
         go to 900
      endif
 
c     Read existing dimensions-declarations from the file
      call ncinq(cdfid,numdims,numvars,numgats,dimulim,error)
      if (error.ne.0) numdims=0
      if (numdims.gt.0) then
        do i=1,numdims
          call ncdinq(cdfid,i,dimnams(i),dimvals(i),error)
c          print *,dimnams(i),dimvals(i)
        enddo
      endif
 
c     put file into define mode
      call ncredf(cdfid,error)
      if (error.ne.0) goto 920
 
c     define the dimension
      do k=1,ndim
c       define the dimension-name
        dimnam(1:3)='dim'
        dimnam(4:4)=chrid(k)
        dimnam(5:5)='_'
        dimnam(6:5+len_trim(varnam))=trim(varnam)
        dimnam=dimnam(1:5+len_trim(varnam))
        did(k)=-1
        if (numdims.gt.0) then
c         check if an existing dimension-declaration can be used
c         instead of defining a nuw dimension
          do i=1,numdims
            dimchk=dimnams(i)
            if ((vardim(k).eq.dimvals(i)).and.
     &        (dimnam(1:4).eq.dimchk(1:4))) then 
              did(k)=i
              goto 100
            endif
          enddo
 100      continue
        endif
        if (did(k).lt.0) then
c         define the dimension
          did(k)=ncddef(cdfid,dimnam,vardim(k),error)
          if (error.ne.0) goto 920
        endif
      enddo
 
c     define variable
      id=ncvdef(cdfid,varnam,NCFLOAT,ndim,did,error)
      if (error.ne.0) goto 920
 
c     define attributes
      do k=1,min0(ndim,3)
c       staggering
        attnam(1:1)=chrid(k)
        attnam(2:5)='stag'
        attnam=attnam(1:5)
        call ncapt(cdfid,id,attnam,NCFLOAT,1,stag(k),error)
        if (error.gt.0) goto 920
c       min postion
        attnam(1:1)=chrid(k)
        attnam(2:4)='min'
        attnam=attnam(1:4)
        call ncapt(cdfid,id,attnam,NCFLOAT,1,varmin(k),error)
        if (error.gt.0) goto 920
c       max position     
        attnam(1:1)=chrid(k)
        attnam(2:4)='max'
        attnam=attnam(1:4)
        call ncapt(cdfid,id,attnam,NCFLOAT,1,varmax(k),error)
        if (error.gt.0) goto 920     
      enddo
 
c     define missing data value
      call ncapt(cdfid,id,'missing_data',NCFLOAT,1,misdat,error)
      if (error.gt.0) goto 920     
 
c     leave define mode
      call ncendf(cdfid,error)
      if (error.gt.0) goto 920     
 
c     define data
      call ncvpt(cdfid,id,corner,vardim,dat,error)
      if (error.gt.0) goto 920
 
c     synchronyse output to disk and exit
      call ncsnc (cdfid,error)
      call ncpopt (ncopts)
      return
 
c     Error exits.
 900  write (6, *) 'ERROR: When calling putcdf, the number of ',
     &             'variable dimensions must be less or equal 4.'
      call ncpopt (ncopts)
      call ncclos (cdfid, error)
      return
 
 920  write (6, *) 'ERROR: An error occurred while attempting to ',
     &             'write the data file in subroutine putcdf.'
      call ncpopt (ncopts)
      call ncclos (cdfid, error)
      return
      end
c
c
      subroutine getdef (cdfid, varnam, ndim, misdat, 
     &                              vardim, varmin, varmax, stag, error)
c-----------------------------------------------------------------------
c     Purpose:
c        This routine is called to get the dimensions and attributes of 
c        a variable from an IVE-NetCDF file for use with the IVE plotting
c        package. Prior to calling this routine, the file must be opened
c        with a call to opncdf.
c     Arguments:
c        cdfid   int   input   file-identifier
c                              (can be obtained by calling routine 
c                              opncdf)
c        varnam  char  input   the user-supplied variable name.
c                              (can be obtained by calling routine 
c                              opncdf)
c        ndim    int   output  the number of dimensions (ndim<=4)
c        misdat  real  output  missing data value for the variable. 
c        vardim  int   output  the dimensions of the variable.
c                              Is dimensioned at least (ndim). 
c        varmin  real  output  the location in physical space of the
c                              origin of each variable. 
c                              Is dimensioned at least Min(3,ndim). 
c        varmax  real  output  the extend of each variable in physical
c                              space.
c                              Is dimensioned at least Min(3,ndim). 
c        stag    real  output  the grid staggering for each variable.
c                              Is dimensioned at least Min(3,ndim). 
c        error   int   output  indicates possible errors found in this
c                              routine.
c                              error = 0   no errors detected.
c                              error = 1   the variable is not on the file.
c                              error =10   other errors.
c     History:
c       Apr. 93    Christoph Schaer (ETHZ)     Created.
c-----------------------------------------------------------------------
 
      include "netcdf.inc"
 
c     Argument declarations.
      integer        MAXDIM
      parameter      (MAXDIM=4)
      character *(*) varnam
      integer        vardim(*), ndim, error, cdfid
      real           misdat,  stag(*), varmin(*), varmax(*)
 
c     Local variable declarations.
      character *(20) dimnam(MAXNCDIM),attnam,vnam
      character *(1)  chrid(MAXDIM)
      integer         id,i,k
      integer         ndims,nvars,ngatts,recdim,dimsiz(MAXNCDIM)
      integer         vartyp,nvatts, ncopts
      data            chrid/'x','y','z','t'/
 
c     Get current value of error options.
      call ncgopt (ncopts)
 
c     make sure NetCDF-errors do not abort execution
      call ncpopt(NCVERBOS)
 
c     Initially set error to indicate no errors.
      error = 0
 
c     inquire for number of dimensions
      call ncinq(cdfid,ndims,nvars,ngatts,recdim,error)
      if (error.eq.1) goto 920
 
c     read dimension-table
      do i=1,ndims 
        call ncdinq(cdfid,i,dimnam(i),dimsiz(i),error)
        if (error.gt.0) goto 920
      enddo
 
c     get id of the variable
      id=ncvid(cdfid,varnam,error)
      if (error.eq.1) goto 910
 
c     inquire about variable
      call ncvinq(cdfid,id,vnam,vartyp,ndim,vardim,nvatts,error)
      if (vartyp.ne.NCFLOAT) error=1
      if (error.gt.0) goto 920
 
c     Make sure ndim <= MAXDIM.
      if (ndim.gt.MAXDIM) then
         error = 1
         go to 900
      endif
 
c     get dimensions from dimension-table
      do k=1,ndim 
        vardim(k)=dimsiz(vardim(k))
      enddo
 
c     get attributes
      do k=1,min0(3,ndim)
c       get min postion
        attnam(1:1)=chrid(k)
        attnam(2:4)='min'
        attnam=attnam(1:4)
        call ncagt(cdfid,id,attnam,varmin(k),error)
        if (error.gt.0) goto 920
c       get max position     
        attnam(1:1)=chrid(k)
        attnam(2:4)='max'
        attnam=attnam(1:4)
        call ncagt(cdfid,id,attnam,varmax(k),error)
        if (error.gt.0) goto 920     
c       get staggering
        attnam(1:1)=chrid(k)
        attnam(2:5)='stag'
        attnam=attnam(1:5)
        call ncagt(cdfid,id,attnam,stag(k),error)
        if (error.gt.0) goto 920
      enddo
 
c     get missing data value
      call ncagt(cdfid,id,'missing_data',misdat,error)
      if (error.gt.0) goto 920     
 
c     normal exit
      call ncpopt (ncopts)
      return
 
c     Error exits.
 900  write (6, *) '*ERROR*: When calling getcdf, the number of ',
     &             'variable dimensions must be less or equal 4.'
      call ncpopt (ncopts)
      call ncclos (cdfid, error)
      return
 
 910  write (6, *) '*ERROR*: The selected variable could not be found ',       
     &             'in the file by getcdf.'
      call ncpopt (ncopts)
      call ncclos (cdfid, error)
      return
 
 920  write (6, *) '*ERROR*: An error occurred while attempting to ',
     &             'read the data file in subroutine getcdf.'
      call ncpopt (ncopts)
      call ncclos (cdfid, error)
      end
 
 
 
      subroutine getdat(cdfid, varnam, time, level, dat, error)
c-----------------------------------------------------------------------
c     Purpose:
c        This routine is called to read the data of a variable
c        from an IVE-NetCDF file for use with the IVE plotting package. 
c        Prior to calling this routine, the file must be opened with 
c        a call to opncdf (for extension) or crecdf (for creation) or
c        readcdf (for readonly).
c     Arguments:
c        cdfid   int   input   file-identifier
c                              (must be obtained by calling routine 
c                              opncdf,readcdf  or crecdf)
c        varnam  char  input   the user-supplied variable name (must 
c                              previously be defined with a call to
c                              putdef)
c        time    real  input   the user-supplied time-level of the
c                              data to be read from the file (the time-
c                              levels stored in the file can be obtained
c                              with a call to gettimes). 
c        level   int   input   the horizontal level(s) to be read 
c                              to the NetCDF file. Suppose that the
c                              variable is defined as (nx,ny,nz,nt).
c                              level>0: the call reads the subdomain
c                                       (1:nx,1:ny,level,itimes)
c                              level=0: the call reads the subdomain
c                                       (1:nx,1:ny,1:nz,itimes)
c                              Here itimes is the time-index corresponding
c                              to the value of 'time'. 
c        dat     real  output  data-array dimensioned sufficiently 
c                              large. The dimensions (nx,ny,nz)
c                              of the variable must previously be defined
c                              with a call to putdef. No previous 
c                              definition of the time-dimension is
c                              required.
c        error   int   output  indicates possible errors found in this
c                              routine.
c                              error = 0   no errors detected.
c                              error = 1   the variable is not present on
c                                          the file.
c                              error = 2   the value of 'time' is not
c                                          known.to the file.
c                              error = 3   inconsistent value of level
c                              error =10   another error.
c     History:
c       March 93    Heini Wernli (ETHZ)      Created wr2cdf.
c       April 93    Bettina Messmer (ETHZ)   Created putdat.
c       June  93    Christoph Schaer (ETHZ)  Created getdat
c       Sept. 07    Johannes Jenkner (ETHZ)  Integer and double times
c-----------------------------------------------------------------------
 
      include "netcdf.inc"
 
C     Declaration of local variables
      character*(*) varnam
      character*(20) chars,dimnam
      integer cdfid
 
      real        dat(*)
      real        misdat,varmin(3),varmax(3),stag(3)
      real        time, timeval
 
      integer     corner(4),edgeln(4),didtim,vardim(4),ndims
      integer     error, ierr
      integer     level,ntime
      integer     idtime,idvar,iflag
      integer     i
 
      integer     vtyp,dn,nat
      integer     dims(4)
      integer     inttime
      double precision doubletime
 
      call ncpopt(NCVERBOS)
 
c     access the variable
      call getdef (cdfid, trim(varnam), ndims, misdat, 
     &                           vardim, varmin, varmax, stag, ierr)
      if (ierr.ne.0) then
        print *,'*ERROR* in getdef in getdat'
        error=1
        return
      endif
      idvar=ncvid(cdfid,trim(varnam),ierr)
      if (ierr.ne.0) then
        print *,'*ERROR* in ncvid in getdat'
        error=1
        return
      endif
 
C     Get times-array
      didtim=ncdid(cdfid,'time',ierr)
      if (ierr.ne.0) then
        print *,'*ERROR* didtim in getdat'
        error=10
        return
      endif
      call ncdinq(cdfid,didtim,chars,ntime,ierr)
      if (ierr.ne.0) then
        print *,'*ERROR* in ncdinq in getdat'
        error=10
        return
      endif
      idtime=ncvid(cdfid,'time',ierr)
      if (ierr.ne.0) then
        print *,'*ERROR* in ncvid for time in getdat'
        error=10
        return
      endif
c     find appropriate time-index
      iflag=0
      call ncvinq(cdfid,idtime,dimnam,vtyp,dn,dims,natt,ierr)
      do i=1,ntime
        if (vtyp.eq.5) then
          call ncvgt1(cdfid,idtime,i,timeval,ierr)
        elseif (vtyp.eq.4) then ! integer version 
          call ncvgt1(cdfid,idtime,i,inttime,ierr) 
          timeval=real(inttime)
        elseif (vtyp.eq.6) then ! double precision version
           call ncvgt1(cdfid,idtime,i,doubletime,ierr) 
           timeval=real(doubletime)   
        endif      
        if (ierr.ne.0) print *,'*ERROR* in ncvgt1 in getdat'
        if (time.eq.timeval) iflag=i
      enddo
      if (iflag.eq.0) then
        error=2
        print *,'Error: Unknown time in getdat'
        return
      endif
 
C     Define data volume to be written (index space)
      corner(1)=1
      corner(2)=1
      edgeln(1)=vardim(1)
      edgeln(2)=vardim(2)
      if (level.eq.0) then
        corner(3)=1
        edgeln(3)=vardim(3)
      else if ((level.le.vardim(3)).and.(level.ge.1)) then
        corner(3)=level
        edgeln(3)=1
      else
        error=3
        return
      endif
      corner(4)=iflag
      edgeln(4)=1
 
C     Read data from NetCDF file
c      print *,'getdat vor Aufruf ncvgt'
c      print *,'cdfid ',cdfid
c      print *,'idvar ',idvar
c      print *,'corner ',corner
c      print *,'edgeln ',edgeln
 
      call ncvgt(cdfid,idvar,corner,edgeln,dat,error)
      if (error.ne.0) then
        print *, '*ERROR* in ncvgt in getdat'
        error=10
      endif
      end
 
 
      subroutine putdat(cdfid, varnam, time, level, dat, error)
c-----------------------------------------------------------------------
c     Purpose:
c        This routine is called to write the data of a variable
c        to an IVE-NetCDF file for use with the IVE plotting package. 
c        Prior to calling this routine, the file must be opened with 
c        a call to opncdf (for extension) or crecdf (for creation), the 
c        variable must be defined with a call to putdef.
c     Arguments:
c        cdfid   int   input   file-identifier
c                              (must be obtained by calling routine 
c                              opncdf or crecdf)
c        varnam  char  input   the user-supplied variable name (must 
c                              previously be defined with a call to
c                              putdef)
c        time    real  input   the user-supplied time-level of the
c                              data to be written to the file (the time-
c                              levels stored in the file can be obtained
c                              with a call to gettimes). If 'time' is not
c                              yet known to the file, a knew time-level is
c                              allocated and appended to the times-array.
c        level   int input     the horizontal level(s) to be written 
c                              to the NetCDF file. Suppose that the
c                              variable is defined as (nx,ny,nz,nt).
c                              level>0: the call writes the subdomain
c                                       (1:nx,1:ny,level,itimes)
c                              level=0: the call writes the subdomain
c                                       (1:nx,1:ny,1:nz,itimes)
c                              Here itimes is the time-index corresponding
c                              to the value of 'time'. 
c        dat     real  output  data-array dimensioned sufficiently 
c                              large. The dimensions (nx,ny,nz)
c                              of the variable must previously be defined
c                              with a call to putdef. No previous 
c                              definition of the time-dimension is
c                              required.
c        error   int output    indicates possible errors found in this
c                              routine.
c                              error = 0   no errors detected.
c                              error = 1   the variable is not present on
c                                          the file.
c                              error = 2   the value of 'time' is new, but
c                                          appending it would yield a non
c                                          ascending times-array.
c                              error = 3   inconsistent value of level
c                              error =10   another error.
c     History:
c       March 93    Heini Wernli (ETHZ)      Created wr2cdf.
c       April 93    Bettina Messmer (ETHZ)   Created putdat.
c-----------------------------------------------------------------------
 
      include "netcdf.inc"
 
C     Declaration of local variables
 
      character*(*) varnam
      character*(20) chars
      integer cdfid
 
 
      real 	dat(*)
      real	misdat,varmin(3),varmax(3),stag(3)
      real	time, timeval
      data	stag/0.,0.,0./
 
      integer	corner(4),edgeln(4),did(4),vardim(4),ndims
      integer	error, ierr
      integer	level,ntime
      integer	idtime,idvar,iflag
      integer	i
 
      call ncpopt(NCVERBOS)
 
c     get definitions of data
      call getdef (cdfid, trim(varnam), ndims, misdat, 
     &                           vardim, varmin, varmax, stag, ierr)
      if (ierr.ne.0)  print *,'*ERROR* in getdef in putdat'
 
c     get id of variable
      idvar=ncvid(cdfid,trim(varnam),ierr)
      if (ierr.ne.0) print *,'*ERROR* in ncvid in putdat'
 
c     get times-array 
      did(4)=ncdid(cdfid,'time',ierr)
      if (ierr.ne.0) print *,'*ERROR* did(4) in putdat'
      call ncdinq(cdfid,did(4),chars,ntime,ierr)
      if (ierr.ne.0) print *,'*ERROR* in ncdinq in putdat'
      idtime=ncvid(cdfid,'time',ierr)
      if (ierr.ne.0) print *,'*ERROR* in ncvid in putdat'
C     Check if a new time step is starting
      iflag=0
      do i=1,ntime
        call ncvgt1(cdfid,idtime,i,timeval,ierr)
        if (ierr.ne.0) print *,'*ERROR* in ncvgt1 in putdat'
        if (time.eq.timeval) iflag=i
      enddo
      if (iflag.eq.0) then		! new time step
        ntime=ntime+1
        iflag=ntime
        idtime=ncvid(cdfid,'time',ierr)
        if (ierr.ne.0) print *, '*ERROR* in ncvid in putdat'
        call ncvpt1(cdfid,idtime,ntime,time,ierr)
        if (ierr.ne.0) print *, '*ERROR* in ncvpt1 in putdat'
      endif
 
C     Define data volume to write on the NetCDF file in index space
      corner(1)=1               ! starting corner of data volume
      corner(2)=1
      edgeln(1)=vardim(1)       ! edge lengthes of data volume
      edgeln(2)=vardim(2)
      if (level.eq.0) then
        corner(3)=1
        edgeln(3)=vardim(3)
      else
        corner(3)=level
        edgeln(3)=1
      endif
      corner(4)=iflag
      edgeln(4)=1
      
C     Put data on NetCDF file
 
c      print *,'vor Aufruf ncvpt d.h. Daten schreiben in putdat '
c      print *,'cdfid ',cdfid
c      print *,'idvar ',idvar
c      print *,'corner ',corner
c      print *,'edgeln ',edgeln
 
      call ncvpt(cdfid,idvar,corner,edgeln,dat,error)
      if (error.ne.0) then
        print *, '*ERROR* in ncvpt in putdat - Put data on NetCDF file'
      endif
 
C     Synchronize output to disk and close the files
 
      call ncsnc(cdfid,ierr)
      if (ierr.ne.0) print *, '*ERROR* in ncsnc in putdat'
      end
 
 
 
 
 
 
      subroutine putdef (cdfid, varnam, ndim, misdat, 
     &                            vardim, varmin, varmax, stag, error)
c-----------------------------------------------------------------------
c     Purpose:
c        This routine is called to define the dimensions and the
c        attributes of a variable on an IVE-NetCDF file for use with the
c        IVE plotting package. Prior to calling this routine, the file must
c        be opened with a call to opncdf (extend an existing file) or
c        crecdf (create a new file).
c     Arguments:
c        cdfid   int   input   file-identifier
c                              (can be obtained by calling routine 
c                              opncdf)
c        varnam  char  input   the user-supplied variable name.
c        ndim    int   input   the number of dimensions (ndim<=4). 
c                              Upon ndim=4, the fourth dimension of the
c                              variable is specified as 'unlimited'
c                              on the file (time-dimension). It can 
c                              later be extended to arbitrary length.
c        misdat  real  input   missing data value for the variable. 
c        vardim  int   input   the dimensions of the variable.
c                              Is dimensioned at least Min(3,ndim). 
c        varmin  real  input   the location in physical space of the
c                              origin of each variable.
c                              Is dimensioned at least Min(3,ndim). 
c        varmax  real  input   the extent of each variable in physical
c                              space.
c                              Is dimensioned at least Min(ndim). 
c        stag    real  input   the grid staggering for each variable.
c                              Is dimensioned at least Min(3,ndim). 
c        error   int   output  indicates possible errors found in this
c                              routine.
c                              error = 0   no errors detected.
c                              error =10   other errors detected.
c     History:
c       Apr. 93    Christoph Schaer (ETHZ)     Created.
c-----------------------------------------------------------------------
 
      include "netcdf.inc"
 
c     Argument declarations.
      integer        MAXDIM
      parameter      (MAXDIM=4)
      character *(*) varnam
      integer        vardim(*), ndim, error, cdfid
      real           misdat,  stag(*), varmin(*), varmax(*)
 
c     Local variable declarations.
      character *(20) dimnam,attnam,dimchk
      character *(1)  chrid(MAXDIM)
      character *(20) dimnams(MAXNCDIM)
      integer         dimvals(MAXNCDIM)
      integer         numdims,numvars,numgats,dimulim
      integer         id,did(MAXDIM),idtime,i,k,ierr
      integer         ncopts
      integer         ibeg,iend
      data            chrid/'x','y','z','t'/
 
c     Get current value of error options.
      call ncgopt (ncopts)
 
c     make sure NetCDF-errors do not abort execution
      call ncpopt(NCVERBOS)
 
c     Initially set error to indicate no errors.
      error = 0
 
c     Make sure ndim <= MAXDIM.
      if (ndim.gt.MAXDIM) then
         error = 10
         go to 900
      endif
 
c     Read existing dimensions-declarations from the file
      call ncinq(cdfid,numdims,numvars,numgats,dimulim,error)
      if (numdims.gt.0) then
        do i=1,numdims
          call ncdinq(cdfid,i,dimnams(i),dimvals(i),error)
c         print *,dimnams(i),dimvals(i)
        enddo
      endif
 
c     put file into define mode
      call ncredf(cdfid,error)
      if (error.ne.0) goto 920
 
c     define spatial dimensions
      do k=1,min0(3,ndim)
c       define the default dimension-name
        dimnam(1:3)='dim'
        dimnam(4:4)=chrid(k)
        dimnam(5:5)='_'
        dimnam(6:5+len_trim(varnam))=trim(varnam)
        dimnam=dimnam(1:5+len_trim(varnam))
        did(k)=-1
        if (numdims.gt.0) then
c         check if an existing dimension-declaration can be used
c         instead of defining a new dimension
          do i=1,numdims
            dimchk=dimnams(i)
            if ((vardim(k).eq.dimvals(i)).and.
     &        (dimnam(1:4).eq.dimchk(1:4))) then 
              did(k)=i
              goto 100
            endif
          enddo
 100      continue
        endif
        if (did(k).lt.0) then
c         define the dimension
          did(k)=ncddef(cdfid,dimnam,vardim(k),error)
          if (error.ne.0) goto 920
        endif
      enddo
 
c     define the times-array
      if (ndim.eq.4) then
c       define dimension and variable 'time'
        if (numdims.ge.4) then
          did(4)=ncdid(cdfid,'time',ierr)
          idtime=ncvid(cdfid,'time',ierr)
        else
c         this dimension must first be defined
          did(4) = ncddef (cdfid,'time',NCUNLIM,ierr)
          idtime = ncvdef (cdfid,'time',NCFLOAT,1,did(4),ierr)
        endif
      endif
 
c     define variable
      id=ncvdef(cdfid,varnam,NCFLOAT,ndim,did,error)
      if (error.ne.0) goto 920
 
c     define attributes
      do k=1,min0(ndim,3)
c       min postion
        attnam(1:1)=chrid(k)
        attnam(2:4)='min'
        attnam=attnam(1:4)
        call ncapt(cdfid,id,attnam,NCFLOAT,1,varmin(k),error)
        if (error.gt.0) goto 920
c       max position     
        attnam(1:1)=chrid(k)
        attnam(2:4)='max'
        attnam=attnam(1:4)
        call ncapt(cdfid,id,attnam,NCFLOAT,1,varmax(k),error)
        if (error.gt.0) goto 920     
c       staggering
        attnam(1:1)=chrid(k)
        attnam(2:5)='stag'
        attnam=attnam(1:5)
        call ncapt(cdfid,id,attnam,NCFLOAT,1,stag(k),error)
        if (error.gt.0) goto 920
      enddo
 
c     define missing data value
      call ncapt(cdfid,id,'missing_data',NCFLOAT,1,misdat,error)
      if (error.gt.0) goto 920     
 
c     leave define mode
      call ncendf(cdfid,error)
      if (error.gt.0) goto 920     
 
c     synchronyse output to disk and exit
      call ncsnc (cdfid,error)
      call ncpopt (ncopts)
      return
 
c     Error exits.
 900  write (6, *) '*ERROR*: When calling putcdf, the number of ',
     &             'variable dimensions must be less or equal 4.'
      call ncpopt (ncopts)
      call ncclos (cdfid, error)
      return
 
 920  write (6, *) '*ERROR*: An error occurred while attempting to ',
     &             'write the data file in subroutine putcdf.'
      call ncpopt (ncopts)
      call ncclos (cdfid, error)
      return
      end
 
 
      subroutine puttimes(cdfid,times,ntimes,ierr)
C------------------------------------------------------------------------
C     Purpose:
C        Redefine all times on the specified NetCDF file
C     Arguments: 
C        cdfid  int  input   identifier for NetCDF file
C        times	real input   array contains all time values on the file,
C                            dimensioned at least times(ntimes)
C        ntimes int  input   number of times on the file
C        error  int  output  errorflag 
C     History:
C        Heini Wernli, ETHZ  
C        Christoph Schaer, ETHZ
C        Johannes Jenkner, ETHZ (adjustment for integer and double times)
C     Note:
C        This preliminary version does not define the times-array, but only
C        overwrites or extends an existing times-array.
C------------------------------------------------------------------------
 
      integer	ierr,i
      real times(*)
      integer didtim,ntimes
 
      integer	cdfid,idtime,nfiltim
      integer	ncdid,ncvid
 
      integer   vtyp,dn,nat
      integer dims(4)
 
      idtime=ncvid(cdfid,'time',ierr)   ! inquire id for time array
      if (ierr.ne.0) return
      didtim=ncdid(cdfid,'time',ierr)	! inquire id for time dimension
      if (ierr.ne.0) return
 
      call ncdinq(cdfid,didtim,'time',nfiltim,ierr)   ! inquire # of times
      if (ierr.ne.0) return
 
      call ncvinq(cdfid,idtime,dimnam,vtyp,dn,dims,natt,ierr)
 
      if (nfiltim.lt.ntimes) then
        print *,'Warning: puttimes is extending times-array'
      else if (nfiltim.gt.ntimes) then
        print *,'Warning: puttimes does not cover range of times-array'
      endif
 
      if (vtyp.eq.5) then
        do i=1,ntimes
          call ncvpt1(cdfid,idtime,i,times(i),ierr)
          if (ierr.ne.0) return
        enddo
      elseif (vtyp.eq.4) then ! integer version  
        do i=1,ntimes
          call ncvpt1(cdfid,idtime,i,int(times(i)),ierr) 
          if (ierr.ne.0) return
        enddo
      elseif (vtyp.eq.6) then ! double precision version
        do i=1,ntimes
          call ncvgt1(cdfid,idtime,i,dble(times(i)),ierr) 
          if (ierr.ne.0) return
        enddo        
      else
        return
      endif
 
      end
 
 
 
      subroutine gettimes(cdfid,times,ntimes,ierr)
C------------------------------------------------------------------------
C     Purpose:
C        Get all times on the specified NetCDF file
C     Arguments: 
C        cdfid  int  input   identifier for NetCDF file
C        times	real output  array contains all time values on the file,
C                            dimensioned at least times(ntimes)
C        ntimes int  output  number of times on the file
C        error  int  output  errorflag 
C     History:
C        Heini Wernli, ETHZ  
C        Johannes Jenkner, ETHZ (adjustment for integer and double times)
C------------------------------------------------------------------------
 
      include "netcdf.inc"
 
      integer	ierr,i
      real times(*)
      integer didtim,ntimes
 
      integer	cdfid,idtime
      integer	ncopts
      character*(20) dimnam
 
      integer   vtyp,dn,nat
      integer dims(4)
 
      integer,dimension(:),allocatable :: inttimes
      double precision,dimension(:),allocatable :: doubletimes
 
c     Get current value of error options, and make sure netCDF-errors do 
c     not abort execution
      call ncgopt (ncopts)
      call ncpopt(NCVERBOS)
 
      didtim=ncdid(cdfid,'time',ierr)	! inquire id for time dimension
      if (ierr.ne.0) goto 900
      idtime=ncvid(cdfid,'time',ierr)   ! inquire id for time array
      if (ierr.ne.0) goto 900
      call ncdinq(cdfid,didtim,dimnam,ntimes,ierr)      ! inquire # of times
      if (ierr.ne.0) goto 900
  
      call ncvinq(cdfid,idtime,dimnam,vtyp,dn,dims,natt,ierr)
 
      if (vtyp.eq.5) then
        do i=1,ntimes
          call ncvgt1(cdfid,idtime,i,times(i),ierr) ! get times
          if (ierr.ne.0) goto 900
        enddo   
      elseif (vtyp.eq.4) then ! integer version  
        allocate(inttimes(ntimes))
        do i=1,ntimes
          call ncvgt1(cdfid,idtime,i,inttimes(i),ierr) ! get times
          if (ierr.ne.0) goto 900
        enddo
        times(1:ntimes)=real(inttimes(1:ntimes))
      elseif (vtyp.eq.6) then ! double precision version
        allocate(doubletimes(ntimes))
        do i=1,ntimes
          call ncvgt1(cdfid,idtime,i,doubletimes(i),ierr) ! get times
          if (ierr.ne.0) goto 900
        enddo
        times(1:ntimes)=real(doubletimes(1:ntimes))        
      else
        goto 900
      endif
 
c     normal exit
      call ncpopt (ncopts)
      return
 
c     error exit
 900  ntimes=1
      times(1)=0.
      call ncpopt (ncopts)
      end
 
 
 
 
      subroutine cpp_crecdf(filnam,filnam_len,cdfid,phymin,phymax,ndim,
     &     cfn,cfn_len,error)
C------------------------------------------------------------------------
C     Purpose:
C        allows to call crecdf from c++
C     Arguments: 
C        see crecdf
C        additionally: fname_len and cfn_len, the length of the 
C           strings
C        
C        
C     History:
C        981221  Mark A. Liniger ETHZ
C        
C     Note:
C        
C        
C------------------------------------------------------------------------
      integer        filnam_len,ndim,cfn_len,error,cdfid
      character *(*) filnam,cfn
      real           phymin(*),phymax(*)
 
      call crecdf (filnam(1:filnam_len),cdfid,phymin,phymax,ndim,
     &     cfn(1:cfn_len),error)
 
      end
 
 
      subroutine cpp_putdef(cdfid,varnam,varnam_len,ndim,misdat,
     &     vardim,varmin,varmax,stag,error)
C------------------------------------------------------------------------
C     Purpose:
C        allows to call putdef from c++
C     Arguments: 
C        see crecdf
C        additionally: varnam_len, the length of the 
C           strings
C        
C        
C     History:
C        981221  Mark A. Liniger ETHZ
C        
C     Note:
C        
C        
C------------------------------------------------------------------------
      integer        varnam_len,ndim,error,vardim(*),cdfid
      character *(*) varnam
      real           misdat,stag(*),varmin(*),varmax(*)
 
      call putdef (cdfid, varnam(1:varnam_len), ndim, misdat, 
     &     vardim, varmin, varmax, stag, error)
 
      end
 
 
      subroutine cpp_putdat(cdfid, varnam,varnam_len, 
     &     time, level, dat, error)
C------------------------------------------------------------------------
C     Purpose:
C        allows to call putdef from c++
C     Arguments: 
C        see crecdf
C        additionally: varnam_len, the length of the 
C           strings
C        
C        
C     History:
C        981221  Mark A. Liniger ETHZ
C        
C     Note:
C        
C        
C------------------------------------------------------------------------
      integer        varnam_len,cdfid,error,level
      character *(*) varnam
      real           dat(*)
      real           time
 
      call putdat(cdfid, varnam(1:varnam_len), time, level, dat, error)
 
 
 
      end

Rev 2	Rev 10
1	`subroutine clscdf (cdfid, error)`	1	`subroutine clscdf (cdfid, error)`
2	`c-----------------------------------------------------------------------`	2	`c-----------------------------------------------------------------------`
3	`c Purpose:`	3	`c Purpose:`
4	`c This routine closes an open netCDF file.`	4	`c This routine closes an open netCDF file.`
5	`c Aguments :`	5	`c Aguments :`
6	`c cdfid int input the id of the file to be closed.`	6	`c cdfid int input the id of the file to be closed.`
7	`c error int output indicates possible errors found in this`	7	`c error int output indicates possible errors found in this`
8	`c routine.`	8	`c routine.`
9	`c error = 0 no errors detected.`	9	`c error = 0 no errors detected.`
10	`c error = 1 error detected.`	10	`c error = 1 error detected.`
11	`c History:`	11	`c History:`
12	`c Nov. 91 PPM UW Created.`	12	`c Nov. 91 PPM UW Created.`
13	`c-----------------------------------------------------------------------`	13	`c-----------------------------------------------------------------------`
14		14
15	`include "netcdf.inc"`	15	`include "netcdf.inc"`
16		16
17	`c Argument declarations.`	17	`c Argument declarations.`
18	`integer cdfid, error`	18	`integer cdfid, error`
19		19
20	`c Local variable declarations.`	20	`c Local variable declarations.`
21	`integer ncopts`	21	`integer ncopts`
22		22
23	`c Get current value of error options.`	23	`c Get current value of error options.`
24	`call ncgopt (ncopts)`	24	`call ncgopt (ncopts)`
25		25
26	`c Make sure netCDF errors do not abort execution.`	26	`c Make sure netCDF errors do not abort execution.`
27	`call ncpopt (NCVERBOS)`	27	`call ncpopt (NCVERBOS)`
28		28
29	`c Close requested file.`	29	`c Close requested file.`
30	`call ncclos (cdfid, error)`	30	`call ncclos (cdfid, error)`
31		31
32	`c Reset error options.`	32	`c Reset error options.`
33	`call ncpopt (ncopts)`	33	`call ncpopt (ncopts)`
34		34
35	`end`	35	`end`
36		36
37		37
38	`subroutine crecdf (filnam, cdfid, phymin, phymax, ndim, cfn,`	38	`subroutine crecdf (filnam, cdfid, phymin, phymax, ndim, cfn,`
39	`& error)`	39	`& error)`
40	`c-----------------------------------------------------------------------`	40	`c-----------------------------------------------------------------------`
41	`c Purpose:`	41	`c Purpose:`
42	`c This routine is called to create a netCDF file for use with`	42	`c This routine is called to create a netCDF file for use with`
43	`c the UWGAP plotting package.`	43	`c the UWGAP plotting package.`
44	`c Any netCDF file written to must be closed with the call`	44	`c Any netCDF file written to must be closed with the call`
45	`c 'call clscdf(cdfid,error)', where cdfid and error are`	45	`c 'call clscdf(cdfid,error)', where cdfid and error are`
46	`c as in the argumentlist below.`	46	`c as in the argumentlist below.`
47	`c Arguments:`	47	`c Arguments:`
48	`c filnam char input the user-supplied netCDF file name.`	48	`c filnam char input the user-supplied netCDF file name.`
49	`c cdfid int output the file-identifier`	49	`c cdfid int output the file-identifier`
50	`c phymin real input the minimum physical dimension of the`	50	`c phymin real input the minimum physical dimension of the`
51	`c entire physical domain along each axis.`	51	`c entire physical domain along each axis.`
52	`c phymin is dimensioned (ndim)`	52	`c phymin is dimensioned (ndim)`
53	`c phymax real input the maximum physical dimension of the`	53	`c phymax real input the maximum physical dimension of the`
54	`c entire physical domain along each axis.`	54	`c entire physical domain along each axis.`
55	`c phymax is dimensioned (ndim)`	55	`c phymax is dimensioned (ndim)`
56	`c ndim int input the number of dimensions in the file`	56	`c ndim int input the number of dimensions in the file`
57	`c (i.e. number of elements in phymin,`	57	`c (i.e. number of elements in phymin,`
58	`c phymax)`	58	`c phymax)`
59	`c cfn char input constants file name`	59	`c cfn char input constants file name`
60	`c ('0' = no constants file).`	60	`c ('0' = no constants file).`
61	`c error int output indicates possible errors found in this`	61	`c error int output indicates possible errors found in this`
62	`c routine.`	62	`c routine.`
63	`c error = 0 no errors detected.`	63	`c error = 0 no errors detected.`
64	`c error = 1 error detected.`	64	`c error = 1 error detected.`
65	`c History:`	65	`c History:`
66	`c Nov. 91 PPM UW Created cr3df.`	66	`c Nov. 91 PPM UW Created cr3df.`
67	`c Jan. 92 CS UW Created crecdf.`	67	`c Jan. 92 CS UW Created crecdf.`
68	`c-----------------------------------------------------------------------`	68	`c-----------------------------------------------------------------------`
69		69
70	`include "netcdf.inc"`	70	`include "netcdf.inc"`
71		71
72	`c Argument declarations.`	72	`c Argument declarations.`
73	`integer MAXDIM`	73	`integer MAXDIM`
74	`parameter (MAXDIM=4)`	74	`parameter (MAXDIM=4)`
75	`integer ndim, error`	75	`integer ndim, error`
76	`character () filnam,cfn`	76	`character () filnam,cfn`
77	`real phymin(), phymax()`	77	`real phymin(), phymax()`
78		78
79	`c Local variable declarations.`	79	`c Local variable declarations.`
80	`character *(20) attnam`	80	`character *(20) attnam`
81	`character *(1) chrid(MAXDIM)`	81	`character *(1) chrid(MAXDIM)`
82	`integer cdfid, k, ibeg, iend, lenfil, ncopts`	82	`integer cdfid, k, ibeg, iend, lenfil, ncopts`
83	`data chrid/'x','y','z','a'/`	83	`data chrid/'x','y','z','a'/`
84		84
85	`c Get current value of error options, and make sure netCDF-errors do`	85	`c Get current value of error options, and make sure netCDF-errors do`
86	`c not abort execution`	86	`c not abort execution`
87	`call ncgopt (ncopts)`	87	`call ncgopt (ncopts)`
88	`call ncpopt(NCVERBOS)`	88	`call ncpopt(NCVERBOS)`
89		89
90	`c Initially set error to indicate no errors.`	90	`c Initially set error to indicate no errors.`
91	`error = 0`	91	`error = 0`
92		92
93	`c create the netCDF file`	93	`c create the netCDF file`
94	`cdfid = nccre (trim(filnam), NCCLOB, error)`	94	`cdfid = nccre (trim(filnam), NCCLOB, error)`
95	`if (error.ne.0) go to 920`	95	`if (error.ne.0) go to 920`
96		96
97	`c define global attributes`	97	`c define global attributes`
98	`do k=1,ndim`	98	`do k=1,ndim`
99	`attnam(1:3)='dom'`	99	`attnam(1:3)='dom'`
100	`attnam(4:4)=chrid(k)`	100	`attnam(4:4)=chrid(k)`
101	`attnam(5:7)='min'`	101	`attnam(5:7)='min'`
102	`attnam=attnam(1:7)`	102	`attnam=attnam(1:7)`
103	`call ncapt(cdfid,NCGLOBAL,attnam,NCFLOAT,1,phymin(k),error)`	103	`call ncapt(cdfid,NCGLOBAL,attnam,NCFLOAT,1,phymin(k),error)`
104	`if (error.gt.0) goto 920`	104	`if (error.gt.0) goto 920`
105		105
106	`attnam(1:3)='dom'`	106	`attnam(1:3)='dom'`
107	`attnam(4:4)=chrid(k)`	107	`attnam(4:4)=chrid(k)`
108	`attnam(5:7)='max'`	108	`attnam(5:7)='max'`
109	`attnam=attnam(1:7)`	109	`attnam=attnam(1:7)`
110	`call ncapt(cdfid,NCGLOBAL,attnam,NCFLOAT,1,phymax(k),error)`	110	`call ncapt(cdfid,NCGLOBAL,attnam,NCFLOAT,1,phymax(k),error)`
111	`if (error.gt.0) goto 920`	111	`if (error.gt.0) goto 920`
112	`enddo`	112	`enddo`
113		113
114	`c define constants file name`	114	`c define constants file name`
115	`if (cfn.ne.'0') then`	115	`if (cfn.ne.'0') then`
116	`call ncaptc (cdfid, NCGLOBAL, 'constants_file_name',`	116	`call ncaptc (cdfid, NCGLOBAL, 'constants_file_name',`
117	`c & NCCHAR, len_trim(cfn)+1, cfn // char(0) , error)`	117	`c & NCCHAR, len_trim(cfn)+1, cfn // char(0) , error)`
118	`& NCCHAR, len_trim(cfn), cfn , error)`	118	`& NCCHAR, len_trim(cfn), cfn , error)`
119	`if (error.gt.0) goto 920`	119	`if (error.gt.0) goto 920`
120	`endif`	120	`endif`
121		121
122	`c End variable definitions.`	122	`c End variable definitions.`
123	`call ncendf (cdfid, error)`	123	`call ncendf (cdfid, error)`
124	`if (error.gt.0) goto 920`	124	`if (error.gt.0) goto 920`
125		125
126	`c normal exit`	126	`c normal exit`
127	`call ncpopt (ncopts)`	127	`call ncpopt (ncopts)`
128	`return`	128	`return`
129		129
130	`c error exit`	130	`c error exit`
131	`920 write (6, *) 'ERROR: An error occurred while attempting to ',`	131	`920 write (6, *) 'ERROR: An error occurred while attempting to ',`
132	`& 'create the data file in subroutine crecdf.'`	132	`& 'create the data file in subroutine crecdf.'`
133	`call ncpopt (ncopts)`	133	`call ncpopt (ncopts)`
134	`call ncclos (cdfid, error)`	134	`call ncclos (cdfid, error)`
135	`end`	135	`end`
136		136
137	`subroutine opncdf(filnam, cdfid,`	137	`subroutine opncdf(filnam, cdfid,`
138	`& phymin, phymax, ndim, varnam, nvar, cfn, error)`	138	`& phymin, phymax, ndim, varnam, nvar, cfn, error)`
139	`c-----------------------------------------------------------------------`	139	`c-----------------------------------------------------------------------`
140	`c Purpose:`	140	`c Purpose:`
141	`c This routine is called to open a netCDF file for read and write`	141	`c This routine is called to open a netCDF file for read and write`
142	`c with the UWGAP plotting package.`	142	`c with the UWGAP plotting package.`
143	`c Arguments:`	143	`c Arguments:`
144	`c filnam char input the user-supplied netCDF file name.`	144	`c filnam char input the user-supplied netCDF file name.`
145	`c cdfid int output the file-identifier`	145	`c cdfid int output the file-identifier`
146	`c phymin real output the minimum physical dimension of the`	146	`c phymin real output the minimum physical dimension of the`
147	`c entire physical domain along each axis.`	147	`c entire physical domain along each axis.`
148	`c phymin is dimensioned (ndim)`	148	`c phymin is dimensioned (ndim)`
149	`c phymax real output the maximum physical dimension of the`	149	`c phymax real output the maximum physical dimension of the`
150	`c entire physical domain along each axis.`	150	`c entire physical domain along each axis.`
151	`c phymax is dimensioned (ndim)`	151	`c phymax is dimensioned (ndim)`
152	`c ndim int output the number of dimensions in the file`	152	`c ndim int output the number of dimensions in the file`
153	`c (i.e. number of elements in phymin,`	153	`c (i.e. number of elements in phymin,`
154	`c phymax)`	154	`c phymax)`
155	`c varnam char output an array containing the variable names.`	155	`c varnam char output an array containing the variable names.`
156	`c varnam is dimensioned (nvar).`	156	`c varnam is dimensioned (nvar).`
157	`c nvar int output the number of variables in the file`	157	`c nvar int output the number of variables in the file`
158	`c cfn char output constants file name`	158	`c cfn char output constants file name`
159	`c ('0'=no constants file).`	159	`c ('0'=no constants file).`
160	`c error int output indicates possible errors found in this`	160	`c error int output indicates possible errors found in this`
161	`c routine.`	161	`c routine.`
162	`c error = 0 no errors detected.`	162	`c error = 0 no errors detected.`
163	`c error = 1 error detected.`	163	`c error = 1 error detected.`
164	`c History:`	164	`c History:`
165	`c Nov. 91 PPM UW Created cr3df.`	165	`c Nov. 91 PPM UW Created cr3df.`
166	`c Jan. 92 CS UW Created opncdf.`	166	`c Jan. 92 CS UW Created opncdf.`
167	`c-----------------------------------------------------------------------`	167	`c-----------------------------------------------------------------------`
168		168
169	`include "netcdf.inc"`	169	`include "netcdf.inc"`
170		170
171	`c Argument declarations.`	171	`c Argument declarations.`
172	`integer MAXDIM`	172	`integer MAXDIM`
173	`parameter (MAXDIM=4)`	173	`parameter (MAXDIM=4)`
174	`integer ndim, nvar, error`	174	`integer ndim, nvar, error`
175	`character () filnam, varnam(*),cfn`	175	`character () filnam, varnam(*),cfn`
176	`real phymin(), phymax()`	176	`real phymin(), phymax()`
177		177
178	`c Local variable declarations.`	178	`c Local variable declarations.`
179	`character *(20) attnam,vnam`	179	`character *(20) attnam,vnam`
180	`character *(1) chrid(MAXDIM)`	180	`character *(1) chrid(MAXDIM)`
181	`integer cdfid, i,k`	181	`integer cdfid, i,k`
182	`integer ncopts, ndims,ngatts,recdim`	182	`integer ncopts, ndims,ngatts,recdim`
183	`integer nvdims,vartyp,nvatts,vardim(MAXDIM)`	183	`integer nvdims,vartyp,nvatts,vardim(MAXDIM)`
184	`real attval`	184	`real attval`
185	`integer lenstr`	185	`integer lenstr`
186	`data chrid/'x','y','z','a'/`	186	`data chrid/'x','y','z','a'/`
187	`data lenstr/80/`	187	`data lenstr/80/`
188		188
189	`c Get current value of error options and make sure netCDF-errors do`	189	`c Get current value of error options and make sure netCDF-errors do`
190	`c not abort execution`	190	`c not abort execution`
191	`call ncgopt (ncopts)`	191	`call ncgopt (ncopts)`
192	`call ncpopt(NCVERBOS)`	192	`call ncpopt(NCVERBOS)`
193		193
194	`c Initially set error to indicate no errors.`	194	`c Initially set error to indicate no errors.`
195	`error = 0`	195	`error = 0`
196		196
197	`c open the netCDF file for write`	197	`c open the netCDF file for write`
198	`cdfid = ncopn (trim(filnam), NCWRITE, error)`	198	`cdfid = ncopn (trim(filnam), NCWRITE, error)`
199	`if (error.ne.0) then`	199	`if (error.ne.0) then`
200	`c try to open the netCDF file for read`	200	`c try to open the netCDF file for read`
201	`cdfid = ncopn (trim(filnam), NCNOWRIT, error)`	201	`cdfid = ncopn (trim(filnam), NCNOWRIT, error)`
202	`if (error.ne.0) go to 920`	202	`if (error.ne.0) go to 920`
203	`endif`	203	`endif`
204		204
205	`c inquire for number of variables`	205	`c inquire for number of variables`
206	`call ncinq(cdfid,ndims,nvar,ngatts,recdim,error)`	206	`call ncinq(cdfid,ndims,nvar,ngatts,recdim,error)`
207	`if (error.eq.1) goto 920`	207	`if (error.eq.1) goto 920`
208		208
209	`c read the variables`	209	`c read the variables`
210	`do i=1,nvar`	210	`do i=1,nvar`
211	`call ncvinq(cdfid,i,varnam(i),vartyp,nvdims,vardim,`	211	`call ncvinq(cdfid,i,varnam(i),vartyp,nvdims,vardim,`
212	`& nvatts,error)`	212	`& nvatts,error)`
213	`if (vartyp.ne.NCFLOAT) error=1`	213	`if (vartyp.ne.NCFLOAT) error=1`
214	`if (error.gt.0) goto 920`	214	`if (error.gt.0) goto 920`
215	`enddo`	215	`enddo`
216		216
217	`c get global attributes`	217	`c get global attributes`
218	`k=0`	218	`k=0`
219	`100 continue`	219	`100 continue`
220	`k=k+1`	220	`k=k+1`
221	`attnam(1:3)='dom'`	221	`attnam(1:3)='dom'`
222	`attnam(4:4)=chrid(k)`	222	`attnam(4:4)=chrid(k)`
223	`attnam(5:7)='min'`	223	`attnam(5:7)='min'`
224	`attnam=attnam(1:7)`	224	`attnam=attnam(1:7)`
225		225
226	`c switch off error message`	226	`c switch off error message`
227	`call ncpopt(0)`	227	`call ncpopt(0)`
228		228
229	`c check whether dimension k is present`	229	`c check whether dimension k is present`
230	`call ncagt(cdfid,NCGLOBAL,attnam,attval,error)`	230	`call ncagt(cdfid,NCGLOBAL,attnam,attval,error)`
231	`if (error.gt.0) goto 110`	231	`if (error.gt.0) goto 110`
232	`phymin(k)=attval`	232	`phymin(k)=attval`
233		233
234	`attnam(1:3)='dom'`	234	`attnam(1:3)='dom'`
235	`attnam(4:4)=chrid(k)`	235	`attnam(4:4)=chrid(k)`
236	`attnam(5:7)='max'`	236	`attnam(5:7)='max'`
237	`attnam=attnam(1:7)`	237	`attnam=attnam(1:7)`
238	`call ncagt(cdfid,NCGLOBAL,attnam,attval,error)`	238	`call ncagt(cdfid,NCGLOBAL,attnam,attval,error)`
239	`if (error.gt.0) goto 920`	239	`if (error.gt.0) goto 920`
240	`phymax(k)=attval`	240	`phymax(k)=attval`
241	`if (k.lt.3) goto 100`	241	`if (k.lt.3) goto 100`
242	`k=k+1`	242	`k=k+1`
243		243
244	`c define ndim-parameter`	244	`c define ndim-parameter`
245	`110 continue`	245	`110 continue`
246	`ndim=k-1`	246	`ndim=k-1`
247	`error=0`	247	`error=0`
248		248
249	`c switch on error messages`	249	`c switch on error messages`
250	`call ncpopt(NCVERBOS)`	250	`call ncpopt(NCVERBOS)`
251		251
252	`c get constants file name`	252	`c get constants file name`
253	`c call ncagt(cdfid,NCGLOBAL,'constants_file_name',cfn,error)`	253	`c call ncagt(cdfid,NCGLOBAL,'constants_file_name',cfn,error)`
254	`c ! chrigel`	254	`c ! chrigel`
255	`call ncagtc(cdfid,NCGLOBAL,'constants_file_name',cfn,lenstr,error)`	255	`call ncagtc(cdfid,NCGLOBAL,'constants_file_name',cfn,lenstr,error)`
256	`if (error.gt.0) cfn='0'`	256	`if (error.gt.0) cfn='0'`
257		257
258	`c normal exit`	258	`c normal exit`
259	`call ncpopt (ncopts)`	259	`call ncpopt (ncopts)`
260	`return`	260	`return`
261		261
262	`c error exit`	262	`c error exit`
263	`920 write (6, *) 'ERROR: An error occurred while attempting to ',`	263	`920 write (6, *) 'ERROR: An error occurred while attempting to ',`
264	`& 'read the data file in subroutine opncdf.'`	264	`& 'read the data file in subroutine opncdf.'`
265	`call ncclos (cdfid, error)`	265	`call ncclos (cdfid, error)`
266	`call ncpopt (ncopts)`	266	`call ncpopt (ncopts)`
267	`end`	267	`end`
268		268
269		269
270	`subroutine readcdf(filnam, cdfid,`	270	`subroutine readcdf(filnam, cdfid,`
271	`& phymin, phymax, ndim, varnam, nvar, cfn, error)`	271	`& phymin, phymax, ndim, varnam, nvar, cfn, error)`
272	`c-----------------------------------------------------------------------`	272	`c-----------------------------------------------------------------------`
273	`c Purpose:`	273	`c Purpose:`
274	`c This routine is called to open a netCDF file for read`	274	`c This routine is called to open a netCDF file for read`
275	`c with the UWGAP plotting package.`	275	`c with the UWGAP plotting package.`
276	`c Arguments:`	276	`c Arguments:`
277	`c filnam char input the user-supplied netCDF file name.`	277	`c filnam char input the user-supplied netCDF file name.`
278	`c cdfid int output the file-identifier`	278	`c cdfid int output the file-identifier`
279	`c phymin real output the minimum physical dimension of the`	279	`c phymin real output the minimum physical dimension of the`
280	`c entire physical domain along each axis.`	280	`c entire physical domain along each axis.`
281	`c phymin is dimensioned (ndim)`	281	`c phymin is dimensioned (ndim)`
282	`c phymax real output the maximum physical dimension of the`	282	`c phymax real output the maximum physical dimension of the`
283	`c entire physical domain along each axis.`	283	`c entire physical domain along each axis.`
284	`c phymax is dimensioned (ndim)`	284	`c phymax is dimensioned (ndim)`
285	`c ndim int output the number of dimensions in the file`	285	`c ndim int output the number of dimensions in the file`
286	`c (i.e. number of elements in phymin,`	286	`c (i.e. number of elements in phymin,`
287	`c phymax)`	287	`c phymax)`
288	`c varnam char output an array containing the variable names.`	288	`c varnam char output an array containing the variable names.`
289	`c varnam is dimensioned (nvar).`	289	`c varnam is dimensioned (nvar).`
290	`c nvar int output the number of variables in the file`	290	`c nvar int output the number of variables in the file`
291	`c cfn char output constants file name`	291	`c cfn char output constants file name`
292	`c ('0'=no constants file).`	292	`c ('0'=no constants file).`
293	`c error int output indicates possible errors found in this`	293	`c error int output indicates possible errors found in this`
294	`c routine.`	294	`c routine.`
295	`c error = 0 no errors detected.`	295	`c error = 0 no errors detected.`
296	`c error = 1 error detected.`	296	`c error = 1 error detected.`
297	`c History:`	297	`c History:`
298	`c Nov. 91 PPM UW Created cr3df.`	298	`c Nov. 91 PPM UW Created cr3df.`
299	`c Jan. 92 CS UW Created opncdf.`	299	`c Jan. 92 CS UW Created opncdf.`
300	`c-----------------------------------------------------------------------`	300	`c-----------------------------------------------------------------------`
301		301
302	`include "netcdf.inc"`	302	`include "netcdf.inc"`
303		303
304	`c Argument declarations.`	304	`c Argument declarations.`
305	`integer MAXDIM`	305	`integer MAXDIM`
306	`parameter (MAXDIM=4)`	306	`parameter (MAXDIM=4)`
307	`integer ndim, nvar, error`	307	`integer ndim, nvar, error`
308	`character () filnam, varnam(*),cfn`	308	`character () filnam, varnam(*),cfn`
309	`real phymin(), phymax()`	309	`real phymin(), phymax()`
310		310
311		311
312	`c Local variable declarations.`	312	`c Local variable declarations.`
313	`character *(20) attnam`	313	`character *(20) attnam`
314	`character *(1) chrid(MAXDIM)`	314	`character *(1) chrid(MAXDIM)`
315	`integer cdfid, i,k`	315	`integer cdfid, i,k`
316	`integer ncopts, ndims,ngatts,recdim`	316	`integer ncopts, ndims,ngatts,recdim`
317	`integer nvdims,vartyp,nvatts,vardim(MAXDIM)`	317	`integer nvdims,vartyp,nvatts,vardim(MAXDIM)`
318	`real attval`	318	`real attval`
319	`integer lenstr`	319	`integer lenstr`
320	`data chrid/'x','y','z','a'/`	320	`data chrid/'x','y','z','a'/`
321	`data lenstr/80/`	321	`data lenstr/80/`
322		322
323	`c Get current value of error options.`	323	`c Get current value of error options.`
324	`call ncgopt (ncopts)`	324	`call ncgopt (ncopts)`
325		325
326	`c make sure netCDF-errors do not abort execution`	326	`c make sure netCDF-errors do not abort execution`
327	`call ncpopt(NCVERBOS)`	327	`call ncpopt(NCVERBOS)`
328		328
329	`c Initially set error to indicate no errors.`	329	`c Initially set error to indicate no errors.`
330	`error = 0`	330	`error = 0`
331		331
332	`c open the netCDF file for read`	332	`c open the netCDF file for read`
333	`cdfid = ncopn (trim(filnam), NCNOWRIT, error)`	333	`cdfid = ncopn (trim(filnam), NCNOWRIT, error)`
334	`if (error.ne.0) go to 920`	334	`if (error.ne.0) go to 920`
335		335
336	`c inquire for number of variables`	336	`c inquire for number of variables`
337	`call ncinq(cdfid,ndims,nvar,ngatts,recdim,error)`	337	`call ncinq(cdfid,ndims,nvar,ngatts,recdim,error)`
338	`if (error.eq.1) goto 920`	338	`if (error.eq.1) goto 920`
339		339
340	`c read the variables`	340	`c read the variables`
341	`do i=1,nvar`	341	`do i=1,nvar`
342	`call ncvinq(cdfid,i,varnam(i),vartyp,nvdims,vardim,`	342	`call ncvinq(cdfid,i,varnam(i),vartyp,nvdims,vardim,`
343	`& nvatts,error)`	343	`& nvatts,error)`
344	`if (vartyp.ne.NCFLOAT) error=1`	344	`if (vartyp.ne.NCFLOAT) error=1`
345	`c print *,varnam(i),nvdims,nvatts`	345	`c print *,varnam(i),nvdims,nvatts`
346	`if (error.gt.0) goto 920`	346	`if (error.gt.0) goto 920`
347	`enddo`	347	`enddo`
348		348
349	`c get global attributes`	349	`c get global attributes`
350	`k=0`	350	`k=0`
351	`100 continue`	351	`100 continue`
352	`k=k+1`	352	`k=k+1`
353	`attnam(1:3)='dom'`	353	`attnam(1:3)='dom'`
354	`attnam(4:4)=chrid(k)`	354	`attnam(4:4)=chrid(k)`
355	`attnam(5:7)='min'`	355	`attnam(5:7)='min'`
356	`attnam=attnam(1:7)`	356	`attnam=attnam(1:7)`
357		357
358	`c switch off error message`	358	`c switch off error message`
359	`call ncpopt(0)`	359	`call ncpopt(0)`
360		360
361	`c check whether dimension k is present`	361	`c check whether dimension k is present`
362	`call ncagt(cdfid,NCGLOBAL,attnam,attval,error)`	362	`call ncagt(cdfid,NCGLOBAL,attnam,attval,error)`
363	`if (error.gt.0) goto 110`	363	`if (error.gt.0) goto 110`
364	`phymin(k)=attval`	364	`phymin(k)=attval`
365		365
366	`attnam(1:3)='dom'`	366	`attnam(1:3)='dom'`
367	`attnam(4:4)=chrid(k)`	367	`attnam(4:4)=chrid(k)`
368	`attnam(5:7)='max'`	368	`attnam(5:7)='max'`
369	`attnam=attnam(1:7)`	369	`attnam=attnam(1:7)`
370	`call ncagt(cdfid,NCGLOBAL,attnam,attval,error)`	370	`call ncagt(cdfid,NCGLOBAL,attnam,attval,error)`
371	`if (error.gt.0) goto 920`	371	`if (error.gt.0) goto 920`
372	`phymax(k)=attval`	372	`phymax(k)=attval`
373	`if (k.lt.4) goto 100`	373	`if (k.lt.4) goto 100`
374	`k=k+1`	374	`k=k+1`
375		375
376	`c define ndim-parameter`	376	`c define ndim-parameter`
377	`110 continue`	377	`110 continue`
378	`ndim=k-1`	378	`ndim=k-1`
379	`error=0`	379	`error=0`
380		380
381	`c switch on error messages`	381	`c switch on error messages`
382	`call ncpopt(NCVERBOS)`	382	`call ncpopt(NCVERBOS)`
383		383
384	`c get constants file name`	384	`c get constants file name`
385	`c call ncagt(cdfid,NCGLOBAL,'constants_file_name',cfn,error)`	385	`c call ncagt(cdfid,NCGLOBAL,'constants_file_name',cfn,error)`
386	`c ! chrigel`	386	`c ! chrigel`
387	`call ncagtc(cdfid,NCGLOBAL,'constants_file_name',cfn,lenstr,error)`	387	`call ncagtc(cdfid,NCGLOBAL,'constants_file_name',cfn,lenstr,error)`
388	`if (error.gt.0) cfn='0'`	388	`if (error.gt.0) cfn='0'`
389	`c print *,cfn`	389	`c print *,cfn`
390		390
391	`c normal exit`	391	`c normal exit`
392	`call ncpopt (ncopts)`	392	`call ncpopt (ncopts)`
393	`return`	393	`return`
394		394
395	`c error exit`	395	`c error exit`
396	`920 write (6, *) 'ERROR: An error occurred while attempting to ',`	396	`920 write (6, *) 'ERROR: An error occurred while attempting to ',`
397	`& 'read the data file in subroutine opncdf.'`	397	`& 'read the data file in subroutine opncdf.'`
398	`call ncclos (cdfid, error)`	398	`call ncclos (cdfid, error)`
399	`call ncpopt (ncopts)`	399	`call ncpopt (ncopts)`
400	`end`	400	`end`
401		401
402		402
403		403
404	`subroutine getcdf (cdfid, varnam, ndim, misdat,`	404	`subroutine getcdf (cdfid, varnam, ndim, misdat,`
405	`& vardim, varmin, varmax, stag, dat, error)`	405	`& vardim, varmin, varmax, stag, dat, error)`
406	`c-----------------------------------------------------------------------`	406	`c-----------------------------------------------------------------------`
407	`c Purpose:`	407	`c Purpose:`
408	`c This routine is called to get a variable and its attributes`	408	`c This routine is called to get a variable and its attributes`
409	`c from a netCDF file for use with the UWGAP plotting package.`	409	`c from a netCDF file for use with the UWGAP plotting package.`
410	`c It is assumed that the data is floating-point data. Prior to`	410	`c It is assumed that the data is floating-point data. Prior to`
411	`c calling this routine, the file must be opened with a call to`	411	`c calling this routine, the file must be opened with a call to`
412	`c opncdf.`	412	`c opncdf.`
413	`c Arguments:`	413	`c Arguments:`
414	`c cdfid int input file-identifier`	414	`c cdfid int input file-identifier`
415	`c (can be obtained by calling routine`	415	`c (can be obtained by calling routine`
416	`c opncdf)`	416	`c opncdf)`
417	`c varnam char input the user-supplied variable name.`	417	`c varnam char input the user-supplied variable name.`
418	`c (can be obtained by calling routine`	418	`c (can be obtained by calling routine`
419	`c opncdf)`	419	`c opncdf)`
420	`c ndim int output the number of dimensions (ndim<=4)`	420	`c ndim int output the number of dimensions (ndim<=4)`
421	`c misdat real output missing data value for the variable.`	421	`c misdat real output missing data value for the variable.`
422	`c vardim int output the dimensions of the variable.`	422	`c vardim int output the dimensions of the variable.`
423	`c is dimensioned at least (ndim).`	423	`c is dimensioned at least (ndim).`
424	`c varmin real output the location in physical space of the`	424	`c varmin real output the location in physical space of the`
425	`c origin of each variable.`	425	`c origin of each variable.`
426	`c is dimensioned at least Min(ndim,3).`	426	`c is dimensioned at least Min(ndim,3).`
427	`c varmax real output the extent of each variable in physical`	427	`c varmax real output the extent of each variable in physical`
428	`c space.`	428	`c space.`
429	`c is dimensioned at least Min(ndim,3).`	429	`c is dimensioned at least Min(ndim,3).`
430	`c stag real output the grid staggering for each variable.`	430	`c stag real output the grid staggering for each variable.`
431	`c is dimensioned at least Min(ndim,3).`	431	`c is dimensioned at least Min(ndim,3).`
432	`c dat real output data-array dimensioned suffiecently`	432	`c dat real output data-array dimensioned suffiecently`
433	`c large, at least`	433	`c large, at least`
434	`c vardim(1)* ... vardim(ndim)`	434	`c vardim(1)* ... vardim(ndim)`
435	`c error int output indicates possible errors found in this`	435	`c error int output indicates possible errors found in this`
436	`c routine.`	436	`c routine.`
437	`c error = 0 no errors detected.`	437	`c error = 0 no errors detected.`
438	`c error = 1 error detected.`	438	`c error = 1 error detected.`
439	`c History:`	439	`c History:`
440	`c Nov. 91 PPM UW Created cr3df.`	440	`c Nov. 91 PPM UW Created cr3df.`
441	`c Jan. 92 CS UW Created getcdf.`	441	`c Jan. 92 CS UW Created getcdf.`
442	`c-----------------------------------------------------------------------`	442	`c-----------------------------------------------------------------------`
443		443
444	`include "netcdf.inc"`	444	`include "netcdf.inc"`
445		445
446	`c Argument declarations.`	446	`c Argument declarations.`
447	`integer MAXDIM`	447	`integer MAXDIM`
448	`parameter (MAXDIM=4)`	448	`parameter (MAXDIM=4)`
449	`character () varnam`	449	`character () varnam`
450	`integer vardim(*), ndim, error, cdfid`	450	`integer vardim(*), ndim, error, cdfid`
451	`real misdat, stag(), varmin(), varmax(), dat()`	451	`real misdat, stag(), varmin(), varmax(), dat()`
452		452
453	`c Local variable declarations.`	453	`c Local variable declarations.`
454	`character *(20) dimnam(100),attnam`	454	`character *(20) dimnam(100),attnam`
455	`character *(1) chrid(MAXDIM)`	455	`character *(1) chrid(MAXDIM)`
456	`integer id,i,k,corner(MAXDIM)`	456	`integer id,i,k,corner(MAXDIM)`
457	`integer ndims,nvars,ngatts,recdim,dimsiz(100)`	457	`integer ndims,nvars,ngatts,recdim,dimsiz(100)`
458	`integer vartyp,nvatts, ncopts`	458	`integer vartyp,nvatts, ncopts`
459	`data chrid/'x','y','z','a'/`	459	`data chrid/'x','y','z','a'/`
460	`data corner/1,1,1,1/`	460	`data corner/1,1,1,1/`
461		461
462	`c Get current value of error options, and make sure netCDF-errors do`	462	`c Get current value of error options, and make sure netCDF-errors do`
463	`c not abort execution`	463	`c not abort execution`
464	`call ncgopt (ncopts)`	464	`call ncgopt (ncopts)`
465	`call ncpopt(NCVERBOS)`	465	`call ncpopt(NCVERBOS)`
466		466
467	`c Initially set error to indicate no errors.`	467	`c Initially set error to indicate no errors.`
468	`error = 0`	468	`error = 0`
469		469
470	`c inquire for number of dimensions`	470	`c inquire for number of dimensions`
471	`call ncinq(cdfid,ndims,nvars,ngatts,recdim,error)`	471	`call ncinq(cdfid,ndims,nvars,ngatts,recdim,error)`
472	`if (error.eq.1) goto 920`	472	`if (error.eq.1) goto 920`
473		473
474	`c read dimension-table`	474	`c read dimension-table`
475	`do i=1,ndims`	475	`do i=1,ndims`
476	`call ncdinq(cdfid,i,dimnam(i),dimsiz(i),error)`	476	`call ncdinq(cdfid,i,dimnam(i),dimsiz(i),error)`
477	`if (error.gt.0) goto 920`	477	`if (error.gt.0) goto 920`
478	`enddo`	478	`enddo`
479		479
480	`c get id of the variable`	480	`c get id of the variable`
481	`id=ncvid(cdfid,varnam,error)`	481	`id=ncvid(cdfid,varnam,error)`
482	`if (error.eq.1) goto 910`	482	`if (error.eq.1) goto 910`
483		483
484	`c inquire about variable`	484	`c inquire about variable`
485	`call ncvinq(cdfid,id,varnam,vartyp,ndim,vardim,nvatts,error)`	485	`call ncvinq(cdfid,id,varnam,vartyp,ndim,vardim,nvatts,error)`
486	`if (vartyp.ne.NCFLOAT) error=1`	486	`if (vartyp.ne.NCFLOAT) error=1`
487	`if (error.gt.0) goto 920`	487	`if (error.gt.0) goto 920`
488		488
489	`c Make sure ndim <= MAXDIM.`	489	`c Make sure ndim <= MAXDIM.`
490	`if (ndim.gt.MAXDIM) then`	490	`if (ndim.gt.MAXDIM) then`
491	`error = 1`	491	`error = 1`
492	`go to 900`	492	`go to 900`
493	`endif`	493	`endif`
494		494
495	`c get dimensions from dimension-table`	495	`c get dimensions from dimension-table`
496	`do k=1,ndim`	496	`do k=1,ndim`
497	`vardim(k)=dimsiz(vardim(k))`	497	`vardim(k)=dimsiz(vardim(k))`
498	`enddo`	498	`enddo`
499		499
500	`c get attributes`	500	`c get attributes`

Subversion Repositories lagranto.wrf

(root)/branches/met.nps.monterey/lib/libcdfio.f – Rev 2 → 10