      SUBROUTINE PUTST6U(NF ,PS,P,C,ES,PHIS,TMEAN,PEEMN,PSMN, 
     1                   RGAS,LA,LRLMT,ILEV,LEVS,LS,LH, 
     2                   LSPHI,T,SF,TMEANH,KOUNT,KSTART,ISSP,LSSP,
     3                   RLS,RLSPHI)

C     * MAY 29/95 - M.LAZARE. INCLUDE OPTION "ISAVDTS" TO SAVE
C     *                       GCM OUTPUT IN "yyyymmddhh" FORMAT
C     *                       (FORMAT STATEMENT ALSO MODIFIED TO
C     *                       HANDLE POSSIBLE 10-CHARACTERS).
C     * NOV 24/94 - M.LAZARE. PREVIOUS VERSION PUTSTG6.
C
C     * ADAPTED FROM PUTSTG5 FOR VRBL STAGGERING VERSION. 
C     * PHI COMPUTED FOR UPWARD COMPATIBILITY AND SAVED WITH
C     * JUDICIOUS LABEL.
C     * SIMILAR TO PUTST3U ROUTINE WRITTEN BY R.LAPRISE EXCEPT ARRAYS 
C     * RLS AND RLSPHI NOW USE WORK SPACE IN THE MODEL AS OPPOSED TO
C     * BEING HARD-COATED TO 20 LEVELS. 
C     * 
C     * SAVES GLOBAL SPECTRAL FORECAST ON SEQUENTIAL FILE NF. 
C     * ALL FIELDS ARE WRITTEN UNPACKED.
C     * LS,LH = OUTPUT LABEL VALUES FOR FULL,HALF LEVELS. 
C 
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)

      COMPLEX PS(LA),PHIS(LA) 
      COMPLEX T(LA,ILEV),P(LA,ILEV),C(LA,ILEV),ES(LA,LEVS)
      REAL SF(ILEV),TMEAN(ILEV),TMEANH(ILEV),PEEMN(ILEV)
      INTEGER LSPHI(ILEV) 
      INTEGER LS(ILEV),LH(ILEV) 
  
      REAL RLS(ILEV),RLSPHI(ILEV) 
      INTEGER IBUF(8) 
  
      LOGICAL LSSP
      LOGICAL OK
      COMMON /MACHTYP/ MACHINE,INTSIZE
      COMMON /KEEPTIM/ IYEAR,IYMDH,MYRSSTI,ISAVDTS
C-------------------------------------------------------------------- 
      ILNSP=NC4TO8("LNSP")
      ITMP =NC4TO8("TEMP")
      IVORT=NC4TO8("VORT")
      IDIV =NC4TO8(" DIV")
      IES  =NC4TO8("  ES")

C     * DETERMINE PROPER IBUF(2) TO USE FOR SAVED FIELDS, BASED ON
C     * VALUE OF OPTION SWITCH "ISAVDTS".
C
      IF(ISAVDTS.NE.0)                   THEN
         IBUF2=IYMDH
      ELSE
         IBUF2=KOUNT
      ENDIF
C
C     * GET DATA RECORD LENGTH.
C                        
      LEN=LA*2*INTSIZE

C     * FOR FIRST SPECTRAL SAVE IN EACH JOB ONLY: 
C     * WRITE OUT DATA TO NF TO BE USED IN PROGRAM PAKGCM FOR CONVERSION
C     * OF T-PRIME TO PHI.
C 
      MAXDATA=6*ILEV+4
      IF((KOUNT-KSTART).LT.ISSP) THEN 
        CALL SETLAB(IBUF,NC4TO8("ZONL"),IBUF2,NC4TO8("DATA"),1,
     1                                       MAXDATA,1,LRLMT,0)
        RILEV = FLOAT(ILEV) 
        RLA   = FLOAT(  LA) 
        DO 210 L=1,ILEV 
        RLSPHI(L)=FLOAT(LSPHI(L)) 
  210   RLS(L)= FLOAT(LS(L))
        CALL FBUFOUT(NF,IBUF,-1,K)
        WRITE(NF) RILEV,RLA,RGAS,PSMN,
     1            ( TMEAN(L),L=1,ILEV), 
     2            (TMEANH(L),L=1,ILEV), 
     3            ( PEEMN(L),L=1,ILEV), 
     4            (    SF(L),L=1,ILEV), 
     5            (   RLS(L),L=1,ILEV), 
     6            (RLSPHI(L),L=1,ILEV)
C       WRITE(6,6026) IBUF
      ENDIF 
C 
C     * SURFACE GEOPOTENTIAL (MOUNTAINS) ARE SAVED EVERY TIME.
C 
      CALL SETLAB(IBUF,NC4TO8("SPEC"),IBUF2,NC4TO8("PHIS"),1,
     1                                          LA,1,LRLMT,0)
      CALL FBUFOUT(NF,IBUF,-1,K)  
      WRITE(NF) PHIS
C     WRITE(6,6026) IBUF
C 
C 
C     * SAVE PS-PRIME.
C 
      IBUF(3)= ILNSP
      CALL FBUFOUT(NF,IBUF,-1,K)  
      WRITE(NF) PS
C     WRITE(6,6026) IBUF
C 
C     * SAVE T-PRIME FOR ILEV LEVELS. 
C
      IBUF(3)=  ITMP 
      DO 310 L=1,ILEV 
         IBUF(4)=LH(L) 
         CALL FBUFOUT(NF,IBUF,-1,K)  
         CALL WRTBUF(NF,T(1,L),LEN,OK)
C        WRITE(6,6026) IBUF
  310 CONTINUE
C 
C     * SAVE VORTICITY AND DIVERGENCE IN PAIRS FOR EACH LEVEL.
C 
      DO 410 L=1,ILEV 
         IBUF(4)=LS(L) 
         IBUF(3)= IVORT
         CALL FBUFOUT(NF,IBUF,-1,K)  
         CALL WRTBUF(NF,P(1,L),LEN,OK)
C        WRITE(6,6026) IBUF
         IBUF(3)=  IDIV
         CALL FBUFOUT(NF,IBUF,-1,K)  
         CALL WRTBUF(NF,C(1,L),LEN,OK)
C        WRITE(6,6026) IBUF
  410 CONTINUE
C 
C     * MOISTURE VARIABLE SAVED FOR LEVS LEVELS.
C 
      IF(LEVS.EQ.0) RETURN
      IBUF(3)=   IES
      DO 510 N=1,LEVS 
         L=(ILEV-LEVS)+N 
         IBUF(4)=LH(L) 
         CALL FBUFOUT(NF,IBUF,-1,K)  
         CALL WRTBUF(NF,ES(1,N),LEN,OK)
C        WRITE(6,6026) IBUF
  510 CONTINUE
C 
      RETURN
C-----------------------------------------------------------------------
 6026 FORMAT(' ',60X,A4,1X,I10,2X,A4,5I6)
      END 
