# 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 > rdlmrf.f <<ENDPROG
      PROGRAM QV7
C     READ AND PRINT LMRF6
C
C-----GBYTE/S, DATE AND CLOCK ARE MACHINE-DEPENDENT ROUTINES AND
C     FUNCTIONS.  SEE COADS RELEASE 1 SUPPLEMENT H FOR A DESCRIPTION
C     OF THEIR BEHAVIOR.
C                AUTHOR: S.LUBKER,  93/08/25. 16:40:27.
C     -----------REVISION HISTORY---------------------------------------34567898
C      LEVEL AUTHOR DATE       DESCRIPTION
C      ===== ====== ========== ====================
C      .01A. SJL    93/08/25.  ORIGINAL VERSION.
C     ------------------------------------------------------------------34567898
      IMPLICIT INTEGER(A-E,G-Z)
C
      DATA UNIT/1/,FMISS/-9999./
C
      PARAMETER(DIM BUF=6)
      DIMENSION BUF(DIM BUF)
      DATA (BUF(I),I=1,6)/6*0/,DEOF/0/
C
      CHARACTER RPT*64
C
      CHARACTER*8 FIELD,FORMAT
      PARAMETER(NUMBER=73)
      COMMON /LMR6/FIELD(NUMBER),FTRUEL(NUMBER),FTRUEU(NUMBER)
     +,FUNITS(NUMBER),FBASE(NUMBER),BITS(NUMBER),OFFSET(NUMBER)
     +,FORMAT(NUMBER),RPTID,INDXCK
C
      DIMENSION CODED(NUMBER),FTRUE(NUMBER)
C
      DIMENSION AL(15),AD(255,15)
      DATA AL(2)/16/
      DIMENSION TRFLG(23)
C
      CHARACTER*8 YYMMDD,HHMMSS
      CHARACTER LEVEL*4,FILE*64
      DATA LEVEL/'.01A'/
C

c
c     -----  ncar dependent stuff ---
c

c     read input data file name from input script
      read(5,'(a64)')file
      call msread (ier,'lmrf',file,' ',' ')

c     split the multi-file MSS volume into separate data files
c     f001 --> f006 and convert f001 to a pure binary file
c     so fortran drirect access can be used.  Process just the
c     the first file.  This approach will work for non-multi
c     file MSS volumes as well.  Program modification will be
c     necessary to process f002-->f006 in sequence.

      istat = ishell('cossplit lmrf')
      istat = ishell('cosconvert -b f001')


c     ---------------------------------
      CALL DATE(YYMMDD)
      CALL CLOCK(HHMMSS)

      OPEN(UNIT,FILE='f001',FORM='UNFORMATTED',ACCESS='DIRECT'
     +,RECL=LEN(RPT))
C-----READ REPORT
  100 READ(UNIT,REC=BUF(2)+1,IOSTAT=EOF)RPT
      IF(EOF.NE.0)GOTO 900
      DEOF=0
      IF(MOD(BUF(2),53).EQ.0)THEN
        PRINT 1,LEVEL,YYMMDD,HHMMSS,FILE,BUF(2)/53+1
    1   FORMAT('1QV7',A4,2A9,' < ',A,T132,I10)
        CALL PRNFLD(FIELD,FORMAT,NUMBER)
      ENDIF
      BUF(2)=BUF(2)+1
C
C-----UNPACK REPORT AND CONVERT CODED TO TRUE VALUES
      CALL GETRPT(RPT,CODED,FTRUE,FMISS
     +,FUNITS,FBASE,BITS,OFFSET,NUMBER,RPTID,INDXCK)
C-----PRINT REPORT
      CALL PRNRPT(FTRUE,FMISS,FUNITS,FORMAT,NUMBER)
C      GOTO 700
C
C-----GET TRIMMING ATTACHMENT
      CALL GBYTES(RPT,AD(1,2),448,4,0,16)
      CALL GETTRF(AL,AD,TRFLG)
      PRINT *,'TRIM ATT: "',TRFLG,'"'
C
c     stop processing after 5 records
  700 IF(BUF(2).EQ.5)STOP 'ETC'
      GOTO 100
C
  900 PRINT *,' REPORTS ',BUF(2),', EOF ',EOF
      DEOF=DEOF+1
      IF(DEOF.LT.2)GOTO 100
      END
C-----------------------------------------------------------------------3456789 
      BLOCK DATA BDLMR6
      IMPLICIT INTEGER(A-E,G-Z)
C
      CHARACTER*8 FIELD,FORMAT
      PARAMETER(NUMBER=73)
      COMMON /LMR6/FIELD(NUMBER),FTRUEL(NUMBER),FTRUEU(NUMBER)
     +,FUNITS(NUMBER),FBASE(NUMBER),BITS(NUMBER),OFFSET(NUMBER)
     +,FORMAT(NUMBER),RPTID,INDXCK
C
      DATA (FIELD(I),FTRUEL(I),FTRUEU(I),FUNITS(I),FBASE(I)
     +,BITS(I),OFFSET(I),FORMAT(I),I= 1,10)
     1/'B10 ',      1.,    648.,      1.,      0.,  10,  16,'(A4 '
     2,'YR  ',   1770.,   2024.,      1.,   1769.,   8,  26,',A4 '
     3,'MO  ',      1.,     12.,      1.,      0.,   4,  34,',A2 '
     4,'DY  ',      1.,     31.,      1.,      0.,   5,  38,',A2 '
     5,'HR  ',    0.00,   23.99,    0.01,   -1.00,  12,  43,',A4 '
     6,'TI  ',      0.,      3.,      1.,     -1.,   4,  55,',A1 '
     7,'LON ',    0.00,  359.99,    0.01,   -1.00,  16,  59,',A5 '
     8,'LAT ',  -90.00,   90.00,    0.01,-9001.00,  15,  75,',A5 '
     9,'LI  ',      0.,      6.,      1.,     -1.,   4,  90,',A1 '
     1,'DCK ',      0.,    999.,      1.,     -1.,  10,  94,',A3 '/
      DATA (FIELD(I),FTRUEL(I),FTRUEU(I),FUNITS(I),FBASE(I)
     +,BITS(I),OFFSET(I),FORMAT(I),I=11,20)
     1/'SID ',      0.,     80.,      1.,     -1.,   8, 104,',A2 '
     2,'PT  ',      0.,     15.,      1.,     -1.,   5, 112,',A2 '
     3,'QI  ',      0.,      2.,      1.,     -1.,   2, 117,',A1 '
     4,'DS  ',      0.,     13.,      1.,     -1.,   5, 119,',A2 '
     5,'DC  ',      0.,      2.,      1.,     -1.,   4, 124,',A2 '
     6,'TC  ',      0.,      1.,      1.,     -1.,   3, 128,',A1 '
     7,'PB  ',      0.,      2.,      1.,     -1.,   2, 131,',A1 '
     8,'DI  ',      0.,      6.,      1.,     -1.,   4, 133,',A1 '
     9,'D   ',      1.,    362.,      1.,      0.,   9, 137,',A3 '
     2,'WI  ',      0.,      8.,      1.,     -1.,   4, 146,',A1 '/
      DATA (FIELD(I),FTRUEL(I),FTRUEU(I),FUNITS(I),FBASE(I)
     +,BITS(I),OFFSET(I),FORMAT(I),I=21,30)
     1/'W   ',     0.0,   102.2,     0.1,    -1.0,  10, 150,',A4 '
     2,'VI  ',      0.,      2.,      1.,     -1.,   2, 160,',A1 '
     3,'VV  ',     90.,     99.,      1.,     89.,   4, 162,',A2 '
     4,'WW  ',      0.,     99.,      1.,     -1.,   7, 166,',A2 '
     5,'W1  ',      0.,      9.,      1.,     -1.,   4, 173,',A1 '
     6,'W2  ',      0.,      9.,      1.,     -1.,   4, 177,',A1 '
     7,'SLP ',   870.0,  1074.6,     0.1,  8699.0,  11, 181,',A5 '
     8,'T1  ',      0.,      9.,      1.,     -1.,   4, 192,',A1 '
     9,'AT  ',   -99.9,    99.9,     0.1, -1000.0,  11, 196,',A4 '
     3,'WBT ',   -99.9,    99.9,     0.1, -1000.0,  11, 207,',A4 '/
      DATA (FIELD(I),FTRUEL(I),FTRUEU(I),FUNITS(I),FBASE(I)
     +,BITS(I),OFFSET(I),FORMAT(I),I=31,40)
     1/'DPT ',   -99.9,    99.9,     0.1, -1000.0,  11, 218,',A4 '
     2,'SST ',   -99.9,    99.9,     0.1, -1000.0,  11, 229,',A4 '
     3,'SI  ',      0.,     12.,      1.,     -1.,   4, 240,',A2 '
     4,'N   ',      0.,      9.,      1.,     -1.,   4, 244,',A1 '
     5,'NH  ',      0.,      9.,      1.,     -1.,   4, 248,',A1 '
     6,'CL  ',      0.,     10.,      1.,     -1.,   4, 252,',A2 '
     7,'HI  ',      0.,      1.,      1.,     -1.,   2, 256,',A1 '
     8,'H   ',      0.,     10.,      1.,     -1.,   4, 258,',A2 '
     9,'CM  ',      0.,     10.,      1.,     -1.,   4, 262,',A2 '
     4,'CH  ',      0.,     10.,      1.,     -1.,   4, 266,',A2 '/
      DATA (FIELD(I),FTRUEL(I),FTRUEU(I),FUNITS(I),FBASE(I)
     +,BITS(I),OFFSET(I),FORMAT(I),I=41,50)
     1/'WD  ',      0.,     38.,      1.,     -1.,   6, 270,',A2 '
     2,'WP  ',      0.,     30.,      1.,     -1.,   5, 276,',A2 '
     3,'WH  ',      0.,    49.5,     0.5,     -1.,   7, 281,',A2 '
     4,'SD  ',      0.,     38.,      1.,     -1.,   6, 288,',A2 '
     5,'SP  ',      0.,     30.,      1.,     -1.,   5, 294,',A2 '
     6,'SH  ',      0.,    49.5,     0.5,     -1.,   7, 299,',A2 '
     7,'C1  ',      0.,     40.,      1.,     -1.,   7, 306,',A2 '
     8,'C2  ',      0.,     40.,      1.,     -1.,   7, 313,',A2 '
     9,'SC  ',      0.,      9.,      1.,     -1.,   4, 320,',A1 '
     5,'SS  ',      0.,      9.,      1.,     -1.,   4, 324,',A1 '/
      DATA (FIELD(I),FTRUEL(I),FTRUEU(I),FUNITS(I),FBASE(I)
     +,BITS(I),OFFSET(I),FORMAT(I),I=51,60)
     1/'A   ',      0.,      8.,      1.,     -1.,   4, 328,',A1 '
     2,'PPP ',     0.0,    51.0,     0.1,    -1.0,   9, 332,',A3 '
     3,'IS  ',      1.,      5.,      1.,      0.,   3, 341,',A1 '
     4,'ES  ',      0.,     99.,      1.,     -1.,   7, 344,',A2 '
     5,'RS  ',      0.,      4.,      1.,     -1.,   3, 351,',A1 '
     6,'II  ',      0.,     10.,      1.,     -1.,   4, 354,',A2 '
     7,'ID1 ',     33.,     95.,      1.,     32.,   6, 358,', A1'
     8,'ID2 ',     33.,     95.,      1.,     32.,   6, 364,', A1'
     9,'ID3 ',     33.,     95.,      1.,     32.,   6, 370,', A1'
     6,'ID4 ',     33.,     95.,      1.,     32.,   6, 376,', A1'/
      DATA (FIELD(I),FTRUEL(I),FTRUEU(I),FUNITS(I),FBASE(I)
     +,BITS(I),OFFSET(I),FORMAT(I),I=61,70)
     1/'ID5 ',     33.,     95.,      1.,     32.,   6, 382,', A1'
     2,'ID6 ',     33.,     95.,      1.,     32.,   6, 388,', A1'
     3,'ID7 ',     33.,     95.,      1.,     32.,   6, 394,', A1'
     4,'ID8 ',     33.,     95.,      1.,     32.,   6, 400,', A1'
     5,'OS  ',      0.,      6.,      1.,     -1.,   4, 406,',A1 '
     6,'OP  ',      0.,      9.,      1.,     -1.,   4, 410,',A1 '
     7,'T2  ',      0.,      6.,      1.,     -1.,   3, 414,',A1 '
     8,'IX  ',      1.,      6.,      1.,      0.,   4, 417,',A1 '
     9,'WX  ',      1.,      1.,      1.,      0.,   1, 421,',A1 '
     7,'SX  ',      1.,      1.,      1.,      0.,   1, 422,',A1 '/
      DATA (FIELD(I),FTRUEL(I),FTRUEU(I),FUNITS(I),FBASE(I)
     +,BITS(I),OFFSET(I),FORMAT(I),I=71,73)
     1/'IRD ',      1.,    255.,      1.,      0.,   8, 423,',A3 '
     2,'A6  ',      0.,      1.,      1.,     -1.,   2, 431,',A1 '
     3,'CK  ',      0.,     30.,      1.,      0.,   5, 443,',A2)'/
C
      DATA INDXCK/NUMBER/,RPTID/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)
C
      CHARACTER*(*) RPT
      DIMENSION CODED(*),FTRUE(*),FUNITS(*),FBASE(*),BITS(*),OFFSET(*)
C
      IF(MOD(ICHAR(RPT(2:2)),16).NE.RPTID)STOP 'RPTID'
C
      CODED(INDXCK)=0
      DO 190 I=1,NUMBER
        IF(I.EQ.INDXCK)GOTO 190
        CALL GBYTE(RPT,CODED(I),OFFSET(I),BITS(I))
        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
      I=INDXCK
      FTRUE(I)=MOD(CODED(I),2**BITS(I)-1)
      CALL GBYTE(RPT,CODED(I),OFFSET(I),BITS(I))
      IF(FTRUE(I).NE.CODED(I))STOP 'CHECKSUM'
      END
C-----------------------------------------------------------------------3456789
      SUBROUTINE GETTRF(AL,AD,TRFLG)
C     GET TRIMMING ATTACHMENT
C
      IMPLICIT INTEGER(A-E,G-Z)
      DIMENSION AL(15),AD(255,15)
      DIMENSION TRFLG(23)
C
      IF(AL(2).EQ.16)THEN
        TRFLG( 1)=((AD( 1,2)*16+AD( 2,2))*16+AD( 3,2))*4+AD( 4,2)/4
        TRFLG( 2)=MOD(AD( 4,2)      ,4)
        TRFLG( 3)=    AD( 5,2)
        TRFLG( 4)=    AD( 6,2)
        TRFLG( 5)=    AD( 7,2)
        TRFLG( 6)=    AD( 8,2)
        TRFLG( 7)=    AD( 9,2)
        TRFLG( 8)=    AD(10,2)
        TRFLG( 9)=    AD(11,2)/4
        TRFLG(10)=MOD(AD(11,2)      ,4)
        TRFLG(11)=    AD(12,2)/4
        TRFLG(12)=MOD(AD(12,2)      ,4)
        TRFLG(13)=    AD(13,2)/4
        TRFLG(14)=MOD(AD(13,2)      ,4)
        TRFLG(15)=    AD(14,2)/4
        TRFLG(16)=MOD(AD(14,2)      ,4)
        TRFLG(17)=    AD(15,2)/4
        TRFLG(18)=MOD(AD(15,2)/2    ,2)
        TRFLG(19)=MOD(AD(15,2)      ,2)
        TRFLG(20)=    AD(16,2)/2/2/2
        TRFLG(21)=MOD(AD(16,2)/2/2  ,2)
        TRFLG(22)=MOD(AD(16,2)/2    ,2)
        TRFLG(23)=MOD(AD(16,2)      ,2)
      ELSE
        DO 190 I=1,23
          TRFLG(I)=0
  190   CONTINUE
      ENDIF
      END
C-----------------------------------------------------------------------3456789 
      SUBROUTINE PRNFLD(FIELD,FORMAT,NUMBER)
C     PRINT FIELDS
C
      IMPLICIT INTEGER(A-E,G-Z)
      CHARACTER*8 FIELD,FORMAT
      DIMENSION FIELD(*),FORMAT(*)
      CHARACTER FLD*1
      character*584 format1

      FLD(I,J)=FIELD(I)(J:J)

c
c     put format into single string
      do i = 1,73
       ii = (i-1)*8 + 1
       i7 = ii + 7
       format1(ii:i7)=format(i)
      enddo

      WRITE(*,format1)
     +  ((FLD(I,MOD(J+INDEX(FIELD(I)(1:3)//' ',' ')-1,3)+1)
     +,I=1,NUMBER),J=0,2)
      WRITE(*,format1)('-',I=1,NUMBER)
      END
C-----------------------------------------------------------------------3456789
      SUBROUTINE PRNRPT(FTRUE,FMISS,FUNITS,FORMAT,NUMBER)
C     PRINT REPORT
C
      IMPLICIT INTEGER(A-E,G-Z)
      CHARACTER*8 FORMAT
      DIMENSION FTRUE(*),FUNITS(*),FORMAT(*)
      CHARACTER*8 ATRUE(104)
      character*584 format1
C
      DO 190 I=1,NUMBER
        IF(FTRUE(I).EQ.FMISS)THEN
          ATRUE(I)=' '
        ELSE IF(FORMAT(I)(2:2).EQ.' ')THEN
          ATRUE(I)(1:1)=CHAR(NINT(FTRUE(I)))
        ELSE
          WRITE(ATRUE(I),'(I'//FORMAT(I)(3:3)//')')
     +    NINT(FTRUE(I)/FUNITS(I))
        ENDIF
  190 CONTINUE
C
c 
c     put format into single string 
      do i = 1,73 
       ii = (i-1)*8 + 1 
       i7 = ii + 7 
       format1(ii:i7)=format(i)
      enddo 

      WRITE(*,format1)(ATRUE(I),I=1,NUMBER)
      END
ENDPROG

#   set up control data input in a here document

cat > data5 << ENDDATA
/DSS/Y17704
ENDDATA

#
#   compile, and link the program

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

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

rdlmrf <data5 >rdlmrf_o

# rcp the output back to home machine

rcp  rdlmrf_o huron.scd.ucar.edu:/u1/worley/rje/.

ja -cst      # get accounting wrap up

echo "End of processing job."