      SUBROUTINE GRIBP(grid_config,storm_hem)
      PARAMETER (IMX=75,  JMX=75, KMX=20)
C
      common /cloud/    VCWAT(IMX,JMX),
     *                  VRAIN(IMX,JMX),VICE(IMX,JMX)

      character  grid_config*11,storm_hem*8
      COMMON  /OUTP/    PSTAR(IMX,JMX),PRECIP(IMX,JMX),
     *                PRECIPC(IMX,JMX),PRECIPL(IMX,JMX),
     *                    USF(IMX,JMX),   VSF(IMX,JMX),
     *                 UU(IMX,JMX,KMX),    VV(IMX,JMX,KMX),
     *                 TT(IMX,JMX,KMX),    RR(IMX,JMX,KMX),
     *                 CL(IMX,JMX,KMX),    RW(IMX,JMX,KMX),
     *                 TI(IMX,JMX,KMX),    RM(IMX,JMX,KMX),
     *                 OM(IMX,JMX,KMX),    HR(IMX,JMX,KMX),
     *                 HC(IMX,JMX,KMX),    HL(IMX,JMX,KMX),
     *                 HH(IMX,JMX,KMX),   SST(IMX,JMX),PSURF(IMX,JMX)
      DIMENSION FLD(IMX,JMX)
C
CC      DATA  IYEAR  /95/
C  
      INTEGER         IBDSFL(9)
      INTEGER         ID(25)
      INTEGER         IGDS(18),IGRIB(256)
C                                                                                                                
      CHARACTER * 1   KBUF(102400)
      CHARACTER * 1   PDS(28)
C
      EQUIVALENCE (KBUF(1),IGRIB(1) )
C
CXXXXXXXXXXXXXXXXXX  TEST CASE>>>>>>
C      IDAY = 29
C      IMON  = 8
C      IHOR  = 0
C      ITIME = 72
C      IWEST  = -114500
CXXXXXXXXXXXXXXXX<<<<<<<<<
C
      READ(35,*)IYEAR
C
C
      ILEVC = 0
C
C   BRING IN DATA FROM THE INITIATE FILE
C
      READ(19,*)BOUNDW
      IBOUNDW = IFIX(BOUNDW)
C
      IWEST  = IBOUNDW*1000 + 500
C
      READ(10,*)IDAY,IMON,IHOR,ITIME
C  
C      
C      IDAY = 29
C      IMON  = 8
C      IHOR  = 0
C      ITIME = 72
C
C####################################################################
C
C   SET THE RANGE OF DATA IN DEGREES * 1000 
C     
C
      if (storm_hem == 'northern') then
        if (grid_config == 'poleward') then
          ISOUTH = -9500
        else
          ISOUTH = -14500
        endif
      else
        if (grid_config == 'poleward') then
          ISOUTH = -64500
        else
          ISOUTH = -59500
        endif
      endif

      INORTH = ISOUTH + 74000
      IEAST  = IWEST  + 74000
C
      print*,'boundary:',ISOUTH,IWEST,INORTH,IEAST
C
C####################################################################
C 
C   DEAL WITH OTHER PARAMETERS
C
C     ITYPE = 0 FOR REAL ARRAY
C
       ITYPE = 0
C
       IFLD  = 0
       IBITL = 0
C
C   ICOMP = 0     EARTH ORIENTED WINDS <----- 
C   ICOMP = 1     GRID ORIENTED  WINDS  
C
       ICOMP = 0
C
C   SET BIT MAPS TO ZERO
C
      IBFLAG = 0
       IBMAP = 0
       IBLEN = IMX*JMX
C
C   HAVE PROGRAM MAKE PDS FROM USER SUPPLIED (ID)
C
      IPFLAG = 0
C 
C##################################################################
C
C     READ IN THE MODEL DATA INTERPOLATED TO 75 X 75 GRID AND
C     PRESSURE (hPa) LEVELS:
C
C
C
C   ONE DEGREE RESOLUTION OF DATA
C
      IRES = 1000
C
C   SET TABLE 11 SPECIFICS
C
      IBDSFL(1) = 0
      IBDSFL(2) = 0
      IBDSFL(3) = 0
      IBDSFL(4) = 0
      IBDSFL(5) = 0
      IBDSFL(6) = 0
      IBDSFL(7) = 0
      IBDSFL(8) = 0
      IBDSFL(9) = 0
C
C################################################################## 
C
C    DEFINE IGDS FOR THE GDS  (GRID DESCRIPTION SECTION)
C           THIS WILL BE THE DONE FOR EACH VARIABLE
C           BY SETTING IGFLAG TO 1 AND IGRID TO 255.....
C
      IGFLAG = 1
      IGRID  = 255
C
      IGDS(1) = 0
      IGDS(2) = 255
      IGDS(3) = 0
      IGDS(4) = JMX
      IGDS(5) = IMX
      IGDS(6) = ISOUTH
      IGDS(7) = IWEST
      IGDS(8) = 128
      IGDS(9) =  INORTH
      IGDS(10) = IEAST
      IGDS(11) = IRES
      IGDS(12) = IRES
      IGDS(13) = 64
      IGDS(14) = 0
      IGDS(15) = 0
      IGDS(16) = 0
      IGDS(17) = 0
      IGDS(18) = 0
C
C###################################################################
C
C     SET UP DATA AND DATA SPECIFICS TO PACK INTO GRIB FORMAT 
C
C     FIRST FOR EACH OF THE NINE VARIABLES
C
      DO 50 IVR = 1 , 26
C
C     THE FIRST FOUR VARIABLES ARE ONLY SURFACE VARIABLES
C     THE REST ARE FUNCTIONS OF EACH PRESSURE LEVEL (1000 TO 50 hPa)
C
      KXX = 1
      IF(IVR.GT.5 .AND. IVR .LT. 23)THEN
        if (ivr >= 19 .and. ivr <= 21) then
          kxx = 1
        else
          KXX = 20
        endif
      ENDIF
      IF(IVR .GE. 23)THEN
      KXX = 1
      ENDIF
C
C     NEXT FOR EACH VERTICAL LEVEL (50 hPa to 1000 hPa)
C
      DO 60 KK = 1 , KXX
C
C
C   DEAL WITH SEA LEVEL PRESSURE (Pa)
C
      IF(IVR.EQ.1)THEN
      IPARAM = 2
      ILEVT = 102
      ISCALE   = -1
      LEV   = 0
      DO 120 J = 1 , JMX
      DO 120 I = 1 , IMX
      FLD(I,J) = PSTAR(I,J)
120   CONTINUE
      ENDIF
C
C
C   DEAL WITH PRECIP (kg/m2)
C
      IF(IVR.EQ.2)THEN
      IPARAM = 61
      ILEVT = 1
      ISCALE   = 0
      LEV   = 0
      DO 130 J = 1 , JMX
      DO 130 I = 1 , IMX
      FLD(I,J) = PRECIP(I,J)
130   CONTINUE
      ENDIF
C
C
C   DEAL WITH SURFACE U (m/s2)
C
      IF(IVR.EQ.3)THEN
      IPARAM = 33
      ILEVT = 105
      LEV   = 35
      ISCALE   =  1
      DO 135 J = 1 , JMX
      DO 135 I = 1 , IMX
      FLD(I,J) = USF(I,J)
135   CONTINUE
      ENDIF
C
C
C   DEAL WITH SURFACE V (m/s2)
C
      IF(IVR.EQ.4)THEN
      IPARAM = 34
      ILEVT = 105
      LEV   = 35
      ISCALE   =  1
      DO 145 J = 1 , JMX
      DO 145 I = 1 , IMX
      FLD(I,J) = VSF(I,J)
145   CONTINUE
      ENDIF
C
C
C  DEAL WITH SSTs
C
      IF(IVR.EQ.5)THEN
      IPARAM = 11   
      ILEVT = 1
      ISCALE   =  1
      LEV   = 0
      DO J = 1 , JMX
      DO I = 1 , IMX
      FLD(I,J) = SST(I,J)
      ENDDO   
      ENDDO
      ENDIF

C
C
C   DEAL WITH VERTICALLY INTEGRATED CLOUD WATER (gm/m3)
C
      IF(IVR.EQ. 23)THEN
       IPARAM = 136
       ILEVT = 1
       ISCALE   =  3
       LEV   = 0
      DO J = 1 , JMX
      DO I = 1 , IMX
        FLD(I,J) = VCWAT(i,j)
      ENDDO
      ENDDO
      ENDIF
C
C   DEAL WITH VERTICALLY INTEGRATED RAIN WATER (gm/m3)
C
      IF(IVR.EQ. 24)THEN
       IPARAM = 138
       ILEVT = 1
       ISCALE   =  3
       LEV   = 0
      DO J = 1 , JMX
      DO I = 1 , IMX
        FLD(I,J) = VRAIN(i,j)
      ENDDO
      ENDDO
      ENDIF
C
C   DEAL WITH VERTICALLY INTEGRATED ICE (gm/m3)
C
      IF(IVR.EQ. 25)THEN
       IPARAM = 139
       ILEVT = 1
       ISCALE  =  3
       LEV   = 0
      DO J = 1 , JMX
      DO I = 1 , IMX
        FLD(I,J) = VICE(i,j)    
      ENDDO
      ENDDO
      ENDIF
C
C   DEAL WITH VERTICALLY INTEGRATED CONDENSATE (gm/m3)
C
      IF(IVR.EQ. 26)THEN
       IPARAM = 140
       ILEVT = 1
       ISCALE  =  3
       LEV   = 0
      DO J = 1 , JMX
      DO I = 1 , IMX
        FLD(I,J) = vcwat (i,j) + vrain (i,j) + vice(i,j)
      ENDDO
      ENDDO
      ENDIF

C   DEAL WITH U (m/s2)
C
      IF(IVR.EQ.6)THEN
      IPARAM = 33
      ILEVT = 100
      ISCALE   =  1
      LEV   = 50*KK
      DO 151 J = 1 , JMX
      DO 151 I = 1 , IMX
      FLD(I,J) = UU(I,J,KK)
151   CONTINUE
      ENDIF
C
C
C   DEAL WITH V (m/s2) 
C
      IF(IVR.EQ.7)THEN
      IPARAM = 34
      ILEVT = 100
      ISCALE   =  1
      LEV   = 50*KK
      DO 155 J = 1 , JMX
      DO 155 I = 1 , IMX
      FLD(I,J) = VV(I,J,KK)
155   CONTINUE
      ENDIF
C
C
C   DEAL WITH T (K)
C
      IF(IVR.EQ.8)THEN
      IPARAM = 11
      ILEVT = 100
      ISCALE   =  1
      LEV   = 50*KK
      DO 165 J = 1 , JMX
      DO 165 I = 1 , IMX
      FLD(I,J) = TT(I,J,KK)
165   CONTINUE
      ENDIF
C
C
C   DEAL WITH HUMIDITY (%)
C
      IF(IVR.EQ.9)THEN
      IPARAM = 52
      ILEVT = 100
      ISCALE   =  1
      LEV   = 50*KK
      DO 175 J = 1 , JMX
      DO 175 I = 1 , IMX
      FLD(I,J) = RR(I,J,KK)
175   CONTINUE
      ENDIF
C
C
C   DEAL WITH HEIGHT (M)
C
      IF(IVR.EQ.10)THEN
       IPARAM = 7
       ILEVT = 100
       ISCALE   =  -1
       LEV   = 50*KK
       IF(KK.GT.5)THEN
       ISCALE   =  0
       ENDIF
C
      DO 185 J = 1 , JMX
      DO 185 I = 1 , IMX
      FLD(I,J) = HH(I,J,KK)
185   CONTINUE
      ENDIF
C     
C_________________________________________
C     
C   DEAL WITH MIXING RATIO (gm/kg)
C     
      IF(IVR.EQ.11)THEN
       IPARAM = 53
       ILEVT = 100
       ISCALE   =  3
       LEV   = 50*KK
      DO J = 1 , JMX
      DO I = 1 , IMX
      FLD(I,J) = RM(I,J,KK)
      ENDDO
      ENDDO
      ENDIF
C     
C   DEAL WITH CLOUD WATER (gm/kg)
C     
      IF(IVR.EQ.12)THEN
       IPARAM = 153
       ILEVT = 100
       ISCALE   =  3
       LEV   = 50*KK
      DO J = 1 , JMX
      DO I = 1 , IMX
      FLD(I,J) = CL(I,J,KK)
      ENDDO
      ENDDO
      ENDIF
C     
C   DEAL WITH RAIN WATER (gm/kg)
C     
      IF(IVR.EQ.13)THEN
       IPARAM = 170
       ILEVT = 100
       ISCALE   =  3
       LEV   = 50*KK
      DO J = 1 , JMX
      DO I = 1 , IMX
      FLD(I,J) = RW(I,J,KK)
      ENDDO
      ENDDO
      ENDIF
C     
C   DEAL WITH ICE (gm/kg)
C     
      IF(IVR.EQ.14)THEN
       IPARAM = 178
       ILEVT = 100
       ISCALE  =  3
       LEV   = 50*KK
      DO J = 1 , JMX
      DO I = 1 , IMX
      FLD(I,J) = TI(I,J,KK)
      ENDDO
      ENDDO
      ENDIF
C 
C     
C   DEAL WITH OMEGA
C     
      IF(IVR.EQ.15)THEN
       IPARAM = 39
       ILEVT = 100
       ISCALE  =  2
       LEV   = 50*KK
      DO J = 1 , JMX
      DO I = 1 , IMX
      FLD(I,J) = OM(I,J,KK)
      ENDDO
      ENDDO
      ENDIF

C   DEAL WITH CONVECTIVE HEATING RATE
C
      IF(IVR.EQ.16)THEN
       IPARAM = 242
       ILEVT = 100
       ISCALE  =  2
       LEV   = 50*KK
      DO J = 1 , JMX
      DO I = 1 , IMX
      FLD(I,J) = HC(I,J,KK)
      ENDDO
      ENDDO
      ENDIF
C
C   DEAL WITH LARGE-SCALE HEATING RATE
C
      IF(IVR.EQ.17)THEN
       IPARAM = 241
       ILEVT = 100
       ISCALE  =  2
       LEV   = 50*KK
      DO J = 1 , JMX
      DO I = 1 , IMX
      FLD(I,J) = HL(I,J,KK)
      ENDDO
      ENDDO
      ENDIF
C
C   DEAL WITH TOTAL HEATING RATE
C
C     
C   DEAL WITH HEATING RATE
C     
      IF(IVR.EQ.18)THEN
       IPARAM = 215
       ILEVT = 100
       ISCALE  =  2
      LEV   = 50*KK
      DO J = 1 , JMX
      DO I = 1 , IMX
      FLD(I,J) = HR(I,J,KK)
      ENDDO
      ENDDO
      ENDIF
C
C  DEAL WITH surface pressure (Pa)
C
      IF(IVR.EQ.19)THEN
      IPARAM = 1
      ILEVT = 1
      ISCALE = -1
      LEV   = 0
      DO J = 1 , JMX
      DO I = 1 , IMX
      FLD(I,J) = PSURF(I,J)
      ENDDO
      ENDDO
      ENDIF
C

C
C   DEAL WITH CONVECTIVE-SCALE PRECIP (kg/m2)
C
      IF(IVR.EQ.20)THEN
      IPARAM = 63
      ILEVT = 1
      ISCALE   = 0
      LEV   = 0
      DO  J = 1 , JMX
      DO  I = 1 , IMX
      FLD(I,J) = PRECIPC(I,J)
      ENDDO
      ENDDO
      ENDIF
C

C
C   DEAL WITH LARGE-SCALE PRECIP (kg/m2)
C
      IF(IVR.EQ.21)THEN
      IPARAM = 62
      ILEVT = 1
      ISCALE   = 0
      LEV   = 0
      DO J = 1 , JMX
      DO I = 1 , IMX
      FLD(I,J) = PRECIPL(I,J)
      ENDDO
      ENDDO
      ENDIF
C
C
C   DEAL WITH COMBINED CONDENSATES (gm/kg)
C
      IF(IVR.EQ.22)THEN
       IPARAM = 179 
       ILEVT = 100
       ISCALE   =  3
       LEV   = 50*KK
      DO J = 1 , JMX
      DO I = 1 , IMX
      FLD(I,J) = CL(I,J,KK) + RW(I,J,KK) + TI(I,J,KK)
      ENDDO
      ENDDO
      ENDIF
C______________________________________________
C
C       IF(IVR.EQ.9)PRINT*,'HEIGHT ',KK,LEV,HH(15,45,KK)
C       IF(IVR.EQ.7)PRINT*,'TEMPER ',KK,LEV,TT(15,45,KK)
C       IF(IVR.EQ.8)PRINT*,'HUMIDT ',KK,LEV,RR(15,45,KK)
C       IF(IVR.EQ.2)PRINT*,'PRECIP ',KK,LEV,PRECIP(15,45)
C       IF(IVR.EQ.1)PRINT*,'PSTAR  ',KK,LEV,PSTAR(15,45)
C       IF(IVR.EQ.3)PRINT*,'U-SRF  ',KK,LEV,USF(15,45)
C       IF(IVR.EQ.4)PRINT*,'V-SRF  ',KK,LEV,VSF(15,45)
C
C#########################################################################
C
C     MAKE THE ID(25) ELEMENTS FOR THE PDS (PRODUCT DEFINITION SECTION)
C
      ID(1) = 28
 
      if(IVR .GE. 23) then
       ID(2) = 129
      else
       ID(2) = 2
      endif

      ID(3) = 7
      ID(4) = 70
      ID(5) = 255
      ID(6) = 1
      ID(7) = 0
      ID(8) = IPARAM
C
      ID(9) = ILEVT
      ID(10) = 0
      ID(11) = LEV
C
      ID(12) = mod(IYEAR,100)
      ID(13) = IMON
      ID(14) = IDAY
      ID(15) = IHOR
      ID(16) = 0
      ID(17) = 1
      ID(18) = ITIME
C
      ID(19) = 0
      ID(20) = 0
      ID(21) = 0
      ID(22) = 0
      ID(23) = iyear/100 + 1
      ID(24) = 0
c
      if (iparam == 61) then
        ! Add PDS ID's for precip to indicate accumulation and the
        ! hours that make up the inclusive accumulation period.
        if (ID(18).eq.0) then
          ID(18) = 0
          ID(19) = 0
        else
          ID(18) = ID(18) - 6
          ID(19) = ID(18) + 6
        endif
        ID(20) = 4
      endif
C
      ID(25) = ISCALE
 
c     NOTE: In GRIB format, the proper notation for the year 2000 
c           is the 100th year of the 20th century, so adjust the
c           above values accordingly....

      if (mod(iyear,100) .eq. 0) then
        ID(12) = 100
        ID(23) = ID(23) - 1
      endif
C
C#######################################################################
C
C    CALL THE NMC PACKING ROUTINES...............
C
C
         CALL W3FI72(ITYPE,FLD,IFLD,IBITL,
     *              IPFLAG,ID,PDS,
     *              IGFLAG,IGRID,IGDS,ICOMP,
     *              IBFLAG,IBMAP,IBLEN,IBDSFL,
     *              NPTS,KBUF,ITOT,JERR)
C 
       ILEVC = ILEVC + 1
C
C       WRITE THEM TO DISK
C
       CALL GWRITE(KBUF,ITOT)
C
C
C
60     CONTINUE
C
C
50     CONTINUE
C
       PRINT*
       PRINT*,'TOTAL GRIB LEVELS PACKED: ',ILEVC
C
       RETURN
       END
