CDIR$ NOLIST                                                                       PPHOTO.77        
*DK COMP                                                                           COMP.1           
CDIR$ NOLIST                                                                       COMP.2           
      SUBROUTINE COMP
      SAVE
C     ****    ADVANCE PSI IN TIME                                                  COMP.5           
C     ****                                                                         COMP.6           
C     ****    COMMON DECKS:                                                        COMP.7           
C     ****                                                                         COMP.8           
C     ****      PARAMS, ASAS, CONS, CRATES, INDEX, SOURCE, VSCR2                   COMP.9           
C     ****                                                                         COMP.10          
      include 'params.h'
      include 'asas2.h'
      include 'cons2.h'
      include 'crates2.h'
      include 'index.h'
      include 'source2.h'
      include 'vscr2.h'
      DIMENSION AK0(2,2),S(2,2),PHI(2,3),DELTA(2,2),B(2,2)
      DIMENSION SS(2,2)
      DIMENSION ENMBAR(IMXP),FS11ST(IMXP),FS12ST(IMXP),FS21ST(IMXP),
     1  FS22ST(IMXP),ST(IMXP)
      EQUIVALENCE (C(40),B)
      DATA PHI/0.,0.673,1.35,0.,1.11,0.769/,TAU/1.86E+3/,
     AS/-1.,1.,0.,0./,DELTA/1.,0.,0.,1./,
     BT00/273./
      DATA SS/0.,0.,1.,-1./
      DATA SMALL/1.E-6/
      DFACT=1.
C     ****     CALCULATE EMBAR                                                     COMP.29          
      NPS1K=NJ+NPS-1
      NPS2K=NPS1K+KMAXP1
      DO 1 K = 1,KMAXP1
      DO 1 I=1,LEN1
	EMBAR(I,K)=1./(F(I,NPS1K+K)/RMASS(1)+F(I,NPS2K+K)/RMASS(2)+(1.-
     A  F(I,NPS1K+K)-F(I,NPS2K+K))/RMASS(3))
    1 CONTINUE
C     CALCULATE PS0, EMBAR0 AND .5*((DMBAR/DZ)/MBAR) AT LEVEL 1/2                  COMP.37          
      NPS1K=NJ+NPS
      NPS2K=NPS1K+KMAXP1
      DO 30 I=1,LEN1
	PS0(I,1)=B(1,1)*F(I,NPS1K)+B(1,2)*F(I,NPS2K)+FB(I,1)
	PS0(I,2)=B(2,1)*F(I,NPS1K)+B(2,2)*F(I,NPS2K)+FB(I,2)
	EMBAR0(I)=1./(PS0(I,1)/RMASS(1)+PS0(I,2)/RMASS(2)+(1.-PS0(I,1)
     A  -PS0(I,2))/RMASS(3))
	WKS3(I)=(EMBAR(I,1)-EMBAR0(I))/(C(3)*(EMBAR0(I)+EMBAR(I,1)))
   30 CONTINUE
C     ****     CALCULTE EP AND AK AT LEVEL 1/2, SET Z(0) TO ZERO                   COMP.47          
      KM=1
      KP=2
C     ****     EP(1/2)                                                             COMP.50          
      DO 2 L=1,2
	DO 2 I=1,LEN1
	  EP(I,L,KP)=1.-(2./(EMBAR0(I)+EMBAR(I,1)))*(RMASS(L)+
     A    (EMBAR(I,1)-EMBAR0(I))/C(3))
	  Z(I,1,L)=0.
    2 CONTINUE
      DO 3 L=1,2
	LL=3-L
	NPSL=NJ+NPS+(L-1)*KMAXP1
	DO 3 M=1,2
	  DO 3 I=1,LEN1
	    AK(I,L,M,KP)=-DELTA(L,M)*(PHI(LL,3)+(PHI(LL,L)-PHI(LL,3))*
     A        .5*(PS0(I,L)+F(I,NPSL)))-(1.-DELTA(L,M))*(PHI(L,M)-
     B        PHI(L,3))*.5*(PS0(I,L)+F(I,NPSL))
    3 CONTINUE
C     ****     WKS1=MBAR/M3*(T00/(T0+T))*0.25/(TAU*DET) AT LEVEL 1/2               COMP.66          
      NTK=NJ+NT+KMAX
      DO 4 I=1,LEN1
	WKS1(I)=0.5*(EMBAR0(I)+EMBAR(I,1))/RMASS(3)*(T00/(T0(1)+
     A  F(I,NTK)))**0.25/(TAU*(AK(I,1,1,KP)*AK(I,2,2,KP)-AK(I,1,2,KP)*
     B  AK(I,2,1,KP)))
    4 CONTINUE
C     ****     COMPLETE CALCULATION OF AK(1/2)                                     COMP.73          
      DO 5 L=1,2
	DO 5 M=1,2
	  DO 5 I=1,LEN1
	    AK(I,L,M,KP)=AK(I,L,M,KP)*WKS1(I)
C           ****     SET GAMA(0) TO 0.                                             COMP.78          
	    GAMA(I,1,L,M)=0.
    5 CONTINUE
C     ****     MAIN HEIGHT DO LOOP                                                 COMP.81          
      DO 6 K=1,KMAX
C       ****     CYCLE K LEVELS                                                    COMP.83          
	KB=KM
	KM=KP
	KP=KB
C       **** EP(K+1/2)                                                             COMP.87          
	DO 7 L=1,2
	 DO 7 I=1,LEN1
	 EP(I,L,KP)=1.-(2./(EMBAR(I,K)+EMBAR(I,K+1)))*(RMASS(L)+
     A   (EMBAR(I,K+1)-EMBAR(I,K))/C(3))
    7 CONTINUE
C     ****     AK(K+1/2)                                                           COMP.93          
      DO 8 L=1,2
	LL=3-L
	NPSL=NJ+NPS+(L-1)*KMAXP1+K
	DO 8 M=1,2
	  DO 8 I=1,LEN1
	    AK(I,L,M,KP)=-DELTA(L,M)*(PHI(LL,3)+(PHI(LL,L)-PHI(LL,3))*
     A        .5*(F(I,NPSL-1)+F(I,NPSL)))-(1.-DELTA(L,M))*(PHI(L,M)-
     B        PHI(L,3))*.5*(F(I,NPSL-1)+F(I,NPSL))
    8 CONTINUE
C     ****     WKS1=MBAR/M3*(T00/(T0+T))**0.25/(TAU*DET(ALFA))                     COMP.103         
      NTK=NJ+NT+K
      DO 9 I=1,LEN1
	WKS1(I)=0.5*(EMBAR(I,K)+EMBAR(I,K+1))/RMASS(3)*(T00/(T0(K+1)+.5*
     A    (F(I,NTK-1)+F(I,NTK))))**0.25/(TAU*(AK(I,1,1,KP)*AK(I,2,2,KP)-
     B    AK(I,1,2,KP)*AK(I,2,1,KP)))
C       ****     EDDY DIFFUSION TERMS IN WKS1 AND WKS2                             COMP.109         
	WKS2(I)=WKS3(I)
	WKS3(I)=(EMBAR(I,K+1)-EMBAR(I,K))/(C(3)*(EMBAR(I,K)+
     C    EMBAR(I,K+1)))
    9 CONTINUE
C     ****                                                                         COMP.114         
C     ****     CALCULATE AUGMENTED SOURCE TERMS                                    COMP.115         
C     ****                                                                         COMP.116         
      NTK=NJ+NT+K-1
      NPS1K=NJ+NPS+K-1
      NPS2K=NPS1K+KMAXP1
C     ****     ENMBAR=P0*EXPS*MBAR/(K*T)                                           COMP.120         
      DO 91 I = 1,LEN1
	ENMBAR(I)=C(81)*EXPS(K)*EMBAR(I,K)/(C(84)*F(I,NTK))
	FS11ST(I)=ENMBAR(I)**2*(-.5/.3*(RK13(K,I)+RK13(K+1,I))*
     1    (F(I,NPS2K)/RMASS(2))**2-1./3.*(RK14(K,I)+RK14(K+1,I))*
     2    F(I,NPS1K)/RMASS(1)*F(I,NPS2K)/RMASS(2)+.5*(RK15(K,I)+
     3    RK15(K+1,I))*(-.5*F(I,NPS2K)/(RMASS(2)*EMBAR(I,K))+1./3.*
     4    (F(I,NPS2K)/RMASS(2))**2+2./3.*F(I,NPS1K)/RMASS(1)*
     5    F(I,NPS2K)/RMASS(2)))
	FS21ST(I)=.5*(FS21(K,I)+FS21(K+1,I))+FS11ST(I)
	FS11ST(I)=.5*(FS11(K,I)+FS11(K+1,I))+FS11ST(I)
	FS12ST(I)=-1./3.*(RK13(K,I)+RK13(K+1,I))*F(I,NPS1K)/RMASS(1)*
     1    F(I,NPS2K)/RMASS(2)-1./6.*(RK14(K,I)+RK14(K+1,I))*(F(I,NPS1K)/
     2    RMASS(1))**2+.5*(RK15(K,I)+RK15(K+1,I))*F(I,NPS1K)/RMASS(1)*
     3    (-.5/EMBAR(I,K)+1./3.*F(I,NPS1K)/RMASS(1)+2./3.*F(I,NPS2K)/
     4    RMASS(2))
	FS22ST(I)=.5*(FS22(K,I)+FS22(K+1,I))+ENMBAR(I)**2*(-(RK12(K,I)+
     1    RK12(K+1,I))*F(I,NPS2K)/(RMASS(2)*EMBAR(I,K))+FS12ST(I))
	FS12ST(I)=.5*(FS12(K,I)+FS12(K+1,I))+ENMBAR(I)**2*(.5*(RK12(K,I)
     1    +RK12(K+1,I))*F(I,NPS2K)/(RMASS(2)*EMBAR(I,K))+FS12ST(I))
C       ****                                                                       COMP.140         
C       ****     TOTAL SOURCE                                                      COMP.141         
C       ****                                                                       COMP.142         
C       ST(I)=.5*(ENMBAR(I)*((2.*(FS11(K,I)+FS11(K+1,I))+FS21(K,I)+                COMP.143         
C    1    FS21(K+1,I))*F(I,NPS1K)/RMASS(1)+(2.*(FS12(K,I)+FS12(K+1,I))+            COMP.144         
C    2    FS22(K,I)+FS22(K+1,I))*F(I,NPS2K)/RMASS(2))+2.*(FS1(K,I)+                COMP.145         
C    3    FS1(K+1,I))+FS2(K,I)+FS2(K+1,I)-3.*ENMBAR(I)**3*((RK13(K,I)+             COMP.146         
C    4    RK13(K+1,I))*F(I,NPS1K)/RMASS(1)*(F(I,NPS2K)/RMASS(2))**2+               COMP.147         
C    5    (RK14(K,I)+RK14(K+1,I))*(F(I,NPS1K)/RMASS(1))**2*F(I,NPS2K)/             COMP.148         
C    6    RMASS(2)+(RK15(K,I)+RK15(K+1,I))*F(I,NPS1K)/RMASS(1)*                    COMP.149         
C    7    F(I,NPS2K)/RMASS(2)*(1.-F(I,NPS1K)-F(I,NPS2K))/RMASS(3)))*               COMP.150         
C    8    RMASS(2)/ENMBAR                                                          COMP.151         
	ST(I)=0.
C       ****                                                                       COMP.153         
C       ****     SET UP SOURCE MATRIX IN WKM2                                      COMP.154         
C       ****                                                                       COMP.155         
	WKM2(I,1,1)=FS11ST(I)-ST(I)
	WKM2(I,1,2)=2.*FS12ST(I)
	WKM2(I,2,1)=.5*FS21ST(I)
	WKM2(I,2,2)=FS22ST(I)-ST(I)
   91 CONTINUE
C     ****     FINISH CALCULATING AK(K+1/2) AND GENERATE PK, QK, RK                COMP.161         
      NWK=NJ+NW+K
      DO 10 L=1,2
	DO 10 M=1,2
	  DO 10 I=1,LEN1
	    AK(I,L,M,KP)=AK(I,L,M,KP)*WKS1(I)
	    PK(I,L,M)=(AK(I,L,M,KM)*(1./C(3)+EP(I,M,KM)/2.)-EXPS(K)
     A        *(C(87)*DIFK(I,K)*DFACT*(1./C(3)-WKS2(I))+0.25*
     B        (F(I,NWK-1)+F(I,NWK)))*DELTA(L,M))/C(3)
	    RK(I,L,M)=(AK(I,L,M,KP)*(1./C(3)-EP(I,M,KP)/2.)-EXPS(K)
     A        *(C(86)*DIFK(I,K+1)*DFACT*(1./C(3)+WKS3(I))-0.25*
     B        (F(I,NWK-1)+F(I,NWK)))*DELTA(L,M))/C(3)
	    QK(I,L,M)=-(AK(I,L,M,KM)*(1./C(3)-EP(I,M,KM)/2.)+
     A        AK(I,L,M,KP)*(1./C(3)+EP(I,M,KP)/2.))/C(3)+EXPS(K)*
     B        (((C(86)*DIFK(I,K+1)*(1./C(3)-WKS3(I))+C(87)*DIFK(I,K)*
     C        (1./C(3)+WKS2(I)))*DFACT/C(3)+C(7))*DELTA(L,M)-
     D        WKM2(I,L,M))
   10 CONTINUE
C     ****     CALCULATE HORIZONTAL ADVECTION IN FK ARRAY                          COMP.179         
      DO 11 L=1,2
	NPSL=NPS+(L-1)*KMAXP1
	CALL ADVECL(NPSL,FK(1,L),K)
   11 CONTINUE
C     ****                                                                         COMP.184         
C     ****     ADD EXPLICIT SOURCE TERMS FK                                        COMP.185         
C     ****                                                                         COMP.186         
      DO 111 I = 1,LEN1
	FK(I,1)=FK(I,1)-(FS1(K,I)+FS1(K+1,I))*RMASS(2)/ENMBAR(I)
	FK(I,2)=FK(I,2)-.5*(FS2(K,I)+FS2(K+1,I))*RMASS(2)/ENMBAR(I)
  111 CONTINUE
C     ****     SHAPIRO SMOOTHER   (ELIMINATED)                                     COMP.191         
      DO 112 L=1,2
	NPSK=NPSNM+(L-1)*KMAXP1+K-1
	NPSNMK=NJ+NPSK
	DO 112 I=3,IMAXP2
	  WKV2(I,L)=F(I,NPSNMK)-C(26)*(F(I+2,NPSNMK)+F(I-2,NPSNMK)-4.*
     1       (F(I+1,NPSNMK)+F(I-1,NPSNMK))+6.*F(I,NPSNMK))
  112 CONTINUE
C     ****     COMPLETE CALCULATION OF RHS IN FK                                   COMP.199         
      DO 12 L=1,2
	DO 12 I=3,IMAXP2
	  FK(I,L)=EXPS(K)*(WKV2(I,L)*C(7)-FK(I,L))
   12 CONTINUE
C     ****     INSERT PERIODIC POINTS                                              COMP.204         
      DO 121 L = 1,2
	DO 121 I = 1,2
	  FK(I,L) = FK(I+IMAX,L)
	  FK(I+IMAXP2,L) = FK(I+2,L)
  121 CONTINUE
      IF(K.EQ.1) GO TO 13
      IF(K.EQ.KMAX) GO TO 14
      GO TO 15
   13 CONTINUE
C     ****     LOWER BNDRY                                                         COMP.214         
      DO 16 L=1,2
	DO 16 M=1,2
	  DO 16 KK=1,2
	    DO 16 I=1,LEN1
	      QK(I,L,M)=QK(I,L,M)+PK(I,L,KK)*B(KK,M)
   16 CONTINUE
      DO 33 L=1,2
	DO 33 M=1,2
	  DO 33 I=1,LEN1
	    FK(I,L)=FK(I,L)-PK(I,L,M)*FB(I,M)
	    PK(I,L,M)=0.
   33 CONTINUE
      GO TO 15
   14 CONTINUE
C     ****     UPPER BNDRY                                                         COMP.229         
      DO 17 L=1,2
	DO 17 M=1,2
	  DO 17 I=1,LEN1
	    QK(I,L,M)=QK(I,L,M)+(1.+.5*EP(I,M,KP)*C(3))/(1.-.5*
     A        EP(I,M,KP)*C(3))*RK(I,L,M)
	    RK(I,L,M)=0.
   17 CONTINUE
   15 CONTINUE
C     ****     QK=ALFAK=QK-PK*GAMA(K-1)                                            COMP.238         
      DO 18 L=1,2
	DO 18 M=1,2
	  DO 18 KK=1,2
	    DO 18 I=1,LEN1
	      QK(I,L,M)=QK(I,L,M)-PK(I,L,KK)*GAMA(I,K,KK,M)
   18 CONTINUE
C     ****     WKS1=DET(ALFA)                                                      COMP.245         
      DO 19 I=1,LEN1
	WKS1(I)=QK(I,1,1)*QK(I,2,2)-QK(I,1,2)*QK(I,2,1)
   19 CONTINUE
C     ****     WKM1=ALFAI                                                          COMP.249         
      DO 20 L=1,2
	LL=3-L
	DO 20 M=1,2
	  DO 20 I=1,LEN1
	    WKM1(I,L,M)=(DELTA(L,M)*QK(I,LL,LL)-(1.-DELTA(L,M))*
     A        QK(I,L,M))/WKS1(I)
   20 CONTINUE
C     ****     GAMA(K+1)=ALFAI*RK                                                  COMP.257         
C     ****     WKV1=FK-PK*Z(K)                                                     COMP.258         
      DO 21 L=1,2
	DO 22 I=1,LEN1
	  WKV1(I,L)=FK(I,L)
   22 CONTINUE
      DO 21 M=1,2
	DO 23 I=1,LEN1
	  GAMA(I,K+1,L,M)=0.
	  WKV1(I,L)=WKV1(I,L)-PK(I,L,M)*Z(I,K,M)
   23   CONTINUE
	DO 21 KK=1,2
	  DO 21 I=1,LEN1
	    GAMA(I,K+1,L,M)=GAMA(I,K+1,L,M)+WKM1(I,L,KK)*RK(I,KK,M)
   21 CONTINUE
C     ****     Z(K+1)=WKM1*WKV1                                                    COMP.272         
      DO 231 L=1,2
	DO 232 I=1,LEN1
	  Z(I,K+1,L)=0.
  232   CONTINUE
	DO 231 M=1,2
	  DO 231 I=1,LEN1
	    Z(I,K+1,L)=Z(I,K+1,L)+WKM1(I,L,M)*WKV1(I,M)
  231 CONTINUE
    6 CONTINUE
C     ****     SET PSNP(KMAXP1) TO ZERO                                            COMP.282         
      DO 24 L=1,2
	NPSL=NJNP+NPS+(L-1)*KMAXP1+KMAX
	DO 24 I=1,LEN1
	  F(I,NPSL)=0.
   24 CONTINUE
C     ****     DOWNWARD SWEEP                                                      COMP.288         
      DO 25 KK=1,KMAX
	K=KMAX+1-KK
	DO 25 L=1,2
	  NPSL=NJNP+NPS+(L-1)*KMAXP1+(K-1)
	  DO 26 I=1,LEN1
	    F(I,NPSL)=Z(I,K+1,L)
   26     CONTINUE
	  DO 25 M=1,2
	    NPSM=NJNP+NPS+(M-1)*KMAXP1+K
	    DO 25 I=1,LEN1
	      F(I,NPSL)=F(I,NPSL)-GAMA(I,K+1,L,M)*F(I,NPSM)
   25 CONTINUE
C     ****     INSERT VALUE OF PS(KMAXP1) USING BNDRY CONDITION                    COMP.301         
      DO 27 L=1,2
	NPSL=NJNP+NPS+(L-1)*KMAXP1+KMAX
	DO 27 I=1,LEN1
	  F(I,NPSL)=(1.+.5*EP(I,L,KP)*C(3))/(1.-.5*EP(I,L,KP)*C(3))*
     A      F(I,NPSL-1)
   27 CONTINUE
C     ****     TIME SMOOTHING OF PSI                                               COMP.308         
      NPSNMK=NJ+NPSNM-1
      NPSK=NJ+NPS-1
      NPSNPK=NJNP+NPS-1
      NPSMNK=NJNP+NPSNM-1
      DO 29 K = 1,2*KMAXP1
      DO 29 I=1,LEN1
	F(I,NPSMNK+K)=C(30)*F(I,NPSK+K)+C(31)*(F(I,NPSNMK+K)+
     1  F(I,NPSNPK+K))
   29 CONTINUE
C     ****     INSERT PERIODIC POINTS                                              COMP.318         
      K1=NJNP+NPS
      K2=K1+2*KMAXP1-1
      DO 31 N=1,2
	DO 32 I=1,2
	  DO 32 K=K1,K2
	  F(I,K)=F(I+IMAX,K)
	  F(I+IMAXP2,K)=F(I+2,K)
   32   CONTINUE
	K1=NJNP+NPSNM
	K2=K1+2*KMAXP1-1
   31 CONTINUE
C     ****     INSURE NON-NEGATIVE PSI                                             COMP.330         
      NPS1K=NJNP+NPS-1
      NPS2K=NJNP+NPS2-1
      NPS1MK=NJNP+NPSNM-1
      NPS2MK=NJNP+NPS2NM-1
      DO 41 K=1,KMAXP1
      DO 41 I=1,LEN1
	F(I,NPS1K+K)=CVMGP(F(I,NPS1K+K),SMALL,F(I,NPS1K+K)-SMALL)
	F(I,NPS2K+K)=CVMGP(F(I,NPS2K+K),SMALL,F(I,NPS2K+K)-SMALL)
	F(I,NPS1MK+K)=CVMGP(F(I,NPS1MK+K),SMALL,F(I,NPS1MK+K)-SMALL)
	F(I,NPS2MK+K)=CVMGP(F(I,NPS2MK+K),SMALL,F(I,NPS2MK+K)-SMALL)
	F(I,NPS1K+K)=F(I,NPS1K+K)*CVMGP(1.,(1.-SMALL)/(F(I,NPS1K+K)+
     1    F(I,NPS2K+K)),1.-SMALL-F(I,NPS1K+K)-F(I,NPS2K+K))
	F(I,NPS2K+K)=F(I,NPS2K+K)*CVMGP(1.,(1.-SMALL)/(F(I,NPS1K+K)+
     1    F(I,NPS2K+K)),1.-SMALL-F(I,NPS1K+K)-F(I,NPS2K+K))
	F(I,NPS1MK+K)=F(I,NPS1MK+K)*CVMGP(1.,(1.-SMALL)/(F(I,NPS1MK+K)+
     1  F(I,NPS2MK+K)),1.-SMALL-F(I,NPS1MK+K)-F(I,NPS2MK+K))
	F(I,NPS2MK+K)=F(I,NPS2MK+K)*CVMGP(1.,(1.-SMALL)/(F(I,NPS1MK+K)+
     1  F(I,NPS2MK+K)),1.-SMALL-F(I,NPS1MK+K)-F(I,NPS2MK+K))
   41 CONTINUE
      RETURN
      END
*DK COMPARG                                                                        COMPARG.1        
      SUBROUTINE COMPARG
      SAVE
C     ****     ADVANCE AR COMPOSITION BY ONE TIME STEP                             COMPARG.4        
C     ****                                                                         COMPARG.5        
C     ****   COMMON DECKS:                                                         COMPARG.6        
C     ****   PARAMS,ASAS,CONS,FIELDS,INDEX,PHOTOO,PSIB,VSCR                        COMPARG.7        
C     ****                                                                         COMPARG.8        
      include 'params.h'
      include 'asas2.h'
      include 'cons2.h'
      include 'fields2.h'
      include 'index.h'
      include 'photoo2.h'
      include 'psib2.h'
      include 'vscr.h'
      COMMON/SODIUMP/PNA(KMXP,IMXP),XLNA(KMXP,IMXP),XLBNA(IMXP)
     1,PNAI(KMXP,IMXP),XLNAI(KMXP,IMXP),XLBNAI(IMXP)
     2,RNAO(KMXP,IMXP),RNAO2(KMXP,IMXP),RNAOH(KMXP,IMXP)
      DIMENSION PHIA(3)
      DIMENSION FMM(IMXP)
      DATA RMA,PHIA,ALFAA,PSAB/23.,1.042,1.509,1.176,0.17,0.131E-1/
C     ****     UPPER BOUNDARY - ZERO DIFFUSIVE FLUX                                COMPARG.23       
C     ****     LOWER BOUNDARY - CONSTANT VALUE                                     COMPARG.24       
      DO 1 I=3,LEN1-2
      FMM(I)=FNO(1,I)*16.+FNO2(1,I)*32.+FNN2(1,I)*28.
      T4(I)=0.
      T1(I)=0
      T2(I)=1.
      T3(I)=-XLBNA(I)*RMA/FMM(I)
    1 CONTINUE
      IBNDB=0
C     LOWER BOUNDARY FLUX CONDITION                                                COMPARG.33       
C     FLUXNA=0.                                                                    COMPARG.34       
C     DO 1 I=3,LEN1-2                                                              COMPARG.35       
C     T4(I)=0.                                                                     COMPARG.36       
C     T1(I)=0                                                                      COMPARG.37       
C     T2(I)=0.                                                                     COMPARG.38       
C     T3(I)=FLUXNA                                                                 COMPARG.39       
C   1 CONTINUE                                                                     COMPARG.40       
C     IBNDB=1                                                                      COMPARG.41       
C     ****     SOURCES                                                             COMPARG.42       
      DO 2 K=1,KMAXP1
	DO 2 I=3,IMAXP4-2
	  S1(I,K)=-XLNA(K,I)
	  S2(I,K)=PNA(K,I)
    2 CONTINUE
      DO 3 I = 1,2
	T1(I) = T1(I+IMAX)
	T1(I+IMAXP2) = T1(I+2)
	T2(I) = T2(I+IMAX)
	T2(I+IMAXP2) = T2(I+2)
	T3(I) = T3(I+IMAX)
	T3(I+IMAXP2) = T3(I+2)
	T4(I) = T4(I+IMAX)
	T4(I+IMAXP2) = T4(I+2)
	  DO 3 K = 1,KMAXP1
	    S1(I,K) = S1(I+IMAX,K)
	    S1(I+IMAXP2,K) = S1(I+2,K)
	    S2(I,K) = S2(I+IMAX,K)
	    S2(I+IMAXP2,K) = S2(I+2,K)
    3 CONTINUE
      IBND=0
      CALL MINOR (NPSA,NPSANM,RMA,PHIA,ALFAA,IBND,IBNDB,PARB)
      RETURN
      END
*DK COMPCH4                                                                        COMPCH4.1        
      SUBROUTINE COMPCH4
      SAVE
C     ****                                                                         COMPCH4.4        
C     ****     ADVANCE CH4 COMPOSITION BY ONE TIME STEP                            COMPCH4.5        
C     ****                                                                         COMPCH4.6        
C     ****     COMMON DECKS:                                                       COMPCH4.7        
C     ****       PARAMS, ASAS, CH4H2COF, CONS, FIELDS, FIELDT, FLUX,               COMPCH4.8        
C     ****         INDEX, PHOTO, PSIB, RATEBLKL, VSCR                              COMPCH4.9        
C     ****                                                                         COMPCH4.10       
      include 'params.h'
      include 'asas2.h'
      include 'ch4h2co2.h'
      include 'cons2.h'
      include 'fields2.h'
      include 'fieldt2.h'
      include 'flux2.h'
      include 'index.h'
      include 'photo2.h'
      include 'psib2.h'
      include 'rateblk2.h'
      include 'vscr.h'
      DIMENSION PHICH4(3)
      DATA RMCH4,PHICH4/16.,0.921,0.846,1.077/
C     ****                                                                         COMPCH4.25       
C     ****     UPPER BOUNDARY: DIFFUSIVE EQUILIBRIUM                               COMPCH4.26       
C     ****                                                                         COMPCH4.27       
      DO 1 I=1,LEN1
	T4(I)=0.
    1 CONTINUE
C     ****                                                                         COMPCH4.31       
C     ****     SOURCES                                                             COMPCH4.32       
C     ****                                                                         COMPCH4.33       
      DO 2 K=1,KMAXP1
	DO 2 I=3,LEN1-2
	 S1(I,K)=-(RJCH4(K,I)+RKMM(35,K,I)*FNOH(K,I)+RKMM(36,K,I)*
     1     FNO(K,I)+RKMM(37,K,I)*FNO1D(K,I))
	 S2(I,K)=0.
    2 CONTINUE
C     ****    DENSITY SPECIFIED AT LOWER BOUNDARY                                  COMPCH4.40       
      DO 4 I=3,LEN1-2
	T1(I)=0.
	T2(I)=1.
	T3(I)=-XCH4(I)*RMCH4/(FNO2(1,I)*RMASS(1)+FNO(1,I)*RMASS(2)+
     1    FNN2(1,I)*RMASS(3))
    4 CONTINUE
C     ****                                                                         COMPCH4.47       
C     ****     PERIODIC POINTS                                                     COMPCH4.48       
C     ****                                                                         COMPCH4.49       
      DO 3 I = 1,2
	T1(I) = T1(I+IMAX)
	T1(I+IMAXP2) = T1(I+2)
	T2(I) = T2(I+IMAX)
	T2(I+IMAXP2) = T2(I+2)
	T3(I) = T3(I+IMAX)
	T3(I+IMAXP2) = T3(I+2)
	T4(I) = T4(I+IMAX)
	T4(I+IMAXP2) = T4(I+2)
	  DO 3 K = 1,KMAXP1
	    S1(I,K) = S1(I+IMAX,K)
	    S1(I+IMAXP2,K) = S1(I+2,K)
	    S2(I,K) = S2(I+IMAX,K)
	    S2(I+IMAXP2,K) = S2(I+2,K)
    3 CONTINUE
      IBNDB=0
      IBND=0
      ALFA=0.
      CALL MINOR(NPCH4,NCH4NM,RMCH4,PHICH4,ALFA,IBND,IBNDB,PCH4B)
      RETURN
      END
*DK COMPCO                                                                         COMPCO.1         
      SUBROUTINE COMPCO
      SAVE
C     ****                                                                         COMPCO.4         
C     ****     ADVANCE CO COMPOSITION BY ONE TIME STEP                             COMPCO.5         
C     ****                                                                         COMPCO.6         
C     ****     COMMON DECKS:                                                       COMPCO.7         
C     ****       PARAMS, ASAS, CH4H2COF, CONS, FIELDS, FIELDT, FLUX,               COMPCO.8         
C     ****         INDEX, PHOTO, PSIB, RATEBLK, VSCR                               COMPCO.9         
C     ****                                                                         COMPCO.10        
      include 'params.h'
      include 'asas2.h'
      include 'ch4h2co2.h'
      include 'cons2.h'
      include 'fields2.h'
      include 'fieldt2.h'
      include 'flux2.h'
      include 'index.h'
      include 'photo2.h'
      include 'psib2.h'
      include 'rateblk2.h'
      include 'vscr.h'
      DIMENSION PHICO(3)
      DATA RMCO,PHICO/28.,0.833,1.427,0.852/
C     ****                                                                         COMPCO.25        
C     ****     UPPER BOUNDARY: DIFFUSIVE EQUILIBRIUM                               COMPCO.26        
C     ****                                                                         COMPCO.27        
      DO 1 I=1,LEN1
	T4(I)=0.
    1 CONTINUE
C     ****                                                                         COMPCO.31        
C     ****     SOURCES                                                             COMPCO.32        
C     ****                                                                         COMPCO.33        
      DO 2 K=1,KMAXP1
	DO 2 I=3,LEN1-2
	  S1(I,K)=-(RKMM(40,K,I)*FNO(K,I)*(FNO(K,I)+FNO2(K,I)+FNN2(K,I))
     1      +RKMM(41,K,I)*FNOH(K,I))
	  S2(I,K)=RKCO2P(K,I)*FNCO2(K,I)+(RKMM(35,K,I)*FNOH(K,I)
     1      +RKMM(36,K,I)*FNO(K,I)+RKMM(37,K,I)*FNO1D(K,I))*FNCH4(K,I)+
     2      SCOI(K,I)
    2 CONTINUE
C     ****    IF IBNDCO = 0, FLUX GIVEN AT LOWER BOUNDARY                          COMPCO.42        
      IF(IBNDCO.EQ.0)THEN
	DO 3 I=3,LEN1-2
          T1(I)=0.
          T2(I)=0.
	  T3(I)=FLUXCO(I)
    3   CONTINUE
	IBNDB=1
C       ****    IF IBNDCO = 1, PHOTOCHEMICAL EQUILIBRIUM AT LOWER                  COMPCO.50        
C       ****      BOUNDARY                                                         COMPCO.51        
      ELSE IF(IBNDCO.EQ.1)THEN
	DO 4 I=3,LEN1-2
          T1(I)=0.
          T2(I)=1.
	  T3(I)=-XCO(I)*RMCO/(FNO2(1,I)*RMASS(1)+FNO(1,I)*RMASS(2)+
     1      FNN2(1,I)*RMASS(3))
    4   CONTINUE
C     ****                                                                         COMPCO.59        
C     ****     PERIODIC POINTS                                                     COMPCO.60        
C     ****                                                                         COMPCO.61        
      DO 5 I = 1,2
	T1(I) = T1(I+IMAX)
	T1(I+IMAXP2) = T1(I+2)
	T2(I) = T2(I+IMAX)
	T2(I+IMAXP2) = T2(I+2)
	T3(I) = T3(I+IMAX)
	T3(I+IMAXP2) = T3(I+2)
	T4(I) = T4(I+IMAX)
	T4(I+IMAXP2) = T4(I+2)
	  DO 5 K = 1,KMAXP1
	    S1(I,K) = S1(I+IMAX,K)
	    S1(I+IMAXP2,K) = S1(I+2,K)
	    S2(I,K) = S2(I+IMAX,K)
	    S2(I+IMAXP2,K) = S2(I+2,K)
    5 CONTINUE
      IBNDB=0
      ENDIF
      IBND=0
      ALFA=0.
      CALL MINOR(NPCO,NPCONM,RMCO,PHICO,ALFA,IBND,IBNDB,PCOB)
      RETURN
      END
*DK COMPCO2                                                                        COMPCO2.1        
      SUBROUTINE COMPCO2
      SAVE
C     ****                                                                         COMPCO2.4        
C     ****     ADVANCE CO2 COMPOSITION BY ONE TIME STEP                            COMPCO2.5        
C     ****                                                                         COMPCO2.6        
C     ****     COMMON DECKS:                                                       COMPCO2.7        
C     ****       PARAMS, ASAS, CH4H2COF, CONS, FIELDS, FIELDT, FLUX,               COMPCO2.8        
C     ****         INDEX, PHOTO, PSIB, RATEBLK, VSCR                               COMPCO2.9        
C     ****                                                                         COMPCO2.10       
      include 'params.h'
      include 'asas2.h'
      include 'ch4h2co2.h'
      include 'cons2.h'
      include 'fields2.h'
      include 'fieldt2.h'
      include 'flux2.h'
      include 'index.h'
      include 'photo2.h'
      include 'psib2.h'
      include 'rateblk2.h'
      include 'vscr.h'
      DIMENSION PHICO2(3)
      DATA RMCO2,PHICO2/44.,1.199,3.91,1.201/
C     ****                                                                         COMPCO2.25       
C     ****     UPPER BOUNDARY: DIFFUSIVE EQUILIBRIUM                               COMPCO2.26       
C     ****                                                                         COMPCO2.27       
      DO 1 I=1,LEN1
	T4(I)=0.
    1 CONTINUE
C     ****                                                                         COMPCO2.31       
C     ****     SOURCES                                                             COMPCO2.32       
C     ****                                                                         COMPCO2.33       
      DO 2 K=1,KMAXP1
	DO 2 I=3,IMAXP4-2
	  S1(I,K)=-(RJCO2T(K,I)+RSKIONS(K,I))
	  S2(I,K)=RKMM(40,K,I)*FNCO(K,I)*FNO(K,I)*(FNO(K,I)+FNO2(K,I)+
     1      FNN2(K,I))+RKMM(41,K,I)*FNCO(K,I)*FNOH(K,I)+SCO2I(K,I)
    2 CONTINUE
C     ****    DENSITY SPECIFIED AT LOWER BOUNDARY                                  COMPCO2.40       
      DO 4 I=3,LEN1-2
	T1(I)=0.
	T2(I)=1.
	T3(I)=-XCO2(I)*RMCO2/(FNO2(1,I)*RMASS(1)+FNO(1,I)*RMASS(2)+
     1    FNN2(1,I)*RMASS(3))
    4 CONTINUE
C     ****                                                                         COMPCO2.47       
C     ****     PERIODIC POINTS                                                     COMPCO2.48       
C     ****                                                                         COMPCO2.49       
      DO 3 I = 1,2
	T1(I) = T1(I+IMAX)
	T1(I+IMAXP2) = T1(I+2)
	T2(I) = T2(I+IMAX)
	T2(I+IMAXP2) = T2(I+2)
	T3(I) = T3(I+IMAX)
	T3(I+IMAXP2) = T3(I+2)
	T4(I) = T4(I+IMAX)
	T4(I+IMAXP2) = T4(I+2)
	  DO 3 K = 1,KMAXP1
	    S1(I,K) = S1(I+IMAX,K)
	    S1(I+IMAXP2,K) = S1(I+2,K)
	    S2(I,K) = S2(I+IMAX,K)
	    S2(I+IMAXP2,K) = S2(I+2,K)
    3 CONTINUE
      IBNDB=0
      IBND=0
      ALFA=0.
      CALL MINOR(NPCO2,NCO2NM,RMCO2,PHICO2,ALFA,IBND,IBNDB,PCO2B)
      RETURN
      END
*DK COMPH2                                                                         COMPH2.1         
      SUBROUTINE COMPH2
      SAVE
C     ****                                                                         COMPH2.4         
C     ****     ADVANCE H2 COMPOSITION BY ONE TIME STEP                             COMPH2.5         
C     ****                                                                         COMPH2.6         
C     ****     COMMON DECKS:                                                       COMPH2.7         
C     ****       PARAMS, ASAS, CH4H2COF, CONS, FIELDS, FIELDT, FLUX,               COMPH2.8         
C     ****         H2FORG, INDEX, PHOTO, PSIB, RATEBLK, VSCR                       COMPH2.9         
C     ****                                                                         COMPH2.10        
      include 'params.h'
      include 'asas2.h'
      include 'ch4h2co2.h'
      include 'cons2.h'
      include 'fields2.h'
      include 'fieldt2.h'
      include 'flux2.h'
      include 'h2forg2.h'
      include 'index.h'
      include 'photo2.h'
      include 'psib2.h'
      include 'rateblk2.h'
      include 'vscr.h'
      DIMENSION PHIH2(3)
      DATA RMH2,PHIH2/2.,0.226,0.321,0.282/
C     ****                                                                         COMPH2.26        
C     ****     UPPER BOUNDARY: DIFFUSIVE EQUILIBRIUM                               COMPH2.27        
C     ****                                                                         COMPH2.28        
      DO 1 I=1,LEN1
	T4(I)=0.
    1 CONTINUE
C     ****                                                                         COMPH2.32        
C     ****     SOURCES                                                             COMPH2.33        
C     ****                                                                         COMPH2.34        
      DO 2 K=1,KMAXP1
	DO 2 I=3,IMAXP4-2
	  S1(I,K)=-(RKMM(11,K,I)*FNO1D(K,I)+RKMM(20,K,I)*FNO(K,I)+
     1      RKMM(25,K,I)*FNOH(K,I)+FK9OP(K,I))
	  S2(I,K)=0.12*RJH2OLY(K,I)*FNH2O(K,I)+RKMM(30,K,I)*FNH(K,I)*
     1      FNHO2(K,I)+RKMM(33,K,I)*
     2      FNH(K,I)*FNH(K,I)*(FNO(K,I)+FNO2(K,I)+FNN2(K,I))+RJCH4(K,I)*
     3      FNCH4(K,I)
    2 CONTINUE
C     ****    DENSITY SPECIFIED AT LOWER BOUNDARY                                  COMPH2.44        
      DO 4 I=3,LEN1-2
	T1(I)=0.
	T2(I)=1.
	T3(I)=-XH2(I)*RMH2/(FNO2(1,I)*RMASS(1)+FNO(1,I)*RMASS(2)+
     1    FNN2(1,I)*RMASS(3))
    4 CONTINUE
C     ****                                                                         COMPH2.51        
C     ****     PERIODIC POINTS                                                     COMPH2.52        
C     ****                                                                         COMPH2.53        
      DO 3 I = 1,2
	T1(I) = T1(I+IMAX)
	T1(I+IMAXP2) = T1(I+2)
	T2(I) = T2(I+IMAX)
	T2(I+IMAXP2) = T2(I+2)
	T3(I) = T3(I+IMAX)
	T3(I+IMAXP2) = T3(I+2)
	T4(I) = T4(I+IMAX)
	T4(I+IMAXP2) = T4(I+2)
	  DO 3 K = 1,KMAXP1
	    S1(I,K) = S1(I+IMAX,K)
	    S1(I+IMAXP2,K) = S1(I+2,K)
	    S2(I,K) = S2(I+IMAX,K)
	    S2(I+IMAXP2,K) = S2(I+2,K)
    3 CONTINUE
      IBNDB=0
      IBND=0
      ALFA=0.
      CALL MINOR(NPH2,NPH2NM,RMH2,PHIH2,ALFA,IBND,IBNDB,PH2B)
      RETURN
      END
*DK COMPH2O                                                                        COMPH2O.1        
      SUBROUTINE COMPH2O
      SAVE
C     ****                                                                         COMPH2O.4        
C     ****     ADVANCE H2O COMPOSITION BY ONE TIME STEP                            COMPH2O.5        
C     ****                                                                         COMPH2O.6        
C     ****     COMMON DECKS:                                                       COMPH2O.7        
C     ****       PARAMS, ASAS, CONS, DISSHOX, FIELDS, FIELDT, FLUX,                COMPH2O.8        
C     ****         INDEX, IONHOX, PHOTO, PSIB, RATEBLK, VSCR                       COMPH2O.9        
C     ****                                                                         COMPH2O.10       
C     ****                                                                         COMPH2O.11       
      include 'params.h'
      include 'asas2.h'
      include 'cons2.h'
      include 'disshox2.h'
      include 'fields2.h'
      include 'fieldt2.h'
      include 'flux2.h'
      include 'index.h'
      include 'ionhox2.h'
      include 'photo2.h'
      include 'psib2.h'
      include 'rateblk2.h'
      include 'vscr.h'
      DIMENSION PHIH2O(3)
      DATA RMH2O,PHIH2O/18.,0.817,0.922,0.920/
C     ****                                                                         COMPH2O.27       
C     ****     UPPER BOUNDARY: DIFFUSIVE EQUILIBRIUM                               COMPH2O.28       
C     ****                                                                         COMPH2O.29       
      DO 1 I=1,LEN1
	T4(I)=0.
    1 CONTINUE
C     ****                                                                         COMPH2O.33       
C     ****     SOURCES                                                             COMPH2O.34       
C     ****                                                                         COMPH2O.35       
      DO 2 K=1,KMAXP1
	DO 2 I=3,LEN1-1
	  S1(I,K)=-(SH2OSRB(K,I)+SH2OSRC(K,I)+SH2OLYA(K,I)+SH2OEUV(K,I)
     1      +RKMM(10,K,I)*FNO1D(K,I)+RKK(10,K,I)*YIOP(K,I)+RKMM(42,K,I)*
     2      FNO(K,I))
	  S2(I,K)=RKMM(22,K,I)*FNOH(K,I)*FNOH(K,I)+RKMM(23,K,I)*
     1      FNOH(K,I)*FNHO2(K,I)+RKMM(24,K,I)*FNOH(K,I)*FNH2O2(K,I)+
     2      RKMM(25,K,I)*FNOH(K,I)*FNH2(K,I)+RKMM(32,K,I)*FNH(K,I)*
     3      FNHO2(K,I)+(2.*RKMM(35,K,I)*FNOH(K,I)+RKMM(36,K,I)*FNO(K,I)+
     4      RKMM(37,K,I)*FNO1D(K,I))*FNCH4(K,I)-PHOXIC(K,I)*0.5
    2 CONTINUE
C     ****    DENSITY SPECIFIED AT LOWER BOUNDAR                                   COMPH2O.47       
      DO 4 I=3,LEN1-2
	T1(I)=0.
	T2(I)=1.
	T3(I)=-XH2O(I)*RMH2O/(FNO2(1,I)*RMASS(1)+FNO(1,I)*RMASS(2)+
     1    FNN2(1,I)*RMASS(3))
    4 CONTINUE
C     ****                                                                         COMPH2O.54       
C     ****     PERIODIC POINTS                                                     COMPH2O.55       
C     ****                                                                         COMPH2O.56       
      DO 3 I = 1,2
	T1(I) = T1(I+IMAX)
	T1(I+IMAXP2) = T1(I+2)
	T2(I) = T2(I+IMAX)
	T2(I+IMAXP2) = T2(I+2)
	T3(I) = T3(I+IMAX)
	T3(I+IMAXP2) = T3(I+2)
	T4(I) = T4(I+IMAX)
	T4(I+IMAXP2) = T4(I+2)
	  DO 3 K = 1,KMAXP1
	    S1(I,K) = S1(I+IMAX,K)
	    S1(I+IMAXP2,K) = S1(I+2,K)
	    S2(I,K) = S2(I+IMAX,K)
	    S2(I+IMAXP2,K) = S2(I+2,K)
    3 CONTINUE
C     CALL CONREC(SH2OSRB(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)           COMPH2O.72       
C     CALL FRAME                                                                   COMPH2O.73       
C     CALL CONREC(SH2OSRC(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)           COMPH2O.74       
C     CALL FRAME                                                                   COMPH2O.75       
C     CALL CONREC(SH2OLYA(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)           COMPH2O.76       
C     CALL FRAME                                                                   COMPH2O.77       
C     CALL CONREC(SH2OEUV(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)           COMPH2O.78       
C     CALL FRAME                                                                   COMPH2O.79       
C     CALL CONREC(FNO1D(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)             COMPH2O.80       
C     CALL FRAME                                                                   COMPH2O.81       
C     CALL CONREC(YIOP(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)              COMPH2O.82       
C     CALL FRAME                                                                   COMPH2O.83       
C     CALL CONREC(FNO(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)               COMPH2O.84       
C     CALL FRAME                                                                   COMPH2O.85       
C     CALL CONREC(FNOH(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)              COMPH2O.86       
C     CALL FRAME                                                                   COMPH2O.87       
C     CALL CONREC(FNHO2(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)             COMPH2O.88       
C     CALL FRAME                                                                   COMPH2O.89       
C     CALL CONREC(FNH2O2(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)            COMPH2O.90       
C     CALL FRAME                                                                   COMPH2O.91       
C     CALL CONREC(FNH2(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)              COMPH2O.92       
C     CALL FRAME                                                                   COMPH2O.93       
C     CALL CONREC(FNH(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)               COMPH2O.94       
C     CALL FRAME                                                                   COMPH2O.95       
C     CALL CONREC(FNCH4(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)             COMPH2O.96       
C     CALL FRAME                                                                   COMPH2O.97       
C     CALL CONREC(PHOXIC(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)            COMPH2O.98       
C     CALL FRAME                                                                   COMPH2O.99       
C     CALL CONREC(FNO2(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)              COMPH2O.100      
C     CALL FRAME                                                                   COMPH2O.101      
C     CALL CONREC(FNN2(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)              COMPH2O.102      
C     CALL FRAME                                                                   COMPH2O.103      
C     CALL CONREC(S1,LEN1,LEN1,KMAXP1,0.,0.,0.,0,0,-1430B)                         COMPH2O.104      
C     CALL FRAME                                                                   COMPH2O.105      
C     CALL CONREC(S2,LEN1,LEN1,KMAXP1,0.,0.,0.,0,0,-1430B)                         COMPH2O.106      
C     CALL FRAME                                                                   COMPH2O.107      
      DO 5 I = 3,IMAX+3
	DO 5 K = 1,KMAXP1
	  S3(I,K) = RKK(10,K,I)
	  S4(I,K) = RKMM(10,K,I)
	  S5(I,K) = RKMM(22,K,I)
	  S6(I,K) = RKMM(23,K,I)
	  S7(I,K) = RKMM(24,K,I)
	  S8(I,K) = RKMM(25,K,I)
	  S9(I,K) = RKMM(32,K,I)
	  S10(I,K) = RKMM(35,K,I)
	  S11(I,K) = RKMM(36,K,I)
	  S12(I,K) = RKMM(37,K,I)
	  S13(I,K) = RKMM(42,K,I)
    5 CONTINUE
C     CALL CONREC(S3(3,1),LEN1,IMAX+1,KMAXP1,0.,0.,0.,0,0,-1430B)                  COMPH2O.122      
C     CALL FRAME                                                                   COMPH2O.123      
C     CALL CONREC(S4(3,1),LEN1,IMAX+1,KMAXP1,0.,0.,0.,0,0,-1430B)                  COMPH2O.124      
C     CALL FRAME                                                                   COMPH2O.125      
C     CALL CONREC(S5(3,1),LEN1,IMAX+1,KMAXP1,0.,0.,0.,0,0,-1430B)                  COMPH2O.126      
C     CALL FRAME                                                                   COMPH2O.127      
C     CALL CONREC(S6(3,1),LEN1,IMAX+1,KMAXP1,0.,0.,0.,0,0,-1430B)                  COMPH2O.128      
C     CALL FRAME                                                                   COMPH2O.129      
C     CALL CONREC(S7(3,1),LEN1,IMAX+1,KMAXP1,0.,0.,0.,0,0,-1430B)                  COMPH2O.130      
C     CALL FRAME                                                                   COMPH2O.131      
C     CALL CONREC(S8(3,1),LEN1,IMAX+1,KMAXP1,0.,0.,0.,0,0,-1430B)                  COMPH2O.132      
C     CALL FRAME                                                                   COMPH2O.133      
C     CALL CONREC(S9(3,1),LEN1,IMAX+1,KMAXP1,0.,0.,0.,0,0,-1430B)                  COMPH2O.134      
C     CALL FRAME                                                                   COMPH2O.135      
C     CALL CONREC(S10(3,1),LEN1,IMAX+1,KMAXP1,0.,0.,0.,0,0,-1430B)                 COMPH2O.136      
C     CALL FRAME                                                                   COMPH2O.137      
C     CALL CONREC(S11(3,1),LEN1,IMAX+1,KMAXP1,0.,0.,0.,0,0,-1430B)                 COMPH2O.138      
C     CALL FRAME                                                                   COMPH2O.139      
C     CALL CONREC(S12(3,1),LEN1,IMAX+1,KMAXP1,0.,0.,0.,0,0,-1430B)                 COMPH2O.140      
C     CALL FRAME                                                                   COMPH2O.141      
C     CALL CONREC(S13(3,1),LEN1,IMAX+1,KMAXP1,0.,0.,0.,0,0,-1430B)                 COMPH2O.142      
C     CALL FRAME                                                                   COMPH2O.143      
C     WRITE(6,2345)(T3(I),XH2O(I),I=1,LEN1)                                        COMPH2O.144      
C2345 FORMAT(2E15.4)                                                               COMPH2O.145      
      IBNDB=0
      IBND=0
      ALFA=0.
      CALL MINOR(NPH2O,NH2ONM,RMH2O,PHIH2O,ALFA,IBND,IBNDB,PH2OB)
      RETURN
      END
*DK COMPHE                                                                         COMPHE.1         
      SUBROUTINE COMPHE
      SAVE
C     ****                                                                         COMPHE.4         
C     ****     COMMON DECKS:                                                       COMPHE.5         
C     ****       PARAMS, ASAS, CONS, FIELDS, HEFLUX, INDEX, PHOTOO,                COMPHE.6         
C     ****         PSIB, VSCR                                                      COMPHE.7         
C     ****                                                                         COMPHE.8         
      include 'params.h'
      include 'asas2.h'
      include 'cons2.h'
      include 'fields2.h'
      include 'heflux2.h'
      include 'index.h'
      include 'photoo2.h'
      include 'psib2.h'
      include 'vscr.h'
      COMMON/SODIUMP/PNA(KMXP,IMXP),XLNA(KMXP,IMXP),XLBNA(IMXP)
     1,PNAI(KMXP,IMXP),XLNAI(KMXP,IMXP),XLBNAI(IMXP)
     2,RNAO(KMXP,IMXP),RNAO2(KMXP,IMXP),RNAOH(KMXP,IMXP)
      DIMENSION PHIH(3)
      DIMENSION FMM(IMXP)
C     DATA RMH,PHIH,ALFAH,PSHB/23.,.270,.404,.322,-0.38,0.73E-6/                   COMPHE.23        
      DATA RMH,PHIH,ALFAH,PSHB/23.,1.042,1.509,1.176,0.17,0.131E-1/
C     ****     UPPER BOUNDARY CONDITION                                            COMPHE.25        
C     ****     T4=TOTAL FLUX AT UPPER BOUNDARY                                     COMPHE.26        
      DO 10 I=3,LEN1-2
      FMM(I)=FNO(1,I)*16.+FNO2(1,I)*32.+FNN2(1,I)*28.
      T4(I) =0.
      T1(I)=0.
      T2(I)=1.
      T3(I)=-XLBNAI(I)*RMH/FMM(I)
   10 CONTINUE
C     DO 10 I=3,LEN1-2                                                             COMPHE.34        
C     FMM(I)=FNO(1,I)*16.+FNO2(1,I)*32.+FNN2(1,I)*28.                              COMPHE.35        
C     T4(I) = FLUX(I)                                                              COMPHE.36        
C  10 CONTINUE                                                                     COMPHE.37        
C     ****     LOWER BOUNDARY CONDITION - CONSTANT VALUE                           COMPHE.38        
C     DO 4 I=3,LEN1-2                                                              COMPHE.39        
C     T1(I)=0.                                                                     COMPHE.40        
C     T2(I)=1.                                                                     COMPHE.41        
C     T3(I)=-XHE(I)*RMH/FMM(I)                                                     COMPHE.42        
C   4 CONTINUE                                                                     COMPHE.43        
C     ****     SOURCES ARE ZERO                                                    COMPHE.44        
      DO 5 K=1,KMAXP1
      DO 5 I=3,IMAXP4-2
      S1(I,K)=-XLNAI(K,I)
      S2(I,K)=PNAI(K,I)
    5 CONTINUE
C     ****                                                                         COMPHE.50        
C     ****     PERIODIC POINTS                                                     COMPHE.51        
C     ****                                                                         COMPHE.52        
      DO 3 I = 1,2
	T1(I) = T1(I+IMAX)
	T1(I+IMAXP2) = T1(I+2)
	T2(I) = T2(I+IMAX)
	T2(I+IMAXP2) = T2(I+2)
	T3(I) = T3(I+IMAX)
	T3(I+IMAXP2) = T3(I+2)
	T4(I) = T4(I+IMAX)
	T4(I+IMAXP2) = T4(I+2)
    3 CONTINUE
      IBND=0
      IBNDB=0
      CALL MINOR(NPSH,NPSHNM,RMH,PHIH,ALFAH,IBND,IBNDB,PHB)
      RETURN
      END
*DK COMPHOX                                                                        COMPHOX.1        
      SUBROUTINE COMPHOX
      SAVE
C     ****                                                                         COMPHOX.4        
C     ****     ADVANCE HOX COMPOSITION BY ONE TIME STEP                            COMPHOX.5        
C     ****                                                                         COMPHOX.6        
C     ****     COMMON DECKS:                                                       COMPHOX.7        
C     ****       PARAMS, ASAS, CONS, DISSHOX, FIELDS, FIELDT, FLUX,                COMPHOX.8        
C     ****         HOXSTUF, HOXUPP, INDEX, IONHOX, NEWRAT, PHOTO, PSIB,            COMPHOX.9        
C     ****         RATEBLK, RJH2O2O, VSCR                                          COMPHOX.10       
C     ****                                                                         COMPHOX.11       
      include 'params.h'
      include 'asas2.h'
      include 'cons2.h'
      include 'disshox2.h'
      include 'fields2.h'
      include 'fieldt2.h'
      include 'flux2.h'
      include 'hoxstuf2.h'
      include 'hoxupp2.h'
      include 'index.h'
      include 'ionhox2.h'
      include 'newrat2.h'
      include 'photo2.h'
      include 'psib2.h'
      include 'rateblk2.h'
      include 'rjh2o2o2.h'
      include 'vscr.h'
      DIMENSION FM(IMXP),SS1(IMXP),SS2(IMXP),RR(IMXP),XHOX(IMXP)
      DIMENSION PHIHOX(3)
      DATA RMHOX,PHIHOX/1.,0.146,0.243,0.162/
C     ****                                                                         COMPHOX.32       
C     ****     UPPER BOUNDARY: TOTAL FLUX=FHOX                                     COMPHOX.33       
C     ****                                                                         COMPHOX.34       
      DO 1 I=3,LEN1-2
	T4(I)=FHOX(I)
    1 CONTINUE
      IBND=1
C     ****                                                                         COMPHOX.39       
C     ****     SOURCES                                                             COMPHOX.40       
C     ****                                                                         COMPHOX.41       
C     U=9.                                                                         COMPHOX.42       
C     V=17.                                                                        COMPHOX.43       
C     W=25.                                                                        COMPHOX.44       
      U=1.
      V=1.
      W=1.
      DO 2 K=1,KMAXP1
	DO 2 I=3,LEN1-2
	  FM(I)=FNO(K,I)+FNO2(K,I)+FNN2(K,I)
	  HO2HR(K,I)=RKMM(28,K,I)*FM(I)*FNO2(K,I)/(RKMM(18,K,I)*
     1      FNO(K,I)+RBB(12,K,I)*FNNO(K,I)+RKMM(26,K,I)*FNO3(K,I))
	  OHHR(K,I)=((RKMM(18,K,I)*FNO(K,I)*RKMM(28,K,I)*FNO2(K,I)*
     1      FM(I))/(RKMM(18,K,I)*FNO(K,I)+RKMM(26,K,I)*FNO3(K,I)+
     2      RBB(12,K,I)*FNNO(K,I))+RKMM(29,K,I)*FNO3(K,I))/
     3      (RKMM(17,K,I)*FNO(K,I)+RKMM(21,K,I)*FNO3(K,I))
	  HHOXR(K,I)=1./(1.+HO2HR(K,I)+OHHR(K,I))
	  SS1(I)=HO2HR(K,I)
	  SS2(I)=OHHR(K,I)
	  RR(I)=HHOXR(K,I)
	  S2(I,K)=(2.*(SH2OSRB(K,I)+SH2OSRC(K,I)+SH2OEUV(K,I)+0.88*
     1      SH2OLYA(K,I))*FNH2O(K,I)*U+2.*RJH2O2(K,I)*FNH2O2(K,I)*V+
     2      PHOXIC(K,I)+(2.*RKMM(11,K,I)*FNH2(K,I)*U+2.*RKMM(10,K,I)*
     3      FNH2O(K,I)*V+2.*RKMM(37,K,I)*FNCH4(K,I))*FNO1D(K,I)*V+
     4      RKK(11,K,I)*YIHP(K,I)*FNO(K,I)+2.*RKMM(20,K,I)* FNH2(K,I)*
     5      FNO(K,I)*U+2.*RKMM(19,K,I)*FNH2O2(K,I)*FNO(K,I)*W+2.*
     6      RKMM(42,K,I)*FNH2O(K,I)*FNO(K,I)*V+2.*RKMM(36,K,I)*
     7      FNCH4(K,I)*FNO(K,I)*V+RKK(9,K,I)*FNH2(K,I)*YIOP(K,I)+
     8      ALPP(4,K,I)*YIOHP(K,I)*FNE(K,I))
	  S1(I,K)=-(2.*RKMM(23,K,I)*SS1(I)*RR(I)*SS2(I)*RR(I)+
     1      2.*RKMM(27,K,I)*SS1(I)*SS1(I)*RR(I)*RR(I)+2.*(RKMM(30,K,I)+
     2      RKMM(32,K,I))*SS1(I)*RR(I)*RR(I)+2.*RKMM(22,K,I)*SS2(I)*
     3      RR(I)*SS2(I)*RR(I)+2.*RKMM(33,K,I)*FM(I)*RR(I)*RR(I))*
     4      FNHOX(K,I)-RKK(12,K,I)*YIOP(K,I)*RR(I)
    2 CONTINUE
C     ****    PHOTOCHEMICAL EQUILIBRIUM AT LOWER BOUNDARY                          COMPHOX.76       
      DO 3 I = 3,LEN1-2
	FM(I)=FNO(1,I)+FNO2(1,I)+FNN2(1,I)
	SS1(I)=HO2HR(1,I)
	SS2(I)=OHHR(1,I)
	RR(I)=HHOXR(1,I)
	XHOX(I)=SQRT((2.*(SH2OSRB(1,I)+SH2OSRC(1,I)+SH2OEUV(1,I)+0.88*
     1    SH2OLYA(1,I))*FNH2O(1,I)*U+2.*RJH2O2(1,I)*FNH2O2(1,I)*V+
     1    PHOXIC(1,I)
     2    +(2.*RKMM(11,1,I)*FNH2(1,I)*U+2.*RKMM(10,1,I)*FNH2O(1,I)*V+2.*
     3    RKMM(37,1,I)*FNCH4(1,I))*FNO1D(1,I)*V+RKK(11,1,I)*YIHP(1,I)*
     4    FNO(1,I)+2.*RKMM(20,1,I)*FNH2(1,I)*FNO(1,I)*U+2.*RKMM(19,1,I)*
     5    FNH2O2(1,I)*FNO(1,I)*W+2.*RKMM(42,1,I)*FNH2O(1,I)*FNO(1,I)*V+
     6    2.*RKMM(36,1,I)*FNCH4(1,I)*FNO(1,I)*V+RKK(9,1,I)*FNH2(1,I)*
     7    YIOP(1,I)+ALPP(4,1,I)*YIOHP(1,I)*FNE(1,I))/(2.*RKMM(23,1,I)*
     8    SS1(I)*RR(I)*SS2(I)*RR(I)+2.*RKMM(27,1,I)*SS1(I)*SS1(I)*RR(I)*
     9    RR(I)+2.*(RKMM(30,1,I)+RKMM(32,1,I))*SS1(I)*RR(I)*RR(I)+2.*
     1    RKMM(22,1,I)*RR(I)*RR(I)*SS2(I)*SS2(I)+2.*RKMM(33,1,I)*FM(I)*
     2    RR(I)*RR(I)))
    3 CONTINUE
      DO 4 I=3,LEN1-2
	T1(I)=0.
	T2(I)=1.
	T3(I)=-XHOX(I)/(FNO2(1,I)*RMASS(1)+FNO(1,I)*RMASS(2)+
     1    FNN2(1,I)*RMASS(3))
    4 CONTINUE
C     ****                                                                         COMPHOX.102      
C     ****     PERIODIC POINTS                                                     COMPHOX.103      
C     ****                                                                         COMPHOX.104      
      DO 5 I = 1,2
	T1(I) = T1(I+IMAX)
	T1(I+IMAXP2) = T1(I+2)
	T2(I) = T2(I+IMAX)
	T2(I+IMAXP2) = T2(I+2)
	T3(I) = T3(I+IMAX)
	T3(I+IMAXP2) = T3(I+2)
	T4(I) = T4(I+IMAX)
	T4(I+IMAXP2) = T4(I+2)
	  DO 5 K = 1,KMAXP1
	    S1(I,K) = S1(I+IMAX,K)
	    S1(I+IMAXP2,K) = S1(I+2,K)
	    S2(I,K) = S2(I+IMAX,K)
	    S2(I+IMAXP2,K) = S2(I+2,K)
    5 CONTINUE
      IBNDB=0
      ALFA=-0.38
      CALL MINOR(NPHOX,NHOXNM,RMHOX,PHIHOX,ALFA,IBND,IBNDB,PHOXB)
      RETURN
      END
*DK COMPNO                                                                         COMPNO.1         
      SUBROUTINE COMPNO
      SAVE
C     ****                                                                         COMPNO.4         
C     ****     ADVANCE NO COMPOSITION BY ONE TIME STEP                             COMPNO.5         
C     ****                                                                         COMPNO.6         
C     ****     COMMON DECKS:                                                       COMPNO.7         
C     ****       PARAMS, ASAS, CONS, FIELDS, FIELDT, FLUX, INDEX, PHOTO,           COMPNO.8         
C     ****          PSIB, RATEBLK, VSCR                                            COMPNO.9         
C     ****                                                                         COMPNO.10        
      include 'params.h'
      include 'asas2.h'
      include 'cons2.h'
      include 'fields2.h'
      include 'fieldt2.h'
      include 'flux2.h'
      include 'index.h'
      include 'noznoz2.h'
      include 'photo2.h'
      include 'psib2.h'
      include 'rateblk2.h'
      include 'vscr.h'
      DIMENSION PHINO(3)
      DATA RMNO,PHINO/30.,0.814,0.866,0.926/
C     ****                                                                         COMPNO.25        
C     ****     UPPER BOUNDARY: DIFFUSIVE EQUILIBRIUM                               COMPNO.26        
C     ****                                                                         COMPNO.27        
      DO 1 I=1,LEN1
	T4(I)=0.
    1 CONTINUE
C     ****                                                                         COMPNO.31        
C     ****     SOURCES                                                             COMPNO.32        
C     ****                                                                         COMPNO.33        
      DO 2 K=1,KMAXP1
	DO 2 I=3,LEN1-2
	  S1(I,K)=-(FK5O2P(K,I)+RBB(3,K,I)*FNN4S(K,I)+RBB(6,K,I)*
     1      FNN2D(K,I)+RBB(8,K,I)+RBB(9,K,I))*RNONOZ(K,I)
	  S2(I,K)=RBB(1,K,I)*FNO2(K,I)*FNN4S(K,I)+RBB(2,K,I)*FNO2(K,I)*
     1      FNN2D(K,I)+RBB(10,K,I)*FNOH(K,I)*FNN4S(K,I)
    2 CONTINUE
C     ****    IF IBNDNO = 0, FLUX GIVEN AT LOWER BOUNDARY                          COMPNO.41        
      IF(IBNDNO.EQ.0)THEN
	DO 3 I=3,LEN1-2
          T1(I)=0.
          T2(I)=0.
	  T3(I)=FLUXNO(I)
    3   CONTINUE
	IBNDB=1
C       ****    IF IBNDNO = 1, PHOTOCHEMICAL EQUILIBRIUM AT LOWER                  COMPNO.49        
C       ****      BOUNDARY                                                         COMPNO.50        
      ELSE IF(IBNDNO.EQ.1)THEN
	DO 4 I=3,LEN1-2
          T4(I)=0.
          T1(I)=0.
          T2(I)=1.
	  T3(I)=-XNO(I)*RMNO/(FNO2(1,I)*RMASS(1)+FNO(1,I)*RMASS(2)+
     1    FNN2(1,I)*RMASS(3))
    4   CONTINUE
	IBNDB=0
      ENDIF
      DO 5 I = 1,2
	T1(I) = T1(I+IMAX)
	T1(I+IMAXP2) = T1(I+2)
	T2(I) = T2(I+IMAX)
	T2(I+IMAXP2) = T2(I+2)
	T3(I) = T3(I+IMAX)
	T3(I+IMAXP2) = T3(I+2)
	T4(I) = T4(I+IMAX)
	T4(I+IMAXP2) = T4(I+2)
	DO 5 K = 1,KMAXP1
	  S1(I,K) = S1(I+IMAX,K)
	  S1(I+IMAXP2,K) = S1(I+2,K)
	  S2(I,K) = S2(I+IMAX,K)
	  S2(I+IMAXP2,K) = S2(I+2,K)
    5 CONTINUE
      IBND=0
      ALFA=0.
      CALL MINOR(NPNO,NPNONM,RMNO,PHINO,ALFA,IBND,IBNDB,PNOB)
      RETURN
      END
