      SUBROUTINE RPKPHS4(NF,G,NLEV,IBUF,LON,NLAT,ILAT,LEV,LH,GG,OK) 

C     * JUL 10/03 - M. LAZARE. NEW ROUTINE, BASED ON RPKPHS3, BUT USING
C     *                        CODE SIMILAR TO OTHER INPUT ROUTINES TO
C     *                        PRODUCE "PAK" REORDERED DATA RELEVANT
C     *                        FOR THE PARTICULAR NODE. "NLAT" IS PASSED
C     *                        INSTEAD OF "ILEV" AND WORK ARRAY "GG"
C     *                        ADDED TO CALL. ** NOTE ** THAT THESE
C     *                        CHANGES ARE NOT PART OF THE WRITE
C     *                        (WPKPHS4) REVISION, SINCE THERE EACH NODE
C     *                        WRITES OUT ITS OWN REORDERED DATA WHICH
C     *                        IS POST-PROCESSED OUTSIDE OF THE MODEL. 

C     * NOV 20/94 - M. LAZARE. PREVIOUS VERSION RPKPHS3.
  
C     * READS FROM THE SEQUENTIAL FILE NF THE PACKED ARRAY G WHOSE
C     * EIGHT WORD LABEL IS GIVEN BY IBUF.

C     * THE REPEATING GRENWICH LONGITUDE IS STRIPPED OFF BEFORE
C     * INSERTING INTO ARRAY G.
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     * 
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     *        NLAT  = NUMBER OF GAUSSIAN LATITUDES.
C     *        ILAT  = NUMBER OF GAUSSIAN LATITUDES ON EACH NODE.
C     *         LEV  = ILEV+1 
C     *          LH  = VECTOR OF MODEL HALF-LEVEL SIGMA VALUES. 
C     *          GG  = WORK FIELD TO DO ACTUAL I/O.
C     * 
C     * OUTPUT: G    = PACKED ARRAY.
C     *         OK   = LOGICAL SWITCH. WHEN THE EXECUTION IS INCORRECT
C     *                OK IS FALSE. 
C
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N) 
  
      INTEGER IBUF(8), KBUF(8), LH(NLEV)
      REAL G ( LON*ILAT+1, NLEV)
      REAL GG( (LON+1)*NLAT)
      LOGICAL OK
C-----------------------------------------------------------------------
      OK = .FALSE. 
      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('RPKPHS4',-1)
                 KBUF(4) = 0
              ELSE
                 KBUF(4) = LH(LEV-L)
              ENDIF 
          ELSE
              KBUF(4) = LH(L)
          ENDIF 
C
          CALL GETGGBX(G(1,L),KBUF(3),NF,LON1,NLAT,KBUF(2),KBUF(4),GG)
  100 CONTINUE
C
      DO 300 I=1,8
          IBUF(I)=KBUF(I)
  300 CONTINUE
C
      OK = .TRUE. 
      RETURN
C-------------------------------------------------------------------- 
      END
