      SUBROUTINE PUTGGB3(GGPAK,ILG1,ILAT,KHEM,NPGG,KOUNT,
     1                   NF,NAME,LEV,GLL,WRKS)
C
C     * OCT 11/06 - F.MAJAESS (REPLACE DIRECT BINARY "DATA" RECORD
C     *                        WRITES BY "PUTFLD2" CALLS).
C     * DEC 19/03 - M.LAZARE. HARD CODE "XPAK" LOCAL ARRAY DIMENSION
C     *                       DUE TO ENCOUNTERED PROBLEM WITH "NANS"
C     *                       INITIALIZATION UNDER AIX.
C     * DEC 05/03 - R.MCLAY/  SUPPORT FOR MPI I/O ADDED, AS AN OPTION
C     *             M.LAZARE. BASED ON SWITCH "IPIO" PASSED THROUGH
C     *                       COMMON BLOCK.
C     * MAY 29/95 - M.LAZARE. PREVIOUS VERSION PUTGGB2.
C
C     * UNPACKS A GAUSSIAN GRID IN GGPAK ROW BY ROW FROM THE GCM. 
C     * THE UNPACKED GRID IS SAVED ON FILE NF.
C     * THE FIRST POINT IN EACH ROW IS COPIED INTO THE LAST POINT.
C 

      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)

      COMMON /SIZES/  LONSL,NLAT,ILEV,LEVS,LRLMT,ICOORD,LAY,PTOIT,MOIST

      INTEGER*4 MYNODE 
      COMMON /MPINFO/ MYNODE 

C     * COMMON BLOCK to hold the number of nodes and communicator. 

      INTEGER*4 NNODE, AGCM_COMMWRLD, MY_CMPLX_TYPE, MY_REAL_TYPE
      INTEGER*4 MY_INT_TYPE
      COMMON /MPICOMM/ NNODE, AGCM_COMMWRLD, MY_CMPLX_TYPE,MY_REAL_TYPE,
     1                 MY_INT_TYPE

      REAL GGPAK(ILAT*(ILG1-1))
      REAL WRKS(1)
      COMMON /KEEPTIM/ IYEAR,IMDH,MYRSSTI,ISAVDTS

      REAL, TARGET  :: GLL(ILG1*ILAT) 
C     REAL, TARGET  :: XPAK(NLAT*ILG1)

C     * HARD CODE "XPAK" DIMENSION DUE TO PROBLEM WITH "NANS" INITIALIZATION
C     * UNDER AIX. IT'S SET TO HANDLE UP TO 641X320 (T213 GRID).

      REAL, TARGET  :: XPAK(205120)
      REAL, POINTER :: GBUF(:)

      INTEGER*4 SZ, MASTER, IERR
C
C     * COMMON BLOCK TO HOLD SWITCH FOR DOING PARALLEL I/O OR NOT.
C
      COMMON /IPARIO/ IPIO     
C
C     * COMMON BLOCK TO HOLD LOGICAL SWITCH FOR RCM.
C
      LOGICAL LRCM
      COMMON /MODEL/  LRCM

C     * ICOM IS A SHARED I/O AREA. IT MUST BE LARGE ENOUGH
C     * FOR AN 8 WORD LABEL FOLLOWED BY A PACKED GAUSSIAN GRID.
C
      COMMON /ICOM/ IBUF(8),IDAT(1)
C---------------------------------------------------------------------
      IF(ILG1*NLAT.GT.205120)            CALL XIT('PUTGGB3',-1)
      IGRID=NC4TO8("GRID")
      NPACK=0 

C     * DETERMINE PROPER IBUF(2) TO USE FOR SAVED FIELDS, BASED ON
C     * VALUE OF OPTION SWITCH "ISAVDTS".
C     * NOTE THAT THE VALUE OF "NF" IS CHECKED TO SEE IF WE ARE
C     * WRITING TO THE INTERACTIVE FILE; IF SO KOUNT IS USED IN
C     * IBUF(2) REGARDLESS OF WHETHER WE ARE RUNNING WITH THE
C     * DATE-TIME STAMP OR NOT. 
C     * THIS ENABLES US TO JUST USE PUTGGB3 AND NOT REQUIRE A SEPARATE
C     * SUBROUTINE PUTGGBX TO WRITE TO THE INTERACTIVE FILE.
C
      IF(ISAVDTS.NE.0 .AND. NF.NE.19)                   THEN
C        * IN 32-BIT, THIS ONLY WORKS UNTIL IYEAR=2147!
         IBUF2=1000000*IYEAR + IMDH
      ELSE
         IBUF2=KOUNT
      ENDIF
C 
C     * STORE VALUES OF GGPAK INTO GLL, ADDING CYCLIC LONGITUDE.
C     * NOTE THAT THIS IS NOT DONE FOR THE RCM!
C
      ILG=ILG1-1
      IF(.NOT.LRCM)                       THEN      
        DO 210 J=1,ILAT 
          IJ   = (J-1)*ILG1
          IOFF = (J-1)*ILG
          DO 200 I=1,ILG
            GLL(IJ+I)=GGPAK(IOFF+I)
  200     CONTINUE
          GLL(IJ+ILG1)=GLL(IJ+1)
  210   CONTINUE
      ENDIF

      IF (NNODE.GT.1 .AND. IPIO.EQ.0) THEN
C
C       * ABORT IF TRYING TO RUN THE RCM WITH MPI - NOT SUPPORTED.
C
        IF(LRCM)      CALL XIT('PUTGGB3',-2)
C
C       * GATHER GLL into GBUF (=>XBUF) FROM ALL NBR NODES.
C
        MASTER = 0
        SZ     = ILAT*ILG1
        GBUF => XPAK(1:ILG1*NLAT)
        CALL WRAP_GATHER(GLL   , SZ,            MY_REAL_TYPE, 
     1                   GBUF  , SZ,            MY_REAL_TYPE,  
     2                   MASTER, AGCM_COMMWRLD, IERR)
C 
        IF (MYNODE == 0) THEN
          CALL SETLAB(IBUF,IGRID,IBUF2,NAME,LEV,ILG1,NLAT,KHEM,NPACK)
          MAXX=ILG1*NLAT
          CALL PUTFLD2(NF,GBUF,IBUF,MAXX)
        ENDIF

      ELSE

        IF(LRCM)                                                   THEN
          CALL SETLAB(IBUF,IGRID,IBUF2,NAME,LEV,ILG,ILAT,KHEM,NPACK)
          MAXX=ILG*ILAT
          CALL PUTFLD2(NF,GGPAK,IBUF,MAXX)
        ELSE
          CALL SETLAB(IBUF,IGRID,IBUF2,NAME,LEV,ILG1,ILAT,KHEM,NPACK)
          MAXX=ILG1*ILAT
          CALL PUTFLD2(NF,GLL,IBUF,MAXX)
        ENDIF

      ENDIF
      RETURN
C---------------------------------------------------------------------
      END 
