PROGRAM RDTAPE C-FORTRAN 77 PROGRAM TO READ ARCHIVED CLOUD CLIMATOLOGICAL DATA FROM UNIT 1. C ARCHIVE CONTAINS 11 FILES WHICH CONTAIN 6 CLASSES OF DATA(SEE VARIABLE CLAS) C-THIS SAMPLE PROGRAM SELECTS THE FOLLOWING MAPS FOR OUTPUT ON DEFAULT UNIT: C CLASS (FILE-NUMBER OF MAPS) C 1 GRID BOX LAND FRACTION (1-4) C (LAND AND OCEAN MAPS ARE SEPARATE FOR THE FOLLOWING) C 2 LONG-TERM AVG TOTAL CLOUD FOR DJF (2-1, 6-2) C 3 LONG-TERM STRATUS CLOUD AMOUNT AND HEIGHT FOR DJF (3-2, 7-3) C 4 PHASE OF ANNUAL CYCLE IN TOTAL CLOUD (4-1, 8-1) C 4 PHASE OF DJF DIURNAL CYCLE FOR TOTAL CLOUD AND ST AMT (4-2, 8-2) C 5 TREND FOR TOTAL CLOUD AND ST AMT FOR DJF (5-2, 9-2) C2,3FGGE YEAR DJF TOTAL CLOUD, ST AMT, CL=6 AMT, CL=6 HEIGHT (10-8) C 6 CLOUD TYPE CONTINGENCIES P(ST=>NS) FOR DJF (11-2) C THE TOTAL NUMBER OF MAPS PRINTED IS 32. C ANY OTHER MAPS CAN BE GENERATED BY USER MODIFICATIONS OF PROGRAM. C-VARIABLES C ONLY DATA PARAMETERS USED ARE READ INTO ARRAYS, C OTHERS ARE READ INTO DUMMY VARIABLES. C THE FORMAT NUMBER(KFMT) OF THE HEADER RECORD IS DECODED C TO SELECT THE PROPER DATA CLASS (ICLAS=KFMT/10) AND TO C SELECT LABELS FOR MAP OUTPUT (JFMT=MOD(KFMT,10), LFMT DERIVED FROM JFMT). C-SUBROUTINE MAPG IS CALLED TO PLOT MAPS ON APPROPRIATE GRID SIZE C USING LAT,LON DATA CONTAINED IN FILE 1. C-LAT,LON DATA FROM FILE 1 ARE WRITTEN TO UNIT 2 FOR USE IN SUBROUTINE MAPG. C FILE 1 MUST THEREFORE BE READ FIRST AND LAT,LON DATA SAVED. C-INPUT VARIABLE NFRD (READ FROM DEFAULT UNIT) C SPECIFIES THE NUMBER OF CONSECUTIVE FILES TO BE READ. ON SOME COMPUTERS, C THE STATEMENT 'CLOSE(1)' (LINE 242) MUST BE REMOVED FOR NFRD>1. C-FILES MAY BE READ SINGLY AND IN ANY ORDER(AFTER FILE1). C NOTE-TIME REQUIREMENTS FOR SOME FILES ARE LARGE. AS WRITTEN, THIS C PROGRAM DOES NOT TERMINATE AFTER A DESIRED MAP IS PRINTED FROM A FILE. C-DATA RECORD LENGTH IS 24 CHAR FOR FILES 1-10 AND 56 FOR FILE 11. C DIMENSION MAP(7290), CLAT(7290),CLON(7290),FRL(7290) DIMENSION DAT(2134),N(2134),KB(2134) CHARACTER*1 Z CHARACTER*3 SN(0:16),TIM(0:2),TYP(22) CHARACTER*4 LOBS(0:1) CHARACTER*5 LO(2) CHARACTER*7 HLAB(0:1) CHARACTER*12 CLAS(6) CHARACTER*15 LAB(5) DATA LO, LOBS/' LAND','OCEAN', 'NRAW','NCOB'/ DATA Z,TIM/'Z',' ','ALL','DAY'/ DATA CLAS/' GRID DATA ',' TOTAL CLOUD',' CLOUD TYPES', D ' HARMONICS ',' INTERANNUAL',' CONTINGENCY'/ DATA LAB/'AMOUNT(PERCENT)',' FREQ (PERCENT)', D 'AMT WP(PERCENT)','HEIGHT (METERS)','HEIGHT (MET/10)'/ DATA HLAB/' ANNUAL','DIURNAL'/ DATA SN/'ANN','JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG', D 'SEP','OCT','NOV','DEC','DJF','MAM','JJA','SON'/ DATA TYP/' CI',' AS',' NS',' CU ',' ST ',' CB','CLR','FOG','TCA', D 'CL0','CL1','CL2','CL3','CL4','CL5','CL6','CL7','CL8','CL9', D ' ','LOW','MID'/ 6 FORMAT('1'/' MAP GROUP=',I4,2X,A5,I2,25X,A3,I5.0,' TIME=',A3, F ' CLOUD TYPE=',A3/' DATA CLASS=',A12) MBLANK=999999 NF=0 READ(*,*) NFRD C-------------------------------------------------HEADER C*READ MAP GROUP HEADER* 100 READ(1,1,END=900) MGRP,NBXS,KSZ,KLO,KYR,KSN,KTIM,KTYP,KFMT 1 FORMAT(2I4,2I2,I4,4I2) IF (KSN.GT.12) KSN= KSN-28 IF (KTIM.GE.0) THEN WRITE(TIM(0),'(I2.2,A1)') KTIM,Z KTIM=0 END IF KTIM= ABS(KTIM) ICLAS= KFMT/10 JFMT= MOD(KFMT,10) C-------------------------------------------------CLASS 1 IF (ICLAS.EQ.1) THEN C**FILE 1 GRID DATA** C BOX,CLAT,CLON,FRL,NLSTA 10 FORMAT(I4,F5.2,F5.2,F5.4,I5) READ(1,10) (KBX,CLAT(I),CLON(I),FRL(I),NLST, I=1,NBXS) WRITE(2) KSZ,CLAT,CLON DO 150 I= 1,NBXS 150 MAP(I)= FRL(I)*100. +.5 WRITE(*,16) MGRP,LO(1),KSZ,CLAS(ICLAS) 16 FORMAT('1'/' MAP GROUP=',I4,2X,A5,I2, F /' DATA CLASS=',A12,40X,'PERCENT LAND') CALL MAPG(MAP,KSZ) C-------------------------------------------------CLASS 2 ELSE IF (ICLAS.EQ.2) THEN C**FILES 2,6,10 TOTAL CLOUD** C BOX,NOBS,AMT, SD, NTP,IDY,NSN 20 FORMAT(I4, I6, F4.1,F4.1, I2, I2, I2) READ(1,20) (KB(I),N(I),DAT(I),SD,NTP,IDY,NSN, I=1,NBXS) C- C-SELECT MAPS TO BE PRINTED IF (KTIM.NE.1 .OR. KSN.NE.13) GOTO 100 IF (KYR.LT.2000 .AND. MGRP.LT.3429) GOTO 100 C- MINOB=100 IF (KYR.LT.2000) MINOB= 50 DO 240 I= 1,7290 240 MAP(I)= MBLANK DO 250 I= 1,NBXS IF (N(I).GE.MINOB .AND. DAT(I).GE.0.) THEN MAP(KB(I))= DAT(I) +.5 END IF 250 CONTINUE WRITE(*,6) MGRP,LO(KLO),KSZ,SN(KSN),KYR,TIM(KTIM),TYP(KTYP), W CLAS(ICLAS) WRITE(*,26) LAB(1),LOBS(JFMT),MINOB 26 FORMAT('+',49X,A15,' MIN ',A4,'=',I3) CALL MAPG(MAP,KSZ) C-------------------------------------------------CLASS 3 ELSE IF (ICLAS.EQ.3) THEN C**FILES 3,7,10 CLOUD TYPES (AMT OR HEIGHT)** C BOX,NOBS,AMT,FQ, AWP 30 FORMAT(I4,I6,F5.2,F5.2,F4.1) C BOX,NOBS,HGT,SD 35 FORMAT(I4,I6, F5.1,F5.1,4X) IF (JFMT.NE.5) THEN READ(1,30) (KB(I),N(I),DAT(I),FQ,AWP, I=1,NBXS) LFMT=1 ELSE READ(1,35) (KB(I),N(I),DAT(I),SD, I=1,NBXS) JFMT=0 LFMT=4 IF (KSZ.EQ.5) LFMT=5 END IF C- C-SELECT MAPS TO BE PRINTED IF (KTIM.EQ.0 .OR. KSN.NE.13) GOTO 100 IF (KYR.LT.2000 .AND. MGRP.LT.3429) GOTO 100 IF (KTYP.NE.5 .AND. KTYP.NE.16) GOTO 100 C- MINOB=100 IF (KLO.EQ.1.AND.LFMT.LT.4) MINOB=200 IF (KYR.LT.2000) THEN IF (MGRP.LE.889.OR.MGRP.GE.3585) MINOB= 50 IF (MGRP.GE.3429.AND.MGRP.LE.3584) MINOB=80 END IF DO 340 I= 1,7290 340 MAP(I)= MBLANK DO 350 I= 1,NBXS IF (N(I).GE.MINOB .AND. DAT(I).GE.0.) THEN MAP(KB(I))= DAT(I) +.5 IF (LFMT.EQ.5) MAP(KB(I))= DAT(I)/10. +.5 END IF 350 CONTINUE WRITE(*,6) MGRP,LO(KLO),KSZ,SN(KSN),KYR,TIM(KTIM),TYP(KTYP), W CLAS(ICLAS) WRITE(*,36) LAB(LFMT),LOBS(JFMT),MINOB 36 FORMAT('+',49X,A15,' MIN ',A4,'=',I3) CALL MAPG(MAP,KSZ) C-------------------------------------------------CLASS 4 ELSE IF (ICLAS.EQ.4) THEN C**FILES 4,8 HARMONICS** C BOX,PHASE,AMP,VAF, NT,AVG 40 FORMAT(I4,F5.2,F5.2,F4.1,I2,F4.1) READ(1,40) (KB(I),DAT(I),AMP,VAF,NT,AV, I=1,NBXS) C- C-SELECT MAPS TO BE PRINTED IF (KSN.NE.0 .AND. KSN.NE.13) GOTO 100 IF (KTYP.NE.9 .AND. KTYP.NE.5) GOTO 100 IF (JFMT.GT.1) GOTO 100 C- LFMT= MIN(1,JFMT) IF (JFMT.EQ.0) JFMT=1 DO 440 I= 1,7290 440 MAP(I)= MBLANK DO 450 I= 1,NBXS IF (DAT(I).GE.0.) THEN MAP(KB(I))= DAT(I) +.5 END IF 450 CONTINUE WRITE(*,6) MGRP,LO(KLO),KSZ,SN(KSN),KYR,TIM(KTIM),TYP(KTYP), W CLAS(ICLAS) WRITE(*,46) HLAB(LFMT),LAB(JFMT) 46 FORMAT('+',23X,A7,21X,'PHASE',12X,A15) CALL MAPG(MAP,KSZ) C-------------------------------------------------CLASS 5 ELSE IF (ICLAS.EQ.5) THEN C**FILES 5,9 INTERANNUAL** C BOX,NYRS,SPAN,IAV,TRND,UNC 50 FORMAT(I4, I2, I2, F5.2,F6.3,F5.3) READ(1,50) (KB(I),N(I),KSP,SD,DAT(I),UNC, I=1,NBXS) C- C-SELECT MAPS TO BE PRINTED IF (KSN.NE.13) GOTO 100 IF (KTYP.NE.9 .AND. KTYP.NE.5) GOTO 100 IF (JFMT.GT.1) GOTO 100 C- MINYR=6 IF (KLO.EQ.2) MINYR=19 DO 540 I= 1,7290 540 MAP(I)= MBLANK DO 550 I= 1,NBXS IF (N(I).GT.MINYR) THEN MAP(KB(I))= DAT(I) *10. +.5 IF (DAT(I).LT.0) MAP(KB(I))= DAT(I) *10. -.5 END IF 550 CONTINUE WRITE(*,6) MGRP,LO(KLO),KSZ,SN(KSN),KYR,TIM(KTIM),TYP(KTYP), W CLAS(ICLAS) WRITE(*,56) LAB(JFMT),MINYR 56 FORMAT('+',40X,'TREND',4X,A15,'/10YRS MINYRS>',I2) CALL MAPG(MAP,KSZ) C-------------------------------------------------CLASS 6 ELSE IF (ICLAS.EQ.6) THEN C**FILE 11 CONTINGENCY** C BOX,NOBS,NTY,FC, FQ, PCI, PAS, PNS, PCU, PST, PCB, PNO 60 FORMAT(I4,I6,I6,F4.1,F4.1,F4.1,F4.1,F4.1,F4.1,F4.1,F4.1,F4.1,4X) READ(1,60) (KB(I),NR,N(I),F,F,P,P,DAT(I),P,P,P,P, I=1,NBXS) C- C-SELECT MAPS TO BE PRINTED IF (KTYP.NE.5 .OR. KSN.NE.13) GOTO 100 C- MINOB=50 IF (KLO.EQ.1) MINOB= 200 DO 640 I= 1,7290 640 MAP(I)= MBLANK DO 650 I= 1,NBXS IF (N(I).GE.MINOB .AND. DAT(I).GE.0.) THEN MAP(KB(I))= DAT(I) +.5 END IF 650 CONTINUE WRITE(*,6) MGRP,LO(KLO),KSZ,SN(KSN),KYR,TIM(KTIM),TYP(KTYP), W CLAS(ICLAS) WRITE(*,66) LAB(2),MINOB 66 FORMAT('+',53X,A15,6X,'NS',9X,'MIN NRAW=',I3) CALL MAPG(MAP,KSZ) C------------------------------------------------- ELSE IF (ICLAS.GT.6) THEN WRITE(6,86) 86 FORMAT(' ERROR IN DATA') STOP 899 END IF GOTO 100 C------------------------------------------------- 900 CONTINUE NF= NF + 1 WRITE(*,96) NF 96 FORMAT(///1X,I3,' EOFS ENCOUNTERED') IF (NF.GE.NFRD .OR. ICLAS.EQ.6) STOP CLOSE(1) GOTO 100 END SUBROUTINE MAPG(IDAT,KSZ) C-PLOTS INTEGER DATA(IDAT) IN MAP FORMAT FOR 4 GRID SIZES(KSZ) C MAP POSITION IS SPECIFIED BY CLAT,CLON FOR GRID (ISZ=KSZ) READ FROM UNIT 2 C- KSZ NUM CHARACTERS PLOTTED/GRID BOX C 5 3 C 10 7 C 2 5 C 15 7 C-PLOTS BLANK FOR IDAT(I)=999999 DIMENSION IDAT(7290),CLAT(7290),CLON(7290) CHARACTER*7 MAP(72,144), BLANK BLANK= ' ' MBLANK= 999999 REWIND(2) DO 40 I= 1,4 IF (ISZ.EQ.KSZ) GOTO 45 READ(2) ISZ,CLAT,CLON 40 CONTINUE 45 DO 50 LA= 1,72 DO 50 LO= 1,144 50 MAP(LA,LO)= BLANK C IF (KSZ.EQ.5) THEN DO 100 I= 1,1820 LA= 1 + (CLAT(I)+90.)/KSZ LO= 1 + CLON(I)/KSZ IF (IDAT(I).NE.MBLANK) WRITE(MAP(LA,LO),'(I3)') IDAT(I) 100 CONTINUE MAP(1,36) = MAP(1,1) MAP(36,36)= MAP(36,1) MAP(1,1)= BLANK MAP(36,1)= BLANK WRITE(*,106) (I,I= -60,90,30) 106 FORMAT(/' LAT -90',6(15X,I3)/114X,'LON') DO 150 LO= 1,72 IF (MOD(LO-1,6).EQ.0) WRITE(*,116) LO/6 *30 116 FORMAT (114X,I3,'E') WRITE(*,126) (MAP(LA,LO), LA=1,36) 126 FORMAT(7X,36A3) 150 CONTINUE WRITE(*,156) 156 FORMAT(113X,'360E') C ELSE IF (KSZ.EQ.10) THEN DO 200 I= 1,230 LA= 1 + (CLAT(I)+90.)/KSZ LO= 1 + CLON(I)/20 IF (IDAT(I).NE.MBLANK) WRITE(MAP(LA,LO),'(I7)') IDAT(I) 200 CONTINUE MAP(1,9) = MAP(1,1) MAP(18,9)= MAP(18,1) MAP(1,1)= BLANK MAP(18,1)= BLANK WRITE(*,206) (I, I=90,360,90) 206 FORMAT(/' LON 0',33X,I2,28X,I3,29X,I3,25X,I3,'E'/' LAT'/' 90N') DO 250 LA= 18,1,-1 WRITE(*,216) (MAP(LA,LO), LO=1,18) 216 FORMAT(6X,18A7) WRITE(*,226) (LA-10)*10 226 FORMAT(1X,I4) 250 CONTINUE C ELSE IF (KSZ.EQ.2) THEN DO 300 I= 1,7290 LA= 1 + (CLAT(I)+90.)/2.5 LO= 1 + CLON(I)/2.5 IF (IDAT(I).NE.MBLANK) WRITE(MAP(LA,LO),'(I5)') IDAT(I) 300 CONTINUE MAP(1,72) = MAP(1,1) MAP(72,72)= MAP(72,1) MAP(1,1)= BLANK MAP(72,1)= BLANK WRITE(*,306) -90,(I,I= -75,-30,15) 306 FORMAT(/' LAT',I5,4(25X,I5)/127X,'LON') DO 350 LO= 1,144 IF (MOD(LO-1,12).EQ.0) WRITE(*,316) LO/12 *30 316 FORMAT (127X,I3,'E') WRITE(*,326) (MAP(LA,LO), LA=1,24) 326 FORMAT(8X,24A5) 350 CONTINUE WRITE(*,356) 356 FORMAT(127X,'360E') WRITE(*,306) -90,(I,I= -75,-30,15) WRITE(*,366) 366 FORMAT('1'//) WRITE(*,306) -30,(I,I= -15,30,15) DO 360 LO= 1,144 IF (MOD(LO-1,12).EQ.0) WRITE(*,316) LO/12 *30 WRITE(*,326) (MAP(LA,LO), LA=25,48) 360 CONTINUE WRITE(*,356) WRITE(*,306) -30,(I,I= -15,30,15) WRITE(*,366) WRITE(*,306) 30,(I,I= 45,90,15) DO 370 LO= 1,144 IF (MOD(LO-1,12).EQ.0) WRITE(*,316) LO/12 *30 WRITE(*,326) (MAP(LA,LO), LA=49,72) 370 CONTINUE WRITE(*,356) WRITE(*,306) 30,(I,I= 45,90,15) C ELSE IF (KSZ.EQ.15) THEN DO 400 I= 1,120 LA= (CLAT(I)+90.)/KSZ LO= 1 + CLON(I)/30 IF (IDAT(I).NE.MBLANK) WRITE(MAP(LA,LO),'(I7)') IDAT(I) 400 CONTINUE WRITE(*,406) (I, I=90,360,90) 406 FORMAT(/' LON 0',3X,4(24X,I3),'E'/' LAT'/' 80N') DO 450 LA= 10,1,-1 WRITE(*,416) (MAP(LA,LO), LO=1,12) 416 FORMAT(6X,12A9) LAT= (LA-6)*15 IF (LA.EQ.1) LAT= -70 WRITE(*,426) LAT 426 FORMAT(1X,I4) 450 CONTINUE ELSE WRITE(*,456) 456 FORMAT(' ILLEGAL GRID SIZE SPECIFIED') END IF RETURN END