SRB .PILOT.GISS.000007.0.19861001.19861031 William B. Rossow NASA Goddard Institute for Space Studies 2880 Broadway New York, NY 10025 USA 19890913 CX.1.NOA.9.8610 (M00553-M00561) 19890912 6250 IBM 4381-13 running VM/SP Release 5, Service Level 509 IBM 0123456789=:> /STUVWXYZ,(-JKLMNOPQR*";+ABCDEFGHI.)"< Results from ISCCP analysis of B3 radiance data (sampled to 25 km) for either the POLSAT or GEOSAT. Unlike the standard ISCCP product, these data are reported at original pixel resolution and contain detailed information about the algorithm decision. Additional descriptive notes and sample software are included. END OF GENERAL SEGMENT RECORD NAME: AU.NOA.N - Pixel-by-scanline map grid 24 24 3792 William B. Rossow NASA Goddard Institute for Space Studies 2880 Broadway New York, NY 10025 USA SRB/ALASKA/NOA :SRB ALASKA IFO/NOAA-9 N/A :Not Applicable DATA-DESCRIPTION-RECORD-SUBSECTION RECORD-PREFIX-AREA BEGIN TAPEFILE_NUMBER FNUM I*4 Unitless I4 31 0 1 1 1 1 RECORD_NUMBER RNUM I*4 Unitless I4 31 0 1 1 1 9999 BYTE_CHECKSUM CKSM I*4 Unitless I11 31 0 1 1 0 11089538 LOGICAL_RECSIZE RSIZ I*4 Unitless I6 31 0 1 1 24 24 LOGIREC/PHYSREC NREC I*4 Unitless I6 31 0 1 1 157 157 RESERVED_APFX1 RSAPFX1 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_APFX2 RSAPFX2 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_APFX3 RSAPFX3 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_APFX4 RSAPFX4 I*1 Unitless Z2 7 0 1 1 00 FF DATA-DESCRIPTION-RECORD-SUBSECTION RECORD-PREFIX-AREA END DATA-DESCRIPTION-RECORD-SUBSECTION RECORD-DATA-AREA BEGIN LATITUDE LAT I*2 Degrees F5.1 9 -90 000.1 000.1 -90.0 90.0 LONGITUDE LON I*2 Degrees F6.1 9 -180 000.1 000.1 -180.0 180.0 RESERVED_AUX01 RSAUX01 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX02 RSAUX02 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX03 RSAUX03 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX04 RSAUX04 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX05 RSAUX05 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX06 RSAUX06 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX07 RSAUX07 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX08 RSAUX08 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX09 RSAUX09 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX10 RSAUX10 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX11 RSAUX11 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX12 RSAUX12 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX13 RSAUX13 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX14 RSAUX14 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX15 RSAUX15 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX16 RSAUX16 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX17 RSAUX17 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX18 RSAUX18 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX19 RSAUX19 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_AUX20 RSAUX20 I*1 Unitless Z2 7 0 1 1 00 FF DATA-DESCRIPTION-RECORD-SUBSECTION RECORD-DATA-AREA END INSTRUMENT DESCRIPTION: Not Applicable TEMPORAL CHARACTERISTICS: This dataset is NOT time-dependent. It is to be used as a reference map, for those satellite observation datasets on this tape that specify AU.NOA.N as their AUXFIL. SPATIAL CHARACTERISTICS: Data covers the region from: 55 degrees North to 90 degrees North (+55 to +90), 175 degrees West to 135 degrees West (-175 to -135). (Polar projection covers 55S - 90S or 55N - 90N, maximum; Midlatitude maps cover 55S to 55N, maximum.) CALIBRATION INFO: Not Applicable REFERENCES: Not Applicable SOFTWARE: ************************************** **** Fireltln Fortran *** 12/30/88 *** ************************************** C*** 3/29/89 (KLB): Modified output format C*** 4/27/89 (KLB): (Maximum) values for RPFX, FSIZ, and NREC are now C*** now defined in the ancillary file's DDR; these C*** values yield the minimum acceptable array bounds. *** PROGRAM FIRELTLN C C--- Purpose: Demonstrate how to read and interpret the C--- pixel-by-scanline LATLON grid supplied as C--- an Ancilliary file. C C C----------------------------------------------------------------------- C--- The constant, IS$IBM, controls whether ASCII character data C--- is to be translated to EBCDIC before it is displayed. Set C--- it to .TRUE. if you're running on IBM hardware. C COMMON /MACHIN/ IS$IBM LOGICAL IS$IBM C----------------------------------------------------------------------- C C--- MAXPXS is simply an upper bound on the various array sizes; C--- it must be greater than, or equal to, the quantity NREC, as C--- determined from the Data Description Record (DDR). C INTEGER MAXPXS PARAMETER (MAXPXS = 320) C C C--- Auxilliary data values may be 1, 2, or 4 byte quantities. C INTEGER RSIZMX PARAMETER (RSIZMX = 24) C INTEGER RSIZ$1, RSIZ$2, RSIZ$4 PARAMETER (RSIZ$1 = RSIZMX) PARAMETER (RSIZ$2 = RSIZMX / 2) PARAMETER (RSIZ$4 = RSIZMX / 4) C CHARACTER*1 AUXBUF(RSIZ$1*MAXPXS) CHARACTER*1 AUX$1(RSIZ$1,MAXPXS) INTEGER*2 AUX$2(RSIZ$2,MAXPXS) INTEGER*4 AUX$4(RSIZ$4,MAXPXS) EQUIVALENCE (AUXBUF,AUX$1,AUX$2,AUX$4) C C--- The quantities that form the "record prefix" C INTEGER FNUM, RNUM, CKSM, RSIZ, NREC, RPFX C----------------------------------------------------------------------- C C--- Various useful storage and constants C INTEGER PXL REAL RLAT(MAXPXS), RLON(MAXPXS) INTEGER LUNIN /10/ INTEGER LAT /1/, LON /2/ INTEGER*2 NULL$2 /Z7FFF/ C----------------------------------------------------------------------- C C--- I have chosen the FIRE coefficient N to be 9, thus, C--- since we are dealing with I*2 quantities, the parameter b C--- is 15 and the scaling factor is (2 ** (N-b)) or 1/64. C--- The additive constant is -90.0 for LAT and -180.0 for LON. C C--- (Note that the FSCALE defined here is actually the inverse of C--- what is given in the DDR, since it is the scaling factor that C--- was used in GENERATING the data; also, the ADDCON values are C--- the additive inverse of what is given in the DDR for the same C--- reason.) C INTEGER N$FIRE, HI$BIT, FSCALE PARAMETER (N$FIRE = 9) PARAMETER (HI$BIT = 15) PARAMETER (FSCALE = (2 ** (HI$BIT - N$FIRE))) REAL ADDCON(2) /90.0, 180.0/ C----------------------------------------------------------------------- C C C--- BEGIN FIRELTLN C IS$IBM = .TRUE. C PRINT *,'*** FIRELTLN ***' PRINT * PRINT *,'*** FSCALE :',FSCALE PRINT *,'*** ADDCON(LAT) :',ADDCON(LAT) PRINT *,'*** ADDCON(LON) :',ADDCON(LON) PRINT * PRINT *,'*** THE FLAG, "IS$IBM", HAS THE VALUE, ',IS$IBM PRINT *,'*** THIS CONSTANT SHOULD BE SET EQUAL TO .TRUE.' PRINT *,'*** IF YOU ARE RUNNING ON IBM HARDWARE, AND TO' PRINT *,'*** .FALSE. OTHERWISE.' PRINT * C XSCALE = FSCALE C C--- Read and display the file header record C READ(LUNIN,NUM=NBYTES,END=1010,ERR=1020) AUXBUF PRINT *,'$$$ NBYTES =',NBYTES,' (HEADER RECORD)' C C--- The subroutine ATOE converts character data from ASCII to EBCDIC. C--- It is included in the FORTRAN program, FIREREAD. C IF (IS$IBM) THEN CALL ATOE( AUXBUF, NBYTES, AUXBUF ) ENDIF C PRINT * PRINT *,'=== ANCILLARY FILE HEADER (FIRST 160 BYTES ONLY) ===' PRINT *,(AUXBUF(I), I = 1, 80) PRINT *,(AUXBUF(I), I = 81, 160) PRINT * C C--- Scanline is same as RNUM (Record Number) C C--- Loop over scanlines (major loop) C 100 READ(LUNIN,NUM=NBYTES,END=200,ERR=1020) & FNUM, RNUM, CKSM, RSIZ, NREC, RPFX, AUXBUF PRINT 110,FNUM,RNUM,CKSM,RSIZ,NREC,RPFX 110 FORMAT(//,1X,'FNUM:',I4,5X,'RNUM:',I4,5X,'CKSM:',I11, & 5X,'RSIZ:',I6,5X,'NREC:',I6,5X,'RPFX:',I6,/) C C--- Make sure that our array bounds are large enough C IF (RSIZ .GT. RSIZMX) THEN PRINT *,'+++ "RSIZ" .GT. "RSIZMX" (',RSIZ, RSIZMX,')' PRINT *,' ++ INCREASING "RSIZMX" WILL FIX THIS PROBLEM.' STOP 1 ENDIF IF (NREC .GT. MAXPXS) THEN PRINT *,'+++ NREC .GT. "MAXPXS" (',NREC, MAXPXS,')' PRINT *,' ++ INCREASING "MAXPXS" WILL FIX THIS PROBLEM.' STOP 1 ENDIF C C--- Test for loss of synchronization, somewhere... C IF (RSIZ*NREC .NE. (NBYTES-RPFX)) THEN PRINT *,'+++ ANCILLARY FILE SYNCHRONIZATION ERROR: ', & 'FNUM',FNUM,', RNUM',RNUM,', NBYTES',NBYTES PRINT *,' ++ CHECK RPFX (',RPFX,') AND NBYTES.' STOP 1 ENDIF C C--- Initialize output Lat/Lon values to a "null-value flag" C DO 115 PXL = 1, MAXPXS RLAT(PXL) = 999.9 RLON(PXL) = 999.9 115 CONTINUE C C--- Loop over pixels within each scanline (minor loop) C DO 120 PXL = 1, NREC IF (AUX$2(LAT,PXL) .NE. NULL$2) THEN XLAT = AUX$2(LAT,PXL) RLAT(PXL) = (XLAT / XSCALE) - ADDCON(LAT) ENDIF IF (AUX$2(LON,PXL) .NE. NULL$2) THEN XLON = AUX$2(LON,PXL) RLON(PXL) = (XLON / XSCALE) - ADDCON(LON) ENDIF 120 CONTINUE C DO 140 PXL = 1, NREC - 9, 10 PRINT 130, (RLAT(I), RLON(I), I = PXL, PXL+9) 130 FORMAT(1X,10(:1X,F5.1,1X,F6.1)) 140 CONTINUE NRECDV = NREC / 10 NRECRM = NREC - (NRECDV * 10) IF (NRECRM .NE. 0) & PRINT 130, (RLAT(I), RLON(I), I = NRECDV*10, NREC - 9) GOTO 100 C C--- Normal termination C 200 PRINT * PRINT *,'*** END-OF-FILE ***' STOP C C--- I/O error C 1010 PRINT *,'+++ UNEXPECTED END OF FILE (ON HEADER): ', & 'FILE',FNUM,', RECORD',RNUM STOP 1 C 1020 PRINT *,'+++ ERROR READING ANCILLARY FILE: ', & 'FILE',FNUM,', RECORD',RNUM STOP 1 C END END OF ANCILLARY SEGMENT RECORD NAME: CX.NOA.N - ISCCP analysis: B3 radiance data 24 24 3792 William B. Rossow NASA Goddard Institute for Space Studies 2880 Broadway New York, NY 10025 USA SRB/ALASKA/NOA :SRB ALASKA IFO/NOAA-9 NOA/AVHRR :Advanced Very High Resolution Radiometer DATA-DESCRIPTION-RECORD-SUBSECTION RECORD-PREFIX-AREA BEGIN TAPEFILE_NUMBER FNUM I*4 Unitless I4 31 0 1 1 1 9999 RECORD_NUMBER RNUM I*4 Unitless I4 31 0 1 1 1 9999 BYTE_CHECKSUM CKSM I*4 Unitless I11 31 0 1 1 0 960840 LOGICAL_RECSIZE RSIZ I*4 Unitless I6 31 0 1 1 24 24 LOGIREC/PHYSREC NREC I*4 Unitless I6 31 0 1 1 157 157 RESERVED_DPFX1 RSDPFX1 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_DPFX2 RSDPFX2 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_DPFX3 RSDPFX3 I*1 Unitless Z2 7 0 1 1 00 FF RESERVED_DPFX4 RSDPFX4 I*1 Unitless Z2 7 0 1 1 00 FF DATA-DESCRIPTION-RECORD-SUBSECTION RECORD-PREFIX-AREA END DATA-DESCRIPTION-RECORD-SUBSECTION RECORD-DATA-AREA BEGIN FLAGS1 FLG1 I*1 Unitless Z2 7 0 1 1 00 FF FLAGS2 FLG2 I*1 Unitless Z2 7 0 1 1 00 FF FLAGS3 FLG3 I*1 Unitless Z2 7 0 1 1 00 FF IR_Channel IDAT I*1 Unitless Z2 7 0 1 1 00 FF IR_Clearsky ICLR I*1 Unitless Z2 7 0 1 1 00 FF Addtl_Channel1 ADD1 I*1 Unitless Z2 7 0 1 1 00 FF Addtl_Channel2 ADD2 I*1 Unitless Z2 7 0 1 1 00 FF Addtl_Channel3 ADD3 I*1 Unitless Z2 7 0 1 1 00 FF FLAGS4 FLG4 I*1 Unitless Z2 7 0 1 1 00 FF Navigation_Ang1 MU0 I*1 Unitless Z2 7 0 1 1 00 FF Navigation_Ang2 PHI0 I*1 Unitless Z2 7 0 1 1 00 FF Vis_Channel VDAT I*1 Unitless Z2 7 0 1 1 00 FF Vis_Clearsky VCLR I*1 Unitless Z2 7 0 1 1 00 FF FLAGS5 FLG5 I*1 Unitless Z2 7 0 1 1 00 FF FLAGS6 FLG6 I*1 Unitless Z2 7 0 1 1 00 FF Retrieved_Temp TRET I*1 Unitless Z2 7 0 1 1 00 FF Retrieved_Press PRET I*1 Unitless Z2 7 0 1 1 00 FF Clearsky_Temp TCLR I*1 Unitless Z2 7 0 1 1 00 FF Clearsky_Press PCLR I*1 Unitless Z2 7 0 1 1 00 FF FLAGS7 FLG7 I*1 Unitless Z2 7 0 1 1 00 FF Albedo_or_Tau ATAU I*1 Unitless Z2 7 0 1 1 00 FF Clearsky_Albedo ACLR I*1 Unitless Z2 7 0 1 1 00 FF Tau_corrected_T TCOR I*1 Unitless Z2 7 0 1 1 00 FF Tau_corrected_P PCOR I*1 Unitless Z2 7 0 1 1 00 FF DATA-DESCRIPTION-RECORD-SUBSECTION RECORD-DATA-AREA END INSTRUMENT DESCRIPTION: Please see the following document (and references contained therein): World Climate Research Programme, International Satellite Cloud Climatology Project (ISCCP), "Description of Reduced Resolution Radiance Data", Rossow, W.B., Kinsella, E., Wolf, A., and Garder, L.C., July 1985 (Revised August 1987), WMO/TD-No. 58, 143 pp. TEMPORAL CHARACTERISTICS: Every non-null overpass of the Special region, for every day in the date range, 19861001-19861031. For NOA (polar-orbiter) mid-latitude data, all orbits within a given day are merged into a single image. SPATIAL CHARACTERISTICS: Data covers the region from: 55 degrees North to 90 degrees North (+55 to +90), 175 degrees West to 135 degrees West (-175 to -135). (Polar projection covers 55S - 90S or 55N - 90N, maximum; Midlatitude maps cover 55S to 55N, maximum.) Spatially sampled imaging data. Nominal spatial resolution is 25 km. Pixel field of view is 4 km (NOAA data) or 5-8 km (GEOSAT data). Earth location (latitude +/- 90 degrees, longitude +/- 180 degrees) is obtained for each pixel from ancillary data. CALIBRATION INFO: Radiances normalized to NOAA-9 AVHRR, which in turn is normalized to NOAA-7 AVHRR as part of ISCCP calibration monitoring. Absolute visible calibration is then obtained from a combination of ISCCP normalization and an absolute calibration from NASA ER-2 flights under NOAA-9. Please see the following document (and references contained therein): World Climate Research Programme, International Satellite Cloud Climatology Project (ISCCP), "Description of Reduced Resolution Radiance Data", Rossow, W.B., Kinsella, E., Wolf, A., and Garder, L.C., July 1985 (Revised August 1987), WMO/TD-No. 58, 143 pp. REFERENCES: For a description of the cloud analysis algorithm and a detailed interpretation of the analysis results, see the following: "International Satellite Cloud Climatology Project (ISCCP) Documentation of Cloud Data", W.B. Rossow, L.C. Garder, P.-J. Lu, and A. Walker (1988), WMO/TD-No. 266, pp. 75. The following references were taken directly from the document, "International Satellite Cloud Climatology Project (ISCCP) Description of Reduced Resolution Radiance Data", W.B. Rossow, E. Kinsella, A. Wolf, and L.C. Garder, (1985, 1987), pages 95-98. -------------------------------------------------------------------------------- 6.1. GENERAL Coakley, J.A., and F.P. Bretherton, 1982: Cloud cover from high-resolution scanner data: Detecting and allowing for partially filled fields of view. J. Geophys. Res., 87, 4917-4932. Coulson, K.L., and H. Jacobowitz, 1972: Proposed target for the visible channel of a satellite radiometer. NOAA Tech. Rep. NESS 62, pp. 27. Deschamps, P.Y., M. Herman and D. Tanre, 1983: Modelisation du rayonnement reflechi par l'atmosphere et la Terre entre 0.35 et 4 fm. Final report, ESA contract 4393/80/F/DD(SC), pp. 165. Frouin, R., and C. Gautier, 1987: Calibration of GOES-5 and GOES-6 VISSR/VAS and AVHRR short wavelength channels. Int. J. Remote Sensing (in press). Hilsenrath, E., D.F. Heath and B.M. Schlesinger, 1979: Seasonal and interannual variations in total ozone revealed by the NIMBUS 4 back-scattered ultraviolet experiment. J. Geophys. Res., 84, 6969-6979. Hollier, P., 1977a: Sensibilit spectrale absolue des chaines IR et visibles. (Modeles F1, F2). COSMOS METEOSAT, European Space Agency. Hollier, P., 1977b: Notice d'utilisation du systeme de calibration interne des chaines IR1 et IR2. COSMOS METEOSAT, European Space Agency. Kidwell, K.B., 1981: NOAA Polar Orbiter Data (TIROS-N, NOAA-6 and NOAA-7) Users Guide, Environmental Data and Information Service, National Oceanic and Atmospheric Administration, U.S. Dept. of Commerce. Kimes, D.S., 1983: Dynamics of directional reflectance factor distributions for vegetation canopies. Appl. Optics, 22, 1364-1372. Kneizys, F.X., E.P. Shettle, W.O. Gallery, J.H. Chetwynd, L.W. Abreu, J.E.A. Selby, R.W. Fenn and R.A. McClatchey, 1980: Atmospheric transmittance/rad- iance computer code LOWTRAN 5. Environ. Res. Paper No. 354, Air Force Cambridge Laboratories, Bedford, Mass., pp. 233. Koepke, P., 1980: Calibration of the METEOSAT IR-channel by ground measure- ments. Contrib. Atmos. Phys., 53, 442-445. Koepke, P., 1982: Vicarious satellite calibration in the solar spectral range by means of calculated radiances and its application to METEOSAT. Appl. Optics, 21, 2845-2854. Kriebel, K.T., 1980: Calibration of the METEOSAT VIS-channel. Proc. Second METEOSAT Scientific User Meeting, London, 26-27 March 1980, ESOC/ESA. Kriebel, K.T., 1981: Calibration of the METEOSAT-VIS-channel by airborne measurements. Appl. Optics, 20, 11-12. Lauritson. L., G.J. Nelson and F.W. Porto, 1979: Data extraction and calibra- tion of TIROS-N/NOAA radiometers. NOAA Tech. Memo. NESS 107, National Oceanic and Atmospheric Administration, U.S. Dept. of Commerce, 58 pp. Matthews, E., 1983: Global vegetation and land use: New high-resolution data bases for climate studies. J. Climate Appl. Meteor., 22, 474-487. Matthews, E., and W.B. Rossow, 1987: Global, seasonal maps of surface visible reflectivity from satellite observations. J. Climate Appl. Meteor., 26, 170- 202. McClatchey, R.A., R.W. Fenn, J.E.A. Selby, F.E. Volz and J.S. Garing, 1972: Optical properties of the atmosphere (3rd ed.). AFCRL Environ. Res. Papers No. 411, 108 pp. Menzel, P., 1980: Prelaunch study report of VAS-D performance. Univ. of Wisconsin, 65 pp. Menzel, P., 1981: Prelaunch study report of VAS-E performance. Univ. of Wisconsin, 9 pp. Menzel, P., 1983: Prelaunch study report of VAS-F performance. Univ. of Wisconsin, 7 pp. Menzel, P., W.L. Smith and L.D. Herman, 1981: Visible infrared spin-scan radiometer atmospheric sounder radiometric calibration: An inflight evalua- tion from intercomparisons with HIRS and radiosonde measurements. Appl. Optics, 20, 3641-3644. Meteorological Satellite Center, 1980: The GMS Users Guide (updated in March 1984), Japan Meteorological Agency, 130 pp. Morgan, J., 1978: Introduction to the METEOSAT System. MDMD, ESOC, European Space Agency, Darmstadt. Muench, H.S., 1981: Calibration of geosynchronous satellite video sensors. U.S. Air Force Geophysics Lab., Hanscom AFB, Massachusetts, 25 pp. Neckel, H., and D. Labs, 1984: The solar radiation between 3300 and 12500 CA., Solar Phys., 90, 205-258. Njoku, E.G., 1985: Satellite-derived sea surface temperature: Workshop com- parisons. Bull. Amer. Meteor. Soc., 66, 274-281. Norton, C.C., F.R. Mosher, B. Hinton, D.W. Martin, D. Santek and W. Kuhlow, 1980: A model for calculating desert aerosol turbidity over the oceans from geostationary satellite data. J. Appl. Meteor., 19, 633-644. Paltridge, G., and C.M.R. Platt, 1976: Radiative Processes in Meteorology and Climatology. Elsevier Scientific Publ. Co., New York, pp. 318. Schiffer, R.A., and W.B. Rossow, 1983: The International Satellite Cloud Climatology Project (ISCCP): The first project of the World Climate Research Programme. Bull. Amer. Meteor. Soc., 64, 779-784. Schiffer, R.A., and W.B. Rossow, 1985: ISCCP global radiance data set: A new resource for climate research. Bull. Amer. Meteor. Soc., 66, 1498-1505. Smith, E.A., and D. Loranger, 1977: Radiometric calibration of polar and geosynchronous satellite shortwave detectors for albedo measurements. Dept. of Atmos. Sci., Colorado State Univ., 42 pp. Smith, E.A., and T.H. Vonder Haar, 1980: A first look at the summer MONEX GOES satellite data. AIAA 15th Thermophysics Conf., Snowmass, Colorado, 14-16 July 1980, Amer. Inst. Aero. and Astro., 16 pp. Tanre, D., M. Herman, P.Y. Deschamps and A. Deleffe, 1979: Atmospheric model- ling for space measurements of ground reflectances, including bidirectional effects. Appl. Opt., 18, 3857-3596. Walraven, R.L., and K.L. Carlson, 1972: Measurements of the light properties of gypsum sand. Contrib. Atmos. Sci. No. 7, Univ. California, Davis, pp. 140. Warren, S.G., 1982: Optical properties of snow. Rev. Geophys. Space Phys., 20, 67-89. Willson, R.C., 1984: Measurement of solar total irradiance and its variability. Space Sci. Rev., 38, 203-242. World Climate Programme, 1981: Preliminary plan for the World Climate Research Programme, World Meteorological Organization, Geneva, WCP-2. World Climate Programme, 1981: The International Satellite Cloud Climatology Project, World Meteorological Organization, Geneva, WCP-6. World Climate Programme, 1982: Report of a Planning Meeting on the International Satellite Cloud Climatology Project (ISCCP), Geneva, 9-12 August 1982, World Meteorological Organization, WCP-28. World Climate Programme, 1982: The International Satellite Cloud Climatology Project (ISCCP) Preliminary Implementation Plan (revision 1). World Meteor- ological Organization, WCP-35. 6.2. PROJECT DOCUMENTS WCP-6: The International Satellite Cloud Climatology Project, January 1981, World Meteorological Organization, Geneva. WCP-20: The International Satellite Cloud Climatology Project (ISCCP) Prelim- inary Implementation Plan, April 1982, World Meteorological Organiza- tion, Geneva. WCP-28: Report of the Planning Meeting on the International Satellite Cloud Climatology Project (ISCCP), Geneva, 9-12 August 1982, World Meteor- ological Organization, Geneva. WCP-35: The International Satellite Cloud Climatology Project (ISCCP) Prelim- inary Implementation Plan (Revision 1), November 1982, World Meteor- ological Organization, Geneva. WCP-42: Report of the First Session of the International Satellite Cloud Climatology Project (ISCCP), New York, 13-17 December 1982, World Meteorological Organization, Geneva. WCP-52: Report of the Second Session of the International Satellite Cloud Climatology Project (ISCCP), New York, 25-27 May 1983, World Meteor- ological Organization, Geneva. WCP-73: The International Satellite Cloud Climatology Project (ISCCP) Cloud Analysis Algorithm Intercomparison, March 1984, World Meteorological Organization, Geneva. WCP-82: Report of the Third Session of the International Working Group on Data Management for the International Satellite Cloud Climatology Project (ISCCP), Tokyo, 6-8 March 1984, World Meteorological Organization, Geneva. WCP-95: International Satellite Cloud Climatology Project (ISCCP) - Catalog of Data Products, April 1985, World Meteorological Organization, Geneva. WCP-102: Report of the Fourth Session of the International Working Group on Data Management for the International Satellite Cloud Climatology Project (ISCCP), Darmstadt, 25-27 February 1985, World Meteorological Organiza- tion, Geneva. WMO/TD-No. 88: The International Satellite Cloud Climatology Project (ISCCP) Research Plan and Validation Strategy, January 1986, World Meteor- ological Organization, Geneva. WCP-123: Report of the Fifth Session of the International Working Group on Data Management for the International Satellite Cloud Climatology Project (ISCCP), Paris, 23-25 June 1986, World Meteorological Organization, Geneva. WMO/TD-No. 4: The International Satellite Cloud Climatology Project (ISCCP) Data Management Plan, September 1984, World Meteorological Organiza- tion, Geneva. WMO/TD-No. 266: The International Satellite Cloud Climatology Project (ISCCP) Documentation of Cloud Data, December 1988, World Meteorological Organization, Geneva. 6.3. RELATED REPORTS GARP, 1975: The Physical Basis of Climate and Climate Modelling. GARP Publica- tion Series No. 16, World Meteorological Organization, Geneva, 265 pp. Hahn, C.J., S.G. Warren, J. London, R.M. Chervin and R. Jenne, 1982: Atlas of simultaneous occurrence of different cloud types over the ocean. NCAR Technical Note NCAR/TN-201+STR. Hahn, C.J., S.G. Warren, J. London, R.M. Chervin and R. Jenne, 1984: Atlas of simultaneous occurrence of different cloud types over land. NCAR Technical Note NCAR/TN-241+STR. Luther, F.M., 1984: The intercomparison of radiation codes in climate models (ICRCCM) - Longwave clear-sky calculations, WCP-93, Frascati, Italy, 15-18 August 1984, World Meteorological Organization, Geneva. New York, 1981: Clouds in Climate: Modeling and Satellite Observational Studies. Report of Workshop held at NASA Goddard Institute for Space Studies, New York, NY, USA, October 1980. Oxford, 1978: JOC Study Conference on Parameterizations of Extended Cloudiness and Radiation for Climate Models, Oxford, England. GARP Climate Dynamics Subprogram. World Meteorological Organization, Geneva. Smith, E.A., and M.R. Smith, 1987: Atlas of Earth radiation budget measurements from NIMBUS-7 ERB (1979-1983), Florida State Univ., 254 pp. Warren, S.G., C.J. Hahn, J. London, R.M. Chervin and R.L. Jenne, 1986: Global distribution of total cloud cover and cloud type amounts over land. NCAR Technical Note NCAR/TN-273 + STR (also DOE/ER/60085-H1). WCP-115: Report of the Workshop on Surface Radiation Budget for Climate Applications, Columbia, Maryland, 18-21 June 1985, J.T. Suttles and G. Ohring, Eds. (also WMO/TD-No. 104), World Meteorological Organization, Geneva. SOFTWARE: ************************************** **** Firenote Fortran *** 12/30/88 *** ************************************** * * Minor mods to comments - 2/24/89, KLB * * Documented record prefix area length parameter, RPFX, and changes * to the FIRE-standard-format of the DDR - 4/26/89, KLB * C======================================================================= C==== FIRE tape documentation ======================================== C======================================================================= C C C C Notes on the FIRE tape format C======================================================================= C C TAPE STRUCTURE - Description and Notes C ====================================== C C The tape is nominally 2400 feet long, and written at 6250 BPI, C unlabeled, on an IBM 4381 running VM/CMS. It includes CHARACTER, C INTEGER*1 (commonly known as CHARACTER*1), INTEGER*2, and INTEGER*4 C data only (no REAL, DOUBLE, or other floating point formats). C Note: CHARACTER*1 is taken to be an unsigned quantity, having C possible values ranging from 0 through 255 (hexadecimal 00..FF), C while INTEGER*2 and INTEGER*4 are taken to be signed quantities, C whose maximum (positive) values are 32,767 (7FFF, hexadecimal) C and 2,147,483,647 (7FFFFFFF, hexadecimal), respectively. C C The tapes contain the following files, in the following order, as C described in the description of the "Standard Data Format for FIRE": C C File No. 1 - Header file, in CHARACTER format (ASCII). C Physical record length is 6400 bytes. C Logical record length is 80 bytes. C C File No. 2 - Volume Table of Contents (VTOC) in ASCII. C Physical record length is 6400 bytes. C Logical record length is 160 bytes. C Brief description of files, beginning with the C ancillary data file(s), the fourth (and fifth, ...) C physical file(s) on the tape. C C File No. 3 - Test Data in ASCII. C Physical record length is 6400 bytes. C Logical record length is 80 bytes. C Each logical record is an expanded "pixel packet", C consisting of RSIZ (see below) bytes of the C original file per "Test Data" logical record. C Note that this file represents the complete contents of C the first "observation data" file on the tape, NOT of the C first "data" file (the ancillary file). C C File No. 4 - Ancillary File (LatLon grid) in scaled INTEGER*2 format. C Record prefix length is RPFX bytes (see below). C Logical record length is RSIZ bytes (see below). C There are NREC (see below) logical records, or "pixels", C per physical record. C Physical record length is thus (RPFX + NREC*RSIZ) bytes. C Within each logical record ("pixel") of the DATA area, C bytes 1 and 2 contain a LATITUDE in I*2 format, C bytes 3 and 4 contain a LONGITUDE in I*2 format; C currently, bytes 5 through RSIZ of each logical record C are unused, and are reserved for possible future use. C The LAT/LON quantities are to be used as a lookup table C to convert any (pixel,scanline) coordinate pair in each C of the data files into a pair of LAT/LON coordinates. C First physical record is header record, in ASCII. C Note: if there is more than one ancillary data file on C a given tape, then the second ancillary file will be the C fifth physical file, etc. C C Files no. X through last - Where "X" = (3 + no. of ancillary files) C Observation Data Files in INTEGER*1 format. C Record prefix length is RPFX bytes (see below). C Logical record length is RSIZ bytes (see below). C There are NREC (see below) logical records, or "pixels", C per physical record. C Physical record length is thus (RPFX + NREC*RSIZ) bytes. C Contains various flags and physical quantities in coded C format, obtained from ISCCP analysis of B3 radiance data. C First physical record is header record, in ASCII. C C C C C DATA FILE STRUCTURE - Description and Notes C =========================================== C C OBSERVATION DATA FILES C ====================== C C HEADER RECORD C ============= C C The header record consists of the same 160 bytes of ASCII text as are C contained in the VTOC's DDR record for each data file, padded on the C right with spaces to the full physical record length of the file. All C records following the header record for any given file are "data" C records, whose format is described below. C C Note that we have modified the "FIRE-standard-format" of the DDR C section of the header file in three ways: C C 1. Bytes 26-65 (40 bytes), originally reserved for a plain language C description of the record, are now allocated as follows: C bytes 26-58 (33 bytes) are reserved for a plain language C description of the record, bytes 59-60 (2 bytes) are blank C (i.e., ASCII "space") filled, and bytes 61-65 (5 bytes) now C contain the size, in bytes, of the record prefix area, RPFX. C C 2. Bytes 81-96 (16 bytes), originally filled with blanks, are now C used to identify the "RECORD NAME" of the ancillary file that C corresponds to the data file being described. There is an 8- C byte field (bytes 81-88) that is reserved for the keyword, C " AUXFIL=" (please note the leading blank), immediately followed C by an 8-byte field (bytes 89-96) that holds the ancillary file's C RECORD NAME. C C All ancillary files will have the string, "((NONE))" in this C location, since they do not, themselves, require other ancillary C files. All observation data files will have the RECORD NAME C that appears in bytes 13-20 of the appropriate ancillary file's C DDR (also in the VTOC). Note that this addition permits the C READ program to check (a) that what is being read as an C ancillary data file really is that type of file, and (b) that C the correct ancillary data file is being used. Since the RECORD C TYPE field is unique in only a generic sense (CX files for all C GOES-WEST data have the same RECORD NAME, namely "CX.GOW.G", C although the actual map grid described by the ancillary file C differs from month to month, i.e., Oct 86 is slightly different C from Nov 86, due to movements in the satellite's position with C respect to the Earth). This means that the check on RECORD NAME C is useful only when dealing with files from the same tape, not C for checking files originating on different tapes. This change C also permits unambiguous (again with the restriction that all C files were obtained from the same tape) specification of which C ancillary data file to use when CX data files having different C map grids are included on a single tape (in which case, two or C more ancillary data files, with different RECORD NAMEs, will C also be found on that tape). Multiple map grids may arise for C certain of the polar-orbiter (NOA) data files, for example, if C North-polar, South-polar, and Mid-latitude data files are mixed C on a single tape. This may be necessary under certain circum- C stances to provide full coverage of the desired geographic area C for a given date/time range. C C The sample program, FIREREAD, which is included on this tape, C provides an example of the use the additional ancillary file C identification field to verify that the correct ancillary data C file is being used. C C 3. We bracket the two subsections ("prefix" and "data") of the DDR C section with logical records containing the following keywords: C C DATA-DESCRIPTION-RECORD-SUBSECTION C RECORD-PREFIX-AREA C RECORD-DATA-AREA C BEGIN C END C C Each keyword, when it appears, is left-justified in a field of C 80 bytes, filled on the right with spaces. Three such keywords, C therefore, occupy the full 240 bytes ordinarily taken up by a C DDR logical record. The first such keyword will always be C "DATA-DESCRIPTION-SUBSECTION". The second keyword in such a DDR C entry will be either "RECORD-PREFIX-AREA" or "RECORD-DATA-AREA". C The third such field will be either "BEGIN" or "END". It is C hoped that this convention will result in DDR sections which are C easily and unambigously parsed by both human and machine. C Although the given lengths of the record prefix area (RPFX) and C of the data area's logical record (RSIZ) suffice to implicitly C delimit the two DDR subsections, it is believed that the C redundancy afforded by the addition of the "BEGIN...END" record C pairs makes misinterpretation of these subsections less likely, C especially for the human reader. We believe that it should be C reasonably straightforward to adapt software that parses the DDR C to recognize and appropriately respond to these additional C records. C C These changes were deemed necessary to permit inclusion of a C record prefix subsection, while maintaining an acceptably compact C DDR section. C C C C DATA RECORDS C ============ C C Record Prefix Area C ------------------ C Each physical record is composed of a "record prefix area" and C a "record data area". The record prefix area contains the following C information: C C FNUM (I*4) - Data file number on tape. C RNUM (I*4) - Data record sequence number within the file. C CKSM (I*4) - Checksum (simply the sum of all byte values within C the DATA area that follows PREFIX area). C RSIZ (I*4) - The size, in bytes, of each logical record in the C DATA area. C NREC (I*4) - The number of logical records in the DATA area. C RPFX (I*4) - The size, in bytes, of the PREFIX area. C C Note that the size of the record prefix area, RPFX, may be obtained C from the DDR (bytes 61-65), or from the prefix area itself. C If it is preferred to obtain RPFX from the data file record prefix C area, then the "NUM=" option of the FORTRAN-77 READ statement may C be used to permit reading one complete physical record into a buffer C without prior knowledge of the length of the record; in this case, C the length of the buffer must be declared to be greater than or equal C to the actual length of the physical record (the FIRE maximum of C 12,000 bytes may be used for this purpose). C C Note also that although the original version of FIRE-format C CX data has a record prefix area of 24 bytes, with only the C above quantities included, future datasets may have a larger C prefix area containing additional information. The prefix area C will always be an integral multiple of the logical record size, C RSIZ, to permit easy manipulation of the data components of the C physical record; the first 24 bytes of the record prefix area C will always, however, remain as defined in this document. C C C Record Data Area C ---------------- C The record data area contains, in scanline format, NREC BX/CX pixel C packets (RSIZ bytes per pixel packet), where NREC is the number of C pixels per scanline. C C C Record Structure C ---------------- C C Note: in the examples which follow, values for RPFX, RSIZ, and C NREC are assumed, solely for purposes of discussion. The actual C values of these quantities on any particular data tape must be C obtained from the DDR and from the data file record prefix area. C C Physical Record for a FIRE CX dataset C C Assume: RPFX = 24, RSIZ = 24, NREC = 320 C -------------------------------------------------------------------- C Rec Prefix Area (24 bytes) Rec Data Area (320 * 24 bytes) C -------------------------------------------------------------------- C C C C Logical Record for the FIRE CX dataset C C Assume: RSIZ = 24 C ----------------------------- C Bytes 1-24 of the CX packet C ----------------------------- C C C C Thus in the above example, the physical record contains a prefix area C of 24 bytes and a data area composed of 320 logical records (pixels) C of 24 bytes each. The physical record can, in this case, if it is C convenient to do so, be treated as 321 logical records of 24 bytes C each, the first logical record being the "record prefix area". C A FORTRAN program, FIREREAD, has been provided to demonstrate how C to read and interpret this file. Several tables of REAL numbers, C in the form of FORTRAN DATA statements, have also been provided, C to permit conversion of certain of the data quantities into actual C physical quantities (e.g., temperature and pressure). Please note C that the FORTRAN code contains machine- and operating system- C dependent aspects, and is provided merely as a guide to using the C data. C C C C ANCILLARY FILE C ============== C An ancillary file, containing the LAT/LON coordinates of each mapped C grid point (pixel,scanline) in the data files, is included on each C tape. As does each data file, the ancillary file has a header record, C containing the 160 byte DDR entry for that file, padded with spaces C on the right to the full physical record length. Every record from C that point on has a "record prefix area" similar to that of the data C files (described above), and the data area contains the same number of C "pixels" as do the data files. Each pixel in the ancillary file C contains, in the first 4 bytes, two 2-byte quantities which represent C LAT/LON coordinate pairs, in scaled INTEGER*2 format. Additional C quantities may be present in the remainder of each logical record C (or pixel) in bytes 5 through RSIZ, as described in the DDR for the C ancillary file. Fill values of FF, 7FFF, or 7FFFFFFF (hexadecimal) C are used for 1-, 2-, and 4-byte integer quantities, respectively. C Note that the LAT/LON values have been scaled, as described in the C DDR, to permit storing values in the range, -90.0 through +90.0 C degrees latitude, and -180.0 through +180.0 degrees longitude. C A short FORTRAN program, RDLTLN, has been provided on each tape, C to demonstrate how to read and interpret the LAT/LON information C contained in this file. C C Note: in cases where more than a single map-grid was used, there C will be one ancillary file for each map-grid, and the " AUXFIL=" C field will point to the appropriate ancillary file for each data C file. C C C C======================================================================= C Notes on the FIRE BX/CX data format C======================================================================= C C In general, there are two satellite radiometer channels which are C always present, the visible (Vis) and infrared (IR) channels, C although the Vis channel is not present in "nighttime" data; C it is possible that one or both of these channels may not be C present for any particular pixel, scanline (or part), or image C (or part). Since the FIRE dataset is supplied in a fixed map grid, C in pixel-by-scanline format, all data bytes are always present, C and "missing" data always has the special null value, 255. C Zero or more bytes may be "null" for any particular pixel. C C The BX data packet C ================== C C The first 13 bytes of each logical record (pixel) constitute the C "BX data packet". C C The byte sequence of this packet is as follows: C C 5 bytes of pixel ID and IR information C 3 bytes of "additional channel" data C 5 bytes of Vis information. C C C Byte No. Bit Representation (MSB to LSB) C ------------------------------------------- C Description C ----------- C C C Byte 1: N SH L T S1 S2 C1 C2 C ----------------------------------------- C C N - 0 for day pixels, 1 for night pixels. C C SH - "shore" bit. If this bit is equal to 1, then the C pixel has been determined to be geographically C near a coastline. The "nearness" criterion is as C follows: a water pixel is classed as "shore" if C there is a coastline within 5 pixels of it; a land C pixel is "shore" if there is a coastline within C 2 pixels of it. C C L - 0 for land, 1 for ocean. C C T - 1 if the pixel topography exceeds 2500 meters in C height, 0 otherwise. This bit should never be C found to be ON when L is ON (i.e., there is no C high topography in the ocean). C C S1 through S2 - snow/ice bits. 0-none; 1-filled with snow C or with ice, depending on whether the pixel is on C land (snow) or ocean (ice); 3-near an ice or C a snow margin. C C C1 through C2 - pixel class, from a combination of spatial and C temporal criteria. 0-undecided state; 1-cloud C 2-clear; 3-mixed (conflicting information). C C C Byte 2: I1 I2 I3 I4 I5 T1 T2 T3 C ----------------------------------------- C C I1 through I5 - IR clear-sky flag, representing the result of C the clear-sky logic for the given pixel. In C particular, coded values from 1 through 8 (bit C combinations 00001 through 01000) signify that C the short-term statistics were judged adequate C for the given pixel, and code values of 9 or C higher (bit combinations 01001 and higher) C signify that long-term statistics were used to C determine the IR clear-sky radiance. Short-term C statistics are generally preferred for those C situations which are judged to be fairly cloud- C free on a time scale of 5 days (land), or 15 C days (ocean), while long-term statistics (15 or C 30 days on land, 30 days on ocean) are used C whenever the clear-sky uncertainty is higher C than normal (due to either persistent cloudiness C or to difficulties associated with the terrain C in which the pixel is located). C C This flag may take on the following values: C C 0 ----- Value does not exist ----- C 1 (short-term) Tsurf = average of clear pixels C 2 (short-term) Tmax - DEL3 (Tsurf too cold) C 3 (short-term) Tsurf (TMAX determined to be too hot) C 4 (short-term) Tsurf (hot TMAX result ignored) C 5 (short-term) Tmax - DEL3 (hot TMAX result ignored) C 6 ----- Value does not exist ----- C 7 (short-term) Tsurf (short-term TMAX passes test) C 8 (short-term) Tmax - DEL3 (short-term TMAX passes test) C 9 (long-term) Tsurf (short-term cloud contaminated) C 10 (long-term) Tmax - DEL4 C 11 (long-term) Tmax - DEL4 C 12 (long-term) Tsurf (hot TMAX result ignored) C 13 (long-term) Tmax - DEL4 (hot TMAX result ignored) C 14 (long-term) Tmax - DEL4 (hot TMAX result ignored) C 15 (long-term) Tsurf (TMAX determined to be too hot) C 16 (long-term) Twarm percent - DEL2 (TMAX too hot) C 17 ----- Value does not exist ----- C 18 ----- Value does not exist ----- C 19 ----- Value does not exist ----- C 20 ----- Value does not exist ----- C 21 (long-term) Tsurf (short-term TMAX passes test) C 22 (long-term) Twarm percent - DEL2 (short-term TMAX passes) C 23 ----- Value does not exist ----- C 24 ----- Value does not exist ----- C 25 ----- Value does not exist ----- C 26 ----- Value does not exist ----- C 27 ----- Value does not exist ----- C 28 ----- Value does not exist ----- C 29 ----- Value does not exist ----- C 30 ----- Value does not exist ----- C 31 ----- Value does not exist ----- C C T1 through T3 - Coded representation of the result of IR C thresholding, with values in the range, C 1 through 5 (001..101), representing: C C 0 ----- Value does not exist ----- C 1 Values more than one threshold above the clear radiance C 2 Values less than one threshold above .. C 3 Values less than one threshold below .. C 4 Values more than one but less than two thresholds below .. C 5 Values more than two thresholds below .. C 6 ----- Value does not exist ----- C 7 ----- Value does not exist ----- C C Code values greater than 3 indicate cloudy pixels. C C Byte 3: F M1 M2 M3 M4 M5 M6 M7 C ----------------------------------------- C C F - 1 if the clear-sky spatial filter was used, C 0 otherwise. C C M1 through M7 - Coded representation of the satellite zenith C angle (actually, cosine(MUE)), having values in C the range, 0 through 100 decimal (corresponding C to cos(MUE) 0 through 1.00) C C C Byte 4: I1 I2 I3 I4 I5 I6 I7 I8 C ----------------------------------------- C C I1 through I8 - Coded representation of the IR radiance, having C values in the range, 0 through 255. C Use lookup table TMPTAB to convert to physical C units. C C C Byte 5: I1 I2 I3 I4 I5 I6 I7 I8 C ----------------------------------------- C C I1 through I8 - Coded representation of the inferred IR clear-sky C radiance, having values in the range, 0 through C 255. C Use lookup table TMPTAB to convert to physical C units. C C C Byte 6: I1 I2 I3 I4 I5 I6 I7 I8 C ----------------------------------------- C C I1 through I8 - Coded representation of "Additional Channel 1" C radiance, having values in the range, 0 through C 255 (for AVHRR this is near-IR channel). C C C Byte 7: I1 I2 I3 I4 I5 I6 I7 I8 C ----------------------------------------- C C I1 through I8 - Coded representation of "Additional Channel 2" C radiance, having values in the range, 0 through C 255 (for AVHRR this is the 3.7 micron channel). C C C Byte 8: I1 I2 I3 I4 I5 I6 I7 I8 C ----------------------------------------- C C I1 through I8 - Coded representation of "Additional Channel 3" C radiance, having values in the range, 0 through C 255 (for AVHRR this is 11.5 micron channel). C C C Byte 9: G F1 F2 F3 F4 T1 T2 T3 C ----------------------------------------- C C G - 1 for ocean pixels with viewing geometries near C solar glint conditions. C C F1 through F4 are Vis clear-sky bit flags: C C F1 - 1 indicates that long-term (30 day) statistics C were used to infer the Vis clear-sky radiance. C C F2 - 1 indicates that region statistics were used C to test the inferred Vis clear-sky. C C F3 - 1 indicates that the Vis clear-sky was judged to C be "too dark" by comparison to a model. C C F4 - 1 indicates that the Vis clear-sky was judged to C be "too bright" by comparison to a model. C C T1 through T3 - Coded representation of the Vis channel threshold C result, having values in the range, 1 through 5 C (001 through 101), representing the same ranges C as for the IR threshold. C C 0 ----- Value does not exist ----- C 1 Values more than one threshold below the clear radiance C 2 Values less than one threshold below .. C 3 Values less than one threshold above .. C 4 Values more than one but less than two thresholds above .. C 5 Values more than two thresholds above .. C 6 ----- Value does not exist ----- C 7 ----- Value does not exist ----- C C Code values greater than 3 indicate cloudy pixels. C C Byte 10: M1 M2 M3 M4 M5 M6 M7 M8 C ----------------------------------------- C C M1 through M8 - Coded representation of the solar zenith angle C (cosine(MU0)), having values in the range, 0 C through 100 decimal, corresponding to cos(MU0) C values 0 through 1.00. C C C Byte 11: P1 P2 P3 P4 P5 P6 P7 P8 C ----------------------------------------- C C P1 through P8 - Coded representation of the satellite-solar C azimuth, in degrees, having values in the range, C 0 through 180. C C C Byte 12: V1 V2 V3 V4 V5 V6 V7 V8 C ----------------------------------------- C C V1 through V8 - Coded representation of the Vis radiance, having C values in the range, 0 through 255. C Use lookup table RFLTAB to convert to physical C units. C C C Byte 13: V1 V2 V3 V4 V5 V6 V7 V8 C ----------------------------------------- C C V1 through V8 - Coded representation of the inferred Vis clear-sky C radiance, having values in the range, 0 through C 255. C Use lookup table RFLTAB to convert to physical C units. C C The CX data packet C ================== C C The next 11 bytes of each logical record (pixel) constitute the C "CX data packet". C C Byte 14: N I1 I2 I3 V1 V2 V3 0 C ----------------------------------------- C C N - 1 = Night, 0 = Day. This value is the final C decision and can differ from that in Byte 1, C depending on illumination geometry. C C I1 through I3 - Coded representation of the IR channel threshold C result, having values in the range, 1 through 5. C This value is the final decision and can differ C from that in Byte 2, depending on surface C conditions. C C V1 through V3 - Coded representation of the Vis channel threshold C result, having values in the range, 1 through 5. C This value is the final decision and can differ C from that in Byte 9, depending on surface C conditions. C C ******************************************************************** C This byte contains the final cloud/no cloud decision that determines C the meaning of some subsequent bytes. If either I1-I3 or V1-V3 gives C a value greater than 3, then the pixel is cloudy. If the pixel is C cloudy, Bytes 16/17 represent cloud top temperature/pressure and Byte C 21 is cloud optical thickness. If the pixel is clear, Bytes 16/17 C represent surface temperature/pressure and Byte 21 is surface C reflectance. C ******************************************************************** C C Byte 15: I1 I2 I3 I4 J1 J2 J3 J4 C ----------------------------------------- C C I1 through I4 - IR data radiative retrieval return code C C J1 through J4 - IR clear-sky radiative retrieval return code C C These codes have the following meanings: C C 0 OK (good retrieval) C 1 (SRF) Tobserved > Tretrieved C => alternate retrieval formula applied C 2 (SRF) EXTMU < 0.25 (opacity too large) C => alternate retrieval formula applied C 3 (SRF) TOVS brightness temp > image brightness temp by > 20 K C 4 (SRF) Image brightness temp > TOVS brightness temp by > 20 K C 5 (CLD) Isothermal cloud layers C 6 (CLD) Brightness temp < Tmin of profile C 7 (CLD) As for 0, above (see note below) C 8 (SRF) As for 1, above (see note below) C 9 (SRF) As for 2, above (see note below) C 10 (SRF) As for 3, above (see note below) C 11 (SRF) As for 4, above (see note below) C 12 Value not in radiation tables C 13 ----- Value does not exist ----- C 14 ----- Value does not exist ----- C 15 ----- Value does not exist ----- C C Notes: C C 1. (SRF) means that the value pertains to the result of the C surface properties retrieval routine, (CLD) refers to the C cloud retrieval. C C 2. Codes 7 through 11 have the same meanings as corresponding C codes 0 through 4, but are maintained seperately to warn C the user that in these cases the brightness temperature C was found to be greater than or equal to the clear sky C value, thus the surface retrieval routine was used. C C Byte 16: T1 T2 T3 T4 T5 T6 T7 T8 C ----------------------------------------- C C T1 through T8 - Coded representation of the retrieved temperature, C in Kelvins, for observed data, having values in C the range, 0 through 255. If the pixel is cloudy, C then this is the cloud top temperature, assuming C an opaque cloud; if the pixel is clear, then this C is the surface temperature. C Use lookup table TMPTAB to convert to physical C units. C C C Byte 17: P1 P2 P3 P4 P5 P6 P7 P8 C ----------------------------------------- C C P1 through P8 - Coded representation of the pressure (mBAR) for C observed data, corresponding to the retrieved C temperature, and having values in the range, 0 C through 255. C Use lookup table PRETAB to convert to physical C units. C C C Byte 18: T1 T2 T3 T4 T5 T6 T7 T8 C ----------------------------------------- C C T1 through T8 - Coded representation of the retrieved temperature C (K) for clear-sky, having values in the range, 0 C through 255. C Use lookup table TMPTAB to convert to physical C units. C C C Byte 19: P1 P2 P3 P4 P5 P6 P7 P8 C ----------------------------------------- C C P1 through P8 - Coded representation of the retrieved pressure C (mBAR) for clear-sky, (surface pressure C determined from topography and surface C temperature), having values in the range, C 0 through 255. C Use lookup table PRETAB to convert to physical C units. C C C Byte 20: I1 I2 I3 I4 J1 J2 J3 J4 C ----------------------------------------- C C I1 through I4 - Vis data radiative retrieval return code C C J1 through J4 - Vis clear-sky radiative retrieval return code C C These codes have the following meanings: C C 0 OK (good retrieval) C 1 (TAUCOR) OK (in TC adjustment loop for thin cloud) C 2 (TAUCOR) Adjustment of cloud top leads to TAUMUE > 4.5 C 3 (TAUCOR) TAU out of range (TAU > 125) C 4 (TAUCOR) Unable to calculate TAUMIN (not enough precision) C 5 (TAUCOR) Observed temperature > clear sky temperature C 6 (TAUCOR) Bad values in TAURAY array, radiance out of range C 7 (SRF) Value below low end of the surface intensity array C 8 (SRF) Value above high end of the surface intensity array C 9 ----- Value does not exist ----- C 10 ----- Value does not exist ----- C 11 ----- Value does not exist ----- C 12 (TAUCOR) Value below low end of radiation table (RADDIF < 0) C 13 (TAUCOR) Adjustment loop iterated more than 10 times C 14 (CLD) TAURET set to 0.0 (observed radiance too dark) C 15 ----- Value does not exist ----- C C Note: (SRF) means that the value pertains to the result of the C surface properties retrieval routine, (CLD) refers to the C cloud retrieval, and (TAUCOR) refers to the iteration loop C that adjusts the values of cloud top temperature and TAU C in cases of low TAU. C C C Byte 21: V1 V2 V3 V4 V5 V6 V7 V8 C ----------------------------------------- C C V1 through V8 - Coded representation of either the albedo (if the C pixel is "clear") or the optical thickness, Tau, C (if the pixel is cloudy). The range of permitted C values is 0 through 255. C Use lookup table RFLTAB if albedo, or TAUTAB if C optical thickness, to convert to physical units. C C C Byte 22: V1 V2 V3 V4 V5 V6 V7 V8 C ----------------------------------------- C C V1 through V8 - Coded representation of the surface albedo from C the clear-sky radiance, having values in the C range, 0 through 255. C Use lookup table RFLTAB to convert to physical C units. C C C Byte 23: V1 V2 V3 V4 V5 V6 V7 V8 C ----------------------------------------- C C V1 through V8 - Coded representation of the retrieved cloud-top C temperature, after correction for partial C transmission of surface radiation. The range of C permitted values is 0 through 255. C Use lookup table TMPTAB to convert to physical C units. C C C Byte 24: V1 V2 V3 V4 V5 V6 V7 V8 C ----------------------------------------- C C V1 through V8 - Coded representation of the retrieved cloud-top C pressure, after correction for partial C transmission of surface radiation. The range of C permitted values is 0 through 255 (255 reported if C pixel is clear). C Use lookup table PRETAB to convert to physical C units. C C--- END OF NOTES C ************************************** **** Firelook Fortran *** 12/30/88 *** ************************************** C--- Following are lookup tables for byte values representing C--- temperature (TMPTAB), pressure (PRETAB), C--- reflectivity (RFLTAB), and optical thickness (TAUTAB). C--- C--- The DATA statements have been commented out as a warning C--- that the number of continuation statements is greater than C--- many (most?) FORTRAN compilers will allow. It is recommended C--- that the quantities be used to generate tables in a format C--- that is suitable for your environment. C C C--- BEGIN LOOKUP TABLES C C REAL TMPTAB(0:255), C & PRETAB(0:255), C & RFLTAB(0:255), C & TAUTAB(0:255) C C C DATA TMPTAB C & / -100.0, 165.0, 169.0, 172.0, C & 175.0, 177.8, 180.5, 183.0, C & 185.5, 187.8, 190.0, 192.0, C & 194.0, 195.7, 197.5, 199.2, C & 201.0, 202.7, 204.5, 206.2, C & 208.0, 209.7, 211.5, 212.8, C & 214.1, 215.4, 216.7, 217.9, C & 219.2, 220.5, 221.8, 223.1, C & 224.4, 225.4, 226.5, 227.5, C & 228.6, 229.6, 230.6, 231.7, C & 232.7, 233.8, 234.8, 235.7, C & 236.6, 237.5, 238.4, 239.2, C & 240.1, 241.0, 241.9, 242.8, C & 243.7, 244.5, 245.3, 246.1, C & 246.9, 247.7, 248.5, 249.3, C & 250.1, 250.9, 251.7, 252.4, C & 253.1, 253.9, 254.6, 255.3, C & 256.0, 256.7, 257.5, 258.2, C & 258.9, 259.5, 260.2, 260.8, C & 261.5, 262.1, 262.8, 263.4, C & 264.1, 264.7, 265.4, 266.0, C & 266.6, 267.2, 267.8, 268.4, C & 269.1, 269.7, 270.3, 270.9, C & 271.5, 272.1, 272.7, 273.2, C & 273.8, 274.4, 275.0, 275.6, C & 276.1, 276.7, 277.3, 277.8, C & 278.4, 278.9, 279.5, 280.0, C & 280.5, 281.1, 281.6, 282.2, C & 282.7, 283.2, 283.7, 284.2, C & 284.7, 285.2, 285.8, 286.3, C & 286.8, 287.3, 287.8, 288.3, C & 288.8, 289.3, 289.8, 290.2, C & 290.7, 291.2, 291.7, 292.2, C & 292.7, 293.2, 293.6, 294.1, C & 294.6, 295.0, 295.5, 296.0, C & 296.5, 296.9, 297.4, 297.8, C & 298.3, 298.7, 299.2, 299.6, C & 300.1, 300.5, 301.0, 301.4, C & 301.9, 302.3, 302.8, 303.2, C & 303.6, 304.0, 304.5, 304.9, C & 305.3, 305.8, 306.2, 306.6, C & 307.0, 307.5, 307.9, 308.3, C & 308.7, 309.1, 309.6, 310.0, C & 310.4, 310.8, 311.2, 311.6, C & 312.0, 312.4, 312.9, 313.3, C & 313.7, 314.1, 314.5, 314.9, C & 315.3, 315.7, 316.1, 316.4, C & 316.8, 317.2, 317.6, 318.0, C & 318.4, 318.8, 319.2, 319.5, C & 319.9, 320.3, 320.7, 321.1, C & 321.4, 321.8, 322.2, 322.6, C & 323.0, 323.3, 323.7, 324.1, C & 324.5, 324.9, 325.2, 325.6, C & 326.0, 326.4, 326.7, 327.1, C & 327.4, 327.8, 328.2, 328.5, C & 328.9, 329.2, 329.6, 329.9, C & 330.3, 330.6, 331.0, 331.3, C & 331.7, 332.0, 332.4, 332.7, C & 333.1, 333.4, 333.8, 334.1, C & 334.5, 334.8, 335.2, 335.5, C & 335.9, 336.2, 336.6, 336.9, C & 337.3, 337.6, 338.0, 338.3, C & 338.6, 339.0, 339.3, 339.7, C & 340.0, 345.0, -200.0, -1000.0 / C C DATA PRETAB C & / -100.0, 1.0, 5.0, 10.0, C & 15.0, 20.0, 25.0, 30.0, C & 35.0, 40.0, 45.0, 50.0, C & 55.0, 60.0, 65.0, 70.0, C & 75.0, 80.0, 85.0, 90.0, C & 95.0, 100.0, 105.0, 110.0, C & 115.0, 120.0, 125.0, 130.0, C & 135.0, 140.0, 145.0, 150.0, C & 155.0, 160.0, 165.0, 170.0, C & 175.0, 180.0, 185.0, 190.0, C & 195.0, 200.0, 205.0, 210.0, C & 215.0, 220.0, 225.0, 230.0, C & 235.0, 240.0, 245.0, 250.0, C & 255.0, 260.0, 265.0, 270.0, C & 275.0, 280.0, 285.0, 290.0, C & 295.0, 300.0, 305.0, 310.0, C & 315.0, 320.0, 325.0, 330.0, C & 335.0, 340.0, 345.0, 350.0, C & 355.0, 360.0, 365.0, 370.0, C & 375.0, 380.0, 385.0, 390.0, C & 395.0, 400.0, 405.0, 410.0, C & 415.0, 420.0, 425.0, 430.0, C & 435.0, 440.0, 445.0, 450.0, C & 455.0, 460.0, 465.0, 470.0, C & 475.0, 480.0, 485.0, 490.0, C & 495.0, 500.0, 505.0, 510.0, C & 515.0, 520.0, 525.0, 530.0, C & 535.0, 540.0, 545.0, 550.0, C & 555.0, 560.0, 565.0, 570.0, C & 575.0, 580.0, 585.0, 590.0, C & 595.0, 600.0, 605.0, 610.0, C & 615.0, 620.0, 625.0, 630.0, C & 635.0, 640.0, 645.0, 650.0, C & 655.0, 660.0, 665.0, 670.0, C & 675.0, 680.0, 685.0, 690.0, C & 695.0, 700.0, 705.0, 710.0, C & 715.0, 720.0, 725.0, 730.0, C & 735.0, 740.0, 745.0, 750.0, C & 755.0, 760.0, 765.0, 770.0, C & 775.0, 780.0, 785.0, 790.0, C & 795.0, 800.0, 805.0, 810.0, C & 815.0, 820.0, 825.0, 830.0, C & 835.0, 840.0, 845.0, 850.0, C & 855.0, 860.0, 865.0, 870.0, C & 875.0, 880.0, 885.0, 890.0, C & 895.0, 900.0, 905.0, 910.0, C & 915.0, 920.0, 925.0, 930.0, C & 935.0, 940.0, 945.0, 950.0, C & 955.0, 960.0, 965.0, 970.0, C & 975.0, 980.0, 985.0, 990.0, C & 995.0, 1000.0, 1005.0, 1010.0, C & 1015.0, 1020.0, 1025.0, 1030.0, C & 1035.0, 1040.0, 1045.0, 1050.0, C & 1055.0, 1060.0, 1065.0, 1070.0, C & 1075.0, 1080.0, 1085.0, 1090.0, C & 1095.0, 1100.0, 1105.0, 1110.0, C & 1115.0, 1120.0, 1125.0, 1130.0, C & 1135.0, 1140.0, 1145.0, 1150.0, C & 1155.0, 1160.0, 1165.0, 1170.0, C & 1175.0, 1180.0, 1185.0, 1190.0, C & 1195.0, 1200.0, -200.0, -200.0, C & -200.0, -200.0, -200.0, -200.0, C & -200.0, -200.0, -200.0, -200.0, C & -200.0, -200.0, -200.0, -1000.0 / C C DATA RFLTAB C & / -100.000, 0.000, 0.008, 0.012, C & 0.016, 0.020, 0.024, 0.028, C & 0.032, 0.036, 0.040, 0.044, C & 0.048, 0.052, 0.056, 0.060, C & 0.064, 0.068, 0.072, 0.076, C & 0.080, 0.084, 0.088, 0.092, C & 0.096, 0.100, 0.104, 0.108, C & 0.112, 0.116, 0.120, 0.124, C & 0.128, 0.132, 0.136, 0.140, C & 0.144, 0.148, 0.152, 0.156, C & 0.160, 0.164, 0.168, 0.172, C & 0.176, 0.180, 0.184, 0.188, C & 0.192, 0.196, 0.200, 0.204, C & 0.208, 0.212, 0.216, 0.220, C & 0.224, 0.228, 0.232, 0.236, C & 0.240, 0.244, 0.248, 0.252, C & 0.256, 0.260, 0.264, 0.268, C & 0.272, 0.276, 0.280, 0.284, C & 0.288, 0.292, 0.296, 0.300, C & 0.304, 0.308, 0.312, 0.316, C & 0.320, 0.324, 0.328, 0.332, C & 0.336, 0.340, 0.344, 0.348, C & 0.352, 0.356, 0.360, 0.364, C & 0.368, 0.372, 0.376, 0.380, C & 0.384, 0.388, 0.392, 0.396, C & 0.400, 0.404, 0.408, 0.412, C & 0.416, 0.420, 0.424, 0.428, C & 0.432, 0.436, 0.440, 0.444, C & 0.448, 0.452, 0.456, 0.460, C & 0.464, 0.468, 0.472, 0.476, C & 0.480, 0.484, 0.488, 0.492, C & 0.496, 0.500, 0.504, 0.508, C & 0.512, 0.516, 0.520, 0.524, C & 0.528, 0.532, 0.536, 0.540, C & 0.544, 0.548, 0.552, 0.556, C & 0.560, 0.564, 0.568, 0.572, C & 0.576, 0.580, 0.584, 0.588, C & 0.592, 0.596, 0.600, 0.604, C & 0.608, 0.612, 0.616, 0.620, C & 0.624, 0.628, 0.632, 0.636, C & 0.640, 0.644, 0.648, 0.652, C & 0.656, 0.660, 0.664, 0.668, C & 0.672, 0.676, 0.680, 0.684, C & 0.688, 0.692, 0.696, 0.700, C & 0.704, 0.708, 0.712, 0.716, C & 0.720, 0.724, 0.728, 0.732, C & 0.736, 0.740, 0.744, 0.748, C & 0.752, 0.756, 0.760, 0.764, C & 0.768, 0.772, 0.776, 0.780, C & 0.784, 0.788, 0.792, 0.796, C & 0.800, 0.804, 0.808, 0.812, C & 0.816, 0.820, 0.824, 0.828, C & 0.832, 0.836, 0.840, 0.844, C & 0.848, 0.852, 0.856, 0.860, C & 0.864, 0.868, 0.872, 0.876, C & 0.880, 0.884, 0.888, 0.892, C & 0.896, 0.900, 0.904, 0.908, C & 0.912, 0.916, 0.920, 0.924, C & 0.928, 0.932, 0.936, 0.940, C & 0.944, 0.948, 0.952, 0.956, C & 0.960, 0.964, 0.968, 0.972, C & 0.976, 0.980, 0.984, 0.988, C & 0.992, 1.000, 1.016, 1.040, C & 1.072, 1.108, -200.000, -1000.000 / C C DATA TAUTAB C & / -100.00, 0.02, 0.04, 0.06, C & 0.09, 0.11, 0.14, 0.16, C & 0.19, 0.22, 0.24, 0.27, C & 0.30, 0.33, 0.37, 0.40, C & 0.43, 0.46, 0.50, 0.53, C & 0.57, 0.60, 0.64, 0.68, C & 0.72, 0.75, 0.79, 0.83, C & 0.87, 0.92, 0.96, 1.00, C & 1.04, 1.09, 1.13, 1.18, C & 1.22, 1.27, 1.32, 1.37, C & 1.42, 1.47, 1.52, 1.57, C & 1.62, 1.67, 1.73, 1.78, C & 1.83, 1.89, 1.95, 2.00, C & 2.06, 2.12, 2.18, 2.24, C & 2.30, 2.36, 2.43, 2.49, C & 2.55, 2.62, 2.69, 2.75, C & 2.82, 2.89, 2.96, 3.03, C & 3.10, 3.18, 3.25, 3.32, C & 3.40, 3.48, 3.55, 3.63, C & 3.71, 3.79, 3.88, 3.96, C & 4.04, 4.13, 4.22, 4.30, C & 4.39, 4.48, 4.57, 4.67, C & 4.76, 4.85, 4.95, 5.05, C & 5.15, 5.25, 5.35, 5.45, C & 5.56, 5.66, 5.77, 5.88, C & 5.99, 6.11, 6.22, 6.34, C & 6.45, 6.57, 6.69, 6.82, C & 6.94, 7.07, 7.19, 7.33, C & 7.46, 7.59, 7.73, 7.87, C & 8.01, 8.15, 8.30, 8.44, C & 8.59, 8.74, 8.90, 9.06, C & 9.22, 9.38, 9.54, 9.71, C & 9.88, 10.05, 10.23, 10.41, C & 10.59, 10.78, 10.97, 11.16, C & 11.35, 11.55, 11.76, 11.96, C & 12.17, 12.39, 12.60, 12.83, C & 13.05, 13.28, 13.52, 13.76, C & 14.00, 14.25, 14.51, 14.77, C & 15.03, 15.30, 15.58, 15.86, C & 16.15, 16.44, 16.74, 17.05, C & 17.36, 17.69, 18.02, 18.35, C & 18.70, 19.05, 19.41, 19.78, C & 20.16, 20.54, 20.94, 21.35, C & 21.77, 22.20, 22.63, 23.08, C & 23.55, 24.03, 24.52, 25.02, C & 25.54, 26.07, 26.62, 27.19, C & 27.77, 28.37, 28.99, 29.63, C & 30.29, 30.97, 31.67, 32.40, C & 33.16, 33.94, 34.74, 35.58, C & 36.45, 37.35, 38.29, 39.26, C & 40.26, 41.32, 42.42, 43.57, C & 44.76, 46.00, 47.31, 48.68, C & 50.11, 51.60, 53.17, 54.84, C & 56.59, 58.43, 60.36, 62.40, C & 64.59, 66.90, 69.36, 71.96, C & 74.72, 77.73, 80.94, 84.38, C & 88.06, 92.02, 96.40, 101.01, C & 105.51, 109.87, 114.33, 119.59, C & -200.00, -200.00, -200.00, -200.00, C & -200.00, -200.00, -200.00, -200.00, C & -200.00, -200.00, -200.00, -200.00, C & -200.00, -200.00, -200.00, -200.00, C & -200.00, -200.00, -200.00, -200.00, C & -200.00, -200.00, -200.00, -1000.00 / C C--- END OF LOOKUP TABLES C ************************************** **** Fireread Fortran *** 12/30/88 *** ************************************** * C*** 2/24/89 (KLB): Minor mods to comments * C*** 4/27/89 (KLB): (Maximum) values for RPFX, FSIZ, and NREC are C*** now defined in the AUX/DATA file's DDRs; these C*** values yield the minimum acceptable array bounds. C*** C*** Beware of hard-coded constants, e.g., "24" for RPFX and RSIZ, C*** and "12000" for the physical record size (maximum). Also, note C*** that there are compound constants constructed from these values, C*** e.g., "12000/24" for MAXPXS. The use of hard-coded values has C*** been kept to a minimum, to facilitate program maintenance, C*** however, note that we had to use declarations of the form, e.g., C*** "CHARACTER*12000 FIRE$$", since our compiler will not accept C*** forms like "CHARACTER*PRECMX FIRE$$". * C*** 5/13/89 (KLB): AUXNAM of ancillary file to be used is now defined C*** in the header record, VTOC section, via the key- C*** word " AUXFIL=" followed immediately by the 8-byte C*** RECTYP of the appropriate ancillary file. All C*** ancillary files have the AUXNAM "((NONE))" in this C*** position, since they do not themselves require C*** other ancillary data files. * C*** 9/12/89 (KLB): Finally broke down and changed the map display to C*** Lat/Lon scale instead of scanline/pixel. Much C*** easier to interpret now. * *** PROGRAM FIREREAD C C--- Purpose: Sample program to read and unpack the data from C--- one of the FIRE observation datasets. C C--- Written by: Ken Bell (CLKLB@NASAGISS.BITNET) C C======================================================================= C--- Program Description: C======================================================================= C--- C--- FIREREAD is a demo of how to read one of the observation C--- "DATA" files on the FIRE tape. C--- C--- The "logical" functions performed by FIREREAD are: C--- C--- 1. Test whether the technique of EQUIVALENCing CHARACTER and C--- INTEGER data, which is used here in place of function calls C--- to the intrinsic functions CHAR and ICHAR, will work on your C--- system (it may not, even if your compiler doesn't complain). C--- C--- 2. The "DATA" file is READ and the contents "unpacked" one C--- physical record (NREC pixels) at a time. The "ANCILLIARY", C--- or LATLON dataset is read in parallel with the "DATA", to C--- provide a mapping of "pixel and scanline" coordinates onto C--- "latitude and longitude". C--- C--- 3. The contents of each logical record are written into a file C--- using the format specified in the corresponding DDR. Note C--- that this file will occupy approximately 10 MB disk space. C--- C--- 4. A printer plot of the "LNDWTR" information is made. This C--- is a "reduced resolution" picture of the geography of the C--- region covered by the dataset, where the resolution is such C--- as to produce a readable map on a 132 column lineprinter. C--- C--- 5. Lineprinter histograms are generated to show distributions C--- of "active" (i.e., not missing) pixels, IR and VIS data, C--- and IR and VIS clearsky values. C--- C--- C--- There are 7 subroutines called from within FIREREAD: C--- C--- 1. CHCONV - Tests CHAR/INTEGER EQUIVALENCE vs. CHAR()/ICHAR() C--- C--- 2. ATOE - ASCII-to-EBCDIC conversion C--- C--- 3. MKTBLS - Makes lookup tables for bit-flag extraction C--- C--- 4. GETREC - READs and checks next DATA and ANCILLARY record C--- C--- 5. PUNPAK - Unpacks some of the quantities in one "pixel", C--- or logical record. C--- C--- 6. HSTPRN - Lineprinter histogram plotter C--- C--- 7. CHKSUM - Calculates the byte-checksum of the DATA area of C--- a physical record (or "scanline") to compare to the C--- value found in the "record prefix area". (FUNCTION) C C======================================================================= C--- Cautions: (System-dependent features) C======================================================================= C--- C--- * Please note that this program contains certain machine- and C--- operating system-dependent features. In particular, C--- attention is drawn to the use of EQUIVALENCing of CHARACTER C--- and INTEGER data, to declarations that are used to C--- initialize storage in place of using DATA statements, C--- and to the use of the "Z2" format descriptor for displaying C--- certain data values in hexadecimal (base 16). C--- C--- * Also note that the variables, CHAR and ICHAR, were C--- declared, and are used in place of the intrinsic C--- functions by the same names. This code executes much C--- faster on our machine. If your compiler doesn't permit C--- this, make the following substitutions to the code: C--- C--- In place of the pair of statements, C--- CHAR = x C--- ... use ICHAR ... C--- substitute the single statement, C--- ... use ICHAR(x) ... C--- and in place of the pair of statements, C--- ICHAR = x C--- ... use CHAR ... C--- substitute the single statement, C--- ... use CHAR(x) ... C--- Of course, remove all declarations of CHAR C--- and ICHAR, to permit the intrinsics to be used. C--- C--- The subroutine (and CALL to) CHCONV has been C--- included in this program to test this feature C--- on your system. C--- C--- * Note that the logical units used for I/O must be C--- connected before running this program; these are C C--- logical unit 10 (LUNCX / LUNIN - input), C--- logical unit 11 (LUNAUX - input), C--- logical unit 30 (LUNOUT - output). C--- logical unit 40 (LUNMAP - output). C C--- Simply for purposes of example, on our system we use C--- the following FILEDEFs (IBMese): C--- C--- FILEDEF lunin device fname ftype ( RECFM F C--- FILEDEF lunaux device fname ftype ( RECFM F C--- FILEDEF lunout device fname ftype ( RECFM F LRECL 80 C--- FILEDEF lunmap device fname ftype ( RECFM FA LRECL 133 C--- C--- * This program is provided as a guide to writing your C--- own software, rather than as "ready-to-use" software. C--- Please refer to the accompanying documentation on the C--- "internals" of this dataset, for more detail. C--- C--- * Finally, certain hardware environments will require C--- that INTEGER data be manipulated before use to change C--- the byte order (e.g., DEC VAX users). This code runs C--- "as is" on an IBM 4381 under VM/SP Release 5. C--- C======================================================================= C C--- The constant, IS$IBM, controls whether ASCII character data C--- is to be translated to EBCDIC before it is displayed. Set C--- it to .TRUE. if you're running on IBM hardware, to .FALSE. C--- otherwise. C COMMON /MACHIN/ IS$IBM LOGICAL IS$IBM C C======================================================================= C----------------------------------------------------------------------- C BXCX COMMON BLOCK - ONE PIXEL C----------------------------------------------------------------------- COMMON /BXCX/ YEAR,DAY,MONTH,DAYNIT, 2 NITEBX,LNDWTR,SHORE,VEGTYP,HITOPO,CLASSF,SNOICE, 3 IRFLTR,ITHRFL,ITHR,MUEBF,IRDAT,IRCLR,LNGTRI,SUSPVS, 4 GLINT,VTHRFL,VTHR,MU0BF,PHI0BF,ADDCHN(3),VISDAT,VISCLR, 5 NITECX,ITHRCX,VTHRCX,IIRFL,IIRCL,TMPRET,PRSRET,TMPCSR, 6 PRSCSR,IVSFL,IVSCL,ALBTAU,ALBCSR,TMPCOR,PRSCOR INTEGER YEAR,MONTH,DAY,DAYNIT, 1 NITEBX,LNDWTR,SHORE,VEGTYP,HITOPO,CLASSF,SNOICE, 2 IRFLTR,ITHRFL,ITHR,MUEBF,IRDAT,IRCLR,LNGTRI,SUSPVS,GLINT, 3 VTHRFL,VTHR,MU0BF,PHI0BF,ADDCHN,VISDAT,VISCLR INTEGER NITECX,ITHRCX,VTHRCX,IIRFL,IIRCL,TMPRET,PRSRET,TMPCSR, 1 PRSCSR,IVSFL,IVSCL,ALBTAU,ALBCSR,TMPCOR,PRSCOR C INTEGER NOMTIM, PRJDAT C C----------------------------------------------------------------------- C C--- One FIRE Pixel is a packet of RSIZ bytes. C--- One FIRE Line is an array of FIRE Pixels C--- LRECSZ and PRECMX are the size of the logical record and the max. C--- size of a physical record. MAXPXS is calculated from these values. C C--- MAXPXS is simply an upper bound on the various array sizes; C--- it must be greater than, or equal to, the quantity NREC, as C--- determined from the Data Description Record (DDR). Here we C--- calculate it from the maximum physical record size permitted C--- by the FIRE standard (12000 bytes) and the size of a pixel C--- packet (24 bytes). Note that one or more 24-byte packets is C--- taken up by the record prefix area, as specified in the DDR. C--- The actual physical record of the file is, in general, less than C--- the 12000 byte maximum. C INTEGER LRECSZ, PRECMX PARAMETER (LRECSZ = 24, PRECMX = 12000) INTEGER MAXPXS PARAMETER (MAXPXS = PRECMX / LRECSZ) C C--- Auxilliary data values may be 1, 2, or 4 byte quantities. C INTEGER RSIZ$1, RSIZ$2, RSIZ$4 PARAMETER (RSIZ$1 = LRECSZ) PARAMETER (RSIZ$2 = LRECSZ / 2) PARAMETER (RSIZ$4 = LRECSZ / 4) C COMMON /$FIRE$/ FIRE$$, AUX$$, PREFIX, & LUNIN, LUNAUX, LUNOUT, FILENO, LINE, & TOTPXS, NULPXS, $NITBX, $NITCX, LNDCNT C INTEGER LUNIN, LUNAUX, LUNOUT, FILENO, LINE, TOTPXS, & NULPXS, LNDCNT(2), $NITBX(0:1), $NITCX(0:1) C CHARACTER*12000 FIRE$$ CHARACTER*24 FIRELN(MAXPXS) EQUIVALENCE (FIRELN,FIRE$$) C CHARACTER*12000 AUX$$ CHARACTER*24 AUXLN(MAXPXS) CHARACTER*1 AUX$1(RSIZ$1,MAXPXS) INTEGER*2 AUX$2(RSIZ$2,MAXPXS) INTEGER*4 AUX$4(RSIZ$4,MAXPXS) EQUIVALENCE (AUXLN,AUX$$,AUX$1,AUX$2,AUX$4) C C--- Set up the structure used for filling the very first pixel in C--- each record C INTEGER FNUM, RNUM, CKSM, RSIZ, NREC, RPFX CHARACTER*24 PREFIX EQUIVALENCE (PREFIX( 1: 4), FNUM) EQUIVALENCE (PREFIX( 5: 8), RNUM) EQUIVALENCE (PREFIX( 9:12), CKSM) EQUIVALENCE (PREFIX(13:16), RSIZ) EQUIVALENCE (PREFIX(17:20), NREC) EQUIVALENCE (PREFIX(21:24), RPFX) C C C--- Define the VTOC structure (first 160 bytes of header record) C CHARACTER*64 VEMPTY CHARACTER*14 BEGDAT, ENDDAT CHARACTER*8 RECTYP CHARACTER*8 AUXKEY, AUXNAM CHARACTER*7 WESLON, EASLON CHARACTER*6 NORLAT, SOULAT CHARACTER*6 FILTOT CHARACTER*4 FILNUM C CHARACTER*160 VTOC EQUIVALENCE (VTOC( 1: 4), FILNUM) EQUIVALENCE (VTOC( 6: 11), FILTOT) EQUIVALENCE (VTOC( 13: 20), RECTYP) EQUIVALENCE (VTOC( 22: 35), BEGDAT) EQUIVALENCE (VTOC( 37: 50), ENDDAT) EQUIVALENCE (VTOC( 52: 57), NORLAT) EQUIVALENCE (VTOC( 59: 64), SOULAT) EQUIVALENCE (VTOC( 66: 72), WESLON) EQUIVALENCE (VTOC( 74: 80), EASLON) EQUIVALENCE (VTOC( 81: 88), AUXKEY) EQUIVALENCE (VTOC( 89: 96), AUXNAM) EQUIVALENCE (VTOC( 97:160), VEMPTY) C C--- A place to save the names of the file pointed to by "AUXFIL=" C CHARACTER*8 CX$AUX C C C--- Define a buffer for conversion of the character*1 data (byte C--- values) in FIREPX to integer*4 quantities. Note: if the CHAR- C--- ICHAR equivalencing fails on your system, then this code must also C--- be rewritten to use the CHAR() and ICHAR() intrinsic functions. C C--- Diagram showing which elements of FIREPX, FIRCHR, and FIRINT C--- correspond to one another: C C--- FIREPX: 1 2 3 4 ... 23 24 C--- FIRCHR: 4 8 12 16 ... 92 96 C--- FIRINT: 1 2 3 4 ... 23 24 C CHARACTER*24 FIREPX CHARACTER*1 FIRCHR(4*RSIZ$1) INTEGER FIRINT(RSIZ$1) /RSIZ$1 * 0/ EQUIVALENCE (FIRINT,FIRCHR) C----------------------------------------------------------------------- C COMMON /STATS/ IRDHST, VIDHST, IRCHST, VICHST, PXLHST, & FLGIRD, FLGVID, FLGIRC, FLGVIC, FLGPXL INTEGER IRDHST(0:255), VIDHST(0:255), & IRCHST(0:255), VICHST(0:255), & PXLHST(MAXPXS) LOGICAL FLGIRD, FLGVID, FLGIRC, FLGVIC, FLGPXL C C----------------------------------------------------------------------- INTEGER PXL, PXLOFF INTEGER $NULPX, $TOTPX C----------------------------------------------------------------------- C--- Some constants C----------------------------------------------------------------------- INTEGER LAT /1/, LON /2/ CHARACTER*1 SPACE /' '/ C----------------------------------------------------------------------- C--- NULLPX is used as a convenient way to test for null pixel. C--- PXNULL is used as a convenient way to initialize NULLPX. C CHARACTER*24 NULLPX CHARACTER*1 PXNULL(RSIZ$1) /RSIZ$1 * ZFF/ EQUIVALENCE (NULLPX, PXNULL) C----------------------------------------------------------------------- C C--- I have chosen the FIRE coefficient N to be 9, thus, C--- since we are dealing with I*2 quantities, the parameter b C--- is 15 and the scaling factor is (2 ** (N-b)) or 1/64. C--- The additive constant is -90.0 for LAT and -180.0 for LON. C C--- (Note that the FSCALE defined here is actually the inverse of C--- what is given in the DDR, since it is the scaling factor that C--- was used in GENERATING the data; also, the ADDCON values are C--- the additive inverse of what is given in the DDR for the same C--- reason.) C INTEGER N$FIRE, HI$BIT, FSCALE PARAMETER (N$FIRE = 9) PARAMETER (HI$BIT = 15) PARAMETER (FSCALE = (2 ** (HI$BIT - N$FIRE))) REAL ADDCON(2) /90.0, 180.0/ C C--- Values of 120 for GRKHEI and GRKWID are suitable for lineprinter C--- plots (full width of page for longitude, two pages long for lat.) C INTEGER GRKHEI, GRKWID PARAMETER (GRKHEI = 120, GRKWID = 120) CHARACTER*1 PXLGRK(GRKHEI,GRKWID) CHARACTER*80 FMTGRK INTEGER GRKLAT, GRKLON, GRKBEG, GRKEND REAL EASTLN, WESTLN, NORTLT, SOUTLT C----------------------------------------------------------------------- C--- Lookup tables C REAL TMPTAB(0:255), & PRETAB(0:255), & RFLTAB(0:255), & TAUTAB(0:255) C----------------------------------------------------------------------- C C--- BEGIN FIREREAD C IS$IBM = .TRUE. C PRINT *,'*** FIRE DATA READ PROGRAM (EXAMPLE) ***' PRINT * PRINT *,'*** THE FLAG, "IS$IBM", HAS THE VALUE, ',IS$IBM PRINT *,'*** THIS CONSTANT SHOULD BE SET EQUAL TO .TRUE.' PRINT *,'*** IF YOU ARE RUNNING ON IBM HARDWARE, AND TO' PRINT *,'*** .FALSE. OTHERWISE.' PRINT * C C--- Radians-to-Degrees conversion = 180-deg / Pi-radians C RD2DG = 180.0 / ARCOS( -1.0 ) C C--- Test whether the ICHAR, CHAR equivalencing is OK on your system C CALL CHCONV( IERR ) IF (IERR .NE. 0) STOP 1 C C--- Define the logical I/O units (they must be preattached) C LUNCX = 10 LUNAUX = 11 LUNTBL = 20 LUNOUT = 30 LUNMAP = 40 C C INIT STATS C LINE = 0 $TOTPX = 0 $NULPX = 0 $NITBX(0) = 0 $NITBX(1) = 0 $NITCX(0) = 0 $NITCX(1) = 0 LNDCNT(1) = 0 LNDCNT(2) = 0 C LUNIN = LUNCX C C----------------------------------------------------------------------- C--- Read the FIRE lookup tables (from FIRELOOK FORTRAN) C----------------------------------------------------------------------- C READ(LUNTBL,*,END=1001,ERR=1001) TMPTAB, PRETAB, RFLTAB, TAUTAB C C----------------------------------------------------------------------- C--- Read the FIRE Data File header (VTOC record) C----------------------------------------------------------------------- C FIRE$$ = SPACE READ(LUNIN,NUM=NBYTES,END=1010,ERR=1020) FIRE$$ C IF (IS$IBM) THEN CALL ATOE( FIRE$$, NBYTES, FIRE$$ ) ENDIF PRINT *,'=== FIRE FILE HEADER (FIRST 160 BYTES ONLY) ===' PRINT *,FIRE$$( 1: 80) PRINT *,FIRE$$(81:160) C VTOC = FIRE$$ READ(FILNUM,'(I4)') FILENO IF (AUXKEY .NE. ' AUXFIL=') THEN PRINT *,'+++ "AUXFIL=" KEYWORD NOT FOUND. EITHER THE FILE ' PRINT *,' ++ IS BAD OR YOU ARE USING AN UNSUPPORTED VERSION.' STOP 1 ENDIF CX$AUX = AUXNAM C C--- Write out the header record into the PlainTxt file C IPOS = 1 DO 25 I = 1, (NBYTES / 80) WRITE(LUNOUT,'(A80)',ERR=1030) FIRE$$(IPOS:IPOS+79) IPOS = IPOS + 80 25 CONTINUE IF (IPOS .LE. NBYTES) & WRITE(LUNOUT,'(A)',ERR=1030) FIRE$$(IPOS:NBYTES) C C----------------------------------------------------------------------- C--- Read the Ancillary file's header (VTOC record) C----------------------------------------------------------------------- C AUX$$ = SPACE READ(LUNAUX,NUM=NBYTES,END=1010,ERR=1020) AUX$$ C IF (IS$IBM) THEN CALL ATOE( AUX$$, NBYTES, AUX$$ ) ENDIF C PRINT *,'=== ANCILLARY FILE HEADER (FIRST 160 BYTES ONLY) ===' PRINT *,(AUX$$(I:I), I = 1, 80) PRINT *,(AUX$$(I:I), I = 81, 160) C VTOC = AUX$$ IF (AUXKEY .NE. ' AUXFIL=') THEN PRINT *,'+++ "AUXFIL=" KEYWORD NOT FOUND. EITHER THE FILE ' PRINT *,' ++ IS BAD OR YOU ARE USING AN UNSUPPORTED VERSION.' STOP 1 ENDIF IF (AUXNAM .NE. '((NONE))') THEN PRINT *,'+++ AUXNAM = ',AUXNAM,', SHOULD BE EQUAL TO ((NONE))' PRINT *,' ++ THIS IS NOT AN ANCILLARY FILE.' STOP 1 ENDIF IF (RECTYP .NE. CX$AUX) THEN PRINT *,'+++ RECTYP = ',RECTYP,', SHOULD BE EQUAL TO ',CX$AUX PRINT *,' ++ THIS IS THE WRONG ANCILLARY FILE FOR THIS DATA.' STOP 111 ENDIF C C----------------------------------------------------------------------- C--- Prepare to process the rest of the file C----------------------------------------------------------------------- C XSCALE = FSCALE C CALL MKTBLS C C--- Initialize the geographic pictorial view of the image to EMPTY. C DO 50 GRKLON = 1, GRKWID DO 50 GRKLAT = 1, GRKHEI PXLGRK(GRKLAT,GRKLON) = SPACE 50 CONTINUE GRKBEG = 1 GRKEND = GRKHEI C C--- Determine our Lat/Lon bounds C READ(EASLON,'(F7.2)') EASTLN READ(WESLON,'(F7.2)') WESTLN READ(NORLAT,'(F6.2)') NORTLT READ(SOULAT,'(F6.2)') SOUTLT C C--- Call GetRec() repeatedly until there is no more data C 100 CALL GETREC( IERR ) C C--- End-Of-File encountered? C IF (IERR .EQ. -1) GOTO 500 C C--- Did an error occur? C IF (IERR .NE. 0) GOTO 1000 C C----------------------------------------------------------------------- C--- Write out the "plain ASCII" version of the data file in hex C--- *WARNING* -- this file will occupy c.a. 10 MB ! C----------------------------------------------------------------------- C C--- The first "LRECSZ" bytes of FIRELN will always contain the C--- "constant" part of the record prefix area, namely, FNUM, RNUM, C--- CKSM, RSIZ, NREC, and RPFX, in that order. C PREFIX = FIRELN(1) PXLOFF = RPFX / RSIZ C WRITE(LUNOUT,250,ERR=1030) FNUM,RNUM,CKSM,RSIZ,NREC,RPFX 250 FORMAT(1X,I4,2X,I4,2X,I11,2X,I6,2X,I6,2X,I6) C DO 275 PXL = 1, NREC FIREPX = FIRELN(PXL+PXLOFF) DO 255 IPX = 1, RSIZ IPXOFF = 4 * IPX FIRCHR(IPXOFF) = FIREPX(IPX:IPX) 255 CONTINUE WRITE(LUNOUT,260,ERR=1030) (FIRINT(I), I = 1, RSIZ) 260 FORMAT(24(1X,Z2)) 275 CONTINUE C DO 300 PXL = 1, NREC C $TOTPX = $TOTPX + 1 C C--- If the pixel is null, we needn't bother unpacking it C IF (FIRELN(PXL+PXLOFF) .EQ. NULLPX) THEN $NULPX = $NULPX + 1 GOTO 300 ENDIF C C--- Store the active pixel histogram C PXLHST(PXL) = PXLHST(PXL) + 1 C C--- Unpack each of the NREC bytes of the pixel C CALL PUNPAK( PXL+PXLOFF ) C C ... C--- Process pixels within current scanline here C ... C C--- XSCALE converts back from scaled integer to the real quantity C--- ADDCON(LAT) converts to a LAT from ( -90.0 .. +90.0) C--- ADDCON(LON) converts to a LON from (-180.0 .. +180.0) C RLAT = (AUX$2(LAT,PXL+PXLOFF) / XSCALE) - ADDCON(LAT) RLON = (AUX$2(LON,PXL+PXLOFF) / XSCALE) - ADDCON(LON) C C--- Bin in Lat/Lon space C GRKLON = GRKWID*(RLON - WESTLN + 1.0)/(EASTLN - WESTLN + 1.0) GRKLAT = GRKHEI*(RLAT - SOUTLT + 1.0)/(NORTLT - SOUTLT + 1.0) C IF ((GRKLON .LT. 1) .OR. (GRKLON .GT. GRKWID)) GOTO 285 IF ((GRKLAT .LT. 1) .OR. (GRKLAT .GT. GRKHEI)) GOTO 285 C C--- Determine the bounds for plotting (we don't want to plot C--- large expanses of non-data) - since we're displaying the C--- data with Northernmost latitudes at the top of the page, C--- we'll begin with the largest, and end with the smallest, C--- data-containing latitude, including all latitudes in-between. C IF (GRKLAT .GT. GRKBEG) GRKBEG = GRKLAT IF (GRKLAT .LT. GRKEND) GRKEND = GRKLAT C C--- Store the pixel LndWtr characteristic in the pictorial array C IF (LNDWTR .EQ. 1) THEN C--- This is a WATER pixel PXLGRK(GRKLAT,GRKLON) = '-' ELSEIF (LNDWTR .EQ. 2) THEN C--- This is a LAND pixel PXLGRK(GRKLAT,GRKLON) = '#' ELSE C--- This should never happen (=> bad LNDWTR code) PXLGRK(GRKLAT,GRKLON) = '?' PRINT *,'+++ BAD LNDWTR (',LNDWTR,') AT (',RLAT,',',RLON,')' ENDIF 285 CONTINUE C $NITBX(NITEBX) = $NITBX(NITEBX) + 1 $NITCX(NITECX) = $NITCX(NITECX) + 1 LNDCNT(LNDWTR) = LNDCNT(LNDWTR) + 1 C C 300 CONTINUE KOUNT = 0 C C--- Get next record C GOTO 100 C C----------------------------------------------------------------------- C--- Normal program termination -------------------------------------- C----------------------------------------------------------------------- C 500 PRINT *,'*** ===========================================' PRINT *,'*** N O R M A L T E R M I N A T I O N' PRINT *,'*** ===========================================' PRINT *,'*** FILE NO.:',FILENO PRINT *,'*** LAST RECORD NO.:',LINE PRINT *,'*** TOTAL PIXELS:',$TOTPX PRINT *,'*** NULL PIXELS:',$NULPX PRINT *,'*** DAY BX PIXELS:',$NITBX(0) PRINT *,'*** NIGHT BX PIXELS:',$NITBX(1) PRINT *,'*** DAY CX PIXELS:',$NITCX(0) PRINT *,'*** NIGHT CX PIXELS:',$NITCX(1) PRINT *,'*** WATER PIXELS:',LNDCNT(1) PRINT *,'*** LAND PIXELS:',LNDCNT(2) PRINT *,'***' C C C--- Display an image of the geographic region C--- (The result is written to a separate file to facilitate printing C--- the image using standard, i.e., ASA, printer control codes.) C--- C C--- Set up the FORMAT statements for the image pictorial C C--- First, the longitude ruler C--- C--- It looks like: =========================================== C--- xxxx.xx xxxx.xx xxxx.xx C C--- Dashed line and tic marks C MIDDLE = (GRKWID + 1) / 2 C FMTGRK = '(///,1X,6X,2X,'''',???(''=''),'''',???(''=''),'''')' IFMT = INDEX(FMTGRK,'?') WRITE(FMTGRK(IFMT:IFMT+2),'(I3.3)') MIDDLE - 2 IFMT = INDEX(FMTGRK,'?') WRITE(FMTGRK(IFMT:IFMT+2),'(I3.3)') GRKWID - MIDDLE - 1 WRITE(LUNMAP,FMT=FMTGRK) C C--- Westernmost, Central, and Easternmost longitudes C C--- (Note: the "7", "7/2", "8", and "8/2" in the following statements C--- arise from the choice of F7.2 (i.e., width of 7) for displaying C--- longitude values) C FMTGRK = '(1X,6X,2X,F7.2,???X,F7.2,???X,F7.2)' IFMT = INDEX(FMTGRK,'?') WRITE(FMTGRK(IFMT:IFMT+2),'(I3.3)') (MIDDLE - 7 - 7/2) IFMT = INDEX(FMTGRK,'?') WRITE(FMTGRK(IFMT:IFMT+2),'(I3.3)') (GRKWID - MIDDLE - 8/2 - 7) WRITE(LUNMAP,FMT=FMTGRK) WESTLN, (WESTLN + EASTLN)/2.0, EASTLN C C--- Now set up to display the data C FMTGRK = '(1X,F6.2,2X,???A)' IFMT = INDEX(FMTGRK,'?') WRITE(FMTGRK(IFMT:IFMT+2),'(I3.3)') GRKWID C C--- Print the picture (Lat values displayed on left-hand side) C DO 550 GRKLAT = GRKBEG, GRKEND, -1 RLAT = ((GRKLAT*(NORTLT - SOUTLT + 1.0))/GRKHEI) + SOUTLT - 1.0 WRITE(LUNMAP,FMT=FMTGRK) RLAT, & (PXLGRK(GRKLAT,GRKLON), GRKLON = 1, GRKWID) 550 CONTINUE C C--- Print histograms, if selected C IF (FLGPXL) CALL HSTPRN( 1, NREC, PXLHST, 'ACTIVE PIXELS' ) IF (FLGIRD) CALL HSTPRN( 0, 255, IRDHST, 'IR COUNTS DATA' ) IF (FLGIRC) CALL HSTPRN( 0, 255, IRCHST, 'IR COUNTS CLEARSKY' ) IF (FLGVID) CALL HSTPRN( 0, 255, VIDHST, 'VIS COUNTS DATA' ) IF (FLGVIC) CALL HSTPRN( 0, 255, VICHST, 'VIS COUNTS CLEARSKY' ) C STOP C C----------------------------------------------------------------------- C--- Error state termination ----------------------------------------- C----------------------------------------------------------------------- C 1000 PRINT *,'+++ READ LOOP TERMINATED BEFORE END-OF-DATA' STOP 1 C 1001 PRINT *,'+++ EOF OR ERR READING FIRE LOOKUP TABLES.' STOP 1 C 1010 PRINT *,'+++ UNEXPECTED END OF FILE (ON HEADER): ', & 'FILE',FILENO,', RECORD',LINE STOP 1 C 1020 PRINT *,'+++ ERROR READING DATA FILE: ', & 'FILE',FILENO,', RECORD',LINE STOP 1 C 1030 PRINT *,'+++ ERROR WRITING TO PLAINTXT FILE (DISK FULL?)' STOP 1 END C ************************************************************************ ************************************************************************ **====================================================================** ** ** BLOCK DATA ** ** **====================================================================** ************************************************************************ ************************************************************************ C COMMON /MACHIN/ IS$IBM LOGICAL IS$IBM C C--- LRECSZ and PRECMX are the size of the pixel packet and the maximum C--- size of a physical record. MAXPXS is calculated from these values. C--- MAXPXS is simply an upper bound on the various array sizes; C--- it must be greater than, or equal to, the quantity NREC, as C--- determined from the Data Description Record (DDR). C INTEGER LRECSZ, PRECMX PARAMETER (LRECSZ = 24, PRECMX = 12000) INTEGER MAXPXS PARAMETER (MAXPXS = PRECMX / LRECSZ) C COMMON /STATS/ IRDHST, VIDHST, IRCHST, VICHST, PXLHST, & FLGIRD, FLGVID, FLGIRC, FLGVIC, FLGPXL INTEGER IRDHST(0:255), VIDHST(0:255), & IRCHST(0:255), VICHST(0:255), & PXLHST(MAXPXS) LOGICAL FLGIRD, FLGVID, FLGIRC, FLGVIC, FLGPXL C DATA IS$IBM /.TRUE./ DATA FLGIRD /.FALSE./, FLGVID /.FALSE./, & FLGIRC /.FALSE./, FLGVIC /.FALSE./, & FLGPXL /.FALSE./ C END C ************************************************************************ ************************************************************************ **====================================================================** ** ** SUBROUTINE GETREC( IERR ) INTEGER IERR ** ** **====================================================================** ************************************************************************ ************************************************************************ C COMMON /MACHIN/ IS$IBM LOGICAL IS$IBM C C----------------------------------------------------------------------- C C--- One FIRE Pixel is a packet of RSIZ bytes. C--- One FIRE Line is an array of FIRE Pixels C--- LRECSZ and PRECMX are the size of the logical record and the max. C--- size of a physical record. MAXPXS is calculated from these values. C C--- MAXPXS is simply an upper bound on the various array sizes; C--- it must be greater than, or equal to, the quantity NREC, as C--- determined from the Data Description Record (DDR). Here we C--- calculate it from the maximum physical record size permitted C--- by the FIRE standard (12000 bytes) and the size of a pixel C--- packet (24 bytes). Note that one or more 24-byte packets is C--- taken up by the record prefix area, as specified in the DDR. C--- The actual physical record of the file is, in general, less than C--- the 12000 byte maximum. C INTEGER LRECSZ, PRECMX PARAMETER (LRECSZ = 24, PRECMX = 12000) INTEGER MAXPXS PARAMETER (MAXPXS = PRECMX / LRECSZ) C C--- Auxilliary data values may be 1, 2, or 4 byte quantities. C INTEGER RSIZ$1, RSIZ$2, RSIZ$4 PARAMETER (RSIZ$1 = LRECSZ) PARAMETER (RSIZ$2 = LRECSZ / 2) PARAMETER (RSIZ$4 = LRECSZ / 4) C COMMON /$FIRE$/ FIRE$$, AUX$$, PREFIX, & LUNIN, LUNAUX, LUNOUT, FILENO, LINE, & TOTPXS, NULPXS, $NITBX, $NITCX, LNDCNT C INTEGER LUNIN, LUNAUX, LUNOUT, FILENO, LINE, TOTPXS, & NULPXS, LNDCNT(2), $NITBX(0:1), $NITCX(0:1) C CHARACTER*12000 FIRE$$ CHARACTER*24 FIRELN(MAXPXS) EQUIVALENCE (FIRELN,FIRE$$) C CHARACTER*12000 AUX$$ CHARACTER*24 AUXLN(MAXPXS) CHARACTER*1 AUX$1(RSIZ$1,MAXPXS) INTEGER*2 AUX$2(RSIZ$2,MAXPXS) INTEGER*4 AUX$4(RSIZ$4,MAXPXS) EQUIVALENCE (AUXLN,AUX$$,AUX$1,AUX$2,AUX$4) C C--- Set up the structure used for filling the very first pixel in C--- each record C INTEGER FNUM, RNUM, CKSM, RSIZ, NREC, RPFX CHARACTER*24 PREFIX EQUIVALENCE (PREFIX( 1: 4), FNUM) EQUIVALENCE (PREFIX( 5: 8), RNUM) EQUIVALENCE (PREFIX( 9:12), CKSM) EQUIVALENCE (PREFIX(13:16), RSIZ) EQUIVALENCE (PREFIX(17:20), NREC) EQUIVALENCE (PREFIX(21:24), RPFX) C C----------------------------------------------------------------------- C C--- Use the $xxxx$ quantities to store the xxxx quantities found in C--- the data file, to compare to those found in the ancillary file. C INTEGER $RNUM$, $RSIZ$, $NREC$, $RPFX$ C INTEGER PXLOFF C C----------------------------------------------------------------------- C C--- Function to calculate the data area checksum C INTEGER CHKSUM EXTERNAL CHKSUM C C C--- BEGIN GETREC C IERR = 0 C C----------------------------------------------------------------------- C--- Get the Ancillary data record ------------------------------------ C----------------------------------------------------------------------- C READ(LUNAUX,NUM=NBYTES,END=200,ERR=10010) AUX$$ C LINE = LINE + 1 C PREFIX = AUXLN(1) C C--- Store the record prefix contents C $RNUM$ = RNUM $RSIZ$ = RSIZ $NREC$ = NREC $RPFX$ = RPFX C C--- Now that we know the size of the prefix area, RPFX, we can C--- calculate how many "pixels" the "real pixels" are offset from C--- the beginning of the physical record (RPFX is guaranteed to be C--- an integral multiple of RSIZ). C PXLOFF = RPFX / RSIZ C C--- Test for correct value of LogicalRecordSize (LRECSZ) embedded C--- in this code. Should be identical to that obtained from the C--- DDR, which should be identical to that found in the record pfx. C IF (RSIZ .NE. LRECSZ) THEN PRINT *,'+++ ANCILLARY FILE "RSIZ" .NE. "LRECSZ":' PRINT *,' ++ RSIZ =',RSIZ,', LRECSZ =',LRECSZ,', RNUM =',RNUM PRINT *,' ++ FIX THIS BY RECOMPILING WITH CORRECT "LRECSZ"' STOP 1 ENDIF C IF (RSIZ*NREC .NE. (NBYTES-RPFX)) THEN PRINT *,'+++ ANCILLARY FILE SYNCHRONIZATION ERROR: ', & 'FILE',FILENO,', RECORD',LINE PRINT *,' ++ NBYTES',NBYTES,', RSIZ',RSIZ,', NREC',NREC IERR = 1 ENDIF C IF (CKSM .NE. CHKSUM( AUXLN(1+PXLOFF), RSIZ * NREC )) THEN PRINT *,'+++ BAD ANCILLARY FILE CHECKSUM: ', & 'FILE',FILENO,', RECORD',LINE PRINT *,' ++ CHECKSUM: HEADER -',CKSM,', CALCULATED -', & CHKSUM( AUXLN(1+PXLOFF), RSIZ * NREC ) IERR = 1 ENDIF C C----------------------------------------------------------------------- C--- Get the corresponding Observation Data record -------------------- C----------------------------------------------------------------------- C READ(LUNIN,NUM=NBYTES,END=100,ERR=10000) FIRE$$ C C--- Assign the first element of FIRELN to PREFIX so we can check C--- the record prefix fields (the actual data starts with the element C--- FIRELN(PXL+PXLOFF); if RPFX is only 1 pixel long, then PXLOFF is C--- equal to 1, if 2 pixels, then 2, and so on). C PREFIX = FIRELN(1) C C--- Test that RNUM, RSIZ, NREC, and RPFX are the same in both the C--- observation data and ancillary data files. C IF ((RNUM .NE. $RNUM$) .OR. (RSIZ .NE. $RSIZ$) .OR. & (NREC .NE. $NREC$) .OR. (RPFX .NE. $RPFX$)) THEN PRINT *,'+++ FILE RECORD SYNCHRONIZATION ERROR: ', & 'FILE',FILENO,', RECORD',LINE PRINT *,' ++ RNUM',RNUM,', $RNUM$',$RNUM$, & ', RSIZ',RSIZ,', $RSIZ$',$RSIZ$ PRINT *,' ++ NREC',NREC,', $NREC$',$NREC$, & ', RPFX',RPFX,', $RPFX$',$RPFX$ IERR = 1 ENDIF C IF (RNUM .NE. LINE) THEN PRINT *,'+++ DATA RECORD SYNCHRONIZATION ERROR: ', & 'FILE',FILENO,', RECORD',LINE IERR = 1 ENDIF C IF (FNUM .NE. FILENO) THEN PRINT *,'+++ DATA FILE SYNCHRONIZATION ERROR: ', & 'FILE',FILENO,', RECORD',LINE IERR = 1 ENDIF C C--- Test for loss of synchronization, somewhere... C IF (NBYTES .NE. (RPFX + (RSIZ * NREC))) THEN PRINT *,'+++ DATA FILE SYNCHRONIZATION ERROR: ', & 'FILE',FILENO,', RECORD',LINE PRINT *,' ++ NBYTES',NBYTES,', RSIZ',RSIZ,', NREC',NREC IERR = 1 ENDIF C IF (CKSM .NE. CHKSUM( FIRELN(1+PXLOFF), RSIZ * NREC )) THEN PRINT *,'+++ BAD DATA CHECKSUM: ', & 'FILE',FILENO,', RECORD',LINE PRINT *,' ++ CHECKSUM: HEADER -',CKSM,', CALCULATED -', & CHKSUM( FIRELN(1+PXLOFF), RSIZ * NREC ) IERR = 1 ENDIF C C----------------------------------------------------------------------- C--- Normal return --------------------------------------------------- C----------------------------------------------------------------------- C RETURN C C----------------------------------------------------------------------- C--- End-Of-File ----------------------------------------------------- C----------------------------------------------------------------------- C 100 PRINT *,'*** END-OF-FILE ENCOUNTERED (DATA): ', & 'LAST RECORD NO. WAS',LINE IERR = -1 RETURN C 200 PRINT *,'*** END-OF-FILE ENCOUNTERED (ANCILLARY): ', & 'LAST RECORD NO. WAS',LINE IERR = -1 RETURN C C----------------------------------------------------------------------- C--- I/O error ------------------------------------------------------- C----------------------------------------------------------------------- C 10000 PRINT *,'+++ ERROR READING DATA FILE: ', & 'FILE',FILENO,', RECORD',LINE IERR = 1 RETURN C 10010 PRINT *,'+++ ERROR READING ANCILLARY FILE: ', & 'FILE',FILENO,', RECORD',LINE IERR = 1 RETURN C END ******************** * FireLib1 Fortran * ******************** * *----------------------------------------------------------------------* * * * The FIRE subroutine/function library * * * * Part 1 - User Subroutines * * * *----------------------------------------------------------------------* * ************************************************************************ ************************************************************************ **====================================================================** ** ** INTEGER FUNCTION CHKSUM( CARRAY, NBYTES ) CHARACTER*1 CARRAY(1) INTEGER NBYTES ** ** **====================================================================** ************************************************************************ ************************************************************************ C INTEGER TMP C CHARACTER*1 CHARS(4), CHAR INTEGER ICHAR EQUIVALENCE (CHARS(1), ICHAR) EQUIVALENCE (CHARS(4), CHAR) C ICHAR = 0 C TMP = 0 DO 10 I = 1, NBYTES CHAR = CARRAY(I) TMP = TMP + ICHAR 10 CONTINUE C CHKSUM = TMP RETURN END C ************************************************************************ ************************************************************************ **====================================================================** ** ** SUBROUTINE MKTBLS ** ** **====================================================================** ************************************************************************ ************************************************************************ C C BX / CX USER COMMUNICATIONS AREA C COMMON /BXCX/ YEAR,DAY,MONTH,DAYNIT, 2 NITEBX,LNDWTR,SHORE,VEGTYP,HITOPO,CLASSF,SNOICE, 3 IRFLTR,ITHRFL,ITHR,MUEBF,IRDAT,IRCLR,LNGTRI,SUSPVS, 4 GLINT,VTHRFL,VTHR,MU0BF,PHI0BF,ADDCHN(3),VISDAT,VISCLR, 5 NITECX,ITHRCX,VTHRCX,IIRFL,IIRCL,TMPRET,PRSRET,TMPCSR, 6 PRSCSR,IVSFL,IVSCL,ALBTAU,ALBCSR,TMPCOR,PRSCOR INTEGER YEAR,MONTH,DAY,DAYNIT, 1 NITEBX,LNDWTR,SHORE,VEGTYP,HITOPO,CLASSF,SNOICE, 2 IRFLTR,ITHRFL,ITHR,MUEBF,IRDAT,IRCLR,LNGTRI,SUSPVS,GLINT, 3 VTHRFL,VTHR,MU0BF,PHI0BF,ADDCHN,VISDAT,VISCLR INTEGER NITECX,ITHRCX,VTHRCX,IIRFL,IIRCL,TMPRET,PRSRET,TMPCSR, 1 PRSCSR,IVSFL,IVSCL,ALBTAU,ALBCSR,TMPCOR,PRSCOR COMMON /TBLCOM/ NITTAB(0:255),FLTTAB(0:255),GLNTAB(0:255), 1 SHRTAB(0:255),LNDTAB(0:255),TOPTAB(0:255),VEGTAB(0:255), 2 CLSTAB(0:255),SNITAB(0:255),IFLTAB(0:255),THRTAB(0:255), 3 ANGTAB(0:255),VFLTAB(0:255),ITHRTB(0:255),VTHRTB(0:255), 4 DRETAB(0:255),CRETAB(0:255),LNGTAB(0:255),SUSTAB(0:255) INTEGER NITTAB,FLTTAB,GLNTAB,SHRTAB,LNDTAB,TOPTAB,VEGTAB, 1 CLSTAB,SNITAB,IFLTAB,THRTAB,ANGTAB,VFLTAB,ITHRTB,VTHRTB,DRETAB, 2 CRETAB,LNGTAB,SUSTAB C C----------------------------------------------------------------------- C C--- One FIRE Pixel is a packet of RSIZ bytes. C--- One FIRE Line is an array of FIRE Pixels C--- LRECSZ and PRECMX are the size of the logical record and the max. C--- size of a physical record. MAXPXS is calculated from these values. C C--- MAXPXS is simply an upper bound on the various array sizes; C--- it must be greater than, or equal to, the quantity NREC, as C--- determined from the Data Description Record (DDR). Here we C--- calculate it from the maximum physical record size permitted C--- by the FIRE standard (12000 bytes) and the size of a pixel C--- packet (24 bytes). Note that one or more 24-byte packets is C--- taken up by the record prefix area, as specified in the DDR. C--- The actual physical record of the file is, in general, less than C--- the 12000 byte maximum. C INTEGER LRECSZ, PRECMX PARAMETER (LRECSZ = 24, PRECMX = 12000) INTEGER MAXPXS PARAMETER (MAXPXS = PRECMX / LRECSZ) C C--- Auxilliary data values may be 1, 2, or 4 byte quantities. C INTEGER RSIZ$1, RSIZ$2, RSIZ$4 PARAMETER (RSIZ$1 = LRECSZ) PARAMETER (RSIZ$2 = LRECSZ / 2) PARAMETER (RSIZ$4 = LRECSZ / 4) C COMMON /$FIRE$/ FIRE$$, AUX$$, PREFIX, & LUNIN, LUNAUX, LUNOUT, FILENO, LINE, & TOTPXS, NULPXS, $NITBX, $NITCX, LNDCNT C INTEGER LUNIN, LUNAUX, LUNOUT, FILENO, LINE, TOTPXS, & NULPXS, LNDCNT(2), $NITBX(0:1), $NITCX(0:1) C CHARACTER*12000 FIRE$$ CHARACTER*24 FIRELN(MAXPXS) EQUIVALENCE (FIRELN,FIRE$$) C CHARACTER*12000 AUX$$ CHARACTER*24 AUXLN(MAXPXS) CHARACTER*1 AUX$1(RSIZ$1,MAXPXS) INTEGER*2 AUX$2(RSIZ$2,MAXPXS) INTEGER*4 AUX$4(RSIZ$4,MAXPXS) EQUIVALENCE (AUXLN,AUX$$,AUX$1,AUX$2,AUX$4) C C--- Set up the structure used for filling the very first pixel in C--- each record C INTEGER FNUM, RNUM, CKSM, RSIZ, NREC, RPFX CHARACTER*24 PREFIX EQUIVALENCE (PREFIX( 1: 4), FNUM) EQUIVALENCE (PREFIX( 5: 8), RNUM) EQUIVALENCE (PREFIX( 9:12), CKSM) EQUIVALENCE (PREFIX(13:16), RSIZ) EQUIVALENCE (PREFIX(17:20), NREC) EQUIVALENCE (PREFIX(21:24), RPFX) C C----------------------------------------------------------------------- C Prepare various lookup tables to extract bit-flags from data C----------------------------------------------------------------------- C DO 200 IVAL = 0,255 IF (IVAL .LT. 128) THEN NITTAB(IVAL) = 0 ELSE NITTAB(IVAL) = 1 ENDIF FLTTAB(IVAL) = NITTAB(IVAL) GLNTAB(IVAL) = NITTAB(IVAL) IF (IAND( IVAL, 64 ) .EQ. 0) THEN SHRTAB(IVAL) = 0 ELSE SHRTAB(IVAL) = 1 ENDIF IF (IAND( IVAL, 32 ) .EQ. 0) THEN LNDTAB(IVAL) = 2 ELSE LNDTAB(IVAL) = 1 ENDIF IF (IAND( IVAL, 16 ) .EQ. 0) THEN TOPTAB(IVAL) = 0 ELSE TOPTAB(IVAL) = 1 ENDIF CLSTAB(IVAL) = IAND( IVAL, 2+1 ) SNITAB(IVAL) = IAND( IVAL, 8+4 ) / 4 VEGTAB(IVAL) = -1 IFLTAB(IVAL) = IAND( IVAL, 128+64+32+16+8 ) / 8 THRTAB(IVAL) = IAND( IVAL, 4+2+1 ) ANGTAB(IVAL) = IAND( IVAL, 64+32+16+8+4+2+1 ) VFLTAB(IVAL) = IAND( IVAL, 64+32+16+8 ) / 8 ITHRTB(IVAL) = IAND( IVAL, 64+32+16 ) / 16 VTHRTB(IVAL) = IAND( IVAL, 8+4+2 ) / 2 DRETAB(IVAL) = IAND( IVAL, 128+64+32+16 ) / 16 CRETAB(IVAL) = IAND( IVAL, 8+4+2+1 ) LNGTAB(IVAL) = IAND( IVAL, 32 ) / 32 SUSTAB(IVAL) = IAND( IVAL, 8 ) / 8 200 CONTINUE C RETURN END C ************************************************************************ ************************************************************************ **====================================================================** ** ** SUBROUTINE HSTPRN (LO$BIN,HI$BIN,HIST,TITLE) INTEGER LO$BIN, HI$BIN, HIST(LO$BIN:HI$BIN) CHARACTER*(*) TITLE C C----------------------------------------------------------------------- C--- LINEPRINTER HISTOGRAMMER, courtesy of L.C. Garder C----------------------------------------------------------------------- C ** ** **====================================================================** ************************************************************************ ************************************************************************ C CHARACTER*1 PRNT(100) CHARACTER*1 BLNK,XXXX DATA BLNK /' '/ DATA XXXX /'X'/ C C BEGIN C MAX=0 ISUM=0 IFRSBN=0 DO 100 IBIN=LO$BIN,HI$BIN IVAL=HIST(IBIN) ISUM=ISUM+IVAL IF(IVAL.GT.MAX) MAX=IVAL IF(IVAL.EQ.0) GO TO 100 LASTBN=IBIN IF(IFRSBN.EQ.0) IFRSBN=IBIN 100 CONTINUE IF(MAX.EQ.0) RETURN PRINT * PRINT *,'================= ',TITLE,' =================' PRINT * AMAX=MAX SUM=ISUM ISUM=0 DO 700 IBIN=IFRSBN,LASTBN HEIT=HIST(IBIN) IHEIT=100.0*(HEIT/AMAX) DO 600 IPRN=1,100 PRNT(IPRN)=BLNK IF(IPRN.LE.IHEIT) PRNT(IPRN)=XXXX 600 CONTINUE ISUM=ISUM+HIST(IBIN) TOT=100.0*(ISUM/SUM) IF(TOT.LT.0.1) GO TO 700 PRINT 601,IBIN,HIST(IBIN),TOT,PRNT 601 FORMAT(1X,I4,1X,I8,1X,F11.2,1X,'.',100A1) IF(TOT.GT.99.5) RETURN 700 CONTINUE RETURN END C ************************************************************************ ************************************************************************ **====================================================================** ** ** SUBROUTINE ATOE( STR$IN, LENGTH, STR$OU ) CHARACTER*1 STR$IN(1), STR$OU(1) INTEGER LENGTH ** ** **====================================================================** ************************************************************************ ************************************************************************ C C----------------------------------------------------------------------- C--- ASCII-to-EBCDIC translate table, courtesy of N.R. Habra C----------------------------------------------------------------------- * * ASCII TO EBCDIC TRANSLATE TABLE * 0 1 2 3 4 5 6 7 8 9 A B C D E F CHARACTER*16 $XLAT$(16) / & Z00010203372D2E2F1605250B0C0D0E0F, & Z101112133C3D322618193F271C1D1E1F, & Z405A7F7B5B6C507D4D5D5C4E6B604B61, & ZF0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F, & Z7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6, & ZD7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D, & Z79818283848586878889919293949596, & Z979899A2A3A4A5A6A7A8A9C06AD0A107, & Z00000000000000000000000000000000, & Z00000000000000000000000000000000, & Z00000000000000000000000000000000, & Z00000000000000000000000000000000, & Z00000000000000000000000000000000, & Z00000000000000000000000000000000, & Z00000000000000000000000000000000, & Z00000000000000000000000000000000 & / C CHARACTER*1 XLAT(0:255) EQUIVALENCE (XLAT, $XLAT$) C CHARACTER*1 CHARS(4), CHAR INTEGER ICHAR EQUIVALENCE (CHARS(1), ICHAR) EQUIVALENCE (CHARS(4), CHAR) C ICHAR = 0 C DO 10 I = 1, LENGTH CHAR = STR$IN(I) STR$OU(I) = XLAT(ICHAR) 10 CONTINUE RETURN END C ************************************************************************ ************************************************************************ **====================================================================** ** ** SUBROUTINE ETOA( STR$IN, LENGTH, STR$OU ) CHARACTER*1 STR$IN(1), STR$OU(1) INTEGER LENGTH ** ** **====================================================================** ************************************************************************ ************************************************************************ C C----------------------------------------------------------------------- C--- EBCDIC-to-ASCII translate table, courtesy of N.R. Habra C----------------------------------------------------------------------- * * EBCDIC TO ASCII TRANSLATE TABLE * 0 1 2 3 4 5 6 7 8 9 A B C D E F CHARACTER*16 $XLAT$(16) / & Z000102030009007F0000000B0C0D0E0F, & Z1011121300000800181900001C1D1E1F, & Z00000000000A171B0000000000050607, & Z0000160000000004000000001415001A, & Z20000000000000000000002E3C282B00, & Z2600000000000000000021242A293B5E, & Z2D2F00000000000000007C2C255F3E3F, & Z000000000000000000603A2340273D22, & Z00616263646566676869000000000000, & Z006A6B6C6D6E6F707172000000000000, & Z007E737475767778797A0000005B0000, & Z000000000000000000000000005D0000, & Z7B414243444546474849000000000000, & Z7D4A4B4C4D4E4F505152000000000000, & Z5C00535455565758595A000000000000, & Z30313233343536373839000000000000 & / C CHARACTER*1 XLAT(0:255) EQUIVALENCE (XLAT, $XLAT$) C CHARACTER*1 CHARS(4), CHAR INTEGER ICHAR EQUIVALENCE (CHARS(1), ICHAR) EQUIVALENCE (CHARS(4), CHAR) C ICHAR = 0 C DO 10 I = 1, LENGTH CHAR = STR$IN(I) STR$OU(I) = XLAT(ICHAR) 10 CONTINUE RETURN END C ************************************************************************ ************************************************************************ **====================================================================** ** ** SUBROUTINE CHCONV( IERR ) C C--- Purpose: Tests whether the ICHAR, CHAR equivalencing is C--- suitable, or whether the intrinsic functions C--- must be used instead. C ** ** **====================================================================** ************************************************************************ ************************************************************************ C INTEGER KCHAR CHARACTER*1 KHARS(4), KHAR EQUIVALENCE (KCHAR,KHARS) EQUIVALENCE (KHARS(4),KHAR) C DO 10 I = 0, 255 KCHAR = I IF (CHAR(I) .NE. KHAR) GOTO 99 10 CONTINUE C C--- The equivalencing passed. C IERR = 0 RETURN C C--- The equivalencing failed. C 99 IERR = 1 PRINT *,'+++ (ICHAR,CHAR) EQUIVALENCE conversion failed.' PRINT *,' ++ Please modify all references to the variables,' PRINT *,' ++ ICHAR and CHAR, and substitute code to use the' PRINT *,' ++ intrinsic functions instead.' RETURN END C ************************************************************************ ************************************************************************ **====================================================================** ** ** SUBROUTINE PUNPAK( PXL ) INTEGER PXL C C----------------------------------------------------------------------- C--- PIXEL UNPACKER - Courtesy of L.C. Garder, P.J. Lu, and A. Walker. C----------------------------------------------------------------------- C ** ** **====================================================================** ************************************************************************ ************************************************************************ C C BX / CX USER COMMUNICATIONS AREA C COMMON /BXCX/ YEAR,DAY,MONTH,DAYNIT, 2 NITEBX,LNDWTR,SHORE,VEGTYP,HITOPO,CLASSF,SNOICE, 3 IRFLTR,ITHRFL,ITHR,MUEBF,IRDAT,IRCLR,LNGTRI,SUSPVS, 4 GLINT,VTHRFL,VTHR,MU0BF,PHI0BF,ADDCHN(3),VISDAT,VISCLR, 5 NITECX,ITHRCX,VTHRCX,IIRFL,IIRCL,TMPRET,PRSRET,TMPCSR, 6 PRSCSR,IVSFL,IVSCL,ALBTAU,ALBCSR,TMPCOR,PRSCOR INTEGER YEAR,MONTH,DAY,DAYNIT, 1 NITEBX,LNDWTR,SHORE,VEGTYP,HITOPO,CLASSF,SNOICE, 2 IRFLTR,ITHRFL,ITHR,MUEBF,IRDAT,IRCLR,LNGTRI,SUSPVS,GLINT, 3 VTHRFL,VTHR,MU0BF,PHI0BF,ADDCHN,VISDAT,VISCLR INTEGER NITECX,ITHRCX,VTHRCX,IIRFL,IIRCL,TMPRET,PRSRET,TMPCSR, 1 PRSCSR,IVSFL,IVSCL,ALBTAU,ALBCSR,TMPCOR,PRSCOR COMMON /TBLCOM/ NITTAB(0:255),FLTTAB(0:255),GLNTAB(0:255), 1 SHRTAB(0:255),LNDTAB(0:255),TOPTAB(0:255),VEGTAB(0:255), 2 CLSTAB(0:255),SNITAB(0:255),IFLTAB(0:255),THRTAB(0:255), 3 ANGTAB(0:255),VFLTAB(0:255),ITHRTB(0:255),VTHRTB(0:255), 4 DRETAB(0:255),CRETAB(0:255),LNGTAB(0:255),SUSTAB(0:255) INTEGER NITTAB,FLTTAB,GLNTAB,SHRTAB,LNDTAB,TOPTAB,VEGTAB, 1 CLSTAB,SNITAB,IFLTAB,THRTAB,ANGTAB,VFLTAB,ITHRTB,VTHRTB,DRETAB, 2 CRETAB,LNGTAB,SUSTAB C C C*********************************************************************** C COMMON BLOCK BXCX VARIABLE DICTIONARY C********************************************************************** C C I*4 LUNCX ---------- LOGICAL UNIT NUMBER FOR THE BX/CX DATA SET C I*4 LUNAUX --------- LOGICAL UNIT NUMBER FOR AUXILIARY DATA ZNLTLN C I*4 NITEBX --------- NIGHT FLAG - BX DECISION C I*4 LNDWTR --------- LAND/WATER FLAG FOR PIXEL (1 = WATER, 2 = LAND) C I*4 SHORE ---------- SHORE FLAG C I*4 VEGTYP --------- VEGETATION TYPE C I*4 HITOPO --------- HIGH TOPOGRAPHY FLAG C I*4 CLASSF --------- COMPOSITE CLASS OF PIXEL C I*4 SNOICE --------- SNOW/ICE COVER CODE C I*4 IRFLTR --------- C I*4 ITHRFL --------- IR CLEAR SKY FLAG C I*4 ITHR ----------- IR THRESHOLD CLASS OF PIXEL - BX C I*4 MUEBF ---------- NAVIGATION ANGLE MU FOR PIXEL -------- (0-100) C I*4 IRDAT ---------- TEMPERATURE OF IMAGE PIXEL ----------- (0-255) C I*4 IRCLR ---------- TEMPERATURE OF CLEAR SKY PIXEL ------- (0-255) C I*4 LNGTRI --------- LONG TERM STATISTIC FLAG --------------- (0-1) C I*4 SUSPVS --------- ON = SUSPICIOUS VS FLAG ---------------- (0-1) C I*4 GLINT ---------- GLINT FLAG ----------------------------- (0-1) C I*4 VTHRFL --------- VISIBLE CLEAR SKY FLAG C I*4 VTHR ----------- VISIBLE THRESHOLD CLASS OF PIXEL - BX C I*4 MU0BF ---------- NAVIGATION ANGLE MU0 FOR PIXEL ------- (0-100) C I*4 PHI0BF --------- NAVIGATION ANGLE PHI0 FOR PIXEL ------ (0-100) C I*4 ADDCHN --------- THREE ADDITIONAL CHANNELS IF AVAILABLE (0-255) C I*4 VISDAT --------- VISIBLE REFLECTANCE OF IMAGE PIXEL --- (0-255) C I*4 VISCLR --------- VISIBLE REFLECTANCE OF CLEAR SKY PIXEL (0-255) C I*4 NITECX --------- DAY/NIGHT FLAG FOR PIXEL 0 - DAY, 1 - NIGHT C I*4 ITHRCX --------- IR THRESHOLD CLASS - CX DECISION C I*4 VTHRCX --------- VS THRESHOLD CLASS - CX DECISION C I*4 IIRFL ---------- IR RETRIEVAL FLAG C I*4 IIRCL ---------- CLEAR SKY IR CHANNEL RETRIEVAL FLAG -- (0-255) C I*4 TMPRET --------- SURFACE OR CLOUD TOP TEMPERATURE ----- (0-255) C I*4 PRSRET --------- SURFACE OR CLOUD TOP PRESSURE -------- (0-255) C I*4 TMPCSR --------- CLEAR SKY SURFACE TEMPERATURE -------- (0-255) C I*4 PRSCSR --------- CLEAR SKY SURFACE PRESSURE ----------- (0-255) C I*4 IVSFL ---------- VISIBLE CHANNEL RETRIEVAL FLAG ------- (0-255) C I*4 IVSCL ---------- CLEAR SKY VISIBLE CHANNEL RETR FLAG - (0-255) C I*4 ALBTAU --------- SURFACE ALBEDO OR TAU ---------------- (0-255) C I*4 ALBCSR --------- CLEAR SKY SURFACE ALBEDO ------------- (0-255) C I*4 TMPCOR --------- COUD TOP TEMPERATURE AFTER TAU CORRECT (0-255) C I*4 PRSCOR --------- COUD TOP PRESSURE AFTER TAU CORRECTION (0-255) C----------------------------------------------------------------------- C C C----------------------------------------------------------------------- C C--- One FIRE Pixel is a packet of RSIZ bytes. C--- One FIRE Line is an array of FIRE Pixels C--- LRECSZ and PRECMX are the size of the logical record and the max. C--- size of a physical record. MAXPXS is calculated from these values. C C--- MAXPXS is simply an upper bound on the various array sizes; C--- it must be greater than, or equal to, the quantity NREC, as C--- determined from the Data Description Record (DDR). Here we C--- calculate it from the maximum physical record size permitted C--- by the FIRE standard (12000 bytes) and the size of a pixel C--- packet (24 bytes). Note that one or more 24-byte packets is C--- taken up by the record prefix area, as specified in the DDR. C--- The actual physical record of the file is, in general, less than C--- the 12000 byte maximum. C INTEGER LRECSZ, PRECMX PARAMETER (LRECSZ = 24, PRECMX = 12000) INTEGER MAXPXS PARAMETER (MAXPXS = PRECMX / LRECSZ) C C--- Auxilliary data values may be 1, 2, or 4 byte quantities. C INTEGER RSIZ$1, RSIZ$2, RSIZ$4 PARAMETER (RSIZ$1 = LRECSZ) PARAMETER (RSIZ$2 = LRECSZ / 2) PARAMETER (RSIZ$4 = LRECSZ / 4) C COMMON /$FIRE$/ FIRE$$, AUX$$, PREFIX, & LUNIN, LUNAUX, LUNOUT, FILENO, LINE, & TOTPXS, NULPXS, $NITBX, $NITCX, LNDCNT C INTEGER LUNIN, LUNAUX, LUNOUT, FILENO, LINE, TOTPXS, & NULPXS, LNDCNT(2), $NITBX(0:1), $NITCX(0:1) C CHARACTER*12000 FIRE$$ CHARACTER*24 FIRELN(MAXPXS) EQUIVALENCE (FIRELN,FIRE$$) C CHARACTER*12000 AUX$$ CHARACTER*24 AUXLN(MAXPXS) CHARACTER*1 AUX$1(RSIZ$1,MAXPXS) INTEGER*2 AUX$2(RSIZ$2,MAXPXS) INTEGER*4 AUX$4(RSIZ$4,MAXPXS) EQUIVALENCE (AUXLN,AUX$$,AUX$1,AUX$2,AUX$4) C C--- Set up the structure used for filling the very first pixel in C--- each record C INTEGER FNUM, RNUM, CKSM, RSIZ, NREC, RPFX CHARACTER*24 PREFIX EQUIVALENCE (PREFIX( 1: 4), FNUM) EQUIVALENCE (PREFIX( 5: 8), RNUM) EQUIVALENCE (PREFIX( 9:12), CKSM) EQUIVALENCE (PREFIX(13:16), RSIZ) EQUIVALENCE (PREFIX(17:20), NREC) EQUIVALENCE (PREFIX(21:24), RPFX) C C----------------------------------------------------------------------- C--- FIREPX is a convenience, permitting us to grab a whole pixel at C--- once from FIRELN. PXLBUF is used for ease of addressibility, C--- since dereferencing an array is faster than substring operations. C CHARACTER*24 FIREPX CHARACTER*1 PXLBUF(RSIZ$1) EQUIVALENCE (FIREPX, PXLBUF) C----------------------------------------------------------------------- C--- NULLPX is used as a convenient way to assign 24 bytes of 255; C--- PXNULL is used as a convenient way to initialize NULLPX. C CHARACTER*24 NULLPX CHARACTER*1 PXNULL(RSIZ$1) /RSIZ$1 * ZFF/ EQUIVALENCE (NULLPX, PXNULL) C----------------------------------------------------------------------- C COMMON /STATS/ IRDHST, VIDHST, IRCHST, VICHST, PXLHST, & FLGIRD, FLGVID, FLGIRC, FLGVIC, FLGPXL INTEGER IRDHST(0:255), VIDHST(0:255), & IRCHST(0:255), VICHST(0:255), & PXLHST(MAXPXS) LOGICAL FLGIRD, FLGVID, FLGIRC, FLGVIC, FLGPXL C C----------------------------------------------------------------------- C WORKING STORAGE C CHARACTER*1 CHARS(4) EQUIVALENCE (ICHAR,CHARS(1)) CHARACTER*1 $BYTE$ EQUIVALENCE ($BYTE$,CHARS(4)) C----------------------------------------------------------------------- C C BEGIN PUNPAK C ICHAR = 0 C C--- Select your pixel, gentlepersons C C--- We assume that the caller has already added the appropriate offset C--- (PXLOFF) onto the value of PXL that was passed to PUNPAK(). C FIREPX = FIRELN( PXL ) C C BYTE 1 C $BYTE$ = PXLBUF(1) NITEBX = NITTAB(ICHAR) SHORE = SHRTAB(ICHAR) LNDWTR = LNDTAB(ICHAR) HITOPO = TOPTAB(ICHAR) VEGTYP = VEGTAB(ICHAR) CLASSF = CLSTAB(ICHAR) SNOICE = SNITAB(ICHAR) C C BYTE 2 C $BYTE$ = PXLBUF(2) ITHRFL = IFLTAB(ICHAR) ITHR = THRTAB(ICHAR) LNGTRI = LNGTAB(ICHAR) C C BYTE 3 C $BYTE$ = PXLBUF(3) IRFLTR = FLTTAB(ICHAR) MUEBF = ANGTAB(ICHAR) C C BYTE 4 C $BYTE$ = PXLBUF(4) IRDAT = ICHAR IRDHST(IRDAT) = IRDHST(IRDAT)+1 C C BYTE 5 C $BYTE$ = PXLBUF(5) IRCLR = ICHAR IRCHST(IRCLR) = IRCHST(IRCLR)+1 C C ADDITIONAL CHANNELS C $BYTE$ = PXLBUF(6) ADDCHN(1) = ICHAR $BYTE$ = PXLBUF(7) ADDCHN(2) = ICHAR $BYTE$ = PXLBUF(8) ADDCHN(3) = ICHAR C C VIS DATA C C BYTE 9 (Night BX data) C $BYTE$ = PXLBUF(9) GLINT = GLNTAB(ICHAR) VTHRFL = VFLTAB(ICHAR) VTHR = THRTAB(ICHAR) SUSPVS = SUSTAB(ICHAR) C C BYTE 10 C $BYTE$ = PXLBUF(10) MU0BF = ICHAR C C BYTE 11 C $BYTE$ = PXLBUF(11) PHI0BF = ICHAR C C BYTE 12 C $BYTE$ = PXLBUF(12) VISDAT = ICHAR VIDHST(VISDAT) = VIDHST(VISDAT)+1 C C BYTE 13 C $BYTE$ = PXLBUF(13) VISCLR = ICHAR VICHST(VISCLR) = VICHST(VISCLR)+1 C C FETCH AND UNPACK CX DATA C C C BYTE 14 (CX data) C $BYTE$ = PXLBUF(14) NITECX = NITTAB(ICHAR) ITHRCX = ITHRTB(ICHAR) VTHRCX = VTHRTB(ICHAR) C C BYTE 15 C $BYTE$ = PXLBUF(15) IIRFL = DRETAB(ICHAR) IIRCL = CRETAB(ICHAR) C C BYTE 16 C $BYTE$ = PXLBUF(16) TMPRET = ICHAR C C BYTE 17 C $BYTE$ = PXLBUF(17) PRSRET = ICHAR C C BYTE 18 C $BYTE$ = PXLBUF(18) TMPCSR = ICHAR C C BYTE 19 C $BYTE$ = PXLBUF(19) PRSCSR = ICHAR C C BYTE 20 VIS C $BYTE$ = PXLBUF(20) IVSFL = DRETAB(ICHAR) IVSCL = CRETAB(ICHAR) C C BYTE 21 VIS C $BYTE$ = PXLBUF(21) ALBTAU = ICHAR C C BYTE 22 VIS C $BYTE$ = PXLBUF(22) ALBCSR = ICHAR C C BYTE 23 VIS C $BYTE$ = PXLBUF(23) TMPCOR = ICHAR C C BYTE 24 VIS C $BYTE$ = PXLBUF(24) PRSCOR = ICHAR C RETURN END END OF OBSERVATION SEGMENT