Subversion Repositories pvinversion.ecmwf

Compare Revisions

Ignore whitespace Rev 2 → Rev 3

/trunk/lib/libcdfplus.f
0,0 → 1,1128
subroutine wricst(cstnam,datar,aklev,bklev,aklay,bklay,stdate)
C------------------------------------------------------------------------
 
C Creates the constants file for NetCDF files containing ECMWF
C data. The constants file is compatible with the one created
C for EM data (with subroutine writecst).
C
C Input parameters:
C
C cstnam name of constants file
C datar array contains all required parameters to write file
C datar(1): number of points along x
C datar(2): number of points along y
C 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 x
C datar(8): grid increment along y
C datar(9): number of levels
C datar(10): data type (forecast or analysis)
C datar(11): data version
C datar(12): constants file version
C datar(13): longitude of pole of coordinate system
C datar(14): latitude of pole of coordinate system
C aklev array contains the aklev values
C bklev array contains the bklev values
C aklay array contains the aklay values
C bklay array contains the bklay values
C stdate array contains date (year,month,day,time,step) of first
C field on file (start-date), dimensionised as stdate(5)
C------------------------------------------------------------------------
 
 
include "netcdf.inc"
 
integer nchar,maxlev
 
parameter (nchar=20,maxlev=32)
real aklev(maxlev),bklev(maxlev)
real aklay(maxlev),bklay(maxlev)
real pollat,latmin,latmax
integer datar(14)
integer stdate(5)
character*80 cstnam
 
C declarations for constants-variables
 
integer nz
integer dattyp, datver, cstver
 
C further declarations
 
integer ierr ! error flag
integer cdfid ! NetCDF id
integer xid,yid,zid ! dimension ids
integer pollonid, pollatid, ! variable ids
> aklevid, bklevid, aklayid, bklayid,
> lonminid, lonmaxid, latminid, latmaxid,
> dellonid, dellatid,
> startyid, startmid, startdid, starthid, startsid,
> dattypid, datverid, cstverid
 
nz=datar(9) ! number of levels
 
C Set data-type and -version, version of cst-file-format
 
dattyp=datar(10)
datver=datar(11)
cstver=datar(12)
 
C Initially set error to false
 
ierr=0
 
C Create constants file
 
cdfid=nccre(trim(cstnam),NCCLOB,ierr)
 
C Define the dimensions
 
xid = ncddef (cdfid,'nx',datar(1),ierr)
yid = ncddef (cdfid,'ny',datar(2),ierr)
zid = ncddef (cdfid,'nz',datar(9),ierr)
 
C Define integer constants
 
pollonid = 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 mode
 
call ncendf(cdfid,ierr)
 
C Store levels
call 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) then
pollat=min(real(datar(14))/1000.,90.)
else
pollat=max(real(datar(14))/1000.,-90.)
endif
call ncvpt1(cdfid, pollatid, 1, pollat, ierr)
 
C Store horizontal data borders and grid increments
call 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 version
call ncvpt1(cdfid, dattypid, 1, dattyp, ierr)
call ncvpt1(cdfid, datverid, 1, datver, ierr)
 
C Store version of the constants file format
call ncvpt1(cdfid, cstverid, 1, cstver, ierr)
 
C Store strings
 
call ncclos(cdfid,ierr)
return
 
end
subroutine writelmcst(cdfid,nx,ny,nz,pollon,pollat,lonmin,
&lonmax,latmin,latmax,dellon,dellat,dattyp,datver,cstver,
&psref,tstar,tbeta,pintf,p0top,idate)
c ------------------------------------------------------------------
 
implicit none
 
integer cdfid
 
c deklarationen der constants-variablen
real pollon,pollat
real lonmin,lonmax,latmin,latmax,dellon,dellat
integer idate(5)
integer nx,ny,nz
integer dattyp, datver, cstver
real psref, tstar, tbeta, pintf, p0top
 
include 'netcdf.inc'
 
* netcdf declaration
integer iret, k
* dimension ids
integer nxdim, nydim, nzdim
* variable ids
integer startyid, startmid, startdid, starthid
* variable shapes, corners and edge lengths
integer dims(1), corner(1), edges(1)
 
* enter define mode
call 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,nz
call 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, pollat
call ncapt(cdfid,NCGLOBAL,'pollon',NCFLOAT,1,pollon,iret)
call ncapt(cdfid,NCGLOBAL,'pollat',NCFLOAT,1,pollat,iret)
 
* store lonmin, etc
call 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 version
call 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 grid
call 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 mode
call ncendf(cdfid, iret)
 
* store starty, etc
corner(1) = 1
edges(1) = 1
call 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)
 
end
subroutine globcst(cdfnam,datar,aklev,bklev,aklay,bklay,stdate)
C------------------------------------------------------------------------
C+
C NAME:
C subroutine globcst
C
C PURPOSE:
C instead of writing a constants-file (*_cst), the information
C is added to the netCDF file as global variables
C the data format is compatible with the one requested by
C the IVE ETH/MIT version, contact author about details
C
C CATEGORY:
C model,netCDF
C
C CALLING SEQUENCE:
C subroutine globcst(cdfnam,datar,aklev,bklev,aklay,bklay,stdate)
C
C INPUTS:
C cdfnam name of netCDF file
C The file needs to exist, otherwise an ERROR occurs,
C i.e. nothing is done
C datar array contains all required parameters to write file
C datar(1): number of points along x
C datar(2): number of points along y
C 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 x
C datar(8): grid increment along y
C datar(9): number of levels
C datar(10): data type (forecast or analysis)
C datar(11): data version
C datar(12): constants file version
C datar(13): longitude of pole of coordinate system
C datar(14): latitude of pole of coordinate system
C aklev array contains the aklev values
C bklev array contains the bklev values
C aklay array contains the aklay values
C bklay array contains the bklay values
C stdate array contains date (year,month,day,time,step) of first
C field on file (start-date), dimensionised as stdate(5)
C list the griblist-ASCII-file
C varno the GRIB code number
C
C OUTPUTS:
C Adds cdf-information to EXISTING netCDF-file
C
C MODIFICATION HISTORY:
C
C June 93 Christoph Schaer (ETHZ) created
C Nov 93 Heini Wernli (ETHZ) wricst
C Nov 98 David N. Bresch (MIT) wricst to globcst
C-
C Sun include statement.
include "netcdf.inc"
integer nchar,maxlev
parameter (nchar=20,maxlev=32)
real aklev(maxlev),bklev(maxlev)
real aklay(maxlev),bklay(maxlev)
integer datar(14)
integer stdate(5)
character*80 cdfnam
C declarations for constants-variables
integer nz
integer dattyp, datver, cstver
C further declarations
integer ierr ! error flag
integer cdfid ! NetCDF id
integer xid,yid,zid ! dimension ids
integer pollonid, pollatid, ! variable ids
> aklevid, bklevid, aklayid, bklayid,
> lonminid, lonmaxid, latminid, latmaxid,
> dellonid, dellatid,
> startyid, startmid, startdid, starthid, startsid,
> dattypid, datverid, cstverid
nz=datar(9) ! number of levels
C Set data-type and -version, version of cst-file-format
dattyp=datar(10)
datver=datar(11)
cstver=datar(12)
C Initially set error to false
ierr=0
C open the netCDF-file:
call cdfwopn(cdfnam,cdfid,ierr)
if (ierr.ne.0) then
print*,'ERROR opening netCDF-file ',cdfnam
return
endif
C Put file into define mode
call ncredf(cdfid,ierr)
if (ierr.ne.0) then
print*,'ERROR switching to netCDF redefine mode'
return
endif
C Define the dimensions
xid = ncddef (cdfid,'nx',datar(1),ierr)
yid = ncddef (cdfid,'ny',datar(2),ierr)
zid = ncddef (cdfid,'nz',datar(9),ierr)
C Define integer constants
pollonid = 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 mode
call ncendf(cdfid,ierr)
if (ierr.ne.0) then
print*,'ERROR exiting define mode'
return
endif
C Store levels
call 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 increments
call 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 version
call ncvpt1(cdfid, dattypid, 1, dattyp, ierr)
call ncvpt1(cdfid, datverid, 1, datver, ierr)
C Store version of the constants file format
call ncvpt1(cdfid, cstverid, 1, cstver, ierr)
if (ierr.ne.0) then
print*,'ERROR adding cst-date as global variables'
return
endif
C Store strings
call ncclos(cdfid,ierr)
if (ierr.ne.0) then
print*,'ERROR closing netCDF file'
endif
return
end
 
subroutine 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 selected
c domain of a variable from an IVE-NetCDF file.
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
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 ix/y/z int input indices of lower left corner of selected
c data volume.
c sx/y/z int input size of selected data volume
c dat real output data-array with dimensions (sx,sy,sz).
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 = 6,7,8 data volume too large
c error =10 another error.
c History:
c June 93 Christoph Schaer (ETHZ) Created getdat
c Nov 93 Heini Wernli (ETHZ) Created getsdat
c-----------------------------------------------------------------------
 
include "netcdf.inc"
 
C Declaration of local variables
character*(*) varnam
character*(20) chars
integer cdfid
 
integer ix,iy,iz,sx,sy,sz
real dat(sx,sy,sz)
real misdat,varmin(4),varmax(4),stag(4)
real time, timeval
 
integer corner(4),edgeln(4),didtim,vardim(4),ndims
integer error, ierr
integer ntime
integer idtime,idvar,iflag
integer i
 
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 getsdat'
error=1
return
endif
 
C Get times-array
didtim=ncdid(cdfid,'time',ierr)
if (ierr.ne.0) then
print *,'*ERROR* didtim in getsdat'
error=10
return
endif
call ncdinq(cdfid,didtim,chars,ntime,ierr)
if (ierr.ne.0) then
print *,'*ERROR* in ncdinq in getsdat'
error=10
return
endif
idtime=ncvid(cdfid,'time',ierr)
if (ierr.ne.0) then
print *,'*ERROR* in ncvid for time in getsdat'
error=10
return
endif
c find appropriate time-index
iflag=0
do i=1,ntime
call ncvgt1(cdfid,idtime,i,timeval,ierr)
if (ierr.ne.0) print *,'*ERROR* in ncvgt1 in getsdat'
if (time.eq.timeval) iflag=i
enddo
if (iflag.eq.0) then
error=2
print *,'Error: Unknown time in getsdat'
print *,time,timeval
return
endif
 
C Define data volume to be written (index space)
corner(1)=ix
corner(2)=iy
corner(3)=iz
corner(4)=iflag
edgeln(1)=sx
edgeln(2)=sy
edgeln(3)=sz
edgeln(4)=1
 
C Check if data volume is within data domain
 
if (ix+sx-1.gt.vardim(1)) then
error=7
print *,'Error: data volume too large in x-direction'
print *,ix,sx,vardim(1)
return
endif
if (iy+sy-1.gt.vardim(2)) then
error=8
print *,'Error: data volume too large in y-direction'
return
endif
if (iz+sz-1.gt.vardim(3)) then
error=9
print *,'Error: data volume too large in z-direction'
return
endif
 
C Read data from NetCDF file
 
call ncvgt(cdfid,idvar,corner,edgeln,dat,error)
if (error.ne.0) then
print *, 'corner ',corner(1),corner(2),corner(3)
print *, 'edgeln ',edgeln(1),edgeln(2),edgeln(3)
print *, '*ERROR* in ncvgt in getsdat'
error=10
endif
end
subroutine getlevs(cstid,nlev,aklev,bklev,aklay,bklay,error)
c-----------------------------------------------------------------------
c Purpose:
c This routine is called to get the level arrays aklev and
c bklev from a NetCDF constants file.
c Arguments:
c cstid int input identifier for NetCDF constants file
c nlev int input number of levels
c aklev real output array contains all aklev values
c bklev real output array contains all bklev values
c aklay real output array contains all aklay values
c bklay real output array contains all bklay values
c error int output error flag
c error = 0 no errors detected
c error = 1 error detected
c History:
c Aug. 93 Heini Wernli Created.
c-----------------------------------------------------------------------
 
integer error
 
integer cstid
integer ncdid,ncvid ! NetCDF functions
integer didz,idak,idbk,idaky,idbky
integer nlev
real aklev(nlev),bklev(nlev),aklay(nlev),bklay(nlev)
character*(20) dimnam
integer i
 
didz =ncdid(cstid,'nz',error)
if (error.ne.0) goto 920
idak =ncvid(cstid,'aklev',error)
if (error.ne.0) goto 920
idbk =ncvid(cstid,'bklev',error)
if (error.ne.0) goto 920
idaky =ncvid(cstid,'aklay',error)
if (error.ne.0) goto 920
idbky =ncvid(cstid,'bklay',error)
if (error.ne.0) goto 920
 
call ncdinq(cstid,didz,dimnam,nlev,error) ! read number of levels
if (error.ne.0) goto 920
 
do 10 i=1,nlev
call ncvgt1(cstid,idak,i,aklev(i),error) ! get aklev
call ncvgt1(cstid,idbk,i,bklev(i),error) ! get bklev
call ncvgt1(cstid,idaky,i,aklay(i),error) ! get aklay
call ncvgt1(cstid,idbky,i,bklay(i),error) ! get bklay
if (error.ne.0) goto 920
10 continue
 
return
 
c Error exits.
920 write(*,*)'*ERROR*: An error occured in subroutine getlevs'
return
 
end
subroutine getntim(cdfid,ntimes,ierr)
C------------------------------------------------------------------------
C Purpose:
C Get number of times on the specified NetCDF file
C Arguments:
C cdfid int input identifier for NetCDF file
C ntimes int output number of times on the file
C error int output errorflag
C History:
C Heini Wernli, ETHZ
C------------------------------------------------------------------------
include "netcdf.inc"
integer ierr
integer didtim,ntimes
integer cdfid,idtime
integer ncopts
character*(20) dimnam
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
c normal exit
call ncpopt (ncopts)
return
c error exit
900 ntimes=1
call ncpopt (ncopts)
end
subroutine getstart(cdfid,idate,ierr)
C------------------------------------------------------------------------
C Purpose:
C Get start date for fields on specified NetCDF file
C Arguments:
C cdfid int input identifier for NetCDF file
C idate int output array contains date (year,month,day,time,step)
C dimensioned as idate(5)
C ierr int output error flag
C------------------------------------------------------------------------
 
include "netcdf.inc"
 
c variable declarations
integer ierr
integer idate(5)
integer cdfid,ncopts,idvar,nvars
integer ndims,ngatts,recdim,i,vartyp,nvatts,vardim(4)
character*20 vnam(100)
 
c Get current value of error options, and make sure NetCDF-errors do
c not abort execution
call ncgopt (ncopts)
call ncpopt (NCVERBOS)
 
idvar=ncvid(cdfid,'starty',ierr)
if (ierr.ne.0) goto 930
call ncvgt1(cdfid,idvar,1,idate(1),ierr)
if (ierr.ne.0) goto 920
 
idvar=ncvid(cdfid,'startm',ierr)
if (ierr.ne.0) goto 920
call ncvgt1(cdfid,idvar,1,idate(2),ierr)
if (ierr.ne.0) goto 920
 
idvar=ncvid(cdfid,'startd',ierr)
if (ierr.ne.0) goto920
call ncvgt1(cdfid,idvar,1,idate(3),ierr)
if (ierr.ne.0) goto 920
 
idvar=ncvid(cdfid,'starth',ierr)
if (ierr.ne.0) goto 920
call ncvgt1(cdfid,idvar,1,idate(4),ierr)
if (ierr.ne.0) goto 920
 
C Starts is not defined on all files
C Only ask for it if it exists
C Inquire number of dimensions, variables and attributes
idate(5)=0
call ncinq(cdfid,ndims,nvars,ngatts,recdim,ierr)
do i=1,nvars
call ncvinq(cdfid,i,vnam(i),vartyp,ndims,vardim,nvatts,ierr)
if (vnam(i).eq.'starts') then
idvar=ncvid(cdfid,'starts',ierr)
call ncvgt1(cdfid,idvar,1,idate(5),ierr)
if (ierr.ne.0) goto 920
endif
enddo
 
c normal exit
call ncpopt (ncopts)
return
 
c error exit
920 continue
write (6, *) 'ERROR: An error occurred while attempting to ',
& 'read the starting-time in subroutine putstart.'
930 continue
call ncpopt (ncopts)
 
end
subroutine 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 file
C idate int input array contains date (year,month,day,time,step)
C dimensioned as idate(5)
C ierr int output error flag
C------------------------------------------------------------------------
 
include "netcdf.inc"
 
c variable declarations
integer ierr,idate(5),startid(5),cdfid,ncopts,i
 
c Get current value of error options, and make sure NetCDF-errors do
c not abort execution
call ncgopt (ncopts)
call ncpopt (NCVERBOS)
 
c define variables
call ncredf(cdfid,ierr)
if (ierr.ne.0) goto 920
startid(1) = ncvdef (cdfid, 'starty', NCLONG, 0, 0, ierr)
if (ierr.ne.0) goto 920
startid(2) = ncvdef (cdfid, 'startm', NCLONG, 0, 0, ierr)
if (ierr.ne.0) goto 920
startid(3) = ncvdef (cdfid, 'startd', NCLONG, 0, 0, ierr)
if (ierr.ne.0) goto 920
startid(4) = ncvdef (cdfid, 'starth', NCLONG, 0, 0, ierr)
if (ierr.ne.0) goto 920
startid(5) = ncvdef (cdfid, 'starts', NCLONG, 0, 0, ierr)
if (ierr.ne.0) goto 920
call ncendf(cdfid, ierr)
if (ierr.ne.0) goto 920
 
c store variables
do i=1,5
call ncvpt1(cdfid,startid(i),1,idate(i),ierr)
if (ierr.ne.0) goto 920
enddo
 
c synchronyse output to disk, revert to previous error-mode, and exit
call ncsnc (cdfid,ierr)
call ncpopt (ncopts)
return
 
c error exit
920 write (6, *) 'ERROR: An error occurred while attempting to ',
& 'write the starting-time in subroutine putstart.'
call ncpopt (ncopts)
call ncclos (cdfid, ierr)
 
end
subroutine getgrid(cdfid,dx,dy,ierr)
C------------------------------------------------------------------------
C Purpose:
C Get grid increments for fields on specified NetCDF file
C Arguments:
C cdfid int input identifier for NetCDF file
C dx real output grid increment along latitude
C dy real output grid increment along longitude
C ierr int output error flag
C------------------------------------------------------------------------
 
integer ierr
 
integer cdfid
integer ncvid
 
integer idilon,idilat
real dx,dy
 
idilon =ncvid(cdfid,'dellon',ierr)
if (ierr.ne.0) return
idilat =ncvid(cdfid,'dellat',ierr)
if (ierr.ne.0) return
 
call ncvgt1(cdfid,idilon,1,dx,ierr)
if (ierr.ne.0) return
call ncvgt1(cdfid,idilat,1,dy,ierr)
if (ierr.ne.0) return
 
end
subroutine getdattyp(cdfid,typ,ierr)
C------------------------------------------------------------------------
C Purpose:
C Get data type for specified NetCDF file
C Arguments:
C cdfid int input identifier for NetCDF file
C typ int output data type: 1 (52) for pressure (theta) coord
C ierr int output error flag
C------------------------------------------------------------------------
integer ierr
integer cdfid
integer ncvid
integer idtyp,typ
idtyp =ncvid(cdfid,'dattyp',ierr)
if (ierr.ne.0) return
call ncvgt1(cdfid,idtyp,1,typ,ierr)
if (ierr.ne.0) return
end
subroutine getpole(cdfid,pollon,pollat,ierr)
C------------------------------------------------------------------------
C Purpose:
C Get physical coordinates of pole of coordinate system
C Arguments:
C cdfid int input identifier for NetCDF file
C pollon real output longitude of pole
C pollat real output latitude of pole
C ierr int output error flag
C------------------------------------------------------------------------
 
integer ierr
 
integer cdfid
integer ncvid
 
integer idplon,idplat
real pollon,pollat
 
idplon =ncvid(cdfid,'pollon',ierr)
if (ierr.ne.0) return
idplat =ncvid(cdfid,'pollat',ierr)
if (ierr.ne.0) return
 
call ncvgt1(cdfid,idplon,1,pollon,ierr)
if (ierr.ne.0) return
call ncvgt1(cdfid,idplat,1,pollat,ierr)
if (ierr.ne.0) return
 
end
subroutine getmc2grid(cdfid,polx,poly,delx,shem,phi0,lam0,ierr)
C------------------------------------------------------------------------
C Purpose:
C Get physical coordinates of pole of coordinate system
C Arguments:
C cdfid int input identifier for NetCDF file
C ierr int output error flag
C------------------------------------------------------------------------
integer ierr
integer cdfid
integer ncvid
integer idpolx,idpoly,iddelx,idshem,idphi0,idlam0
real polx,poly,delx,shem,phi0,lam0
idpolx =ncvid(cdfid,'polx',ierr)
if (ierr.ne.0) return
idpoly =ncvid(cdfid,'poly',ierr)
if (ierr.ne.0) return
iddelx =ncvid(cdfid,'delx',ierr)
if (ierr.ne.0) return
idshem =ncvid(cdfid,'shem',ierr)
if (ierr.ne.0) return
idphi0 =ncvid(cdfid,'phi0',ierr)
if (ierr.ne.0) return
idlam0 =ncvid(cdfid,'lam0',ierr)
if (ierr.ne.0) return
call ncvgt1(cdfid,idpolx,1,polx,ierr)
if (ierr.ne.0) return
call ncvgt1(cdfid,idpoly,1,poly,ierr)
if (ierr.ne.0) return
call ncvgt1(cdfid,iddelx,1,delx,ierr)
if (ierr.ne.0) return
call ncvgt1(cdfid,idshem,1,shem,ierr)
if (ierr.ne.0) return
call ncvgt1(cdfid,idphi0,1,phi0,ierr)
if (ierr.ne.0) return
call ncvgt1(cdfid,idlam0,1,lam0,ierr)
if (ierr.ne.0) return
end
 
 
subroutine getcfn(cdfid,cfn,ierr)
C------------------------------------------------------------------------
C Purpose:
C Get name of constants file
C Arguments:
C cdfid int input identifier for NetCDF file
C cfn char output name of constants file
C ierr int output error flag
C------------------------------------------------------------------------
 
include 'netcdf.inc'
 
integer ierr
integer cdfid,lenstr
character*80 cfn
 
lenstr=80
call ncagtc(cdfid,NCGLOBAL,"constants_file_name",cfn,lenstr,ierr)
if (ierr.ne.0) write(*,*)'error in SR getcfn'
 
end
 
 
subroutine getdim (cdfid, varnam, nx, ny, nz, error)
c-------------------------------------------------------------------------
c Purpose:
c This routine is called to get the dimensions 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 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.
c
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 March 2000 Heini Wernli (ETHZ) Created.
c-----------------------------------------------------------------------
 
include "netcdf.inc"
 
c Argument declarations.
character *(*) varnam
integer vardim(4), ndim, error, cdfid
integer nx,ny,nz
 
c Local variable declarations.
character *(20) dimnam(MAXNCDIM),vnam
integer id,i,k
integer ndims,nvars,ngatts,recdim,dimsiz(MAXNCDIM)
integer vartyp,nvatts, ncopts
 
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 get dimensions from dimension-table
do k=1,ndim
vardim(k)=dimsiz(vardim(k))
enddo
 
nx=vardim(1)
ny=vardim(2)
nz=vardim(3)
 
c normal exit
call ncpopt (ncopts)
return
 
c 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)
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 new_gettra(cdfid,varnam,ix,ntimes,array,ierr)
C------------------------------------------------------------------------
C
C Reads the time-evolution for one grid-point of the variable
C indicated by varnam.
C
C cdfid int input identifier for NetCDF file
C varnam char input name of variable
C ix int input index for trajectory to read
C ntimes int input number of time-indices to read
C array real output array contains the readed values
C ierr int output error flag
C------------------------------------------------------------------------
C Declaration of attributes
integer cdfid
character*(*) varnam
integer ix
integer ntimes
real array(ntimes)
C Declaration of local variables
integer corner(4),edgeln(4)
integer idvar,ierr
integer ncvid
integer strend
corner(1)=ix
corner(2)=1
corner(3)=1
corner(4)=1
edgeln(1)=1
edgeln(2)=1
edgeln(3)=1
edgeln(4)=ntimes
idvar =ncvid(cdfid,varnam(1:strend(varnam)),ierr)
call ncvgt(cdfid,idvar,corner,edgeln,array,ierr)
if (ierr.ne.0) goto 991
return
991 stop 'Variable not found on NetCDF file in SR new_gettra'
end
subroutine 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 open
C nvars int output number of variables on file
C vnam char output array with variable names
C ierr int output error flag
C------------------------------------------------------------------------
 
include 'netcdf.inc'
integer cdfid,ierr,nvars
character*(*) vnam(*)
 
integer ndims,ngatts,recdim,i,vartyp,nvatts,vardim(4)
call ncpopt(NCVERBOS)
 
C Inquire number of dimensions, variables and attributes
call ncinq(cdfid,ndims,nvars,ngatts,recdim,ierr)
C Inquire variable names from NetCDF file
do i=1,nvars
call ncvinq(cdfid,i,vnam(i),vartyp,ndims,vardim,nvatts,ierr)
enddo
return
end