      SUBROUTINE WPKPHS3(NF,G,NLEV,IBUF,LON,ILAT,ILEV,LEV,LH,IPKGRD)

C     * NOV 22/94 - M. LAZARE. PROCESSING WITH CYCLIC LATITUDE NOW
C     *                        PROPERLY DEFINED TO HANDLE 32-BIT
C     *                        MACHINES AS WELL, AS DONE IN RPKPHS3.
C     * FEB 20/93 - M. LAZARE. I/O NOW DONE ON COMPLETE GRIDS INSTEAD
C     *                        OF LATITUDE SLICES.
C     * JUL 31/92 - M. LAZARE, E. CHAN, P. MASIER. PREVIOUS VERSION
C     *                        WPKPHS2.
  
C     * WRITES A PACKED ARRAY G, PRECEEDED BY ITS EIGHT WORD LABEL,
C     * TO THE SEQUENTIAL FILE NF.

C     * THE REPEATING GRENWICH LONGITUDE IS ADDED BEFORE WRITING
C     * ARRAY G TO THE SEQUENTIAL FILE.
C     * NOTE THAT THIS CALCULATION, TO AVOID THE OVERHEAD OF GOING
C     * THROUGH THE PACKER, ASSUMES ALL GRID FIELDS ARE UNPACKED
C     * INTERNALLY IN THE GCM (NEW STANDARD).
  
C     * G CAN BE MULTIDIMENTIONAL, BUT OTHERWISE NLEV HAS TO BE SET 
C     * TO ONE. 
  
C     * THE FIELDS EMD,EMM ARE HANDLED DIFFERENTLY BECAUSE THEY HAVE
C     * "LEV" LEVELS AND ARE ORDERED BOTTOM UP. 
C
C     * INPUT: NF    = SEQUENTIAL RESTART FILE. 
C     *        NLEV  = NUMBER OF LEVELS. CAN BE EITHER 1,LEV,ILEV,LEVS. 
C     *        IBUF  = EIGHT WORD LABEL.
C     *         LON  = NUMBER OF DISTINCT EQUALLY-SPACED LONGITUDES.
C     *        ILAT  = NUMBER OF GAUSSIAN LATITUDES.
C     *        ILEV  = NUMBER OF MODEL SIGMA LEVELS.
C     *         LEV  = ILEV+1 
C     *          LH  = VECTOR OF MODEL HALF-LEVEL SIGMA VALUES. 
C     *        IPKGRD= LENGTH OF PACKED GRID. 
C     * 
C     * OUTPUT: G    = PACKED ARRAY PRECEDED BY THE EIGHT WORD
C     *                LABEL IBUF.
C 
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)

      INTEGER G(1)
      INTEGER IBUF(8),KBUF(8),LH(NLEV)
      INTEGER NGRENV(2)

      COMMON /ICOM/ JBUF(8), IDAT(1)
      COMMON /MACHTYP/ MACHINE,INTSIZE
C----------------------------------------------------------------------
      JX=0
      LON1=LON+1
C
      DO 30 I=1,8
        KBUF(I)=IBUF(I)      
   30 CONTINUE
C
      DO 100 L = 1,NLEV 
          IF( NLEV.EQ.1 )         THEN
              KBUF(4) = 1
          ELSE IF( NLEV.EQ.LEV )  THEN
              IF( L.EQ.LEV ) THEN 
              IF(KBUF(3).NE.NC4TO8(" EMD") .AND. 
     1           KBUF(3).NE.NC4TO8(" EMM")) CALL XIT('WPKPHS3',-1)
                 KBUF(4) = 0
              ELSE
                 KBUF(4) = LH(LEV-L)
              ENDIF 
          ELSE
              KBUF(4) = LH(L)
          ENDIF 
C
          DO 60 J=1,ILAT
             DO 50 I=1,LON
               DO 40 INT=1,INTSIZE 
                  N=INTSIZE*((J-1)*LON1+(I-1))+INT
                  JX=JX+1
                  IDAT(N)=G(JX)
                  IF(I.EQ.1) NGRENV(INT)=G(JX)
   40          CONTINUE 
   50        CONTINUE
             NGREN=INTSIZE*((J-1)*LON1+LON)
             DO 55 INT=1,INTSIZE
                IDAT(NGREN+INT)=NGRENV(INT)
   55        CONTINUE
   60     CONTINUE
C
          DO 70 I=1,8
              JBUF(I)=KBUF(I)      
   70     CONTINUE
C
          CALL RECPUT(NF,JBUF)
  100 CONTINUE
C
      DO 300 I=1,8
          IBUF(I)=KBUF(I)      
  300 CONTINUE
C
      RETURN
      END
