C**********************************************************************C C**********************************************************************C C**********************************************************************C C* T V R E A D M O D U L E *C C*--------------------------------------------------------------------*C C* CONTAINS: *C C* PROGRAM SAMPLE : EXAMPLE OF HOW TO USE THESE SUBROUTINES *C C* SUBROUTINE TVOPEN : OPEN A TV FILE AND INITIALIZE *C C* SUBROUTINE TVREAD : UNPACK TV DATA FOR ONE LATITUDE BAND *C C* SUBROUTINE TVPHYS : CONVERT DATA IN LAT BAND TO PHYSICAL VALUES*C C* SUBROUTINE RDANC : READ ANCILLARY DATA FILE *C C* SUBROUTINE PRINTI : PRINT COUNT VALUES FOR ONE GRID BOX *C C* SUBROUTINE PRINTR : PRINT PHYSICAL VALUES FOR ONE GRID BOX *C C* SUBROUTINE CENTER : CALCULATE CENTER LON/LAT OF GRID BOX *C C* SUBROUTINE EQ2SQ : CONVERT EQUAL AREA MAP TO SQUARE MAP *C C* BLOCK DATA : CONVERSION TABLES AND EQUAL-AREA GRID INFO *C C**********************************************************************C C**********************************************************************C C**********************************************************************C C* THIS SAMPLE PROGRAM READS AN ENTIRE TV FILE BY LOOPING OVER THE 72 C* LATITUDE BANDS ONE AT A TIME. FOR EACH PASS THROUGH THE LOOP, C* TVREAD IS CALLED TO UNPACK THE DATA FOR THAT LAT BAND, AND THEN C* TVPHYS IS CALLED TO CONVERT THAT DATA TO PHYSICAL VALUES. C*--------------------------------------------------------------------*C PROGRAM SAMPLE C*--------------------------------------------------------------------*C C* TV DATA *C C*--------------------------------------------------------------------*C C* NUMBER OF VARIABLES REPORTED IN EACH TOVS PROFILE PARAMETER ( MAXVAR = 30 ) C* GRIDS PARAMETER ( MAXLON = 144 ) PARAMETER ( MAXLAT = 72 ) PARAMETER ( MAXBOX = 6596 ) C* UNDEFINED VALUE FOR INTEGER VALUES PARAMETER ( IUNDEF = 255 ) C* UNDEFINED VALUE FOR FLOATING POINT VALUES PARAMETER ( RUNDEF = -1000.0 ) C* TV RECORD IDENTIFICATION COMMON /TVHEAD/ LUNTV,IREC,IFILE,ITYPE,IYEAR,MONTH,IDAY $ ,LATBEG,LATEND,LONBEG,LONEND,IBXBEG,IBXEND C* TV DATA FOR ONE LATITUDE ZONE C* TVREAD WILL SET NLON TO THE NUMBER OF EQUAL-AREA BOXES IN THE C* LATITUDE ZONE, AND SET IVAR TO THE INTEGER DATA CALLING TVPHYS C* TO FOR CONVERTING TO PHYSICAL VALUES AND STORING IN RVAR COMMON /TVDATA/ LAT,NLON,IVAR(MAXVAR,MAXLON),RVAR(MAXVAR,MAXLON) C* EQUAL AREA GRID INFO COMMON /TVGRID/ NCELLS(MAXLAT),ICELLS(MAXLAT) C* COUNT TO PHYSICAL VALUE CONVERSION TABLES PARAMETER ( MAXCNT = 255 ) COMMON/CNTTAB/TMPTAB(0:MAXCNT),PRETAB(0:MAXCNT), 1 PRWTAB(0:MAXCNT),OZNTAB(0:MAXCNT) C* ARRAYS TO HOLD ONE DECODED VARIABLE AS EQUAL-AREA MAP, AND SQUARE MAP REAL*4 EQMAP(MAXBOX) REAL*4 SQMAP(MAXLON,MAXLAT) CHARACTER*100 STARS/'********************************************* $*******************************************************'/ C*--------------------------------------------------------------------*C C* READ ANCILARY DATA FILE IF PLANNING TO CONVERT EQUAL AREA TO *C C* SQUARE GRID *C C*--------------------------------------------------------------------*C LUNANC = 9 CALL RDANC(LUNANC,IRC) IF ( IRC .NE. 0 ) GOTO 900 C*--------------------------------------------------------------------*C C* OPEN TV FILE AND READ HEADER *C C*--------------------------------------------------------------------*C LUNTV = 10 CALL TVOPEN(IRC) C* CHECK FOR OPEN ERROR IF ( IRC .NE. 0 ) GOTO 910 C*--------------------------------------------------------------------*C C* LOOP OVER LATITUDES, CALL TVREAD SUBROUTINE FOR EACH LAT BAND *C C*--------------------------------------------------------------------*C IBOX = 0 IFULL = 0 DO 500 LAT=1,MAXLAT CALL TVREAD(IRC) C* CHECK FOR END OF FILE IF ( IRC .LT. 0 ) THEN GOTO 800 C* CHECK FOR READ ERROR ELSE IF ( IRC .GT. 0 ) THEN GOTO 920 END IF C*--------------------------------------------------------------------*C C* CONVERT TO PHYSICAL VALUES *C C*--------------------------------------------------------------------*C CALL TVPHYS C*--------------------------------------------------------------------*C C* LOOP OVER LONGITUDES TO PROCESS PROFILES WITHIN THIS LAT BAND *C C*--------------------------------------------------------------------*C DO 400 LON=1,NLON IBOX = IBOX + 1 C* CHECK FOR EMPTY BOX IF ( IVAR(3,LON) .EQ. 255 ) GOTO 400 IFULL = IFULL + 1 C*--------------------------------------------------------------------*C C* DO WHATEVER YOU WANT TO DO WITH THE BOX HERE *C C*--------------------------------------------------------------------*C C* FOR THIS SAMPLE PROGRAM, JUST SELECT A FEW BOXES IF ( LAT .EQ. 36 .AND. LON .LT. 5 ) THEN PRINT 310,STARS,LON,LAT 310 FORMAT(//,A100,//,1X,'PROCESSING EQUAL-AREA LON/LAT',2I10) C* PRINT CONTENTS OF IVAR - COUNTS CALL PRINTI(LON) C* PRINT CONTENTS OF RVAR - PHYSICAL VALUES CALL PRINTR(LON) END IF C*--------------------------------------------------------------------*C C* END OF LON,LAT LOOPS *C C*--------------------------------------------------------------------*C 400 CONTINUE 500 CONTINUE C*--------------------------------------------------------------------*C C* NORMAL END *C C*--------------------------------------------------------------------*C 800 CONTINUE PRINT 810,IFULL 810 FORMAT(/1X,'NUMBER OF FULL BOXES:',I6) PRINT 860 860 FORMAT(/1X,'NORMAL END OF PROGRAM') STOP 0 C*--------------------------------------------------------------------*C C* ERROR ENDS *C C*--------------------------------------------------------------------*C 900 CONTINUE PRINT *,'ERROR: RDANC RC=',IRC STOP 999 910 CONTINUE PRINT *,'ERROR: TVOPEN RC=',IRC STOP 999 920 CONTINUE PRINT *,'ERROR: TVREAD RC=',IRC STOP 999 END C**********************************************************************C C**********************************************************************C C**********************************************************************C C* NAME: TVOPEN *C C* DESCRIPTION: OPEN THE TV FILE AND INITIALIZE HEADER VARIABLES *C C**********************************************************************C C**********************************************************************C C**********************************************************************C SUBROUTINE TVOPEN(IRC) COMMON /TVHEAD/ LUNTV,IREC,IFILE,ITYPE,IYEAR,MONTH,IDAY $ ,LATBEG,LATEND,LONBEG,LONEND,IBXBEG,IBXEND IBXBEG = 0 IBXEND = 0 IREC = 0 OPEN(LUNTV,ACCESS='DIRECT',RECL=16530, $ FORM='UNFORMATTED',IOSTAT=IRC) PRINT *,'FILE SUCCESSFULLY OPENED' RETURN END C**********************************************************************C C**********************************************************************C C**********************************************************************C C* NAME: TVREAD *C C* DESCRIPTION: READ AND UNPACK TV DATA FOR A SINGLE LATITUDE BAND *C C**********************************************************************C C**********************************************************************C C**********************************************************************C SUBROUTINE TVREAD(IRC) PARAMETER ( MAXVAR = 30 ) PARAMETER ( NUMBOX = 551 ) PARAMETER ( MAXLAT = 72 ) PARAMETER ( MAXLON = 144 ) PARAMETER ( IUNDEF = 255 ) PARAMETER ( RUNDEF = -1000.0 ) COMMON /TVBUFS/ CHRBUF(MAXVAR,NUMBOX) CHARACTER*1 CHRBUF COMMON /TVDATA/ LAT,NLON,IVAR(MAXVAR,MAXLON),RVAR(MAXVAR,MAXLON) COMMON /TVHEAD/ LUNTV,IREC,IFILE,ITYPE,IYEAR,MONTH,IDAY $ ,LATBEG,LATEND,LONBEG,LONEND,IBXBEG,IBXEND COMMON /TVGRID/ NCELLS(MAXLAT),ICELLS(MAXLAT) SAVE IDECOD C*--------------------------------------------------------------------*C C* INITIALIZE THE OUTPUT ARRAY - IVAR *C C*--------------------------------------------------------------------*C DO 100 LON=1,MAXLON DO 100 I=1,MAXVAR IVAR(I,LON) = IUNDEF 100 CONTINUE C*--------------------------------------------------------------------*C C* LOOP OVER ALL BOXES FOR THIS LAT *C C*--------------------------------------------------------------------*C NLON = ICELLS(LAT) NPREV = NCELLS(LAT) DO 500 LON=1,NLON NBOX = NPREV + LON C*--------------------------------------------------------------------*C C* IF BOX IS CONTAINED IN THE CURRENT RECORD, UNPACK IT *C C*--------------------------------------------------------------------*C 200 CONTINUE IF ( NBOX .GE. IBXBEG ) THEN IF ( NBOX .LE. IBXEND ) THEN IF ( ICHAR(CHRBUF(1,IDECOD+1)) .GT. LAT ) GOTO 510 IDECOD = IDECOD + 1 ILON = ICHAR(CHRBUF(2,IDECOD)) DO 300 I=1,MAXVAR IVAR(I,ILON) = ICHAR(CHRBUF(I,IDECOD)) 300 CONTINUE C*--------------------------------------------------------------------*C C* OTHERWISE READ THE NEXT RECORD *C C*--------------------------------------------------------------------*C ELSE CALL TVREC(IRC) IDECOD = 1 IF ( IRC .EQ. 0 ) THEN GOTO 200 ELSE GOTO 900 END IF END IF END IF 500 CONTINUE 510 CONTINUE C*--------------------------------------------------------------------*C C* END *C C*--------------------------------------------------------------------*C 900 CONTINUE RETURN END C**********************************************************************C C**********************************************************************C C**********************************************************************C C* NAME: TVREC *C C* DESCRIPTION: READ A TV DATA RECORD AND UNPACK RECORD PREFIX *C C**********************************************************************C C**********************************************************************C C**********************************************************************C SUBROUTINE TVREC(IRC) PARAMETER ( MAXVAR = 30 ) PARAMETER ( NUMBOX = 551 ) PARAMETER ( MAXLAT = 72 ) COMMON /TVBUFS/ CHRBUF(MAXVAR,NUMBOX) CHARACTER*1 CHRBUF COMMON /TVHEAD/ LUNTV,IREC,IFILE,ITYPE,IYEAR,MONTH,IDAY $ ,LATBEG,LATEND,LONBEG,LONEND,IBXBEG,IBXEND COMMON /TVGRID/ NCELLS(MAXLAT),ICELLS(MAXLAT) C*--------------------------------------------------------------------*C C* READ THE TV DATA RECORD IN C*1 FORMAT *C C*--------------------------------------------------------------------*C IREC = IREC + 1 READ(LUNTV,REC=IREC,IOSTAT=IRC) CHRBUF IF ( IRC .EQ. 0 ) THEN C*--------------------------------------------------------------------*C C* DECODE THE PREFIX INFORMATION FOR THIS RECORD *C C*--------------------------------------------------------------------*C IFILE = ICHAR(CHRBUF(1,1)) JREC = ICHAR(CHRBUF(2,1)) ITYPE = ICHAR(CHRBUF(3,1)) IYEAR = ICHAR(CHRBUF(4,1)) MONTH = ICHAR(CHRBUF(5,1)) IDAY = ICHAR(CHRBUF(6,1)) LATBEG = ICHAR(CHRBUF(7,1)) LATEND = ICHAR(CHRBUF(8,1)) LONBEG = ICHAR(CHRBUF(9,1)) LONEND = ICHAR(CHRBUF(10,1)) IBXBEG = (IREC-1)*550+1 IBXEND = (IREC*550) IF ( IREC .EQ. 1 ) PRINT 90,ITYPE,IYEAR,MONTH,IDAY 90 FORMAT(/1X,'TV PREFIX INFORMATION:', $ 'DATA TYPE',I3,' YEAR',I5,' MONTH',I3,' DAY',I3) END IF RETURN END C**********************************************************************C C**********************************************************************C C**********************************************************************C C* NAME: EQ2SQ *C C* DESCRIPTION: CONVERT EQUAL AREA MAP TO SQUARE LAT/LON MAP FOR *C C* DISPLAY PURPOSES *C C* ISHIFT = 1 => SHIFT LONGITUDES TO BE IN RANGE -180 TO +180 *C C* ISHIFT ANY OTHER VALE => KEEP LONGITUDES IN RANGE 0 TO 360 *C C**********************************************************************C C**********************************************************************C C**********************************************************************C SUBROUTINE EQ2SQ(ISHIFT,EQMAP,SQMAP) PARAMETER ( MAXLON = 144 ) PARAMETER ( MAXLAT = 72 ) PARAMETER ( MAXBOX = 6596 ) REAL EQMAP(MAXBOX) REAL SQMAP(MAXLON,MAXLAT) C* EQUAL AREA GRID INFO COMMON /TVGRID/ NCELLS(MAXLAT),ICELLS(MAXLAT) COMMON /SQUARE/ LONLIM(2,MAXBOX) IBOX = 0 DO 200 LAT=1,MAXLAT DO 200 LON=1,ICELLS(LAT) IBOX = IBOX + 1 LONSQ1 = LONLIM(1,IBOX) LONSQ2 = LONLIM(2,IBOX) DO 100 ILON=LONSQ1,LONSQ2 LONSQ = ILON IF ( ISHIFT .EQ. 1 ) THEN LONSQ = LONSQ + MAXLON/2 IF ( LONSQ .GT. MAXLON ) LONSQ = LONSQ - MAXLON END IF SQMAP(LONSQ,LAT) = EQMAP(IBOX) 100 CONTINUE 200 CONTINUE RETURN END C**********************************************************************C C**********************************************************************C C**********************************************************************C C* NAME: TVPHYS *C C* DESCRIPTION: CONVERT DATA FOR ALL GRID BOXES WITHIN A SINGLE LAT *C C* BAND FROM INTEGER COUNTS TO FLOATING POINT *C C* PHYSICAL VALUES *C C**********************************************************************C C**********************************************************************C C**********************************************************************C SUBROUTINE TVPHYS PARAMETER ( MAXVAR = 30 ) PARAMETER ( NUMBOX = 551 ) PARAMETER ( MAXLON = 144 ) PARAMETER ( IUNDEF = 255 ) PARAMETER ( RUNDEF = -1000.0 ) COMMON /TVDATA/ LAT,NLON,IVAR(MAXVAR,MAXLON),RVAR(MAXVAR,MAXLON) PARAMETER ( MAXCNT = 255 ) COMMON/CNTTAB/TMPTAB(0:MAXCNT),PRETAB(0:MAXCNT), 1 PRWTAB(0:MAXCNT),OZNTAB(0:MAXCNT) DO 500 LON=1,NLON C*--------------------------------------------------------------------*C C* BASIC PROFILE INFORMATION *C C*--------------------------------------------------------------------*C DO 10, IBYTE=1,8 RVAR(IBYTE,LON) = IVAR(IBYTE,LON) 10 CONTINUE C*--------------------------------------------------------------------*C C* CLOUD TOP PRESSURE *C C*--------------------------------------------------------------------*C RVAR(9,LON) = PRETAB(IVAR(9,LON)) C*--------------------------------------------------------------------*C C* CLOUD AMOUNT *C C*--------------------------------------------------------------------*C IF ( IVAR(10,LON) .EQ. IUNDEF ) THEN RVAR(10,LON) = RUNDEF ELSE RVAR(10,LON) = FLOAT(IVAR(10,LON)) / 100.0 ENDIF C*--------------------------------------------------------------------*C C* TOPOGRAPHICAL HEIGHT *C C*--------------------------------------------------------------------*C RVAR(11,LON) = FLOAT(IVAR(11,LON)) C*--------------------------------------------------------------------*C C* SURFACE TEMPERATURE & PRESSURE *C C*--------------------------------------------------------------------*C RVAR(12,LON) = TMPTAB(IVAR(12,LON)) RVAR(13,LON) = PRETAB(IVAR(13,LON)) C*--------------------------------------------------------------------*C C* TROPOPAUSE TEMPERATURE & PRESSURE *C C*--------------------------------------------------------------------*C RVAR(14,LON) = TMPTAB(IVAR(14,LON)) RVAR(15,LON) = PRETAB(IVAR(15,LON)) C*--------------------------------------------------------------------*C C* PRECIPITABLE WATER *C C*--------------------------------------------------------------------*C DO 11, IBYTE=16,20 RVAR(IBYTE,LON) = PRWTAB(IVAR(IBYTE,LON)) 11 CONTINUE C*--------------------------------------------------------------------*C C* ATMOSPHERIC TEMPERATURES *C C*--------------------------------------------------------------------*C DO 12, IBYTE=21,29 RVAR(IBYTE,LON) = TMPTAB(IVAR(IBYTE,LON)) 12 CONTINUE C*--------------------------------------------------------------------*C C* OZONE COLUMN ABUNDANCE *C C*--------------------------------------------------------------------*C RVAR(30,LON) = OZNTAB(IVAR(30,LON)) C*--------------------------------------------------------------------*C C* END OF LON LOOP *C C*--------------------------------------------------------------------*C 500 CONTINUE C*--------------------------------------------------------------------*C C* NORMAL RETURN *C C*--------------------------------------------------------------------*C PRINT 510,LAT 510 FORMAT(1X,'TVPHYS: LAT BAND',I4,' CONVERTED TO PHYSICAL VALUES') RETURN END C**********************************************************************C C**********************************************************************C C**********************************************************************C C* NAME: RDANC *C C* DESCRIPTION: READ TV ANCILARY DATA FILE (FILE 4 ON TAPE) *C C**********************************************************************C C**********************************************************************C C**********************************************************************C SUBROUTINE RDANC(LUNANC,IRC) PARAMETER ( MAXBOX = 6596 ) COMMON /SQUARE/ LONLIM(2,MAXBOX) CHARACTER*80 HEADER OPEN(LUNANC,ACCESS='DIRECT',RECL=80,FORM='FORMATTED',IOSTAT=IRC) IF ( IRC .NE. 0 ) RETURN READ(LUNANC,REC=1,FMT='(A80)') HEADER READ(LUNANC,REC=2,FMT='(A80)') HEADER DO 100 IREC=1,MAXBOX READ(LUNANC,REC=IREC+2,FMT=110) IBOX,J,I,LONBEG,LONEND, $ CENLAT,CENLON,IAREA,LANDFR,ITOPOG,IVEG LONLIM(1,IBOX) = LONBEG LONLIM(2,IBOX) = LONEND 100 CONTINUE 110 FORMAT(5I4,2F9.2,I8,I6,I7,5I4) 111 FORMAT(1X,5I4,2F9.2,I8,I6,I7,I4) RETURN END C**********************************************************************C C**********************************************************************C C**********************************************************************C C* NAME: PRINTI *C C* DESCRIPTION: PRINT COUNT VALUES FOR THE BOX *C C**********************************************************************C C**********************************************************************C C**********************************************************************C SUBROUTINE PRINTI(LON) PARAMETER ( MAXVAR = 30 ) PARAMETER ( MAXLON = 144 ) COMMON /TVDATA/ LAT,NLON,IVAR(MAXVAR,MAXLON),RVAR(MAXVAR,MAXLON) PRINT 140 140 FORMAT(/1X,'PRINTI: COUNT VALUES FOR ALL VARIABLES') PRINT 145,(K,K=1,10) 145 FORMAT(1X,18X,10I8) DO 150 I=1,MAXVAR,10 IEND = I + 9 IF ( IEND .GT. MAXVAR ) IEND = MAXVAR PRINT 155,I,IEND,(IVAR(K,LON),K=I,IEND) 150 CONTINUE 155 FORMAT(1X,'VARIABLE (',I3.3,'-',I3.3,')',10I8) RETURN END C**********************************************************************C C**********************************************************************C C**********************************************************************C C* NAME: PRINTR *C C* DESCRIPTION: PRINT PHYSICAL VALUES FOR THE BOX *C C**********************************************************************C C**********************************************************************C C**********************************************************************C SUBROUTINE PRINTR(LON) PARAMETER ( MAXVAR = 30 ) PARAMETER ( MAXLON = 144 ) COMMON /TVDATA/ LAT,NLON,IVAR(MAXVAR,MAXLON),RVAR(MAXVAR,MAXLON) PRINT 140 140 FORMAT(/1X,'PRINTR: PHYSICAL VALUES FOR ALL VARIABLES') PRINT 145,(K,K=1,10) 145 FORMAT(1X,18X,10I8) DO 150 I=1,MAXVAR,10 IEND = I + 9 IF ( IEND .GT. MAXVAR ) IEND = MAXVAR PRINT 155,I,IEND,(RVAR(K,LON),K=I,IEND) 150 CONTINUE 155 FORMAT(1X,'VARIABLE (',I3.3,'-',I3.3,')',10F8.2) RETURN END C**********************************************************************C C**********************************************************************C C**********************************************************************C C* NAME: CENTER *C C* DESCRIPTION: CALCULATE CENTER LON/LAT OF BOX (EQUAL-AREA GRID) *C C**********************************************************************C C**********************************************************************C C**********************************************************************C SUBROUTINE CENTER(LON) PARAMETER ( DLAT = 2.5 ) PARAMETER ( MAXLAT = 72 ) COMMON /TVGRID/ NCELLS(MAXLAT),ICELLS(MAXLAT) PARAMETER ( MAXVAR = 30 ) PARAMETER ( MAXLON = 144 ) COMMON /TVDATA/ LAT,NLON,IVAR(MAXVAR,MAXLON),RVAR(MAXVAR,MAXLON) DLON = 360.0 / NLON CENLAT = ( LAT - 1 ) * DLAT + DLAT/2.0 - 90.0 CENLON = ( LON - 1 ) * DLON + DLON/2.0 PRINT 300,CENLON,CENLAT 300 FORMAT(/1X,'CENTER: CENTER LON/LAT',2F8.2) RETURN END C**********************************************************************C C**********************************************************************C C**********************************************************************C C* NAME: BLOCK DATA *C C* DESCRIPTION: INITIALIZE CONVERSION TABLES AND EQUAL-AREA GRID *C C**********************************************************************C C**********************************************************************C C**********************************************************************C BLOCK DATA C*--------------------------------------------------------------------*C PARAMETER ( MAXCNT = 255 ) COMMON/CNTTAB/TMPTAB(0:MAXCNT),PRETAB(0:MAXCNT), 1 PRWTAB(0:MAXCNT),OZNTAB(0:MAXCNT) C*--------------------------------------------------------------------*C PARAMETER ( MAXLAT = 72 ) COMMON /TVGRID/ NCELLS(MAXLAT),ICELLS(MAXLAT) 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 (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,-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, & -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,-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,-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,-200.00,-1000.00/ 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/ DATA NCELLS / & 0, 3, 12, 28, 50, 78, 112, 152, 198, 250, & 308, 372, 441, 516, 596, 681, 771, 866, 966,1070, & 1178,1290,1406,1526,1649,1775,1904,2036,2170,2306, & 2444,2584,2725,2867,3010,3154,3298,3442,3586,3729, & 3871,4012,4152,4290,4426,4560,4692,4821,4947,5070, & 5190,5306,5418,5526,5630,5730,5825,5915,6000,6080, & 6155,6224,6288,6346,6398,6444,6484,6518,6546,6568, & 6584,6593 / DATA ICELLS / & 3, 9, 16, 22, 28, 34, 40, 46, 52, 58, & 64, 69, 75, 80, 85, 90, 95, 100, 104, 108, & 112, 116, 120, 123, 126, 129, 132, 134, 136, 138, & 140, 141, 142, 143, 144, 144, 144, 144, 143, 142, & 141, 140, 138, 136, 134, 132, 129, 126, 123, 120, & 116, 112, 108, 104, 100, 95, 90, 85, 80, 75, & 69, 64, 58, 52, 46, 40, 34, 28, 22, 16, & 9, 3 / END