PROGRAM ADP73S C C From: http://dss.ucar.edu/datasets/ds464.0/software/readsfc2.f (or, C but not publically accessible: ~baseball/rje/NMC/adp73prt2.sfc ) C C Use f90 to compile. Designed for interactive use. For batch use, you C must wrap this in a script, and rewrite the program code which asks C the user for information - i.e., "hardwire" into DATA statements, etc. C C Written by Gregg Walters, NCAR/SCD/DSS, 2001Aug22 C major modifications: C 2004may25 C 2006jan19 (now gets all cat.52 data, C and corrects loss of SST) C 2007Jun15 (now does location counts) C 2008Jul15 (now can select on elevation) C C contact baseball@ucar.edu or datahelp@ucar.edu C C >>> INSTRUCTIONS FOR USE <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< C >>> PLEASE READ ALL OF THIS TO LEARN HOW TO USE THE PROGRAM <<<<<<<<<<<<<<<<<< C C It can optionally produce a print of all observations in a file, except as C specified by the user when prompted, or by editing the program. C C It can optionally print a list of stations being printed, their names, and C the number of reports from each. C C It reads NCEP/NMC ADP ON29 formatted data from a sequential file. ADP data C files were not designed by NCEP for random access. Our mission has been C to keep an historical archive of data in their original formats. It is C up to you, perhaps using output from this program, to engineer a database. C C When this is run, you will first be prompted to decide whether to do dumps. C If you have modified the program, and having a lot of trouble debugging, C you might try this mode - just be aware that the dump volume can be very C large. When you do choose to do dumps, no selection criteria will be C offered or applied. C C Next you will be prompted for an input file from DS464.0. These files are C available from two sources: the NCAR MSS or the DSS server, and the file C format differs between them. C C The files on the MSS are listed here: C C http://dss.ucar.edu/datasets/ds464.0/MSS-file-list.html C C These files are COS-blocked. You should use msread -fCH to download C the data from the NCAR MSS, which will strip the COS-blocking and add C "newline characters" making them ready to use as input to readsfc2. C C Using msread -fBI will strip the COS-blocking but not add the "newline C characters". See below for help with a "fold" command to do this. C C If msrcp is used, you will then need to use our cosconvert software C found here: C C http://dss.ucar.edu/libraries/io/cos_blocking/utils/ C C and then do a "fold" (see below). C C The files on the DSS server can be obtained from here: C http://dss.ucar.edu/datasets/ds464.0/data/ C C These files are not COS-blocked, but they are gzipped, meaning that you C must do a gunzip. The resulting file could be used in the MM5 or WRF. C However, to use in readsfc2, you must then do a "fold". C C HELP WITH "fold". readsfc2 will only work when the input file has C logical records separated by a "newline character". If not, you will C need to use our FORTRAN version of the UNIX fold, found here: C C http://dss.ucar.edu/datasets/ds464.0/software/fold.f C c Compile it, and move the executable to "fold". Then copy your input C file to fort.11. Then execute fold. The output will be given C in fort.12, which can be used in readsfc2. C C In the directory where readsfc2 is run, you must have a copy of the USAF C dictionary, named 'usafdict', which is a copy of: C C http://dss.ucar.edu/datasets/ds900.0/data/combined C C >>>>>>> NOTE: A FILE IN THE FORM ACCEPTABLE TO THIS PROGRAM CAN NOT BE <<<<<<< C >>>>>>> READ BY THE MM5. <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< C C Next you will be prompted for an output file. C C If you are not doing a dump, then you will be prompted for a data set C type, up to 10 periods of record, a geographic region and/or a list C of station numbers. Then you will also be prompted for the various C units to be used, and for controls on the appearance of the printout. C Finally, after all these prompts, if you choose not to proceed, you C can either quit, or reset these things and then proceed. C C A sample output is in: C http://dss.ucar.edu/datasets/ds464.0/software/readsfc2.sampleout C C The NCEP/NMC ADP format is here: C http://dss.ucar.edu/datasets//common/nmc.adp/format_on124_01mar C c Modified to transform visibility code to a distance c and to transform height of low cloud base code to a height C PARAMETER (MX=400) ! NUMBER OF REPORTS TO BATCH PARAMETER (NRAN=10) ! NUMBER OF DATE RANGES PARAMETER (MXLV8=8) ! NUMBER OF ADDITIONAL DATA PORTIONS PARAMETER (KWMAX=100) ! NUMBER OF STATIONS FOR SELWMO C CHARACTER*8 QSHO, D08, A08, M08 COMMON / ARRAYS / P(MX), Z(MX), T(MX), H(MX), D(MX), F(MX), A C(MX), QSHO(MX), D08(MX), A08(MX), M08(MX), IC08(MX), R PMSG, ZMSG, TMSG, HMSG, DMSG, FMSG, RMSG C C P PRESSURE (STATION AND SEA LEVEL) IN MB AS PRINTED (IN TENTHS OF MB C AS PACKED) C T TEMPERATURE IN DEGREES C AS PRINTED (IN TENTHS OF DEGREES AS PACKED) C H DEWPOINT DEPRESSION IN DEGREES C AS PRINTED (IN TENTHS OF DEGREES C AS PACKED) C D WIND DIRECTION IN DEGREES C F WIND SPEED IN KNOTS C Q SET OF QUALITY MARKS (SEE NCEP/NMC OFFICE NOTE 29) C FOR STNP, SLP, T, H, W(WIND) --- WE WON'T BE PRINTING THESE C C ALL OTHER PARAMETERS ARE CODES C C LEAVE THE 10000 ALONE, EVEN THOUGH IT IS BIGGER THAN THE ORIGINAL C 6440 LOGICAL RECORD SIZE C CHARACTER NBF*10000 COMMON / ADPB / NBF COMMON / ADPC / LOGREC, NU, NA, LTHR, LOUT, idump, irep, ireplim C CHARACTER*8 EOREP, EOREC, XS, WASH, EOFIL COMMON / ADP / EOREP, EOREC, XS, WASH, EOFIL C C C C C REAL*8 TIME, XLAT, XLON, ELEV CHARACTER*16 IDATSHO CHARACTER*8 IDSTYP, IDTPRT, ASTA CHARACTER NADD(MXLV8)*10 COMMON / CRDADP / IDATSHO, IDSTYP, IDTPRT, ASTA, XLAT, XLON, 2 ELEV, IFH, IRTYP, INSTYP, IRC, IYR, IMO, IDY, IHR, TIME, TIME08 DIMENSION ELEVLIM(2) <---<< C CHARACTER*1 QSLP, QSTP, QDDFF, QAT, QDWX C C C C CHARACTER*8 LOCI(5,1801,3601) ! STATION ID - UP TO 5 AT EACH POINT CHARACTER*5 STATID CHARACTER*26 NAMEDIC DIMENSION LOCT(5,1801,3601) ! STATION TYPE - UP TO 5 AT EACH POINT DIMENSION LOCK(5,1801,3601) ! COUNTER - UP TO 5 AT EACH POINT C CHARACTER*6 SELWMO(KWMAX) C CHARACTER*13 ARC CHARACTER*3 MON(12) DATA MON / 'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', D 'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC'/ C CHARACTER*2 DYSHO, HRSHO C CHARACTER*32 FNAMI, FNAMO, FILE, FMT, FORM, STAT, STATUS C DIMENSION IPERBEG(NRAN), IPEREND(NRAN) CHARACTER GLOBE*1, STNSEL*1 <---<< CHARACTER IPERIOD*16, IPSEL*1, IADJ*1, TIMECK*11, IRISK*1 CHARACTER TYPOUT*1 CHARACTER DATETAG*8, DATETUG*8, LONA*1 CHARACTER IDEF*1, IHTU*1, ITEMPU*1, IDEW*1, IWINDU*1 CHARACTER ADU*2, AHTU*2, ATEMPU*1, ADEW*6, AWINDU*3, ASWPERU*4 C C C C CHARACTER AVISU*2, APREC*2 C CHARACTER IPROC*1, IQR*1, AYR*4 C C C C C C NP = 0 ! INITIALIZE THE COUNTER FOR CATEGORY 06 HEADER PRINTS 1000 CONTINUE WRITE (*,*) ' ' WRITE (*,*) ' It is suggested that you widen your window', W ' to 90 - 100 columns, for cleaner prompts' WRITE (*,*) ' ' WRITE (*,*) ' Enter a 0 here; unless you want to run', W ' in a debugging mode, in which case' WRITE (*,*) ' enter the number of reports to dump' WRITE (*,*) ' ' C READ (*,7000,ERR=1000) ZZ READ (*,*,ERR=1000) ZZ idump = ZZ C C7000 FORMAT (I) C NU = 99999 NA = 0 LTHR = 0 C IREC = 0 ! records hold variable length reports idump0 = 0 IREP = 0 ! REPORTS READ IREPP = 0 ! REPORTS PRINTED ireplim = idump ! limit number of reports read when idump > 0 C MAXLEV = MX C C *** SPECIFY INPUT FILE NAME C WRITE (*,*) ' ' WRITE (*,*) ' Enter input file name' WRITE (*,*) ' ' READ (*,7001) FNAMI 7001 FORMAT (A) IUN = 1 FMT = 'FORMATTED' STAT = 'OLD' OPEN (IUN,FILE=FNAMI,FORM=FMT,STATUS=STAT) C WRITE (*,*) ' ' WRITE (*,*) ' Enter output file name' WRITE (*,*) ' ' READ (*,7001) FNAMO LOUT = 7 STAT = 'NEW' OPEN (LOUT,FILE=FNAMO,FORM=FMT,STATUS=STAT) C 1001 CONTINUE C WRITE (*,*) ' Please select the type of output you want' WRITE (*,*) ' ' WRITE (*,*) ' Enter For' WRITE (*,*) ' d Data reports only' WRITE (*,*) ' s Station report counts only' WRITE (*,*) ' b Both' READ (*,7001) TYPOUT IF (TYPOUT.NE.'d'.AND.TYPOUT.NE.'s'.AND.TYPOUT.NE.'b') GO TO 1000 C IRISK = 'n' C C C IDEF = 'y' C IHTU = 'm' AHTU = ' M' ADU = 'KM' AVISU = 'KM' APREC = 'IN' C ITEMPU = 'c' ATEMPU = 'C' C IDEW = 'd' ADEW = 'DEWDEP' C IWINDU = 'k' AWINDU = 'KTS' C C C NRPBH = 50 C IOK = 0 C DATETAG(1:8) = 'SYNOPTIC' DATETUG(1:8) = 'synoptic' LONA = 'W' IRADIUS = 99999 XRADIUS = IRADIUS YLON = 0.0 YLAT = 0.0 DIST = 0.0 ELEVLIM(1) = 99999. <---<< C IF (idump0.NE.0) THEN IDTPRT(1:3) = 'all ' C C C C C IPERBEG(1) = 1 GLOBE(1:1) = 'g' STNSEL(1:1) = 'a' ELSE 1010 CONTINUE C C ***** SELECT A SPECIFIC FILE TYPE BY SETTING IDTPRT C WRITE (*,*) ' ' WRITE (*,*) ' Enter data type to print, choosing from' WRITE (*,*) ' ' WRITE (*,*) ' Type From ---------' WRITE (*,*) ' ADPSFC DS464.0 land surface' WRITE (*,*) ' SFCSHP DS464.0 ship surface' C C C C C C C WRITE (*,*) ' ' WRITE (*,*) ' all Do both types' WRITE (*,*) ' ' C C READ (*,7001) IDTPRT IF (IDTPRT(1:6).EQ.'ADPSFC') THEN IOK = 1 C C C ENDIF IF (IDTPRT(1:6).EQ.'SFCSHP') THEN IOK = 1 C C C C C ENDIF C C C C C C C C C C C C C C C C C C C C C C C C C C IF (IDTPRT(1:3).EQ.'ALL' ) IDTPRT(1:3) = 'all' IF (IDTPRT(1:3).EQ.'all' ) THEN IOK = 1 C C C C ENDIF IF (IOK.EQ.0) THEN WRITE (*,*) ' DATA TYPE NOT RECOGNIZED - type' WRITE (*,*) ' exactly as shown' GO TO 1010 ENDIF C C ***** SPECIFY PERIOD OF RECORD C WRITE (*,*) ' ' WRITE (*,*) ' Now prompting for the desired period(s) of record' KPER = 0 1020 CONTINUE WRITE (*,*) ' Please specify your date/times (this ', w 'prompt will be looped to allow up to' WRITE (*,*) ' ',NRAN,' selections)' WRITE (*,*) ' ' WRITE (*,*) ' Enter For' WRITE (*,*) ' ' WRITE (*,*) ' YYYYMMDDHH Beginning date/time', w ' (e.g. 2001061500)' WRITE (*,*) ' YYYYMMDDHH Ending date/time', w ' < on the next line > (say 9 if same as beginning)' WRITE (*,*) ' 1 All times available on the file' WRITE (*,*) ' q To stop specifications' WRITE (*,*) ' ' 1025 CONTINUE IF (KPER.GE.NRAN) GO TO 1030 IF (KPER.NE.0) THEN WRITE (*,*) 'NEXT (YYYYMMDDHH and YYYYMMDDHH, or q to quit)' ENDIF READ (*,7001) IPERIOD KPER = KPER + 1 IF (IPERIOD(1:1).EQ.'Q') IPERIOD(1:1) = 'q' IF (IPERIOD(1:1).EQ.'q') THEN IF (KPER.EQ.1) THEN IPERBEG(1) = 1 IPEREND(1) = 1 ELSE KPER = KPER - 1 ENDIF GO TO 1030 ENDIF READ (IPERIOD,7027,ERR=1020) IPERBEG(KPER) 7027 FORMAT (I10) IF (IPERBEG(KPER).EQ.1) GO TO 1030 IF (IPERBEG(KPER).LT.1973010100) GO TO 1020 READ (*,7027,ERR=1020) IPEREND(KPER) IF (IPEREND(KPER).EQ.9) IPEREND(KPER) = IPERBEG(KPER) IF (IPEREND(KPER).LT.IPERBEG(KPER)) GO TO 1020 GO TO 1025 1030 CONTINUE WRITE (*,*) ' ' WRITE (*,*) ' Choose the time convention to be used', W ' to select the data and to show in' WRITE (*,*) ' the printout -' WRITE (*,*) ' synoptic time (h) or report time (i) ?' WRITE (*,*) ' ' READ (*,7001) IPSEL IF (IPSEL.EQ.'H') IPSEL = 'h' IF (IPSEL.EQ.'I') IPSEL = 'i' IF (IPSEL.NE.'h'.AND.IPSEL.NE.'i') GO TO 1030 IF (IPSEL.EQ.'h') THEN IADJ = 'n' GO TO 1035 ENDIF 1032 CONTINUE IADJ = 'y' WRITE (*,*) ' ' WRITE (*,*) ' The true report date may differ from ', W ' the synoptic date.' WRITE (*,*) ' (e.g. a "year mo dy hr hr.hu" ' WRITE (*,*) ' of "1998 6 1 0 23.00" is' WRITE (*,*) ' really "1998 5 31 23 23.00"' WRITE (*,*) ' Would you like to adjust the report date? (y/n)' WRITE (*,*) ' HIGHLY RECOMMENDED to avoid confusion.' WRITE (*,*) ' Note: The adjustment will be done before', W ' the date/time selection is done.' C WRITE (*,*) ' ' READ (*,7001) IADJ IF (IADJ.EQ.'Y') IADJ = 'y' IF (IADJ.EQ.'N') IADJ = 'n' IF (IADJ.NE.'y'.AND.IADJ.NE.'n') GO TO 1032 1035 CONTINUE DATETAG(1:8) = 'SYNOPTIC' DATETUG(1:8) = 'synoptic' IF (IPSEL.EQ.'i') THEN DATETAG(1:8) = ' REPORT ' DATETUG(1:8) = ' report ' ENDIF WRITE (*,*) ' ' WRITE (*,*) ' The date/time sort for the great majority', W ' of the data is reliable. To save a' WRITE (*,*) ' little time, you could make the selection', W ' stop reading the (sequential) file' WRITE (*,*) ' for the period you want after the end', W ' of all periods are found. There is a' WRITE (*,*) ' small risk of losing out of sort data', W ' after that point. If nothing else, ' WRITE (*,*) ' it accelerates things when you are debugging.' WRITE (*,*) ' ' WRITE (*,*) ' So, do you want to do this kind of stop? (y/n)' WRITE (*,*) ' ' READ (*,7001) IRISK IF (IRISK.EQ.'Y') IRISK = 'y' IF (IRISK.EQ.'N') IRISK = 'n' IF (IRISK.NE.'y'.AND.IRISK.NE.'n') GO TO 1035 1040 CONTINUE C C ***** SPECIFY GEOGRAPHIC REGION C WRITE (*,*) ' ' WRITE (*,*) ' Now prompting for the geographic domain.' WRITE (*,*) ' ' WRITE (*,*) ' ' WRITE (*,*) ' Enter For' WRITE (*,*) ' g Entire globe' WRITE (*,*) ' l Latitude-longitude "window"' WRITE (*,*) ' r Places within a radius of a point. This' WRITE (*,*) ' will take longer to process than' WRITE (*,*) ' simple(latitude-longitude window)' WRITE (*,*) ' ' READ (*,7001) GLOBE(1:1) IF (GLOBE(1:1).EQ.'G') GLOBE(1:1) = 'g' IF (GLOBE(1:1).EQ.'L') GLOBE(1:1) = 'l' IF (GLOBE(1:1).EQ.'R') GLOBE(1:1) = 'r' IF (GLOBE(1:1).NE.'g'.AND. i GLOBE(1:1).NE.'l'.AND. i GLOBE(1:1).NE.'r') GO TO 1040 IF (idump0.NE.0) THEN write (lout,7700) globe(1:1), stnsel(1:1) 7700 format (//,1x,'GLOBE(1:1) = ',a1,1x,'STNSEL(1:1) = ',a1) ENDIF C IF (GLOBE(1:1).EQ.'g') THEN LONW = 360 LATS = -90 LONE = 0 LATN = 90 ALONW = LONW ALATS = LATS ALONE = LONE ALATN = LATN GO TO 1048 ENDIF C 1042 CONTINUE IF (GLOBE(1:1).EQ.'l') THEN WRITE (*,*) ' Now prompting for the desired latitude-', w 'longitude window' WRITE (*,*) ' We are using the coordinate system as', w ' specified in NMC Office Note 124' WRITE (*,*) ' ' WRITE (*,*) ' YOU MUST SPECIFY YOUR LONGITUDES AS POSITIVE', W ' INTEGER DEGREES FROM 0 TO 360 WEST.' WRITE (*,*) ' Characters e or w will not be understood.' WRITE (*,*) ' YOU MUST SPECIFY YOUR LATITUDES AS INTEGER', W ' DEGREES BETWEEN -90 (south) AND' WRITE (*,*) ' 90 (north).' WRITE (*,*) ' Characters n or s will not be understood.' WRITE (*,*) ' ' WRITE (*,*) ' Enter For latitude-longitude window' WRITE (*,*) ' www Longitude of lower left corner' WRITE (*,*) ' sss Latitude of lower left corner', w ' << on the next line >>' WRITE (*,*) ' eee Longitude of upper right corner', w ' << on the next line >>' WRITE (*,*) ' nnn Latitude of upper right corner', w ' << on the next line >>' c READ (*,*,ERR=1042) ZZ1, ZZ2, ZZ3, ZZ4 C7004 FORMAT (I/I/I/I) LONW = ZZ1 LATS = ZZ2 LONE = ZZ3 LATN = ZZ4 ALONW = LONW ALATS = LATS ALONE = LONE ALATN = LATN IF (LONW.LT. 0.OR.LONW.GT.360) GO TO 1042 IF (LATS.LT.-90.OR.LATS.GT. 90) GO TO 1042 C IF (LONE.LT. 0.OR.LONE.GT.360) GO TO 1042 IF (LONE.EQ.LONW) GO TO 1042 IF (LATN.LT.-90.OR.LATN.GT. 90) GO TO 1042 IF (LATN.LE.LATS) GO TO 1042 GO TO 1048 ENDIF C IF (GLOBE(1:1).EQ.'r') THEN 1044 CONTINUE WRITE (*,*) ' Within how many kilometers? (50-9999)' WRITE (*,*) ' ' READ (*,*,ERR=1044) ZZ IRADIUS = ZZ IF (IRADIUS.LT.50.OR.IRADIUS.GT.9999) THEN IRADIUS = 99999 GO TO 1044 ELSE XRADIUS = IRADIUS 1046 CONTINUE WRITE (*,*) ' What is your central point? ' WRITE (*,*) ' ' WRITE (*,*) ' We are using the coordinate system as', w ' specified in NMC Office Note 124' WRITE (*,*) ' ' WRITE (*,*) ' YOU MUST SPECIFY YOUR LONGITUDE AS DEGREES', W ' AND FRACTION FROM 0 TO 360 WEST.' WRITE (*,*) ' E.G. 105.1. Characters e or w will not be', W ' understood.' WRITE (*,*) ' YOU MUST SPECIFY YOUR LATITUDE AS DEGREES', W ' AND FRACTION FROM -90.0 (south) AND' WRITE (*,*) ' 90.0 (north).' WRITE (*,*) ' Characters n or s will not be understood.' WRITE (*,*) ' Enter decimal only' WRITE (*,*) ' ' WRITE (*,*) ' www Longitude of center' WRITE (*,*) ' sss Latitude of center', w ' << on the next line >>' READ (*,7003,ERR=1046) ALONW, ALATS 7003 FORMAT (F6.2/F6.2) IF (ALONW.LT. 0.OR.ALONW.GT.360) GO TO 1046 IF (ALATS.LT.-90.OR.ALATS.GT. 90) GO TO 1046 ALONE = ALONW ALATN = ALATS YLON = ALONW YLAT = ALATS GO TO 1048 ENDIF ENDIF C 1048 CONTINUE WRITE (*,*) ' In the output, show longitude west or east? (w/e)' WRITE (*,*) ' ' READ (*,7001) LONA IF (LONA.EQ.'w') LONA = 'W' IF (LONA.EQ.'e') LONA = 'E' IF (LONA.NE.'W'.AND.LONA.NE.'E') GO TO 1048 1050 CONTINUE C <---<< C ***** SPECIFY STATION SELECTION METHOD, IF ANY <---<< C <---<< WRITE (*,*) ' ' <---<< WRITE (*,*) ' Now prompting for WMO station selection method', <---<< W ' method (whether from entire globe, or' <---<< WRITE (*,*) ' from your latitude-longitude window)' <---<< WRITE (*,*) ' ' <---<< WRITE (*,*) ' NOTE- in order to get all reports from', <---<< W ' stations which use two different' <---<< WRITE (*,*) ' identifications, i.e. a WMO number or', <---<< W ' a call sign, be sure to select "All ' <---<< WRITE (*,*) ' stations"' <---<< WRITE (*,*) ' ' <---<< WRITE (*,*) ' Enter For ' <---<< WRITE (*,*) ' a All stations' <---<< WRITE (*,*) ' b Your list of WMO block numbers,', <---<< W ' up to KWMAX' <---<< WRITE (*,*) ' l Your list of WMO station numbers/names,', <---<< W ' up to KWMAX' <---<< WRITE (*,*) ' e Stations between two elevations' <---<< WRITE (*,*) ' ' <---<< WRITE (*,*) ' Please see ', <---<< w ' http://dss.ucar.edu/datasets/ds900.0/data/ , for' <---<< WRITE (*,*) ' a list of WMO station numbers, which includes', <---<< w ' name, lat-lon, elevation, etc.' <---<< WRITE (*,*) ' ' <---<< READ (*,7001,ERR=1050) STNSEL <---<< IF (STNSEL(1:1).EQ.'a') GO TO 1065 <---<< IF (STNSEL(1:1).EQ.'b') GO TO 1054 <---<< IF (STNSEL(1:1).EQ.'l') GO TO 1054 <---<< IF (STNSEL(1:1).EQ.'e') GO TO 1060 <---<< GO TO 1050 <---<< 1054 CONTINUE <---<< KW = 0 <---<< 1055 CONTINUE <---<< IF (KW.EQ.0) THEN <---<< WRITE (*,*) ' ' <---<< WRITE (*,*) ' Now prompting for WMO station numbers/blocks' <---<< WRITE (*,*) ' ' <---<< WRITE (*,*) ' Enter For ' <---<< WRITE (*,*) ' ' <---<< WRITE (*,*) ' BBNNN WMO station number (e.g. 72469 which', <---<< w ' is Denver)' <---<< WRITE (*,*) ' BB All the stations in a WMO block (e.g.', <---<< w ' 08, which is all of Spain)' <---<< WRITE (*,*) ' ' <---<< WRITE (*,*) ' Please see ', <---<< w ' http://dss.ucar.edu/datasets/ds900.0/data/ ,' <---<< WRITE (*,*) ' for a list of station numbers, which', <---<< w ' includes name, lat-lon, elevation, etc.' <---<< WRITE (*,*) ' ' <---<< ELSE <---<< WRITE (*,*) ' Enter next (BBNNN, BB, or q to quit)' <---<< ENDIF <---<< READ (*,7001) SELWMO(KW+1)(1:6) <---<< IF (KW.LT.KWMAX) THEN <---<< IF (SELWMO(KW+1)(1:1).EQ.'Q') SELWMO(KW+1)(1:1) = 'q' <---<< IF (SELWMO(KW+1)(1:1).NE.'q') THEN <---<< C READ (SELWMO(KW+1)(1:5),7000,ERR=1058) IWMO ! TEST INTEGERS <---<< READ (SELWMO(KW+1)(1:5),*,ERR=1058) ZZ ! TEST INTEGERS <---<< C ZZ = IWMO ! 2008.02.15 - PROBABLY A MISCODING <---<< IWMO = ZZ <---<< IF (IWMO.LT.0) GO TO 1055 <---<< 1058 CONTINUE <---<< KW = KW + 1 <---<< GO TO 1055 <---<< ELSE <---<< KW = KW + 1 <---<< ENDIF <---<< ELSE <---<< SELWMO(KW)(1:1) = 'q' <---<< ENDIF <---<< GO TO 1065 <---<< 1060 CONTINUE <---<< WRITE (*,*) ' Please enter the lowest and highest', <---<< w ' station elevations that you want, on', <---<< w ' successive lines, in whole meters.' <---<< READ (*,8060,ERR=1060) ILEVLIM <---<< ELEVLIM(1) = ILEVLIM <---<< READ (*,8060,ERR=1060) ILEVLIM <---<< ELEVLIM(2) = ILEVLIM <---<< 8060 FORMAT (I5) <---<< IF (ELEVLIM(1).LT.-60.0.OR.ELEVLIM(1).GT.11000.0) GO TO 1060 <---<< IF (ELEVLIM(2).LT.-60.0.OR.ELEVLIM(2).GT.11000.0) GO TO 1060 <---<< IF (ELEVLIM(2).LT.ELEVLIM(1)) GO TO 1060 <---<< 1065 CONTINUE <---<< C IDEF = 'y' ! commented out 2008.06.02 IF (TYPOUT.EQ.'d'.OR.TYPOUT.EQ.'b') THEN WRITE (*,*) ' ' WRITE (*,*) ' A LIMITED SELECTION OF DATA UNITS IS AVAILABLE', W ' Most of the ADP ON124 data is ' WRITE (*,*) ' in metric, but the winds are in knots.' WRITE (*,*) ' Do you just want to use the ADP ON124 units,', W ' and other defaults? (y/n)' WRITE (*,*) ' ' READ (*,7001,ERR=1070) IDEF IF (IDEF.EQ.'Y') IDEF = 'y' IF (IDEF.EQ.'N') IDEF = 'n' IF (IDEF.NE.'y'.AND.IDEF.NE.'n') GO TO 1065 1070 CONTINUE IF (IDEF.EQ.'y') GO TO 1089 WRITE (*,*) ' In the following prompts, the ON124 "NATIVE"', W ' units appears as capital letters.' WRITE (*,*) ' ' WRITE (*,*) ' Do you want to see elevation in METERS or', W ' feet? (m/f)' WRITE (*,*) ' This will also control visibility, between', W ' kilometers and miles;' WRITE (*,*) ' and precipitation, between centimeters and', W ' inches' WRITE (*,*) ' ' READ (*,7001,ERR=1070) IHTU IF (IHTU.EQ.'M') IHTU = 'm' IF (IHTU.EQ.'F') IHTU = 'f' IF (IHTU.NE.'m'.AND.IHTU.NE.'f') GO TO 1070 IF (IHTU.EQ.'m') AHTU = ' M' IF (IHTU.EQ.'f') AHTU = 'FT' AVISU = 'KM' IF (IHTU.EQ.'f') AVISU = 'MI' ADU = AVISU APREC = 'CM' IF (IHTU.EQ.'f') APREC = 'IN' 1075 CONTINUE WRITE (*,*) ' ' WRITE (*,*) ' Do you want to see temperatures in degrees', W ' CENTIGRADE or Fahrenheit? (c/f)' WRITE (*,*) ' ' READ (*,7001,ERR=1075) ITEMPU IF (ITEMPU.EQ.'C') ITEMPU = 'c' IF (ITEMPU.EQ.'F') ITEMPU = 'f' IF (ITEMPU.NE.'c'.AND.ITEMPU.NE.'f') GO TO 1075 IF (ITEMPU.EQ.'c') ATEMPU = 'C' IF (ITEMPU.EQ.'f') ATEMPU = 'F' 1080 CONTINUE WRITE (*,*) ' ' WRITE (*,*) ' Do you want to see DEWPOINT DEPRESSION', W ' (d) or dewpoint (p) ? (d/p)' WRITE (*,*) ' ' READ (*,7001,ERR=1080) IDEW IF (IDEW.EQ.'D') IDEW = 'd' IF (IDEW.EQ.'P') IDEW = 'p' IF (IDEW.NE.'d'.AND.IDEW.NE.'p') GO TO 1080 IF (IDEW.EQ.'d') ADEW = 'DEWDEP' IF (IDEW.EQ.'p') ADEW = ' DEWPT' 1085 CONTINUE WRITE (*,*) ' ' WRITE (*,*) ' Do you want to see winds in KNOTS or meters', W ' per second? (k/m)' WRITE (*,*) ' ' READ (*,7001,ERR=1085) IWINDU IF (IWINDU.EQ.'K') IWINDU = 'k' IF (IWINDU.EQ.'M') IWINDU = 'm' IF (IWINDU.NE.'k'.AND.IWINDU.NE.'m') GO TO 1085 IF (IWINDU.EQ.'k') AWINDU = 'KTS' IF (IWINDU.EQ.'m') AWINDU = 'MPS' 1089 CONTINUE C C C C C C C C C C C C C C C C C C C C C C 1097 CONTINUE WRITE (*,*) ' ' WRITE (*,*) ' How many reports (10 - 60) do you want to', W ' print between headers?' C WRITE (*,*) ' You may enter 0 to turn off the headers, e', W 'xcept for one at the very beginning' WRITE (*,*) ' ' C READ (*,7000,ERR=1097) NRPBH READ (*,*,ERR=1097) ZZ NRPBH = ZZ C IF (NRPBH.EQ. 0) GO TO 1098 IF (NRPBH.LT.10.OR.NRPBH.GT.60) GO TO 1097 ENDIF ENDIF C 1098 CONTINUE C IF (idump.EQ.0) THEN IF (IDTPRT(1:3).NE.'all') THEN WRITE (LOUT,9899) FNAMI, IDTPRT(1:6) 9899 FORMAT ( 1X,'---------------------------------------', F '---------------------------------------', F /,1X,'PRINTOUT OF SURFACE OBSERVATIONS FROM F', F 'ILE ',A, F /,1X,' USING readsfc2.f WITH THESE OPTIONS: ', F //,1X,' Do ',A,' data type only ') ELSE WRITE (LOUT,9900) FNAMI 9900 FORMAT ( 1X,'---------------------------------------', F '---------------------------------------', F /,1X,'PRINTOUT OF SURFACE OBSERVATIONS FROM F', F 'ILE ',A, F /,1X,' USING readsfc2.f WITH THESE OPTIONS: ', F //,1X,' Do all data types on the file.') C ENDIF ELSE write (lout,9901) fnami, ireplim 9901 FORMAT ( 1X,'---------------------------------------', F '---------------------------------------', F /,1X,'PRINTOUT OF SURFACE OBSERVATIONS FROM F', F 'ILE ',A, f /,1x,'first ',i4,' reports in dump mode',/1x,' ') ENDIF IF (idump0.EQ.0) THEN IF (IPERBEG(1).EQ.1) THEN WRITE (LOUT,9902) 9902 FORMAT (/,1X,' For all times on the file ') ELSE write (lout,9903) (iperbeg(ii),iperend(ii),ii=1,kper) 9903 FORMAT (/,1X,' For these periods: ', F 100(/4X,I10,' - ',I10)) IF (IRISK.EQ.'y') THEN write (lout,9904) 9904 FORMAT (/,1X,' Stopping file scan when end of last', F ' period(s) are first processed') ELSE write (lout,9905) 9905 FORMAT (/,1X,' Scanning entire file for data in period(s)') ENDIF ENDIF IF (IPSEL.EQ.'h') then TIMECK(1:11) = ' synoptic ' ELSE TIMECK(1:11) = 'observation' ENDIF WRITE (LOUT,9906) TIMECK(1:11) 9906 FORMAT (/,1X,' Using ',A,' times') IF (TYPOUT.EQ.'d'.OR.TYPOUT.EQ.'b') THEN WRITE (LOUT,99070) 99070 FORMAT (/,1X,' In the printout of the reports, the') IF (IADJ.EQ.'y') then WRITE (LOUT,99071) DATETUG 99071 FORMAT (1X,' ',a,' dates have been adjusted so ', F 'that they agree with the report times') ELSE WRITE (LOUT,99072) DATETUG 99072 FORMAT (1X,' ',a,' dates are the header dates, ', F 'so they may disagree with the report ', F 'times.') ENDIF ENDIF IF (GLOBE(1:1).EQ.'g') THEN <---<< WRITE (LOUT,9908) 9908 FORMAT (/,1X,' Stations from the entire globe') ENDIF IF (GLOBE(1:1).EQ.'l') THEN <---<< WRITE (LOUT,99091) LONW, LONE, LATS, LATN 99091 FORMAT (/,1X,' Stations from this window: ', F /,1X,' Longitude (W) ',I3,' eastward to ',I3, F ' ', F /,1X,' Latitude ',I3,' northward to ',I3) ENDIF IF (GLOBE(1:1).EQ.'r') THEN WRITE (LOUT,99092) IRADIUS, ALONW, ALATS 99092 FORMAT (/,1X,' Stations Within ',I5,' km of this point:', F /,1X,' Longitude (W) ',F6.2, F /,1X,' Latitude ',F6.2, F /,1X,' When reports are printed, the distance', F ' from this point will appear in the ID') ENDIF IF (STNSEL(1:1).EQ.'b'.OR.STNSEL(1:1).EQ.'l') THEN WRITE (LOUT,9910) (SELWMO(KKW)(1:6),KKW=1,KW-1) <---<< 9910 FORMAT (/,1X,' Extracting these stations: (just 2 digits', <---<< F ' means stations with this WMO block number)', <---<< F 10(/,5X,A,2X,A,2X,A,2X,A,2X,A)) <---<< ENDIF IF (STNSEL(1:1).EQ.'e') THEN IF (ELEVLIM(1).NE.99999.) THEN WRITE (LOUT,9912) ELEVLIM(1), ELEVLIM(2) <---<< 9912 FORMAT (/,1X,' Extracting stations within this elevation ', <---<< F ' range:' <---<< F /,5X,F6.0,' through ',F6.0,' meters') <---<< ENDIF <---<< ENDIF <---<< IF (TYPOUT.EQ.'d'.OR.TYPOUT.EQ.'b') THEN IF (LONA.EQ.'W') THEN WRITE (LOUT,99121) 99121 FORMAT (/,1X,' Longitudes will be shown as 0 - 360 WEST', F ' of the GM') ELSE WRITE (LOUT,99122) 99122 FORMAT (/,1X,' Longitudes will be shown as 0 - 360 EAST', F ' of the GM') ENDIF ENDIF IF (TYPOUT.EQ.'d'.OR.TYPOUT.EQ.'b') THEN WRITE (LOUT,9914) AHTU, ATEMPU 9914 FORMAT (/,1X,' Heights in ',A, F /,1X,' Temperatures in ',A) IF (IDEW.EQ.'d') THEN WRITE (LOUT,9915) 9915 FORMAT ( 1X,' Moisture as a dewpoint depression') ELSE WRITE (LOUT,9916) 9916 FORMAT ( 1X,' Moisture as a dewpoint') ENDIF WRITE (LOUT,9917) AWINDU 9917 FORMAT ( 1X,' Winds in ',A) C C C C C C C C C C C C C C C C C C C IF (NRPBH.EQ.0) THEN WRITE (LOUT,9919) 9919 FORMAT (/,1X,' Just one header will be printed') C ELSE WRITE (LOUT,9920) NRPBH 9920 FORMAT (/,1X,I4,' reports will be printed between', F ' headers') ENDIF C ENDIF ENDIF C C REWIND (LOUT) CLOSE (LOUT) ! instead STAT = 'OLD' ! instead OPEN (LOUT,FILE=FNAMO,FORM=FMT,STATUS=STAT) ! instead DO 1115 I = 1, 1000 READ (LOUT,8115,END=1120,ERR=1120) NBF(1:99) 8115 FORMAT (A) WRITE (6,9915) NBF(1:99) 9115 FORMAT (1X,A) 1115 CONTINUE 1120 CONTINUE WRITE (*,*) ' ' WRITE (*,*) ' PROCEED WITH ABOVE OPTIONS? (y/n)' WRITE (*,*) ' ' READ (*,7001) IPROC IF (IPROC.EQ.'Y') IPROC = 'y' IF (IPROC.EQ.'N') IPROC = 'n' IF (IPROC.NE.'y'.AND.IPROC.NE.'n') GO TO 1120 IF (IPROC.EQ.'n') THEN 1125 CONTINUE WRITE (*,*) ' ' WRITE (*,*) ' Options may be reset, but it means going through', W ' all of them again.' WRITE (*,*) ' Reset or quit? (r/q)' WRITE (*,*) ' ' READ (*,7001) IQR IF (IQR.EQ.'R') IQR = 'r' IF (IQR.EQ.'Q') IQR = 'q' IF (IQR.NE.'r'.AND.IQR.NE.'q') GO TO 1125 IF (IQR.EQ.'n') GO TO 991 C REWIND (LOUT) CLOSE (LOUT) ! instead STAT = 'NEW' ! instead OPEN (LOUT,FILE=FNAMO,FORM=FMT,STATUS=STAT) ! instead GO TO 1001 ENDIF C IF (idump.EQ.0) THEN IF (TYPOUT.EQ.'d'.OR.TYPOUT.EQ.'b') THEN WRITE (LOUT,9922) 9922 FORMAT (/,1X,'---------------------------------------', F '---------------------------------------', F //,1X,'Detailed information about the data may', F ' be found in the NMC Office Note 124 ', F /,1X,'(ON124) document: ', F ' ', F //,1X,' http://dss.ucar.edu/datasets/common', F '/nmc.adp/format_on124_01mar ', F ///,1X,' Under the FH column, F has values of:', F ' 1-"new", 2-ASOS, 3-AWOS, 4-other auto-', F 'mated, 9-manual. ', F /,1X,' H has values of:', F ' 1-converted hourly, 9-regular, others ', F 'are "location flag for ships." ', F /,1X,' ') C C C C C C C C C C C C C C ENDIF ENDIF C 1900 CONTINUE ICCNT = 0 KCCNT = 0 c c stop c IF (TYPOUT.EQ.'d'.OR.TYPOUT.EQ.'b') THEN IF (NRPBH.EQ.0) THEN WRITE (LOUT,9001) DATETAG WRITE (LOUT,9002) LONA, ADEW WRITE (LOUT,9003) ADU, AHTU, W AWINDU, AVISU, W ATEMPU, ATEMPU, W AHTU, APREC, APREC, APREC, W AHTU, AHTU, ATEMPU, APREC NRPBH = 1 WRITE (LOUT,9004) ENDIF ENDIF C 2000 CONTINUE C C C C C C C C C C C C C C C C C C C *** READ A REPORT C C *** RDADP WILL SELECT ON DATA TYPE (USING NAMES ALREADY INPUT BY USER) C TIME08 = 99.99 CALL RDADP (IUN,IST,IREC,IREP) IF (IST.EQ.1) GO TO 990 IF (IST.EQ.3) GO TO 991 IREP = IREP + 1 c if (idump.ne.0) then c IST = 3 c GO TO 991 c ENDIF if (idump.ne.0.and.irep.le.ireplim) then write (lout,9005) irec, irep, nu, na, lthr, iyr 9005 format (1X,'ADP73: AFTER RDADP irec, irep, nu, na, lthr, iyr', F i3,4i10,i10) endif IFILE = 0 C C AS RETURNED BY RDADP C THE ON124 HEADER (SYNOPTIC) TIME, IHR, IS IN HUNDREDTHS OF AN HOUR C THE REPORT TIME, TIME, IS HR.HH C C TO ANTICIPATE THE REPORT SELECTION PROCESS AND PRINTOUTS, WE NEED C TO DEFINE C IDATE SYNOPTIC DATE/TIME C MDATE REPORT DATE/TIME BASED ON THE SYNOPTIC DATE/TIME, C ADJUSTED IF PREFERRED C C DEFINE IDATE C ICC = 19 IF (IYR.LT.70) ICC = 20 IYEAR = 100*ICC + IYR IYRMO = 100*IYEAR + IMO IF (IYEAR.LT.1982) ASWPERU = 'CODE' IF (IYEAR.GE.1982) ASWPERU = ' SEC' JHR = IHR / 100 C C IDATE EXPECTS JHR IN WHOLE HOURS C IDATE = 10000*IYRMO + IDY*100 + JHR ! SYNOPTIC DATE/TIME if (idump.ne.0.and.irep.le.ireplim) then write (lout,6665) idate, iyr, imo, idy, ihr, time 6665 format (1x,'idate, iyr, imo, idy, ihr, time', f i16,3i3,i5,f6.2) endif C C DEFINE PREFERRED MDATE C IF (IADJ.eq.'y') THEN C C REPORT TIMES AT 00Z OFTEN DO NOT MATCH THE SYNOPTIC TIME, AND MAY ALSO C CORRESPOND TO THE PREVIOUS OR FOLLOWING DATE, RELATIVE TO THE C SYNOPTIC TIME. EXAMPLES (ALL UTC, ALSO KNOWN AS Z): C C SYNOPTIC REPORT ACTUAL REPORT C DATE/TIME TIME DATE/TIME C (YYMMDDHHHH) HH.HH (YYMMDDHH.HH) C 0003010000 23.03 00022923.03 C 0012311800 02.04 01010102.04 C CALL DADJUST (IYR,IMO,IDY,IHR,TIME,MYR,MMO,MDY,NHR) C MHR = NHR / 100 MHR = TIME ELSE MYR = IYR MMO = IMO MDY = IDY MHR = IHR / 100 ENDIF C IF (MYR.GT.70) THEN MCC = 19 AYR = '19 ' ELSE MCC = 20 AYR = '20 ' ENDIF IF (MYR.GT.9) THEN WRITE (AYR(3:4),9006) MYR ELSE AYR(3:3) = '0' WRITE (AYR(4:4),9007) MYR ENDIF MYEAR = 100*MCC + MYR MYRMO = 100*MYEAR + MMO C C MDATE EXPECTS MHR IN WHOLE HOURS C MDATE = 10000*MYRMO + MDY*100 + MHR C if (idump.ne.0.and.irep.le.ireplim) then write (lout,6666) mdate, myr, mmo, mdy, mhr, time 6666 FORMAT (1X,'MDATE, MYR, MMO, MDY, MHR, TIME', F I16,3I3,I5,F6.2) ENDIF C C THE L-DATES ARE USED FOR DEFINING AND DUMPING DATSHO AND NOTHING ELSE C IF (IPSEL.EQ.'h') then LHR = JHR LDY = IDY LMO = IMO LYEAR = IYEAR ELSE LHR = MHR LDY = MDY LMO = MMO LYEAR = MYEAR ENDIF C IF (LDY.GE.10) THEN WRITE (DYSHO(1:2),9006) LDY 9006 FORMAT (I2) ELSE DYSHO(1:1) = '0' WRITE (DYSHO(2:2),9007) LDY 9007 FORMAT (I1) ENDIF IF (LHR.GE.10) THEN WRITE (HRSHO(1:2),9006) LHR ! SYNOPTIC HOUR, NOT OBSERVATION TIME ELSE HRSHO(1:1) = '0' WRITE (HRSHO(2:2),9007) LHR ! SYNOPTIC HOUR, NOT OBSERVATION TIME ENDIF WRITE (IDATSHO(1:16),9009) LYEAR, MON(LMO), DYSHO, HRSHO 9009 FORMAT (I4,A3,A2,'.',A2,' ') if (idump.ne.0.and.irep.le.ireplim) then write (lout,9008) idatsho(1:12), idstyp(1:6), asta(1:6), w xlon, xlat, alonw, alone, alats, alatn 9008 FORMAT (1X,'ADP73: IDATSHO, IDSTYP, ASTA', F ' XLON, XLAT, ALONW, ALONE, ALATS, ALATN ', F A,1X,A,1X,A,2f6.1,4f7.2) endif C C ***** SELECT ON DATE (USING NUMBERS ALREADY INPUT BY USER) C ITOSS = 1 IF (IPERBEG(1).NE.1) THEN KDATE = IDATE ! USE SYNOPTIC DATE IF (IPSEL.EQ.'i') KDATE = MDATE ! USE PREFERRED REPORT DATE DO 10 II = 1, KPER C C IPERB = MOD(IPERBEG(II),100000000) C IPERE = MOD(IPEREND(II),100000000) C 1999123123 C IF (IPEREND(II).NE.9) THEN IF (KDATE.GE.(IPERBEG(II)).AND. I KDATE.LE.(IPEREND(II))) GO TO 12 ENDIF 10 CONTINUE IF (IRISK.EQ.'y') THEN IF (KDATE.GT.IPEREND(KPER)) GO TO 991 ENDIF GO TO 2000 ENDIF 12 CONTINUE LONK = (10 * (XLON+0.05)) + 1 ! ALLOW FOR WRAPAROUND LATK = (10 * (XLAT+0.05)) + 901 ! ALLOW FOR EQUATOR IF (LONK.LT.1.OR.LONK.GT.3601) GO TO 2000 IF (LATK.LT.1.OR.LONK.GT.1801) GO TO 2000 C C BAD LONK AND/OR LATK VALUES CAN BLOW THE LOCK, LOCI AND LOCT TABLES BELOW C C ***** SELECT GEOGRAPHIC AREA (USING NUMBERS ALREADY INPUT BY USER) C IF (GLOBE(1:1).EQ.'l') THEN IF (XLAT.LT.ALATS.OR.XLAT.GT.ALATN) GO TO 2000 IF (ALONW.LT.ALONE) THEN IF (XLON.GT.ALONW.AND.XLON.LT.ALONE) GO TO 2000 <---<< ELSE IF (XLON.LT.ALONE. OR.XLON.GT.ALONW) GO TO 2000 <---<< ENDIF ENDIF IF (GLOBE(1:1).EQ.'r') THEN CALL LLDIST (XLAT,XLON,YLAT,YLON,DIST) IF (DIST.GT.XRADIUS) GO TO 2000 ENDIF C IF (STNSEL(1:1).EQ.'a') GO TO 20 <---<< C C ***** SELECT ON STATION (USING BLOCKS OR NUMBERS ALREADY INPUT BY USER) C IF (STNSEL(1:1).EQ.'b') THEN <---<< DO 16 ISIT = 1, KW <---<< IF (SELWMO(ISIT)(1:1).EQ.'q') GO TO 2000 ! END OF LIST <---<< IF (SELWMO(ISIT)(3:6).NE.' ') THEN <---<< C <---<< C HERE WE ARE SELECTING ENTIRE WMO BLOCKS OF STATIONS <---<< C <---<< IF (ASTA(1:2).EQ.SELWMO(ISIT)(1:2)) GO TO 20 <---<< ENDIF <---<< 16 CONTINUE <---<< GO TO 2000 ! NOT ONE WE WANT <---<< ENDIF <---<< C IF (STNSEL(1:1).EQ.'l') THEN <---<< DO 17 ISIT = 1, KW <---<< IF (SELWMO(ISIT)(1:1).EQ.'q') GO TO 2000 ! END OF LIST <---<< IF (SELWMO(ISIT)(3:6).NE.' ') THEN <---<< C <---<< C HERE WE ARE SELECTING SPECIFIC STATIONS <---<< C <---<< IF (ASTA(1:6).EQ.SELWMO(ISIT)(1:6)) GO TO 20 <---<< ENDIF <---<< 17 CONTINUE <---<< GO TO 2000 ! NOT ONE WE WANT <---<< ENDIF <---<< C IF (STNSEL(1:1).EQ.'e') THEN <---<< C <---<< C **** SELECT FROM ELEVATION RANGE (USING NUMBERS ALREADY INPUT) <---<< C <---<< IF (ELEV.GE.ELEVLIM(1).AND.ELEV.LE.ELEVLIM(2)) GO TO 20 <---<< GO TO 2000 ! NOT ONE WE WANT <---<< ENDIF <---<< 20 CONTINUE ! ACCEPTED <---<< C C **** WE HAVE A REPORT THAT WE WANT!! C C BUMP LOCATION/STATION COUNTER C LONK = (10 * (XLON+0.05)) + 1 ! ALLOW FOR WRAPAROUND LATK = (10 * (XLAT+0.05)) + 901 ! ALLOW FOR EQUATOR DO 21 LLK = 1, 5 IF ( LOCK(LLK,LATK,LONK) .EQ.0) THEN LOCI(LLK,LATK,LONK)(1:6) = ASTA(1:6) LOCT(LLK,LATK,LONK) = IRTYP LOCK(LLK,LATK,LONK) = LOCK(LLK,LATK,LONK) + 1 GO TO 22 ELSE IF (LLK.LT.5) THEN IF (ASTA(1:6).EQ.LOCI(LLK,LATK,LONK)(1:6)) THEN LOCK(LLK,LATK,LONK) = LOCK(LLK,LATK,LONK) + 1 GO TO 22 ENDIF ELSE LOCI(LLK,LATK,LONK)(1:6) = 'OTHERS' ! LUMP TOGETHER 5 OR MORE LOCT(LLK,LATK,LONK) = 999 LOCK(LLK,LATK,LONK) = LOCK(LLK,LATK,LONK) + 1 ENDIF ENDIF 21 CONTINUE 22 CONTINUE C C C C C C C C C C C C C C PRINT A HEADER FOR THE NEXT NRPBH REPORTS TO BE PRINTOUT C C <<< END OF CODE "PARALLEL" WITH readupa2.f >>> C C C C C C C C C C C C C NP = NP + 1 IF (TYPOUT.EQ.'d'.OR.TYPOUT.EQ.'b') THEN IF (NRPBH.GT.1.AND.MOD(NP,NRPBH).EQ.1) THEN WRITE (LOUT,9001) DATETAG 9001 FORMAT (/,1X, F 'STATION ----------------------------- FH ', F A,' DATE REPORT WIND ', F ' WEATHER PRESSURE TEMPERATURE', F ' ------- CLOUD COVER ------ PRECIPITATI', F 'ON SNOW LENGTH - WAVE - ---- SWELL ----', F '- SPECIAL -- SHIP -- WATER') WRITE (LOUT,9002) LONA, ADEW 9002 FORMAT (1X, F ' WMO TYPE LAT LON',A,' DIST ELEV ', F 'YEAR MO DY HR TIME DIR SPD VIS ', F ' CUR PAST SEALEV STATION AIR ', F A,' TOT LOW TYPE BASE TYPE 6-HR ', F ' 24-HR DEPTH PR.OB. PER HT DIR PE', F 'R HT SST PHENOMENA DIR SPEED EQUIV') C WRITE (LOUT,9003) ADU, AHTU, W AWINDU, AVISU, W ATEMPU, ATEMPU, W AHTU, APREC, APREC, APREC, W AHTU, ASWPERU, AHTU, ATEMPU, APREC 9003 FORMAT (1X, F ' (SM.1) (DEGR&.01DEGR) ',A,' ',A,' ', F ' HR&.O1HR ',A,' ',A, F ' (CODES) MB MB ',A,' ',A,' ', F ' (OKTAS) LOW HT,',A,' MID HIGH ',A,' ',A, F ' ',A,' SEC ',A,' WMO- ',A,' ', F A,' ',A,' WMO- WMO- ',A) C WRITE (LOUT,9004) 9004 FORMAT (63X,'--- Q ---- QUALITY (SM.51) ----- Q ------ Q ', F ' ---- Q ----- Q',69X,'0877',31X,'0700 4451') C ENDIF ENDIF C C READ CATEGORY 51 DATA C CALL SADP51(N51,SLP,STP,DDD,FFF,AT,DPD,ATMX,ATMN, 2 QSLP,QSTP,QDDFF,QAT,QDWX, 3 IVV,IPW,IW1,IN,INH,IC1,IZCB,IC2,IC3,ICPT,IPT) c c please see http://dss.ucar.edu/datasets/common/nmc.adp/format_on124_96feb , c Appendix S.2, Category 51 for a description of these variables. c IF (N51.LE.0) THEN SLP = PMSG STP = PMSG DDD = 0.0 FFF = 0.0 AT = TMSG DPD = TMSG ATMX = TMSG ATMN = TMSG QSLP = ' ' QSTP = ' ' QDDFF = ' ' QAT = ' ' QDWX = ' ' IVV = 0 IPW = 0 IW1 = 0 IN = 0 INH = 0 IC1 = 0 IZCB = 0 IC2 = 0 IC3 = 0 ICPT = 0 IPT = 0 ENDIF C C READ CATEGORY 52 DATA C CALL SADP52(N52,XPC6,XSNO,XPC24,IPCT,IWP,IWZ,ISWD,ISWP, 2 ISWZ,SST,ISPHG,ISPHD,ISDD,ISFF,XWEQ) c c please see http://dss.ucar.edu/datasets/common/nmc.adp/format_on124_96feb , c Appendix S.2, Category 52 for a description of these variables. c IF (N52.LE.0) THEN XPC6 = 99.99 XSNO = 999. XPC24 = 99.99 IPCT = 9 IWP = 99 IWZ = 99 ISWD = 99 ISWP = 99 XZS = 99. SST = TMSG ISPHG = 99 ISPHD = 99 ISDD = 99 ISFF = 9 XWEQ = 999.99 ENDIF C C READ CATEGORY 8 DATA C C CALL SADP08(NADD,NLV8,MXLV8) C C PLEASE SEE THE COMMENTS IN THE SADP08 SUBROUTINE TO C LEARN HOW TO USE THIS DATA C C please see http://dss.ucar.edu/datasets/common/nmc.adp/format_on124_96feb , C Appendix S.2, Category 08 for a description of these variables. C CALL VISDEC (IVV,RANGE,AVISU) CALL HTCBASE (IZCB,IBASE,IHTU) C C IF (IYR.GE.73) THEN IF (MYR.GE.73) THEN AYR = '19 ' ELSE AYR = '20 ' ENDIF IF (MYR.GT.9) THEN WRITE (AYR(3:4),9073) MYR 9073 FORMAT (I2) ELSE AYR(3:3) = '0' WRITE (AYR(4:4),9074) MYR 9074 FORMAT (I1) ENDIF IDDD = DDD IFFF = FFF C C CONVERT UNITS C IF (IHTU.EQ.'f') THEN JELEV = (3.2808399 * ELEV) + 0.5 IF (IYEAR.LT.1982) THEN ! INPUT IS HALF-YARD IF (IWZ.NE.99) THEN XWZ = 1.5 * IWZ ENDIF IF (ISWZ.NE.99) THEN XSWZ = 1.5 * ISWZ ENDIF ENDIF IF (IYEAR.GE.1982) THEN ! INPUT IS HALF-METER IF (IWZ.NE.99) THEN XWZ = 1.64 * IWZ ENDIF IF (ISWZ.NE.99) THEN XSWZ = 1.64 * ISWZ ENDIF ENDIF ELSE JELEV = ELEV IF (IYEAR.LT.1982) THEN ! INPUT IS HALF-YARD IF (IWZ.NE.99) THEN XWZ = 0.457 * IWZ ENDIF IF (ISWZ.NE.99) THEN XSWZ = 0.457 * ISWZ ENDIF ENDIF IF (IYEAR.GE.1982) THEN IF (IWZ.NE.99) THEN XWZ = 0.5 * IWZ ENDIF IF (ISWZ.NE.99) THEN XSWZ = 0.5 * ISWZ ENDIF ENDIF IF ( XPC6.NE.99.99) XPC6 = 2.54 * XPC6 IF (XPC24.NE.99.99) XPC24 = 2.54 * XPC24 IF ( XWEQ.NE.999.99) XWEQ = 2.54 * XWEQ ENDIF DEW = DPD IF (IDEW.EQ.'p') THEN IF (DPD.NE.HMSG.AND.AT.NE.TMSG) DEW = AT - DPD ENDIF IF (ITEMPU.EQ.'f') THEN IF ( AT.NE.TMSG) AT = (1.8 * AT) + 32. IF ( SST.NE.TMSG) SST = (1.8 * SST) + 32. IF ( DEW.NE.HMSG) DEW = (1.8 * DEW) + 32. ENDIF IF (IWINDU.EQ.'m') THEN IF (IFFF.NE.FMSG) THEN IFFF= (0.514791 * IFFF) + 0.5 ENDIF ENDIF IF (ADU.EQ.'KM') THEN JDIST = DIST ELSE JDIST = (0.621371 * DIST) + 0.5 ! CONVERT TO MILES ENDIF C C SLP, STP, DDD,FFF, AT, DEW C QSLP, QSTP, QDDFF, QAT, QDWX QUALITY FLAGS C IF (LONA.EQ.'E') XLON = 360.0 - XLON IF (TYPOUT.EQ.'d'.OR.TYPOUT.EQ.'b') THEN WRITE(LOUT,9800) ASTA, IRTYP, XLAT, XLON, JDIST, JELEV, IFH, 2 AYR, MMO, MDY, MHR, TIME, IDDD, QDDFF, IFFF, RANGE, 3 IPW, IW1, SLP, QSLP, STP, QSTP, AT, QAT, DEW, QDWX, 4 IN, INH, IC1, IBASE, IC2, IC3, XPC6, XPC24, 5 XSNO,IPCT,IWP,XWZ,ISWD,ISWP,XSWZ, 6 SST,ISPHG,ISPHD,ISDD,ISFF,XWEQ 9800 FORMAT(1X, 1 A6,1X,I3,1X,2F7.2,2I6,1X,I2,1X, 2 A4,3I3,F6.2,I5,1X,A,I4,F7.3, 3 I5,I3,F8.1,1X,A,F7.1,1X,A,F6.1,1X,A,F6.1,1X,A, 4 2I4,I5,I6,I4,I5,2F7.2, 5 F8.1,I5,I5,F7.1,I6,I5,2F7.1,I4,I5,I6,I5,F10.2) 6 ENDIF C C *** DONE PARSING THIS REPORT, GO GET THE NEXT ONE C GO TO 2000 C 990 CONTINUE IFILE = IFILE + 1 IF (IFILE.LT.2) GO TO 1900 991 CONTINUE IF (IPROC.EQ.'y') THEN IF (TYPOUT.EQ.'s'.OR.TYPOUT.EQ.'b') THEN C C DUMP LOCATION/STATION COUNTERS C NUMLLK = 0 NUMREP = 0 WRITE (LOUT,9991) LONA 9991 FORMAT (/,1X,9('##########'),'##', F //,1X,'ADP73: LOCATION / STATION COUNTS', F /, ' ', F ' NAME SHOWN IN USAF DICTIONARY (DS900.0)', F /, ' LON(',A,') LAT STATION TYPE REPORTS', F ' (FIRST OF PERHAPS A FEW)') DO 994 LONK = 1, 3601 DO 993 LATK = 1, 1801 XLON = (LONK - 1) / 10. IF (LONA.EQ.'E') THEN XLON = 360. - XLON ENDIF XLAT = (LATK - 901) / 10. DO 992 LLK = 1, 5 IF (LOCK(LLK,LATK,LONK).EQ.0) GO TO 992 IF (LLK.EQ.1) THEN NUMLLK = NUMLLK + 1 ENDIF STATID(1:5) = LOCI(LLK,LATK,LONK)(1:5) CALL USAFDIC (STATID,NAMEDIC) WRITE (LOUT,9992) XLON, XLAT, LOCI(LLK,LATK,LONK)(1:6), W LOCT(LLK,LATK,LONK), W LOCK(LLK,LATK,LONK), W NAMEDIC(1:26) 9992 FORMAT (F6.1,2X,F6.1,3X,A6,2X,I3,2X,I5,4X,A26) NUMREP = NUMREP + LOCK(LLK,LATK,LONK) 992 CONTINUE 993 CONTINUE 994 CONTINUE WRITE (LOUT,9994) NUMLLK, NUMREP 9994 FORMAT (//1X,'ADP73: FOUND A TOTAL OF ',I6,' STATION', F ' LOCATIONS AND ',I9,' REPORTS', F /1X,' STATIONS CAN GO IN AND OUT OF SERVICE,', F ' RELOCATE, OR TRANSMIT FAULTY INFORMATION', F /1X,' IF NO NAMES APPEAR ABOVE, VERIFY THAT', F ' YOU PROVIDED DICTIONARY FILE usafdict') ENDIF WRITE (LOUT,9997) IREC, IST 9997 FORMAT (//1X,'ADP73: STOP- IREC, IST',I9,', ',I2,' END OF FILE') WRITE (*,*) ' ' WRITE (*,9998) FNAMO 9998 FORMAT (/1X,'ADP73: NOW EXAMINE THE OUTPUT FILE ',A) WRITE (*,*) ' ' ELSE WRITE (LOUT,9999) IPROC 9999 FORMAT (1X,'ADP73: ',A,'NOT RUN') ENDIF CLOSE (LOUT) CLOSE (IUN) STOP END BLOCK DATA ADPBLK C C BLOCK DATA FOR READ ROUTINES FOR NCEP/NMC ADP DATA 1973 AND LATER C PARAMETER (MX=300) CHARACTER*8 QSHO, D08, A08, M08 COMMON / ARRAYS / P(MX), Z(MX), T(MX), H(MX), D(MX), F(MX), A C(MX), QSHO(MX), D08(MX), A08(MX), M08(MX), IC08(MX), R PMSG, ZMSG, TMSG, HMSG, DMSG, FMSG, RMSG C C P PRESSURE IN MB C Z GEOPOTENTIAL IN METERS C T TEMPERATURE IN DEGREES C AS PRINTED (IN TENTHS OF DEGREES AS PACKED) C H DEWPOINT DEPRESSION IN DEGREES C AS PRINTED (IN TENTHS OF DEGREES AS PACKED) C D WIND DIRECTION IN DEGREES C F WIND SPEED IN KNOTS C Q SET OF QUALITY MARKS (SEE NCEP/NMC OFFICE NOTE 29) C FOR P,Z,T,H,W(WIND) C DATA PMSG, ZMSG, TMSG, HMSG, DMSG, FMSG, RMSG / P 9999.9, 99999., 999.9, 99.9, 999., 999., -9.999/ C C LEAVE THE 10000 ALONE, EVEN THOUGH IT IS BIGGER THAN THE ORIGINAL C 6440 LOGICAL RECORD SIZE C CHARACTER NBF*10000 COMMON / ADPB / NBF COMMON / ADPC / LOGREC, NU, NA, LTHR, LOUT, idump, irep, ireplim C CHARACTER*8 EOREP, EOREC, XS, WASH, EOFIL COMMON / ADP / EOREP, EOREC, XS, WASH, EOFIL C PARAMETER (JX=21) COMMON / PRESS / PM(JX) C C REAL*8 TIME, XLAT, XLON, ELEV CHARACTER*16 IDATSHO CHARACTER*8 IDSTYP, IDTPRT, ASTA C COMMON / CRDADP / IDATSHO, IDSTYP, IDTPRT, ASTA, XLAT, XLON, 2 ELEV, IFH, IRTYP, INSTYP, IRC, IYR, IMO, IDY, IHR, TIME, TIME08 C DATA PM / 1000., 925., 850., 700., 500., 400., 300., 250., P 200., 150., 100., 70., 50., 30., 20., 10., M 7., 5., 3., 2., 1./ C DATA LOGREC / 6440 / C DATA EOREP /'END REPO'/ DATA EOREC /'END RECO'/ DATA XS /'XXXXXXXX'/ DATA WASH /'WASHINGT'/ DATA EOFIL /'ENDOF FI'/ C END SUBROUTINE RDADP(IUN,ISTAT,IREC,IREP) C C RDADP UNPACKS HEADER BLOCK IDS AND REPORT IDS FROM C THE DATA IN THE INPUT FILE C C LEAVE THE 10000 ALONE, EVEN THOUGH IT IS BIGGER THAN THE ORIGINAL C 6440 LOGICAL RECORD SIZE C PARAMETER (NDIM=10000,LIM=NDIM/8) CHARACTER NBF*10000 COMMON / ADPB / NBF COMMON / ADPC / LOGREC, NU, NA, LTHR, LOUT, idump, jrep, ireplim C CHARACTER*8 EOREP, EOREC, XS, WASH, EOFIL COMMON / ADP / EOREP, EOREC, XS, WASH, EOFIL C C C C REAL*8 TIME, XLAT, XLON, ELEV CHARACTER*16 IDATSHO CHARACTER*8 IDSTYP, IDTPRT, ASTA COMMON / CRDADP / IDATSHO, IDSTYP, IDTPRT, ASTA, XLAT, XLON, 2 ELEV, IFH, IRTYP, INSTYP, IRC, IYR, IMO, IDY, IHR, TIME, TIME08 C CHARACTER*1 QSLP, QSTP, QDDFF, QAT, QDWX C CHARACTER*8 IDSAVE COMMON / SAVE / IDSAVE, IYRSV, IMOSV, IDYSV, IHRSV C CHARACTER*1 IC25, IC26, IC27 C C SAVE C if (idump.ne.0.and.irep.le.ireplim) then write (lout,8999) irec, irep, nu, na, lthr, iyr 8999 format (/1x,'RDADP TOP: irec, irep, nu, na, lthr, iyr', f 5i10,i10) endif NU = NU + LTHR IF (NU.LT.NA) GO TO 10 5 CONTINUE C C CALL RDTAPE(IUN,1,0,NBF,LIM) C CALL IOWAIT(IUN,IST,IWDS) C IF(IST.NE.0) GO TO 90 C IST = 1 IREC = IREC + 1 READ (IUN,8001,END=90) NBF 8001 FORMAT (A) C C HOW DO I GET THE ACTUAL NUMBER OF CHARACTERS READ HERE? C IWDS = LOGREC / 8 IST = 0 NU = 1 NA = 8 * IWDS IF (NBF(21:28).NE.WASH) GO TO 10 IREP = 0 ! RESET REPORT COUNT FOR NEW DATE / TYPE C C PRINT HEADER RECORD FOR DIAGNOSTICS C if (idump.ne.0.and.irep.le.ireplim) then write (lout,800) irec, nbf(1:120) 800 format (/1x,'RDADP: HEADER irec =',i5,' nbf(1:120)', f /,1X,'# 1 2 3 4 5', f ' 6 7 8 9 10', f ' 11 12', f /,1X,' 12345678901234567890123456789012345678901234567890', f '12345678901234567890123456789012345678901234567890', f '12345678901234567890', f /,1X,'#',A120,'#') endif C C GET DATE AND DATASET TYPE FROM HEADER RECORD C READ (NBF(1:16),8008) IHRSV, IYRSV, IMOSV, IDYSV, IDSAVE(1:6) 8008 FORMAT (I4,I2,I2,I2,A) GO TO 5 10 CONTINUE IHR = IHRSV ! CALLING PROGRAM MAY IYR = IYRSV ! REWRITE THESE IMO = IMOSV ! VALUES, SO RESTORE IDY = IDYSV ! THEM WITH THE SAVED IDSTYP(1:6) = IDSAVE(1:6) ! VALUES C if (idump.ne.0.and.irep.le.ireplim) then C C ***** SELECT ON FILE TYPE C IF (IDTPRT(1:3).NE.'all'.AND.IDSTYP(1:6).NE.IDTPRT(1:6)) 2 GO TO 5 ENDIF C IF(NBF(NU:NU+9).EQ.'ENDOF FILE') GO TO 5 IF(NBF(NU:NU+9).EQ.'END RECORD') GO TO 5 IF(NBF(NU:NU+9).EQ.'XXXXXXXXXX') GO TO 5 C C GET ID FOR CURRENT REPORT C C 2 IC25, IC26, IC27, IRTYP, ELEV, INSTYP, LTH READ (NBF(NU:NU+39),8010,ERR=80) XLAT, XLON, ASTA(1:6), TIME, 2 IC25, IC26, IC27, IRTYP, ELEV, IFH, LTH 8010 FORMAT(F5.2,F5.2,A6,F4.2,4X,3A1,I3,F5.0,I2,I3) C LTHR = LTH * 10 C IF (idump.NE.0) THEN WRITE (LOUT,9021) IREC, NU, LOGREC, LTHR 9021 FORMAT (/,1X,9('##########'),'##', F //,1X,'REPORT DECODE FROM RECORD', F I6,', STARTING BYTE',I5,' OF ',I5,', LENGTH',I5) WRITE (LOUT,9022) IREC, NU, W NBF(NU :NU+ 119), NBF(NU+ 120:NU+ 239), W NBF(NU+ 240:NU+ 359), NBF(NU+ 360:NU+ 479), W NBF(NU+ 480:NU+ 599), NBF(NU+ 600:NU+ 719), W NBF(NU+ 720:NU+ 839), NBF(NU+ 840:NU+ 959), W NBF(NU+ 960:NU+1079), NBF(NU+1080:NU+1199) 9022 FORMAT (/1X,'RDADP: DUMP RECORD IREC=',I5,', NU=',I5, F /,1X,'# 1 2 3 4 5', F ' 6 7 8 9 10', F ' 11 12', F /,1X,' 12345678901234567890123456789012345678901234567890', F '12345678901234567890123456789012345678901234567890', F '12345678901234567890', F /,1X,'NBF(1:960)- ', F /,1X,'#',A120,'# 120', /,1X,'#',A120,'# 240', F /,1X,'#',A120,'# 360', /,1X,'#',A120,'# 480', F /,1X,'#',A120,'# 600', /,1X,'#',A120,'# 720', F /,1X,'#',A120,'# 840', /,1X,'#',A120,'# 960', F /,1X,'#',A120,'# 1080', /,1X,'#',A120,'# 1200') ENDIF ISTAT = 0 IF (NU+LTHR.GT.LOGREC) GO TO 5 IF(LTHR.GT.40) RETURN C C C C C C C NYRMO = 100*IYR + IMO JHR = (IHR + 50) / 100 IDATE = 10000*NYRMO + IDY*100 + JHR ! HEADER TIME C C C C C C C C C C C C C 80 CONTINUE WRITE (LOUT,9080) IREC, IREP, NU, NBF(NU:NU+119) 9080 FORMAT (/1X,'RDADP: READ ERROR AT IREC=',I5,', IREP=',I5, F ', NU=',I5, F /,1X,'# 1 2 3 4 5', F ' 6 7 8 9 10', F ' 11 12', F /,1X,' 12345678901234567890123456789012345678901234567890', F '12345678901234567890123456789012345678901234567890', F '12345678901234567890', F /,1X,'NBF(1:120)- ', F /,1X,'#',A120,'#') GO TO 5 90 CONTINUE ISTAT = IST RETURN END SUBROUTINE SADP51(N51,SLP,STP,DDD,FFF,AT,DPD,ATMX,ATMN, 2 QSLP,QSTP,QDDFF,QAT,QDWX,IVV,IPW,IW1,IN,INH,IC1,IZCB, 3 IC2,IC3,ICPT,IPT) C C DECODE PARAMETERS FROM CAT 51 DATA, ALL ARGMENTS ARE OUTPUT. C N51 = 0 MEANS NO CAT 51 DATA IN THIS REPORT. C N51 = -1 MEANS ERROR IN DECODE OF THE DATA C CHARACTER NBF*10000,NMSG*60 DATA NMSG/'9999999999999999999999999999999999999999999999999999999 299999'/ COMMON / ADPB / NBF COMMON / ADPC / LOGREC, NU, NA, LTHR, LOUT, idump, irep, ireplim CHARACTER*1 QSLP, QSTP, QDDFF, QAT, QDWX C SAVE C NTU = NU + 40 N51 = 0 C 5 CONTINUE C C LOOK FOR CATEGORY 51 C IF(NBF(NTU:NTU+9).EQ.'END REPORT') GO TO 90 READ(NBF(NTU:NTU+9),'(I2,I3,I2,I3)',ERR=95)NCC,NTN,NENT,NCCC IF(NTN.LE.0) GO TO 95 IF(NCC.EQ.51) GO TO 20 NTU = NU + 10 * (NTN-1) GO TO 5 C C 20 CONTINUE C C DECODE CATEGORY 51 C NTU = NTU + 10 READ(NBF(NTU:NTU+59),1002,ERR=95)SLP,STP,DDD,FFF,AT,DPD,ATMX,ATMN, 2 QSLP,QSTP,QDDFF,QAT,QDWX,IVV,IPW,IW1,IN,INH,IC1, 3 IZCB,IC2,IC3,ICPT,IPT 1002 FORMAT(F5.1,F5.1,2F3.0,F4.1,F3.1,2F4.1,5A1,2I3,7I2,I1,I3) N51 = N51 + 1 RETURN 90 CONTINUE READ(NMSG,1002,ERR=95) SLP,STP,DDD,FFF,AT,DPD,ATMX,ATMN, 2 QSLP,QSTP,QDDFF,QAT,QDWX,IVV,IPW,IW1,IN,INH,IC1, 3 IZCB,IC2,IC3,ICPT,IPT RETURN 95 CONTINUE PRINT 1003,NBF(NTU:NTU+59) 1003 FORMAT(' DECODE ERROR IN CAT51 ',A60) N51 = -1 RETURN END SUBROUTINE SADP52(N52,XPC6,XSNO,XPC24,IPCT,IWP,IWZ,ISWD,ISWP, 2 ISWZ,SST,ISPHG,ISPHD,ISDD,ISFF,XWEQ) C C DECODE PARAMETERS FROM CAT 52 DATA, ALL ARGMENTS ARE OUTPUT. C N52 = 0 MEANS NO CAT 52 DATA IN THIS REPORT. C N52 = -1 MEANS ERROR IN DECODE OF THE DATA C CHARACTER NBF*10000,NMSG*40 DATA NMSG/'9999999999999999999999999999999999999999'/ COMMON / ADPB / NBF COMMON / ADPC / LOGREC, NU, NA, LTHR, LOUT, idump, irep, ireplim C SAVE C NTU = NU + 40 N52 = 0 C 5 CONTINUE C C LOOK FOR CATEGORY 52 C IF(NBF(NTU:NTU+9).EQ.'END REPORT') GO TO 90 READ(NBF(NTU:NTU+9),'(I2,I3,I2,I3)',ERR=95)NCC,NTN,NENT,NCCC IF(NTN.LE.0) GO TO 95 IF(NCC.EQ.52) GO TO 20 NTU = NU + 10 * (NTN-1) GO TO 5 C C 20 CONTINUE C C DECODE CATEGORY 52 C NTU = NTU + 10 READ(NBF(NTU:NTU+39),1002,ERR=95)XPC6,XSNO,XPC24,IPCT,IWP,IWZ, 2 ISWD,ISWP,ISWZ,SST,ISPHG,ISPHD,ISDD,ISFF,XWEQ C 1002 FORMAT(F4.2,F3.0,F4.2,I1,5I2,F4.1,2I2,I1,I2,F7.2) N52 = NENT C N52 = N52 + 1 RETURN 90 CONTINUE READ(NMSG,1002,ERR=95)XPC6,XSNO,XPC24,IPCT,IWP,IWZ, 2 ISWD,ISWP,ISWZ,SST,ISPHG,ISPHD,ISDD,ISFF,XWEQ RETURN 95 CONTINUE PRINT 1003,NBF(NTU:NTU+39) 1003 FORMAT(' DECODE ERROR IN CAT52 ',A40) N52 = -1 RETURN END SUBROUTINE SADP08(NADD,N08,MAXLEV) CHARACTER NADD(MAXLEV)*(*) CHARACTER NBF*10000,NMSG*40 DATA NMSG/'9999999999999999999999999999999999999999'/ COMMON / ADPB / NBF COMMON / ADPC / LOGREC, NU, NA, LTHR, LOUT, idump, irep, ireplim C SAVE C NTU = NU + 40 N08 = 0 NLV = 0 2 CONTINUE C C LOOK FOR CATEGORY 8 C IF(NBF(NTU:NTU+9).EQ.'END REPORT') GO TO 90 READ(NBF(NTU:NTU+9),'(I2,I3,I2,I3)',ERR=95)NCC,NTN,NENT,NCCC IF(NTN.LE.0) GO TO 95 IF(NCC.EQ. 8) GO TO 3 NTU = NU + 10 * (NTN-1) GO TO 2 C 3 CONTINUE 10 CONTINUE C C DECODE CATEGORY 08, PARTIALLY. C C FROM NCEP'S FINAL VERSION OF ON124: C C NO. OF PARAMETER UNIT C CHARACTERS C 5 DATA GIVEN BY SPECIFICATION VARIABLE C IN TABLE SM.8A* C 3 FORM OF DATA CODE FIGURE FROM C TABLE SM.8A C 1 INDICATOR FOR SPECIFICATION CHARACTER FROM C TABLE SM.8B C 1 INDICATOR FOR FORM CHARACTER FROM C TABLE SM.8C C C * - VALUE SET "MISSING" (99999) INDICATES TRANSMITTED AS MISSING. C C A USEFUL EXAMPLE WOULD BE PRECIPITATION DATA THAT APPEARS WHEN C THE FORM IS "085" - TABLE SM.8A SHOWS: C C PRECIPITATION DURING PAST HOUR .... 0RRRR (SEE TABLE SM.8A.1 FOR RRRR). C WHICH SAYS: C C RRRR = PRECIPITATION IN INCHES TIMES ONE-HUNDRED. C C WE LEAVE IT TO THE USER TO DEVELOP THE CODE DO DEAL WITH SPECIFIC C NEEDS - THERE ARE TOO MANY POSSIBILITIES, ALL SUBJECT TO CHANGE, C FOR US TO DEVELOP ALL THE NECESSARY SOFTWARE. C NLV = NENT IF (NLV .LE. MAXLEV) GO TO 12 PRINT 1001,NLV C 1001 FORMAT('0TOO MANY LEVELS IN SADP08',I10) NLV = MAXLEV 12 CONTINUE DO 20 I = 1,NLV NTU = NTU + 10 READ(NBF(NTU:NTU+9),1002,ERR=95)NADD(I) 1002 FORMAT(A10) 20 CONTINUE 90 CONTINUE N08 = NLV RETURN 95 CONTINUE PRINT 1003,NBF(NTU:NTU+9) 1003 FORMAT(' DECODE ERROR IN CAT08 ',A10) N08 = -1 RETURN END SUBROUTINE DADJUST (IYR,IMO,IDY,IHR,TIME,JYR,JMO,JDY,JHR) C C ADJUST THE REPORT DATE (WHICH COMES FROM THE SYNOPTIC DATE) C SO THAT IT AGREES WITH THE REPORT TIME C C THE RECOMPUTED REPORT DATE WILL BE RETURNED IN THE J VARIABLES C C REPORT TIMES AT 00Z OFTEN DO NOT MATCH THE SYNOPTIC TIME, AND MAY ALSO C CORRESPOND TO THE PREVIOUS OR FOLLOWING DATE, RELATIVE TO THE C SYNOPTIC TIME. EXAMPLES (ALL UTC, ALSO KNOWN AS Z): C C SYNOPTIC REPORT ACTUAL REPORT C DATE/TIME TIME DATE/TIME C (YYMMDDHHHH) HH.HH (YYMMDDHH.HH) C 0003010000 23.03 00022923.03 C 0012311800 02.04 01010102.04 C C SAVE C JYR = IYR JMO = IMO JDY = IDY JHR = IHR C C NEED LHR TO BE IN HUNDREDTHS C LHR = 100.* TIME C C WHEN ADJUSTING THE REPORT DATE, WE NEED TO TEST FOR +/- 12 HOURS C AROUND THE SYNOPTIC HOUR, AND WE MUST MAKE THE TESTS WORK SO C AS TO CONFORM TO THE FACT THAT 0000 (SOMETIMES 2400) BELONGS C TO THE SAME DAY AS 0001. C IADJDY = 0 IF (IHR.EQ. 0.AND.LHR.GE.1200) IADJDY = -1 IF (IHR.EQ. 300.AND.LHR.GE.1500) IADJDY = -1 IF (IHR.EQ. 600.AND.LHR.GE.1800) IADJDY = -1 IF (IHR.EQ. 900.AND.LHR.GE.2100) IADJDY = -1 C IF (IHR.EQ.1200.AND.LHR.GE. 0) IADJDY = 0 ! WILL ALWAYS BE SAME DAY... IF (IHR.EQ.1500.AND.LHR.LT. 300) IADJDY = 1 IF (IHR.EQ.1800.AND.LHR.LT. 600) IADJDY = 1 IF (IHR.EQ.2100.AND.LHR.LT. 900) IADJDY = 1 C IF (IADJDY.NE.0) THEN JDY = JDY + IADJDY ! ADJUST DAY AS NEEDED IF (IADJDY.EQ.-1) THEN IF (JDY.LT.1) THEN JMO = JMO - 1 IF (JMO.LT.1) THEN JMO = 12 JYR = JYR - 1 IF (JYR.LT.0) THEN JYR = 99 ENDIF ENDIF JDY = 30 IF (JMO.EQ.2) THEN JDY = 28 IF (MOD(JYR,4).EQ.0) JDY = 29 ENDIF IF (JMO.EQ. 1.OR.JMO.EQ. 3.OR.JMO.EQ. 5.OR.JMO.EQ. 7 I .OR.JMO.EQ. 8.OR.JMO.EQ.10.OR.JMO.EQ.12) JDY = 31 ENDIF ELSE KDY = 30 IF (JMO.EQ.2) THEN KDY = 28 IF (MOD(JYR,4).EQ.0) KDY = 29 ENDIF IF (JMO.EQ. 1.OR.JMO.EQ. 3.OR.JMO.EQ. 5.OR.JMO.EQ. 7 I .OR.JMO.EQ. 8.OR.JMO.EQ.10.OR.JMO.EQ.12) KDY = 31 IF (JDY.GT.KDY) THEN JDY = 1 JMO = JMO + 1 IF (JMO.GT.12) THEN JMO = 1 JYR = JYR + 1 IF (JYR.GT.99) THEN JYR = 0 ENDIF ENDIF ENDIF ENDIF ENDIF RETURN END SUBROUTINE LLDIST (XLAT,XLON,YLAT,YLON,DIST) c C COMPUTES DISTANCE (KM) BETWEEN TWO LATITUDE-LONGITUDE POINTS ALONG C A GREAT CIRCLE. C C FROM DENNIS JOSEPH - 2002JAN c DATA R, DRAD / 6371.2277, 0.0174533/ C SAVE C DLON = ABS(XLON - YLON) IF (DLON.GT.180.) DLON = 360. - DLON DL = DLON * DRAD XL = (XLAT + 90.) * DRAD YL = (YLAT + 90.) * DRAD DIST = R * ABS(ACOS(COS(XL)*COS(YL) + SIN(XL)*SIN(YL)*COS(DL))) RETURN END SUBROUTINE USAFDIC (STATID,NAMEDIC) C C LOOKUP STATION NAME IN USAF STATION DICTIONARY C CHARACTER*5 STATID CHARACTER*6 LOOKUP CHARACTER*8 FNAMI, FILE CHARACTER*32 FMT, FORM, STAT, STATUS CHARACTER ENTRY*256 CHARACTER NAMEDIC*26 C LOOKUP(01:05) = STATID(01:5) LOOKUP(06:06) = '0' NAMEDIC(01:26) = ' ' IUN = 99 FNAMI = 'usafdict' FMT = 'FORMATTED' STAT = 'OLD' OPEN (IUN,FILE=FNAMI,FORM=FMT,STATUS=STAT,ERR=99) 10 CONTINUE READ (IUN,9010,END=90) ENTRY 9010 FORMAT (A) IF (ENTRY(01:06).NE.LOOKUP(01:06)) GO TO 80 C C WMO NUMBER MATCH C NAMEDIC(01:20) = ENTRY(16:35) NAMEDIC(21:21) = ' ' NAMEDIC(22:26) = ENTRY(54:58) GO TO 90 80 CONTINUE IF (ENTRY(08:11).NE.LOOKUP(01:04)) GO TO 10 C C CALL SIGN MATCH C NAMEDIC(01:20) = ENTRY(16:35) NAMEDIC(21:21) = ' ' NAMEDIC(22:26) = ENTRY(54:58) 90 CONTINUE CLOSE (IUN) 99 CONTINUE RETURN END subroutine htcbase (icode,ibase,ihtu) c c htcbase decodes the height of cloud base of low clouds in c surface data (category 51), using the WMO Code table 1000 c shown in the NCAR/DSS FTP file: c c http://dss.ucar.edu/datasets/ds464.0/docs/format_on29_old c c the codes do not transform exactly, I chose a mid-range c value from the table c c Written by G. Walters - Jul 2000 c character*1 ihtu save ibase = 9999 if (ihtu.eq.'m') then c c meters c if (icode.eq. 0) ibase = 25 if (icode.eq. 1) ibase = 75 if (icode.eq. 2) ibase = 150 if (icode.eq. 3) ibase = 250 if (icode.eq. 4) ibase = 450 if (icode.eq. 5) ibase = 800 if (icode.eq. 6) ibase = 1250 if (icode.eq. 7) ibase = 1750 if (icode.eq. 8) ibase = 2250 if (icode.eq. 9) ibase = 2750 ! this is really >= 2500 else c c feet c if (icode.eq. 0) ibase = 75 if (icode.eq. 1) ibase = 225 if (icode.eq. 2) ibase = 450 if (icode.eq. 3) ibase = 800 if (icode.eq. 4) ibase = 1500 if (icode.eq. 5) ibase = 2750 if (icode.eq. 6) ibase = 4250 if (icode.eq. 7) ibase = 5750 if (icode.eq. 8) ibase = 7250 if (icode.eq. 9) ibase = 8750 ! this is really >= 8000 endif return end subroutine visdec(icode,range,avisu) c c visdec decodes the visibility data in the NMC/NCEP ADP c surface data (category 51), using the WMO Code table 4377 c shown in the NCAR/DSS FTP file: c c http://dss.ucar.edu/datasets/ds464.0/docs/format_on29_old c c given an integer icode, visdec returns a floating point range c in kilometers c c please note that some of codes do not transform exactly, c so I made some reasonable guesses... c for code 00, I used 0.05km (table says <0.1km) c for code 89, I used 75km (table says >70km) c c codes in the 90s appear to apply to ship observations, where c the observer does not have a series of landmarks at hand,and: c for code 90, I used 0.025m (table says <50m) c for code 99, I used 50km (table says >=50km) c c and apparently codes 51-55 are not used, so I used 9999.0 c c finally, the code table does not provide for missing data, c but the nmc convention appears to use 999. I transform c any icode < 0 or icode > 99 to -999.9 to indicate missing. c c Written by G. Walters - Jul 2000 c character avisu*2 dimension table(100,2) c c kilometers c data table(001,1), table(051,1) / 0.05, 5.0 / data table(002,1), table(052,1) / 0.1, 9999.0 / data table(003,1), table(053,1) / 0.2, 9999.0 / data table(004,1), table(054,1) / 0.3, 9999.0 / data table(005,1), table(055,1) / 0.4, 9999.0 / data table(006,1), table(056,1) / 0.5, 9999.0 / data table(007,1), table(057,1) / 0.6, 6.0 / data table(008,1), table(058,1) / 0.7, 7.0 / data table(009,1), table(059,1) / 0.8, 8.0 / data table(010,1), table(060,1) / 0.9, 9.0 / data table(011,1), table(061,1) / 1.0, 10.0 / data table(012,1), table(062,1) / 1.1, 11.0 / data table(013,1), table(063,1) / 1.2, 12.0 / data table(014,1), table(064,1) / 1.3, 13.0 / data table(015,1), table(065,1) / 1.4, 14.0 / data table(016,1), table(066,1) / 1.5, 15.0 / data table(017,1), table(067,1) / 1.6, 16.0 / data table(018,1), table(068,1) / 1.7, 17.0 / data table(019,1), table(069,1) / 1.8, 18.0 / data table(020,1), table(070,1) / 1.9, 19.0 / data table(021,1), table(071,1) / 2.0, 20.0 / data table(022,1), table(072,1) / 2.1, 21.0 / data table(023,1), table(073,1) / 2.2, 22.0 / data table(024,1), table(074,1) / 2.3, 23.0 / data table(025,1), table(075,1) / 2.4, 24.0 / data table(026,1), table(076,1) / 2.5, 25.0 / data table(027,1), table(077,1) / 2.6, 26.0 / data table(028,1), table(078,1) / 2.7, 27.0 / data table(029,1), table(079,1) / 2.8, 28.0 / data table(030,1), table(080,1) / 2.9, 29.0 / data table(031,1), table(081,1) / 3.0, 30.0 / data table(032,1), table(082,1) / 3.1, 35.0 / data table(033,1), table(083,1) / 3.2, 40.0 / data table(034,1), table(084,1) / 3.3, 45.0 / data table(035,1), table(085,1) / 3.4, 50.0 / data table(036,1), table(086,1) / 3.5, 55.0 / data table(037,1), table(087,1) / 3.6, 60.0 / data table(038,1), table(088,1) / 3.7, 65.0 / data table(039,1), table(089,1) / 3.8, 70.0 / data table(040,1), table(090,1) / 3.9, 75.0 / data table(041,1), table(091,1) / 4.0, 0.025 / data table(042,1), table(092,1) / 4.1, 0.05 / data table(043,1), table(093,1) / 4.2, 0.2 / data table(044,1), table(094,1) / 4.3, 0.5 / data table(045,1), table(095,1) / 4.4, 1.0 / data table(046,1), table(096,1) / 4.5, 2.0 / data table(047,1), table(097,1) / 4.6, 4.0 / data table(048,1), table(098,1) / 4.7, 10.0 / data table(049,1), table(099,1) / 4.8, 20.0 / data table(050,1), table(100,1) / 4.9, 50.0 / c c miles c data table(001,2), table(051,2) / 0.031, 3.125 / data table(002,2), table(052,2) / 0.063, 9999.0 / data table(003,2), table(053,2) / 0.125, 9999.0 / data table(004,2), table(054,2) / 0.188, 9999.0 / data table(005,2), table(055,2) / 0.25, 9999.0 / data table(006,2), table(056,2) / 0.313, 9999.0 / data table(007,2), table(057,2) / 0.375, 3.75 / data table(008,2), table(058,2) / 0.438, 4.375 / data table(009,2), table(059,2) / 0.5, 5.0 / data table(010,2), table(060,2) / 0.563, 5.625 / data table(011,2), table(061,2) / 0.625, 6.25 / data table(012,2), table(062,2) / 0.688, 6.875 / data table(013,2), table(063,2) / 0.75, 7.5 / data table(014,2), table(064,2) / 0.813, 8.125 / data table(015,2), table(065,2) / 0.875, 8.75 / data table(016,2), table(066,2) / 0.938, 9.375 / data table(017,2), table(067,2) / 1.0, 10.0 / data table(018,2), table(068,2) / 1.063, 10.625 / data table(019,2), table(069,2) / 1.125, 11.25 / data table(020,2), table(070,2) / 1.188, 11.875 / data table(021,2), table(071,2) / 1.25, 12.5 / data table(022,2), table(072,2) / 1.313, 13.125 / data table(023,2), table(073,2) / 1.375, 13.75 / data table(024,2), table(074,2) / 1.438, 14.125 / data table(025,2), table(075,2) / 1.5, 15.0 / data table(026,2), table(076,2) / 1.563, 15.625 / data table(027,2), table(077,2) / 1.625, 16.25 / data table(028,2), table(078,2) / 1.688, 16.875 / data table(029,2), table(079,2) / 1.75, 17.5 / data table(030,2), table(080,2) / 1.813, 18.125 / data table(031,2), table(081,2) / 1.875, 18.75 / data table(032,2), table(082,2) / 1.938, 21.875 / data table(033,2), table(083,2) / 2.0, 25.0 / data table(034,2), table(084,2) / 2.063, 28.125 / data table(035,2), table(085,2) / 2.125, 31.25 / data table(036,2), table(086,2) / 2.188, 34.375 / data table(037,2), table(087,2) / 2.25, 37.5 / data table(038,2), table(088,2) / 2.313, 40.625 / data table(039,2), table(089,2) / 2.375, 43.75 / data table(040,2), table(090,2) / 2.438, 46.875 / data table(041,2), table(091,2) / 2.5, 0.015 / data table(042,2), table(092,2) / 2.563, 0.031 / data table(043,2), table(093,2) / 2.625, 0.125 / data table(044,2), table(094,2) / 2.688, 0.313 / data table(045,2), table(095,2) / 2.75, 0.625 / data table(046,2), table(096,2) / 2.813, 1.25 / data table(047,2), table(097,2) / 2.875, 2.5 / data table(048,2), table(098,2) / 2.938, 6.25 / data table(049,2), table(099,2) / 3.0, 12.5 / data table(050,2), table(100,2) / 3.063, 31.25 / save ivisu = 1 if (avisu.eq.'MI') ivisu = 2 if (icode.ge.0.and.icode.le.99) then range = table(icode+1,ivisu) else range = -9.999 endif return end c c c Code Table 3 (WMO Code 4377) c Symbol VV = Horizontal Visibility c c -------------------------------------- -------------------------------------- c Code | Statute | | | | Code | Statute | | c Figure| Miles | Yards |Kilometers| |Figure| Miles | Yards |Kilometers c -------------------------------------- -------------------------------------- c 00 |Less than|Less than|Less than | | 50 | 3-1/8 | 5,500 | 5.0 c | 1/16 | 110 | 0.1 | | 51 |Not spec.| | c 01 | 1/16 | 110 | 0.1 | | 52 |Not spec.| | c 02 | 1/8 | 220 | 0.2 | | 53 |Not spec.| | c 03 | 3/16 | 330 | 0.3 | | 54 |Not spec.| | c 04 | 1/4 | 440 | 0.4 | | 55 |Not spec.| | c 05 | 5/16 | 550 | 0.5 | | 56 | 3-3/4 | 6,600 | 6 c 06 | 3/8 | 660 | 0.6 | | 57 | 4-3/8 | 7,700 | 7 c 07 | 7/16 | 770 | 0.7 | | 58 | 5 | etc | 8 c 08 | 1/2 | 880 | 0.8 | | 59 | 5-5/8 | | 9 c 09 | 9/16 | 990 | 0.9 | | 60 | 6-1/4 | | 10 c 10 | 5/8 | 1,100 | 1.0 | | 61 | 6-7/8 | | 11 c 11 | 11/16 | 1,210 | 1.1 | | 62 | 7-1/2 | | 12 c 12 | 3/4 | 1,320 | 1.2 | | 63 | 8-1/8 | | 13 c 13 | 13/16 | 1,430 | 1.3 | | 64 | 8-3/4 | | 14 c 14 | 7/8 | 1,540 | 1.4 | | 65 | 9-3/8 | | 15 c 15 | 15/16 | 1,650 | 1.5 | | 66 | 10 | | 16 c 16 | 1 | 1.760 | 1.6 | | 67 | 10-5/8 | | 17 c 17 | 1-1/16 | 1,870 | 1.7 | | 68 | 11-1/4 | | 18 c 18 | 1-1/8 | 1,980 | 1.8 | | 69 | 11-7/8 | | 19 c 19 | 1-3/16 | 2,090 | 1.9 | | 70 | 12-1/2 | | 20 c 20 | 1-1/4 | 2,200 | 2.0 | | 71 | 13-1/8 | | 21 c 21 | 1-5/16 | 2,310 | 2.1 | | 72 | 13-3/4 | | 22 c 22 | 1-3/8 | 2,420 | 2.2 | | 73 | 14-3/8 | | 23 c 23 | 1-7/16 | 2,530 | 2.3 | | 74 | 15 | | 24 c 24 | 1-1/2 | 2,640 | 2.4 | | 75 | 15-5/8 | | 25 c 25 | 1-9/16 | 2,750 | 2.5 | | 76 | 16-1/4 | | 26 c 26 | 1-5/8 | 2,860 | 2.6 | | 77 | 16-7/8 | | 27 c 27 | 1-11/16 | 2,970 | 2.7 | | 78 | 17-1/2 | | 28 c 28 | 1-3/4 | 3,080 | 2.8 | | 79 | 18-1/8 | | 29 c 29 | 1-13/16 | 3,190 | 2.9 | | 80 | 18-3/4 | | 30 c 30 | 1-7/8 | 3,300 | 3.0 | | 81 | 21-7/8 | | 35 c 31 | 1-15/16 | 3,410 | 3.1 | | 82 | 25 | | 40 c 32 | 2 | 3,520 | 3.2 | | 83 | 28-1/8 | | 45 c 33 | 2-1/16 | 3,630 | 3.3 | | 84 | 31-1/4 | | 50 c 34 | 2-1/8 | 3,740 | 3.4 | | 85 | 34-3/8 | | 55 c 35 | 2-3/16 | 3,850 | 3.5 | | 86 | 37-1/2 | | 60 c 36 | 2-1/4 | 3,960 | 3.6 | | 87 | 40-5/8 | | 65 c 37 | 2-5/16 | 4,070 | 3.7 | | 88 | 43-3/4 | | 70 c 38 | 2-3/8 | 4,180 | 3.8 | | 89 |> 43-3/4 | |> 70 c 39 | 2-7/16 | 4,290 | 3.9 | | 90 | | < 55 | < 50 m. c 40 | 2-1/2 | 4,400 | 4.0 | | 91 | | 55 | 50 m. c 41 | 2-9/16 | 4,510 | 4.1 | | 92 | 1/8 | 220 | 200 m. c 42 | 2-5/8 | 4,620 | 4.2 | | 93 | 5/16 | 550 | 500 m. c 43 | 2-11/16 | 4,730 | 4.3 | | 94 | 5/8 | 1,100 | 1 km. c 44 | 2-3/4 | 4,840 | 4.4 | | 95 | 1-1/4 | 2,200 | 2 c 45 | 2-13/16 | 4,950 | 4.5 | | 96 | 2-1/2 | 4,400 | 4 c 46 | 2-7/8 | 5,060 | 4.6 | | 97 | 6-1/4 | | 10 c 47 | 2-15/16 | 5,170 | 4.7 | | 98 | 12-1/2 | | 20 c 48 | 3 | 5,280 | 4.8 | | 99 | 31-1/4 | | 50 c 49 | 3-1/16 | 5,390 | 4.9 | | | or more| | or more c -------------------------------------- -------------------------------------- c 9/14/73 29 Rev 2