CMAX: [Version 1.0 (6/22/93)]
CMAX: ----------------------------------------------------
CMAX: Transformation of QSTARS from qstars.f
CMAX: ----------------------------------------------------
      SUBROUTINE qstars(t,p,e1,e2,tq,i1,i2,n,qsat)
C***********************************************************************
C  FUNCTION VQSAT
C  PURPOSE
C     VECTOR COMPUTATION OF SATURATION MIXING RATIO
C  USAGE
C     QSATT(1;N) = VQSAT(T(1;N),P(1;N),N;QSATT(1;N))
C  DESCRIPTION OF PARAMETERS
C     T        TEMPERATURE VECTOR (DEG K)
C     P        PRESSURE VECTOR (MB)
C     VQSAT    SATURATION MIXING RATIO VECTOR
C
C  DATE:  1982
C***********************************************************************
C
      PARAMETER (ONE = 1.)
      PARAMETER (ZP622 = 0.622)
      PARAMETER (Z1P0S1 = 1.00001)
      PARAMETER (Z1P622 = 1.622)
      PARAMETER (Z138P9 = 138.90001)
      PARAMETER (Z198P9 = 198.99999)
      PARAMETER (Z200 = 200.0)
      PARAMETER (Z337P9 = 337.9)
      DIMENSION QSAT (N), I2 (N), I1 (N), TQ (N), E2 (N), E1 (N), P (N),
     & T (N)
C
      DIMENSION EST2 (72), EST1 (67), EST (139)
      EQUIVALENCE (EST (1), EST1 (1)), (EST (68), EST2 (1))
!hpf$ distribute e1(block)
!hpf$ distribute e2(block)
!hpf$ distribute est(block)
!hpf$ distribute est1(block)
!hpf$ distribute est2(block)
!hpf$ distribute i1(block)
!hpf$ distribute i2(block)
!hpf$ distribute p(block)
!hpf$ distribute qsat(block)
!hpf$ distribute t(block)
!hpf$ distribute tq(block)
C
      DATA EST1 / 0.31195E-02, 0.36135E-02, 0.41800E-02, 0.48227E-02, 0.
     &55571E-02, 0.63934E-02, 0.73433E-02, 0.84286E-02, 0.96407E-02, 0.1
     &1014E-01, 0.12582E-01, 0.14353E-01, 0.16341E-01, 0.18574E-01, 0.21
     &095E-01, 0.23926E-01, 0.27096E-01, 0.30652E-01, 0.34629E-01, 0.390
     &73E-01, 0.44028E-01, 0.49546E-01, 0.55691E-01, 0.62508E-01, 0.7007
     &7E-01, 0.78700E-01, 0.88128E-01, 0.98477E-01, 0.10983E+00, 0.12233
     &E+00, 0.13608E+00, 0.15121E+00, 0.16784E+00, 0.18615E+00, 0.20627E
     &+00, 0.22837E+00, 0.25263E+00, 0.27923E+00, 0.30838E+00, 0.34030E+
     &00, 0.37520E+00, 0.41334E+00, 0.45497E+00, 0.50037E+00, 0.54984E+0
     &0, 0.60369E+00, 0.66225E+00, 0.72589E+00, 0.79497E+00, 0.86991E+00
     &, 0.95113E+00, 0.10391E+01, 0.11343E+01, 0.12372E+01, 0.13484E+01,
     & 0.14684E+01, 0.15979E+01, 0.17375E+01, 0.18879E+01, 0.20499E+01, 
     &0.22241E+01, 0.24113E+01, 0.26126E+01, 0.28286E+01, 0.30604E+01, 0
     &.33091E+01, 0.35755E+01 /
C
      DATA EST2 / 0.38608E+01, 0.41663E+01, 0.44930E+01, 0.48423E+01, 0.
     &52155E+01, 0.56140E+01, 0.60394E+01, 0.64930E+01, 0.69767E+01, 0.7
     &4919E+01, 0.80406E+01, 0.86246E+01, 0.92457E+01, 0.99061E+01, 0.10
     &608E+02, 0.11353E+02, 0.12144E+02, 0.12983E+02, 0.13873E+02, 0.148
     &16E+02, 0.15815E+02, 0.16872E+02, 0.17992E+02, 0.19176E+02, 0.2042
     &8E+02, 0.21750E+02, 0.23148E+02, 0.24623E+02, 0.26180E+02, 0.27822
     &E+02, 0.29553E+02, 0.31378E+02, 0.33300E+02, 0.35324E+02, 0.37454E
     &+02, 0.39696E+02, 0.42053E+02, 0.44531E+02, 0.47134E+02, 0.49869E+
     &02, 0.52741E+02, 0.55754E+02, 0.58916E+02, 0.62232E+02, 0.65708E+0
     &2, 0.69351E+02, 0.73168E+02, 0.77164E+02, 0.81348E+02, 0.85725E+02
     &, 0.90305E+02, 0.95094E+02, 0.10010E+03, 0.10533E+03, 0.11080E+03,
     & 0.11650E+03, 0.12246E+03, 0.12868E+03, 0.13517E+03, 0.14193E+03, 
     &0.14899E+03, 0.15634E+03, 0.16400E+03, 0.17199E+03, 0.18030E+03, 0
     &.18895E+03, 0.19796E+03, 0.20733E+03, 0.21708E+03, 0.22722E+03, 0.
     &23776E+03, 0.24871E+03 /
C
C***********************************************************************
C
      a1622 = one / z1p622
      DO 7000 i = 1 , n
        tq(i) = t(i) - z198p9
        IF (t(i) .LT. z200) THEN
          tq(i) = z1p0s1
        ENDIF
        IF (t(i) .GT. z337p9) THEN
          tq(i) = z138p9
        ENDIF
        i1(i) = tq(i)
        i2(i) = i1(i) + 1
   10   CONTINUE
 7000 CONTINUE
C
      DO 7002 i = 1 , n
        e1(i) = est(i1(i))
        e2(i) = est(i2(i))
   11   CONTINUE
 7002 CONTINUE
C
      DO 7004 i = 1 , n
        qsat(i) = tq(i) - i1(i)
        qsat(i) = qsat(i) * (e2(i) - e1(i))
        qsat(i) = qsat(i) + e1(i)
        e1(i) = p(i) * a1622
        IF (e1(i) .LT. qsat(i)) THEN
          qsat(i) = e1(i)
        ENDIF
        qsat(i) = zp622 * qsat(i) / p(i)
   12   CONTINUE
 7004 CONTINUE
C
      RETURN
      END
