C
C	$Id: metred.f.sed,v 1.2 2008-07-27 00:59:04 haley Exp $
C                                                                      
C                Copyright (C)  2000
C        University Corporation for Atmospheric Research
C                All Rights Reserved
C
C The use of this Software is governed by a License Agreement.
C
      SUBROUTINE METRED(IOS,STATUS)
C
C  READ IN A METAFILE RECORD
C
C  INPUT-NONE
C
C  OUTPUT
C       IOS-METAFILE READ STATUS VALID WHEN STATUS SET TO AN I/O ERROR
C       STATUS-THE ERROR STATUS FLAG
C                       ALLOK EVERYTHING WENT WELL
C                       NE ALLOK ERROR DEFINED IN COMMON TREROR
C
      COMMON/TREROR/ ALLOK, MFRCHK, MTOPER, METRDC, REDERR, TYPCHG
     1             ,INVTYP, MINVLD, TYPERR, FRMEND, ENCINT, IVDCDT
     2             ,GCOERR, GCRERR, GCCERR, FCOERR, FCRERR, FCCERR
     3             ,PLIDXG, PMIDXG, TXIDXG, PGIDXG, INVLMT, CELERR
     4             ,COIERR, COLNRM, UNKNOW, UNKOPC, ENDMTF, VNEROR
     5             ,BADRSZ, DEVOUT, NOVERS, BADFNT, PGMERR, FASERR
     6             ,HINERR, VDWERR, RDWERR, RIXLIM
      INTEGER        ALLOK, MFRCHK, MTOPER, METRDC, REDERR, TYPCHG
     1             ,INVTYP, MINVLD, TYPERR, FRMEND, ENCINT, IVDCDT
     2             ,GCOERR, GCRERR, GCCERR, FCOERR, FCRERR, FCCERR
     3             ,PLIDXG, PMIDXG, TXIDXG, PGIDXG, INVLMT, CELERR
     4             ,COIERR, COLNRM, UNKNOW, UNKOPC, ENDMTF, VNEROR
     5             ,BADRSZ, DEVOUT, NOVERS, BADFNT, PGMERR, FASERR
     6             ,HINERR, VDWERR, RDWERR, RIXLIM
      COMMON/TRINOT/ IPTR, MBUFOT, MAXBYT, DEVUNT, METUNT,
     1          METIPT, ERRUNT, FNTUNT
      INTEGER MAXCNT
      PARAMETER (MAXCNT=200)
      INTEGER IPTR, MBUFOT(MAXCNT), MAXBYT, DEVUNT, METUNT, ERRUNT,
     1        FNTUNT
      LOGICAL METIPT
      COMMON /PTRBUFR/ METBIT, MBUFER, MDTYPE, METREC, MRECLN,
     1                MCONTF, MOPRST, LNGFLG, MERGFL
      INTEGER MNWRDS, RECLOC, RECSIZ, DTLOC, DTSIZ, MBITST, MBUFOF,
     1        MINSBD, MERLOC, MERSIZ
#if defined(cray)
      PARAMETER (MNWRDS=180, RECLOC=0, RECSIZ=16, DTLOC=16, DTSIZ=4
#else
      PARAMETER (MNWRDS=360, RECLOC=0, RECSIZ=16, DTLOC=16, DTSIZ=4
#endif
     1          ,MBITST=32, MBUFOF=32, MINSBD=16, MERLOC=23, MERSIZ=1)
      INTEGER METBIT, MBUFER(MNWRDS), MDTYPE, METREC, MRECLN, MOPRST
      LOGICAL MCONTF, LNGFLG, MERGFL
      COMMON /TRTYPE/ METMIN, METEXT, METPRT, METHED, MIOPCL, MXOPCL,
     1                MIOPID, MXOPID, ASCDEC, ASCHEX, ASCOCT, BINARY,
     2                GAHNOR, GALEFT, GACENT, GARITE, GAVNOR, GATOP ,
     3                GACAP , GAHALF, GABASE, GABOTT, GRIGHT, GLEFT ,
     4                GUP   ,
     5                GDOWN , CINDEX, CDIRCT, PENUP , PENDN , FLAGVL,
     6                SEPRVL, ASCTEK, TYPRGB, TYPBGR,
     7                TYPHLS, TYPMON, SOLID , DASHED, INVSBL, SOLPAT,
     8                ASFIND, ASFBND, ASFLNT, ASFLNW, ASFLNC, ASFMRT,
     9                ASFMRS, ASFMRC, ASFFIS, ASFFHI, ASFFPI, ASFFCO,
     A                ASFFPT, ASFFPW, ASFFPC, ASFTFI, ASFTPR, ASFTCX,
     B                ASFTCS, ASFTCO, ASCFLT, PHOLLO, PSOLID, PPATTR,
     C                PHATCH, PEMPTY, HHORIZ, HVERTI, HPOSLP, HNESLP,
     D                HHOAVE, HPOANE
      INTEGER         METMIN, METEXT, METPRT, METHED, MIOPCL, MXOPCL,
     1                MIOPID, MXOPID, ASCDEC, ASCHEX, ASCOCT, BINARY,
     2                GAHNOR, GALEFT, GACENT, GARITE, GAVNOR, GATOP ,
     3                GACAP , GAHALF, GABASE, GABOTT, GRIGHT, GLEFT ,
     4                GUP   ,
     5                GDOWN , CINDEX, CDIRCT, PENUP , PENDN , FLAGVL,
     6                SEPRVL, ASCTEK, TYPRGB, TYPBGR,
     7                TYPHLS, TYPMON, SOLID , DASHED, INVSBL, SOLPAT,
     8                ASFIND, ASFBND, ASFLNT, ASFLNW, ASFLNC, ASFMRT,
     9                ASFMRS, ASFMRC, ASFFIS, ASFFHI, ASFFPI, ASFFCO,
     A                ASFFPT, ASFFPW, ASFFPC, ASFTFI, ASFTPR, ASFTCX,
     B                ASFTCS, ASFTCO, ASCFLT, PHOLLO, PSOLID, PPATTR,
     C                PHATCH, PEMPTY, HHORIZ, HVERTI, HPOSLP, HNESLP,
     D                HHOAVE, HPOANE
      COMMON /THFLG/NSFLG
C
C  The following COMMON is from the NCAR GKS package.  It is used
C  in order to bump MRECNM when writing a HEADER or TEXT record
C  to the output file.  *** This COMMON must be kept compatible
C  with the NCAR GKS package ***
C
      COMMON  /G01IO/   MIOFLG  ,MRECNM ,ITMP(985)
      INTEGER           MIOFLG  ,MRECNM ,ITMP
C
      INTEGER IOS, STATUS
      INTEGER TEMP, IER
      CHARACTER*1 CTMP
C
C  SET THE FLAG TO OK
C
      STATUS = ALLOK
   20 CONTINUE
C
C  READ IN A METAFILE RECORD
C
      CALL BINRED(0,MNWRDS,MBUFER,IOS,IER)
#if (defined(ultrix) && defined(mips)) || (defined(__alpha) && defined(__osf__))
      DO 220 J=1,360
        IB1 = IAND(ISHIFT(MBUFER(J),-24),255)
        IB2 = IAND(ISHIFT(MBUFER(J),-16),255)
        IB3 = IAND(ISHIFT(MBUFER(J),-08),255)
        IB4 = IAND(ISHIFT(MBUFER(J),-00),255)
        IRV = IOR(IB1,ISHIFT(IB2,08))
        IRV = IOR(IRV,ISHIFT(IB3,16))
        IRV = IOR(IRV,ISHIFT(IB4,24))
        MBUFER(J) = IRV
  220 CONTINUE
#endif
      IF (IER .NE. 0) GO TO 1000
C
C  GET THE DATA TYPE ID AND PASS ANY TEXT AND HEADER RECORDS
C  ON TO THE OUTPUT FILE.
C
      MDTYPE = 0
      CALL GBYTES(MBUFER,MDTYPE,DTLOC,DTSIZ,0,1)
      METREC = METREC + 1
      IF (MDTYPE .NE. METMIN) THEN
        IF (MDTYPE.EQ.METPRT .OR. MDTYPE.EQ.METHED) THEN
C
C  Write to output file.
C
          IF (NSFLG .NE. 1) THEN
            CALL G01FLB
            CALL G01MIO(3,METUNT,CTMP,MBUFER,MNWRDS,ier)
            MRECNM = MRECNM+1
          ENDIF
          GO TO 20
        ELSE IF(MDTYPE .EQ. METEXT) THEN
          WRITE(6,'('' Input metafile already in NCAR CGM format, no act
     -ion taken.'')')
          WRITE(6,'('' Output file may be corrupt.'')')
          STOP
        ELSE
          WRITE(6,'('' Unknown record type in input metafile'')')
          STOP
        ENDIF
      ELSE
C
C  RESET THE BIT POINTER
C
        METBIT = MBITST
C
C  GET THE USEFUL DATA COUNT AND CONVERT FROM 8 BIT BYTES TO BITS
C
        CALL GBYTES(MBUFER,TEMP,RECLOC,RECSIZ,0,1)
        MRECLN = TEMP * 8 + MBUFOF
C
C  IF BIT COUNT OUT OF RANGE THEN SET END OF METAFILE AND RETURN
C       THIS FIX IS FOR MINIMAL METACODE PROBLEMS
C
        IF (MRECLN .LE. MBUFOF .OR. MRECLN .GT. 1440*8) THEN
          STATUS = ENDMTF
          RETURN
        END IF
C
C  GET THE MERGE FRAMES FLAG
C
        CALL GBYTES(MBUFER,TEMP, MERLOC, MERSIZ, 0, 1)
        MERGFL = .FALSE.
        IF (TEMP .EQ. 1) MERGFL = .TRUE.
C
C  NORMAL EXIT
C
        RETURN
      ENDIF
C
C  ERROR EXIT
C
 1000 CONTINUE
      STATUS = REDERR
      RETURN
C
      END
