Blame | Last modification | View Log | Download | RSS feed
subroutine wricst(cstnam,datar,aklev,bklev,aklay,bklay,stdate)C------------------------------------------------------------------------C Creates the constants file for NetCDF files containing ECMWFC data. The constants file is compatible with the one createdC for EM data (with subroutine writecst).CC Input parameters:CC cstnam name of constants fileC datar array contains all required parameters to write fileC datar(1): number of points along xC datar(2): number of points along yC datar(3): maximum latitude of data region (ymax)C datar(4): minimum longitude of data region (xmin)C datar(5): minimum latitude of data region (ymin)C datar(6): maximum longitude of data region (xmax)C datar(7): grid increment along xC datar(8): grid increment along yC datar(9): number of levelsC datar(10): data type (forecast or analysis)C datar(11): data versionC datar(12): constants file versionC datar(13): longitude of pole of coordinate systemC datar(14): latitude of pole of coordinate systemC aklev array contains the aklev valuesC bklev array contains the bklev valuesC aklay array contains the aklay valuesC bklay array contains the bklay valuesC stdate array contains date (year,month,day,time,step) of firstC field on file (start-date), dimensionised as stdate(5)C------------------------------------------------------------------------include "netcdf.inc"integer nchar,maxlevparameter (nchar=20,maxlev=32)real aklev(maxlev),bklev(maxlev)real aklay(maxlev),bklay(maxlev)real pollat,latmin,latmaxinteger datar(14)integer stdate(5)character*80 cstnamC declarations for constants-variablesinteger nzinteger dattyp, datver, cstverC further declarationsinteger ierr ! error flaginteger cdfid ! NetCDF idinteger xid,yid,zid ! dimension idsinteger pollonid, pollatid, ! variable ids> aklevid, bklevid, aklayid, bklayid,> lonminid, lonmaxid, latminid, latmaxid,> dellonid, dellatid,> startyid, startmid, startdid, starthid, startsid,> dattypid, datverid, cstveridnz=datar(9) ! number of levelsC Set data-type and -version, version of cst-file-formatdattyp=datar(10)datver=datar(11)cstver=datar(12)C Initially set error to falseierr=0C Create constants filecdfid=nccre(trim(cstnam),NCCLOB,ierr)C Define the dimensionsxid = ncddef (cdfid,'nx',datar(1),ierr)yid = ncddef (cdfid,'ny',datar(2),ierr)zid = ncddef (cdfid,'nz',datar(9),ierr)C Define integer constantspollonid = ncvdef(cdfid,'pollon', NCFLOAT,0,0,ierr)pollatid = ncvdef(cdfid,'pollat', NCFLOAT,0,0,ierr)aklevid = ncvdef (cdfid, 'aklev', NCFLOAT, 1, zid, ierr)bklevid = ncvdef (cdfid, 'bklev', NCFLOAT, 1, zid, ierr)aklayid = ncvdef (cdfid, 'aklay', NCFLOAT, 1, zid, ierr)bklayid = ncvdef (cdfid, 'bklay', NCFLOAT, 1, zid, ierr)lonminid = ncvdef (cdfid, 'lonmin', NCFLOAT, 0, 0, ierr)lonmaxid = ncvdef (cdfid, 'lonmax', NCFLOAT, 0, 0, ierr)latminid = ncvdef (cdfid, 'latmin', NCFLOAT, 0, 0, ierr)latmaxid = ncvdef (cdfid, 'latmax', NCFLOAT, 0, 0, ierr)dellonid = ncvdef (cdfid, 'dellon', NCFLOAT, 0, 0, ierr)dellatid = ncvdef (cdfid, 'dellat', NCFLOAT, 0, 0, ierr)startyid = ncvdef (cdfid, 'starty', NCLONG, 0, 0, ierr)startmid = ncvdef (cdfid, 'startm', NCLONG, 0, 0, ierr)startdid = ncvdef (cdfid, 'startd', NCLONG, 0, 0, ierr)starthid = ncvdef (cdfid, 'starth', NCLONG, 0, 0, ierr)startsid = ncvdef (cdfid, 'starts', NCLONG, 0, 0, ierr)dattypid = ncvdef (cdfid, 'dattyp', NCLONG, 0, 0, ierr)datverid = ncvdef (cdfid, 'datver', NCLONG, 0, 0, ierr)cstverid = ncvdef (cdfid, 'cstver', NCLONG, 0, 0, ierr)C Leave define modecall ncendf(cdfid,ierr)C Store levelscall ncvpt(cdfid, aklevid, 1, nz, aklev, ierr)call ncvpt(cdfid, bklevid, 1, nz, bklev, ierr)call ncvpt(cdfid, aklayid, 1, nz, aklay, ierr)call ncvpt(cdfid, bklayid, 1, nz, bklay, ierr)C Store position of pole (trivial for ECMWF data)call ncvpt1(cdfid, pollonid, 1, real(datar(13))/1000., ierr)if (datar(14).gt.0) thenpollat=min(real(datar(14))/1000.,90.)elsepollat=max(real(datar(14))/1000.,-90.)endifcall ncvpt1(cdfid, pollatid, 1, pollat, ierr)C Store horizontal data borders and grid incrementscall ncvpt1(cdfid, lonminid, 1, real(datar(4))/1000., ierr)call ncvpt1(cdfid, lonmaxid, 1, real(datar(6))/1000., ierr)latmin=max(real(datar(5))/1000.,-90.)latmax=min(real(datar(3))/1000.,90.)call ncvpt1(cdfid, latminid, 1, latmin, ierr)call ncvpt1(cdfid, latmaxid, 1, latmax, ierr)call ncvpt1(cdfid, dellonid, 1, real(datar(7))/1000., ierr)call ncvpt1(cdfid, dellatid, 1, real(datar(8))/1000., ierr)C Store date of first field on file (start-date)call ncvpt1(cdfid, startyid, 1, stdate(1), ierr)call ncvpt1(cdfid, startmid, 1, stdate(2), ierr)call ncvpt1(cdfid, startdid, 1, stdate(3), ierr)call ncvpt1(cdfid, starthid, 1, stdate(4), ierr)call ncvpt1(cdfid, startsid, 1, stdate(5), ierr)C Store datatype and versioncall ncvpt1(cdfid, dattypid, 1, dattyp, ierr)call ncvpt1(cdfid, datverid, 1, datver, ierr)C Store version of the constants file formatcall ncvpt1(cdfid, cstverid, 1, cstver, ierr)C Store stringscall ncclos(cdfid,ierr)returnendsubroutine writelmcst(cdfid,nx,ny,nz,pollon,pollat,lonmin,&lonmax,latmin,latmax,dellon,dellat,dattyp,datver,cstver,&psref,tstar,tbeta,pintf,p0top,idate)c ------------------------------------------------------------------implicit noneinteger cdfidc deklarationen der constants-variablenreal pollon,pollatreal lonmin,lonmax,latmin,latmax,dellon,dellatinteger idate(5)integer nx,ny,nzinteger dattyp, datver, cstverreal psref, tstar, tbeta, pintf, p0topinclude 'netcdf.inc'* netcdf declarationinteger iret, k* dimension idsinteger nxdim, nydim, nzdim* variable idsinteger startyid, startmid, startdid, starthid* variable shapes, corners and edge lengthsinteger dims(1), corner(1), edges(1)* enter define modecall ncredf(cdfid, iret)startyid = ncvdef (cdfid, 'starty', NCLONG, 0, 0, iret)startmid = ncvdef (cdfid, 'startm', NCLONG, 0, 0, iret)startdid = ncvdef (cdfid, 'startd', NCLONG, 0, 0, iret)starthid = ncvdef (cdfid, 'starth', NCLONG, 0, 0, iret)* store the rest as global attributes* store nx,ny,nzcall ncapt(cdfid,NCGLOBAL,'nx',NCLONG,1,nx,iret)call ncapt(cdfid,NCGLOBAL,'ny',NCLONG,1,ny,iret)call ncapt(cdfid,NCGLOBAL,'nz',NCLONG,1,nz,iret)* store pollon, pollatcall ncapt(cdfid,NCGLOBAL,'pollon',NCFLOAT,1,pollon,iret)call ncapt(cdfid,NCGLOBAL,'pollat',NCFLOAT,1,pollat,iret)* store lonmin, etccall ncapt(cdfid,NCGLOBAL,'lonmin',NCFLOAT,1,lonmin,iret)call ncapt(cdfid,NCGLOBAL,'lonmax',NCFLOAT,1,lonmax,iret)call ncapt(cdfid,NCGLOBAL,'latmin',NCFLOAT,1,latmin,iret)call ncapt(cdfid,NCGLOBAL,'latmax',NCFLOAT,1,latmax,iret)call ncapt(cdfid,NCGLOBAL,'dellon',NCFLOAT,1,dellon,iret)call ncapt(cdfid,NCGLOBAL,'dellat',NCFLOAT,1,dellat,iret)* store data type and versioncall ncapt(cdfid,NCGLOBAL,'dattyp',NCLONG,1,dattyp,iret)call ncapt(cdfid,NCGLOBAL,'datver',NCLONG,1,datver,iret)call ncapt(cdfid,NCGLOBAL,'cstver',NCLONG,1,cstver,iret)* store information of lm model vertical gridcall ncapt(cdfid,NCGLOBAL,'psref',NCFLOAT,1,psref,iret)call ncapt(cdfid,NCGLOBAL,'tstar',NCFLOAT,1,tstar,iret)call ncapt(cdfid,NCGLOBAL,'tbeta',NCFLOAT,1,tbeta,iret)call ncapt(cdfid,NCGLOBAL,'pintf',NCFLOAT,1,pintf,iret)call ncapt(cdfid,NCGLOBAL,'p0top',NCFLOAT,1,p0top,iret)* leave define modecall ncendf(cdfid, iret)* store starty, etccorner(1) = 1edges(1) = 1call ncvpt(cdfid, startyid, corner, edges, idate(1), iret)call ncvpt(cdfid, startmid, corner, edges, idate(2), iret)call ncvpt(cdfid, startdid, corner, edges, idate(3), iret)call ncvpt(cdfid, starthid, corner, edges, idate(4), iret)endsubroutine globcst(cdfnam,datar,aklev,bklev,aklay,bklay,stdate)C------------------------------------------------------------------------C+C NAME:C subroutine globcstCC PURPOSE:C instead of writing a constants-file (*_cst), the informationC is added to the netCDF file as global variablesC the data format is compatible with the one requested byC the IVE ETH/MIT version, contact author about detailsCC CATEGORY:C model,netCDFCC CALLING SEQUENCE:C subroutine globcst(cdfnam,datar,aklev,bklev,aklay,bklay,stdate)CC INPUTS:C cdfnam name of netCDF fileC The file needs to exist, otherwise an ERROR occurs,C i.e. nothing is doneC datar array contains all required parameters to write fileC datar(1): number of points along xC datar(2): number of points along yC datar(3): maximum latitude of data region (ymax)C datar(4): minimum longitude of data region (xmin)C datar(5): minimum latitude of data region (ymin)C datar(6): maximum longitude of data region (xmax)C datar(7): grid increment along xC datar(8): grid increment along yC datar(9): number of levelsC datar(10): data type (forecast or analysis)C datar(11): data versionC datar(12): constants file versionC datar(13): longitude of pole of coordinate systemC datar(14): latitude of pole of coordinate systemC aklev array contains the aklev valuesC bklev array contains the bklev valuesC aklay array contains the aklay valuesC bklay array contains the bklay valuesC stdate array contains date (year,month,day,time,step) of firstC field on file (start-date), dimensionised as stdate(5)C list the griblist-ASCII-fileC varno the GRIB code numberCC OUTPUTS:C Adds cdf-information to EXISTING netCDF-fileCC MODIFICATION HISTORY:CC June 93 Christoph Schaer (ETHZ) createdC Nov 93 Heini Wernli (ETHZ) wricstC Nov 98 David N. Bresch (MIT) wricst to globcstC-C Sun include statement.include "netcdf.inc"integer nchar,maxlevparameter (nchar=20,maxlev=32)real aklev(maxlev),bklev(maxlev)real aklay(maxlev),bklay(maxlev)integer datar(14)integer stdate(5)character*80 cdfnamC declarations for constants-variablesinteger nzinteger dattyp, datver, cstverC further declarationsinteger ierr ! error flaginteger cdfid ! NetCDF idinteger xid,yid,zid ! dimension idsinteger pollonid, pollatid, ! variable ids> aklevid, bklevid, aklayid, bklayid,> lonminid, lonmaxid, latminid, latmaxid,> dellonid, dellatid,> startyid, startmid, startdid, starthid, startsid,> dattypid, datverid, cstveridnz=datar(9) ! number of levelsC Set data-type and -version, version of cst-file-formatdattyp=datar(10)datver=datar(11)cstver=datar(12)C Initially set error to falseierr=0C open the netCDF-file:call cdfwopn(cdfnam,cdfid,ierr)if (ierr.ne.0) thenprint*,'ERROR opening netCDF-file ',cdfnamreturnendifC Put file into define modecall ncredf(cdfid,ierr)if (ierr.ne.0) thenprint*,'ERROR switching to netCDF redefine mode'returnendifC Define the dimensionsxid = ncddef (cdfid,'nx',datar(1),ierr)yid = ncddef (cdfid,'ny',datar(2),ierr)zid = ncddef (cdfid,'nz',datar(9),ierr)C Define integer constantspollonid = ncvdef(cdfid,'pollon', NCFLOAT,0,0,ierr)pollatid = ncvdef(cdfid,'pollat', NCFLOAT,0,0,ierr)aklevid = ncvdef (cdfid, 'aklev', NCFLOAT, 1, zid, ierr)bklevid = ncvdef (cdfid, 'bklev', NCFLOAT, 1, zid, ierr)aklayid = ncvdef (cdfid, 'aklay', NCFLOAT, 1, zid, ierr)bklayid = ncvdef (cdfid, 'bklay', NCFLOAT, 1, zid, ierr)lonminid = ncvdef (cdfid, 'lonmin', NCFLOAT, 0, 0, ierr)lonmaxid = ncvdef (cdfid, 'lonmax', NCFLOAT, 0, 0, ierr)latminid = ncvdef (cdfid, 'latmin', NCFLOAT, 0, 0, ierr)latmaxid = ncvdef (cdfid, 'latmax', NCFLOAT, 0, 0, ierr)dellonid = ncvdef (cdfid, 'dellon', NCFLOAT, 0, 0, ierr)dellatid = ncvdef (cdfid, 'dellat', NCFLOAT, 0, 0, ierr)startyid = ncvdef (cdfid, 'starty', NCLONG, 0, 0, ierr)startmid = ncvdef (cdfid, 'startm', NCLONG, 0, 0, ierr)startdid = ncvdef (cdfid, 'startd', NCLONG, 0, 0, ierr)starthid = ncvdef (cdfid, 'starth', NCLONG, 0, 0, ierr)startsid = ncvdef (cdfid, 'starts', NCLONG, 0, 0, ierr)dattypid = ncvdef (cdfid, 'dattyp', NCLONG, 0, 0, ierr)datverid = ncvdef (cdfid, 'datver', NCLONG, 0, 0, ierr)cstverid = ncvdef (cdfid, 'cstver', NCLONG, 0, 0, ierr)C Leave define modecall ncendf(cdfid,ierr)if (ierr.ne.0) thenprint*,'ERROR exiting define mode'returnendifC Store levelscall ncvpt(cdfid, aklevid, 1, nz, aklev, ierr)call ncvpt(cdfid, bklevid, 1, nz, bklev, ierr)call ncvpt(cdfid, aklayid, 1, nz, aklay, ierr)call ncvpt(cdfid, bklayid, 1, nz, bklay, ierr)C Store position of pole (trivial for ECMWF data)call ncvpt1(cdfid, pollonid, 1, real(datar(13))/1000., ierr)call ncvpt1(cdfid, pollatid, 1, real(datar(14))/1000., ierr)C Store horizontal data borders and grid incrementscall ncvpt1(cdfid, lonminid, 1, real(datar(4))/1000., ierr)call ncvpt1(cdfid, lonmaxid, 1, real(datar(6))/1000., ierr)call ncvpt1(cdfid, latminid, 1, real(datar(5))/1000., ierr)call ncvpt1(cdfid, latmaxid, 1, real(datar(3))/1000., ierr)call ncvpt1(cdfid, dellonid, 1, real(datar(7))/1000., ierr)call ncvpt1(cdfid, dellatid, 1, real(datar(8))/1000., ierr)C Store date of first field on file (start-date)call ncvpt1(cdfid, startyid, 1, stdate(1), ierr)call ncvpt1(cdfid, startmid, 1, stdate(2), ierr)call ncvpt1(cdfid, startdid, 1, stdate(3), ierr)call ncvpt1(cdfid, starthid, 1, stdate(4), ierr)call ncvpt1(cdfid, startsid, 1, stdate(5), ierr)C Store datatype and versioncall ncvpt1(cdfid, dattypid, 1, dattyp, ierr)call ncvpt1(cdfid, datverid, 1, datver, ierr)C Store version of the constants file formatcall ncvpt1(cdfid, cstverid, 1, cstver, ierr)if (ierr.ne.0) thenprint*,'ERROR adding cst-date as global variables'returnendifC Store stringscall ncclos(cdfid,ierr)if (ierr.ne.0) thenprint*,'ERROR closing netCDF file'endifreturnendsubroutine getsdat(cdfid,varnam,time,ix,iy,iz,sx,sy,sz,dat,error)c-----------------------------------------------------------------------c Purpose:c This routine is called to read the data within a selectedc domain of a variable from an IVE-NetCDF file.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 namec 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 ix/y/z int input indices of lower left corner of selectedc data volume.c sx/y/z int input size of selected data volumec dat real output data-array with dimensions (sx,sy,sz).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 = 6,7,8 data volume too largec error =10 another error.c History:c June 93 Christoph Schaer (ETHZ) Created getdatc Nov 93 Heini Wernli (ETHZ) Created getsdatc-----------------------------------------------------------------------include "netcdf.inc"C Declaration of local variablescharacter*(*) varnamcharacter*(20) charsinteger cdfidinteger ix,iy,iz,sx,sy,szreal dat(sx,sy,sz)real misdat,varmin(4),varmax(4),stag(4)real time, timevalinteger corner(4),edgeln(4),didtim,vardim(4),ndimsinteger error, ierrinteger 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 getsdat'error=1returnendifC Get times-arraydidtim=ncdid(cdfid,'time',ierr)if (ierr.ne.0) thenprint *,'*ERROR* didtim in getsdat'error=10returnendifcall ncdinq(cdfid,didtim,chars,ntime,ierr)if (ierr.ne.0) thenprint *,'*ERROR* in ncdinq in getsdat'error=10returnendifidtime=ncvid(cdfid,'time',ierr)if (ierr.ne.0) thenprint *,'*ERROR* in ncvid for time in getsdat'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 getsdat'if (time.eq.timeval) iflag=ienddoif (iflag.eq.0) thenerror=2print *,'Error: Unknown time in getsdat'print *,time,timevalreturnendifC Define data volume to be written (index space)corner(1)=ixcorner(2)=iycorner(3)=izcorner(4)=iflagedgeln(1)=sxedgeln(2)=syedgeln(3)=szedgeln(4)=1C Check if data volume is within data domainif (ix+sx-1.gt.vardim(1)) thenerror=7print *,'Error: data volume too large in x-direction'print *,ix,sx,vardim(1)returnendifif (iy+sy-1.gt.vardim(2)) thenerror=8print *,'Error: data volume too large in y-direction'returnendifif (iz+sz-1.gt.vardim(3)) thenerror=9print *,'Error: data volume too large in z-direction'returnendifC Read data from NetCDF filecall ncvgt(cdfid,idvar,corner,edgeln,dat,error)if (error.ne.0) thenprint *, 'corner ',corner(1),corner(2),corner(3)print *, 'edgeln ',edgeln(1),edgeln(2),edgeln(3)print *, '*ERROR* in ncvgt in getsdat'error=10endifendsubroutine getlevs(cstid,nlev,aklev,bklev,aklay,bklay,error)c-----------------------------------------------------------------------c Purpose:c This routine is called to get the level arrays aklev andc bklev from a NetCDF constants file.c Arguments:c cstid int input identifier for NetCDF constants filec nlev int input number of levelsc aklev real output array contains all aklev valuesc bklev real output array contains all bklev valuesc aklay real output array contains all aklay valuesc bklay real output array contains all bklay valuesc error int output error flagc error = 0 no errors detectedc error = 1 error detectedc History:c Aug. 93 Heini Wernli Created.c-----------------------------------------------------------------------integer errorinteger cstidinteger ncdid,ncvid ! NetCDF functionsinteger didz,idak,idbk,idaky,idbkyinteger nlevreal aklev(nlev),bklev(nlev),aklay(nlev),bklay(nlev)character*(20) dimnaminteger ididz =ncdid(cstid,'nz',error)if (error.ne.0) goto 920idak =ncvid(cstid,'aklev',error)if (error.ne.0) goto 920idbk =ncvid(cstid,'bklev',error)if (error.ne.0) goto 920idaky =ncvid(cstid,'aklay',error)if (error.ne.0) goto 920idbky =ncvid(cstid,'bklay',error)if (error.ne.0) goto 920call ncdinq(cstid,didz,dimnam,nlev,error) ! read number of levelsif (error.ne.0) goto 920do 10 i=1,nlevcall ncvgt1(cstid,idak,i,aklev(i),error) ! get aklevcall ncvgt1(cstid,idbk,i,bklev(i),error) ! get bklevcall ncvgt1(cstid,idaky,i,aklay(i),error) ! get aklaycall ncvgt1(cstid,idbky,i,bklay(i),error) ! get bklayif (error.ne.0) goto 92010 continuereturnc Error exits.920 write(*,*)'*ERROR*: An error occured in subroutine getlevs'returnendsubroutine getntim(cdfid,ntimes,ierr)C------------------------------------------------------------------------C Purpose:C Get number of times on the specified NetCDF fileC Arguments:C cdfid int input identifier for NetCDF fileC ntimes int output number of times on the fileC error int output errorflagC History:C Heini Wernli, ETHZC------------------------------------------------------------------------include "netcdf.inc"integer ierrinteger 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 900c normal exitcall ncpopt (ncopts)returnc error exit900 ntimes=1call ncpopt (ncopts)endsubroutine getstart(cdfid,idate,ierr)C------------------------------------------------------------------------C Purpose:C Get start date for fields on specified NetCDF fileC Arguments:C cdfid int input identifier for NetCDF fileC idate int output array contains date (year,month,day,time,step)C dimensioned as idate(5)C ierr int output error flagC------------------------------------------------------------------------include "netcdf.inc"c variable declarationsinteger ierrinteger idate(5)integer cdfid,ncopts,idvar,nvarsinteger ndims,ngatts,recdim,i,vartyp,nvatts,vardim(4)character*20 vnam(100)c Get current value of error options, and make sure NetCDF-errors doc not abort executioncall ncgopt (ncopts)call ncpopt (NCVERBOS)idvar=ncvid(cdfid,'starty',ierr)if (ierr.ne.0) goto 930call ncvgt1(cdfid,idvar,1,idate(1),ierr)if (ierr.ne.0) goto 920idvar=ncvid(cdfid,'startm',ierr)if (ierr.ne.0) goto 920call ncvgt1(cdfid,idvar,1,idate(2),ierr)if (ierr.ne.0) goto 920idvar=ncvid(cdfid,'startd',ierr)if (ierr.ne.0) goto920call ncvgt1(cdfid,idvar,1,idate(3),ierr)if (ierr.ne.0) goto 920idvar=ncvid(cdfid,'starth',ierr)if (ierr.ne.0) goto 920call ncvgt1(cdfid,idvar,1,idate(4),ierr)if (ierr.ne.0) goto 920C Starts is not defined on all filesC Only ask for it if it existsC Inquire number of dimensions, variables and attributesidate(5)=0call ncinq(cdfid,ndims,nvars,ngatts,recdim,ierr)do i=1,nvarscall ncvinq(cdfid,i,vnam(i),vartyp,ndims,vardim,nvatts,ierr)if (vnam(i).eq.'starts') thenidvar=ncvid(cdfid,'starts',ierr)call ncvgt1(cdfid,idvar,1,idate(5),ierr)if (ierr.ne.0) goto 920endifenddoc normal exitcall ncpopt (ncopts)returnc error exit920 continuewrite (6, *) 'ERROR: An error occurred while attempting to ',& 'read the starting-time in subroutine putstart.'930 continuecall ncpopt (ncopts)endsubroutine putstart(cdfid,idate,ierr)C----------------------------------------------------------------------C Purpose:C Puts the 'starting-time' on the specified NetCDF file.C Arguments:C cdfid int input identifier for NetCDF fileC idate int input array contains date (year,month,day,time,step)C dimensioned as idate(5)C ierr int output error flagC------------------------------------------------------------------------include "netcdf.inc"c variable declarationsinteger ierr,idate(5),startid(5),cdfid,ncopts,ic Get current value of error options, and make sure NetCDF-errors doc not abort executioncall ncgopt (ncopts)call ncpopt (NCVERBOS)c define variablescall ncredf(cdfid,ierr)if (ierr.ne.0) goto 920startid(1) = ncvdef (cdfid, 'starty', NCLONG, 0, 0, ierr)if (ierr.ne.0) goto 920startid(2) = ncvdef (cdfid, 'startm', NCLONG, 0, 0, ierr)if (ierr.ne.0) goto 920startid(3) = ncvdef (cdfid, 'startd', NCLONG, 0, 0, ierr)if (ierr.ne.0) goto 920startid(4) = ncvdef (cdfid, 'starth', NCLONG, 0, 0, ierr)if (ierr.ne.0) goto 920startid(5) = ncvdef (cdfid, 'starts', NCLONG, 0, 0, ierr)if (ierr.ne.0) goto 920call ncendf(cdfid, ierr)if (ierr.ne.0) goto 920c store variablesdo i=1,5call ncvpt1(cdfid,startid(i),1,idate(i),ierr)if (ierr.ne.0) goto 920enddoc synchronyse output to disk, revert to previous error-mode, and exitcall ncsnc (cdfid,ierr)call ncpopt (ncopts)returnc error exit920 write (6, *) 'ERROR: An error occurred while attempting to ',& 'write the starting-time in subroutine putstart.'call ncpopt (ncopts)call ncclos (cdfid, ierr)endsubroutine getgrid(cdfid,dx,dy,ierr)C------------------------------------------------------------------------C Purpose:C Get grid increments for fields on specified NetCDF fileC Arguments:C cdfid int input identifier for NetCDF fileC dx real output grid increment along latitudeC dy real output grid increment along longitudeC ierr int output error flagC------------------------------------------------------------------------integer ierrinteger cdfidinteger ncvidinteger idilon,idilatreal dx,dyidilon =ncvid(cdfid,'dellon',ierr)if (ierr.ne.0) returnidilat =ncvid(cdfid,'dellat',ierr)if (ierr.ne.0) returncall ncvgt1(cdfid,idilon,1,dx,ierr)if (ierr.ne.0) returncall ncvgt1(cdfid,idilat,1,dy,ierr)if (ierr.ne.0) returnendsubroutine getdattyp(cdfid,typ,ierr)C------------------------------------------------------------------------C Purpose:C Get data type for specified NetCDF fileC Arguments:C cdfid int input identifier for NetCDF fileC typ int output data type: 1 (52) for pressure (theta) coordC ierr int output error flagC------------------------------------------------------------------------integer ierrinteger cdfidinteger ncvidinteger idtyp,typidtyp =ncvid(cdfid,'dattyp',ierr)if (ierr.ne.0) returncall ncvgt1(cdfid,idtyp,1,typ,ierr)if (ierr.ne.0) returnendsubroutine getpole(cdfid,pollon,pollat,ierr)C------------------------------------------------------------------------C Purpose:C Get physical coordinates of pole of coordinate systemC Arguments:C cdfid int input identifier for NetCDF fileC pollon real output longitude of poleC pollat real output latitude of poleC ierr int output error flagC------------------------------------------------------------------------integer ierrinteger cdfidinteger ncvidinteger idplon,idplatreal pollon,pollatidplon =ncvid(cdfid,'pollon',ierr)if (ierr.ne.0) returnidplat =ncvid(cdfid,'pollat',ierr)if (ierr.ne.0) returncall ncvgt1(cdfid,idplon,1,pollon,ierr)if (ierr.ne.0) returncall ncvgt1(cdfid,idplat,1,pollat,ierr)if (ierr.ne.0) returnendsubroutine getmc2grid(cdfid,polx,poly,delx,shem,phi0,lam0,ierr)C------------------------------------------------------------------------C Purpose:C Get physical coordinates of pole of coordinate systemC Arguments:C cdfid int input identifier for NetCDF fileC ierr int output error flagC------------------------------------------------------------------------integer ierrinteger cdfidinteger ncvidinteger idpolx,idpoly,iddelx,idshem,idphi0,idlam0real polx,poly,delx,shem,phi0,lam0idpolx =ncvid(cdfid,'polx',ierr)if (ierr.ne.0) returnidpoly =ncvid(cdfid,'poly',ierr)if (ierr.ne.0) returniddelx =ncvid(cdfid,'delx',ierr)if (ierr.ne.0) returnidshem =ncvid(cdfid,'shem',ierr)if (ierr.ne.0) returnidphi0 =ncvid(cdfid,'phi0',ierr)if (ierr.ne.0) returnidlam0 =ncvid(cdfid,'lam0',ierr)if (ierr.ne.0) returncall ncvgt1(cdfid,idpolx,1,polx,ierr)if (ierr.ne.0) returncall ncvgt1(cdfid,idpoly,1,poly,ierr)if (ierr.ne.0) returncall ncvgt1(cdfid,iddelx,1,delx,ierr)if (ierr.ne.0) returncall ncvgt1(cdfid,idshem,1,shem,ierr)if (ierr.ne.0) returncall ncvgt1(cdfid,idphi0,1,phi0,ierr)if (ierr.ne.0) returncall ncvgt1(cdfid,idlam0,1,lam0,ierr)if (ierr.ne.0) returnendsubroutine getcfn(cdfid,cfn,ierr)C------------------------------------------------------------------------C Purpose:C Get name of constants fileC Arguments:C cdfid int input identifier for NetCDF fileC cfn char output name of constants fileC ierr int output error flagC------------------------------------------------------------------------include 'netcdf.inc'integer ierrinteger cdfid,lenstrcharacter*80 cfnlenstr=80call ncagtc(cdfid,NCGLOBAL,"constants_file_name",cfn,lenstr,ierr)if (ierr.ne.0) write(*,*)'error in SR getcfn'endsubroutine getdim (cdfid, varnam, nx, ny, nz, error)c-------------------------------------------------------------------------c Purpose:c This routine is called to get the dimensions 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 nx int output the zonal dimension of the variable.c ny int output the meridional dimension of the variable.c nz int output the vertical dimension of the variable.cc 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 March 2000 Heini Wernli (ETHZ) Created.c-----------------------------------------------------------------------include "netcdf.inc"c Argument declarations.character *(*) varnaminteger vardim(4), ndim, error, cdfidinteger nx,ny,nzc Local variable declarations.character *(20) dimnam(MAXNCDIM),vnaminteger id,i,kinteger ndims,nvars,ngatts,recdim,dimsiz(MAXNCDIM)integer vartyp,nvatts, ncoptsc 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 get dimensions from dimension-tabledo k=1,ndimvardim(k)=dimsiz(vardim(k))enddonx=vardim(1)ny=vardim(2)nz=vardim(3)c normal exitcall ncpopt (ncopts)returnc Error exits.910 write (6, *) '*ERROR*: The selected variable could not be found ',& 'in the file by getdim.'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 new_gettra(cdfid,varnam,ix,ntimes,array,ierr)C------------------------------------------------------------------------CC Reads the time-evolution for one grid-point of the variableC indicated by varnam.CC cdfid int input identifier for NetCDF fileC varnam char input name of variableC ix int input index for trajectory to readC ntimes int input number of time-indices to readC array real output array contains the readed valuesC ierr int output error flagC------------------------------------------------------------------------C Declaration of attributesinteger cdfidcharacter*(*) varnaminteger ixinteger ntimesreal array(ntimes)C Declaration of local variablesinteger corner(4),edgeln(4)integer idvar,ierrinteger ncvidinteger strendcorner(1)=ixcorner(2)=1corner(3)=1corner(4)=1edgeln(1)=1edgeln(2)=1edgeln(3)=1edgeln(4)=ntimesidvar =ncvid(cdfid,varnam(1:strend(varnam)),ierr)call ncvgt(cdfid,idvar,corner,edgeln,array,ierr)if (ierr.ne.0) goto 991return991 stop 'Variable not found on NetCDF file in SR new_gettra'endsubroutine getvars(cdfid,nvars,vnam,ierr)C------------------------------------------------------------------------C Opens the NetCDF file 'filnam' and returns its identifier cdfid.C filnam char input name of NetCDF file to openC nvars int output number of variables on fileC vnam char output array with variable namesC ierr int output error flagC------------------------------------------------------------------------include 'netcdf.inc'integer cdfid,ierr,nvarscharacter*(*) vnam(*)integer ndims,ngatts,recdim,i,vartyp,nvatts,vardim(4)call ncpopt(NCVERBOS)C Inquire number of dimensions, variables and attributescall ncinq(cdfid,ndims,nvars,ngatts,recdim,ierr)C Inquire variable names from NetCDF filedo i=1,nvarscall ncvinq(cdfid,i,vnam(i),vartyp,ndims,vardim,nvatts,ierr)enddoreturnend