      SUBROUTINE PTSJ 
     1           (NFC,NF1,NF2,T,U,V,ES,GZS,SP,LA,NPL,PR,NSL,
     2            AG,BG,AH,BH,NPL1,FPCOL,DFDLNP ,DLNP , 
     3            LP,LG,LH,SIG,PRLOG, IBUF,MAXP8,MOIST,SREF,SPOW) 
C
C     * JUN 12/02 - M.LAZARE. - PASS SREF,SPOW AND USE IN QHYB,SLQB.
C     * OCT 19/01 - M.LAZARE. - PREVIOUS VERSION PTSI.
C     * AUG 13/90 - M.LAZARE. - PREVIOUS VERSION PTSH.
C 
C     * CONVERTS NPL PRESSURE LEVELS OF GAUSSIAN GRIDS (ILG1,ILAT)
C     * ON FILE NF1 TO NSL ETA LEVELS ON FILE NF2 FOR HYBRID MODEL. 
C     * CONVERT ES=SHUM TO MODEL MOISTURE VARIABLE, CONTROLLED BY MOIST.
C     * ETAG FOR MOMENTUM MID LAYER, ETAH FOR THERMODYNAMIC MID LAYER.
C     * PRESSURE LEVELS IN PR ARE ORDERED TOP DOWN. 
C     * (U,T),(V,ES) MAY BE EQUIVALENCED. 
  
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)
      LOGICAL OK
  
      REAL T(LA,NPL), U(LA,NPL), V(LA,NPL), ES(LA,NPL), GZS(LA), SP(LA) 
  
      REAL AG    (NSL),BG    (NSL),AH     (NSL) ,BH   (NSL) 
      REAL PR    (NPL ),FPCOL (NPL ),DFDLNP (NPL1),DLNP (NPL) 
      REAL SIG   (NSL ),PRLOG (NPL )
      INTEGER LP (NPL ),LG    (NSL ),LH     (NSL )
      INTEGER IBUF(MAXP8) 

      COMMON/EPS / A, B, EPS1, EPS2
      COMMON/EPSICE/ AICE,BICE,TICE,QMIN
      COMMON/HTCP  / T1S,T2S,AI,BI,AW,BW,SLP
C
C     * STATEMENT FUNCTIONS.
C
C     * A) COMPUTES THE FRACTIONAL PROBABILITY OF WATER PHASE                     
C     *    EXISTING AS A FUNCTION OF TEMPERATURE (FROM ROCKEL,                    
C     *    RASCHKE AND WEYRES, BEITR. PHYS. ATMOSPH., 1991.)                      
                                                                        
      FRACW(TTT) = MERGE( 1.E0,                                         
     &  0.0059E0+0.9941E0*EXP(-0.003102E0*(T1S-TTT)**2),    
     &  TTT.GE.T1S )

C     * B) COMPUTES THE DEW-POINT TEMPERATURE OVER WATER OR ICE.             
                                                                        
      TDW(XXX) = B/(A - XXX)
      TDI(XXX) = BICE/(AICE - XXX)
      TDEFF(XXX,TTT) = FRACW(TTT)*TDW(XXX) + (1.E0-FRACW(TTT))*TDI(XXX) 
C-------------------------------------------------------------------- 
      MAXX = MAXP8-8 

C     * GET THERMODYNAMIC CONSTANTS.

      CALL SPWCON7(FVORT,PI)  

C     * SET NPL TO PRESSURE VALUES. SET PRLOG TO LN(PR).
  
      DO 110 L=1,NPL
         PRLOG(L) = LOG(PR(L)) 
  110 CONTINUE
C---------------------------------------------------------------------
C     * READ MOUNTAIN GEOPOTENTIAL (M/SEC)**2.
C 
C      READ(NFC)
C      INSTEAD USE RDSKIP TO SKIP RECORDS.
      CALL RDSKIP(NFC,NSKIP,OK)
      CALL GETFLD2(NFC,GZS,NC4TO8("GRID"),-1,NC4TO8("PHIS"),1,
     1                                           IBUF,MAXX,OK)
      IF(.NOT.OK) CALL XIT('PTS',-1)
      WRITE(6,6025) (IBUF(IND),IND=1,8) 
C 
C     * READ SURFACE PRESSURE AND CONVERT TO LSNP.
C 
      REWIND NF1
      CALL GETFLD2(NF1,SP,NC4TO8("GRID"),-1,NC4TO8("  PS"),1,
     1                                          IBUF,MAXX,OK)
      IF(.NOT.OK) CALL XIT('PTS',-2)
      WRITE(6,6025) (IBUF(IND),IND=1,8) 
      DO 210 I=1,LA
         SP(I)=LOG(SP(I))
  210 CONTINUE 
  
C     * READ TEMPERATURES (DEG K).
  
      REWIND NF1
      DO 220 L=1,NPL
         CALL GETFLD2(NF1, T(1,L),NC4TO8("GRID"),-1,NC4TO8("TEMP"),
     1                                         LP (L),IBUF,MAXX,OK)
         IF(.NOT.OK) CALL XIT('PTS',-3) 
         WRITE(6,6025) (IBUF(IND),IND=1,8)
  220 CONTINUE
  
C     * FROM DT/DP=(R*T)/(P*CP),  R/CP=2./7.,  AND T=280. 
C     * WE GET RLDN = DT/D(LN P) = 80.
C     * LTES = (0,1) TO PUT TEMP,ES ON (HALF,FULL) LEVELS.
  
      RLUP =  0.E0
      RLDN = 80.E0
      CALL PAEL  (T,LA,SIG,NSL, T,PRLOG,NPL,SP,RLUP,RLDN, 
     1            AH,BH,NPL+1,FPCOL,DFDLNP ,DLNP )
  
C     * OUTPUT PHIS,LNSP AND TEMPERATURES.
  
      IBUF(2)=0 
      IBUF(4)=1 
      IBUF(3)=NC4TO8("PHIS")
      CALL PUTFLD2(NF2, GZS,IBUF,MAXX) 
      WRITE(6,6026) (IBUF(IND),IND=1,8) 
      IBUF(3)=NC4TO8("LNSP")
      CALL PUTFLD2(NF2, SP ,IBUF,MAXX) 
      WRITE(6,6026) (IBUF(IND),IND=1,8) 
      DO 280 K=1,NSL
         IBUF(3)=NC4TO8("TEMP")
         IBUF(4)=LH(K)
         CALL PUTFLD2(NF2,  T(1,K),IBUF,MAXX)
         WRITE(6,6026) (IBUF(IND),IND=1,8)
  280 CONTINUE
C---------------------------------------------------------------------
C     * READ SPECIFIC HUMIDITY (G/G) FROM FILE NF1. 
C     * LTES = (0,1) TO PUT TEMP,ES ON (HALF,FULL) LEVELS.
  
      REWIND NF1
      DO 410 L=1,NPL
         CALL GETFLD2(NF1,ES(1,L),NC4TO8("GRID"),-1,NC4TO8("SHUM"),
     1                                         LP (L),IBUF,MAXX,OK)
         IF(.NOT.OK) CALL XIT('PTS',-6) 
         WRITE(6,6025) (IBUF(IND),IND=1,8)
  410 CONTINUE
  
C     * INTERPOLATE TO ETA LEVELS. ES MUST BE POSITIVE EVERYWHERE
C     * (BOUND IS 3 PPMV).

      RLUP = 0.E0 
      RLDN = 0.E0 
      CALL PAEL  (ES,LA,SIG,NSL, ES,PRLOG,NPL,SP,RLUP,RLDN, 
     1            AH,BH,NPL+1,FPCOL,DFDLNP ,DLNP )
      DO 425 N=1,NSL
      DO 425 I=1,LA 
         ES(I,N)=MAX(ES(I,N),2.E-6)
         PSPA   = 100.E0*EXP(SP(I))
         CALL NIVCAL (SIGMA,AH(N),BH(N),PSPA,1,1,1)
         PRES   = 0.01E0*PSPA*SIGMA
  425 CONTINUE
  
C     * CONVERT TO MODEL MOISTURE VARIABLE.
  
      DO 470 N=1,NSL
       IF(MOIST.EQ.NC4TO8("RLNQ")) THEN
          DO 430 I=1,LA 
             SHUM   = ES(I,N)
             ES(I,N)= -1.E0/LOG(SHUM)
  430     CONTINUE
  
       ELSEIF(MOIST.EQ.NC4TO8("SQRT")) THEN
          DO 435 I=1,LA 
             SHUM   = ES(I,N)
             ES(I,N)= SQRT(SHUM)
  435     CONTINUE
  
       ELSEIF(MOIST.EQ.NC4TO8("   Q") .OR. MOIST.EQ.NC4TO8("SL3D")) THEN
C
C         * NO CONVERSION REQUIRED.
C
  
       ELSEIF(MOIST.EQ.NC4TO8("  TD")) THEN
          DO 445 I=1,LA 
             PSPA   = 100.E0*EXP(SP(I))
             CALL NIVCAL (SIGMA,AH(N),BH(N),PSPA,1,1,1)
             PRES   = 0.01E0*PSPA*SIGMA
             ALVP   = LOG(ES(I,N)*PRES/(EPS1+EPS2*ES(I,N))) 
             TD     = TDEFF(ALVP,T(I,N))
             ES(I,N)= TD
  445     CONTINUE
  
       ELSEIF(MOIST.EQ.NC4TO8(" LNQ")) THEN
          DO 450 I=1,LA 
             ES(I,N)= LOG(SHUM)
  450     CONTINUE

       ELSEIF(MOIST.EQ.NC4TO8("QHYB") .OR. MOIST.EQ.NC4TO8("SLQB")) THEN
          PINV=1.E0/SPOW
          DO 460 I=1,LA 
             SHUM   = ES(I,N)
             IF(SHUM.GE.SREF) THEN 
                ES(I,N)= SHUM
             ELSE 
                ES(I,N)= SREF/((1.E0+SPOW*LOG(SREF/SHUM))**PINV) 
             ENDIF
  460     CONTINUE
  
       ELSEIF(MOIST.EQ.NC4TO8("T-TD")) THEN
          DO 465 I=1,LA
             PSPA   = 100.E0*EXP(SP(I))
             CALL NIVCAL (SIGMA,AH(N),BH(N),PSPA,1,1,1)
             PRES   = 0.01E0*PSPA*SIGMA
             ALVP   = LOG(ES(I,N)*PRES/(EPS1+EPS2*ES(I,N))) 
             TD     = TDEFF(ALVP,T(I,N))
             ES(I,N)= T(I,N)-TD 
  465     CONTINUE

       ELSE 
                               CALL XIT('INITGSH',-50)
       ENDIF
  
  470 CONTINUE
  
C     * OUTPUT ES ON FILE NF2.
  
      IBUF(2)=0 
      DO 480 K=1,NSL
         IBUF(3)=NC4TO8("  ES")
         IBUF(4)=LH(K)
         CALL PUTFLD2(NF2, ES(1,K),IBUF,MAXX)
         WRITE(6,6026) (IBUF(IND),IND=1,8)
  480 CONTINUE
C---------------------------------------------------------------------
C     * READ MODEL WINDS (U,V)*COS(LAT)/(EARTH RADIUS). 
  
      REWIND NF1
      DO 510 L=1,NPL
         CALL GETFLD2(NF1, U(1,L),NC4TO8("GRID"),-1,NC4TO8("   U"),
     1                                         LP (L),IBUF,MAXX,OK)
         IF(.NOT.OK) CALL XIT('PTS',-4) 
         WRITE(6,6025) (IBUF(IND),IND=1,8)
  510 CONTINUE
      REWIND NF1
      DO 520 L=1,NPL
         CALL GETFLD2(NF1, V(1,L),NC4TO8("GRID"),-1,NC4TO8("   V"),
     1                                         LP (L),IBUF,MAXX,OK)
         IF(.NOT.OK) CALL XIT('PTS',-5) 
         WRITE(6,6025) (IBUF(IND),IND=1,8)
  520 CONTINUE
  
C     * INTERPOLATE TO ETA LEVELS.
  
      RLUP = 0.E0 
      RLDN = 0.E0 
      CALL PAEL ( U,LA, SIG,NSL, U,PRLOG,NPL,SP,RLUP,RLDN,
     1            AG,BG,NPL+1,FPCOL,DFDLNP ,DLNP )
      CALL PAEL ( V,LA, SIG,NSL, V,PRLOG,NPL,SP,RLUP,RLDN,
     1            AG,BG,NPL+1,FPCOL,DFDLNP ,DLNP )
  
C     * OUTPUT PAIRS OF U,V ON FILE NF2.
  
      IBUF(2)=0 
      DO 580 K=1,NSL
         IBUF(4)=LG(K)
  
         IBUF(3)=NC4TO8("   U")
         CALL PUTFLD2(NF2,  U(1,K),IBUF,MAXX)
         WRITE(6,6026) (IBUF(IND),IND=1,8)
  
         IBUF(3)=NC4TO8("   V")
         CALL PUTFLD2(NF2,  V(1,K),IBUF,MAXX)
         WRITE(6,6026) (IBUF(IND),IND=1,8)
  580 CONTINUE
C-------------------------------------------------------------------- 
 6025 FORMAT(' ',A4,I10,1X,A4,5I6)
 6026 FORMAT(' ',60X,A4,I6,1X,A4,5I6) 
      END
