* uwmcdf.f - last change: 2/4/93 (ccy/ams) * * Access routines to the netCDF UWM/COADS data sets. * *..................................................................... subroutine UWREAD (ier, x, idim, jdim, label, mon, year, filen) integer idim, jdim, mon, year, ier real x(idim,jdim) character*80 label, filen * * This routine reads grids from the netCDF UWM/COADS files. * * On input: * idim, jdim - dimensions of output array (usually 360x180) * mon - desired month (jan=1, feb=2, etc.) * iyear - desired year. If 'iyear' is between 1945 * and 1989, the corresponding anomalies are * returned. The climatology for month * 'mon' is returned if iyear = 0. * filen - full file name (including path) for the * input netCDF file. End file name with '$'. * Example: filen = '/data/cdf/sst.cdf$' * * * On output: * x array containing the grid over the globe. Land * points receive the special value -1.0E+10. * label informational label about the data just read. * This can used for the title of a plot. * ier error code: * 0 - no error * <0 - netCDF error code (-errcod) * 1 - not enough work space. * 2 - too many files open * 3 - incompatble dimensions * * * NOTE: For the 1 degree x 1 degree data products (360x180 * arrays) the zonal and meridional grids are as follows: * * longitude(i) = 0.5 + (i-1), for i = 1,...,360 * latitude(j) = -89.5 + (j-1), for j = 1,...,180 * * Land value * ---------- real ALAND parameter ( ALAND = -1.0E+10 ) include 'netcdf.inc' include 'uwmcdf.h' integer errcod, idlat, idlon character pname*10, chyr*4, shorti*80 character*3 chmon(12) logical strcmp integer cst(2), clen(2), ast(3), alen(3) save cst, clen, ast, alen data chmon / 'jan', 'feb', 'mar', 'apr', 'may', 'jun', 'jul', . 'aug', 'sep', 'oct', 'nov', 'dec' / data cst / 1, 1 /, clen / npmax, 1 / data ast / 1, 1, 1 /, alen / npmax, 1, 1 / * Initialize error parameter * -------------------------- ier = 0 errcod = 0 lf = index(filen,'$') - 1 if ( lf .le. 0 ) lf = 80 iyear = year if ( year .ne. 0 .and. year .lt. 1900 ) iyear = 1900+year * Do if this is the first call * ---------------------------- if ( icount .eq. 0 ) then icount = icount + 1 nfile = icount files(icount) = filen call NCPOPT ( NCVERBOS ) * open netcdf file * ---------------- idfile(icount) = NCOPN ( filen(1:lf), NCNOWRIT, errcod ) if ( errcod .ne. 0 ) go to 999 * determine if resolution is compatible * ------------------------------------- idnpt = NCDID ( idfile(icount), 'npoint', errcod ) if ( errcod .ne. 0 ) go to 999 call NCDINQ ( idfile(icount), idnpt, pname, npoint, errcod ) if ( errcod .ne. 0 ) go to 999 if ( npoint .gt. npmax ) then ier = 1 return end if alen(1) = npoint clen(1) = npoint * get id numbers for lat and lon * ------------------------------ idlat = NCVID ( idfile(icount), 'lat', errcod ) if ( errcod .ne. 0 ) go to 999 idlon = NCVID ( idfile(icount), 'lon', errcod ) if ( errcod .ne. 0 ) go to 999 * read in lat and lon data * ------------------------ call NCVGT ( idfile(icount), idlat, 1, npoint, lat, errcod ) if ( errcod .ne. 0 ) go to 999 call NCVGT ( idfile(icount), idlon, 1, npoint, lon, errcod ) if ( errcod .ne. 0 ) go to 999 * Get climatology attributes * -------------------------- idclm(icount) = NCVID ( idfile(icount), 'clm', errcod ) if ( errcod .ne. 0 ) go to 999 call NCAGT ( idfile(icount), idclm(icount), 'add_offset', . offclm(icount), errcod ) if ( errcod .ne. 0 ) go to 999 call NCAGT ( idfile(icount), idclm(icount), 'scale_factor', . sclclm(icount), errcod ) if ( errcod .ne. 0 ) go to 999 * get anomaly attributes * ---------------------- idanm(icount) = NCVID ( idfile(icount), 'anom', errcod ) if ( errcod .eq. 0 ) then call NCAGT ( idfile(icount), idanm(icount), 'add_offset', . offanm(icount), errcod ) if ( errcod .ne. 0 ) go to 999 call NCAGT ( idfile(icount), idanm(icount), 'scale_factor', . sclanm(icount), errcod ) if ( errcod .ne. 0 ) go to 999 end if isopen = 1 * Otherwise check to see if it is a new file * ------------------------------------------ else isopen = 0 do 10 i = 1, icount if ( STRCMP ( filen, files(i), '$' ) ) then nfile = i isopen = 1 end if 10 continue end if * Do only if a new file * --------------------- if ( isopen .ne. 1 ) then icount = icount + 1 if ( icount .gt. nmax ) then ier = 2 return end if files(icount) = filen nfile = icount * open netcdf file * ---------------- idfile(nfile) = NCOPN ( filen(1:lf), NCNOWRIT, errcod ) if ( errcod .ne. 0 ) go to 999 * determine if resolution is compatible * ------------------------------------- idnpt = NCDID ( idfile(nfile), 'npoint', errcod ) if ( errcod .ne. 0 ) go to 999 call NCDINQ ( idfile(nfile), idnpt, pname, npts, errcod ) if ( errcod .ne. 0 ) go to 999 if ( npts .ne. npoint ) then ier = 3 return end if * Get climatology attributes * -------------------------- idclm(nfile) = NCVID ( idfile(nfile), 'clm', errcod ) if ( errcod .ne. 0 ) go to 999 call NCAGT ( idfile(nfile), idclm(nfile), 'add_offset', . offclm(nfile), errcod ) if ( errcod .ne. 0 ) go to 999 call NCAGT ( idfile(nfile), idclm(nfile), 'scale_factor', . sclclm(nfile), errcod ) if ( errcod .ne. 0 ) go to 999 * Get anomaly attributes * ---------------------- idanm(nfile) = ncvid( idfile(nfile), 'anom', errcod ) if ( errcod .eq. 0 ) then call NCAGT ( idfile(nfile), idanm(nfile), 'add_offset', . offanm(nfile), errcod ) if ( errcod .ne. 0 ) go to 999 call NCAGT ( idfile(nfile), idanm(nfile), 'scale_factor', . sclanm(nfile), errcod ) if ( errcod .ne. 0 ) go to 999 end if end if * Do every time: acquire the global attribute 'source' * ---------------------------------------------------- call NCAGTC ( idfile(nfile), . NCGLOBAL, 'source', uwmver, 80, errcod ) if ( errcod .ne. 0 ) go to 999 call NCAGTC ( idfile(nfile), NCGLOBAL, . 'title', shorti, 80, errcod ) if ( errcod .ne. 0 ) go to 999 * fill in land values in x array * ------------------------------ if ( iaccum .eq. 0 ) then do 100 j = 1, jdim do 100 i = 1, idim 100 x(i,j) = ALAND end if * Get climatology or anomaly data * ------------------------------- if ( iyear .eq. 0 ) then cst(2) = mon call NCVGT ( idfile(nfile), idclm(nfile), cst, clen, var, . errcod ) if ( errcod .ne. 0 ) go to 999 vscal = sclclm(nfile) voffst = offclm(nfile) else ast(2) = mon ast(3) = iyear-1944 call NCVGT ( idfile(nfile), idanm(nfile), ast, alen, var, . errcod ) vscal = sclanm(nfile) voffst = offanm(nfile) end if * uncondense field * ---------------- if ( iaccum .eq. 1 ) then do 200 k = 1, npoint i = lon(k) j = lat(k) xvar = var(k) x(i,j) = x(i,j) + xvar * vscal + voffst 200 continue else do 300 k = 1, npoint i = lon(k) j = lat(k) xvar = var(k) x(i,j) = xvar * vscal + voffst 300 continue end if * create an informative label * --------------------------- lf = index( shorti, '$' ) - 1 if ( iyear .eq. 0 ) then label = '/' // shorti(1:lf) // ' climatology for ' . // chmon(mon) // '$' else write( chyr, '(i4)' ) iyear label = '/' // shorti(1:lf) // ' anomaly for ' // chmon(mon) . // ' ' // chyr // '$' end if * Normal end * ---------- ier = 0 return * Abnormal end: error on return from netCDF * ----------------------------------------- 999 continue if ( errcod .eq. -1 ) then ier = -999 else ier = - errcod end if return end *................................................................... logical function STRCMP ( str1, str2, del ) character*(*) str1, str2 character*1 del * * Returns TRUE if strings are the same. * STRCMP = .false. l1 = index ( str1, del ) - 1 l2 = index ( str2, del ) - 1 if ( l1 .le. 0 .or. l2 .le. 0 .or. l1 .ne. l2 ) return STRCMP = .true. do 10 i = 1, l1 if ( str1(i:i) .ne. str2(i:i) ) STRCMP = .false. 10 continue return end *................................................................... subroutine UWCFIL ( ier ) * * Close all netCDF files in use. * include 'uwmcdf.h' integer errcod do 10 i = 1, icount call NCCLOS ( idfile(i), errcod ) if ( errcod .ne. 0 ) go to 999 10 continue * Reset counter * ------------ icount = 0 * Normal end * ---------- return * Abnormal end * ------------ 999 continue if ( errcod .eq. -1 ) then ier = -999 else ier = - errcod end if return end *................................................................... subroutine WRARR ( ierr, array, idim, jdim, label, filen ) include 'netcdf.inc' integer idcdf, ierr, iomode integer ivdims(2), istart(2), icnt(2) real array(idim,jdim) character label*80, filen*(*) data istart / 1, 1 / icnt(1) = idim icnt(2) = jdim * Set error handling to not fatal * ------------------------------- call NCPOPT ( NCVERBOS ) * Create and open a new netcdf file (no clobber) in define mode * ------------------------------------------------------------- ntry = 0 idcdf = NCCRE ( filen, NCNOCLOB, ierr ) if ( ierr .ne. 0 ) return * Create a label * -------------- call NCAPTC ( idcdf, NCGLOBAL, 'title', NCCHAR, 80, label, ierr ) if ( ierr .ne. 0 ) return * Create lat and lon dimensions * ----------------------------- idlon = NCDDEF ( idcdf, 'lon', idim, ierr ) if ( ierr .ne. 0 ) return idlat = NCDDEF ( idcdf, 'lat', jdim, ierr ) if ( ierr .ne. 0 ) return * Create a floating point variable of dimension (idim,jdim) * --------------------------------------------------------- ivdims(1) = idlon ivdims(2) = idlat idvar = NCVDEF ( idcdf, 'variable', NCFLOAT, 2, ivdims, ierr ) if ( ierr .ne. 0 ) return * Set nofill mode * --------------- iomode = NCSFIL ( idcdf, NCNOFILL, ierr ) if ( ierr .ne. 0 ) return * Leave define mode and enter data mode * ------------------------------------- call NCENDF ( idcdf, ierr ) if ( ierr .ne. 0 ) return * Write values into variable * -------------------------- call NCVPT ( idcdf, idvar, istart, icnt, array, ierr ) if ( ierr .ne. 0 ) return * Close cdf file * -------------- call NCCLOS ( idcdf, ierr ) if ( ierr .ne. 0 ) return return end *...................................................................... subroutine RDARR ( ierr, array, idim, jdim, label, filen ) include 'netcdf.inc' integer idcdf, ierr integer istart(2), icnt(2) real array(idim,jdim) character label*80, filen*(*) data istart / 1, 1 / icnt(1) = idim icnt(2) = jdim * Set error handling to not fatal * ------------------------------- call NCPOPT ( NCVERBOS ) * Open a netcdf file * ------------------ idcdf = NCOPN ( filen, NCNOWRIT, ierr ) if ( ierr .ne. 0 ) return * Get the label * ------------- call NCAGTC ( idcdf, NCGLOBAL, 'title', label, 80, ierr ) if ( ierr .ne. 0 ) return * Get the variable id and values * ------------------------------ idvar = NCVID ( idcdf, 'variable', ierr ) if ( ierr .ne. 0 ) return call NCVGT ( idcdf, idvar, istart, icnt, array, ierr ) if ( ierr .ne. 0 ) return * Close cdf file * -------------- call NCCLOS ( idcdf, ierr ) if ( ierr .ne. 0 ) return return end *................................................................... Block Data UWMCDF include 'uwmcdf.h' data icount / 0 / data iaccum / 0 / end