      SUBROUTINE HSCAL (Q, ES, ILG,LON, ILEV,LEVS,
     1                  PRESPA,AH,BH, T, MOIST, LOWBND) 
  
C     * CALCULATE SPECIFIC HUMIDITY (Q) FROM MODEL MOISTURE 
C     * VARIABLE (ES), AS DEFINED BY SWITCH MOIST.
C     * VERTICAL COORDINATE DEFINED THROUGH AH,BH AND PRESPA. 
  
C     * AUG 25/89 - M.LAZARE. - ADD ADDITIONAL MOISTURE VARIABLE 4H LNQ.
C     * APR 25/88 - R.LAPRISE.- ORIGINAL SUBROUTINE.
  
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)

      LOGICAL LOWBND
  
      REAL Q (ILG,ILEV), T (ILG,ILEV), ES (ILG,LEVS)
      REAL PRESPA (ILG), AH(ILEV),  BH(ILEV)
  
      COMMON /EPS/ AA, BB, EPS1, EPS2 
C-----------------------------------------------------------------------
      IF(ILEV-LEVS.GT.0)THEN
        DO 200 L=1,ILEV-LEVS
          DO 100 I=1,LON
            Q(I,L)=0. 
  100     CONTINUE
  200   CONTINUE
      ENDIF 
  
      DO 800 L=ILEV-LEVS+1,ILEV 
  
        IF(MOIST.EQ.NC4TO8("RLNQ"))THEN
          DO 300 I=1,LON
            IF(            ES(I,L-ILEV+LEVS).LE.0.)CALL XIT('HSCAL',-1) 
            Q(I,L)=EXP(-1./ES(I,L-ILEV+LEVS)) 
  300     CONTINUE
  
        ELSEIF(MOIST.EQ.NC4TO8("SQRT"))THEN
          DO 350 I=1,LON
            Q(I,L)=ES(I,L-ILEV+LEVS)**2 
  350     CONTINUE
  
        ELSEIF(MOIST.EQ.NC4TO8("   Q"))THEN
          DO 400 I=1,LON
            Q(I,L)=ES(I,L-ILEV+LEVS)
  400     CONTINUE
  
        ELSEIF(MOIST.EQ.NC4TO8("T-TD"))THEN
          DO 450 I=1,LON
            PMB   = 0.01*(AH(L)+BH(L)*PRESPA(I))
            TD    =T(I,L)-ES(I,L-ILEV+LEVS) 
            PVAP  =EXP(AA-BB/TD)
            Q(I,L)=EPS1*PVAP/(PMB-EPS2*PVAP)
  450     CONTINUE
  
        ELSEIF(MOIST.EQ.NC4TO8("  TD"))THEN
          DO 500 I=1,LON
            PMB   = 0.01*(AH(L)+BH(L)*PRESPA(I))
            PVAP  =EXP(AA -BB / ES(I,L-ILEV+LEVS) ) 
            Q(I,L)=EPS1*PVAP/(PMB-EPS2*PVAP)
  500     CONTINUE
  
        ELSEIF(MOIST.EQ.NC4TO8(" LNQ"))THEN
          DO 550 I=1,LON
            Q(I,L)=EXP(ES(I,L-ILEV+LEVS)) 
  550     CONTINUE
  
        ELSE
                                                   CALL XIT('HSCAL',-2)
        ENDIF 
  
        IF(LOWBND)THEN
          DO 600 I=1,LON
            Q(I,L)=MAX(0.,Q(I,L)) 
  600     CONTINUE
        ENDIF 
  
  800 CONTINUE
      RETURN
      END 
