#include "dims.h"
      SUBROUTINE CMPH2
      use cons_module,only: len1,len2,kmax
      implicit none
C     ****
C     ****     ADVANCES PSI(H2) 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 "lowbnd.h"
#include "phys.h"
#include "compcom.h"
#include "mwt.h"
#include "diffk.h"
#include "cmpdat.h"
!
! Local:
C
      real :: PHIH2(3)=(/0.226,0.321,0.282/)
      integer :: nmsk,nopk,nph2ok,nph2k,npo1k,npch4k,njh2olk,nphoxk,i,k,
     |  ibnd,ibndb
      real :: alfa,xyh2
C     ****
C     ****     NUMBER DENSITY MIXING RATIO OF H2 AT LOWER BOUNDARY
C     ****
      NMSK = NJ+NMS
      NOPK = NJ+NOP
      NPH2OK = NJ+NPH2O
      NPH2K = NJ+NPH2
      NPO1K = NJ+NPO1
      NPCH4K = NJ+NPCH4
      NJH2OLK = NJH2OL-1
      NPHOXK = NJ+NPHOX
      DO 1 I=1,LEN1
C     ****
C     ****     VALUE AT BOTTOM GIVEN BY SPECIFIED NUMBER DENSITY
C     ****     MIXING RATIO XH2LB
C     ****
      T1(I) = 0.
      T2(I) = 1.
      T3(I) = -XH2LB(J)*RMH2/F(I,NMSK)
C     ****
C     ****     ZERO DIFFUSIVE FLUX AT TOP
C     ****
      T4(I) = 0.
    1 CONTINUE
      DO 2 K=1,KMAX
       NJH2OLK = NJH2OLK+1
      DO 2 I=1,LEN1
      S4(I,K) = 0.5*(F(I,NJH2OLK)+F(I,NJH2OLK+1))
    2 CONTINUE
C     ****
C     ****     SOURCES
C     ****
      DO 3 I=1,LEN2
C     ****
C     ****     S3 = N*MBAR  (K+1/2)
C     ****
      S3(I,1) = XNMBAR(I,1)
C     ****
C     ****     S2 = NUMBER DENSITY PRODUCTION OF H2
C     ****
CC    S2(I,1) = S3(I,1)*S4(I,1)*F(I,NPH2OK)/RMH2O
CC   1          +(RKM38*RATIO2(I,1)+
CC   2          RKM41(I,1)*S3(I,1)/(.5*(F(I,NMSK)+F(I,NMSK+1))))*
CC   3           (RATIO3(I,1)*F(I,NPHOXK)/RMTRU(I,1)*S3(I,1))**2
CC   4          +GAM2B*F(I,NPCH4K)/RMCH4*XNO1D(I,1)/RMO1*
CC   5          S3(I,1)*S3(I,1)+XJCH2OB(I,1)*CH2O(I,1)
      S2(I,1) = S3(I,1)*0.12*S4(I,1)*F(I,NPH2OK)/RMH2O
     1          +(RKM38*RATIO2(I,1)+
     2          RKM41(I,1)*S3(I,1)/(.5*(F(I,NMSK)+F(I,NMSK+1))))*
     3           (RATIO3(I,1)*F(I,NPHOXK)/RMTRU(I,1)*S3(I,1))**2
     4          +RKM5B*F(I,NPCH4K)/RMCH4*XNO1D(I,1)/RMO1*
     5          S3(I,1)*S3(I,1)
C     ****
C     ****     S1 = (NUMBER DENSITY LOSS)/ H2
C     ****
      S1(I,1) = -S3(I,1)*(RKM4*XNO1D(I,1)/RMO1+RKM28(I,1)
     1          *F(I,NPO1K)/RMO1+RKM33(I,1)*F(I,NPHOXK)/RMTRU(I,1)
     2          *RATIO1(I,1)*RATIO3(I,1))-RK14*F(I,NOPK)
   3  CONTINUE
C     IF(J.EQ.18) CALL EZCNTR(S2,LEN1,KMAX)
      IBND = 0
      IBNDB = 0
      ALFA = 0.
      XYH2 = 1.E-4
!
      CALL MINOR(NPH2,NPH2NM,RMH2,PHIH2,ALFA,IBND,IBNDB,WH2,XYH2,NPDHH2,
     1 difkk)
      RETURN
      END