C
      SUBROUTINE H2OPAC(OMEGA,T,PROPAC)
C
      exp10(x)=exp(2.302585*x)
C
      A=7.02391+1.3380*ALOG10(T)
      A=exp10(A)
      A=1./A
      B=91.67+0.1033*T
      C=(15.57906-2.06158*ALOG10(T)-0.477352*(ALOG10(T))**2)/1.E7
      D=2.31317+3.8856E-4*T
      D=exp10(D)
      OMEGAC=274.3+.2762*T
C     WRITE(7,4) A,B,C,D,OMEGAC
    4 FORMAT(3X,5E15.5)
      IF (OMEGA.GE.OMEGAC) GOTO 1
      OMEGAT=A*OMEGA**2*EXP(-OMEGA/B)
      GOTO 2
    1 OMEGAT=C*EXP(-OMEGA/D)
    2 CONTINUE
C     WRITE(7,3) T,OMEGA,OMEGAT
    3 FORMAT(3X,F10.0,2E15.5)
    5 CONTINUE
      E=4.2432E-6-2.8854E-7*ALOG(T)
      F=1.2171E+5+258.28*T
      G=2.5830E-4-4.3429E-8*T
      H=1.1332E-2-1.1943E-3*ALOG(T)
      OMEGAP=-2973.3+600.73*ALOG(T)
      OMEGT2=1.5*OMEGAP
C     WRITE(7,11) E,F,G,H,OMEGAP,OMEGT2
   11 FORMAT(3X,6E15.5)
      IF(OMEGA.GT.OMEGT2) GOTO 13
      OMEGAR=E*EXP(-(OMEGA-OMEGAP)**2/F)
      GOTO 14
   13 OMEGAR=G*EXP(-H*OMEGA)
   14 CONTINUE
C     WRITE(7,15) T,OMEGA,OMEGAR
   15 FORMAT(3X,F10.0,2E15.5)
   12 CONTINUE
      GAM=6.0273E-10+2.2905E-13*T+4.0848E-17*T**2
      W1=363.96+1.3530*T-3.5807E-4*T**2+3.3618E-8*T**3
      XJ=161.45/T-2.6996-1.9537E-4*T
      XJ=exp10(XJ)
      W2=-108626./T+697.59+0.14353*T
      XT=28.765/T-9.0461+1.1552E-4*T
      XT=exp10(XT)
      XG=1.4860+0.44462*ALOG10(T)
      XG=exp10(XG)
      XNYC=-5.1972+2.1*ALOG10(T)
      XNYC=-(exp10(XNYC)-4172.)
      W232=1.5*W2
C     WRITE(7,21) GAM,W21,XJ,W2,XT,XG,XNYC,W232
   21  FORMAT(3X,8E15.5)
      XNY=OMEGA
      IF(XNY.GE.XNYC) GOTO 23
      OMEGAK=GAM*W1**2*EXP(XJ*(XNY-XNYC))/((XNY-XNYC)**2+W1**2)
      GOTO 24
   23 IF(XNY.GT.(XNYC+W232)) GOTO 25
      OMEGAK=GAM*W2**2/((XNY-XNYC)**2+W2**2)
      GOTO 24
   25 OMEGAK=XT*EXP(-(XNY-XNYC)/XG)
   24 OMEGAK=OMEGAK*OMEGA
C     WRITE(7,26) T,XNY,OMEGAK
   26 FORMAT(3X,2F10.0,E15.5)
   22 CONTINUE
      PROPAC=OMEGAR+OMEGAT+OMEGAK
      RETURN
      END