      SUBROUTINE PUTRAC4X(NF,TRAC,LA,LRLMT,ILEV,LH,KOUNT,LSTR,
     1                    LSRTOTAL,LATOTAL,LMTOTAL,GLL,
     2                    ITRAC,NTRSPEC,NTRAC,ITRNAM,INDXA)

C     * NOV 04/03 - M.LAZARE.   NEW VERSION TO SUPPORT MPI, WHICH USES
C     *                         NEW VARIABLE "IPIOSW" AND WORK ARRAY "GLL".
C     * OCT 31/02 - J.SCINOCCA. PREVIOUS VERSION PUTRAC4A.
  
C     * SAVE TRACER FIELDS ONTO MODEL SPECTRAL HISTORY FILE, 
C     * IF ITRAC.NE.0.
C 
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)
C
      INTEGER LSRTOTAL(2,LMTOTAL+1)
      INTEGER LH(ILEV),IBUF(8)
C 
      COMPLEX TRAC(LA,ILEV,NTRSPEC)
      INTEGER ITRNAM(NTRAC),INDXA(NTRSPEC) 
C
      COMPLEX GLL(LATOTAL)
C
      LOGICAL LSTR,OK

      COMMON /IPARIO/  IPIO
      COMMON /KEEPTIM/ IYEAR,IMDH,MYRSSTI,ISAVDTS
C-------------------------------------------------------------------------
      IF(ITRAC.EQ.0 .OR. .NOT.LSTR)RETURN 
C
      MAX=2*LA
C
C     * DETERMINE PROPER IBUF(2) TO USE FOR SAVED FIELDS, BASED ON
C     * VALUE OF OPTION SWITCH "ISAVDTS".
C
      IF(ISAVDTS.NE.0)                   THEN
C        * IN 32-BIT, THIS ONLY WORKS UNTIL IYEAR=2147!
         IBUF2=1000000*IYEAR + IMDH
      ELSE
         IBUF2=KOUNT
      ENDIF
C
      CALL SETLAB(IBUF,NC4TO8("SPEC"),IBUF2,NC4TO8("TRAC"),0,-1,1,
     1                                                    LRLMT,0)
C
      DO 300 NA=1,NTRSPEC
         N=INDXA(NA)
         IBUF(3)=ITRNAM(N)
         DO 200 L=1,ILEV 
            IBUF(4)=LH(L)
            CALL PUTSPN (NF,TRAC(1,L,NA),LA,
     1                   LSRTOTAL,LATOTAL,LMTOTAL,GLL,
     2                   IBUF,MAX,IPIO,OK)
  200    CONTINUE
  300 CONTINUE
C-----------------------------------------------------------------------
 6026 FORMAT(' ',60X,A4,1X,I10,2X,A4,5I6)
      RETURN
      END 
