      SUBROUTINE IW3GETAF(LUGRBIX, LUGRB, LABEL, FLD, MTITLE, IERR)
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: IW3GETAF      GET AND UNPACK CRAY GRIB FILES.
C   AUTHOR: LUKE LIN         ORG: WD41        DATE: 97-06-03
C
C ABSTRACT: GET AND UNPACK CRAY GRIB FILES FROM AN OFFICE 84 6 WORD ID.
C           PLEASE READ THE REMARKS BEFORE USING IT.
C
C HISTORY LOG:
C   95-10-04  LUKE LIN
C   95-10-31  LUKE LIN   MODIFY FOR TESTING DIFFERENT GRID TYPE.
C   95-11-27  LUKE LIN   ADD AN OPTION FOR NOT TEST FCST HOUR -- CAC 96H/C
C                        AND MODIFY TO READ RGL(NGM) MODEL.
C   96-01-30  LUKE LIN   MODIFY TO CONVERT FROM 1 DEGREE TO 65*65 BY LINEAR.
C   96-02-14  LUKE LIN   MODIFY FOR NGM BOUNDARY LAYER RH CHART.
C   96-02-23  LUKE LIN   MODIFY FOR NGM SURFACE TO 500 MB LIFTED INDEX.
C   96-02-26  LUKE LIN   MODIFY FOR AVMER OR AVPOLAR AND OUTPUT WILL BE
C                        EITHER 2.5 OR 5.0 DEGREE DEPENDING ON OPTION
C   96-03-07  LUKE LIN   MODIFY FOR NGM SUPER C GRID.
C   96-08-12  LUKE LIN   USE IDERELL'S ROUTINE TO CONVERT 1' TO 65*65.
C   97-01-10  LUKE LIN   ADD TRAJECTORY TDL GRAPHIC PRODUCTS.
C   97-01-15  LUKE LIN   ADD FOR FINAL GRAPHIC PRODUCTS.
C   97-02-05  LUKE LIN   ADD FOR UKMET GRAPHIC PRODUCTS.
C   97-03-06  LUKE LIN   ADD CAC/0-5 WAVE HEIGHT PRODUCTS.
C   97-06-03  LUKE LIN   MODIFY FOR ETA 4-LAYER LIFTED INDEX.
C   98-07-23  BILL FACEY F90 AN Y2K
C
C INPUT ARGUMENTS:
C   LUGRBIX    - AN UNIT NUMBER POINTS TO ONE DEGREE GRIB INDEX FILE.
C   LUGRB      - AN UNIT NUMBER POINTS TO ONE DEGREE GRIB FILE. SEE 
C                REMARK.
C   LABEL      - 12 WORDS LABEL ON INPUT.  WORDS 1-5 SHOULD CONTAIN
C                LABEL ID OF DESIRED FIELD FLD.
C
C OUTPUT ARGEMENTS:
C   FLD     -- BUFF CONTAINS UNPACK FIELD.
C   LABEL   -- ON OUTPUT THE FULL 12 WORDS OF THE LABEL WILL CONTAIN
C              APPROPRIATE VALUES.
C   MTITL   -- CHARACTER*132 MAP TITLE FROM INDEX FILE.
C              (1:86) IS MAP TITLE, FOLLOWINGS ARE MAP ID.
C   IERR    -- RETURN STATUS
C   IRETUR   - RETURN CONDITION;
C            0 - ALL OK
C            1 - W3FP13/GRIB BLOCK 0 NOT CORRECT
C            2 - W3FP13/LENGTH OF PDS NOT CORRECT
C            3 - W3FP13/COULD NOT MATCH TYPE INDICATOR
C            4 - W3FP13/GRID TYPE NOT IN TABLES
C            5 - W3FP13/COULD NOT MATCH TYPE LEVEL
C            6 - W3FP13/COULD NOT INTERPRET ORIGINATOR OF CODE
C            7 - GRIB TYPE ERROR -- UNKNOWN GRIB TYPE.
C           10 - UNCOGNIZE DATA TYPE FROM LABEL
C           11 - W3FT32/ MAPIN NOT RECOGNIZED
C           12 - W3FT32/ MAPOUT NOT RECOGNIZED
C           13 - W3FT32/ PARTICULAR POLA MAPOUT NOT RECOGNIZED
C           14 - W3FT32/ PARTICULAR LOLA MAPOUT NOT RECOGNIZED
C           15 - W3FT32/ PARTICULAR LOLA MAPIN NOT RECOGNIZED
C           16 - W3FT32/ PARTICULAR POLA MAPOUT NOT RECOGNIZED
C           17 - W3FT32/ PARTICULAR LOLA MAPIN NOT RECOGNIZED
C           18 - W3FT32/ PARTICULAR LOLA MAPOUT NOT RECOGNIZED
C           96 - GETGB/ERROR READING INDEX FILE
C           97 - GETGB/ERROR READING GRIB FILE
C           98 - GETGB/NUMBER OF DATA POINTS GREATER THAN JF
C           99 - GETGB/REQUEST NOT FOUND
C           -1 - GETGB/OTHER  W3FI63 GRIB UNPACKER RETURN CODE
C          101 - W3FP11/NON-FATAL ERROR, MTITLE NOT CORRECT
C
C USAGE:
C   INPUT FILES:
C     UNIT LUGRBIX -  INPUT ONE DEGREE GRIB INDEX FILE.  SEE REMARK.
C     UNIT LUGRB   -  INPUT ONE DEGREE GRIB FILE.  SEE REMARK.
C
C   OUTPUT FILES:
C     FT06F001 -   PRINT OUTPUT (STANDARD FORTRAN OUTPUT FILE)
C
C   SUBPROGRAMS CALLED:
C     UNIQUE:     NONE
C
C     LIBRARY:
C       SPECIAL  - NONE
C       W3LIB    - W3FP11 , W3FP13, GETGB , GBYTES , W3FM08
C                - W3FI63 , W3FT43V,W3FT32, SBYTES
C
C   REMARKS:
C       ***** VERY IMPORTANT ******
C       O. THE INTENTION OF THIS SUBROUTINE IS ONLY FOR AD GRAPHIC SECTION
C          TO READ CRAY GRIB FILES FROM THEIR 84 OFFICE 6 WORD IDS.
C          IT IS NOT GENERAL ENOUGH FOR OTHER GROUP USERS.
C          IT CAN BE MODIFIED TO TAKE 28 BYTE PDS INSTEAD OF 6 WORD 84 ID.
C          BY THIS WAY, IT MAY BE MORE GENERAL THAN IT IS NOW.
C          THIS SUBROUTINE SHOULD NOT BE INCLUDED IN W3LIB AT PRESENT TIME.
C       1. USE ASSIGN COMMAND TO ASSIGN ONE-DEGREE GRIB INDEX TO UNIT LUGRBIX
C       2. USE ASSIGN COMMAND TO ASSIGN ONE-DEGREE GRIB TO UNIT LUGRB
C       FOR EXAMPLE:
C assign -a /com/avn/prod/avn.950912/gblav.T00Z.PGrbiF24 -s unblocked fort.31
C           where LUGRBIX=31
C assign -a /com/avn/prod/avn.950912/gblav.T00Z.PGrbF24 -s unblocked fort.11
C           where LUGRB=11
C       3. ONLY DEAL WITH INPUT DATA TYPE 26, 27 & 101.  OTHER DATA TYPE MAY
C          HAVE FATAL ERROR RETURN AT PRESENT TIME.
C       4. CONCERNING RGL CHARTS, THE 6TH WORD ID SHOULD BE '00000127'.
C       5. FOR NO FORECAST HOUR CHECKING SUCH AS CAC 96H/C, THE THIRD BYTE
C          OF THE 6TH WORD ID SHOULD BE '96'.
C
C
C ATTRIBUTES:
C   LANGUAGE: F90
C   MACHINE:  CRAY
C
C$$$
C
      PARAMETER (IPTS=65160,II=360,JJ=181,MM=361)
      PARAMETER (IPTS2=10512,II2=144,JJ2=73)
      PARAMETER (MXSIZE=66000)
      PARAMETER (MXSIZ2=MXSIZE*2)
      PARAMETER (IIK=289,JJK=145,NPTS=IIK*JJK)
      PARAMETER (IJK=145,LJK=73,MPTS=IJK*LJK)
C
      parameter(ji=360*181,ig27=27,jo=65*65,jo2=129*129)
      parameter(ig26=6)
      real rlat(jo),rlon(jo)
      real rlat2(jo2),rlon2(jo2)
      integer ibi,ibo
      logical lo(jo)
      logical lo2(jo2)
      real    ho(jo)
      real    ho2(jo2)
      integer         kgdsi(22)
C
C
      INTEGER      KGDSO(22)
      CHARACTER    GDSO(42)
      INTEGER      LENGDS
      REAL         DIF,SMLNO
C
      INTEGER         LUGI,LUGRBIX
      INTEGER         LUGB,LUGRB
      INTEGER         LABEL(12)
      REAL            FLD(*)
      CHARACTER * 132 MTITLE
      INTEGER         IERR
      INTEGER         IRET
      INTEGER         ITAU
C
      REAL            C(MXSIZE)
      COMMON   /BITM/ KBMS(66000)
      LOGICAL*1       KBMS
C
      COMMON /PCLP/   PCLPFG
      LOGICAL         PCLPFG
C
      COMMON /PDSCOM/ IFWPDS
      INTEGER         IFWPDS(27)
      REAL            CC(II,JJ)
      REAL            CC2(II2,JJ2)
      REAL            BLOLA(NPTS), CLOLA(MPTS)
C
      INTEGER         IGRIB(16500)
      CHARACTER * 1   GRIB(MXSIZ2)
C
      INTEGER         IPDS(4)
      INTEGER         JPDS(4)
      INTEGER         JGDS(100)
      INTEGER         MPDS(25)
      INTEGER         KGDS(100)
      INTEGER         KPDS(25)
      CHARACTER * 1   PDS(28)
      CHARACTER * 1   PDSL(28)
C
C
       CHARACTER*1     CTEMP(8)
       INTEGER         ITEMP
C
       INTEGER         LIDREC(6)
       CHARACTER*8     CGRIB
       INTEGER         IMODE
C
      INTEGER      LABELP(6)
      CHARACTER*1  CLABELP(48)
      EQUIVALENCE  (LABELP(1),CLABELP(1))
C
      CHARACTER*1  IFLAG
      CHARACTER*1  IDPDSC(28)
      INTEGER      IDPDS(4)
      INTEGER      MSK0,MSK1, MSK2, MSK3, MSK4
      INTEGER      MSKNGM
      INTEGER      ITYPE, IMODEL, FLAG
      INTEGER      MSKFFFF
      INTEGER      MSK2F  
C
      SAVE
C
      EQUIVALENCE     (C(1),CC(1,1),CC2(1,1))
      EQUIVALENCE     (GRIB(1),IGRIB(1))
      EQUIVALENCE     (IPDS(1),PDS(1))
      EQUIVALENCE     (JPDS(1),PDSL(1),IGRIB(2))
      EQUIVALENCE     (CTEMP,ITEMP)
      EQUIVALENCE     (IDPDSC(1),IDPDS(1))
C
      DATA        MSK0      /Z'0000000000000F00'/
      DATA        MSK1      /Z'00000000FFFFFF00'/
      DATA        MSK2      /Z'00000000000000FF'/
      DATA        MSK3      /Z'000000000000FFFF'/
      DATA        MSK4      /Z'0000000000FF0000'/
      DATA        MSKNGM    /Z'0000000000000127'/
      DATA        MSKFFFF   /Z'FFFFFFFF00000000'/
      DATA        MSK2F     /Z'FFFF000000000000'/
C
C***********************************************************************
C
C
      IRET   = 0
      IERR = 0
      LUGI = LUGRBIX
      LUGB = LUGRB
      PCLPFG = .FALSE.
C
      ITYPE = IAND(LABEL(5),MSK2)
      PRINT 79, LABEL(5)
  79  FORMAT(' LABEL(5)=', Z8)
      IDN = IAND(LABEL(5),MSK0)
      PRINT *, ' ITYPE=', ITYPE
      IMODEL = IAND(LABEL(6),MSK3)
      FLAG = IAND(LABEL(6),MSK4)
C
         IF (IMODEL .EQ. MSKNGM) THEN
              LABEL(6) = 0
              LABEL(7) = 0
              LABEL(8) = 39
         ENDIF
C
C*************************************************************
              CALL SBYTES(LABELP,LABEL,0,32,0,8)
C             ..... PACK 8-WORD ID TO 4-WORD CRAY ID
              IFLAG    = CHAR(128)
C             .... 128 FOR GDS, 64 FOR BITMAP, 192 FOR BOTH
              ICENT = 20
              ISCALE = 0
C*************************************************************
C
              WRITE(6,224)(LABEL(I),I=1,12)
  224         FORMAT(1X,'LABEL=',/,2(1X,6(Z16,1X),/))
              WRITE(6,226)(LABELP(I),I=1,4)
  226         FORMAT(1X,'LABELP=',/,(1X,4(Z16,1X),/))
              WRITE(6,227)(IDPDS(I),I=1,4)
  227         FORMAT(1X,'IDPDS=',/,(1X,4(Z16,1X),/))
C
         IF (IMODEL .EQ. MSKNGM) THEN
              IDPDSC(4) = CHAR(02)
              IDPDSC(6) = CHAR(39)
              IDPDSC(7) = CHAR(06)

              IF (ITYPE .EQ. 101) THEN
                 IDPDSC(7) = CHAR(101)
                 PRINT *, ' TRY TO GET A NGM C-GRID'
              ENDIF

              ITEMP = IAND(IDPDS(2),MSKFFFF)

         ENDIF
C
C             .... MODIFY PDS TO POINT TO 1-DEGREE GRIB
              DO I=1, 28
                 PDS(I) = IDPDSC(I)
              ENDDO
C
      JREW   = 0
      MPDS   = -1
      MPDS(3) = MOVA2I(PDS(7))
      MPDS(5) = MOVA2I(PDS(9))
      MPDS(6) = MOVA2I(PDS(10))
      MPDS(7) = MOVA2I(PDS(11)) * 256 + MOVA2I(PDS(12))
C
      IF (KPDS(16) .EQ. 0) THEN
         ITAU = KPDS(14)
      ELSE IF (KPDS(16) .EQ. 2) THEN
         ITAU = KPDS(15)
      ELSE IF (KPDS(16) .EQ. 3) THEN
         ITAU = 0
      ELSE IF (KPDS(16) .EQ. 4) THEN
         ITAU = KPDS(15)
      ELSE IF (KPDS(16) .EQ. 10) THEN
         ITAU = KPDS(14)
      ELSE
         PRINT *,' **ERROR - CAN NOT GET TAU.  KPDS(16)=',KPDS(16)
      ENDIF
C
      print *,' ITAU=', itau
C
  700 CONTINUE
C
      IF (KPDS(3) .EQ. 101 .AND. ITYPE .EQ. 101) THEN
          DO III=1, 10283
             FLD(III) = C(III)
          ENDDO
      ENDIF

C     write(*,810)(buff(i),i=1,1440)
C810  format( 180(8(f10.3,2x),/))
C
               CALL W3FP11 (IGRIB,IGRIB(2),MTITLE,IRET)
C
C     .... to get a map title
C
      IF (IRET .NE. 0) THEN
         PRINT *, ' ** NOT A FATAL ERROR FROM W3FP11 -- ', IRET
         IERR = 101
      ENDIF
C
C     print *,' '
C     print *,title(1:86)
C     print *,' '
C
         CGRIB(1:1) = CHAR(71)
         CGRIB(2:2) = CHAR(82)
         CGRIB(3:3) = CHAR(73)
         CGRIB(4:4) = CHAR(66)
         CGRIB(5:5) = CHAR(0)
         CGRIB(6:6) = CHAR(0)
         CGRIB(7:7) = CHAR(0)
         CGRIB(8:8) = CHAR(1)
C
         print *,'idn=',idn
         PRINT 81, (JPDS(I),I=1,4)
  81     FORMAT(' JPDS=', Z16)
C     148   PDS(7) = CHAR(27)
         GRIB(15) = CHAR(ITYPE)
C
         CALL W3FP13(CGRIB,JPDS,LIDREC,IRET)
         CALL W3FI69(JPDS, IFWPDS)
         KCENT=IFWPDS(23)
         PRINT *, 'KCENT=',KCENT
C
         IF (IRET .NE. 0) THEN
            CALL GBYTES(LIDREC,LABEL,0,32,0,12)
            LABEL(1) = IOR(LABEL(1),ITAU)
C           print *,' label after ='
C           write (*,224)(label(k),k=1,12)
         ENDIF
C
      RETURN
      END
