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

set echo     #echo actions within the script

ja           # start accounting

#   change to working directory $TMPDIR

cd $TMPDIR

cat > rdgrp.f <<ENDPROG
      PROGRAM QQ22

C-----READ AND PRINT MSUG2 AND MSTG2 GROUPS 1-8
C
c     use direct access methods or read the data

      IMPLICIT INTEGER(A-E,G-Z)
C
      PARAMETER(MAX=10,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=4)
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,' ',' ')

c     convert the first file of a multi-file volume in COS block
c     format to a binary unix file
      istat = ishell('cossplit -m 1 coads')
      istat = ishell('cosconvert -b f001')
      istat = ishell('rm coads')
      istat = ishell('mv f001 coads')
  
c     open UNIX data file - direct access mode
c     each direct access will get one MSTG record

      open(unit=iunit,file='coads',
     *     form='unformatted', access='direct',recl=48)

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

C
      CALL DATE(DTE)
      CALL TIME(TME)
      PRINT 1,LEVEL,DTE,TME
1     FORMAT('1QQ22',A4,2A9)
C
      CALL DATA(GROUP)
100   CALL GETRPT(1,FMISS,FUNITS,FBASE,BITS,OFFSET,INDEXCK,ID
     +,BPR,BPW,BUF,DIM BUF,PK,DIM PK,UN,DIM UN,FTRUE,JEOF)
      IF(JEOF.NE.0)GOTO 900
C
c     print the first max records, and every 5000th record

      if(buf(2).lt.max.or.mod(buf(2),5000).eq.0)then
         print*,' record number : ',buf(2)
         CALL WRMSTG2(FTRUE,GROUP)
      endif

      go to 100
C
900   PRINT *,' REPORTS ',BUF(2),', EOF ',JEOF
      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(iunit,FMISS,FUNITS,FBASE,BITS,OFFSET,INDEXCK,ID
     +,BPR,BPW,BUF,dimbuf,PK,dimpk,UN,dimun,FTRUE,JEOF)

C
C-----RETURN FLOATING POINT VALUES IN FTRUE
C
C     INPUT
C         iunit - RCDIN UNIT
C         FMISS - MISSING VALUE
C         FUNITS(dimun) - UNITS FOR UNCODING
C         FBASE(dimun) - BASE FOR UNCODING
C         BITS(dimun) - BITS FOR UNPACKING
C         OFFSET(dimun) - 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     OUTPUT
C         BUF(dimbuf) - RCDIN BUFFER
C         PK(dimpk) - PACKED REPORT
C         UN(dimun) - UNPACKED REPORT
C         FTRUE(dimun) - TRUE VALUES
C         JEOF = end of file indicator, 0=no, -1=yes
C
      IMPLICIT INTEGER(A-E,G-Z)
      DIMENSION FUNITS(dimun),FBASE(dimun),BITS(dimun),OFFSET(dimun)
     +,BUF(dimbuf),PK(dimpk),UN(dimun),FTRUE(dimun)
C
       CALL RCDIN(iunit,BUF,dimbuf,PK,dimpk,BPR,BPW,JEOF)
      if(jeof.eq.-1)return
C
C-----GBYTE AND CONVERT TO TRUE
      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, unit = ',iunit
     +,', REPORT = ',BUF(2)
      PRINT *,' FTRUE = ',FTRUE
800   STOP
C
900   END
C=======================================================================
      SUBROUTINE RCDIN(iunit,BUF,dimbuf,RCD,dimrcd,BPR,BPW,JEOF)
C
C-----RETURN ONE LOGICAL RECORD IN RCD
C
C     INPUT
C         iunit - BUFFER IN UNIT
C         BPR - BITS PER RECORD
C         BPW - BITS PER WORD
C     OUTPUT
C         BUF(dimbuf) - PHYSICAL RECORD
C         RCD(dimrcd) - LOGICAL RECORD
C         JEOF = end of file indicator, 0=no, 1=yes
C
C     BUF(1) = gbytes offset, always 0 in this case
C     BUF(2) = record count
C     BUF(3) =
C     BUF(4) =
C     BUF(5) = record LENGTH IN BITS
C     BUF(6) =
C
      IMPLICIT INTEGER(A-E,G-Z)
      DIMENSION BUF(DIM BUF),RCD(DIM RCD)
      data irdata/1/
C
c     read from UNIX data file

c     use err= read option to detect end of file 
10    read(iunit,rec=irdata,err=900)(buf(i),i=7,12)
      irdata=irdata + 1

c
c     write the first part of the input record in hexidecimal
c           just to check the bytes
c
c      write(6,202)(buf(i),i=7,12)
c202   format(2z20)
c
      jeof=0
100   BUF(1)=0
      BUF(5)=384
      BUF(3)=BUF(3)+1

C-----GBYTE
      CALL GBYTES(BUF(6+1),RCD,0,BPW,0,dimrcd)
      BUF(2)=BUF(2)+1
      RETURN

c     end of file has been detected set jeof to -1

900   continue
      jeof = -1

      return
      END
      SUBROUTINE GBYTE (IN,IOUT,ISKIP,NBYTE)
      CALL GBYTES (IN,IOUT,ISKIP,NBYTE,0,1)
      RETURN
      END

      SUBROUTINE SBYTE (IOUT,IN,ISKIP,NBYTE)
      CALL SBYTES (IOUT,IN,ISKIP,NBYTE,0,1)
      RETURN
      END

      SUBROUTINE GBYTES (IN,IOUT,ISKIP,NBYTE,NSKIP,N)
C          Get bytes - unpack bits:  Extract arbitrary size values from a
C          packed bit string, right justifying each value in the unpacked
C          array.
      DIMENSION IN(*), IOUT(*)
C            IN    = packed array input
C            IO    = unpacked array output
C            ISKIP = initial number of bits to skip
C            NBYTE = number of bits to take
C            NSKIP = additional number of bits to skip on each iteration
C            N     = number of iterations
C************************************** MACHINE SPECIFIC CHANGES START HERE
C          Machine dependent information required:
C            LMWD   = Number of bits in a word on this machine
C            MASKS  = Set of word masks where the first element has only the
C                     right most bit set to 1, the second has the two, ...
C            LEFTSH = Shift left bits in word M to the by N bits
C            RGHTSH = Shift right
C            OR     = Logical OR (add) on this machine.
C            AND    = Logical AND (multiply) on this machine
C          This is for 64 bit Cray
      PARAMETER (LMWD=64)
      DIMENSION MASKS(LMWD)
      SAVE      MASKS
      DATA MASKS/Z'1',Z'3',Z'7',Z'F',Z'1F',Z'3F',Z'7F',Z'FF',
     2 Z'1FF',Z'3FF',Z'7FF',Z'FFF',Z'1FFF',Z'3FFF',Z'7FFF',Z'FFFF',
     3 Z'1FFFF',Z'3FFFF',Z'7FFFF',Z'FFFFF',Z'1FFFFF',Z'3FFFFF',
     4 Z'7FFFFF',Z'FFFFFF',Z'1FFFFFF',Z'3FFFFFF',Z'7FFFFFF',Z'FFFFFFF',
     5 Z'1FFFFFFF',Z'3FFFFFFF',Z'7FFFFFFF',Z'FFFFFFFF',
     6 Z'1FFFFFFFF',Z'3FFFFFFFF',Z'7FFFFFFFF',Z'FFFFFFFFF',
     7 Z'1FFFFFFFFF',Z'3FFFFFFFFF',Z'7FFFFFFFFF',Z'FFFFFFFFFF',
     8 Z'1FFFFFFFFFF',Z'3FFFFFFFFFF',Z'7FFFFFFFFFF',Z'FFFFFFFFFFF',
     9 Z'1FFFFFFFFFFF',Z'3FFFFFFFFFFF',Z'7FFFFFFFFFFF',Z'FFFFFFFFFFFF',
     A Z'1FFFFFFFFFFFF',Z'3FFFFFFFFFFFF',
     B Z'7FFFFFFFFFFFF',Z'FFFFFFFFFFFFF',
     A Z'1FFFFFFFFFFFFF',Z'3FFFFFFFFFFFFF',
     B Z'7FFFFFFFFFFFFF',Z'FFFFFFFFFFFFFF',
     A Z'1FFFFFFFFFFFFFF',Z'3FFFFFFFFFFFFFF',
     B Z'7FFFFFFFFFFFFFF',Z'FFFFFFFFFFFFFFF',
     A Z'1FFFFFFFFFFFFFFF',Z'3FFFFFFFFFFFFFFF',
     B Z'7FFFFFFFFFFFFFFF',Z'FFFFFFFFFFFFFFFF'/
C                                             'FFFFFFFFFFFFFFFF'X/
C          IBM PC using Microsoft Fortran uses different syntax:
C     DATA MASKS/16#1,16#3,16#7,16#F,16#1F,16#3F,16#7F,16#FF,
C    + 16#1FF,16#3FF,16#7FF,16#FFF,16#1FFF,16#3FFF,16#7FFF,16#FFFF,
C    + 16#1FFFF,16#3FFFF,16#7FFFF,16#FFFFF,16#1FFFFF,16#3FFFFF,
C    + 16#7FFFFF,16#FFFFFF,16#1FFFFFF,16#3FFFFFF,16#7FFFFFF,16#FFFFFFF,
C    + 16#1FFFFFFF,16#3FFFFFFF,16#7FFFFFFF,16#FFFFFFFF/
      INTEGER RGHTSH, OR, AND
      LEFTSH(M,N) = ISHFT(M,N)
      RGHTSH(M,N) = ISHFT(M,-N)
C     OR(M,N)  = M.OR.N
C     AND(M,N) = M.AND.N
C************************************** MACHINE SPECIFIC CHANGES END HERE
C          History:  written by Robert C. Gammill, jul 1972.


C          NBYTE must be less than or equal to LMWD
      ICON = LMWD-NBYTE
      IF (ICON.LT.0) RETURN
      MASK = MASKS (NBYTE)
C          INDEX  = number of words into IN before the next "byte" appears
C          II     = number of bits the "byte" is from the left side of the word
C          ISTEP  = number of bits from the start of one "byte" to the next
C          IWORDS = number of words to skip from one "byte" to the next
C          IBITS  = number of bits to skip after skipping IWORDS
C          MOVER  = number of bits to the right, a byte must be moved to be
C                   right adjusted
      INDEX = ISKIP/LMWD
      II    = MOD (ISKIP,LMWD)
      ISTEP = NBYTE+NSKIP
      IWORDS= ISTEP/LMWD
      IBITS = MOD (ISTEP,LMWD)

      DO 6 I=1,N                                                                
      MOVER = ICON-II
      IF (MOVER) 2,3,4

C          The "byte" is split across a word break.
    2 MOVEL = -MOVER
      MOVER = LMWD-MOVEL
      NP1 = LEFTSH (IN(INDEX+1),MOVEL)
      NP2 = RGHTSH (IN(INDEX+2),MOVER)
      IOUT(I) = AND (OR (NP1,NP2) , MASK)
      GO TO 5                                                                   

C          The "byte" is already right adjusted.
    3 IOUT(I) = AND (IN (INDEX+1) , MASK)
      GO TO 5                                                                   

C          Right adjust the "byte".
    4 IOUT(I) = AND (RGHTSH (IN (INDEX+1),MOVER) , MASK)

    5 II = II+IBITS
      INDEX = INDEX+IWORDS
      IF (II .LT. LMWD) GO TO 6
      II = II-LMWD
      INDEX = INDEX+1
    6 CONTINUE                                                                  

      RETURN                                                                    
      END                                                                       

      SUBROUTINE SBYTES (IOUT,IN,ISKIP,NBYTE,NSKIP,N)
C          Store bytes - pack bits:  Put arbitrary size values into a
C          packed bit string, taking the low order bits from each value
C          in the unpacked array.
      DIMENSION IN(*), IOUT(*)
C            IOUT  = packed array output
C            IN    = unpacked array input
C            ISKIP = initial number of bits to skip
C            NBYTE = number of bits to pack
C            NSKIP = additional number of bits to skip on each iteration
C            N     = number of iterations
C************************************** MACHINE SPECIFIC CHANGES START HERE
C          Machine dependent information required:
C            LMWD   = Number of bits in a word on this machine
C            MASKS  = Set of word masks where the first element has only the
C                     right most bit set to 1, the second has the two, ...
C            LEFTSH = Shift left bits in word M to the by N bits
C            RGHTSH = Shift right
C            OR     = Logical OR (add) on this machine
C            AND    = Logical AND (multiply) on this machine
C            NOT    = Logical NOT (negation) on this machine
C          This is for Sun UNIX Fortran
      PARAMETER (LMWD=64)
      DIMENSION MASKS(LMWD)
      SAVE      MASKS
      DATA MASKS/Z'1',Z'3',Z'7',Z'F',Z'1F',Z'3F',Z'7F',Z'FF',
     2 Z'1FF',Z'3FF',Z'7FF',Z'FFF',Z'1FFF',Z'3FFF',Z'7FFF',Z'FFFF',
     3 Z'1FFFF',Z'3FFFF',Z'7FFFF',Z'FFFFF',Z'1FFFFF',Z'3FFFFF',
     4 Z'7FFFFF',Z'FFFFFF',Z'1FFFFFF',Z'3FFFFFF',Z'7FFFFFF',Z'FFFFFFF',
     5 Z'1FFFFFFF',Z'3FFFFFFF',Z'7FFFFFFF',Z'FFFFFFFF',
     6 Z'1FFFFFFFF',Z'3FFFFFFFF',Z'7FFFFFFFF',Z'FFFFFFFFF',
     7 Z'1FFFFFFFFF',Z'3FFFFFFFFF',Z'7FFFFFFFFF',Z'FFFFFFFFFF',
     8 Z'1FFFFFFFFFF',Z'3FFFFFFFFFF',Z'7FFFFFFFFFF',Z'FFFFFFFFFFF',
     9 Z'1FFFFFFFFFFF',Z'3FFFFFFFFFFF',Z'7FFFFFFFFFFF',Z'FFFFFFFFFFFF',
     A Z'1FFFFFFFFFFFF',Z'3FFFFFFFFFFFF',
     B Z'7FFFFFFFFFFFF',Z'FFFFFFFFFFFFF',
     A Z'1FFFFFFFFFFFFF',Z'3FFFFFFFFFFFFF',
     B Z'7FFFFFFFFFFFFF',Z'FFFFFFFFFFFFFF',
     A Z'1FFFFFFFFFFFFFF',Z'3FFFFFFFFFFFFFF',
     B Z'7FFFFFFFFFFFFFF',Z'FFFFFFFFFFFFFFF',
     A Z'1FFFFFFFFFFFFFFF',Z'3FFFFFFFFFFFFFFF',
     B Z'7FFFFFFFFFFFFFFF',Z'FFFFFFFFFFFFFFFF'/
      INTEGER RGHTSH, OR, AND
      LEFTSH(M,N) = ISHFT(M,N)
      RGHTSH(M,N) = ISHFT(M,-N)
C     OR(M,N)  = M.OR.N
C     AND(M,N) = M.AND.N
C     NOT(M)   = .NOT.M
C***********************************************************************        

C          NBYTE must be less than or equal to LMWD
      ICON = LMWD-NBYTE
      IF (ICON .LT. 0) RETURN
      MASK = MASKS(NBYTE)
C          INDEX  = number of words into IOUT the next "byte" is to be stored
C          II     = number of bits in from the left side of the word to store it
C          ISTEP  = number of bits from the start of one "byte" to the next
C          IWORDS = number of words to skip from one "byte" to the next
C          IBITS  = number of bits to skip after skipping IWORDS
C          MOVER  = number of bits to the right, a byte must be moved to be
C                   right adjusted
      INDEX = ISKIP/LMWD
      II    = MOD(ISKIP,LMWD)
      ISTEP = NBYTE+NSKIP
      IWORDS = ISTEP/LMWD
      IBITS = MOD(ISTEP,LMWD)

      DO 6 I=1,N                                                                
      J = AND (MASK,IN(I))
      MOVEL = ICON-II
      IF (MOVEL) 2,3,4

C          The "byte" is to be split across a word break
    2 MSK = MASKS (NBYTE+MOVEL)
      IOUT(INDEX+1) = OR (AND(NOT(MSK),IOUT(INDEX+1)),RGHTSH(J,-MOVEL))
      ITEMP = AND (MASKS(LMWD+MOVEL),IOUT(INDEX+2))
      IOUT(INDEX+2) = OR(ITEMP,LEFTSH(J,LMWD+MOVEL))
      GO TO 5                                                                   

C          The "byte" is to be stored right-adjusted
    3 IOUT(INDEX+1) = OR ( AND (NOT(MASK),IOUT(INDEX+1)) , J)
      GO TO 5                                                                   

C          The "byte" is to be stored in middle of word, so shift left.
    4 MSK = LEFTSH(MASK,MOVEL)
      IOUT(INDEX+1) = OR(AND(NOT(MSK),IOUT(INDEX+1)),LEFTSH(J,MOVEL))

    5 II = II+IBITS
      INDEX = INDEX+IWORDS
      IF (II .LT. LMWD) GO TO 6
      II = II-LMWD
      INDEX = INDEX+1
    6 CONTINUE

      RETURN                                                                    
      END                                                                       
ENDPROG

#   set up control data input in a here document

cat > data5 << ENDDATA
/DSS/Y18093
ENDDATA
   
#
#   compile, and link the program

cft77 rdgrp.f
segldr -L /lib,/usr/lib,/usr/local/lib -lmss,ncaro,ncarm,net -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 huron.scd.ucar.edu:/u1/worley/rje/.

ja -cst      # get accounting wrap up

echo "End of processing job."