      PROGRAM GSTRACX                                                                                                               
C     PROGRAM GSTRACX (TRAC,       X,       LNSP,      RHO,       XM,           J2                                                  
C                                                    INPUT,      OUTPUT)        J2                                                  
C    1          TAPE11=TRAC,TAPE12=X,TAPE13=LNSP,TAPE14=RHO,TAPE15=XM,          J2                                                  
C                                              TAPE5=INPUT,TAPE6=OUTPUT)        J2                                                  
C     --------------------------------------------------------------            J2                                                  
C                                                                               J2                                                  
C     JUN 26/12 - S.KHARIN (FIX BUG WHICH OVERWROTE MODEL WITH PRESSURE LEVELS) J2                                                  
C     DEC 11/09 - S.KHARIN (REVISED TMIN=MAX(XREF*1.E-16,1.E-36)                                                                    
C     NOV 16/09 - S.KHARIN. - REVISE FOR "ITRVAR=[4H   Q/4HSL3D" INPUT                                                              
C                             PARAMETER.                                                                                            
C     NOV 03/09 - S.KHARIN. - ADD OPTIONAL "XM" OUTPUT GRID FILE AND MORE                                                           
C                             OPTIONS FOR "LPRESS" INPUT PARAMETER.                                                                 
C     OCT 26/09 - S.KHARIN. - ADD OPTIONAL CONVERTSION TO MASS CONCENTRATIONS.                                                      
C     NOV 17/08 - S.KHARIN. - TRACER CAN BE ON GRID OR SPECTRAL.                                                                    
C                             OUTPUT CAN BE ON MODEL OR PRESSURE LEVELS.                                                            
C     MAY 01/08 - M.LAZARE. - GENERALIZED TRACER CONVERSION PROGRAM BASED                                                           
C                             ON GSHUMH.                                                                                            
C                                                                               J2                                                  
CGSTRACX - CONVERTS ETA (SIGMA/HYBRID) LEVEL TRACER VARIABLE TO                 J1                                                  
C          MIXING RATIO OR MASS CONCENTRATION.                          3  2 C  J1                                                  
C                                                                               J3                                                  
CAUTHOR - M. LAZARE                                                             J3                                                  
C                                                                               J3                                                  
CPURPOSE - CONVERTS ETA (SIGMA/HYBRID) LEVEL GRID FILE OF MODEL                 J3                                                  
C          TRACER VARIABLE TO MIXING RATIO OR MASS CONCENTRATION.               J3                                                  
C                                                                               J3                                                  
CINPUT FILES...                                                                 J3                                                  
C                                                                               J3                                                  
C        TRAC = MODEL TRACER ON ETA (SIGMA/HYBRID) LEVELS.                      J3                                                  
C               IT CAN BE ON GRID OR SPECTRAL.                                  J3                                                  
C        LNSP = (OPTIONAL) LOG OF SURFACE PRESSURE.                             J3                                                  
C               THIS INPUT FILE IS READ ONLY IF TRACER IS INTERPOLATED TO       J3                                                  
C               PRESSURE LEVELS.                                                J3                                                  
C         RHO = (OPTIONAL) AIR DENSITY.                                         J3                                                  
C               THIS INPUT FILE IS READ ONLY IF TRACER IS CONVERTED FROM        J3                                                  
C               MIXING RATIO TO MASS CONCENTRATION.                             J3                                                  
C                                                                               J3                                                  
COUTPUT FILES...                                                                J3                                                  
C                                                                               J3                                                  
C        X    = OUTPUT GRID FILE FOR THE TRACER MIXING RATIOS.                  J3                                                  
C               IT CAN BE ON MODEL LEVELS OR INTERPOLATED TO PRESSURE LEVELS.   J3                                                  
C        XM   = (OPTIONAL) OUTPUT GRID FILE FOR THE TRACER MASS CONCENTRATIONS. J3                                                  
C               IT CAN BE ON MODEL LEVELS OR INTERPOLATED TO PRESSURE LEVELS.   J3                                                  
C                                                                               J3                                                  
CINPUT PARAMETERS...                                                                                                                
C                                                                               J5                                                  
C CARD 1: PARAMETERS FOR CONVERSION TO MIXING RATIO.                            J5                                                  
C                                                                               J5                                                  
C      ICOORD = 4H SIG/4H ETA FOR SIGMA/ETA VERTICAL COORDINATE.                J5                                                  
C      ITRVAR = 4H   Q  FOR  VARIABLE Q                                         J5                                                  
C               4HSL3D                SL3D (SEMI-LAGRANGIAN OPTION)             J5                                                  
C               4HQHYB                HYBRID ( =Q                      ; Q<=Q0  J5                                                  
C                                              =Q0/((1+P*LN(Q0/Q))**P  ; Q>Q0   J5                                                  
C                                              WHERE Q0 IS THE REFERENCE VALUE  J5                                                  
C                                              "XREF" BELOW AND "P" IS THE      J5                                                  
C                                              REFERENCE POWER ("XPOW" BELOW)   J5                                                  
C               4HSLQB                QHYB AS ABOVE EXCEPT SEMI-LAGRANGIAN ADV. J5                                                  
C        XPOW = REFERENCE POWER FOR THE HYBRID CASE (DEFAULT; 1.)               J5                                                  
C        XREF = REFERENCE VALUE FOR THE HYBRID CASE (DEFAULT; 10.E-3 KG/KG)     J5                                                  
C      LPRESS = 0 LEAVE EVERYTHING ON MODEL LEVELS.                             J5                                                  
C             = 1 INTERPOLATE MIXING RATIOS TO PRESSURE LEVELS.                 J5                                                  
C             = 2 INTERPOLATE BOTH MIXING RATIOS AND MASS CONCENTRATIONS        J5                                                  
C                 TO PREESSURE LEVELS.                                          J5                                                  
C             = 3 INTERPOLATE ONLY MASS CONCENTRATIONS TO PRESSURE LEVELS.      J5                                                  
C               IF INTERPOLATED TO PRESSURE LEVELS, AN EXTRA INPUT CARD IS READ.J5                                                  
C               LOG OF SURF. PRESSURE FILE MUST BE PRESENT ON THE COMMAND LINE. J5                                                  
C       LMASS = 1 CONVERT MIXING RATIO TO MASS CONCENTRATION.                   J5                                                  
C               INPUT FILE WITH AIR DENSITY RHO MUST BE ON THE COMMAND LINE.    J5                                                  
C               SAVED IN OUTPUT FILE XM.                                        J5                                                  
C                                                                               J5                                                  
C CARD 2: PARAMETERS FOR OUTPUT GAUSSIAN GRID IF INPUT TRACER IS SPECTRAL.      J5                                                  
C         (BASED ON COFAGG)                                                     J5                                                  
C      ILG   = NUMBER OF GRID POINTS IN GAUSSIAN LATITUDE CIRCLE                J5                                                  
C              (MUST BE A POWER OF TWO OR THREE TIMES A POWER OF TWO)           J5                                                  
C      ILAT  = NUMBER OF GAUSSIAN LATITUDES                                     J5                                                  
C      KUV   = 0 FOR NORMAL ANALYSIS. THIS IS THE ONLY POSSIBLE CHOICE HERE>    J5                                                  
C      NPKGG = GRID PACKING DENSITY (0 DEFAULTS TO 2)                           J5                                                  
C                                                                               J5                                                  
C CARD 3: PARAMETERS FOR CONVERSION TO PRESSURE LEVELS (BASED ON GSAPL)         J5                                                  
C                                                                               J5                                                  
C      NPL    = NUMBER OF REQUESTED PRESSURE LEVELS, (MAX $L$).                 J5                                                  
C      RLUP   = LAPSE RATE USED TO EXTRAPOLATE UPWARDS.                         J5                                                  
C      RLDN   = LAPSE RATE USED TO EXTRAPOLATE DOWNWARDS.                       J5                                                  
C      ICOORD = 4H SIG/ 4H ETA FOR SIGMA/ETA VERTICAL COORDINATES.              J5                                                  
C      PTOIT  = PRESSURE (PA) AT THE LID OF MODEL.                              J5                                                  
C      PR     = PRESSURE LEVELS (MB)                                            J5                                                  
C                                                                               J5                                                  
CEXAMPLE OF INPUT CARD(S)...                                                    J5                                                  
C                                                                               J5                                                  
C*GSTRACX.  SIG QHYB    1.5E-8        2.                                        J5                                                  
C (CONVERT GRIDDED TRACER ON MODEL LEVELS TO MIXING RATIOS)                     J5                                                  
C                                                                               J5                                                  
C*GSTRACX.  SIG QHYB    1.5E-8        2.                                        J5                                                  
C*COFAGG    128   64    0    2                                                  J5                                                  
C (CONVERT SPECTRAL TRACER ON MODEL LEVELS TO MIXING RATIOS)                    J5                                                  
C                                                                               J5                                                  
C*GSTRACX.  SIG QHYB    1.5E-8        2.    1                                   J5                                                  
C*COFAGG.   128   64    0    2                                                  J5                                                  
C*GSAPL.     17       0.0       0.0 ET15      50.0                              J5                                                  
C  10   20   30   50   70  100  150  200  250  300  400  500  600  700  850  925J5                                                  
C1000                                                                           J5                                                  
C (CONVERT SPECTRAL TRACER ON MODEL LEVELS TO MIXING RATIOS ON PRESSURE LEVELS) J5                                                  
C------------------------------------------------------------------------                                                           
      LOGICAL OK                                                                                                                    
      INTEGER LEVS(100),LEVP(100)                                                                                                   
                                                                                                                                    
      INTEGER LSR(2,66),IFAX(10)                                                                                                    
      REAL WRKS(12416),WRKL(19400),TRIGS(194)                                                                                       
      REAL*8 ALP(2275),EPSI(2275)                                                                                                   
      REAL*8 SL(96),CL(96),WL(96),WOSSL(96),RAD(96)                                                                                 
                                                                                                                                    
      REAL ETA(100),A(100),B(100)                                                                                                   
      REAL SIG(100),FSIG (100),DFLNSIG(101),DLNSIG(100)                                                                             
      REAL PR(100),PRLOG(100)                                                                                                       
                                                                                                                                    
C     * WORKING ARRAY (F) DIMENSION: NLEV*(NLG*NLAT+2*LA)                                                                           
C     * WORKING ARRAY (FP) DIMENSION: NLEV*NLG*NLAT                                                                                 
                                                                                                                                    
      REAL F(2304400),FP(1852800),GSLNSP(18528),RHO(18528)                                                                          
C                                                                                                                                   
C     * IUA/IUST  - ARRAY KEEPING TRACK OF UNITS ASSIGNED/STATUS.                                                                   
C                                                                                                                                   
      INTEGER IUA(100),IUST(100)                                                                                                    
      COMMON /JCLPNTU/ IUA,IUST                                                                                                     
                                                                                                                                    
      COMMON/ICOM/IBUF(8),IDAT(18528)                                                                                               
      DATA MAXX,MAXW,MAXLG,MAXLEV/18528,2304400,194,100/                                                                            
C---------------------------------------------------------------------                                                              
      NFIL = 7                                                                                                                      
      CALL JCLPNT (NFIL,11,12,13,14,15,5,6)                                                                                         
C     * INPUT TRACER (GRID OR SPEC)                                                                                                 
      REWIND 11                                                                                                                     
C     * OUTPUT TRACER (MASS MIXING RATIO)                                                                                           
      REWIND 12                                                                                                                     
C     * GRIDDED LOG OF SURF. PRESSURE (OPTIONAL)                                                                                    
      IF (IUST(13).EQ.1) THEN                                                                                                       
        REWIND 13                                                                                                                   
      ENDIF                                                                                                                         
C     * AIR DENSITY (OPTIONAL)                                                                                                      
      IF (IUST(14).EQ.1) THEN                                                                                                       
        WRITE(6,'(A)')' DENSITY FILE IS FOUND.'                                                                                     
        REWIND 14                                                                                                                   
      ENDIF                                                                                                                         
C     * MASS CONCENTRATION (OPTIONAL)                                                                                               
      IF (IUST(15).EQ.1) THEN                                                                                                       
        WRITE(6,'(A)')' FILE FOR MASS CONCENTRATION IS SPECIFIED.'                                                                  
        REWIND 15                                                                                                                   
      ENDIF                                                                                                                         
                                                                                                                                    
C     * READ-IN DIRECTIVE CARD.                                                                                                     
                                                                                                                                    
      READ(5,5000,END=911) ICOORD,ITRVAR,XREF,XPOW,LPRESS,LMASS                 J4                                                  
      WRITE(6,6000) ICOORD,ITRVAR,XREF,XPOW,LPRESS,LMASS                                                                            
      IF( ICOORD.EQ.NC4TO8("    ")) CALL           XIT('GSTRACX',-1)                                                                
      IF( ITRVAR.EQ.NC4TO8("    ")) CALL           XIT('GSTRACX',-2)                                                                
      IF( ITRVAR.NE.NC4TO8("   Q") .AND.                                                                                            
     1    ITRVAR.NE.NC4TO8("SL3D") .AND.                                                                                            
     2    ITRVAR.NE.NC4TO8("QHYB") .AND.                                                                                            
     3    ITRVAR.NE.NC4TO8("SLQB")) CALL           XIT('GSTRACX',-3)                                                                
                                                                                                                                    
C     * DETERMINE NUMBER OF LEVELS IN THE MODEL, IE NSL.                                                                            
                                                                                                                                    
      CALL FILEV (LEVS,NSL,IBUF,11)                                                                                                 
      IF(NSL.EQ.0 .OR. NSL.GT.MAXLEV) CALL         XIT('GSTRACX',-4)                                                                
      NAME=IBUF(3)                                                                                                                  
      WRITE(6,6015) NAME,NSL,(LEVS(L),L=1,NSL)                                                                                      
C                                                                                                                                   
C     * DETERMINE RECORD TYPE                                                                                                       
C                                                                                                                                   
      IF(IBUF(1).EQ.NC4TO8("GRID")) THEN                                                                                            
C                                                                                                                                   
C       * INPUT FILE CONTAINS GRIDS                                                                                                 
C                                                                                                                                   
        LSPEC=0                                                                                                                     
        ILG1=IBUF(5)                                                                                                                
        ILAT=IBUF(6)                                                                                                                
        NWDS=ILG1*ILAT                                                                                                              
        ILLGG=IBUF(7)                                                                                                               
        NPKGG=IBUF(8)                                                                                                               
      ELSE IF(IBUF(1).EQ.NC4TO8("SPEC")) THEN                                                                                       
C                                                                                                                                   
C       * INPUT FILE CONTAINS SPECTRAL COEFFICIENTS                                                                                 
C                                                                                                                                   
        LSPEC=1                                                                                                                     
        WRITE(6,'(A)') ' READ-IN COFAGG CARD...'                                                                                    
        READ(5,5010,END=912) ILG,ILAT,KUV,NPKGG                                 J4                                                  
        IF (ILG+2.GT.MAXLG)   THEN                                                                                                  
          WRITE(6,6005) ILG,MAXLG-2                                                                                                 
          CALL                                     XIT('GSTRACX',-5)                                                                
        ENDIF                                                                                                                       
        MAXLG=ILG+2                                                                                                                 
C                                                                                                                                   
C       * DO NOT ALLOW MODEL WINDS                                                                                                  
C                                                                                                                                   
        IF(KUV.NE.0) CALL                          XIT('GSTRACX',-6)                                                                
        ILATH=ILAT/2                                                                                                                
        ILG1=ILG+1                                                                                                                  
        NWDS=ILG1*ILAT                                                                                                              
        ILLGG=0                                                                                                                     
        LRLMT=IBUF(7)                                                                                                               
        IF(LRLMT.LT.100) CALL FXLRLMT (LRLMT,IBUF(5),IBUF(6),0)                                                                     
        CALL DIMGT(LSR,LA,LR,LM,KTR,LRLMT)                                                                                          
        CALL PRLRLMT (LA,LR,LM,KTR,LRLMT)                                                                                           
                                                                                                                                    
        CALL EPSCAL(EPSI,LSR,LM)                                                                                                    
        CALL GAUSSG(ILATH,SL,WL,CL,RAD,WOSSL)                                                                                       
        CALL  TRIGL(ILATH,SL,WL,CL,RAD,WOSSL)                                                                                       
        CALL FTSETUP(TRIGS,IFAX,ILG)                                                                                                
                                                                                                                                    
        WRITE(6,6020) LR,LM,ILG1,ILAT,NSL                                                                                           
      ENDIF                                                                                                                         
                                                                                                                                    
C     * READ IN INPUT CARD FOR PRESSURE-LEVEL INTERPOLATION.                                                                        
                                                                                                                                    
      IF(LPRESS.NE.0)THEN                                                                                                           
        WRITE(6,'(A)') ' READ-IN GSAPL CARD...'                                                                                     
        READ(5,5015,END=913) NPL,RLUP,RLDN,ICOORD,PTOIT                         J4                                                  
        IF(ICOORD.EQ.NC4TO8("    ")) ICOORD=NC4TO8(" SIG")                                                                          
        IF(ICOORD.EQ.NC4TO8(" SIG")) THEN                                                                                           
          PTOIT=MAX(PTOIT,0.00E0)                                                                                                   
        ELSE                                                                                                                        
          PTOIT=MAX(PTOIT, 0.100E-09)                                                                                               
        ENDIF                                                                                                                       
        IF(NPL.GT.MAXLEV) CALL                     XIT('GSTRACX',-7)                                                                
        READ(5,5020,END=914) (LEVP(I),I=1,NPL)                                  J4                                                  
                                                                                                                                    
C       * DECODE LEVELS.                                                                                                            
                                                                                                                                    
        CALL LVDCODE(PR,LEVP,NPL)                                                                                                   
                                                                                                                                    
        WRITE(6,6025) RLUP,RLDN,ICOORD,PTOIT                                                                                        
        CALL WRITLEV(PR,NPL,' PR ')                                                                                                 
                                                                                                                                    
        DO L=2,NPL                                                                                                                  
          IF(PR(L).LE.PR(L-1)) CALL                XIT('GSTRACX',-8)                                                                
        ENDDO                                                                                                                       
        DO L=1,NPL                                                                                                                  
          PRLOG(L)=LOG(PR(L))                                                                                                       
        ENDDO                                                                                                                       
                                                                                                                                    
C       * GET ETA VALUES FROM THE GSFLD FILE.                                                                                       
                                                                                                                                    
        CALL LVDCODE(ETA,LEVS,NSL)                                                                                                  
        DO L=1,NSL                                                                                                                  
          ETA(L)=ETA(L)*0.001E0                                                                                                     
        ENDDO                                                                                                                       
                                                                                                                                    
C       * EVALUATE THE PARAMETERS OF THE ETA VERTICAL DISCRETIZATION.                                                               
                                                                                                                                    
        CALL COORDAB (A,B, NSL,ETA, ICOORD,PTOIT)                                                                                   
      ENDIF                                                                                                                         
                                                                                                                                    
C---------------------------------------------------------------------                                                              
                                                                                                                                    
      NRECS=0                                                                                                                       
      NSETS=0                                                                                                                       
C                                                                                                                                   
  200 CONTINUE                                                                                                                      
                                                                                                                                    
C     * LEVEL LOOP OVER ALL LEVELS.                                                                                                 
C       ---------------------------                                                                                                 
                                                                                                                                    
      DO L=1,NSL                                                                                                                    
                                                                                                                                    
C       * GET THE MODEL TRACER VARIABLE INTO ARRAY F                                                                                
                                                                                                                                    
        IF (LSPEC.EQ.0)THEN                                                                                                         
C                                                                                                                                   
C         * GRIDS                                                                                                                   
C                                                                                                                                   
          IJ=(L-1)*NWDS+1                                                                                                           
          CALL GETFLD2(11,F(IJ),NC4TO8("GRID"),-1,-1,LEVS(L),                                                                       
     1         IBUF,MAXX,OK)                                                                                                        
        ELSE                                                                                                                        
C                                                                                                                                   
C         * SPECTRAL COEFFICIENTS                                                                                                   
C                                                                                                                                   
          IJ=(L-1)*2*LA+1                                                                                                           
          CALL GETFLD2(11,F(IJ),NC4TO8("SPEC"),-1,-1,LEVS(L),                                                                       
     1         IBUF,MAXX,OK)                                                                                                        
        ENDIF                                                                                                                       
        IF(NSETS.EQ.0) CALL PRTLAB(IBUF)                                                                                            
        IF(.NOT.OK)THEN                                                                                                             
          WRITE(6,6030) NRECS,NSETS                                                                                                 
          IF(NRECS.EQ.0 .OR. L.NE.1)THEN                                                                                            
            CALL                                   XIT('GSTRACX',-9)                                                                
          ELSE                                                                                                                      
            CALL                                   XIT('GSTRACX',0)                                                                 
          ENDIF                                                                                                                     
        ENDIF                                                                                                                       
        NRECS=NRECS+1                                                                                                               
      ENDDO                                                                                                                         
                                                                                                                                    
      IF (LSPEC.EQ.1)THEN                                                                                                           
C                                                                                                                                   
C       * CONVERT SPECTRAL TO GRIDS (GRIDS ARE IN F STARTING AT LEN+1)                                                              
C                                                                                                                                   
        LEN=(2*LA+NWDS)*NSL                                                                                                         
        CALL STAGG (F(LEN+1),ILG1,ILAT,NSL,SL,F(1),LSR,LM,LA,                                                                       
     1       ALP,EPSI,WRKS,WRKL,TRIGS,IFAX,MAXLG)                                                                                   
        DO I=1,ILG1*ILAT*NSL                                                                                                        
          F(I)=F(LEN+I)                                                                                                             
        ENDDO                                                                                                                       
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * CALCULATE MIXING RATIO                                                                                                      
C                                                                                                                                   
      IF(XREF.GT.0.E0) THEN                                                                                                         
C                                                                                                                                   
C       * FOR XREF=0., FIELD IS ALREADY IN MIXING RATIO AND                                                                         
C       *              NO CONVERSION REQUIRED.                                                                                      
C                                                                                                                                   
        DO L=1,NSL                                                                                                                  
          IJ=(L-1)*NWDS                                                                                                             
          PINV=1./XPOW                                                                                                              
          TMIN=MAX(XREF*1.E-16,1.E-36)                                                                                              
          XMIN=XREF/((1.E0+XPOW*LOG(XREF/TMIN))**PINV)                                                                              
          DO I=1,NWDS                                                                                                               
            TRAC = MAX(F(IJ+I),XMIN)                                                                                                
            IF(TRAC.GE.XREF) THEN                                                                                                   
              F(IJ+I) = TRAC                                                                                                        
            ELSE                                                                                                                    
              F(IJ+I) = XREF*(EXP(PINV*(1.-(XREF/TRAC)**XPOW)))                                                                     
            ENDIF                                                                                                                   
          ENDDO                                                                                                                     
        ENDDO                                                                                                                       
      ENDIF                                                                                                                         
      NST=IBUF(2)                                                                                                                   
      CALL SETLAB(IBUF,NC4TO8("GRID"),-1,-1,-1,ILG1,ILAT,ILLGG,NPKGG)                                                               
C                                                                                                                                   
C     * READ LOG OF SURFACE PRESSURE FOR THE SAME TIME STEP                                                                         
C                                                                                                                                   
      IF(LPRESS.NE.0)THEN                                                                                                           
        CALL GETFLD2(13,GSLNSP,NC4TO8("GRID"),NST,NC4TO8("LNSP"),1,                                                                 
     +                                                IBUF,MAXX,OK)                                                                 
        IF(NSETS.EQ.0) CALL PRTLAB(IBUF)                                                                                            
        IF(.NOT.OK) CALL                           XIT('GSTRACX',-10)                                                               
        IF(IBUF(5).NE.ILG1.OR.IBUF(6).NE.ILAT)CALL XIT('GSTRACX',-11)                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * (OPTIONALLY) INTERPOLATE MIXING RATIOS TO PRESSURE LEVELS                                                                   
C                                                                                                                                   
      IF(LPRESS.EQ.1.OR.LPRESS.EQ.2)THEN                                                                                            
        IF(NSETS.EQ.0)                                                                                                              
     1       WRITE(6,'(A)')' INTERPOLATE MIX.RATIOS TO PRESSURE LEVELS.'                                                            
                                                                                                                                    
C     * INTERPOLATE FROM ETA TO PRESSURE.                                                                                           
                                                                                                                                    
        CALL EAPL (FP,NWDS,PRLOG,NPL,F,SIG,NSL,GSLNSP,RLUP,RLDN,                                                                    
     1           A,B, NSL+1,FSIG,DFLNSIG,DLNSIG)                                                                                    
C                                                                                                                                   
C       * SAVE TRACER OR MASS CONCENTR. ON PRESSURE LEVELS                                                                          
C                                                                                                                                   
        IBUF(3)=NAME                                                                                                                
        IBUF(8)=NPKGG                                                                                                               
        CALL PUTSET2(12,FP,LEVP,NPL,IBUF,MAXX)                                                                                      
      ELSE                                                                                                                          
C                                                                                                                                   
C       * SAVE MIXING RATIO OR MASS CONCENTR. ON MODEL LEVELS                                                                       
C                                                                                                                                   
        IBUF(3)=NAME                                                                                                                
        CALL PUTSET2(12,F,LEVS,NSL,IBUF,MAXX)                                                                                       
      ENDIF                                                                                                                         
                                                                                                                                    
      IF(NSETS.EQ.0) CALL PRTLAB(IBUF)                                                                                              
      NSETS=NSETS+1                                                                                                                 
C                                                                                                                                   
C     * (OPTIONALLY) CONVERT MIXING RATIO TO MASS CONCENTRATION                                                                     
C                                                                                                                                   
      IF(LMASS.NE.1)GOTO 200                                                                                                        
      DO L=1,NSL                                                                                                                    
        IJ=(L-1)*NWDS                                                                                                               
C                                                                                                                                   
C       * READ AIR DENSITY                                                                                                          
C                                                                                                                                   
        CALL GETFLD2(14,RHO,NC4TO8("GRID"),NST,-1,LEVS(L),                                                                          
     +       IBUF,MAXX,OK)                                                                                                          
        IF(.NOT.OK) THEN                                                                                                            
          CALL PRTLAB(IBUF)                                                                                                         
          CALL                                     XIT('GSTRACX',-12)                                                               
        ENDIF                                                                                                                       
        DO I=1,NWDS                                                                                                                 
          F(IJ+I)=F(IJ+I)*RHO(I)                                                                                                    
        ENDDO                                                                                                                       
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * (OPTIONALLY) INTERPOLATE MASS CONC. TO PRESSURE LEVELS                                                                      
C                                                                                                                                   
      IF(LPRESS.EQ.2.OR.LPRESS.EQ.3)THEN                                                                                            
        IF(NSETS.EQ.1)                                                                                                              
     1       WRITE(6,'(A)')' INTERPOLATE MASS CONC. TO PRESSURE LEVELS.'                                                            
C                                                                                                                                   
C       * INTERPOLATE FROM ETA TO PRESSURE.                                                                                         
C                                                                                                                                   
        CALL EAPL (FP,NWDS,PRLOG,NPL,F,SIG,NSL,GSLNSP,RLUP,RLDN,                                                                    
     1           A,B, NSL+1,FSIG,DFLNSIG,DLNSIG)                                                                                    
C                                                                                                                                   
C       * SAVE TRACER OR MASS CONCENTR. ON PRESSURE LEVELS                                                                          
C                                                                                                                                   
        IBUF(3)=NAME                                                                                                                
        IBUF(8)=NPKGG                                                                                                               
        CALL PUTSET2(15,FP,LEVP,NPL,IBUF,MAXX)                                                                                      
      ELSE                                                                                                                          
C                                                                                                                                   
C       * SAVE MIXING RATIO OR MASS CONCENTR. ON MODEL LEVELS                                                                       
C                                                                                                                                   
        IBUF(3)=NAME                                                                                                                
        CALL PUTSET2(15,F,LEVS,NSL,IBUF,MAXX)                                                                                       
      ENDIF                                                                                                                         
                                                                                                                                    
      GO TO 200                                                                                                                     
                                                                                                                                    
C     * E.O.F. ON INPUT.                                                                                                            
                                                                                                                                    
  911 CALL                                         XIT('GSTRACX',-13)                                                               
  912 CALL                                         XIT('GSTRACX',-14)                                                               
  913 CALL                                         XIT('GSTRACX',-15)                                                               
  914 CALL                                         XIT('GSTRACX',-16)                                                               
C-----------------------------------------------------------------------                                                            
 5000 FORMAT(10X,2(1X,A4),2E10.0,2I5)                                           J4                                                  
 5010 FORMAT(10X,4I5)                                                           J4                                                  
 5015 FORMAT(10X,I5,2E10.0,1X,A4,E10.0)                                         J4                                                  
 5020 FORMAT(16I5)                                                              J4                                                  
 6000 FORMAT(' COORD=',A4,' MOISTURE VARIABLE=',A4,                                                                                 
     1       ' XREF=',E10.3,' XPOW=',E10.3,' LPRESS=',I5,' LMASS=',I5)                                                              
 6005 FORMAT(' ILG=',I4,' IS TO BIG, MAXIMUM PERMISSIBLE IS ',I4)                                                                   
 6015 FORMAT(' NAME=',A4,',NSL=',I5,/,' ETA LEVELS=',10I6/(12X,10I6))                                                               
 6020 FORMAT(' SPEC=',2I5,'  GRID=',2I5,'  NSL=',I5)                                                                                
 6025 FORMAT(' RLUP,RLDN=',2F6.2,' ICOORD=',1X,A4,                                                                                  
     1       ' P.LID (PA)=',E10.3)                                                                                                  
 6030 FORMAT(' GSTRAC TRANSFORMED',I6,'  RECORDS AND',I6, ' SETS')                                                                  
      END                                                                                                                           
