Blame | Last modification | View Log | Download | RSS feed
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 thisc 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, errorc Local variable declarations.integer ncoptsc 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)endsubroutine cdfwopn(filnam,cdfid,ierr)C------------------------------------------------------------------------C Opens the NetCDF file 'filnam' and returns its identifier cdfid.C filnam char input name of NetCDF file to openC cdfid int output identifier of NetCDF fileC ierr int output error flagC------------------------------------------------------------------------include 'netcdf.inc'integer cdfid,ierrcharacter*(*) filnaminteger strendcall ncpopt(NCVERBOS)cdfid=ncopn(filnam(1:strend(filnam)),NCWRITE,ierr)returnendsubroutine cdfopn(filnam,cdfid,ierr)C------------------------------------------------------------------------C Opens the NetCDF file 'filnam' and returns its identifier cdfid.C filnam char input name of NetCDF file to openC cdfid int output identifier of NetCDF fileC ierr int output error flagC------------------------------------------------------------------------include 'netcdf.inc'integer cdfid,ierrcharacter*(*) filnaminteger strendcall ncpopt(NCVERBOS)cdfid=ncopn(filnam(1:strend(filnam)),NCNOWRIT,ierr)returnendsubroutine crecdf (filnam, cdfid, phymin, phymax, ndim, cfn,& error)c-----------------------------------------------------------------------c Purpose:c This routine is called to create a netCDF file for use withc the UWGAP plotting package.c Any netCDF file written to must be closed with the callc 'call clscdf(cdfid,error)', where cdfid and error arec as in the argumentlist below.c Arguments:c filnam char input the user-supplied netCDF file name.c cdfid int output the file-identifierc phymin real input the minimum physical dimension of thec entire physical domain along each axis.c phymin is dimensioned (ndim)c phymax real input the maximum physical dimension of thec entire physical domain along each axis.c phymax is dimensioned (ndim)c ndim int input the number of dimensions in the filec (i.e. number of elements in phymin,c phymax)c cfn char input constants file namec ('0' = no constants file).c error int output indicates possible errors found in thisc 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 MAXDIMparameter (MAXDIM=4)integer ndim, errorcharacter *(*) filnam,cfnreal phymin(*), phymax(*)c Local variable declarations.character *(20) attnamcharacter *(1) chrid(MAXDIM)integer cdfid, k, ibeg, iend, lenfil, ncoptsdata chrid/'x','y','z','a'/c Get current value of error options, and make sure netCDF-errors doc not abort executioncall ncgopt (ncopts)call ncpopt(NCVERBOS)c Initially set error to indicate no errors.error = 0c create the netCDF filecdfid = nccre (trim(filnam), NCCLOB, error)if (error.ne.0) go to 920c define global attributesdo k=1,ndimattnam(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 920attnam(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 920enddoc define constants file nameif (cfn.ne.'0') thencall 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 920endifc End variable definitions.call ncendf (cdfid, error)if (error.gt.0) goto 920c normal exitcall ncpopt (ncopts)returnc error exit920 write (6, *) 'ERROR: An error occurred while attempting to ',& 'create the data file in subroutine crecdf.'call ncpopt (ncopts)call ncclos (cdfid, error)endsubroutine 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 writec with the UWGAP plotting package.c Arguments:c filnam char input the user-supplied netCDF file name.c cdfid int output the file-identifierc phymin real output the minimum physical dimension of thec entire physical domain along each axis.c phymin is dimensioned (ndim)c phymax real output the maximum physical dimension of thec entire physical domain along each axis.c phymax is dimensioned (ndim)c ndim int output the number of dimensions in the filec (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 filec cfn char output constants file namec ('0'=no constants file).c error int output indicates possible errors found in thisc 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 MAXDIMparameter (MAXDIM=4)integer ndim, nvar, errorcharacter *(*) filnam, varnam(*),cfnreal phymin(*), phymax(*)c Local variable declarations.character *(20) attnam,vnamcharacter *(1) chrid(MAXDIM)integer cdfid, i,kinteger ncopts, ndims,ngatts,recdiminteger nvdims,vartyp,nvatts,vardim(MAXDIM)real attvalinteger lenstrdata chrid/'x','y','z','a'/data lenstr/80/c Get current value of error options and make sure netCDF-errors doc not abort executioncall ncgopt (ncopts)call ncpopt(NCVERBOS)c Initially set error to indicate no errors.error = 0c open the netCDF file for writecdfid = ncopn (trim(filnam), NCWRITE, error)if (error.ne.0) thenc try to open the netCDF file for readcdfid = ncopn (trim(filnam), NCNOWRIT, error)if (error.ne.0) go to 920endifc inquire for number of variablescall ncinq(cdfid,ndims,nvar,ngatts,recdim,error)if (error.eq.1) goto 920c read the variablesdo i=1,nvarcall ncvinq(cdfid,i,varnam(i),vartyp,nvdims,vardim,& nvatts,error)if (vartyp.ne.NCFLOAT) error=1if (error.gt.0) goto 920enddoc get global attributesk=0100 continuek=k+1attnam(1:3)='dom'attnam(4:4)=chrid(k)attnam(5:7)='min'attnam=attnam(1:7)c switch off error messagecall ncpopt(0)c check whether dimension k is presentcall ncagt(cdfid,NCGLOBAL,attnam,attval,error)if (error.gt.0) goto 110phymin(k)=attvalattnam(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 920phymax(k)=attvalif (k.lt.3) goto 100k=k+1c define ndim-parameter110 continuendim=k-1error=0c switch on error messagescall ncpopt(NCVERBOS)c get constants file namec call ncagt(cdfid,NCGLOBAL,'constants_file_name',cfn,error)c ! chrigelcall ncagtc(cdfid,NCGLOBAL,'constants_file_name',cfn,lenstr,error)if (error.gt.0) cfn='0'c normal exitcall ncpopt (ncopts)returnc error exit920 write (6, *) 'ERROR: An error occurred while attempting to ',& 'read the data file in subroutine opncdf.'call ncclos (cdfid, error)call ncpopt (ncopts)endsubroutine readcdf(filnam, cdfid,& phymin, phymax, ndim, varnam, nvar, cfn, error)c-----------------------------------------------------------------------c Purpose:c This routine is called to open a netCDF file for readc with the UWGAP plotting package.c Arguments:c filnam char input the user-supplied netCDF file name.c cdfid int output the file-identifierc phymin real output the minimum physical dimension of thec entire physical domain along each axis.c phymin is dimensioned (ndim)c phymax real output the maximum physical dimension of thec entire physical domain along each axis.c phymax is dimensioned (ndim)c ndim int output the number of dimensions in the filec (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 filec cfn char output constants file namec ('0'=no constants file).c error int output indicates possible errors found in thisc 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 MAXDIMparameter (MAXDIM=4)integer ndim, nvar, errorcharacter *(*) filnam, varnam(*),cfnreal phymin(*), phymax(*)c Local variable declarations.character *(20) attnamcharacter *(1) chrid(MAXDIM)integer cdfid, i,kinteger ncopts, ndims,ngatts,recdiminteger nvdims,vartyp,nvatts,vardim(MAXDIM)real attvalinteger lenstrdata 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 executioncall ncpopt(NCVERBOS)c Initially set error to indicate no errors.error = 0c open the netCDF file for readcdfid = ncopn (trim(filnam), NCNOWRIT, error)if (error.ne.0) go to 920c inquire for number of variablescall ncinq(cdfid,ndims,nvar,ngatts,recdim,error)if (error.eq.1) goto 920c read the variablesdo i=1,nvarcall ncvinq(cdfid,i,varnam(i),vartyp,nvdims,vardim,& nvatts,error)if (vartyp.ne.NCFLOAT) error=1c print *,varnam(i),nvdims,nvattsif (error.gt.0) goto 920enddoc get global attributesk=0100 continuek=k+1attnam(1:3)='dom'attnam(4:4)=chrid(k)attnam(5:7)='min'attnam=attnam(1:7)c switch off error messagecall ncpopt(0)c check whether dimension k is presentcall ncagt(cdfid,NCGLOBAL,attnam,attval,error)if (error.gt.0) goto 110phymin(k)=attvalattnam(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 920phymax(k)=attvalif (k.lt.4) goto 100k=k+1c define ndim-parameter110 continuendim=k-1error=0c switch on error messagescall ncpopt(NCVERBOS)c get constants file namec call ncagt(cdfid,NCGLOBAL,'constants_file_name',cfn,error)c ! chrigelcall ncagtc(cdfid,NCGLOBAL,'constants_file_name',cfn,lenstr,error)if (error.gt.0) cfn='0'c print *,cfnc normal exitcall ncpopt (ncopts)returnc error exit920 write (6, *) 'ERROR: An error occurred while attempting to ',& 'read the data file in subroutine opncdf.'call ncclos (cdfid, error)call ncpopt (ncopts)endsubroutine 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 attributesc from a netCDF file for use with the UWGAP plotting package.c It is assumed that the data is floating-point data. Prior toc calling this routine, the file must be opened with a call toc opncdf.c Arguments:c cdfid int input file-identifierc (can be obtained by calling routinec opncdf)c varnam char input the user-supplied variable name.c (can be obtained by calling routinec 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 thec origin of each variable.c is dimensioned at least Min(ndim,3).c varmax real output the extent of each variable in physicalc 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 suffiecentlyc large, at leastc vardim(1)* ... vardim(ndim)c error int output indicates possible errors found in thisc 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 MAXDIMparameter (MAXDIM=4)character *(*) varnaminteger vardim(*), ndim, error, cdfidreal misdat, stag(*), varmin(*), varmax(*), dat(*)c Local variable declarations.character *(20) dimnam(100),attnamcharacter *(1) chrid(MAXDIM)integer id,i,k,corner(MAXDIM)integer ndims,nvars,ngatts,recdim,dimsiz(100)integer vartyp,nvatts, ncoptsdata chrid/'x','y','z','a'/data corner/1,1,1,1/c Get current value of error options, and make sure netCDF-errors doc not abort executioncall ncgopt (ncopts)call ncpopt(NCVERBOS)c Initially set error to indicate no errors.error = 0c inquire for number of dimensionscall ncinq(cdfid,ndims,nvars,ngatts,recdim,error)if (error.eq.1) goto 920c read dimension-tabledo i=1,ndimscall ncdinq(cdfid,i,dimnam(i),dimsiz(i),error)if (error.gt.0) goto 920enddoc get id of the variableid=ncvid(cdfid,varnam,error)if (error.eq.1) goto 910c inquire about variablecall ncvinq(cdfid,id,varnam,vartyp,ndim,vardim,nvatts,error)if (vartyp.ne.NCFLOAT) error=1if (error.gt.0) goto 920c Make sure ndim <= MAXDIM.if (ndim.gt.MAXDIM) thenerror = 1go to 900endifc get dimensions from dimension-tabledo k=1,ndimvardim(k)=dimsiz(vardim(k))enddoc get attributesdo k=1,min0(ndim,3)c get staggeringattnam(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 920c get min postionattnam(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 920c get max positionattnam(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 920enddoc get missing data valuecall ncagt(cdfid,id,'missing_data',misdat,error)if (error.gt.0) goto 920c get datacall ncvgt(cdfid,id,corner,vardim,dat,error)if (error.gt.0) goto 920c normal exitcall ncpopt (ncopts)returnc 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)return910 write (6, *) 'ERROR: The selected variable could not be found ',& 'in the file by getcdf.'call ncpopt (ncopts)call ncclos (cdfid, error)return920 write (6, *) 'ERROR: An error occurred while attempting to ',& 'read the data file in subroutine getcdf.'call ncpopt (ncopts)call ncclos (cdfid, error)returnendsubroutine 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 attributesc onto a netCDF file for use with the UWGAP plotting package.c It is assumed that the data is floating-point data. Prior toc calling this routine, the file must be created (crecdf) orc opened (opncdf).c Any netCDF file written to must be closed with the callc call ncclos(cdfid,error), where cdfid and error arec as in the argumentlist below.c Arguments:c cdfid int input file-identifierc (can be obtained by calling routinec opncdf)c varnam char input the user-supplied variable name.c (can be obtained by calling routinec 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 thec origin of each variable.c is dimensioned at least Min(ndim,3).c varmax real input the extent of each variable in physicalc 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 suffiecentlyc large, at leastc vardim(1)* ... vardim(ndim)c error int output indicates possible errors found in thisc 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 MAXDIMparameter (MAXDIM=4)character *(*) varnaminteger vardim(*), ndim, error, cdfidreal misdat, stag(*), varmin(*), varmax(*), dat(*)c Local variable declarations.character *(20) dimnam,attnam,dimchkcharacter *(1) chrid(MAXDIM)character *(20) dimnams(MAXNCDIM)integer dimvals(MAXNCDIM)integer numdims,numvars,numgats,dimuliminteger id,did(MAXDIM),i,k,corner(MAXDIM)integer ncoptsinteger ibeg,ienddata 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 executioncall ncpopt(NCVERBOS)c Initially set error to indicate no errors.error = 0c Make sure ndim <= MAXDIM.if (ndim.gt.MAXDIM) thenerror = 1go to 900endifc Read existing dimensions-declarations from the filecall ncinq(cdfid,numdims,numvars,numgats,dimulim,error)if (error.ne.0) numdims=0if (numdims.gt.0) thendo i=1,numdimscall ncdinq(cdfid,i,dimnams(i),dimvals(i),error)c print *,dimnams(i),dimvals(i)enddoendifc put file into define modecall ncredf(cdfid,error)if (error.ne.0) goto 920c define the dimensiondo k=1,ndimc define the dimension-namedimnam(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)=-1if (numdims.gt.0) thenc check if an existing dimension-declaration can be usedc instead of defining a nuw dimensiondo i=1,numdimsdimchk=dimnams(i)if ((vardim(k).eq.dimvals(i)).and.& (dimnam(1:4).eq.dimchk(1:4))) thendid(k)=igoto 100endifenddo100 continueendifif (did(k).lt.0) thenc define the dimensiondid(k)=ncddef(cdfid,dimnam,vardim(k),error)if (error.ne.0) goto 920endifenddoc define variableid=ncvdef(cdfid,varnam,NCFLOAT,ndim,did,error)if (error.ne.0) goto 920c define attributesdo k=1,min0(ndim,3)c staggeringattnam(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 920c min postionattnam(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 920c max positionattnam(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 920enddoc define missing data valuecall ncapt(cdfid,id,'missing_data',NCFLOAT,1,misdat,error)if (error.gt.0) goto 920c leave define modecall ncendf(cdfid,error)if (error.gt.0) goto 920c define datacall ncvpt(cdfid,id,corner,vardim,dat,error)if (error.gt.0) goto 920c synchronyse output to disk and exitcall ncsnc (cdfid,error)call ncpopt (ncopts)returnc 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)return920 write (6, *) 'ERROR: An error occurred while attempting to ',& 'write the data file in subroutine putcdf.'call ncpopt (ncopts)call ncclos (cdfid, error)returnendccsubroutine getdef (cdfid, varnam, ndim, misdat,& vardim, varmin, varmax, stag, error)c-----------------------------------------------------------------------c Purpose:c This routine is called to get the dimensions and attributes ofc a variable from an IVE-NetCDF file for use with the IVE plottingc package. Prior to calling this routine, the file must be openedc with a call to opncdf.c Arguments:c cdfid int input file-identifierc (can be obtained by calling routinec opncdf)c varnam char input the user-supplied variable name.c (can be obtained by calling routinec 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 thec origin of each variable.c Is dimensioned at least Min(3,ndim).c varmax real output the extend of each variable in physicalc 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 thisc 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 MAXDIMparameter (MAXDIM=4)character *(*) varnaminteger vardim(*), ndim, error, cdfidreal misdat, stag(*), varmin(*), varmax(*)c Local variable declarations.character *(20) dimnam(MAXNCDIM),attnam,vnamcharacter *(1) chrid(MAXDIM)integer id,i,kinteger ndims,nvars,ngatts,recdim,dimsiz(MAXNCDIM)integer vartyp,nvatts, ncoptsdata chrid/'x','y','z','t'/c Get current value of error options.call ncgopt (ncopts)c make sure NetCDF-errors do not abort executioncall ncpopt(NCVERBOS)c Initially set error to indicate no errors.error = 0c inquire for number of dimensionscall ncinq(cdfid,ndims,nvars,ngatts,recdim,error)if (error.eq.1) goto 920c read dimension-tabledo i=1,ndimscall ncdinq(cdfid,i,dimnam(i),dimsiz(i),error)if (error.gt.0) goto 920enddoc get id of the variableid=ncvid(cdfid,varnam,error)if (error.eq.1) goto 910c inquire about variablecall ncvinq(cdfid,id,vnam,vartyp,ndim,vardim,nvatts,error)if (vartyp.ne.NCFLOAT) error=1if (error.gt.0) goto 920c Make sure ndim <= MAXDIM.if (ndim.gt.MAXDIM) thenerror = 1go to 900endifc get dimensions from dimension-tabledo k=1,ndimvardim(k)=dimsiz(vardim(k))enddoc get attributesdo k=1,min0(3,ndim)c get min postionattnam(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 920c get max positionattnam(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 920c get staggeringattnam(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 920enddoc get missing data valuecall ncagt(cdfid,id,'missing_data',misdat,error)if (error.gt.0) goto 920c normal exitcall ncpopt (ncopts)returnc 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)return910 write (6, *) '*ERROR*: The selected variable could not be found ',& 'in the file by getcdf.'call ncpopt (ncopts)call ncclos (cdfid, error)return920 write (6, *) '*ERROR*: An error occurred while attempting to ',& 'read the data file in subroutine getcdf.'call ncpopt (ncopts)call ncclos (cdfid, error)endsubroutine getdat(cdfid, varnam, time, level, dat, error)c-----------------------------------------------------------------------c Purpose:c This routine is called to read the data of a variablec from an IVE-NetCDF file for use with the IVE plotting package.c Prior to calling this routine, the file must be opened withc a call to opncdf (for extension) or crecdf (for creation) orc readcdf (for readonly).c Arguments:c cdfid int input file-identifierc (must be obtained by calling routinec opncdf,readcdf or crecdf)c varnam char input the user-supplied variable name (mustc previously be defined with a call toc putdef)c time real input the user-supplied time-level of thec data to be read from the file (the time-c levels stored in the file can be obtainedc with a call to gettimes).c level int input the horizontal level(s) to be readc to the NetCDF file. Suppose that thec variable is defined as (nx,ny,nz,nt).c level>0: the call reads the subdomainc (1:nx,1:ny,level,itimes)c level=0: the call reads the subdomainc (1:nx,1:ny,1:nz,itimes)c Here itimes is the time-index correspondingc to the value of 'time'.c dat real output data-array dimensioned sufficientlyc large. The dimensions (nx,ny,nz)c of the variable must previously be definedc with a call to putdef. No previousc definition of the time-dimension isc required.c error int output indicates possible errors found in thisc routine.c error = 0 no errors detected.c error = 1 the variable is not present onc the file.c error = 2 the value of 'time' is notc known.to the file.c error = 3 inconsistent value of levelc 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 getdatc-----------------------------------------------------------------------include "netcdf.inc"C Declaration of local variablescharacter*(*) varnamcharacter*(20) charsinteger cdfidreal dat(*)real misdat,varmin(4),varmax(4),stag(4)real time, timevalinteger corner(4),edgeln(4),didtim,vardim(4),ndimsinteger error, ierrinteger level,ntimeinteger idtime,idvar,iflaginteger icall ncpopt(NCVERBOS)c access the variablecall getdef (cdfid, trim(varnam), ndims, misdat,& vardim, varmin, varmax, stag, ierr)if (ierr.ne.0) thenprint *,'*ERROR* in getdef in getdat'error=1returnendifidvar=ncvid(cdfid,trim(varnam),ierr)if (ierr.ne.0) thenprint *,'*ERROR* in ncvid in getdat'error=1returnendifC Get times-arraydidtim=ncdid(cdfid,'time',ierr)if (ierr.ne.0) thenprint *,'*ERROR* didtim in getdat'error=10returnendifcall ncdinq(cdfid,didtim,chars,ntime,ierr)if (ierr.ne.0) thenprint *,'*ERROR* in ncdinq in getdat'error=10returnendifidtime=ncvid(cdfid,'time',ierr)if (ierr.ne.0) thenprint *,'*ERROR* in ncvid for time in getdat'error=10returnendifc find appropriate time-indexiflag=0do i=1,ntimecall ncvgt1(cdfid,idtime,i,timeval,ierr)if (ierr.ne.0) print *,'*ERROR* in ncvgt1 in getdat'if (time.eq.timeval) iflag=ienddoif (iflag.eq.0) thenerror=2print *,'Error: Unknown time in getdat'returnendifC Define data volume to be written (index space)corner(1)=1corner(2)=1edgeln(1)=vardim(1)edgeln(2)=vardim(2)if (level.eq.0) thencorner(3)=1edgeln(3)=vardim(3)else if ((level.le.vardim(3)).and.(level.ge.1)) thencorner(3)=leveledgeln(3)=1elseerror=3returnendifcorner(4)=iflagedgeln(4)=1C Read data from NetCDF filec print *,'getdat vor Aufruf ncvgt'c print *,'cdfid ',cdfidc print *,'idvar ',idvarc print *,'corner ',cornerc print *,'edgeln ',edgelncall ncvgt(cdfid,idvar,corner,edgeln,dat,error)if (error.ne.0) thenprint *, '*ERROR* in ncvgt in getdat'error=10endifendsubroutine putdat(cdfid, varnam, time, level, dat, error)c-----------------------------------------------------------------------c Purpose:c This routine is called to write the data of a variablec to an IVE-NetCDF file for use with the IVE plotting package.c Prior to calling this routine, the file must be opened withc a call to opncdf (for extension) or crecdf (for creation), thec variable must be defined with a call to putdef.c Arguments:c cdfid int input file-identifierc (must be obtained by calling routinec opncdf or crecdf)c varnam char input the user-supplied variable name (mustc previously be defined with a call toc putdef)c time real input the user-supplied time-level of thec data to be written to the file (the time-c levels stored in the file can be obtainedc with a call to gettimes). If 'time' is notc yet known to the file, a knew time-level isc allocated and appended to the times-array.c level int input the horizontal level(s) to be writtenc to the NetCDF file. Suppose that thec variable is defined as (nx,ny,nz,nt).c level>0: the call writes the subdomainc (1:nx,1:ny,level,itimes)c level=0: the call writes the subdomainc (1:nx,1:ny,1:nz,itimes)c Here itimes is the time-index correspondingc to the value of 'time'.c dat real output data-array dimensioned sufficientlyc large. The dimensions (nx,ny,nz)c of the variable must previously be definedc with a call to putdef. No previousc definition of the time-dimension isc required.c error int output indicates possible errors found in thisc routine.c error = 0 no errors detected.c error = 1 the variable is not present onc the file.c error = 2 the value of 'time' is new, butc appending it would yield a nonc ascending times-array.c error = 3 inconsistent value of levelc 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 variablescharacter*(*) varnamcharacter*(20) charsinteger cdfidreal dat(*)real misdat,varmin(4),varmax(4),stag(4)real time, timevaldata stag/0.,0.,0.,0./integer corner(4),edgeln(4),did(4),vardim(4),ndimsinteger error, ierrinteger level,ntimeinteger idtime,idvar,iflaginteger icall ncpopt(NCVERBOS)c get definitions of datacall 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 variableidvar=ncvid(cdfid,trim(varnam),ierr)if (ierr.ne.0) print *,'*ERROR* in ncvid in putdat'c get times-arraydid(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 startingiflag=0do i=1,ntimecall ncvgt1(cdfid,idtime,i,timeval,ierr)if (ierr.ne.0) print *,'*ERROR* in ncvgt1 in putdat'if (time.eq.timeval) iflag=ienddoif (iflag.eq.0) then ! new time stepntime=ntime+1iflag=ntimeidtime=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'endifC Define data volume to write on the NetCDF file in index spacecorner(1)=1 ! starting corner of data volumecorner(2)=1edgeln(1)=vardim(1) ! edge lengthes of data volumeedgeln(2)=vardim(2)if (level.eq.0) thencorner(3)=1edgeln(3)=vardim(3)elsecorner(3)=leveledgeln(3)=1endifcorner(4)=iflagedgeln(4)=1C Put data on NetCDF filec print *,'vor Aufruf ncvpt d.h. Daten schreiben in putdat 'c print *,'cdfid ',cdfidc print *,'idvar ',idvarc print *,'corner ',cornerc print *,'edgeln ',edgelncall ncvpt(cdfid,idvar,corner,edgeln,dat,error)if (error.ne.0) thenprint *, '*ERROR* in ncvpt in putdat - Put data on NetCDF file'endifC Synchronize output to disk and close the filescall ncsnc(cdfid,ierr)if (ierr.ne.0) print *, '*ERROR* in ncsnc in putdat'endsubroutine putdef (cdfid, varnam, ndim, misdat,& vardim, varmin, varmax, stag, error)c-----------------------------------------------------------------------c Purpose:c This routine is called to define the dimensions and thec attributes of a variable on an IVE-NetCDF file for use with thec IVE plotting package. Prior to calling this routine, the file mustc be opened with a call to opncdf (extend an existing file) orc crecdf (create a new file).c Arguments:c cdfid int input file-identifierc (can be obtained by calling routinec 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 thec variable is specified as 'unlimited'c on the file (time-dimension). It canc 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 thec origin of each variable.c Is dimensioned at least Min(3,ndim).c varmax real input the extent of each variable in physicalc 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 thisc 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 MAXDIMparameter (MAXDIM=4)character *(*) varnaminteger vardim(*), ndim, error, cdfidreal misdat, stag(*), varmin(*), varmax(*)c Local variable declarations.character *(20) dimnam,attnam,dimchkcharacter *(1) chrid(MAXDIM)character *(20) dimnams(MAXNCDIM)integer dimvals(MAXNCDIM)integer numdims,numvars,numgats,dimuliminteger id,did(MAXDIM),idtime,i,k,ierrinteger ncoptsinteger ibeg,ienddata chrid/'x','y','z','t'/c Get current value of error options.call ncgopt (ncopts)c make sure NetCDF-errors do not abort executioncall ncpopt(NCVERBOS)c Initially set error to indicate no errors.error = 0c Make sure ndim <= MAXDIM.if (ndim.gt.MAXDIM) thenerror = 10go to 900endifc Read existing dimensions-declarations from the filecall ncinq(cdfid,numdims,numvars,numgats,dimulim,error)if (numdims.gt.0) thendo i=1,numdimscall ncdinq(cdfid,i,dimnams(i),dimvals(i),error)c print *,dimnams(i),dimvals(i)enddoendifc put file into define modecall ncredf(cdfid,error)if (error.ne.0) goto 920c define spatial dimensionsdo k=1,min0(3,ndim)c define the default dimension-namedimnam(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)=-1if (numdims.gt.0) thenc check if an existing dimension-declaration can be usedc instead of defining a new dimensiondo i=1,numdimsdimchk=dimnams(i)if ((vardim(k).eq.dimvals(i)).and.& (dimnam(1:4).eq.dimchk(1:4))) thendid(k)=igoto 100endifenddo100 continueendifif (did(k).lt.0) thenc define the dimensiondid(k)=ncddef(cdfid,dimnam,vardim(k),error)if (error.ne.0) goto 920endifenddoc define the times-arrayif (ndim.eq.4) thenc define dimension and variable 'time'if (numdims.ge.4) thendid(4)=ncdid(cdfid,'time',ierr)idtime=ncvid(cdfid,'time',ierr)elsec this dimension must first be defineddid(4) = ncddef (cdfid,'time',NCUNLIM,ierr)idtime = ncvdef (cdfid,'time',NCFLOAT,1,did(4),ierr)endifendifc define variableid=ncvdef(cdfid,varnam,NCFLOAT,ndim,did,error)if (error.ne.0) goto 920c define attributesdo k=1,min0(ndim,3)c min postionattnam(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 920c max positionattnam(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 920c staggeringattnam(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 920enddoc define missing data valuecall ncapt(cdfid,id,'missing_data',NCFLOAT,1,misdat,error)if (error.gt.0) goto 920c leave define modecall ncendf(cdfid,error)if (error.gt.0) goto 920c synchronyse output to disk and exitcall ncsnc (cdfid,error)call ncpopt (ncopts)returnc 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)return920 write (6, *) '*ERROR*: An error occurred while attempting to ',& 'write the data file in subroutine putcdf.'call ncpopt (ncopts)call ncclos (cdfid, error)returnendsubroutine gettimes(cdfid,times,ntimes,ierr)C------------------------------------------------------------------------C Purpose:C Get all times on the specified NetCDF fileC Arguments:C cdfid int input identifier for NetCDF fileC 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 fileC error int output errorflagC History:C Heini Wernli, ETHZC------------------------------------------------------------------------include "netcdf.inc"integer ierr,ireal times(*)integer didtim,ntimesinteger cdfid,idtimeinteger ncoptscharacter*(20) dimnamc Get current value of error options, and make sure netCDF-errors doc not abort executioncall ncgopt (ncopts)call ncpopt(NCVERBOS)didtim=ncdid(cdfid,'time',ierr) ! inquire id for time dimensionif (ierr.ne.0) goto 900idtime=ncvid(cdfid,'time',ierr) ! inquire id for time arrayif (ierr.ne.0) goto 900call ncdinq(cdfid,didtim,dimnam,ntimes,ierr) ! inquire # of timesif (ierr.ne.0) goto 900do 10 i=1,ntimescall ncvgt1(cdfid,idtime,i,times(i),ierr) ! get timesif (ierr.ne.0) goto 90010 continuec normal exitcall ncpopt (ncopts)returnc error exit900 ntimes=1times(1)=0.call ncpopt (ncopts)endsubroutine puttimes(cdfid,times,ntimes,ierr)C------------------------------------------------------------------------C Purpose:C Get all times on the specified NetCDF fileC Arguments:C cdfid int input identifier for NetCDF fileC 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 fileC error int output errorflagC History:C Heini Wernli, ETHZC Christoph Schaer, ETHZC Note:C This preliminary version does not define the times-array, but onlyC overwrites or extends an existing times-array.C------------------------------------------------------------------------integer ierr,ireal times(*)integer didtim,ntimesinteger cdfid,idtime,nfiltiminteger ncdid,ncvididtime=ncvid(cdfid,'time',ierr) ! inquire id for time arrayif (ierr.ne.0) returndidtim=ncdid(cdfid,'time',ierr) ! inquire id for time dimensionif (ierr.ne.0) returncall ncdinq(cdfid,didtim,'time',nfiltim,ierr) ! inquire # of timesif (ierr.ne.0) returnif (nfiltim.lt.ntimes) thenprint *,'Warning: puttimes is extending times-array'else if (nfiltim.gt.ntimes) thenprint *,'Warning: puttimes does not cover range of times-array'endifdo 10 i=1,ntimescall ncvpt1(cdfid,idtime,i,times(i),ierr)if (ierr.ne.0) return10 continueendsubroutine 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 crecdfC additionally: fname_len and cfn_len, the length of theC stringsCCC History:C 981221 Mark A. Liniger ETHZCC Note:CCC------------------------------------------------------------------------integer filnam_len,ndim,cfn_len,error,cdfidcharacter *(*) filnam,cfnreal phymin(*),phymax(*)call crecdf (filnam(1:filnam_len),cdfid,phymin,phymax,ndim,& cfn(1:cfn_len),error)endsubroutine 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 crecdfC additionally: varnam_len, the length of theC stringsCCC History:C 981221 Mark A. Liniger ETHZCC Note:CCC------------------------------------------------------------------------integer varnam_len,ndim,error,vardim(*),cdfidcharacter *(*) varnamreal misdat,stag(*),varmin(*),varmax(*)call putdef (cdfid, varnam(1:varnam_len), ndim, misdat,& vardim, varmin, varmax, stag, error)endsubroutine cpp_putdat(cdfid, varnam,varnam_len,& time, level, dat, error)C------------------------------------------------------------------------C Purpose:C allows to call putdef from c++C Arguments:C see crecdfC additionally: varnam_len, the length of theC stringsCCC History:C 981221 Mark A. Liniger ETHZCC Note:CCC------------------------------------------------------------------------integer varnam_len,cdfid,error,levelcharacter *(*) varnamreal dat(*)real timecall putdat(cdfid, varnam(1:varnam_len), time, level, dat, error)endFUNCTION strbeg (string)c-----------------------------------------------------------------------c Purpose:c This function returns the position of the first nonblankc character in the input string. Returns 0 if the entirec string is blank.c Arguments:c string char input string to be examined.c History:c-----------------------------------------------------------------------IMPLICIT NONEc Function declarationINTEGER strbegc Argument declarationsCHARACTER*(*) stringc Local variable declarations.INTEGER ic External function declarations.INTEGER lenDO i = 1, len(string)strbeg = iIF (string(i:i) .NE. ' ' .AND. string(i:i) .NE. char(0)) THENRETURNENDIFENDDOstrbeg = 0ENDFUNCTION strend (string)c-----------------------------------------------------------------------c Purpose:c This function returns the position of the last nonblankc character in the input string. Returns 0 if the entirec string is blank.c Arguments:c string char input string to be examined.c History:c-----------------------------------------------------------------------IMPLICIT NONEc Function declarationINTEGER strendc Argument declarationsCHARACTER*(*) stringc Local variable declarations.INTEGER ic External function declarations.INTEGER lenDO i = len(string), 1, -1strend = iIF (string(i:i) .NE. ' ' .AND. string(i:i) .NE. char(0)) THENRETURNENDIFENDDOstrend = 0END