#include "dims.h"
      SUBROUTINE H2OFIX
      use cons_module,only: len2
      implicit none
C     ****
C     ****     ADVANCES PSI(H2O) BY ONE TIME STEP
C     ****
#include "params.h"
#include "fcom.h"
#include "vscr.h"
#include "index.h"
#include "buff.h"
#include "lowbnd.h"
#include "phys.h"
#include "compcom.h"
      integer :: nph2ok,npnmk,nmsk,i
C     NPH2OK = NJ+NPH2O
C     NPNMK = NJ+NPH2ONM
C     NMSK = NJ+NMS
C     DO 1 I=1,LEN2
C     IF(F(I,NPH2OK).GT.8.E-6*18./F(I,NMSK)) THEN
C     F(I,NPH2OK) = 8.E-6*18./F(I,NMSK)
C     F(I,NPNMK) = 8.E-6*18./F(I,NMSK)
C     ENDIF
C  1  CONTINUE
      RETURN
      END
!-------------------------------------------------------------------
      SUBROUTINE CMPH2O
      use cons_module,only: len1,len2,kmax
      implicit none
C     ****
C     ****     ADVANCES PSI(H2O) BY ONE TIME STEP
C     ****
#include "params.h"
#include "fcom.h"
#include "vscr.h"
#include "index.h"
#include "buff.h"
#include "crates_const.h"
#include "crates_tdep.h"
#include "phys.h"
#include "lowbnd.h"
#include "compcom.h"
#include "mwt.h"
#include "diffk.h"
#include "cmpdat.h"
!
! Local:
      real :: PHIH2O(3)=(/0.817,0.922,0.920/)
      integer :: nmsk,nopk,npo1k,nph2ok,nph2k,npch4k,nphoxk,i,k,ibnd,
     |  ibndb,njh2otk,nps1k,ntk
      real :: alfa,xyh2o
      real :: ZPK(ZKMXP),PRES(ZKMXP)
C     ****
C     ****     NUMBER DENSITY MIXING RATIO OF H2O AT LOWER BOUNDARY
C     ****
      NMSK = NJ+NMS
      NOPK = NJ+NOP
      NPO1K = NJ+NPO1
      NPH2OK = NJ+NPH2O
      NPH2K = NJ+NPH2
      NPCH4K = NJ+NPCH4
      NPHOXK = NJ+NPHOX
      DO 1 I=1,LEN1
C     ****
C     ****     VALUE AT BOTTOM GIVEN BY SPECIFIED NUMBER DENSITY
C     ****     MIXING RATIO XH2OLB
C     ****
      T1(I) = 0.
      T2(I) = 1.
      T3(I) = -XH2OLB(J)*RMH2O/F(I,NMSK)
C     ****
C     ****     ZERO DIFFUSIVE FLUX AT TOP
C     ****
      T4(I) = 0.
    1 CONTINUE
      NJH2OTK=NJH2OT-1
      DO 2 K=1,KMAX
      NJH2OTK = NJH2OTK+1
      DO 2 I=1,LEN1
      S4(I,K) = 0.5*(F(I,NJH2OTK)+F(I,NJH2OTK+1))
    2 CONTINUE
C     ****
C     ****     SOURCES
C     ****
      DO 3 I=1,LEN2
C     ****     S3 = N*MBAR  (K+1/2)
      S3(I,1) = XNMBAR(I,1)
C     ****
C     ****     S2 = NUMBER DENSITY PRODUCTION OF H2O
C     ****
CC    S2(I,1) = (RKM30(I,1)*RATIO1(I,1)**2+RKM31(I,1)*RATIO1(I,1)*
CC   1          RATIO2(I,1)+RKM40(I,1)*RATIO2(I,1))*(RATIO3(I,1)*
CC   2          F(I,NPHOXK)/RMTRU(I,1)*S3(I,1))**2
CC   3          +(RKM33(I,1)*F(I,NPH2K)/RMH2+RKM32(I,1)*XNH2O2(I,1)
CC   4          /RMH2O2)*S3(I,1)*RATIO1(I,1)*RATIO3(I,1)
CC   5          *F(I,NPHOXK)/RMTRU(I,1)*S3(I,1)
CC   6          +(GAM1(I,1)*F(I,NPCH4K)/RMCH4*S3(I,1)
CC   7          +GAM10*CH2O(I,1)+GAM8(I,1)*CH3OOH(I,1))
CC   8          *F(I,NPHOXK)/RMTRU(I,1)*RATIO1(I,1)*RATIO3(I,1)
CC   9          *S3(I,1)+DEL3(I,1)*RMCL(I,1)
CC   1          *S3(I,1)/(.5*(F(I,NMSK)+F(I,NMSK+1)))*F(I,NPCH4K)/
CC   2          RMCH4*S3(I,1)
      S2(I,1) = (RKM30(I,1)*RATIO1(I,1)**2+RKM31(I,1)*RATIO1(I,1)*
     1          RATIO2(I,1)+RKM40(I,1)*RATIO2(I,1))*(RATIO3(I,1)*
     2          F(I,NPHOXK)/RMTRU(I,1)*S3(I,1))**2
     3          +(RKM33(I,1)*F(I,NPH2K)/RMH2+RKM32(I,1)*XNH2O2(I,1)
     4          /RMH2O2)*S3(I,1)*RATIO1(I,1)*RATIO3(I,1)
     5          *F(I,NPHOXK)/RMTRU(I,1)*S3(I,1)
     6          +(2.*RKM43(I,1)*F(I,NPHOXK)/RMTRU(I,1)*RATIO1(I,1)*
     7          RATIO3(I,1)+RKM44(I,1)*F(I,NPO1K)/RMO1+
     8          RKM45*XNO1D(I,1)/RMO1)*S3(I,1)*F(I,NPCH4K)/
     9          RMCH4*S3(I,1)+DEL3(I,1)*RMCL(I,1)
     1          *S3(I,1)/(.5*(F(I,NMSK)+F(I,NMSK+1)))*F(I,NPCH4K)/
     2          RMCH4*S3(I,1)
C     ****
C     ****     S1 = NUMBER DENSITY LOSS OF H2O
C     ****
      S1(I,1) = -(S4(I,1)+RKM3*XNO1D(I,1)/RMO1*S3(I,1)
     1          +RK15*F(I,NOPK)+0.5*PHOXIC(I,1))
    3 CONTINUE
      IBND=0
      IBNDB=0
      ALFA=0.
      XYH2O = 1.E-4
      CALL MINOR(NPH2O,NPH2ONM,RMH2O,PHIH2O,ALFA,IBND,IBNDB,WH2O,
     1XYH2O,NPDHH2O,difkk)
C
C
      NMSK = NJ+NMS-1
      NPS1K = NJ+NPS-1
      NTK = NJ+NT
      DO K=1,ZKMX
        ZPK(K) = ZSB+(K-1)*DZ
        PRES(K) = 5.E-7*EXP(-ZPK(K))
        NMSK = NMSK+1
        NPS1K = NPS1K+1
	NTK = NTK+1
        DO I=1,LEN1
          S1(I,K) = F(I,NPS1K)*F(I,NMSK)/RMH2O
	  S2(I,K) = F(I,NTK)-
     1              6077.4/(37.759-ALOG(S1(I,K))-ALOG(PRES(K)))
        enddo
      enddo
      call addfsech('TNFP',' ',' ',S2,zimxp,zkmxp,zkmx,j)
C
      RETURN
      END