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 C2READ SUBROUTINE IN USER-CREATED APPLICATION PROGRAMS. *C C* THE C2READ SUBROUTINE REQUIRES ONE ARGUMENT: A LATITUDE ZONE #. *C C* C2READ THEN RETURNS ALL PARAMETERS FOR ALL LONGITUDE BOXES WITHIN *C C* THAT LATITUDE ZONE. THE PURPOSE OF THIS SAMPLE PROGRAM IS TO *C C* OBTAIN AND PRINT ALL INFORMATION FOR A GIVEN LONGITUDE OVER A *C C* GIVEN RANGE OF LATITUDES. SPECIFICALLY, THIS PROGRAM PRINTS THE *C C* VALUES FOR LONGITUDE BOX NUMBER 45 FOR EACH OF THE 72 LATITUDE *C C* ZONES. *C C**********************************************************************C C**********************************************************************C C**********************************************************************C PROGRAM MAIN C*--------------------------------------------------------------------*C C* C2 DATA *C C*--------------------------------------------------------------------*C PARAMETER ( NBYTES = 72, NUMBOX = 100) PARAMETER ( MAXLON = 144 ) COMMON /C2DATA/ INIT, IC2C3, LUNC2, RECORD, FILE, YEAR, MONTH, & GMT, BOXBEG, BOXEND, VAR(NBYTES,MAXLON) INTEGER INIT, LUNC2, RECORD, FILE, YEAR, MONTH, & GMT, BOXBEG, BOXEND REAL VAR C* INFO FOR EQUAL AREA GRID PARAMETER ( MAXLAT = 72 ) COMMON /EQUCOM/ DLONTB(MAXLAT),ICELLS(MAXLAT),NCELLS(MAXLAT) C*--------------------------------------------------------------------*C C* INITIALIZE FLAGS FOR CALLS TO C2READ *C C*--------------------------------------------------------------------*C IERR = 0 INIT = 0 C*--------------------------------------------------------------------*C C* THE LOGICAL UNIT NUMBER IS ASSUMED TO BE 10 IN THIS CODE *C C*--------------------------------------------------------------------*C LUNC2 = 10 C*--------------------------------------------------------------------*C C* IC2C3 IS A FLAG: 2=READING C2 DATA (SINGLE GMT) *C C* 3=READING C3 DATA (ALL GMT) *C C*--------------------------------------------------------------------*C C READ(5,*) IC2C3 IC2C3 = 2 OPEN(UNIT=LUNC2,FILE='/home/cdrom/DATA/1984/FILE006.DAT', & ACCESS='DIRECT',RECL=7200,FORM='UNFORMATTED') C*--------------------------------------------------------------------*C C* USER-SPECIFIED LONGITUDE INDEX AND LATITUDE RANGE *C C*--------------------------------------------------------------------*C C READ(5,*) LON LON = 2 C READ(5,*) LTBEG LTBEG = 12 C READ(5,*) LTEND LTEND = 14 C*--------------------------------------------------------------------*C C* LOOP OVER THE USER SPECIFIED LATITUDE RANGE *C C*--------------------------------------------------------------------*C DO 1000 NLAT = LTBEG,LTEND C*--------------------------------------------------------------------*C C* CALL C2READ SUBROUTINE FOR EACH NEW LATITUDE ZONE C for equal area grid, change to alternate loop at end of convrt C subroutine C*--------------------------------------------------------------------*C CALL C2READ(NLAT,IERR) IF (IERR .NE. 0) GO TO 3000 C*--------------------------------------------------------------------*C C* PRINT THE OUTPUT FOR A PARTICULAT LON/LAT GRID CELL *C C*--------------------------------------------------------------------*C DO 500 NLON=1,MAXLON C* for equal area grid use this loop instead C DO 500 NLON=1,ICELLS(NLAT) PRINT 300, (K,K=1,10) 300 FORMAT(/,1X,'VAR INDEX ',10I10,/) PRINT 400, (VAR(K,NLON),K=1,NBYTES) 400 FORMAT(1X,'VAR ( 1-10)',10F10.3,/1X,'VAR (11-20)',10F10.3, * /1X,'VAR (21-30)',10F10.3,/1X,'VAR (31-40)',10F10.3, * /1X,'VAR (41-50)',10F10.3,/1X,'VAR (51-60)',10F10.3, * /1X,'VAR (61-70)',10F10.3,/1X,'VAR (71-72)',6F10.3) 500 CONTINUE 1000 CONTINUE C*--------------------------------------------------------------------*C C* CLOSE THE C2 DATA FILE *C C*--------------------------------------------------------------------*C CLOSE (LUNC2) STOP C*--------------------------------------------------------------------*C C* ERROR ENDINGS *C C*--------------------------------------------------------------------*C 3000 PRINT 3001,LUNC2,IERR 3001 FORMAT(1X,'ERROR READING C2 DATA LUNC2',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 2 R E A D *C C* *C C*--------------------------------------------------------------------*C C* C2READ FORTRAN01 VERSION 900531 *C C*--------------------------------------------------------------------*C C* *C C* AUTHOR : ALISON W. WALKER *C C* ST SYSTEMS CORPORATION *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 C2 *C C* DATA FILES. THESE DATA ARE STORED ON TAPE IN AN EQUAL AREA GRID. *C C* THIS ROUTINE MAPS THE DATA BY REPLICATION (IN LONGITUDE ONLY) *C C* INTO A 2.5 DEGREE (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 C2REC *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* C2READ 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 /C2DATA/. *C C*--------------------------------------------------------------------*C C* EXTERNAL ROUTINES CALLED *C C* C2REC -------- 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 C2 DATA (FROM C2REC) *C C* -2 --- ERROR DURING READ OF C2 DATA (FROM C2REC) *C C* -3 --- INIT FLAG NOT 0 OR 1 *C C* -4 --- LAT ZONE < 1 OR LAT ZONE > 72 *C C*--------------------------------------------------------------------*C C* C2 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 7,200 (8-BIT) BYTES IN LENGTH. EACH RECORD *C C* HAS A 72 BYTE PREFIX FOLLOWED BY 99 MAP CELLS OF 72 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 - 221) *C C* BYTE 3: YEAR OF DATASET (83 - 95) *C C* BYTE 4: MONTH (1 - 12) *C C* BYTE 5: UNUSED (255) *C C* BYTE 6: GMT (0,3,6,...,21) OR 255 FOR ALL *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-66: CALIBRATION CORRECTION FACTORS IN TWO-BYTE *C C* PAIRS. FIRST BYTE IS 0 FOR POSITIVE *C C* CORRECTION, OR 1 FOR NEGATIVE CORRECTION. *C C* SECOND BYTE IS SCALED CORRECTION MAGNITUDE. *C C* FOUR BYTE-PAIRS ARE RECORDED FOR EACH *C C* SATELLITE TYPE (TYPES 1-7 ABOVE) CORRESPOND- *C C* ING TO TC, TS, TAU, AND RS WITH SCALE FACTORS *C C* OF 10, 10, 100, AND 1000 RESPECTIVELY. *C C* FOR EXAMPLE, BYTES 11-18 ARE THE TC, TS, TAU, *C C* AND RS CORRECTIONS APPLIED TO GOES-WEST BOXES. *C C* BYTES 67-72: UNUSED (255) *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* LATITUDE INCREMENTS ARE ALL 2.5 DEGREES, LONGITUDE INCREMENTS *C C* INCREASE WITH LATITUDE, FROM 2.5 AT EQUATOR, TO 60.0 AT POLES. *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* VAR 1 LATITUDE INDEX (EQUAL-AREA) *C C* VAR 2 LONGITUDE INDEX (EQUAL-AREA) *C C* VAR 3 LOWER LONGITUDE INDEX (2.5-SQ) *C C* VAR 4 UPPER LONGITUDE INDEX (2.5-SQ) *C C* VAR 5 LAND/WATER/COAST CODE *C C* VAR 6 TOTAL NUMBER OF DAYS IN AVERAGE (DAY+NIGHT) *C C* VAR 7 TOTAL NUMBER OF DAYS IN AVERAGE (DAY) *C C* VAR 8 AVG FREQUENCY OF CLOUDY PIXELS *C C* VAR 9 NUMBER OF DAYS WITH CLOUDS PIXELS > 0 *C C* VAR 10 MARGINAL VIS/IR CLOUD AMOUNT *C C* VAR 11 MEAN PC FOR CLOUDY PIXELS *C C* VAR 12 TIME-SIGMA PC FOR IR-CLOUDY PIXELS *C C* VAR 13 MEAN SPATIAL-SIGMA PC FOR IR-CLOUDY PIXELS *C C* VAR 14 MEAN TC FOR CLOUDY PIXELS *C C* VAR 15 TIME-SIGMA TC FOR IR-CLOUDY PIXELS *C C* VAR 16 MEAN SPATIAL-SIGMA TC FOR IR-CLOUDY PIXELS *C C* VAR 17 MEAN TAU FOR VIS/IR-CLOUDY PIXELS *C C* VAR 18 TIME-SIGMA TAU FOR VIS/IR-CLOUDY PIXELS *C C* VAR 19 MEAN SPATIAL-SIGMA TAU FOR VIS/IR-CLOUDY PIXELS *C C* VAR 20 MEAN CLOUD WATER PATH FOR VIS/IR-CLOUDY PIXELS *C C* VAR 21 TIME-SIGMA PATH FOR VIS/IR-CLOUDY PIXELS *C C* VAR 22 MEAN SPATIAL-SIGMA PATH FOR VIS/IR-CLOUDY PIXELS *C C* VAR 23 AVG FREQ OF LOW LEVEL CLOUDINESS *C C* VAR 24 AVG PC OF LOW LEVEL CLOUDINESS *C C* VAR 25 AVG TC OF LOW LEVEL CLOUDINESS *C C* VAR 26 AVG FREQ OF MIDDLE LEVEL CLOUDINESS *C C* VAR 27 AVG PC OF MIDDLE LEVEL CLOUDINESS *C C* VAR 28 AVG TC OF MIDDLE LEVEL CLOUDINESS *C C* VAR 29 AVG FREQ OF HIGH LEVEL CLOUDINESS *C C* VAR 30 AVG PC OF HIGH LEVEL CLOUDINESS *C C* VAR 31 AVG TC OF HIGH LEVEL CLOUDINESS *C C* VAR 32 AVG FREQ OF CUMULUS LEVEL CLOUDINESS *C C* VAR 33 AVG PC OF CUMULUS CLOUDINESS *C C* VAR 34 AVG TC OF CUMULUS CLOUDINESS *C C* VAR 35 AVG TAU OF CUMULUS CLOUDINESS *C C* VAR 36 AVG FREQ OF STRATUS CLOUDINESS *C C* VAR 37 AVG PC OF STRATUS CLOUDINESS *C C* VAR 38 AVG TC OF STRATUS CLOUDINESS *C C* VAR 39 AVG TAU OF STRATUS CLOUDINESS *C C* VAR 40 AVG FREQ OF ALTOCUMULUS CLOUDINESS *C C* VAR 41 AVG PC OF ALTOCUMULUS CLOUDINESS *C C* VAR 42 AVG TC OF ALTOCUMULUS CLOUDINESS *C C* VAR 43 AVG TAU OF ALTOCUMULUS CLOUDINESS *C C* VAR 44 AVG FREQ OF NIMBOSTRATUS CLOUDINESS *C C* VAR 45 AVG PC OF NIMBOSTRATUS CLOUDINESS *C C* VAR 46 AVG TC OF NIMBOSTRATUS CLOUDINESS *C C* VAR 47 AVG TAU OF NIMBOSTRATIS CLOUDINESS *C C* VAR 48 AVG FREQ OF CIRRUS CLOUDINESS *C C* VAR 49 AVG PC OF CIRRUS CLOUDINESS *C C* VAR 50 AVG TC OF CIRRUS CLOUDINESS *C C* VAR 51 AVG TAU OF CIRRUS CLOUDINESS *C C* VAR 52 AVG FREQ OF CIRROSTRATUS CLOUDINESS *C C* VAR 53 AVG PC OF CIRROSTRATUS CLOUDINESS *C C* VAR 54 AVG TC OF CIRROSTRATUS CLOUDINESS *C C* VAR 55 AVG TAU OF CIRROSTRATUS CLOUDINESS *C C* VAR 56 AVG FREQ OF DEEP CONVECTIVE CLOUDINESS *C C* VAR 57 AVG PC OF DEEP CONVECTIVE CLOUDINESS *C C* VAR 58 AVG TC OF DEEP CONVECTIVE CLOUDINESS *C C* VAR 59 AVG TAU OF DEEP CONVECTIVE CLOUDINESS *C C* VAR 60 MEAN TS FOR CLEAR SKY COMPOSITE *C C* VAR 61 STANDARD DEVIATION FOR TS CLEAR SKY COMPOSITE *C C* VAR 62 MEAN RS FOR CLEAR SKY COMPOSITE *C C* VAR 63 AVG SNOW/ICE COVER *C C* VAR 64 SURFACE PRESSURE (TOVS) *C C* VAR 65 SURFACE TEMPERATURE (TOVS) *C C* VAR 66 TEMPERATURE AT 500 MB (TOVS) *C C* VAR 67 TROPOPAUSE PRESSURE (TOVS) *C C* VAR 68 TROPOPAUSE TEMPERATURE (TOVS) *C C* VAR 69 STRATOSPHERE TEMPERATURE AT 15 MB (TOVS) *C C* VAR 70 PRECIPITABLE WATER - COLUMN (TOVS) *C C* VAR 71 OZONE - COLUMN (TOVS) *C C* VAR 72 AVG FREQ OF CLOUDY PIXELS - UNADJUSTED *C C* *C C*--------------------------------------------------------------------*C C* VARIABLE DICTIONARIES: *C C*--------------------------------------------------------------------*C C* *C C* C2DATA COMMON BLOCK: *C C* *C C* I*4 INIT -------- INITIALIZATION FLAG FOR C2READ ------- (0,1) *C C* 0 - READ FIRST DATA RECORD IN THE FILE *C C* 1 - FETCH THE NEXT DATA RECORD *C C* I*4 IC2C3 ------- FLAG INDICATING TYPE OF DATA BEING READ (2,3)*C C* 2 - C2 DATA ( SINGLE GMT ) *C C* 3 - C3 DATA ( ALL GMTS ) *C C* I*4 LUNC2 ------- LOGICAL UNIT NUMBER FOR A C2 DATA SET ------ *C C* I*4 RECORD ------ DATA RECORD NUMBER WITHIN A FILE ---- (1-67) *C C* I*4 FILE -------- FILE NUMBER ON TAPE ---------------- (1-133) *C C* I*4 YEAR -------- YEAR ------------------------------ (83-88) *C C* I*4 MONTH ------- MONTH ------------------------------- (1-12) *C C* I*4 GMT --------- GMT OF DATA FILE -------------------- (0-21) *C C* I*4 BOXBEG ------ BEGINNING CELL NUMBER IN RECORD --- (1-6596) *C C* I*4 BOXEND ------ ENDING CELL NUMBER IN RECORD ------ (1-6596) *C C* R*4 VAR --------- C2 DATA - ALL PARAMETERS ------------------- *C C* *C C* EQUCOM COMMON BLOCK: *C C* *C C* R*4 DLONTB --------- EQUAL AREA MAP LONGITUDE INCREMENT FOR A *C C* GIVEN LATITUDE *C C* I*4 ICELLS --------- NUMBER OF EQUAL AREA CELLS IN A GIVEN *C C* LATITUDE ZONE *C C* I*4 NCELLS --------- TOTAL NUMBER OF CELLS STARTING FROM SOUTH *C C* POLE (LATITUDE ZONE INDEX = 1) UP TO THE *C C* GIVEN LATITUDE ZONE *C C**********************************************************************C C**********************************************************************C C**********************************************************************C SUBROUTINE C2READ(NLAT,IERR) C*--------------------------------------------------------------------*C C* EQUAL AREA INFORMATION *C 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* C2 DATA *C C*--------------------------------------------------------------------*C PARAMETER (NBYTES = 72, NUMBOX = 100) COMMON /C2DATA/ INIT, IC2C3, LUNC2, RECORD, FILE, YEAR, MONTH, & GMT, BOXBEG, BOXEND, VAR(NBYTES,MAXLON) INTEGER INIT, LUNC2, RECORD, FILE, YEAR, MONTH, & GMT, BOXBEG, BOXEND REAL VAR common /reccnt/ icnt C*--------------------------------------------------------------------*C C* FIRST CALL ONLY: SET UP EQUAL AREA INFO, READ FIRST RECORD *C C*--------------------------------------------------------------------*C IF (INIT .EQ. 0) THEN INIT = 1 icnt = 0 IERR = 0 CALL EQUARE CALL C2REC(IERR) IF (IERR .NE. 0) GOTO 9000 ELSE IF (INIT .NE. 1) GOTO 9010 ENDIF C*--------------------------------------------------------------------*C C* GET BEGINNING AND ENDING CELL NUMBERS FOR THE GIVEN LAT ZONE *C C*--------------------------------------------------------------------*C IF (NLAT .GT. 0 .AND. NLAT .LE. 72) THEN LATZN = NLAT NBXBEG = NCELLS(NLAT) + 1 NBXEND = NCELLS(NLAT) + ICELLS(NLAT) ELSE GOTO 9020 ENDIF C*--------------------------------------------------------------------*C C* INITIALIZE THE OUTPUT ARRAY (VAR) *C C*--------------------------------------------------------------------*C DO 1000 LONSQ = 1, MAXLON DO 1200 I = 1, NBYTES VAR(I,LONSQ) = -1000.0 1200 CONTINUE 1000 CONTINUE C*--------------------------------------------------------------------*C C* LOOP OVER ALL EQUAL AREA MAP CELL NUMBERS IN THE LAT ZONE *C C*--------------------------------------------------------------------*C DO 2000 NCELL = NBXBEG, NBXEND C*--------------------------------------------------------------------*C C* IF CELL IS LOCATED IN THE CURRENT RECORD, DECODE IT *C C*--------------------------------------------------------------------*C 2100 IF ( ( NCELL .GE. BOXBEG ) .AND. ( NCELL .LE. BOXEND ) ) THEN NCEL = NCELL - BOXBEG + 2 CALL CONVRT(NCEL) C*--------------------------------------------------------------------*C C* IF CELL IS NOT LOCATED IN THE CURRENT RECORD, READ NEXT RECORD *C C*--------------------------------------------------------------------*C ELSE CALL C2REC(IERR) IF (IERR .NE. 0) GO TO 9000 GOTO 2100 ENDIF 2000 CONTINUE C*--------------------------------------------------------------------*C C* NORMAL END OF ROUTINE *C C*--------------------------------------------------------------------*C RETURN C*--------------------------------------------------------------------*C C* ERROR ENDINGS *C C*--------------------------------------------------------------------*C C*----END OF C2 DATA SET, IERR CONTAINS THE RETURN CODE FROM C2REC 9000 RETURN C*----INIT FLAG NOT SET PROPERLY 9010 IERR = -3 PRINT 9011, INIT, IERR 9011 FORMAT(/10X,'WARNING: USER HAS NOT SET INIT FLAG INIT =',I4, * ' IERR =',I3,/) RETURN C*----INVALID LATITUDE ZONE 9020 IERR = -4 PRINT 9022, NLAT, IERR 9022 FORMAT(10X,' LATITUDE ZONE RANGE EITHER < 1 OR > 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 2 R E C *C C* *C C*--------------------------------------------------------------------*C C* READS ONE RECORD OF C2 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 72 BYTES, TOTALLING 7200 BYTES PER RECORD. *C C*--------------------------------------------------------------------*C C* EXTERNAL ROUTINES CALLED: *C C* PREFIX --- DECODE PREFIX INFORMATION *C C* UNPACK --- CONVERTS C2 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 C2 DATA *C C* -2 --- ERROR DURING READ OF C2 DATA *C C*--------------------------------------------------------------------*C C* C2BUFS 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 C2CHAR ------ ONE RECORD IN CHARACTER FORMAT (13200 BYTES) *C C* I*4 C2INTS ------ ONE RECORD IN INTEGER FORMAT *C C*--------------------------------------------------------------------*C C* C2DATA COMMON BLOCK AND ASSOCIATED PARAMETERS: *C C* I*4 INIT ------- INITIALIZATION FLAG FOR C2READ *C C* I*4 IC2C3 -------- FLAG INDICATING TYPE OF DATA BEING READ *C C* I*4 LUNC2 ------- LOGICAL UNIT FOR C2 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 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* R*4 VAR ------- REAL DATA VARIABLES *C C**********************************************************************C C**********************************************************************C C**********************************************************************C SUBROUTINE C2REC(IERR) C*--------------------------------------------------------------------*C C* PARAMETERS *C C*--------------------------------------------------------------------*C PARAMETER ( NBYTES = 72 ) PARAMETER ( NUMBOX = 100 ) PARAMETER ( MAXLON = 144 ) C*--------------------------------------------------------------------*C C* CONVERSION ARRAYS FOR READING AND UNPACKING C2DATA *C C*--------------------------------------------------------------------*C COMMON /C2BUFS/ C2INTS(NBYTES,NUMBOX)//C2CHAR(NBYTES,NUMBOX) CHARACTER*1 C2CHAR INTEGER C2INTS C*--------------------------------------------------------------------*C C* C2DATA *C C*--------------------------------------------------------------------*C COMMON /C2DATA/ INIT, IC2C3, LUNC2, RECORD, FILE, YEAR, MONTH, & GMT, BOXBEG, BOXEND, VAR(NBYTES,MAXLON) INTEGER INIT, LUNC2, RECORD, FILE, YEAR, MONTH, & GMT, BOXBEG, BOXEND REAL VAR common /reccnt/ irec C*--------------------------------------------------------------------*C C* *C C* B E G I N *C C* *C C*--------------------------------------------------------------------*C C* READ THE C2 DATA RECORD IN C*1 FORMAT *C C*--------------------------------------------------------------------*C irec = irec + 1 READ (LUNC2,rec=irec,END=1000,ERR=2000) C2CHAR 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* ALL DONE, RETURN TO CALLING PROGRAM *C C*--------------------------------------------------------------------*C IERR = 0 RETURN C*--------------------------------------------------------------------*C C* E R R O R E N D I N G S *C C*--------------------------------------------------------------------*C C*----END OF C2 DATA SET 1000 IERR = -1 PRINT 1001,IERR,LUNC2 1001 FORMAT(10X,'UNEXPECTED END OF DATA ON C2 DATA SET IERR LUNC2 ', 1 I5,I5) RETURN C*----ERROR WHILE READING C2 DATA SET 2000 IERR = -2 PRINT 2001,IERR,LUNC2 2001 FORMAT(10X,'ERROR READING C2 DATA SET IERR LUNC2 ', 1 I5,I5) 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 C2 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* C2BUFS COMMON BLOCK *C C* C*1 C2CHAR --------- ONE RECORD IN CHARACTER FORMAT 13200 BYTES *C C* I*4 C2INTS --------- ONE RECORD IN INTEGER FORMAT *C C**********************************************************************C C**********************************************************************C C**********************************************************************C SUBROUTINE UNPACK PARAMETER ( NBYTES = 72 ) PARAMETER ( NUMBOX = 100 ) C*--------------------------------------------------------------------*C COMMON /C2BUFS/ C2INTS(NBYTES,NUMBOX)//C2CHAR(NBYTES,NUMBOX) CHARACTER*1 C2CHAR INTEGER C2INTS 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 C2INTS(IBYTE,IBOX) = ICHAR(C2CHAR(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 C2DATA COMMON BLOCK *C C*--------------------------------------------------------------------*C C* C2DATA COMMON BLOCK AND ASSOCIATED PARAMETERS: *C C* I*4 INIT ------- INITIALIZATION FLAG FOR C2READ *C C* I*4 IC2C3 ------- FLAG INDICATING TYPE OF DATA BEING READ *C C* I*4 LUNC2 ------- LOGICAL UNIT FOR C2 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 GMT ------- GMT OF DATA (0-21, OR 255 FOR ALL) *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* R*4 VAR ------- 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* C2BUFS COMMON BLOCK VARIABLES *C C* C*1 C2CHAR --------- ONE RECORD IN CHARACTER FORMAT 13200 BYTES*C C* I*4 C2INTS --------- ONE RECORD IN INTEGER FORMAT *C C**********************************************************************C C**********************************************************************C C**********************************************************************C SUBROUTINE PREFIX C*--------------------------------------------------------------------*C PARAMETER ( NBYTES = 72 ) 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 /C2DATA/ INIT, IC2C3, LUNC2, RECORD, FILE, YEAR, MONTH, & GMT, BOXBEG, BOXEND, VAR(NBYTES,MAXLON) INTEGER INIT, LUNC2, RECORD, FILE, YEAR, MONTH, & GMT, BOXBEG, BOXEND REAL VAR C*--------------------------------------------------------------------*C COMMON /C2BUFS/ C2INTS(NBYTES,NUMBOX)//C2CHAR(NBYTES,NUMBOX) CHARACTER*1 C2CHAR INTEGER C2INTS C*--------------------------------------------------------------------*C REAL CALCOR(4,7) CHARACTER*3 SATNAM(7) CHARACTER*3 PRMNAM(4) REAL SCALE(4) DATA SCALE/10.,10.,100.,1000./ DATA SATNAM/'GMS','MET','GOW','GOE','INS','NOA','NOM'/ DATA PRMNAM/'TC ','TS ','TAU','RS '/ 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 = C2INTS(1,1) FILE = C2INTS(2,1) C*--------------------------------------------------------------------*C C* FETCH YEAR, MONTH, GMT OF DATA RECORD *C C*--------------------------------------------------------------------*C YEAR = C2INTS(3,1) MONTH = C2INTS(4,1) GMT = C2INTS(6,1) C*--------------------------------------------------------------------*C C* FETCH LAT/LON INDEX OF FIRST EQUAL AREA MAP CELL IN THE DATA RECORD*C C*--------------------------------------------------------------------*C LATBEG = C2INTS(7,1) LONBEG = C2INTS(8,1) C*--------------------------------------------------------------------*C C* FETCH LAT/LON INDEX OF LAST EQUAL AREA MAP CELL IN THE DATA RECORD *C C*--------------------------------------------------------------------*C LATEND = C2INTS(9,1) LONEND = C2INTS(10,1) C*--------------------------------------------------------------------*C C* FETCH CALIBRATION CORRECTION FACTORS *C C* IF YOU WISH TO DECODE THE CALIBRATION CORRECTION FACTORS USED IN *C C* PRODUCING THIS DATA, DE-COMMENT THE FOLLOWING LINES, UP TO AND *C C* INCLUDING '101 FORMAT...' C*--------------------------------------------------------------------*C INDEX = 11 PRINT *,'CALIBRATION CORRECTION FACTORS USED' DO 100 ISAT = 1,7 DO 100 IPARM = 1,4 IF ( C2INTS(INDEX,1) .EQ. 0 ) THEN SIGN = 1. ELSE SIGN = -1. END IF CALCOR(IPARM,ISAT) = C2INTS(INDEX+1,1) * SIGN / SCALE(IPARM) INDEX = INDEX + 2 PRINT 101,SATNAM(ISAT),PRMNAM(IPARM),CALCOR(IPARM,ISAT) 100 CONTINUE 101 FORMAT(1X,A3,5X,A3,5X,F6.3) 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 C2DATA OUTPUT ARRAY (VAR); ALL DECODED VALUES *C C* ARE REAL*4, REPRESENTING PHYSICAL QUANTITIES. VALUES ARE *C C* REPLICATED INTO APPROPRIATE 2.5 DEGREE RECTANGULAR (144 X 72 *C C* LONGITUDE/LATITUDE) GRID CELLS. THE CONVERSION TABLES USED ARE *C C* LOCATED IN BLOCK DATA. THE RESULTS ARE PASSED BACK THROUGH THE *C C* COMMON BLOCK /C2DATA/. *C C*--------------------------------------------------------------------*C C* CALLING PARAMETER: NCELL = CELL NUMBER TO CONVERT *C C*--------------------------------------------------------------------*C C* C2DATA COMMON BLOCK AND ASSOCIATED PARAMETERS: *C C* I*4 INIT ------- INITIALIZATION FLAG FOR C2READ *C C* I*4 IC2C3 ------- FLAG INDICATING TYPE OF DATA BEING READ *C C* I*4 LUNC2 ------- LOGICAL UNIT FOR C2 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 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* R*4 VAR ------- 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* C2BUFS COMMON BLOCK VARIABLES *C C* C*1 C2CHAR --------- ONE RECORD IN CHARACTER FORMAT 13200 BYTES*C C* I*4 C2INTS --------- 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**********************************************************************C C**********************************************************************C SUBROUTINE CONVRT(NCELL) 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 = 72 ) PARAMETER ( NUMBOX = 100 ) COMMON /C2DATA/ INIT, IC2C3, LUNC2, RECORD, FILE, YEAR, MONTH, & GMT, BOXBEG, BOXEND, VAR(NBYTES,MAXLON) INTEGER INIT, LUNC2, RECORD, FILE, YEAR, MONTH, & GMT, BOXBEG, BOXEND REAL VAR C*--------------------------------------------------------------------*C COMMON /C2BUFS/ C2INTS(NBYTES,NUMBOX)//C2CHAR(NBYTES,NUMBOX) CHARACTER*1 C2CHAR INTEGER C2INTS C*--------------------------------------------------------------------*C REAL VALUE(NBYTES) 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 VALUE(1) = C2INTS(1,NCELL) VALUE(2) = C2INTS(2,NCELL) LONEQ = VALUE(2) C*--------------------------------------------------------------------*C C* FETCH LONSQ1 AND LONSQ2 - SQUARE LONGITUDE INDEX RANGE *C C*--------------------------------------------------------------------*C LONSQ1 = C2INTS(3,NCELL) VALUE(3) = LONSQ1 LONSQ2 = C2INTS(4,NCELL) VALUE(4) = LONSQ2 C*--------------------------------------------------------------------*C C* FETCH LAND/WATER/COAST/CODE *C C*--------------------------------------------------------------------*C IF ( C2INTS(5,NCELL) .NE. 255 ) THEN VALUE(5) = C2INTS(5,NCELL) ELSE VALUE(5) = -1000. END IF C*--------------------------------------------------------------------*C C* FETCH COUNTERS AND CLOUD AMOUNTS *C C*--------------------------------------------------------------------*C IF ( C2INTS(6,NCELL) .NE. 255 ) THEN VALUE(6) = C2INTS(6,NCELL) ELSE VALUE(6) = -1000. END IF IF ( C2INTS(7,NCELL) .NE. 255 ) THEN VALUE(7) = C2INTS(7,NCELL) ELSE VALUE(7) = -1000. END IF IF ( C2INTS(8,NCELL) .NE. 255 ) THEN VALUE(8) = C2INTS(8,NCELL) / 2. ELSE VALUE(8) = -1000. END IF IF ( C2INTS(9,NCELL) .NE. 255 ) THEN IF ( IC2C3 .EQ. 3 ) THEN VALUE(9) = C2INTS(9,NCELL) / 2. ELSE VALUE(9) = C2INTS(9,NCELL) END IF ELSE VALUE(9) = -1000. END IF IF ( C2INTS(10,NCELL) .NE. 255 ) THEN VALUE(10) = C2INTS(10,NCELL) / 2. ELSE VALUE(10) = -1000. END IF C*--------------------------------------------------------------------*C C* CONVERT AVERAGE AND VARIANCE OF THE CLOUD TOP PRESSURE *C C*--------------------------------------------------------------------*C VALUE(11) = PRETAB(C2INTS(11,NCELL)) VALUE(12) = PRETAB(C2INTS(12,NCELL)) VALUE(13) = PRETAB(C2INTS(13,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT AVERAGE AND VARIANCE OF THE CLOUD TOP TEMPERATURE *C C*--------------------------------------------------------------------*C VALUE(14) = TMPTAB(C2INTS(14,NCELL)) VALUE(15) = TMPVAR(C2INTS(15,NCELL)) VALUE(16) = TMPVAR(C2INTS(16,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT AVERAGE AND VARIANCE OF THE OPTICAL THICKNESS (TAU) *C C*--------------------------------------------------------------------*C VALUE(17) = TAUTAB(C2INTS(17,NCELL)) VALUE(18) = TAUTAB(C2INTS(18,NCELL)) VALUE(19) = TAUTAB(C2INTS(19,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT AVERAGE AND VARIANCE OF THE CLOUD WATER PATH *C C*--------------------------------------------------------------------*C VALUE(20) = TAUTAB(C2INTS(20,NCELL)) VALUE(21) = TAUTAB(C2INTS(21,NCELL)) VALUE(22) = TAUTAB(C2INTS(22,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT FREQUENCY AND PROPERTIES OF LOW LEVEL CLOUDINESS *C C*--------------------------------------------------------------------*C IF ( C2INTS(23,NCELL) .NE. 255 ) THEN VALUE(23) = C2INTS(23,NCELL) / 2. ELSE VALUE(23) = -1000. END IF VALUE(24) = PRETAB(C2INTS(24,NCELL)) VALUE(25) = TMPTAB(C2INTS(25,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT FREQUENCY AND PROPERTIES OF MIDDLE LEVEL CLOUDINESS *C C*--------------------------------------------------------------------*C IF ( C2INTS(26,NCELL) .NE. 255 ) THEN VALUE(26) = C2INTS(26,NCELL) / 2. ELSE VALUE(26) = -1000. END IF VALUE(27) = PRETAB(C2INTS(27,NCELL)) VALUE(28) = TMPTAB(C2INTS(28,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT FREQUENCY AND PROPERTIES OF HIGH LEVEL CLOUDINESS *C C*--------------------------------------------------------------------*C IF ( C2INTS(29,NCELL) .NE. 255 ) THEN VALUE(29) = C2INTS(29,NCELL) / 2. ELSE VALUE(29) = -1000. END IF VALUE(30) = PRETAB(C2INTS(30,NCELL)) VALUE(31) = TMPTAB(C2INTS(31,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT FREQUENCY AND PROPERTIES OF CUMULUS CLOUDINESS *C C*--------------------------------------------------------------------*C IF ( C2INTS(32,NCELL) .NE. 255 ) THEN VALUE(32) = C2INTS(32,NCELL) / 2. ELSE VALUE(32) = -1000. END IF VALUE(33) = PRETAB(C2INTS(33,NCELL)) VALUE(34) = TMPTAB(C2INTS(34,NCELL)) VALUE(35) = TAUTAB(C2INTS(35,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT FREQUENCY AND PROPERTIES OF STRATUS CLOUDINESS *C C*--------------------------------------------------------------------*C IF ( C2INTS(36,NCELL) .NE. 255 ) THEN VALUE(36) = C2INTS(36,NCELL) / 2. ELSE VALUE(36) = -1000. END IF VALUE(37) = PRETAB(C2INTS(37,NCELL)) VALUE(38) = TMPTAB(C2INTS(38,NCELL)) VALUE(39) = TAUTAB(C2INTS(39,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT FREQUENCY AND PROPERTIES OF ALTOCUMULUS CLOUDINESS *C C*--------------------------------------------------------------------*C IF ( C2INTS(40,NCELL) .NE. 255 ) THEN VALUE(40) = C2INTS(40,NCELL) / 2. ELSE VALUE(40) = -1000. END IF VALUE(41) = PRETAB(C2INTS(41,NCELL)) VALUE(42) = TMPTAB(C2INTS(42,NCELL)) VALUE(43) = TAUTAB(C2INTS(43,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT FREQUENCY AND PROPERTIES OF NIMBOSTRATUS CLOUDINESS *C C*--------------------------------------------------------------------*C IF ( C2INTS(44,NCELL) .NE. 255 ) THEN VALUE(44) = C2INTS(44,NCELL) / 2. ELSE VALUE(44) = -1000. END IF VALUE(45) = PRETAB(C2INTS(45,NCELL)) VALUE(46) = TMPTAB(C2INTS(46,NCELL)) VALUE(47) = TAUTAB(C2INTS(47,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT FREQUENCY AND PROPERTIES OF CIRRUS CLOUDINESS *C C*--------------------------------------------------------------------*C IF ( C2INTS(48,NCELL) .NE. 255 ) THEN VALUE(48) = C2INTS(48,NCELL) / 2. ELSE VALUE(48) = -1000. END IF VALUE(49) = PRETAB(C2INTS(49,NCELL)) VALUE(50) = TMPTAB(C2INTS(50,NCELL)) VALUE(51) = TAUTAB(C2INTS(51,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT FREQUENCY AND PROPERTIES OF CIRROSTRATUS CLOUDINESS *C C*--------------------------------------------------------------------*C IF ( C2INTS(52,NCELL) .NE. 255 ) THEN VALUE(52) = C2INTS(52,NCELL) / 2. ELSE VALUE(52) = -1000. END IF VALUE(53) = PRETAB(C2INTS(53,NCELL)) VALUE(54) = TMPTAB(C2INTS(54,NCELL)) VALUE(55) = TAUTAB(C2INTS(55,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT FREQUENCY AND PROPERTIES OF DEEP CONVECTIVE CLOUDINESS *C C*--------------------------------------------------------------------*C IF ( C2INTS(56,NCELL) .NE. 255 ) THEN VALUE(56) = C2INTS(56,NCELL) / 2. ELSE VALUE(56) = -1000. END IF VALUE(57) = PRETAB(C2INTS(57,NCELL)) VALUE(58) = TMPTAB(C2INTS(58,NCELL)) VALUE(59) = TAUTAB(C2INTS(59,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT AVERAGE OF SURFACE TEMPERATURE FROM CLEAR SKY COMPOSITE *C C*--------------------------------------------------------------------*C VALUE(60) = TMPTAB(C2INTS(60,NCELL)) VALUE(61) = TMPVAR(C2INTS(61,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT AVERAGE OF THE SURFACE REFLECTANCE *C C*--------------------------------------------------------------------*C VALUE(62) = RFLTAB(C2INTS(62,NCELL)) C*--------------------------------------------------------------------*C C* FETCH SNOW AND ICE COVER *C C*--------------------------------------------------------------------*C IF ( C2INTS(63,NCELL) .NE. 255 ) THEN VALUE(63) = C2INTS(63,NCELL) ELSE VALUE(63) = -1000. END IF C*--------------------------------------------------------------------*C C* CONVERT SURFACE PRESSURE AND TEMPERATURE (TOVS) *C C*--------------------------------------------------------------------*C VALUE(64) = PRETAB(C2INTS(64,NCELL)) VALUE(65) = TMPTAB(C2INTS(65,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT TEMPERATURE AT 500 MB (TOVS) *C C*--------------------------------------------------------------------*C VALUE(66) = TMPTAB(C2INTS(66,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT TROPOPAUSE PRESSURE AND TEMPERATURE (TOVS) *C C*--------------------------------------------------------------------*C VALUE(67) = PRETAB(C2INTS(67,NCELL)) VALUE(68) = TMPTAB(C2INTS(68,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT STRATOSPHERE TEMPERATURE AT 15 MB (TOVS) *C C*--------------------------------------------------------------------*C VALUE(69) = TMPTAB(C2INTS(69,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT PRECIPITABLE WATER COLUMN (TOVS) *C C*--------------------------------------------------------------------*C VALUE(70) = PRWTAB(C2INTS(70,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT OZONE COLUMN *C C*--------------------------------------------------------------------*C VALUE(71) = OZNTAB(C2INTS(71,NCELL)) C*--------------------------------------------------------------------*C C* CONVERT ORIGINAL CLOUD AMOUNT *C C*--------------------------------------------------------------------*C IF ( C2INTS(72,NCELL) .NE. 255 ) THEN VALUE(72) = C2INTS(72,NCELL) / 2. ELSE VALUE(72) = -1000. END IF C*--------------------------------------------------------------------*C C* FILL THE OUTPUT ARRAY WITH DATA, WITH REPLICATION (SQUARE GRID) *C C*--------------------------------------------------------------------*C DO 610 LONSQ = LONSQ1, LONSQ2 DO 600 I = 1, NBYTES VAR(I,LONSQ) = VALUE(I) 600 CONTINUE 610 CONTINUE C*--------------------------------------------------------------------*C C* FILL THE OUTPUT ARRAY WITH DATA, NO REPLICATION (EQUAL-AREA GRID) *C C*--------------------------------------------------------------------*C C DO 600 I = 1, NBYTES C VAR(I,LONEQ) = VALUE(I) C 600 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 C*====================================================================*C C* *C C* W A R N I N G ! ! *C C* *C C* DUE TO THE FORTRAN IMPOSED LIMIT ON CONTINUATION LINES (19), THE *C C* FOLLOWING EQUIVALENCE STATEMENTS WERE NECESSARY TO INITIALIZE THE *C C* TABLES. IF YOUR PROCESSOR DOES NOT SUPPORT EQUIVALENCE *C C* STATEMENTS, YOU MUST INITIALIZE THE TABLES IN AN ALTERNATE WAY. *C C* *C C*====================================================================*C C*====================================================================*C DIMENSION TMP1(0:127),TMP2(128:255) EQUIVALENCE ( TMPTAB(0) ,TMP1(0) ) EQUIVALENCE ( TMPTAB(128),TMP2(128) ) DIMENSION VAR1(0:127),VAR2(128:255) EQUIVALENCE ( TMPVAR(0) ,VAR1(0) ) EQUIVALENCE ( TMPVAR(128),VAR2(128) ) DIMENSION PRE1(0:127),PRE2(128:255) EQUIVALENCE ( PRETAB(0) ,PRE1(0) ) EQUIVALENCE ( PRETAB(128),PRE2(128) ) DIMENSION RFL1(0:127),RFL2(128:255) EQUIVALENCE ( RFLTAB(0) ,RFL1(0) ) EQUIVALENCE ( RFLTAB(128),RFL2(128) ) DIMENSION TAU1(0:127),TAU2(128:255) EQUIVALENCE ( TAUTAB(0) ,TAU1(0) ) EQUIVALENCE ( TAUTAB(128),TAU2(128) ) DIMENSION PRW1(0:127),PRW2(128:255) EQUIVALENCE ( PRWTAB(0) ,PRW1(0) ) EQUIVALENCE ( PRWTAB(128),PRW2(128) ) DIMENSION OZN1(0:127),OZN2(128:255) EQUIVALENCE ( OZNTAB(0) ,OZN1(0) ) EQUIVALENCE ( OZNTAB(128),OZN2(128) ) C*====================================================================*C C*====================================================================*C DATA TMP1 / & -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 TMP2 / & 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 VAR1 / & -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 VAR2 / & 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 PRE1 / & -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 PRE2 / & 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 RFL1 / & -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 RFL2 / & 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 TAU1 / & -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 TAU2 / & 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 PRW1 / & -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 PRW2 / & 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 OZN1 / & -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 OZN2 / & 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