# QSUB -s /bin/csh
# QSUB -q prem
# QSUB -lt 600

set echo     #echo actions within the script
ja           # start accounting
cd $TMPDIR    #change to a large capacity working directory

set homdir = pacific.scd.ucar.edu:/home/crestone1/worley/rje

#   specifiy MSS file name
cat > data5 << ENDDATA
/DSS/Y26388
ENDDATA

cat > rdgrp.f <<ENDPROG
      PROGRAM QQ22

C-----READ AND PRINT COADS MSTG2 GROUPS 1-8
c     Read Multi-file datasets on Cray computers
c     Note:
c     1) the number of records printed in control MAX in the parameter statement
c     2) the reading of the various Groups (1-8) is controlled by setting the
c        GROUP variable in the parameter statement
c     3) all MSTG data is returned to array FTRUE
C
      IMPLICIT INTEGER(A-E,G-Z)
C
      PARAMETER(MAX=2,RPTOFF=1,FMISS=-9999.,INDEXCK=6,BPR=384,ID=0
     +,BPW=64,DIM BUF=(1006*64-1)/BPW+1,DIM PK=(BPR-1)/BPW+1,DIM UN=38
     +,GROUP=3)
C
      COMMON /MSTG2/FUNITS(38),FBASE(38),BITS(38),OFFSET(38)
C
      DIMENSION BUF(DIM BUF),PK(DIM PK),UN(DIM UN),FTRUE(DIM UN)
C
C-----2 DIMENSIONAL FTRUE
      character fname*64
      DIMENSION FTRUE2(4,8)
      EQUIVALENCE (FTRUE(7),FTRUE2)
C
      DATA LEVEL/4H.01A/,BUF/DIM BUF*0/
c   
c     -----  ncar dependent stuff ---
c
      iunit=1

c     read input data file name from input script 
      read(5,'(a64)')fname
      call msread (ier,'coads',fname,' ',' ')
      open(iunit,file='coads',status='old',form='unformatted')

c     ---------------------------------

C
      CALL DATE(DTE)
      CALL TIME(TME)
      PRINT 1,LEVEL,DTE,TME
1     FORMAT('1QQ22',A4,2A9)
C
      nfile = 0
      CALL DATA(GROUP)
100   CALL GETRPT(1,FMISS,FUNITS,FBASE,BITS,OFFSET,INDEXCK,ID
     +,BPR,BPW,RPTOFF,BUF,DIM BUF,PK,DIM PK,UN,DIM UN,FTRUE,JEOF)
      IF(JEOF.NE.0)GOTO 500
      eofcnt = 0
C
      if(buf(2).le.max)then
       CALL WRMSTG2(FTRUE,GROUP)
      endif

      GOTO 100

500   eofcnt = eofcnt + 1
      if(eofcnt.ge.2)go to 900
      nfile = nfile + 1
      print*,' eof detected, file num. and records : ',nfile,' ',buf(2)
      do i=1,6
       buf(i)=0
      enddo
      go to 100 
C
900   print*,'end of dataset volume detected, end of processing'
      stop
      END
C=======================================================================
      SUBROUTINE WRMSTG2(FTRUE,GROUP)
      IMPLICIT INTEGER(A-E,G-Z)
      DIMENSION FTRUE(38)
      GOTO (1,2,3,4,5,6,7,8), GROUP
  1   ASSIGN 101 TO IFMT
      GOTO 100
  2   ASSIGN 102 TO IFMT
      GOTO 100
  3   ASSIGN 103 TO IFMT
      GOTO 100
  4   ASSIGN 104 TO IFMT
      GOTO 100
  5   ASSIGN 105 TO IFMT
      GOTO 100
  6   ASSIGN 106 TO IFMT
      GOTO 100
  7   ASSIGN 107 TO IFMT
      GOTO 100
  8   ASSIGN 108 TO IFMT
100   PRINT IFMT,(FTRUE(I),I=1,6)
     +,((FTRUE(6+(J-1)*4+I),J=1,8),I=1,4)
101   FORMAT(/' YEAR ',F5.0,' MONTH ',F3.0,' BOX2 ',F6.0
     +,' BOX10 ',F4.0,' GROUP ',F3.0,' CHECKSUM ',F6.0/
     +8X,'3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/
     +1X,'S',2F8.2,F8.0,F8.2,2F8.0,2F8.1/
     +1X,'A',2F8.2,F8.0,F8.2,2F8.0,2F8.1/
     +1X,'P',2F8.2,F8.0,F8.2,2F8.0,2F8.1/
     +1X,'Q',2F8.2,F8.0,F8.2,2F8.0,2F8.1)
102   FORMAT(/' YEAR ',F5.0,' MONTH ',F3.0,' BOX2 ',F6.0
     +,' BOX10 ',F4.0,' GROUP ',F3.0,' CHECKSUM ',F6.0/
     +8X,'3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/
     +1X,'W',2F8.2,F8.0,F8.2,2F8.0,2F8.1/
     +1X,'U',2F8.2,F8.0,F8.2,2F8.0,2F8.1/
     +1X,'V',2F8.2,F8.0,F8.2,2F8.0,2F8.1/
     +1X,'C',2F8.1,F8.0,F8.1,2F8.0,2F8.1)
103   FORMAT(/' YEAR ',F5.0,' MONTH ',F3.0,' BOX2 ',F6.0
     +,' BOX10 ',F4.0,' GROUP ',F3.0,' CHECKSUM ',F6.0/
     +9X,7X,'3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/
     +1X,'S       ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +1X,'A       ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +1X,'Q       ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +1X,'R       ',2F8.1,F8.0,F8.1,F8.0,3F8.1)
104   FORMAT(/' YEAR ',F5.0,' MONTH ',F3.0,' BOX2 ',F6.0
     +,' BOX10 ',F4.0,' GROUP ',F3.0,' CHECKSUM ',F6.0/
     +9X,7X,'3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/
     +1X,'W       ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +1X,'U       ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +1X,'V       ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +1X,'P       ',2F8.2,F8.0,F8.2,F8.0,3F8.1)
105   FORMAT(/' YEAR ',F5.0,' MONTH ',F3.0,' BOX2 ',F6.0
     +,' BOX10 ',F4.0,' GROUP ',F3.0,' CHECKSUM ',F6.0/
     +9X,7X,'3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/
     +1X,'C       ',2F8.1,F8.0,F8.1,F8.0,3F8.1/
     +1X,'R       ',2F8.1,F8.0,F8.1,F8.0,3F8.1/
     +1X,'W*U     ',2F8.1,F8.0,F8.1,F8.0,3F8.1/
     +1X,'W*V     ',2F8.1,F8.0,F8.1,F8.0,3F8.1)
106   FORMAT(/' YEAR ',F5.0,' MONTH ',F3.0,' BOX2 ',F6.0
     +,' BOX10 ',F4.0,' GROUP ',F3.0,' CHECKSUM ',F6.0/
     +9X,7X,'3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/
     +1X,'S-A     ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +1X,'(S-A)*W ',2F8.1,F8.0,F8.1,F8.0,3F8.1/
     +1X,'QS-Q    ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +1X,'(QS-Q)*W',2F8.1,F8.0,F8.1,F8.0,3F8.1)
107   FORMAT(/' YEAR ',F5.0,' MONTH ',F3.0,' BOX2 ',F6.0
     +,' BOX10 ',F4.0,' GROUP ',F3.0,' CHECKSUM ',F6.0/
     +9X,7X,'3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/
     +1X,'U*A     ',2F8.1,F8.0,F8.1,F8.0,3F8.1/
     +1X,'V*A     ',2F8.1,F8.0,F8.1,F8.0,3F8.1/
     +1X,'U*Q     ',2F8.1,F8.0,F8.1,F8.0,3F8.1/
     +1X,'V*Q     ',2F8.1,F8.0,F8.1,F8.0,3F8.1)
108   FORMAT(/' YEAR ',F5.0,' MONTH ',F3.0,' BOX2 ',F6.0
     +,' BOX10 ',F4.0,' GROUP ',F3.0,' CHECKSUM ',F6.0/
     +9X,7X,'3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/
     +1X,'S       ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +1X,'A       ',2F8.2,F8.0,F8.2,F8.0,3F8.1/
     +1X,'W*U     ',2F8.1,F8.0,F8.1,F8.0,3F8.1/
     +1X,'W*V     ',2F8.1,F8.0,F8.1,F8.0,3F8.1)
      END
C=======================================================================
      SUBROUTINE DATA(GROUP)
      IMPLICIT INTEGER(A-E,G-Z)
C
      COMMON /MSTG2/FUNITS(38),FBASE(38),BITS(38),OFFSET(38)
C
      DATA FUNITS/1.,1.,1.,1.,1.,1.
     + ,.01,.01,.1,.1
     + ,.01,.01,.1,.1
     + ,1.,1.,1.,1.
     + ,.01,.01,.1,.1
     + ,2.,2.,2.,2.
     + ,.1,.1,.1,.1
     + ,.2,.2,.2,.2
     + ,.2,.2,.2,.2/
C
      DATA FBASE/1799.,0.,0.,0.,0.,0.
     + ,-501.,-8801.,-30001.,-30001.
     + ,-501.,-8801.,-30001.,-30001.
     + ,0.,0.,0.,0.
     + ,-1.,-1.,-1.,-1.
     + ,0.,0.,0.,0.
     + ,-1.,-1.,-1.,-1.
     + ,-.5,-.5,-.5,-.5
     + ,-.5,-.5,-.5,-.5/
C
      DATA BITS/8,4,14,10,4,8
     + ,16,16,16,16
     + ,16,16,16,16
     + ,16,16,16,16
     + ,16,16,16,16
     + ,4,4,4,4
     + ,4,4,4,4
     + ,4,4,4,4
     + ,4,4,4,4/
C
      DATA OFFSET/16,24,28,42,52,56
     + ,64,80,96,112
     + ,128,144,160,176
     + ,192,208,224,240
     + ,256,272,288,304
     + ,320,324,328,332
     + ,336,340,344,348
     + ,352,356,360,364
     + ,368,372,376,380/
C
      GOTO (1,2,3,4,5,6,7,8), GROUP
C
  1   FUNITS(7)=.01
      FUNITS(8)=.01
      FUNITS(9)=.01
      FUNITS(10)=.01
      FUNITS(11)=.01
      FUNITS(12)=.01
      FUNITS(13)=.01
      FUNITS(14)=.01
      FUNITS(19)=.01
      FUNITS(20)=.01
      FUNITS(21)=.01
      FUNITS(22)=.01
      FUNITS(27)=2.
      FUNITS(28)=2.
      FUNITS(29)=2.
      FUNITS(30)=2.
      FBASE(7)=-501.
      FBASE(8)=-8801.
      FBASE(9)=86999.
      FBASE(10)=-1.
      FBASE(11)=-501.
      FBASE(12)=-8801.
      FBASE(13)=86999.
      FBASE(14)=-1.
      FBASE(27)=-.5
      FBASE(28)=-.5
      FBASE(29)=-.5
      FBASE(30)=-.5
      RETURN
C
  2   FUNITS(7)=.01
      FUNITS(8)=.01
      FUNITS(9)=.01
      FUNITS(10)=.1
      FUNITS(11)=.01
      FUNITS(12)=.01
      FUNITS(13)=.01
      FUNITS(14)=.1
      FUNITS(19)=.01
      FUNITS(20)=.01
      FUNITS(21)=.01
      FUNITS(22)=.1
      FUNITS(27)=2.
      FUNITS(28)=2.
      FUNITS(29)=2.
      FUNITS(30)=2.
      FBASE(7)=-1.
      FBASE(8)=-10221.
      FBASE(9)=-10221.
      FBASE(10)=-1.
      FBASE(11)=-1.
      FBASE(12)=-10221.
      FBASE(13)=-10221.
      FBASE(14)=-1.
      FBASE(27)=-.5
      FBASE(28)=-.5
      FBASE(29)=-.5
      FBASE(30)=-.5
      RETURN
C
  3   FUNITS(7)=.01
      FUNITS(8)=.01
      FUNITS(9)=.01
      FUNITS(10)=.1
      FUNITS(11)=.01
      FUNITS(12)=.01
      FUNITS(13)=.01
      FUNITS(14)=.1
      FUNITS(19)=.01
      FUNITS(20)=.01
      FUNITS(21)=.01
      FUNITS(22)=.1
      FBASE(7)=-501.
      FBASE(8)=-8801.
      FBASE(9)=-1.
      FBASE(10)=-1.
      FBASE(11)=-501.
      FBASE(12)=-8801.
      FBASE(13)=-1.
      FBASE(14)=-1.
      RETURN
C
  4   FUNITS(7)=.01
      FUNITS(8)=.01
      FUNITS(9)=.01
      FUNITS(10)=.01
      FUNITS(11)=.01
      FUNITS(12)=.01
      FUNITS(13)=.01
      FUNITS(14)=.01
      FUNITS(19)=.01
      FUNITS(20)=.01
      FUNITS(21)=.01
      FUNITS(22)=.01
      FBASE(7)=-1.
      FBASE(8)=-10221.
      FBASE(9)=-10221.
      FBASE(10)=86999.
      FBASE(11)=-1.
      FBASE(12)=-10221.
      FBASE(13)=-10221.
      FBASE(14)=86999.
      RETURN
C
  5   FUNITS(7)=.1
      FUNITS(8)=.1
      FUNITS(9)=.1
      FUNITS(10)=.1
      FUNITS(11)=.1
      FUNITS(12)=.1
      FUNITS(13)=.1
      FUNITS(14)=.1
      FUNITS(19)=.1
      FUNITS(20)=.1
      FUNITS(21)=.1
      FUNITS(22)=.1
      FBASE(7)=-1.
      FBASE(8)=-1.
      FBASE(9)=-30001.
      FBASE(10)=-30001.
      FBASE(11)=-1.
      FBASE(12)=-1.
      FBASE(13)=-30001.
      FBASE(14)=-30001.
      RETURN
C
  6   FUNITS(7)=.01
      FUNITS(8)=.1
      FUNITS(9)=.01
      FUNITS(10)=.1
      FUNITS(11)=.01
      FUNITS(12)=.1
      FUNITS(13)=.01
      FUNITS(14)=.1
      FUNITS(19)=.01
      FUNITS(20)=.1
      FUNITS(21)=.01
      FUNITS(22)=.1
      FBASE(7)=-6301.
      FBASE(8)=-10001.
      FBASE(9)=-4001.
      FBASE(10)=-10001.
      FBASE(11)=-6301.
      FBASE(12)=-10001.
      FBASE(13)=-4001.
      FBASE(14)=-10001.
      RETURN
C
  7   FUNITS(7)=.1
      FUNITS(8)=.1
      FUNITS(9)=.1
      FUNITS(10)=.1
      FUNITS(11)=.1
      FUNITS(12)=.1
      FUNITS(13)=.1
      FUNITS(14)=.1
      FUNITS(19)=.1
      FUNITS(20)=.1
      FUNITS(21)=.1
      FUNITS(22)=.1
      FBASE(7)=-20001.
      FBASE(8)=-20001.
      FBASE(9)=-10001.
      FBASE(10)=-10001.
      FBASE(11)=-20001.
      FBASE(12)=-20001.
      FBASE(13)=-10001.
      FBASE(14)=-10001.
8     RETURN
C
      END
C=======================================================================
      SUBROUTINE GETRPT(TAPE,FMISS,FUNITS,FBASE,BITS,OFFSET,INDEXCK,ID
     +,BPR,BPW,RPTOFF,BUF,DIM BUF,PK,DIM PK,UN,DIM UN,FTRUE,JEOF)
C
C-----RETURN FLOATING POINT VALUES IN FTRUE
C
C     INPUT
C         TAPE - RPTIN/RCDIN UNIT
C         FMISS - MISSING VALUE
C         FUNITS(DIM UN) - UNITS FOR UNCODING
C         FBASE(DIM UN) - BASE FOR UNCODING
C         BITS(DIM UN) - BITS FOR UNPACKING
C         OFFSET(DIM UN) - OFFSET FOR UNPACKING
C         INDEXCK - UN(INDEXCK) = CHECKSUM
C         ID - GROUP NUMBER FOR IDENTIFICATION CHECKSUM
C         BPR - BITS PER REPORT
C         BPW - BITS PER WORD
C         RPTOFF - 0=FALSE 1=TRUE
C     OUTPUT
C         BUF(DIM BUF) - RPTIN/RCDIN BUFFER
C         PK(DIM PK) - PACKED REPORT
C         UN(DIM UN) - UNPACKED REPORT
C         FTRUE(DIM UN) - TRUE VALUES
C         JEOF - 0=FALSE 1=TRUE
C
      IMPLICIT INTEGER(A-E,G-Z)
      DIMENSION FUNITS(DIM UN),FBASE(DIM UN),BITS(DIM UN),OFFSET(DIM UN)
     +,BUF(DIM BUF),PK(DIM PK),UN(DIM UN),FTRUE(DIM UN)
C
C-----RPTIN/RCDIN
      IF(RPTOFF.NE.0)GOTO 100
      CALL RPTIN(TAPE,BUF,PK,KWDS,1,DIM PK,JEOF)
      GOTO 110
100   CALL RCDIN(TAPE,BUF,DIM BUF,PK,DIM PK,BPR,BPW,JEOF)
110   IF(JEOF-1)200,900,800
C
C-----GBYTE AND CONVERT TO TRUE
200   CK=ID
      DO 230 I=1,DIM UN
      CALL GBYTE(PK(OFFSET(I)/BPW+1),UN(I),MOD(OFFSET(I),BPW),BITS(I))
      IF(I.EQ.INDEXCK)GOTO 210
      IF(UN(I).EQ.0)GOTO 220
      FTRUE(I)=(UN(I)+FBASE(I))*FUNITS(I)
      CK=CK+UN(I)
      GOTO 230
210   FTRUE(INDEXCK)=UN(INDEXCK)
      GOTO 230
220   FTRUE(I)=FMISS
230   CONTINUE
      IF(MOD(CK,2**BITS(INDEXCK)-1).EQ.UN(INDEXCK))RETURN
C
C-----ERROR
      PRINT *,' SUBROUTINE GETRPT  --  CHECKSUM ERROR, TAPE = ',TAPE
     +,', REPORT = ',BUF(2)
      PRINT *,' FTRUE = ',FTRUE
800   STOP
C
900   END
C=======================================================================
      SUBROUTINE RCDIN(TAPE,BUF,DIM BUF,RCD,DIM RCD,BPR,BPW,JEOF)
C
C-----RETURN ONE LOGICAL RECORD IN RCD
C
C     INPUT
C         TAPE - BUFFER IN UNIT
C         BPR - BITS PER RECORD
C         BPW - BITS PER WORD
C     OUTPUT
C         BUF(DIM BUF) - PHYSICAL RECORD
C         RCD(DIM RCD) - LOGICAL RECORD
C         JEOF - 0=FALSE 1=TRUE
C
C     BUF(1) = GBYTE OFFSET
C     BUF(2) = LOGICAL RECORD COUNT
C     BUF(3) = PHYSICAL RECORD COUNT
C     BUF(4) =
C     BUF(5) = BLOCK LENGTH IN BITS
C     BUF(6) =
C
      IMPLICIT INTEGER(A-E,G-Z)
      REAL UNIT
      DIMENSION BUF(DIM BUF),RCD(DIM RCD)
C
      IF(BUF(1)+BPR.LE.BUF(5))GOTO 200
C-----BUFFER IN
10    BUFFER IN(TAPE,1)(BUF(7),BUF(DIM BUF))
      JEOF=UNIT(TAPE)+1
      IF(JEOF-1)100,100,800
100   BUF(1)=0
      BUF(5)=LENGTH(TAPE)*BPW
      IF(JEOF.EQ.1)RETURN
      BUF(3)=BUF(3)+1
C
C-----GBYTE
200   CALL GBYTES
     +(BUF(6+BUF(1)/BPW+1) ,RCD ,MOD(BUF(1),BPW) ,BPW ,0 ,DIM RCD)
      IF(RCD(1).EQ.0.AND.RCD(2).EQ.0)GOTO 10
      BUF(1)=BUF(1)+BPR
      BUF(2)=BUF(2)+1
      RETURN
C
C-----ERROR
800   PRINT *,' SUBROUTINE RCDIN  --  BUFFER IN ERROR, TAPE = ',TAPE
     +,', BLOCK = ',BUF(3)+1
      STOP
      END
ENDPROG

   
#
#   compile, and link the program

cft77 rdgrp.f
segldr -L /lib,/usr/lib,/usr/local/lib -lmss,ncaro,ncarm -o rdgrp rdgrp.o

#   run the program, separate the job accounting information and 
#   job output by placing output in a seperate file

rdgrp <data5 >rdgrp_o

# rcp the output back to home machine 
rcp  rdgrp_o $homdir/.

ja -cst      # get accounting wrap up
echo "End of processing job."