cat > p.f <<\EOR
C=============================================================================C
C Comprehensive Ocean-Atmosphere Data Set (COADS):   Fortran 77 Program+Shell C
C Filename:level: rdmstg2:01C                                     14 May 1998 C
C Function: Read/print: Mon. Summary Trimmed Groups (MSTG2)  Author: S.Lubker C
C=============================================================================C
C Software documentation for the (modifiable) example program {rdmstg} and for
C the (invariant) user-interface routines {getrpt,b2lola}:
C
C As provided {rdmstg}:  (a) Prints the program name and level, and FILE (up to
C 80 characters supplied by the user from standard input).  (b) Reads a summary
C "report" (from UNIT=1) via an unformatted direct-access read (report in this
C context refers not to an individual marine report, but to a logical record).
C (c) Unpacks the GROUP (integer) so as to pass to {getrpt} (in the next step)
C unpacking criteria (FUNITS and FBASE) appropriate to that group.  (d) Unpacks
C header fields and the matrix of 4 variables x 8 statistics (as defined in
C <mstg>) into FTRUE via {getrpt}.  (e) Through an EQUIVALENCE to FTRUE, blank
C COMMON variables YEAR, MONTH, B2, B10, GRP, and CK provide named (floating-
C point) access to the INDXCK (i.e., 6) header fields, and FTRUE2 provides
C access to the data in matrix form.  A PARAMETER statement relates the
C abbreviation for each statistic (S3,...,Y) to an FTRUE2 array location; this
C facilitates usage such as FM = FTRUE2(1,M) to obtain the floating-point mean
C value from the first variable within the group.  Note that FMISS is used to
C represent missing data.  (f) The header fields and data matrix are printed
C out according to FORMAT, including variable and statistic headings as defined
C in <mstg>, as appropriate for the GROUP.  (g) The program iterates (to step
C b) reading summary records until an end-of-file (EOF) is encountered.
C Caution: IMPLICIT INTEGER(A-E,G-Z) is used; users may need to explicitly type
C additional variables when modifying this program.
C
C The following optional features are initially deactivated in the Fortran
C code; they may be activated by changing the appropriate Fortran comment
C lines to executable statements, i.e., remove the letter "C" from column 1:
C (a) The call to {b2lola} can be activated to return the E longitude (BLO)
C and latitude (BLA; degrees +N, -S) of the lower-left (SW) corner of 2-degree
C box B2.  (b) The test for NREC greater than 50 can be activated to stop
C before reading/printing the entire file.
C
C External libraries: None.
C Machine dependencies:  None known.
C For more information: See <soft_info> (electronic document).
C-----------------------------------------------------------------------3456789
      PROGRAM RDMSTG
      IMPLICIT INTEGER(A-E,G-Z)
C
      DATA UNIT/1/,FMISS/-9999./
C
      CHARACTER RPT*48
C
      CHARACTER FORMAT*640
      PARAMETER(NUMBER=38)
      COMMON /MSTG2/FUNITS(NUMBER,3:8),FBASE(NUMBER,3:8),BITS(NUMBER)
     +,OFFSET(NUMBER),FORMAT(3:8),RPTID,INDXCK
C
      DIMENSION CODED(NUMBER),FTRUE(NUMBER)
      PARAMETER(S3=1,M=2,N=3,E=4,D=5,H=6,X=7,Y=8)
      REAL YEAR,MONTH,B2,B10,GRP,CK,BLO,BLA
      COMMON YEAR,MONTH,B2,B10,GRP,CK,FTRUE2(4,Y)
      EQUIVALENCE(FTRUE,YEAR)
C
      CHARACTER FILE*80
C
      READ(*,'(A)')FILE
      PRINT '(A)',' RDMSTG.01C < '//FILE
C
C OPEN TO READ BINARY DATA (MACHINE-DEPENDENT MODIFICATIONS MAY BE NEEDED)
      OPEN(UNIT,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=LEN(RPT))
C INITIALIZE NUMBER OF RECORDS READ
      NREC=0
C
C READ REPORT (MACHINE-DEPENDENT MODIFICATIONS MAY BE NEEDED)
  100 READ(UNIT,REC=NREC+1,IOSTAT=EOF)RPT
C EOF OF ZERO INDICATES A SUCCESSFUL READ
      IF(EOF.NE.0)GOTO 900
C INCREMENT NUMBER OF RECORDS READ
      NREC=NREC+1
C
C UNPACK REPORT AND CONVERT CODED TO TRUE VALUES
      GROUP=MOD(ICHAR(RPT(7:7)),16)
      CALL GETRPT(RPT,CODED,FTRUE,FMISS
     +,FUNITS(1,GROUP),FBASE(1,GROUP),BITS,OFFSET,NUMBER,RPTID,INDXCK)
C      CALL B2LOLA(B2,BLO,BLA)
C
C PRINT REPORT
      PRINT FORMAT(GROUP),(FTRUE(I),I=1,INDXCK)
     +,((FTRUE2(I,J),J=S3,Y),I=1,4)
C
C STOP AFTER SEVERAL REPORTS HAVE BEEN READ
C      IF(NREC.GE.50)STOP 'REMOVE STOP TO READ ALL REPORTS'
      GOTO 100
C
C END OF FILE IF EOF IS NEGATIVE ELSE AN ERROR
  900 PRINT *,'REPORTS ',NREC,', EOF ',EOF
      END
C=============================================================================C
C WARNING:  Code beyond this point should not require any modification.       C
C=============================================================================C
C-----------------------------------------------------------------------3456789
      BLOCK DATA BDMSTG
      IMPLICIT INTEGER(A-E,G-Z)
C
      CHARACTER FORMAT*640
      PARAMETER(NUMBER=38)
      COMMON /MSTG2/FUNITS(NUMBER,3:8),FBASE(NUMBER,3:8),BITS(NUMBER)
     +,OFFSET(NUMBER),FORMAT(3:8),RPTID,INDXCK
C
      DATA (FUNITS(I,3),I=1,NUMBER)
     +/1. ,1. ,1. ,1. ,1. ,1.
     3 ,.01 ,.01 ,.01 ,.1
     M ,.01 ,.01 ,.01 ,.1
     N ,1. ,1. ,1. ,1.
     E ,.01 ,.01 ,.01 ,.1
     D ,2. ,2. ,2. ,2.
     H ,.1 ,.1 ,.1 ,.1
     X ,.2 ,.2 ,.2 ,.2
     Y ,.2 ,.2 ,.2 ,.2/
C
      DATA (FUNITS(I,4),I=1,NUMBER)
     +/1. ,1. ,1. ,1. ,1. ,1.
     3 ,.01 ,.01 ,.01 ,.01
     M ,.01 ,.01 ,.01 ,.01
     N ,1. ,1. ,1. ,1.
     E ,.01 ,.01 ,.01 ,.01
     D ,2. ,2. ,2. ,2.
     H ,.1 ,.1 ,.1 ,.1
     X ,.2 ,.2 ,.2 ,.2
     Y ,.2 ,.2 ,.2 ,.2/
C
      DATA (FUNITS(I,5),I=1,NUMBER)
     +/1. ,1. ,1. ,1. ,1. ,1.
     3 ,.1 ,.1 ,.1 ,.1
     M ,.1 ,.1 ,.1 ,.1
     N ,1. ,1. ,1. ,1.
     E ,.1 ,.1 ,.1 ,.1
     D ,2. ,2. ,2. ,2.
     H ,.1 ,.1 ,.1 ,.1
     X ,.2 ,.2 ,.2 ,.2
     Y ,.2 ,.2 ,.2 ,.2/
C
      DATA (FUNITS(I,6),I=1,NUMBER)
     +/1. ,1. ,1. ,1. ,1. ,1.
     3 ,.01 ,.1 ,.01 ,.1
     M ,.01 ,.1 ,.01 ,.1
     N ,1. ,1. ,1. ,1.
     E ,.01 ,.1 ,.01 ,.1
     D ,2. ,2. ,2. ,2.
     H ,.1 ,.1 ,.1 ,.1
     X ,.2 ,.2 ,.2 ,.2
     Y ,.2 ,.2 ,.2 ,.2/
C
      DATA (FUNITS(I,7),I=1,NUMBER)
     +/1. ,1. ,1. ,1. ,1. ,1.
     3 ,.1 ,.1 ,.1 ,.1
     M ,.1 ,.1 ,.1 ,.1
     N ,1. ,1. ,1. ,1.
     E ,.1 ,.1 ,.1 ,.1
     D ,2. ,2. ,2. ,2.
     H ,.1 ,.1 ,.1 ,.1
     X ,.2 ,.2 ,.2 ,.2
     Y ,.2 ,.2 ,.2 ,.2/
C
      DATA (FUNITS(I,8),I=1,NUMBER)
     +/1. ,1. ,1. ,1. ,1. ,1.
     3 ,.01 ,.01 ,.1 ,.1
     M ,.01 ,.01 ,.1 ,.1
     N ,1. ,1. ,1. ,1.
     E ,.01 ,.01 ,.1 ,.1
     D ,2. ,2. ,2. ,2.
     H ,.1 ,.1 ,.1 ,.1
     X ,.2 ,.2 ,.2 ,.2
     Y ,.2 ,.2 ,.2 ,.2/
C
      DATA (FBASE(I,3),I=1,NUMBER)
     +/1799. ,0. ,0. ,0. ,0. ,0.
     3 ,-501. ,-8801. ,-1. ,-1.
     M ,-501. ,-8801. ,-1. ,-1.
     N ,0. ,0. ,0. ,0.
     E ,-1. ,-1. ,-1. ,-1.
     D ,0. ,0. ,0. ,0.
     H ,-1. ,-1. ,-1. ,-1.
     X ,-.5 ,-.5 ,-.5 ,-.5
     Y ,-.5 ,-.5 ,-.5 ,-.5/
C
      DATA (FBASE(I,4),I=1,NUMBER)
     +/1799. ,0. ,0. ,0. ,0. ,0.
     3 ,-1. ,-10221. ,-10221. ,86999.
     M ,-1. ,-10221. ,-10221. ,86999.
     N ,0. ,0. ,0. ,0.
     E ,-1. ,-1. ,-1. ,-1.
     D ,0. ,0. ,0. ,0.
     H ,-1. ,-1. ,-1. ,-1.
     X ,-.5 ,-.5 ,-.5 ,-.5
     Y ,-.5 ,-.5 ,-.5 ,-.5/
C
      DATA (FBASE(I,5),I=1,NUMBER)
     +/1799. ,0. ,0. ,0. ,0. ,0.
     3 ,-1. ,-1. ,-30001. ,-30001.
     M ,-1. ,-1. ,-30001. ,-30001.
     N ,0. ,0. ,0. ,0.
     E ,-1. ,-1. ,-1. ,-1.
     D ,0. ,0. ,0. ,0.
     H ,-1. ,-1. ,-1. ,-1.
     X ,-.5 ,-.5 ,-.5 ,-.5
     Y ,-.5 ,-.5 ,-.5 ,-.5/
C
      DATA (FBASE(I,6),I=1,NUMBER)
     +/1799. ,0. ,0. ,0. ,0. ,0.
     3 ,-6301. ,-10001. ,-4001. ,-10001.
     M ,-6301. ,-10001. ,-4001. ,-10001.
     N ,0. ,0. ,0. ,0.
     E ,-1. ,-1. ,-1. ,-1.
     D ,0. ,0. ,0. ,0.
     H ,-1. ,-1. ,-1. ,-1.
     X ,-.5 ,-.5 ,-.5 ,-.5
     Y ,-.5 ,-.5 ,-.5 ,-.5/
C
      DATA (FBASE(I,7),I=1,NUMBER)
     +/1799. ,0. ,0. ,0. ,0. ,0.
     3 ,-20001. ,-20001. ,-10001. ,-10001.
     M ,-20001. ,-20001. ,-10001. ,-10001.
     N ,0. ,0. ,0. ,0.
     E ,-1. ,-1. ,-1. ,-1.
     D ,0. ,0. ,0. ,0.
     H ,-1. ,-1. ,-1. ,-1.
     X ,-.5 ,-.5 ,-.5 ,-.5
     Y ,-.5 ,-.5 ,-.5 ,-.5/
C
      DATA (FBASE(I,8),I=1,NUMBER)
     +/1799. ,0. ,0. ,0. ,0. ,0.
     3 ,-501. ,-8801. ,-30001. ,-30001.
     M ,-501. ,-8801. ,-30001. ,-30001.
     N ,0. ,0. ,0. ,0.
     E ,-1. ,-1. ,-1. ,-1.
     D ,0. ,0. ,0. ,0.
     H ,-1. ,-1. ,-1. ,-1.
     X ,-.5 ,-.5 ,-.5 ,-.5
     Y ,-.5 ,-.5 ,-.5 ,-.5/
C
      DATA BITS
     +/8 ,4 ,14 ,10 ,4 ,8
     3 ,16 ,16 ,16 ,16
     M ,16 ,16 ,16 ,16
     N ,16 ,16 ,16 ,16
     E ,16 ,16 ,16 ,16
     D ,4 ,4 ,4 ,4
     H ,4 ,4 ,4 ,4
     X ,4 ,4 ,4 ,4
     Y ,4 ,4 ,4 ,4/
C
      DATA OFFSET
     +/16 ,24 ,28 ,42 ,52 ,56
     3 ,64 ,80 ,96 ,112
     M ,128 ,144 ,160 ,176
     N ,192 ,208 ,224 ,240
     E ,256 ,272 ,288 ,304
     D ,320 ,324 ,328 ,332
     H ,336 ,340 ,344 ,348
     X ,352 ,356 ,360 ,364
     Y ,368 ,372 ,376 ,380/
C
      DATA FORMAT(3)
     +/"(/' YEAR ',F5.0,' MONTH ',F3.0,' B2 ',F6.0
     +,' B10 ',F4.0,' GRP ',F3.0,' CK ',F6.0/
     +11X,6X,'S3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/
     +' S         ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +' A         ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +' Q         ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +' R         ',2F8.1,F8.0,F8.1,F8.0,3F8.1)"/
C
      DATA FORMAT(4)
     +/"(/' YEAR ',F5.0,' MONTH ',F3.0,' B2 ',F6.0
     +,' B10 ',F4.0,' GRP ',F3.0,' CK ',F6.0/
     +11X,6X,'S3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/
     +' W         ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +' U         ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +' V         ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +' P         ',2F8.2,F8.0,F8.2,F8.0,3F8.1)"/
C
      DATA FORMAT(5)
     +/"(/' YEAR ',F5.0,' MONTH ',F3.0,' B2 ',F6.0
     +,' B10 ',F4.0,' GRP ',F3.0,' CK ',F6.0/
     +11X,6X,'S3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/
     +' C         ',2F8.1,F8.0,F8.1,F8.0,3F8.1/
     +' R         ',2F8.1,F8.0,F8.1,F8.0,3F8.1/
     +' X=W*U     ',2F8.1,F8.0,F8.1,F8.0,3F8.1/
     +' Y=W*V     ',2F8.1,F8.0,F8.1,F8.0,3F8.1)"/
C
      DATA FORMAT(6)
     +/"(/' YEAR ',F5.0,' MONTH ',F3.0,' B2 ',F6.0
     +,' B10 ',F4.0,' GRP ',F3.0,' CK ',F6.0/
     +11X,6X,'S3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/
     +' D=S-A     ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +' E=(S-A)*W ',2F8.1,F8.0,F8.1,F8.0,3F8.1/
     +' F=QS-Q    ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +' G=(QS-Q)*W',2F8.1,F8.0,F8.1,F8.0,3F8.1)"/
C
      DATA FORMAT(7)
     +/"(/' YEAR ',F5.0,' MONTH ',F3.0,' B2 ',F6.0
     +,' B10 ',F4.0,' GRP ',F3.0,' CK ',F6.0/
     +11X,6X,'S3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/
     +' I=U*A     ',2F8.1,F8.0,F8.1,F8.0,3F8.1/
     +' J=V*A     ',2F8.1,F8.0,F8.1,F8.0,3F8.1/
     +' K=U*Q     ',2F8.1,F8.0,F8.1,F8.0,3F8.1/
     +' L=V*Q     ',2F8.1,F8.0,F8.1,F8.0,3F8.1)"/
C
      DATA FORMAT(8)
     +/"(/' YEAR ',F5.0,' MONTH ',F3.0,' B2 ',F6.0
     +,' B10 ',F4.0,' GRP ',F3.0,' CK ',F6.0/
     +11X,6X,'S3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/
     +' S         ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +' A         ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +' X=W*U     ',2F8.1,F8.0,F8.1,F8.0,3F8.1/
     +' Y=W*V     ',2F8.1,F8.0,F8.1,F8.0,3F8.1)"/
C
      DATA RPTID/2/ ,INDXCK/6/
      END
C-----------------------------------------------------------------------3456789
      SUBROUTINE GETRPT(RPT,CODED,FTRUE,FMISS
     +,FUNITS,FBASE,BITS,OFFSET,NUMBER,RPTID,INDXCK)
C     UNPACK REPORT AND CONVERT CODED TO TRUE VALUES
C
      IMPLICIT INTEGER(A-E,G-Z)
      CHARACTER*(*) RPT
      DIMENSION CODED(*),FTRUE(*),FUNITS(*),FBASE(*),BITS(*),OFFSET(*)
C
      IF(MOD(ICHAR(RPT(2:2)),16).NE.RPTID)STOP 'RPTID ERROR'
      CALL UNPACK(RPT,CODED)
      FTRUE(INDXCK)=CODED(INDXCK)
      CODED(INDXCK)=0
      DO 190 I=1,NUMBER
        IF(I.EQ.INDXCK)GOTO 190
        IF(CODED(I).EQ.0)THEN
          FTRUE(I)=FMISS
        ELSE
          FTRUE(I)=(CODED(I)+FBASE(I))*FUNITS(I)
          CODED(INDXCK)=CODED(INDXCK)+CODED(I)
        ENDIF
  190 CONTINUE
      CODED(INDXCK)=MOD(CODED(INDXCK),2**BITS(INDXCK)-1)
      IF(FTRUE(INDXCK).NE.CODED(INDXCK))STOP 'CHECKSUM ERROR'
      END
C-----------------------------------------------------------------------3456789
      SUBROUTINE UNPACK(RPT,CODED)
C     UNPACK REPORT
C
      IMPLICIT INTEGER(A-E,G-Z)
      CHARACTER*(*) RPT
      DIMENSION CODED(*)
C
      CODED(1)=ICHAR(RPT(3:3))
      CODED(2)=ICHAR(RPT(4:4))/16
      CODED(3)=(MOD(ICHAR(RPT(4:4)),16)*256+ICHAR(RPT(5:5)))*4
     ++ICHAR(RPT(6:6))/64
      CODED(4)=MOD(ICHAR(RPT(6:6)),64)*16+ICHAR(RPT(7:7))/16
      CODED(5)=MOD(ICHAR(RPT(7:7)),16)
      CODED(6)=ICHAR(RPT(8:8))
      CODED(7)=ICHAR(RPT(9:9))*256+ICHAR(RPT(10:10))
      CODED(8)=ICHAR(RPT(11:11))*256+ICHAR(RPT(12:12))
      CODED(9)=ICHAR(RPT(13:13))*256+ICHAR(RPT(14:14))
      CODED(10)=ICHAR(RPT(15:15))*256+ICHAR(RPT(16:16))
      CODED(11)=ICHAR(RPT(17:17))*256+ICHAR(RPT(18:18))
      CODED(12)=ICHAR(RPT(19:19))*256+ICHAR(RPT(20:20))
      CODED(13)=ICHAR(RPT(21:21))*256+ICHAR(RPT(22:22))
      CODED(14)=ICHAR(RPT(23:23))*256+ICHAR(RPT(24:24))
      CODED(15)=ICHAR(RPT(25:25))*256+ICHAR(RPT(26:26))
      CODED(16)=ICHAR(RPT(27:27))*256+ICHAR(RPT(28:28))
      CODED(17)=ICHAR(RPT(29:29))*256+ICHAR(RPT(30:30))
      CODED(18)=ICHAR(RPT(31:31))*256+ICHAR(RPT(32:32))
      CODED(19)=ICHAR(RPT(33:33))*256+ICHAR(RPT(34:34))
      CODED(20)=ICHAR(RPT(35:35))*256+ICHAR(RPT(36:36))
      CODED(21)=ICHAR(RPT(37:37))*256+ICHAR(RPT(38:38))
      CODED(22)=ICHAR(RPT(39:39))*256+ICHAR(RPT(40:40))
      CODED(23)=ICHAR(RPT(41:41))/16
      CODED(24)=MOD(ICHAR(RPT(41:41)),16)
      CODED(25)=ICHAR(RPT(42:42))/16
      CODED(26)=MOD(ICHAR(RPT(42:42)),16)
      CODED(27)=ICHAR(RPT(43:43))/16
      CODED(28)=MOD(ICHAR(RPT(43:43)),16)
      CODED(29)=ICHAR(RPT(44:44))/16
      CODED(30)=MOD(ICHAR(RPT(44:44)),16)
      CODED(31)=ICHAR(RPT(45:45))/16
      CODED(32)=MOD(ICHAR(RPT(45:45)),16)
      CODED(33)=ICHAR(RPT(46:46))/16
      CODED(34)=MOD(ICHAR(RPT(46:46)),16)
      CODED(35)=ICHAR(RPT(47:47))/16
      CODED(36)=MOD(ICHAR(RPT(47:47)),16)
      CODED(37)=ICHAR(RPT(48:48))/16
      CODED(38)=MOD(ICHAR(RPT(48:48)),16)
      END
C-----------------------------------------------------------------------3456789
      SUBROUTINE B2LOLA(B2,BLO,BLA)
C 2 DEG BOX WEST LON +E AND SOUTH LAT +N -S
      IMPLICIT REAL(A-Z)
C
      IF (NINT(B2).GE.2.AND.NINT(B2).LE.16201) THEN
        BLO = MOD(NINT(B2)-2,180)*2
        BLA = 88-(NINT(B2)-2)/180*2
      ELSE IF (NINT(B2).EQ.1) THEN
        BLO = 0
        BLA = 90
      ELSE IF (NINT(B2).EQ.16202) THEN
        BLO = 0
        BLA = -90
      ELSE
        PRINT *,'ERROR: B2 = ',B2
        STOP 'B2LOLA'
      ENDIF
      END
EOR
rm fort.1 a.out
ln -s $1 fort.1
f77 p.f
echo $1 `date` | a.out