| 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 |