CDIR$ NOLIST                                                                       COMP.352         
*DK FACE                                                                           FACE.1           
CDIR$ NOLIST                                                                       FACE.2           
      SUBROUTINE FACE2(STEP,DS,SB,DX)
      SAVE
C     ****                                                                         FACE.5           
C     ****     INTERFACE                                                           FACE.6           
C     ****                                                                         FACE.7           
C     ****     COMMON DECKS:                                                       FACE.8           
C     ****       PARAMS, ASAS, CONS, CRATES, FIELDS, FIELDT, FLUX,                 FACE.9           
C     ****         HOXSTUF, INDEX, INDEXDAT, NEWRAT, PSIB, SOURCE, VSCR3           FACE.10          
C     ****                                                                         FACE.11          
      include 'params.h'
      include 'asas2.h'
      include 'cons2.h'
      include 'crates2.h'
      include 'disshox2.h'
      include 'fields2.h'
      include 'fieldt2.h'
      include 'flux2.h'
      include 'hoxstuf2.h'
      include 'index.h'
      include 'indexdat.h'
      include 'newrat2.h'
      include 'noznoz2.h'
      include 'oxoxox2.h'
      include 'photo2.h'
      include 'photoo2.h'
      include 'psib2.h'
      include 'rateblk2.h'
      include 'rjh2o2o2.h'
      include 'source2.h'
      include 'vscr3.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 IFP(12)
      DIMENSION FM(IMXP),DH2OT(KMXP,IMXP)
      EQUIVALENCE (C(46),PS1B),(C(47),PS3B)
      DATA PS1B,PS3B/.22,.78/
      DATA ISTAR/0/,PI/3.141592654/
      IF(ISTAR.EQ.0)THEN
C       ****                                                                       FACE.42          
C       ****     SET INITIAL CONSTANTS                                             FACE.43          
C       ****     CONVERT NUMBER DENSITIES TO PSI'S                                 FACE.44          
C       ****                                                                       FACE.45          
	ISTAR=1
	KMAX=KMX
	KMAXP1=KMAX+1
	IMAX=IMX
	IMAXP2=IMAX+2
	IMAXP4=IMAX+4
	LEN1=IMXP
	LEN2=LEN1*KMAX
	LEN3=LEN1*KMAXP1
C       ****     SET DLAMDA                                                        FACE.55          
	DLAMDA=8.*ATAN(1.)/IMAX
	C(1)=DLAMDA
C       ****     FINITE DIFFERENCE OPERATOR CONSTANTS                              FACE.58          
	C(10)=2./(3.*DLAMDA)
	C(11)=1./(12.*DLAMDA)
C       ****     SHAPIRO SMOOTHER CONSTANT                                         FACE.61          
C       C(26)=3.0E-2                                                               FACE.62          
	C(26)=0.
C       ****     TIME SMOOTHING CONSTANT                                           FACE.64          
	ALPHA=.95
	C(30)=ALPHA
	C(31)=.5*(1.-ALPHA)
C       ****       B MATRIX                                                        FACE.68          
	C(40)=-1.
	C(41)=0.
	C(42)=0.
	C(43)=-1.
C       ****        ATOMIC OXYGEN RECOMBINATION RATE                               FACE.73          
	C(44)=3.8E-30
C       ****        FB VECTOR                                                      FACE.75          
	DO 12 I = 1,LEN1
	  FB(I,1)=2*C(46)
   12   CONTINUE
C       ****    EARTHS RADIUS                                                      FACE.79          
C       C(51)=6.3 122E8                                                            FACE.80          
	C(51)=IMX*DX/(2.*PI)
	C(52)=1./C(51)
	C(53)=C(51)*C(51)
C       ****    ACCELERATION DU TO GRAVITY                                         FACE.84          
	C(54)=870.
C       ****    GAS CONSTANT                                                       FACE.86          
	C(57)=8.314E7
C       ****         P0                                                            FACE.88          
	C(81)=5.E-4
C       ****        BOLTZMANN CONSTANT                                             FACE.90          
	C(84)=1.38E-16
C       ****     AVOGRADO'S NUMBER                                                 FACE.92          
	C(85)=6.023E23
	RMASS(1)=32.
	RMASS(2)=16.
	RMASS(3)=28.
	RMA=23.
	RMH=23.
	RMNO=30.
	RMN4S=14.
	RMCH4=16.
	RMH2=2.
	RMCO2=44.
	RMCO=28.
	RMH2O=18.
	RMHOX=1.
C       ****     T0                                                                FACE.107         
	DO 2 K=1,KMAXP1
	  T0(K)=0.
    2   CONTINUE
C       ****                                                                       FACE.111         
C       ****     SET INITIAL PSI'S                                                 FACE.112         
C       ****                                                                       FACE.113         
C       ****     WK1=PSI1, WK2=PSI2, WK3=PSAR,  WK4=PSHE,                          FACE.114         
C       ****     WK5=PNO,  WK6=PN4S, WK7=PCH4,  WK8=PH2,                           FACE.115         
C       ****     WK9=PCO2, WK10=PCO, WK11=PHOX, WK12=PH2O                          FACE.116         
C       ****                                                                       FACE.117         
	DO 3 K=1,KMAXP1
	  DO 3 I=3,LEN1-1
	    FNNOZ(K,I)=FNNO(K,I)+FNNO2(K,I)
	    WK1(K,I)=FNO2(K,I)*RMASS(1)+FNO(K,I)*RMASS(2)+FNN2(K,I)*
     1        RMASS(3)
	    WK2(K,I)=FNOX(K,I)*RMASS(2)/WK1(K,I)
	    WK3(K,I)=FNAR(K,I)*RMA/WK1(K,I)
	    WK4(K,I)=FNHE(K,I)*RMH/WK1(K,I)
	    WK5(K,I)=FNNOZ(K,I)*RMNO/WK1(K,I)
	    WK6(K,I)=FNN4S(K,I)*RMN4S/WK1(K,I)
	    WK7(K,I)=FNCH4(K,I)*RMCH4/WK1(K,I)
	    WK8(K,I)=FNH2(K,I)*RMH2/WK1(K,I)
	    WK9(K,I)=FNCO2(K,I)*RMCO2/WK1(K,I)
	    WK10(K,I)=FNCO(K,I)*RMCO/WK1(K,I)
	    WK11(K,I)=FNHOX(K,I)*RMHOX/WK1(K,I)
	    WK12(K,I)=FNH2O(K,I)*RMH2O/WK1(K,I)
	    WK1(K,I)=FNO2(K,I)*RMASS(1)/WK1(K,I)
    3   CONTINUE
C       ****                                                                       FACE.136         
C       ****    TRANSFER PSI'S TO F-ARRAY                                          FACE.137         
C       ****                                                                       FACE.138         
	NPS1K=NJ+NPS-1
	NPS2K=NPS1K+KMAXP1
	NPSAK=NJ+NPSA-1
	NPSHK=NJ+NPSH-1
	NPNOK=NJ+NPNO-1
	NPN4SK=NJ+NPN4S-1
	NPCH4K=NJ+NPCH4-1
	NPH2K=NJ+NPH2-1
	NPCO2K=NJ+NPCO2-1
	NPCOK=NJ+NPCO-1
	NPHOXK=NJ+NPHOX-1
	NPH2OK=NJ+NPH2O-1
	DO 4 K=1,KMAX
	  DO 4 I=3,LEN1-1
	    F(I,NPS1K+K)=.5*(WK1(K,I)+WK1(K+1,I))
	    F(I,NPS2K+K)=.5*(WK2(K,I)+WK2(K+1,I))
	    F(I,NPSAK+K)=.5*(WK3(K,I)+WK3(K+1,I))
	    F(I,NPSHK+K)=.5*(WK4(K,I)+WK4(K+1,I))
	    F(I,NPNOK+K)=.5*(WK5(K,I)+WK5(K+1,I))
	    F(I,NPN4SK+K)=.5*(WK6(K,I)+WK6(K+1,I))
	    F(I,NPCH4K+K)=.5*(WK7(K,I)+WK7(K+1,I))
	    F(I,NPH2K+K)=.5*(WK8(K,I)+WK8(K+1,I))
	    F(I,NPCO2K+K)=.5*(WK9(K,I)+WK9(K+1,I))
	    F(I,NPCOK+K)=.5*(WK10(K,I)+WK10(K+1,I))
	    F(I,NPHOXK+K)=.5*(WK11(K,I)+WK11(K+1,I))
	    F(I,NPH2OK+K)=.5*(WK12(K,I)+WK12(K+1,I))
    4   CONTINUE
C       ****     BOUNDARY                                                          FACE.166         
	DO 9 I = 3,LEN1-1
	  F(I,NPS1K+KMAXP1)=1.5*WK1(KMAXP1,I)-.5*WK1(KMAX,I)
	  F(I,NPS2K+KMAXP1)=1.5*WK2(KMAXP1,I)-.5*WK2(KMAX,I)
	  F(I,NPSAK+KMAXP1)=1.5*WK3(KMAXP1,I)-.5*WK3(KMAX,I)
	  F(I,NPSHK+KMAXP1)=1.5*WK4(KMAXP1,I)-.5*WK4(KMAX,I)
	  F(I,NPNOK+KMAXP1)=1.5*WK5(KMAXP1,I)-.5*WK5(KMAX,I)
	  F(I,NPN4SK+KMAXP1)=1.5*WK6(KMAXP1,I)-.5*WK6(KMAX,I)
	  F(I,NPCH4K+KMAXP1)=1.5*WK7(KMAXP1,I)-.5*WK7(KMAX,I)
	  F(I,NPH2K+KMAXP1)=1.5*WK8(KMAXP1,I)-.5*WK8(KMAX,I)
	  F(I,NPCO2K+KMAXP1)=1.5*WK9(KMAXP1,I)-.5*WK9(KMAX,I)
	  F(I,NPCOK+KMAXP1)=1.5*WK10(KMAXP1,I)-.5*WK10(KMAX,I)
	  F(I,NPHOXK+KMAXP1)=1.5*WK11(KMAXP1,I)-.5*WK11(KMAX,I)
	  F(I,NPH2OK+KMAXP1)=1.5*WK12(KMAXP1,I)-.5*WK12(KMAX,I)
	  F(I,NPS1K+KMAXP1)=1.5*WK1(KMAXP1,I)-.5*WK1(KMAX,I)
	  F(I,NPS2K+KMAXP1)=1.5*WK2(KMAXP1,I)-.5*WK2(KMAX,I)
	  F(I,NPSAK+KMAXP1)=1.5*WK3(KMAXP1,I)-.5*WK3(KMAX,I)
	  F(I,NPSHK+KMAXP1)=1.5*WK4(KMAXP1,I)-.5*WK4(KMAX,I)
	  F(I,NPNOK+KMAXP1)=1.5*WK5(KMAXP1,I)-.5*WK5(KMAX,I)
	  F(I,NPN4SK+KMAXP1)=1.5*WK6(KMAXP1,I)-.5*WK6(KMAX,I)
	  F(I,NPCH4K+KMAXP1)=1.5*WK7(KMAXP1,I)-.5*WK7(KMAX,I)
	  F(I,NPH2K+KMAXP1)=1.5*WK8(KMAXP1,I)-.5*WK8(KMAX,I)
	  F(I,NPCO2K+KMAXP1)=1.5*WK9(KMAXP1,I)-.5*WK9(KMAX,I)
	  F(I,NPCOK+KMAXP1)=1.5*WK10(KMAXP1,I)-.5*WK10(KMAX,I)
	  F(I,NPHOXK+KMAXP1)=1.5*WK11(KMAXP1,I)-.5*WK11(KMAX,I)
	  F(I,NPH2OK+KMAXP1)=1.5*WK12(KMAXP1,I)-.5*WK12(KMAX,I)
    9   CONTINUE
C       ****                                                                       FACE.193         
C       ****     PERIODIC POINTS                                                   FACE.194         
C       ****                                                                       FACE.195         
	NPSK = NJ+NPS-1
	DO 16 I=1,2
	  DO 16 K=1,12*KMAXP1
	    F(I,NPSK+K) = F(I+IMAX,NPSK+K)
	    F(I+IMAXP2,NPSK+K) = F(I+2,NPSK+K)
   16   CONTINUE
	IFP(1) = NPS
	IFP(2) = NPS2
	IFP(3) = NPSA
	IFP(4) = NPSH
	IFP(5) = NPNO
	IFP(6) = NPN4S
	IFP(7) = NPCH4
	IFP(8) = NPH2
	IFP(9) = NPCO2
	IFP(10) = NPCO
	IFP(11) = NPHOX
	IFP(12) = NPH2O
C       CALL PLOT(IFP,12,NJ)                                                       FACE.214         
C       ****                                                                       FACE.215         
C       ****     COPY CURRENT FIELDS TO NM ARRAYS                                  FACE.216         
C       ****                                                                       FACE.217         
	NPSK = NJ+NPS-1
	NPSNMK = NJ+NPSNM-1
	DO 14 K = 1,12*KMAXP1
	DO 14 I = 1,LEN1
	  F(I,NPSNMK+K) = F(I,NPSK+K)
   14   CONTINUE
	IFP(1) = NPSNM
	IFP(2) = NPS2NM
	IFP(3) = NPSANM
	IFP(4) = NPSHNM
	IFP(5) = NPNONM
	IFP(6) = NN4SNM
	IFP(7) = NCH4NM
	IFP(8) = NPH2NM
	IFP(9) = NCO2NM
	IFP(10) = NPCONM
	IFP(11) = NHOXNM
	IFP(12) = NH2ONM
C       CALL PLOT(IFP,12,NJ)                                                       FACE.236         
      ENDIF
      C(3)=DS
      C(7)=1./STEP
C     ****     EXP(-.5*DS)                                                         FACE.240         
      C(86)=EXP(-.5*DS)
C     ****     EXP(.5*DS)                                                          FACE.242         
      C(87)=1./C(86)
C     ****     EXPS, DIFK                                                          FACE.244         
      S=SB+.5*DS
      EXPS(1)=EXP(-S)
      EXPDS=EXP(-DS)
      DO 1 K=2,KMAXP1
	EXPS(K)=EXPS(K-1)*EXPDS
    1 CONTINUE
      DO 15 K = 1,KMAXP1
	DO 15 I = 3,LEN1-2
	  DIFK(I,K) = FDIFK(K,I)
   15 CONTINUE
C     ****                                                                         FACE.255         
C     ****     PERIODIC POINTS FOR T, U, W, RJ, PS2B, DIFK                         FACE.256         
C     ****                                                                         FACE.257         
      DO 17 I = 1,2
	PS2B(I) = PS2B(I+IMAX)
	PS2B(I+IMAXP2) = PS2B(I+2)
	DO 17 K = 1,KMAXP1
	  DIFK(I,K) = DIFK(I+IMAX,K)
	  DIFK(I+IMAXP2,K) = DIFK(I+2,K)
	  FT(K,I) = FT(K,I+IMAX)
	  FT(K,I+IMAXP2) = FT(K,I+2)
	  FUI(K,I) = FUI(K,I+IMAX)
	  FU(K,I) = FU(K,I+IMAX)
	  FUI(K,I+IMAXP2) = FUI(K,I+2)
	  FU(K,I+IMAXP2) = FU(K,I+2)
	  FW(K,I) = FW(K,I+IMAX)
	  FWI(K,I) = FWI(K,I+IMAX)
	  FW(K,I+IMAXP2) = FW(K,I+2)
	  FWI(K,I+IMAXP2) = FWI(K,I+2)
	  FRJ(K,I) = FRJ(K,I+IMAX)
	  FRJ(K,I+IMAXP2) = FRJ(K,I+2)
   17 CONTINUE
C     ****                                                                         FACE.277         
C     ****     PERIODIC POINTS FOR SOURCE TERMS                                    FACE.278         
C     ****                                                                         FACE.279         
C     CALL CHKBLKS                                                                 FACE.280         
      DO 18 I = 1,2
	DO 18 K =1,KMAXP1
	  FS11(K,I) = FS11(K,I+IMAX)
	  FS11(K,I+IMAXP2) = FS11(K,I+2)
	  FS12(K,I) = FS12(K,I+IMAX)
	  FS12(K,I+IMAXP2) = FS12(K,I+2)
	  FS21(K,I) = FS21(K,I+IMAX)
	  FS21(K,I+IMAXP2) = FS21(K,I+2)
	  FS22(K,I) = FS22(K,I+IMAX)
	  FS22(K,I+IMAXP2) = FS22(K,I+2)
	  FS1(K,I) = FS1(K,I+IMAX)
	  FS1(K,I+IMAXP2) = FS1(K,I+2)
	  FS2(K,I) = FS2(K,I+IMAX)
	  FS2(K,I+IMAXP2) = FS2(K,I+2)
   18 CONTINUE
C     CALL CHKBLKS                                                                 FACE.296         
C     ****                                                                         FACE.297         
C     ****     PERIODIC POINTS RATE COEFFICIENTS                                   FACE.298         
C     ****                                                                         FACE.299         
      DO 19 I = 1,2
	DO 20 N = 1,25
	  DO 20 K = 1,KMAXP1
	    RKK(N,K,I) = RKK(N,K,I+IMAX)
	    RKK(N,K,I+IMAXP2) = RKK(N,K,I+2)
   20   CONTINUE
	DO 21 N = 1,10
	  DO 21 K = 1,KMAXP1
	    ALPP(N,K,I) = ALPP(N,K,I+IMAX)
	    ALPP(N,K,I+IMAXP2) = ALPP(N,K,I+2)
   21   CONTINUE
	DO 22 N = 1,20
	  DO 22 K = 1,KMAXP1
	    RBB(N,K,I) = RBB(N,K,I+IMAX)
	    RBB(N,K,I+IMAXP2) = RBB(N,K,I+2)
   22   CONTINUE
	DO 23 N = 1,50
	  DO 23 K = 1,KMAXP1
	    RKMM(N,K,I) = RKMM(N,K,I+IMAX)
	    RKMM(N,K,I+IMAXP2) = RKMM(N,K,I+2)
   23   CONTINUE
	DO 24 K = 1,KMAXP1
	  RK12(K,I) = RK12(K,I+IMAX)
	  RK12(K,I+IMAXP2) = RK12(K,I+2)
	  RK13(K,I) = RK13(K,I+IMAX)
	  RK13(K,I+IMAXP2) = RK13(K,I+2)
	  RK14(K,I) = RK14(K,I+IMAX)
	  RK14(K,I+IMAXP2) = RK14(K,I+2)
	  RK15(K,I) = RK15(K,I+IMAX)
	  RK15(K,I+IMAXP2) = RK15(K,I+2)
   24   CONTINUE
   19 CONTINUE
C     ****                                                                         FACE.332         
C     ****     NTRANSFER T AND U                                                   FACE.333         
C     ****     N                                                                   FACE.334         
      NTK=NJ+NT-1
      NUK=NJ+NU-1
      DO 5 K=1,KMAX
	DO 5 I=1,LEN1
	  F(I,NTK+K)=.5*(FT(K,I)+FT(K+1,I))
	  F(I,NUK+K)=.5*(FU(K,I)+FU(K+1,I))
    5 CONTINUE
C     ****     BOUNDARY                                                            FACE.342         
      DO 10 I = 1,LEN1
	F(I,NTK+KMAXP1)=FT(1,I)
	F(I,NUK+KMAXP1)=FU(1,I)
   10 CONTINUE
C     ****                                                                         FACE.347         
C     ****     TRANSFER W AND RJ                                                   FACE.348         
C     ****                                                                         FACE.349         
      NWK=NJ+NW-1
      NRJK=NDJ+NRJ-1
      DO 6 K=1,KMAXP1
	DO 6 I=1,LEN1
	  F(I,NWK+K)=FW(K,I)
	  F(I,NRJK+K)=FRJ(K,I)
    6 CONTINUE
C     ****                                                                         FACE.357         
C     ****     UPDATE PSI'S                                                        FACE.358         
C     ****                                                                         FACE.359         
C     CALL CHKBLKS                                                                 FACE.360         
      CALL RATES(FT)
C     CALL CHKBLKS                                                                 FACE.362         
C     ****                                                                         FACE.363         
C     ****     LOWER BOUNDARY CONDITION                                            FACE.364         
C     ****                                                                         FACE.365         
      DO 11 I = 1,LEN1
C       ENMBAR(I)=C(81)*EXPS(1)*C(87)/((PS1B/RMASS(1)+PS3B/RMASS(3))*              FACE.367         
C    1    C(84)*FT(1,I))                                                           FACE.368         
C       AA(I)=ENMBAR(I)**3*(2.*RK12(1,I)*(PS1B/RMASS(1)+PS3B/RMASS(3))+            FACE.369         
C    1    RK13(1,I)*PS1B/RMASS(1)-RK15(1,I)*RMASS(2)*PS1B/(RMASS(3)*               FACE.370         
C    2    RMASS(1)))                                                               FACE.371         
C       BB(I)=ENMBAR(I)*(ENMBAR(I)**2*(RK14(1,I)*(PS1B/RMASS(1))**2+               FACE.372         
C    1    RK15(1,I)*(PS1B/RMASS(1))*(1.-PS1B)/RMASS(3))-FS22(1,I))                 FACE.373         
C       CC(I)=-FS21(1,I)*ENMBAR(I)*PS1B/RMASS(1)-FS2(1,I)                          FACE.374         
C       PS2B(I)=RMASS(2)*(-BB(I)+SQRT(BB(I)**2-4.*AA(I)*CC(I)))/(2.*               FACE.375         
C    1    AA(I))                                                                   FACE.376         
	FB(I,2)=PS2B(I)
   11 CONTINUE
C     II=1                                                                         FACE.379         
C     WRITE(6,101)II                                                               FACE.380         
C 101 FORMAT(* HI*I1)                                                              FACE.381         
C     CALL CHKBLKS                                                                 FACE.382         
      CALL COMP
C     CALL CHKBLKS                                                                 FACE.384         
      CALL PHOTO
C     CALL CHKBLKS                                                                 FACE.386         
      CALL CMPN2D
C     CALL CHKBLKS                                                                 FACE.388         
      CALL CMPN4S
C     CALL CHKBLKS                                                                 FACE.390         
      CALL COMPNO
C     CALL CHKBLKS                                                                 FACE.392         
      CALL COMPARG
C     CALL CHKBLKS                                                                 FACE.394         
C     CALL COMPHE                                                                  FACE.395         
C     CALL CHKBLKS                                                                 FACE.396         
      CALL COMPCH4
C     CALL CHKBLKS                                                                 FACE.398         
      CALL COMPH2
C     CALL CHKBLKS                                                                 FACE.400         
      CALL COMPCO2
C     CALL CHKBLKS                                                                 FACE.402         
      CALL COMPCO
C     CALL CHKBLKS                                                                 FACE.404         
      CALL COMPHOX
C     CALL CHKBLKS                                                                 FACE.406         
      CALL COMPH2O
C     CALL CHKBLKS                                                                 FACE.408         
C     ****                                                                         FACE.409         
C     ****     NTRANSFER UI                                                        FACE.410         
C     ****     N                                                                   FACE.411         
      NUK=NJ+NU-1
      DO 55 K=1,KMAX
	DO 55 I=1,LEN1
	  F(I,NUK+K)=.5*(FUI(K,I)+FUI(K+1,I))
   55 CONTINUE
C     ****     BOUNDARY                                                            FACE.417         
      DO 67 I = 1,LEN1
	F(I,NUK+KMAXP1)=FUI(1,I)
   67 CONTINUE
C     ****                                                                         FACE.421         
C     ****     TRANSFER WI                                                         FACE.422         
C     ****                                                                         FACE.423         
      NWK=NJ+NW-1
      DO 66 K=1,KMAXP1
	DO 66 I=1,LEN1
	  F(I,NWK+K)=FWI(K,I)
   66 CONTINUE
      CALL COMPHE
	IFP(1) = NPS
	IFP(2) = NPS2
	IFP(3) = NPSA
	IFP(4) = NPSH
	IFP(5) = NPNO
	IFP(6) = NPN4S
	IFP(7) = NPCH4
	IFP(8) = NPH2
	IFP(9) = NPCO2
	IFP(10) = NPCO
	IFP(11) = NPHOX
	IFP(12) = NPH2O
C       CALL PLOT(IFP,12,NJNP)                                                     FACE.442         
C     WRITE(6,1000)PNOB,PN4SB                                                      FACE.443         
C1000 FORMAT(* PNOB, PN4SB *,2E13.4)                                               FACE.444         
C     ****                                                                         FACE.445         
C     ****     CONVERT PSI'S TO NUMBER DENSITIES                                   FACE.446         
C     ****                                                                         FACE.447         
C     ****     WK1=INTERPOLATED PSI1,   WK2=INTERPOLATED PSI2                      FACE.448         
C     ****     WK3=INTERPOLATED PSAR,   WK4=INTERPOLATED PSHE                      FACE.449         
C     ****     WK5=INTERPOLATED PSNO,   WK6=INTERPOLATED PSN4S                     FACE.450         
C     ****     WK7=INTERPOLATED PSCH4,  WK8=INTERPOLATED PSH2                      FACE.451         
C     ****     WK9=INTERPOLATED PSCO2,  WK10=INTERPOLATED PSCO                     FACE.452         
C     ****     WK11=INTERPOLATED PSHOX, WK12=INTERPOLATED PSH2O                    FACE.453         
C     ****                                                                         FACE.454         
      NPS1K=NJNP+NPS-1
      NPS2K=NPS1K+KMAXP1
      NPSAK=NJNP+NPSA-1
      NPSHK=NJNP+NPSH-1
      NPNOK=NJNP+NPNO-1
      NPN4SK=NJNP+NPN4S-1
      NPCH4K=NJNP+NPCH4-1
      NPH2K=NJNP+NPH2-1
      NPCO2K=NJNP+NPCO2-1
      NPCOK=NJNP+NPCO-1
      NPHOXK=NJNP+NPHOX-1
      NPH2OK=NJNP+NPH2O-1
      DO 7 K=1,KMAX
	DO 7 I=1,LEN1
	  WK1(K+1,I)=.5*(F(I,NPS1K+K)+F(I,NPS1K+K+1))
	  WK2(K+1,I)=.5*(F(I,NPS2K+K)+F(I,NPS2K+K+1))
	  WK3(K+1,I)=.5*(F(I,NPSAK+K)+F(I,NPSAK+K+1))
	  WK4(K+1,I)=.5*(F(I,NPSHK+K)+F(I,NPSHK+K+1))
	  WK5(K+1,I)=.5*(F(I,NPNOK+K)+F(I,NPNOK+K+1))
	  WK6(K+1,I)=.5*(F(I,NPN4SK+K)+F(I,NPN4SK+K+1))
	  WK7(K+1,I)=.5*(F(I,NPCH4K+K)+F(I,NPCH4K+K+1))
	  WK8(K+1,I)=.5*(F(I,NPH2K+K)+F(I,NPH2K+K+1))
	  WK9(K+1,I)=.5*(F(I,NPCO2K+K)+F(I,NPCO2K+K+1))
	  WK10(K+1,I)=.5*(F(I,NPCOK+K)+F(I,NPCOK+K+1))
	  WK11(K+1,I)=.5*(F(I,NPHOXK+K)+F(I,NPHOXK+K+1))
	  WK12(K+1,I)=.5*(F(I,NPH2OK+K)+F(I,NPH2OK+K+1))
    7 CONTINUE
C     ****     LOWER BOUNDARY                                                      FACE.482         
      DO 13 I = 1,LEN1
	WK1(1,I)=PS1B
	WK2(1,I)=PS2B(I)
	WK3(1,I)=.5*(F(1,NPSAK+1)+PARB(I))
	WK4(1,I)=.5*(F(1,NPSHK+1)+PHB(I))
	WK5(1,I)=.5*(F(1,NPNOK+1)+PNOB(I))
	WK6(1,I)=.5*(F(1,NPN4SK+1)+PN4SB(I))
	WK7(1,I)=.5*(F(1,NPCH4K+1)+PCH4B(I))
	WK8(1,I)=.5*(F(1,NPH2K+1)+PH2B(I))
	WK9(1,I)=.5*(F(1,NPCO2K+1)+PCO2B(I))
	WK10(1,I)=.5*(F(1,NPCOK+1)+PCOB(I))
	WK11(1,I)=.5*(F(1,NPHOXK+1)+PHOXB(I))
	WK12(1,I)=.5*(F(1,NPH2OK+1)+PH2OB(I))
   13 CONTINUE
C     ****                                                                         FACE.497         
C     ****     CONVERT TO NUMBER DENSITIES                                         FACE.498         
C     ****                                                                         FACE.499         
C     ****     WK5=MBAR*P0*EXPS/(R*T)                                              FACE.500         
      DO 8 K=1,KMAXP1
	DO 8 I=3,LEN1-1
	  WK13(K,I)=C(81)*EXPS(K)*C(87)/(C(84)*FT(K,I)*(WK1(K,I)/
     1      RMASS(1)+WK2(K,I)/RMASS(2)+(1.-WK1(K,I)-WK2(K,I))/RMASS(3)))
	  FNO2(K,I)=WK1(K,I)*WK13(K,I)/RMASS(1)
	  FNOX(K,I)=WK2(K,I)*WK13(K,I)/RMASS(2)
	  FNO(K,I)=OOXR(K,I)*FNOX(K,I)
	  FNO3(K,I)=O3OR(K,I)*FNO(K,I)
	  FNN2(K,I)=(1.-WK1(K,I)-WK2(K,I))*WK13(K,I)/RMASS(3)
	  FM(I)=FNO(K,I)+FNO2(K,I)+FNN2(K,I)
	  FNAR(K,I)=WK3(K,I)*WK13(K,I)/RMA
C         FNAS(K,I)=FNAR(K,I)/(1.+RNAO(K,I)+RNAO2(K,I)+RNAOH(K,I))                 FACE.512         
C         FNAO(K,I)=FNAS(K,I)*RNAO(K,I)                                            FACE.513         
C         FNAO2(K,I)=FNAS(K,I)*RNAO2(K,I)                                          FACE.514         
C         FNAOH(K,I)=FNAS(K,I)*RNAOH(K,I)                                          FACE.515         
	  FNHE(K,I)=WK4(K,I)*WK13(K,I)/RMH
	  FNNOZ(K,I)=WK5(K,I)*WK13(K,I)/RMNO
	  FNNO(K,I)=RNONOZ(K,I)*FNNOZ(K,I)
	  FNNO2(K,I)=SNO2NO(K,I)*FNNO(K,I)
	  FNN4S(K,I)=WK6(K,I)*WK13(K,I)/RMN4S
	  FNCH4(K,I)=WK7(K,I)*WK13(K,I)/RMCH4
	  FNH2(K,I)=WK8(K,I)*WK13(K,I)/RMH2
	  FNCO2(K,I)=WK9(K,I)*WK13(K,I)/RMCO2
	  FNCO(K,I)=WK10(K,I)*WK13(K,I)/RMCO
	  FNHOX(K,I)=WK11(K,I)*WK13(K,I)/RMHOX
	  FNH2O(K,I)=WK12(K,I)*WK13(K,I)/RMH2O
	  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))
	  FNH(K,I)=HHOXR(K,I)*FNHOX(K,I)
	  FNHO2(K,I)=HO2HR(K,I)*FNH(K,I)
	  FNOH(K,I)=OHHR(K,I)*FNH(K,I)
	  DH2OT(K,I)=SH2OSRC(K,I)+SH2OSRB(K,I)+.88*SH2OLYA(K,I)+
     1      SH2OEUV(K,I)
C         FNH2O2(K,I)=RKMM(27,K,I)*FNHO2(K,I)*FNHO2(K,I)/(RJH2O2(K,I)              FACE.539         
C    1    +RKMM(19,K,I)*FNO(K,I)+RKMM(24,K,I)*FNOH(K,I))                           FACE.540         
	  FNH2O2(K,I)=1.E-20
    8 CONTINUE
C*****************************                                                     FACE.543         
C     CALL CONREC(FNO2(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)              FACE.544         
C     CALL FRAME                                                                   FACE.545         
C     CALL CONREC(FNOX(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)              FACE.546         
C     CALL FRAME                                                                   FACE.547         
C     CALL CONREC(FNO(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)               FACE.548         
C     CALL FRAME                                                                   FACE.549         
C     CALL CONREC(FNO3(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)              FACE.550         
C     CALL FRAME                                                                   FACE.551         
C     CALL CONREC(FNN2(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)              FACE.552         
C     CALL FRAME                                                                   FACE.553         
C     CALL CONREC(FNAR(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)              FACE.554         
C     CALL FRAME                                                                   FACE.555         
C     CALL CONREC(FNHE(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)              FACE.556         
C     CALL FRAME                                                                   FACE.557         
C     CALL CONREC(FNNOZ(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)             FACE.558         
C     CALL FRAME                                                                   FACE.559         
C     CALL CONREC(FNNO(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)              FACE.560         
C     CALL FRAME                                                                   FACE.561         
C     CALL CONREC(FNNO2(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)             FACE.562         
C     CALL FRAME                                                                   FACE.563         
C     CALL CONREC(FNN4S(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)             FACE.564         
C     CALL FRAME                                                                   FACE.565         
C     CALL CONREC(FNCH4(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)             FACE.566         
C     CALL FRAME                                                                   FACE.567         
C     CALL CONREC(FNH2(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)              FACE.568         
C     CALL FRAME                                                                   FACE.569         
C     CALL CONREC(FNCO2(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)             FACE.570         
C     CALL FRAME                                                                   FACE.571         
C     CALL CONREC(FNCO(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)              FACE.572         
C     CALL FRAME                                                                   FACE.573         
C     CALL CONREC(FNHOX(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)             FACE.574         
C     CALL FRAME                                                                   FACE.575         
C     CALL CONREC(FNH2O(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)             FACE.576         
C     CALL FRAME                                                                   FACE.577         
C     CALL CONREC(HO2HR(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)             FACE.578         
C     CALL FRAME                                                                   FACE.579         
C     CALL CONREC(OHHR(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)              FACE.580         
C     CALL FRAME                                                                   FACE.581         
C     CALL CONREC(HHOXR(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)             FACE.582         
C     CALL FRAME                                                                   FACE.583         
C     CALL CONREC(FNH(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)               FACE.584         
C     CALL FRAME                                                                   FACE.585         
C     CALL CONREC(FNHO2(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)             FACE.586         
C     CALL FRAME                                                                   FACE.587         
C     CALL CONREC(FNOH(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)              FACE.588         
C     CALL FRAME                                                                   FACE.589         
C     CALL CONREC(DH2OT(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)             FACE.590         
C     CALL FRAME                                                                   FACE.591         
C     CALL CONREC(FNH2O2(1,3),KMAXP1,KMAXP1,IMAX+1,0.,0.,0.,0,0,-1430B)            FACE.592         
C     CALL FRAME                                                                   FACE.593         
C*****************************                                                     FACE.594         
C     ****                                                                         FACE.595         
C     ****     FLIP BUFFER INDICES                                                 FACE.596         
C     ****                                                                         FACE.597         
      ITEMP = NJ
      NJ = NJNP
      NJNP = ITEMP
      RETURN
      END
