#include "dims.h"
      SUBROUTINE CMPCH4
      use cons_module,only: len1,len2,kmax
      implicit none
C     ****
C     ****     ADVANCES PSI(CH4) 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"
C     ****
C     ****     NUMBER DENSITY MIXING RATIO OF CH4 AT LOWER BOUNDARY
C     ****
!
! Local:
      real :: PHICH4(3) = (/0.921,0.846,1.077/)
      integer :: nmsk,npo1k,njch4tk,npch4k,nphoxk,i,k,ibnd,ibndb
      real :: xych4,alfa
C
C     ****
C     ****     BOUNDARIES
C     ****
      NMSK = NJ+NMS
      NPO1K = NJ+NPO1
      NJCH4TK = NJCH4T-1
      NPCH4K = NJ+NPCH4
      NPHOXK = NJ+NPHOX
      DO 1 I=1,LEN1
C     ****
C     ****     VALUE AT BOTTOM GIVEN BY SPECIFIED NUMBER DENSITY
C     ****     MIXING RATIO XCOLB
C     ****
      T1(I) = 0.
      T2(I) = 1.
      T3(I) = -XCH4LB(J)*RMCH4/F(I,NMSK)
C     ****
C     ****     ZERO DIFFUSIVE FLUX AT TOP
C     ****
      T4(I) = 0.
    1 CONTINUE
      DO 2 K=1,KMAX
      NJCH4TK = NJCH4TK+1
      DO 2 I=1,LEN1
      S4(I,K) = 0.5*(F(I,NJCH4TK)+F(I,NJCH4TK+1))
    2 CONTINUE
C     ****
C     ****     SOURCES
C     ****
      DO 3 I=1,LEN2
      S3(I,1) = XNMBAR(I,1)
C     ****
C     ****  S15 = OH
      S15(I,1) = F(I,NPHOXK)/RMTRU(I,1)*RATIO1(I,1)*RATIO3(I,1)
     1           *S3(I,1)
C     ****
C     ****     S2 = NUMBER DENSITY PRODUCTION OF CH4
C     ****
      S2(I,1) = 0.
C     ****
C     ****     S1 = NUMBER DENSITY LOSS OF CH4
C     ****
CC    S1(I,1) = -(GAM1(I,1)*S15(I,1)+((RKM5A+RKM5B)*
CC   1          XNO1D(I,1)/RMO1+GAM13(I,1)*F(I,NPO1K)
CC   2          /RMO1)*S3(I,1)+S4(I,1)+DEL3(I,1)*RMCL(I,1)
CC   3          *S3(I,1)/(.5*(F(I,NMSK)+F(I,NMSK+1))))
      S1(I,1) = -(RKM43(I,1)*S15(I,1)+(RKM45*
     1          XNO1D(I,1)/RMO1+RKM44(I,1)*F(I,NPO1K)
     2          /RMO1)*S3(I,1)+S4(I,1)+DEL3(I,1)*RMCL(I,1)
     3          *S3(I,1)/(.5*(F(I,NMSK)+F(I,NMSK+1))))
    3 CONTINUE
      IBND=0
      IBNDB=0
      ALFA=0.
C     XYCH4 = 1.E-10
      XYCH4 = 1.E-4
      CALL MINOR(NPCH4,NPCH4NM,RMCH4,PHICH4,ALFA,IBND,IBNDB,WCH4,
     1XYCH4,NPDHCH4,difkk)
      RETURN
      END