c**********************************************************************c c**********************************************************************c c**********************************************************************c c* *c c* m a i n p r o g r a m *c c* *c c*--------------------------------------------------------------------*c c* this is a sample main program presented to illustrate the use of *c c* the c1read subroutine in user-created application programs. *c c* the c1read subroutine requires one argument: a latitude zone #. *c c* c1read then returns all parameters for all longitude boxes within *c c* that latitude zone. the purpose of this program was to obtain *c c* and print all information for all longitudes over a given *c c* range of latitudes. *c c* *c c* this version of c1read is for equal area format (no replication), *c c* and returns physical values (converted from counts). *c c*====================================================================*c c* modification: *c c* 7/98 added the logical equal_area. If equal_area=true, then the *c c* data is retrieved on the equal-area grid (6596 regions). If *c c* equal_area=false, then the data is replicated to fill the *c c* equal-angle grid (10368 regions). *c c* This logical was added to the call of subroutines c1read and *c c* convrt. *c c*====================================================================*c c* * * * * * * * * * * * * * Please Note * * * * * * * * * * * * * * * c c* You must change the parameter path to reflect your data directory. *c c*====================================================================*c c**********************************************************************c c**********************************************************************c c**********************************************************************c program main c*--------------------------------------------------------------------*c c* c1 data *c c*--------------------------------------------------------------------*c cc parameter (latbeg=15,latend=15) parameter (dlat = 2.5,maxlat = 180.0/dlat,maxlon = 360.0/dlat) parameter (maxcnt = 255) parameter (nbytes = 132, numbox = 100) parameter (maxint = 74) parameter (ireal = maxint + 1) c*====================================================================*c common/cnttab/tmptab(0:maxcnt),tmpvar(0:maxcnt),pretab(0:maxcnt), 1 rfltab(0:maxcnt),tautab(0:maxcnt),prwtab(0:maxcnt), 2 ozntab(0:maxcnt) common /c1data/ init, lunc1, record, file, year, month, day, & gmt, boxbeg, boxend, ivar(maxint,maxlon), & rvar(ireal:nbytes,maxlon) c*--------------------------------------------------------------------*c c* equal area info common block *c c*--------------------------------------------------------------------*c common /equcom/ dlontb(maxlat),icells(maxlat),ncells(maxlat) c*====================================================================*c integer init, lunc1, record, file, year, month, day, & gmt, boxbeg, boxend, ivar, & tmptab,tmpvar,pretab,rfltab,tautab,prwtab,ozntab integer yy,mm,dd,hh c*====================================================================*c real rvar c*====================================================================*c logical equal_area character path*21,name*12,filename*33 c*====================================================================*c data path/'/your_data_directory/'/ c*--------------------------------------------------------------------*c c* call routine to compute grid information *c c*--------------------------------------------------------------------*c call equare c*--------------------------------------------------------------------*c c* if equal_area = true, the data will be on the equal-area grid *c c* (6596 regions). *c c* if equal_area = false, the data will be on the equal-angle grid *c c* (10368 regions). Replication is used to put the data on this grid *c c*--------------------------------------------------------------------*c equal_area = .true. c*--------------------------------------------------------------------*c c* user-specified latitude index (either read in, or defined in c* parameter statement) *c c*--------------------------------------------------------------------*c print*,'Enter beginning and ending latitude bands of interest' read (5,*) latbeg, latend print*,latbeg,latend print*,' ' print*,'Enter date and GMT hour of interest in this format:' print*,' YYMMDDHH, ex. 86103100 is 00GMT on Oct. 31, 1986' read(5,123)yy,mm,dd,hh 123 format(4i2.2) write(name,124)yy,mm,dd,hh 124 format('c1_',3I2.2,'_',i2.2) filename=path//name print*,'Filename: ',filename print*,' ' print*,'Do you want data on the equal-area grid? (T/F)' read(5,*)equal_area if(equal_area)then print*,'Equal-area grid' else print*,'Equal-angle grid' endif c*--------------------------------------------------------------------*c c* user should issue the "open" command for the given c1 data file *c c* the logical unit number is assumed to be 10 in this code *c c*--------------------------------------------------------------------*c c* to read more than one c1 data file, insert a loop here. loop over *c c* the number of files you wish to read. there are 8 files per day. *c c* this is sufficient for reading sequential c1 files, but to read *c c* only files for a specific gmt, the file definitions must be *c c* modified to contain only those file numbers that you wish to read. *c c*--------------------------------------------------------------------*c c* initialize flags for calls to c1read *c c*--------------------------------------------------------------------*c lunc1 = 10 ierr = 0 init = 0 open (lunc1,file=filename, & access='direct',recl=nbytes*numbox,iostat=iok) record = 0 c*--------------------------------------------------------------------*c c* loop over the user specified latitude range *c c*--------------------------------------------------------------------*c do 1000 nlat = latbeg,latend call c1read(nlat,equal_area,ierr) if (ierr .ne. 0) go to 3000 c*--------------------------------------------------------------------*c c* loop over lons in this lat zone (equal-area or equal-angle) *c c*--------------------------------------------------------------------*c c* for equal-angle grid lonend=maxlon, equal-area grid lonend=icells(nlat) c*--------------------------------------------------------------------*c if(.not.equal_area)lonend=maxlon if(equal_area)lonend=icells(nlat) do 2000 lon = 1,lonend if(.not.equal_area)then alon = (lon-1)*2.5 + 1.25 else alon=(lon-1)*360./icells(nlat)+360./(icells(nlat)*2.) endif alat = (nlat-1)*2.5 - 88.75 print 100,alat,alon print 200, file,record,boxbeg,boxend,year,month,day,gmt print 300, (i,i=1,25) print 400, (ivar(k,lon),k=1,25) print 500, (ivar(k,lon),k=26,50) print 600, (ivar(k,lon),k=51,74) print 700, (k,k=1,10) print 800, (rvar(k,lon),k=75,nbytes) 2000 continue 1000 continue 100 format(/,10x,'latitude = ',f11.2,2x,'longitude = ',f11.2,/) 200 format(1x,'fileid ',i3,' nrec ',i3,' cellbeg ',i4,' cellend ',i4, 1 ' year 19',i2,' month ',i2,' day ',i2,' gmt ',i2) 300 format(/1x,'var index ',25i4,/) 400 format(1x,'var ( 1-25)',25i4) 500 format(1x,'var (26-50)',25i4) 600 format(1x,'var (51-74)',24i4) 700 format(/,1x,'rvar index ',10i10,/) 800 format(1x,'rvar (75-84) ',10f10.3,/1x,'rvar (85-94) ',10f10.3, * /1x,'rvar (95-104) ',10f10.3,/1x,'rvar (105-114)',10f10.3, * /1x,'rvar (115-124)',10f10.3,/1x,'rvar (125-132)',8f10.3) c*--------------------------------------------------------------------*c c* user should issue the "close" command for the given c1 data file *c c*--------------------------------------------------------------------*c close (lunc1) stop c*--------------------------------------------------------------------*c c* error endings *c c*--------------------------------------------------------------------*c 3000 print 3001,lunc1,ierr 3001 format(1x,'error reading c1 data lunc1',i4,' ierr',i4) stop end c**********************************************************************c c**********************************************************************c c**********************************************************************c c* *c c* s u b r o u t i n e c 1 r e a d *c c* *c c*--------------------------------------------------------------------*c c* c1read fortran02 version 880610 *c c*--------------------------------------------------------------------*c c* *c c* revised by : alison w. walker *c c* last revision : june 10, 1988 *c c* *c c* author : rao v. anne *c c* nasa goddard space flight center *c c* institute for space studies *c c* new york, ny usa *c c* *c c*--------------------------------------------------------------------*c c* description: *c c*--------------------------------------------------------------------*c c* *c c* this is the primary program to read and decode the data from c1 *c c* data files. these data are stored on tape in an equal area grid. *c c* this routine maps the data by replication into a 2.5 degree *c c* (144 x 72 longitude/latitude) grid, *c c* *c c* the first call to this routine initializes variables and creates *c c* the tables representing the equal area grid map by calling the *c c* equare routine. processing then proceeds in the same way as *c c* for subsequent calls described as follows: *c c* *c c* a data record is read in with a call to the c1rec *c c* routine and is converted from c*1 to i*4 with a call to the *c c* unpack routine. the prefix is decoded by a call to the prefix *c c* routine. the latitude window option is the feature of *c c* c1read which allows for rapid checking of data records until the *c c* beginning of the user-specified latitude range is encountered; *c c* subsequent records are read in as needed. when the appropriate *c c* latitude is encoutered, all of the data within this zone are *c c* converted to physical values where appropriate, and replicated *c c* into the 2.5 degree equal-angle grid. the results are passed *c c* back to the main program in the common block /c1data/. *c c*--------------------------------------------------------------------*c c* external routines called *c c* c1rec -------- read one data record *c c* unpack ------- convert one data record from c*1 to i*4 *c c* convrt ------- convert one cell to physical values *c c* equare ------- calculate equal area map grid information *c c* prefix ------- decode prefix information for one record *c c*--------------------------------------------------------------------*c c* calling parameters *c c* nlat = latitude zone (1-72) *c c* ierr = return code *c c*--------------------------------------------------------------------*c c* return codes *c c* 0 --- all is well *c c* -1 --- unexpected end of c1 data (from c1rec) *c c* -2 --- error during read of c1 data (from c1rec) *c c* -3 --- init flag not 0 or 1 *c c* -4 --- lat zone < 1 or lat zone > 72 *c c*--------------------------------------------------------------------*c c* c1 data files record structure (on tape): *c c*--------------------------------------------------------------------*c c* *c c* there are 67 data records in each data file. *c c* all data records are 13,200 (8-bit) bytes in length. each record *c c* has a 132 byte prefix followed by 99 map cells of 132 bytes each. *c c* a data byte value of 255 is considered undefined. *c c* *c c* the prefix contains 10 values reported as 8 bit positive integers:*c c* byte 1: record number in file (1 - 67) *c c* byte 2: file number on tape (6 - 133) *c c* byte 3: year of dataset (83 - 90) *c c* byte 4: month (1 - 12) *c c* byte 5: day (1 - 31) *c c* byte 6: gmt (0,3,6,...,21) *c c* byte 7: first lat index on record in an equal area form *c c* byte 8: first lon index on record in an equal area form *c c* byte 9: last lat index on record in an equal area form *c c* byte 10: last lon index on record in an equal area form *c c* bytes 11 - 132: 255 (undefined) *c c* *c c*--------------------------------------------------------------------*c c* map grid characteristics: *c c*--------------------------------------------------------------------*c c* *c c* 6596 grid cells in an equal area map; (0,0) is a box corner. *c c* the sequential box numbering system assigns a number *c c* between 1 and 6596 to each equal-area box, starting from *c c* the south pole at the greenwich meridian. within each *c c* latitude belt the numbers then increase eastward from the *c c* zero degree meridian. box numbers increase northward *c c* in latitude. in each hemisphere there are 3298 boxes. *c c* *c c* 10368 grid cells in an equal longitude/latitude (144 x 72 grid) *c c* map. latitude begins at -90 degrees and moves 180 degrees north- *c c* ward. longitude begins at 0 degrees and moves to 360 degrees *c c* eastward *c c* *c c*--------------------------------------------------------------------*c c* variable definition for each cell by index number: *c c*--------------------------------------------------------------------*c c* *c c* index definition *c c* *c c* 1 latitude index (equal-area) *c c* 2 longitude index (equal-area) *c c* 3 lower longitude index (2.5-sq) *c c* 4 upper longitude index (2.5-sq) *c c* 5 total number of pixels *c c* 6 number of cloudy pixels *c c* 7 number of ir-cloudy pixels *c c* 8 number of ir unclear pixels *c c* 9 number of vis/ir unclear pixels *c c* 10 number of ir-only cloudy pixels *c c* 11 day/night/land/water/coast code *c c* 12 satellite identification code *c c* 13 snow/ice cover code *c c* 14 cosine of solar zenith angle (mu0) *c c* 15 cosine of satellite zenith angle (mue) *c c* 16 relative azimuth angle (phi0) *c c* 17 # pixels from long term statistics *c c* 18 # pixels from cloud contaminated region (vis) *c c* 19 number of pixels in ir threshold range 3 *c c* 20 number of pixels in ir threshold range 2 *c c* 21 number of pixels in ir threshold range 1 *c c* 22 number of pixels in vis threshold range 3 *c c* 23 number of pixels in vis threshold range 2 *c c* 24 number of pixels in vis threshold range 1 *c c* 25 # clear pix showing ir cloud contam. in rad *c c* 26 pc distribution (no-vis) 5 < pc <= 180 *c c* 27 pc distribution (no-vis) 180 < pc <= 310 *c c* 28 pc distribution (no-vis) 310 < pc <= 440 *c c* 29 pc distribution (no-vis) 440 < pc <= 560 *c c* 30 pc distribution (no-vis) 560 < pc <= 680 *c c* 31 pc distribution (no-vis) 680 < pc <= 800 *c c* 32 pc distribution (no-vis) 800 < pc <= 1000 *c c* 33 pc distrib. (vis-only,no-adj) 5 < pc <= 180 *c c* 34 pc distrib. (vis-only,no-adj) 180 < pc <= 310 *c c* 35 pc distrib. (vis-only,no-adj) 310 < pc <= 440 *c c* 36 pc distrib. (vis-only,no-adj) 440 < pc <= 560 *c c* 37 pc distrib. (vis-only,no-adj) 560 < pc <= 680 *c c* 38 pc distrib. (vis-only,no-adj) 680 < pc <= 800 *c c* 39 pc distrib. (vis-only,no-adj) 800 < pc <= 1000 *c c* 40 pc/tau (vis-adj) 5 72 nlat =',i4, * ' ierr =',i3,/) return end c**********************************************************************c c**********************************************************************c c**********************************************************************c c* *c c* s u b r o u t i n e c 1 r e c *c c* *c c*--------------------------------------------------------------------*c c* reads one record of c1 data in character*1 format and calls *c c* external routines to unpack the prefix information, and convert *c c* the data into integer*4 format. each data record consists of *c c* one prefix cell and 99 data cells of the equal area grid. each *c c* cell contains 132 bytes, totalling 13200 bytes per record. *c c*--------------------------------------------------------------------*c c* external routines called: *c c* prefix --- decode prefix information *c c* unpack --- converts c1 data from c*1 to integer *c c*--------------------------------------------------------------------*c c* calling parameters: *c c* i*4 ierr --------- return code *c c*--------------------------------------------------------------------*c c* error codes: *c c* 0 --- all is well *c c* -1 --- unexpected end of c1 data *c c* -2 --- error during read of c1 data *c c*--------------------------------------------------------------------*c c* c1bufs common block and associated parameters: *c c* i*4 nbytes --------- number of bytes per data box *c c* i*4 numbox ------ number of data boxes in the record (+prefix) *c c* c*1 c1char ------ one record in character format (13200 bytes) *c c* i*4 c1ints ------ one record in integer format *c c*--------------------------------------------------------------------*c c* c1data common block and associated parameters: *c c* i*4 maxint ------- byte number of last integer variable *c c* i*4 ireal ------- byte number of first real variable *c c* i*4 init ------- initialization flag for c1read *c c* i*4 lunc1 ------- logical unit for c1 data input *c c* i*4 record ------- record number of current record *c c* i*4 file ------- file number on tape of current record *c c* i*4 year ------- year of data *c c* i*4 month ------- month of data *c c* i*4 day ------- day of data *c c* i*4 gmt ------- gmt of data *c c* i*4 boxbeg ------- equal area box number of first box in record*c c* i*4 boxend ------- equal area box number of last box in record *c c* i*4 ivar ------- integer data variables *c c* r*4 rvar ------- real data variables *c c**********************************************************************c c**********************************************************************c c**********************************************************************c subroutine c1rec(ierr) c*--------------------------------------------------------------------*c c* parameters *c c*--------------------------------------------------------------------*c parameter ( nbytes = 132 ) parameter ( numbox = 100 ) parameter ( maxint = 74 ) parameter ( ireal = maxint + 1 ) parameter ( maxlon = 144 ) c*--------------------------------------------------------------------*c c* conversion arrays for reading and unpacking c1data *c c*--------------------------------------------------------------------*c common /c1bufs/ c1ints(nbytes,numbox)//c1char(nbytes,numbox) character*1 c1char integer c1ints c*--------------------------------------------------------------------*c c* c1data *c c*--------------------------------------------------------------------*c common /c1data/ init, lunc1, record, file, year, month, day, & gmt, boxbeg, boxend, ivar(maxint,maxlon), & rvar(ireal:nbytes,maxlon) integer init, lunc1, record, file, year, month, day, & gmt, boxbeg, boxend, ivar real rvar c*--------------------------------------------------------------------*c c* *c c* b e g i n *c c* *c c*--------------------------------------------------------------------*c c* read the c1 data record in c*1 format c c*--------------------------------------------------------------------*c read(lunc1,rec=record+1) c1char c*--------------------------------------------------------------------*c c* unpack the character data into integer data *c c*--------------------------------------------------------------------*c call unpack c*--------------------------------------------------------------------*c c* decode the prefix information for this record *c c*--------------------------------------------------------------------*c call prefix c*--------------------------------------------------------------------*c c* print prefix information *c c*--------------------------------------------------------------------*c ccc print 101, file,record,boxbeg,boxend,year,month,day,gmt 101 format(1x,'fileid ',i3,' nrec ',i3,' cellbeg ',i4,' cellend ',i4, 1 ' year 19',i2,' month ',i2,' day ',i2,' gmt ',i2) c*--------------------------------------------------------------------*c c* all done, return to calling program *c c*--------------------------------------------------------------------*c ierr = 0 return end c**********************************************************************c c**********************************************************************c c**********************************************************************c c* *c c* s u b r o u t i n e e q u a r e *c c* *c c*--------------------------------------------------------------------*c c* creates various tables giving the characteristics of the equal- *c c* area world map for each latitude. the number of equal-area *c c* cells varies from 3 at the poles up to 144 at the equator. *c c* this routine creates a pointer array which can be used to assign *c c* a number, between 1 and 6596, to each equal area cell, starting *c c* at the south pole and greenwich meridian and increasing eastward *c c* and northward. *c c**********************************************************************c c**********************************************************************c c**********************************************************************c c*--------------------------------------------------------------------*c c* common block equcom variable dictionary *c c*--------------------------------------------------------------------*c c* r*4 dlontb --------- equal-area map longitude increment for *c c* a given latitude zone *c c* i*4 icells --------- number of equal area cells in a *c c* given latitude zone *c c* i*4 ncells --------- total number of cells starting from the *c c* south pole (latitude zone index = 1) *c c* up to the given latitude zone *c c*--------------------------------------------------------------------*c subroutine equare c*--------------------------------------------------------------------*c parameter (dlat = 2.5,maxlat = 180.0/dlat,maxlon = 360.0/dlat) common /equcom/ dlontb(maxlat),icells(maxlat),ncells(maxlat) c*--------------------------------------------------------------------*c c* equal-area computations *c c*--------------------------------------------------------------------*c pi = 2.0 * asin(1.0) halfpi = pi / 2.0 twopi = 2.0 * pi rcelat = ( dlat * pi ) / 180.0 rearth = 6371.2 c*--------------------------------------------------------------------*c c* calculate area of equatorial zone *c c*--------------------------------------------------------------------*c hezon = rearth * sin(rcelat) aezon = 2.0 * pi * rearth * hezon c*--------------------------------------------------------------------*c c* calculate area of equatorial cell *c c*--------------------------------------------------------------------*c aecell = ( aezon * dlat ) / 360.0 c*--------------------------------------------------------------------*c c* compute equal-area longitude interval for each latitude zone *c c*--------------------------------------------------------------------*c maxlt2 = maxlat / 2 do 100 lat = 1,maxlt2 xlatb = ( lat - 1 ) * dlat xlate = xlatb + dlat rlatb = ( 2.0 * pi * xlatb ) / 360.0 rlate = ( 2.0 * pi * xlate ) / 360.0 c*--------------------------------------------------------------------*c c* calculate area of zone *c c*--------------------------------------------------------------------*c htb = rearth * sin(rlatb) hte = rearth * sin(rlate) htzone = hte - htb azone = 2.0 * pi * rearth * htzone c*--------------------------------------------------------------------*c c* calculate number of cells in zone *c c*--------------------------------------------------------------------*c rcells = azone / aecell icellr = ( rcells + 0.5 ) rcellr = icellr dlongr = 360.0 / rcellr c*--------------------------------------------------------------------*c c* create table of longitudes *c c*--------------------------------------------------------------------*c lat1 = lat + maxlt2 lat2 = maxlt2 + 1 - lat dlontb(lat1) = dlongr dlontb(lat2) = dlontb(lat1) icells(lat1) = icellr icells(lat2) = icellr 100 continue c*--------------------------------------------------------------------*c c* create equal-area pointer map *c c*--------------------------------------------------------------------*c ntcel = 0 do 200 lat = 1, maxlat ncells(lat) = ntcel ntcel = ntcel + icells(lat) 200 continue return end c**********************************************************************c c**********************************************************************c c**********************************************************************c c* *c c* s u b r o u t i n e u n p a c k *c c* *c c*--------------------------------------------------------------------*c c* unpacks a c1 record from character*1 format into integer*4 format *c c* using the fortran procedure called ichar. the intrinsic statement *c c* is used to identify this name as a fortran supplied procedure so *c c* that if this program is moved to a processor that does not provide *c c* the same intrinsic procedure, a helpful diagnostic message may *c c* be given. *c c*--------------------------------------------------------------------*c c* c1bufs common block *c c* c*1 c1char --------- one record in character format 13200 bytes *c c* i*4 c1ints --------- one record in integer format *c c**********************************************************************c c**********************************************************************c c**********************************************************************c subroutine unpack parameter ( nbytes = 132 ) parameter ( numbox = 100 ) c*--------------------------------------------------------------------*c common /c1bufs/ c1ints(nbytes,numbox)//c1char(nbytes,numbox) character*1 c1char integer c1ints c*====================================================================*c c*====================================================================*c c* *c c* w a r n i n g ! ! ! *c c* *c c* if this program is moved to a processor that does not provide the *c c* intrinsic function "ichar", an alternate method of converting *c c* character*1 format to integer*4 format must be used. *c c* *c c*====================================================================*c c*====================================================================*c c* *c intrinsic ichar c* *c c*====================================================================*c c*====================================================================*c do 100 ibox = 1,numbox do 100 ibyte = 1,nbytes c1ints(ibyte,ibox) = ichar(c1char(ibyte,ibox)) 100 continue return end c**********************************************************************c c**********************************************************************c c**********************************************************************c c* *c c* s u b r o u t i n e p r e f i x *c c* *c c*--------------------------------------------------------------------*c c* decodes prefix information, putting it into c1data common block *c c*--------------------------------------------------------------------*c c* c1data common block and associated parameters: *c c* i*4 maxint ------- byte number of last integer variable *c c* i*4 ireal ------- byte number of first real variable *c c* i*4 init ------- initialization flag for c1read *c c* i*4 lunc1 ------- logical unit for c1 data input *c c* i*4 record ------- record number of current record *c c* i*4 file ------- file number on tape of current record *c c* i*4 year ------- year of data *c c* i*4 month ------- month of data *c c* i*4 day ------- day of data *c c* i*4 gmt ------- gmt of data *c c* i*4 boxbeg ------- equal area box number of first box in record*c c* i*4 boxend ------- equal area box number of last box in record *c c* i*4 ivar ------- integer data variables *c c* r*4 rvar ------- real data variables *c c* equcom common block variables *c c* r*4 dlontb --------- equal-area map longitude increment for *c c* a given latitude zone *c c* i*4 icells --------- number of equal area cells in a *c c* given latitude zone *c c* i*4 ncells --------- total number of cells starting from the *c c* south pole (latitude zone index = 1) *c c* up to the given latitude zone *c c* c1bufs common block variables *c c* c*1 c1char --------- one record in character format 13200 bytes*c c* i*4 c1ints --------- one record in integer format *c c**********************************************************************c c**********************************************************************c c**********************************************************************c subroutine prefix c*--------------------------------------------------------------------*c parameter ( nbytes = 132 ) parameter ( maxint = 74 ) parameter ( ireal = maxint + 1 ) parameter ( numbox = 100 ) c*--------------------------------------------------------------------*c parameter (dlat = 2.5,maxlat = 180.0/dlat,maxlon = 360.0/dlat) common /equcom/ dlontb(maxlat),icells(maxlat),ncells(maxlat) c*--------------------------------------------------------------------*c common /c1data/ init, lunc1, record, file, year, month, day, & gmt, boxbeg, boxend, ivar(maxint,maxlon), & rvar(ireal:nbytes,maxlon) integer init, lunc1, record, file, year, month, day, & gmt, boxbeg, boxend, ivar real rvar c*--------------------------------------------------------------------*c common /c1bufs/ c1ints(nbytes,numbox)//c1char(nbytes,numbox) character*1 c1char integer c1ints c*--------------------------------------------------------------------*c c* *c c* b e g i n *c c* *c c*--------------------------------------------------------------------*c c* fetch record number, file number *c c*--------------------------------------------------------------------*c record = c1ints(1,1) file = c1ints(2,1) c*--------------------------------------------------------------------*c c* fetch year, month, day, gmt of data record *c c*--------------------------------------------------------------------*c year = c1ints(3,1) month = c1ints(4,1) day = c1ints(5,1) gmt = c1ints(6,1) c*--------------------------------------------------------------------*c c* fetch lat/lon index of first equal area map cell in the data record*c c*--------------------------------------------------------------------*c latbeg = c1ints(7,1) lonbeg = c1ints(8,1) c*--------------------------------------------------------------------*c c* fetch lat/lon index of last equal area map cell in the data record *c c*--------------------------------------------------------------------*c latend = c1ints(9,1) lonend = c1ints(10,1) c*--------------------------------------------------------------------*c c* assign equal area cell numbers to first and last cells in record *c c*--------------------------------------------------------------------*c boxbeg = ncells(latbeg) + lonbeg boxend = ncells(latend) + lonend return end c**********************************************************************c c**********************************************************************c c**********************************************************************c c* *c c* s u b r o u t i n e c o n v r t *c c* *c c*--------------------------------------------------------------------*c c* assigns values to c1data output arrays, ivar and rvar. values *c c* are replicated into appropriate 2.5 degree rectangular *c c* (144 x 72 longitude/latitude) grid cells. the first 74 data *c c* values in the cell are integers and the remaining 58 values are *c c* converted into floating point values representing physical *c c* quantities. the conversion tables used are located in block data.*c c* the results are passed back through the common block /c1data/. *c c*--------------------------------------------------------------------*c c* calling parameter: ncell = cell number to convert *c c*--------------------------------------------------------------------*c c* c1data common block and associated parameters: *c c* i*4 maxint ------- byte number of last integer variable *c c* i*4 ireal ------- byte number of first real variable *c c* i*4 init ------- initialization flag for c1read *c c* i*4 lunc1 ------- logical unit for c1 data input *c c* i*4 record ------- record number of current record *c c* i*4 file ------- file number on tape of current record *c c* i*4 year ------- year of data *c c* i*4 month ------- month of data *c c* i*4 day ------- day of data *c c* i*4 gmt ------- gmt of data *c c* i*4 boxbeg ------- equal area box number of first box in record*c c* i*4 boxend ------- equal area box number of last box in record *c c* i*4 ivar ------- integer data variables *c c* r*4 rvar ------- real data variables *c c* *c c* equcom common block variables *c c* r*4 dlontb --------- equal-area map longitude increment for *c c* a given latitude zone *c c* i*4 icells --------- number of equal area cells in a *c c* given latitude zone *c c* i*4 ncells --------- total number of cells starting from the *c c* south pole (latitude zone index = 1) *c c* up to the given latitude zone *c c* *c c* c1bufs common block variables *c c* c*1 c1char --------- one record in character format 13200 bytes*c c* i*4 c1ints --------- one record in integer format *c c* *c c* cnttab common block variables *c c* r*4 tmptab --------- count to temperature table *c c* r*4 tmpvar --------- count to temperature variance table *c c* r*4 pretab --------- count to pressure table *c c* r*4 rfltab --------- count to reflectance table *c c* r*4 tautab --------- count to optical thickness table *c c* r*4 prwtab --------- count to precipitable water table *c c* r*4 ozntab --------- count to ozone abundance table *c c*--------------------------------------------------------------------*c c* physical units and ranges for conversion: *c c*--------------------------------------------------------------------*c c* tmptab - conversion counts (1-253) to temperature (165k-345k) *c c* tmpvar - conversion counts (1-253) to temp. variance(.075k-85k) *c c* pretab - conversion counts (1-241) to pressure (1mb-1200mb) *c c* rfltab - conversion counts (1-253) to reflectance (0.0-1.108) *c c* tautab - conversion counts (1-231) to tau (0.02-119.59) *c c* prwtab - conversion counts (1-253) to precipitable water (humidity)*c c* (0.0-8.0) in centimeters *c c* ozntab - conversion counts (1-253) to ozone abundance (0-515) in *c c* dobson units. *c c*--------------------------------------------------------------------*c c* modifications: *c c* added the logical equal_area. This allows the user to define *c c* which grid the output data is on. If equal_area=true, the data *c c* is on the equal-area grid (6596 regions), otherwise the data is *c c* replicated to fill the equal-angle grid (10368 regions). *c c**********************************************************************c c**********************************************************************c c**********************************************************************c subroutine convrt(ncell,equal_area) c*--------------------------------------------------------------------*c parameter (maxcnt = 255) common/cnttab/tmptab(0:maxcnt),tmpvar(0:maxcnt),pretab(0:maxcnt), 1 rfltab(0:maxcnt),tautab(0:maxcnt),prwtab(0:maxcnt), 2 ozntab(0:maxcnt) c*--------------------------------------------------------------------*c parameter (dlat = 2.5,maxlat = 180.0/dlat,maxlon = 360.0/dlat) common /equcom/ dlontb(maxlat),icells(maxlat),ncells(maxlat) c*--------------------------------------------------------------------*c parameter ( nbytes = 132 ) parameter ( maxint = 74 ) parameter ( ireal = maxint + 1 ) parameter ( numbox = 100 ) common /c1data/ init, lunc1, record, file, year, month, day, & gmt, boxbeg, boxend, ivar(maxint,maxlon), & rvar(ireal:nbytes,maxlon) integer init, lunc1, record, file, year, month, day, & gmt, boxbeg, boxend, ivar real rvar c*--------------------------------------------------------------------*c common /c1bufs/ c1ints(nbytes,numbox)//c1char(nbytes,numbox) character*1 c1char integer c1ints c*--------------------------------------------------------------------*c real var(ireal:nbytes) c*--------------------------------------------------------------------*c logical equal_area c*--------------------------------------------------------------------*c c* *c c* b e g i n *c c* *c c*--------------------------------------------------------------------*c c* fetch equal-area latitude and longitude index *c c*--------------------------------------------------------------------*c latequ = c1ints(1,ncell) lonequ = c1ints(2,ncell) c*--------------------------------------------------------------------*c c* fetch lonsq1 and lonsq2 - square longitude index range *c c* use equal-angle or equal-area longitude indices dependent upon *c c* the logical equal-area. This logic replaces the original: *c c* lonsq1 = c1ints(3,ncell) c* lonsq2 = c1ints(4,ncell) c*--------------------------------------------------------------------*c if(.not. equal_area)then lonsq1 = c1ints(3,ncell) lonsq2 = c1ints(4,ncell) else lonsq1=lonequ lonsq2=lonequ endif c*--------------------------------------------------------------------*c c* convert average and variance of the cloud top pressure *c c*--------------------------------------------------------------------*c var(75) = pretab(c1ints(75,ncell)) var(76) = pretab(c1ints(76,ncell)) var(77) = pretab(c1ints(77,ncell)) var(78) = pretab(c1ints(78,ncell)) var(79) = pretab(c1ints(79,ncell)) c*--------------------------------------------------------------------*c c* convert average and variance of the cloud top temperature *c c*--------------------------------------------------------------------*c var(80) = tmptab(c1ints(80,ncell)) var(81) = tmpvar(c1ints(81,ncell)) var(82) = tmptab(c1ints(82,ncell)) var(83) = tmptab(c1ints(83,ncell)) var(84) = tmptab(c1ints(84,ncell)) c*--------------------------------------------------------------------*c c* convert average and variance of the optical thickness (tau) *c c*--------------------------------------------------------------------*c var(85) = tautab(c1ints(85,ncell)) var(86) = tautab(c1ints(86,ncell)) var(87) = tautab(c1ints(87,ncell)) var(88) = tautab(c1ints(88,ncell)) c*--------------------------------------------------------------------*c c* convert average of the surface temperature *c c*--------------------------------------------------------------------*c var(89) = tmptab(c1ints(89,ncell)) var(90) = tmptab(c1ints(90,ncell)) var(91) = tmpvar(c1ints(91,ncell)) var(92) = tmptab(c1ints(92,ncell)) c*--------------------------------------------------------------------*c c* convert average of the surface reflectance *c c*--------------------------------------------------------------------*c var(93) = rfltab(c1ints(93,ncell)) var(94) = rfltab(c1ints(94,ncell)) var(95) = rfltab(c1ints(95,ncell)) var(96) = rfltab(c1ints(96,ncell)) c*--------------------------------------------------------------------*c c* convert average and variance of the ir radiance *c c*--------------------------------------------------------------------*c var(97) = tmptab(c1ints(97,ncell)) var(98) = tmpvar(c1ints(98,ncell)) var(99) = tmptab(c1ints(99,ncell)) var(100) = tmptab(c1ints(100,ncell)) var(101) = tmpvar(c1ints(101,ncell)) var(102) = tmptab(c1ints(102,ncell)) var(103) = tmptab(c1ints(103,ncell)) c*--------------------------------------------------------------------*c c* convert average and variance of the vis radiance *c c*--------------------------------------------------------------------*c var(104) = rfltab(c1ints(104,ncell)) var(105) = rfltab(c1ints(105,ncell)) var(106) = rfltab(c1ints(106,ncell)) var(107) = rfltab(c1ints(107,ncell)) var(108) = rfltab(c1ints(108,ncell)) var(109) = rfltab(c1ints(109,ncell)) var(110) = rfltab(c1ints(110,ncell)) c*--------------------------------------------------------------------*c c* fetch difference stats (-100 to +100 percent) *c c*--------------------------------------------------------------------*c if ( c1ints(111,ncell) .ne. 255 ) then c1ints(111,ncell) = c1ints(111,ncell) - 100 else c1ints(111,ncell) = -1000.0 end if var(111) = c1ints(111,ncell) if ( c1ints(112,ncell) .ne. 255 ) then c1ints(112,ncell) = c1ints(112,ncell) - 100 else c1ints(112,ncell) = -1000.0 end if var(112) = c1ints(112,ncell) c*--------------------------------------------------------------------*c c* fetch the atmosphere qc ( = 255 if no data ) *c c*--------------------------------------------------------------------*c var(113) = c1ints(113,ncell) c*--------------------------------------------------------------------*c c* convert surface pressure and temperature *c c*--------------------------------------------------------------------*c var(114) = pretab(c1ints(114,ncell)) var(115) = tmptab(c1ints(115,ncell)) c*--------------------------------------------------------------------*c c* convert temperature at 7 standard pressure levels *c c* (1000, 800, 680, 560, 440, 310, 180, mb) *c c*--------------------------------------------------------------------*c do 400 ival = 116,122 var(ival) = tmptab(c1ints(ival,ncell)) 400 continue c*--------------------------------------------------------------------*c c* convert tropopause pressure and temperature *c c*--------------------------------------------------------------------*c var(123) = pretab(c1ints(123,ncell)) var(124) = tmptab(c1ints(124,ncell)) c*--------------------------------------------------------------------*c c* convert stratosphere temperatures at 70 and 30 mb *c c*--------------------------------------------------------------------*c var(125) = tmptab(c1ints(125,ncell)) var(126) = tmptab(c1ints(126,ncell)) c*--------------------------------------------------------------------*c c* convert precipitable water for 5 standard pressure levels *c c* (1000, 800, 680, 560, 440 mb) *c c*--------------------------------------------------------------------*c do 500 ival = 127, 131 var(ival) = prwtab(c1ints(ival,ncell)) 500 continue c*--------------------------------------------------------------------*c c* convert o3-ozone abundance *c c*--------------------------------------------------------------------*c var(132) = ozntab(c1ints(132,ncell)) c*--------------------------------------------------------------------*c c* fill the output arrays with data, with replication *c c* unless equal_area=true c*--------------------------------------------------------------------*c do 620 lonsq = lonsq1, lonsq2 do 600 ival = 1,74 ivar(ival,lonsq) = c1ints(ival,ncell) 600 continue do 610 ival = 75, nbytes rvar(ival,lonsq) = var(ival) 610 continue 620 continue return end c**********************************************************************c c**********************************************************************c c**********************************************************************c c* *c c* b l o c k d a t a *c c* *c c*--------------------------------------------------------------------*c c* this sub-program initializes the conversion tables to convert *c c* counts (0-255) into physical quantities. to use these tables *c c* with any program, just copy the common block declaration (4 lines) *c c* into your program, and append this sub-program. no call is *c c* necessary because the initialization is done at compile time. *c c**********************************************************************c c**********************************************************************c c**********************************************************************c block data c*--------------------------------------------------------------------*c c* common block declaration: (4 lines) *c c*--------------------------------------------------------------------*c parameter (maxcnt = 255) common/cnttab/tmptab(0:maxcnt),tmpvar(0:maxcnt),pretab(0:maxcnt), 1 rfltab(0:maxcnt),tautab(0:maxcnt),prwtab(0:maxcnt), 2 ozntab(0:maxcnt) c*====================================================================*c data (tmptab(i),i=0,127) / & -100.000,165.000,169.000,172.000,175.000,177.800,180.500, & 183.000,185.500,187.800,190.000,192.000,194.000,195.700, & 197.500,199.200,201.000,202.700,204.500,206.200,208.000, & 209.700,211.500,212.800,214.100,215.400,216.700,217.900, & 219.200,220.500,221.800,223.100,224.400,225.400,226.500, & 227.500,228.600,229.600,230.600,231.700,232.700,233.800, & 234.800,235.700,236.600,237.500,238.400,239.200,240.100, & 241.000,241.900,242.800,243.700,244.500,245.300,246.100, & 246.900,247.700,248.500,249.300,250.100,250.900,251.700, & 252.400,253.100,253.900,254.600,255.300,256.000,256.700, & 257.500,258.200,258.900,259.500,260.200,260.800,261.500, & 262.100,262.800,263.400,264.100,264.700,265.400,266.000, & 266.600,267.200,267.800,268.400,269.100,269.700,270.300, & 270.900,271.500,272.100,272.700,273.200,273.800,274.400, & 275.000,275.600,276.100,276.700,277.300,277.800,278.400, & 278.900,279.500,280.000,280.500,281.100,281.600,282.200, & 282.700,283.200,283.700,284.200,284.700,285.200,285.800, & 286.300,286.800,287.300,287.800,288.300,288.800,289.300, & 289.800,290.200/ data (tmptab(i),i=128,255) / & 290.700,291.200,291.700,292.200,292.700, & 293.200,293.600,294.100,294.600,295.000,295.500,296.000, & 296.500,296.900,297.400,297.800,298.300,298.700,299.200, & 299.600,300.100,300.500,301.000,301.400,301.900,302.300, & 302.800,303.200,303.600,304.000,304.500,304.900,305.300, & 305.800,306.200,306.600,307.000,307.500,307.900,308.300, & 308.700,309.100,309.600,310.000,310.400,310.800,311.200, & 311.600,312.000,312.400,312.900,313.300,313.700,314.100, & 314.500,314.900,315.300,315.700,316.100,316.400,316.800, & 317.200,317.600,318.000,318.400,318.800,319.200,319.500, & 319.900,320.300,320.700,321.100,321.400,321.800,322.200, & 322.600,323.000,323.300,323.700,324.100,324.500,324.900, & 325.200,325.600,326.000,326.400,326.700,327.100,327.400, & 327.800,328.200,328.500,328.900,329.200,329.600,329.900, & 330.300,330.600,331.000,331.300,331.700,332.000,332.400, & 332.700,333.100,333.400,333.800,334.100,334.500,334.800, & 335.200,335.500,335.900,336.200,336.600,336.900,337.300, & 337.600,338.000,338.300,338.600,339.000,339.300,339.700, & 340.000,345.000,-200.000,-1000.000/ data (tmpvar(i),i=0,127) / & -100.000, 0.075, 0.300,0.600,0.900,1.200,1.500,1.800,2.100,2.400, & 2.700, 3.000, 3.300,3.600,3.900,4.200,4.500,4.800,5.100,5.400, & 5.700, 6.000, 6.300,6.600,6.900,7.200,7.500,7.800,8.100,8.400, & 8.700, 9.000, 9.300, 9.600, 9.900,10.200,10.500,10.800,11.100, & 11.400,11.700,12.000,12.300,12.600,12.900,13.200,13.500,13.800, & 14.100,14.400,14.700,15.000,15.300,15.600,15.900,16.200,16.500, & 16.800,17.100,17.400,17.700,18.000,18.300,18.600,18.900,19.200, & 19.500,19.800,20.100,20.400,20.700,21.000,21.300,21.600,21.900, & 22.200,22.500,22.800,23.100,23.400,23.700,24.000,24.300,24.600, & 24.900,25.200,25.500,25.800,26.100,26.400,26.700,27.000,27.300, & 27.600,27.900,28.200,28.500,28.800,29.100,29.400,29.700,30.000, & 30.300,30.600,30.900,31.200,31.500,31.800,32.100,32.400,32.700, & 33.000,33.300,33.600,33.900,34.200,34.500,34.800,35.100,35.400, & 35.700,36.000,36.300,36.600,36.900,37.200,37.500,37.800/ data (tmpvar(i),i=128,255) / & 38.100, & 38.400,38.700,39.000,39.300,39.600,39.900,40.200,40.500,40.800, & 41.100,41.400,41.700,42.000,42.300,42.600,42.900,43.200,43.500, & 43.800,44.100,44.400,44.700,45.000,45.300,45.600,45.900,46.200, & 46.500,46.800,47.100,47.400,47.700,48.000,48.300,48.600,48.900, & 49.200,49.500,49.800,50.100,50.400,50.700,51.000,51.300,51.600, & 51.900,52.200,52.500,52.800,53.100,53.400,53.700,54.000,54.300, & 54.600,54.900,55.200,55.500,55.800,56.100,56.400,56.700,57.000, & 57.300,57.600,57.900,58.200,58.500,58.800,59.100,59.400,59.700, & 60.000,60.300,60.600,60.900,61.200,61.500,61.800,62.100,62.400, & 62.700,63.000,63.300,63.600,63.900,64.200,64.500,64.800,65.100, & 65.400,65.700,66.000,66.300,66.600,66.900,67.200,67.500,67.800, & 68.100,68.400,68.700,69.000,69.300,69.600,69.900,70.200,70.500, & 70.800,71.100,71.400,71.700,72.000,72.300,72.600,72.900,73.200, & 73.500,73.800,74.100,74.400,74.700,75.400,78.000,85.000, & -200.000,-1000.000/ data (pretab(i),i=0,127) / & -100.00, 1.00, 5.00, 10.00,15.00,20.00,25.00,30.00,35.00,40.00, & 45.00, 50.00, 55.00,60.00,65.00,70.00,75.00,80.00,85.00,90.00, & 95.00,100.00,105.00,110.00,115.00,120.00,125.00,130.00,135.00, & 140.00,145.00,150.00,155.00,160.00,165.00,170.00,175.00,180.00, & 185.00,190.00,195.00,200.00,205.00,210.00,215.00,220.00,225.00, & 230.00,235.00,240.00,245.00,250.00,255.00,260.00,265.00,270.00, & 275.00,280.00,285.00,290.00,295.00,300.00,305.00,310.00,315.00, & 320.00,325.00,330.00,335.00,340.00,345.00,350.00,355.00,360.00, & 365.00,370.00,375.00,380.00,385.00,390.00,395.00,400.00,405.00, & 410.00,415.00,420.00,425.00,430.00,435.00,440.00,445.00,450.00, & 455.00,460.00,465.00,470.00,475.00,480.00,485.00,490.00,495.00, & 500.00,505.00,510.00,515.00,520.00,525.00,530.00,535.00,540.00, & 545.00,550.00,555.00,560.00,565.00,570.00,575.00,580.00,585.00, & 590.00,595.00,600.00,605.00,610.00,615.00,620.00,625.00,630.00/ data (pretab(i),i=128,255) / & 635.00,640.00,645.00,650.00,655.00,660.00,665.00,670.00,675.00, & 680.00,685.00,690.00,695.00,700.00,705.00,710.00,715.00,720.00, & 725.00,730.00,735.00,740.00,745.00,750.00,755.00,760.00,765.00, & 770.00,775.00,780.00,785.00,790.00,795.00,800.00,805.00,810.00, & 815.00,820.00,825.00,830.00,835.00,840.00,845.00,850.00,855.00, & 860.00,865.00,870.00,875.00,880.00,885.00,890.00,895.00,900.00, & 905.00,910.00,915.00,920.00,925.00,930.00,935.00,940.00,945.00, & 950.00,955.00,960.00,965.00,970.00,975.00,980.00,985.00,990.00, & 995.00,1000.00,1005.00,1010.00,1015.00,1020.00,1025.00,1030.00, & 1035.00,1040.00,1045.00,1050.00,1055.00,1060.00,1065.00, & 1070.00,1075.00,1080.00,1085.00,1090.00,1095.00,1100.00, & 1105.00,1110.00,1115.00,1120.00,1125.00,1130.00,1135.00, & 1140.00,1145.00,1150.00,1155.00,1160.00,1165.00,1170.00, & 1175.00,1180.00,1185.00,1190.00,1195.00,1200.00,-200.00, & -200.00,-200.00,-200.00,-200.00,-200.00,-200.00,-200.00, & -200.00,-200.00,-200.00,-200.00,-200.00,-1000.00/ data (rfltab(i),i=0,127) / & -100.000,0.000,0.008,0.012,0.016,0.020,0.024,0.028,0.032,0.036, & 0.040,0.044,0.048,0.052,0.056,0.060,0.064,0.068,0.072,0.076, & 0.080,0.084,0.088,0.092,0.096,0.100,0.104,0.108,0.112,0.116, & 0.120,0.124,0.128,0.132,0.136,0.140,0.144,0.148,0.152,0.156, & 0.160,0.164,0.168,0.172,0.176,0.180,0.184,0.188,0.192,0.196, & 0.200,0.204,0.208,0.212,0.216,0.220,0.224,0.228,0.232,0.236, & 0.240,0.244,0.248,0.252,0.256,0.260,0.264,0.268,0.272,0.276, & 0.280,0.284,0.288,0.292,0.296,0.300,0.304,0.308,0.312,0.316, & 0.320,0.324,0.328,0.332,0.336,0.340,0.344,0.348,0.352,0.356, & 0.360,0.364,0.368,0.372,0.376,0.380,0.384,0.388,0.392,0.396, & 0.400,0.404,0.408,0.412,0.416,0.420,0.424,0.428,0.432,0.436, & 0.440,0.444,0.448,0.452,0.456,0.460,0.464,0.468,0.472,0.476, & 0.480,0.484,0.488,0.492,0.496,0.500,0.504,0.508/ data (rfltab(i),i=128,255) / & 0.512,0.516, & 0.520,0.524,0.528,0.532,0.536,0.540,0.544,0.548,0.552,0.556, & 0.560,0.564,0.568,0.572,0.576,0.580,0.584,0.588,0.592,0.596, & 0.600,0.604,0.608,0.612,0.616,0.620,0.624,0.628,0.632,0.636, & 0.640,0.644,0.648,0.652,0.656,0.660,0.664,0.668,0.672,0.676, & 0.680,0.684,0.688,0.692,0.696,0.700,0.704,0.708,0.712,0.716, & 0.720,0.724,0.728,0.732,0.736,0.740,0.744,0.748,0.752,0.756, & 0.760,0.764,0.768,0.772,0.776,0.780,0.784,0.788,0.792,0.796, & 0.800,0.804,0.808,0.812,0.816,0.820,0.824,0.828,0.832,0.836, & 0.840,0.844,0.848,0.852,0.856,0.860,0.864,0.868,0.872,0.876, & 0.880,0.884,0.888,0.892,0.896,0.900,0.904,0.908,0.912,0.916, & 0.920,0.924,0.928,0.932,0.936,0.940,0.944,0.948,0.952,0.956, & 0.960,0.964,0.968,0.972,0.976,0.980,0.984,0.988,0.992,1.000, & 1.016,1.040,1.072,1.108,-200.000,-1000.000/ data (tautab(i),i=0,127) / & -100.000,0.020,0.040,0.060,0.090,0.110,0.140,0.160,0.190,0.220, & 0.240,0.270,0.300,0.330,0.370,0.400,0.430,0.460,0.500,0.530, & 0.570,0.600,0.640,0.680,0.720,0.750,0.790,0.830,0.870,0.920, & 0.960,1.000,1.040,1.090,1.130,1.180,1.220,1.270,1.320,1.370, & 1.420,1.470,1.520,1.570,1.620,1.670,1.730,1.780,1.830,1.890, & 1.950,2.000,2.060,2.120,2.180,2.240,2.300,2.360,2.430,2.490, & 2.550,2.620,2.690,2.750,2.820,2.890,2.960,3.030,3.100,3.180, & 3.250,3.320,3.400,3.480,3.550,3.630,3.710,3.790,3.880,3.960, & 4.040,4.130,4.220,4.300,4.390,4.480,4.570,4.670,4.760,4.850, & 4.950,5.050,5.150,5.250,5.350,5.450,5.560,5.660,5.770,5.880, & 5.990,6.110,6.220,6.340,6.450,6.570,6.690,6.820,6.940,7.070, & 7.190,7.330,7.460,7.590,7.730,7.870,8.010,8.150,8.300,8.440, & 8.590,8.740,8.900,9.060,9.220,9.380,9.540,9.710/ data (tautab(i),i=128,255) / & 9.880,10.050, & 10.230,10.410,10.590,10.780,10.970,11.160,11.350,11.550,11.760, & 11.960,12.170,12.390,12.600,12.830,13.050,13.280,13.520,13.760, & 14.000,14.250,14.510,14.770,15.030,15.300,15.580,15.860,16.150, & 16.440,16.740,17.050,17.360,17.690,18.020,18.350,18.700,19.050, & 19.410,19.780,20.160,20.540,20.940,21.350,21.770,22.200,22.630, & 23.080,23.550,24.030,24.520,25.020,25.540,26.070,26.620,27.190, & 27.770,28.370,28.990,29.630,30.290,30.970,31.670,32.400,33.160, & 33.940,34.740,35.580,36.450,37.350,38.290,39.260,40.260,41.320, & 42.420,43.570,44.760,46.000,47.310,48.680,50.110,51.600,53.170, & 54.840,56.590,58.430,60.360,62.400,64.590,66.900,69.360,71.960, & 74.720,77.730,80.940,84.380,88.060,92.020,96.400,101.010, & 105.510,109.870,114.330,119.590,-200.000,-200.000,-200.000, & -200.000,-200.000,-200.000,-200.000,-200.000,-200.000,-200.000, & -200.000,-200.000,-200.000,-200.000,-200.000,-200.000,-200.000, & -200.000,-200.000,-200.000,-200.000,-200.000,-200.000, & -1000.000/ data (prwtab(i),i=0,127) / & -100.000,0.000,0.030,0.060,0.090,0.120,0.150,0.180,0.210,0.240, & 0.270,0.300,0.330,0.360,0.390,0.420,0.450,0.480,0.510,0.540, & 0.570,0.600,0.630,0.660,0.690,0.720,0.750,0.780,0.810,0.840, & 0.870,0.900,0.930,0.960,0.990,1.020,1.050,1.080,1.110,1.140, & 1.170,1.200,1.230,1.260,1.290,1.320,1.350,1.380,1.410,1.440, & 1.470,1.500,1.530,1.560,1.590,1.620,1.650,1.680,1.710,1.740, & 1.770,1.800,1.830,1.860,1.890,1.920,1.950,1.980,2.010,2.040, & 2.070,2.100,2.130,2.160,2.190,2.220,2.250,2.280,2.310,2.340, & 2.370,2.400,2.430,2.460,2.490,2.520,2.550,2.580,2.610,2.640, & 2.670,2.700,2.730,2.760,2.790,2.820,2.850,2.880,2.910,2.940, & 2.970,3.000,3.030,3.060,3.090,3.120,3.150,3.180,3.210,3.240, & 3.270,3.300,3.330,3.360,3.390,3.420,3.450,3.480,3.510,3.540, & 3.570,3.600,3.630,3.660,3.690,3.720,3.750,3.780/ data (prwtab(i),i=128,255) / & 3.810,3.840, & 3.870,3.900,3.930,3.960,3.990,4.020,4.050,4.080,4.110,4.140, & 4.170,4.200,4.230,4.260,4.290,4.320,4.350,4.380,4.410,4.440, & 4.470,4.500,4.530,4.560,4.590,4.620,4.650,4.680,4.710,4.740, & 4.770,4.800,4.830,4.860,4.890,4.920,4.950,4.980,5.010,5.040, & 5.070,5.100,5.130,5.160,5.190,5.220,5.250,5.280,5.310,5.340, & 5.370,5.400,5.430,5.460,5.490,5.520,5.550,5.580,5.610,5.640, & 5.670,5.700,5.730,5.760,5.790,5.820,5.850,5.880,5.910,5.940, & 5.970,6.000,6.030,6.060,6.090,6.120,6.150,6.180,6.210,6.240, & 6.270,6.300,6.330,6.360,6.390,6.420,6.450,6.480,6.510,6.540, & 6.570,6.600,6.630,6.660,6.690,6.720,6.750,6.780,6.810,6.840, & 6.870,6.900,6.930,6.960,6.990,7.020,7.050,7.080,7.110,7.140, & 7.170,7.200,7.230,7.260,7.290,7.320,7.350,7.380,7.410,7.440, & 7.470,7.500,7.650,8.000,-200.000,-1000.000/ data (ozntab(i),i=0,127) / & -100.0,0.0,2.0,4.0,6.0,8.0,10.0,12.0,14.0,16.0,18.0,20.0,22.0, & 24.0,26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0, & 48.0,50.0,52.0,54.0,56.0,58.0,60.0,62.0,64.0,66.0,68.0,70.0, & 72.0,74.0,76.0,78.0,80.0,82.0,84.0,86.0,88.0,90.0,92.0,94.0, & 96.0,98.0,100.0,102.0,104.0,106.0,108.0,110.0,112.0,114.0, & 116.0,118.0,120.0,122.0,124.0,126.0,128.0,130.0,132.0,134.0, & 136.0,138.0,140.0,142.0,144.0,146.0,148.0,150.0,152.0,154.0, & 156.0,158.0,160.0,162.0,164.0,166.0,168.0,170.0,172.0,174.0, & 176.0,178.0,180.0,182.0,184.0,186.0,188.0,190.0,192.0,194.0, & 196.0,198.0,200.0,202.0,204.0,206.0,208.0,210.0,212.0,214.0, & 216.0,218.0,220.0,222.0,224.0,226.0,228.0,230.0,232.0,234.0, & 236.0,238.0,240.0,242.0,244.0,246.0,248.0,250.0,252.0/ data (ozntab(i),i=128,255) / & 254.0, & 256.0,258.0,260.0,262.0,264.0,266.0,268.0,270.0,272.0,274.0, & 276.0,278.0,280.0,282.0,284.0,286.0,288.0,290.0,292.0,294.0, & 296.0,298.0,300.0,302.0,304.0,306.0,308.0,310.0,312.0,314.0, & 316.0,318.0,320.0,322.0,324.0,326.0,328.0,330.0,332.0,334.0, & 336.0,338.0,340.0,342.0,344.0,346.0,348.0,350.0,352.0,354.0, & 356.0,358.0,360.0,362.0,364.0,366.0,368.0,370.0,372.0,374.0, & 376.0,378.0,380.0,382.0,384.0,386.0,388.0,390.0,392.0,394.0, & 396.0,398.0,400.0,402.0,404.0,406.0,408.0,410.0,412.0,414.0, & 416.0,418.0,420.0,422.0,424.0,426.0,428.0,430.0,432.0,434.0, & 436.0,438.0,440.0,442.0,444.0,446.0,448.0,450.0,452.0,454.0, & 456.0,458.0,460.0,462.0,464.0,466.0,468.0,470.0,472.0,474.0, & 476.0,478.0,480.0,482.0,484.0,486.0,488.0,490.0,492.0,494.0, & 496.0,498.0,500.0,505.0,515.0,-200.0,-1000.0/ end