      SUBROUTINE CMPNO
C     ****
C     ****     ADVANCES PSI(NO) BY ONE TIME STEP
C     ****
      include "params.h"
      include "blnk.h"
      include "vscr.h"
      include "cons.h"
      include "index.h"
      include "buff.h"
      include "crates.h"
      include "phys.h"
      COMMON/RUNTIM/NERD,NOB(ZJMX),NERD2(ZJMX+1)
      REAL NOB,NNOB
      COMMON/MASS/ RMN4S,RMN2D,RMNO,BRN2D,CEE
      DIMENSION PHINO(3)
      DATA PHINO/0.814,0.866,0.926/
C     ****
C     ****     BOUNDARIES
C     ****
C     ****     DIFFUSIVE EQUILIBRIUM AT UPPER BOUNDARY
      DO 1 I=1,LEN1
      T4(I)=0.
    1 CONTINUE
      IBND=0
C     ****     LOWER BOUNDARY: N(NO) = NOB(J)
      NNOB=NOB(J)
      IBNDB=0
      NMSK=NJ+NMS
      NTK=NJ+NT+KMAX
      DO 4 I=1,LEN1
      T1(I)=0.
      T2(I)=1.
      T3(I)=-NNOB*RMNO*C(84)*F(I,NTK)/(C(81)*C(87)*EXPS(1)*F(I,NMSK))
    4 CONTINUE
C     ****     SOURCES
      NPNOK=NJ+NPNO
      NPN4SK=NJ+NPN4S
      NPN2DK=NPN2D+NJNP
      NTK=NJ+NT
      NPS1K=NJ+NPS
      NPS2K=NPS1K+KMAXP1
      NMSK=NJ+NMS
      NNO2K=NNO2
      NEK=NJ+NE
      NO2PK=NJ+NO2P
      DO 2 K=1,KMAX
      DO 2 I=1,LEN1
C     ****     S3 = EXPS
      S3(I,K)=EXPS(K)
    2 CONTINUE
      DO 3 I=1,LEN2
C     ****     S3 = N*MBAR   (K+1/2)
      S3(I)=C(81)*S3(I)/(C(84)*F(I,NTK)*(F(I,NPS1K)/RMASS(1)+
     1F(I,NPS2K)/RMASS(2)+(1.-F(I,NPS2K)-F(I,NPS1K))/RMASS(3)))
C  Changed 12/97 because of alert by Alan Burns and Wenbin Wang
C    1F(I,NPS2K)/RMASS(2)+(1.-F(I,NPS1K)-F(I,NPS1K))/RMASS(3)))
C     ****     S2 = NUMBER DENSITY PRODUCTION
      S2(I)=S3(I)**2*F(I,NPS1K)/RMASS(1)*(BETA1(I,1)*F(I,NPN4SK)/RMN4S
     1+BETA2(I,1)*F(I,NPN2DK)/RMN2D)
      S2(I)=S2(I)+S3(I)**3*BETA17(I,1)*F(I,NPS2K)/RMASS(2)*(1.
     1-F(I,NPS2K)-F(I,NPS1K))/RMASS(3)*F(I,NPN4SK)/RMN4S


C     ****     S1 = (NUMBER DENSITY LOSS)/N(NO)
      S1(I)=-S3(I)*(BETA3(I,1)*F(I,NPN4SK)/RMN4S+BETA6(I,1)*F(I,NPN2DK)
     1/RMN2D)-.5*(BETA8(I,1)+BETA8(I+LEN1,1)+BETA9(I,1)+BETA9(I+LEN1,1))
     2-RK5(I,1)*F(I,NO2PK)
     3      -.5*(BETA9N(I,1)+BETA9N(I+LEN1,1))
    3 CONTINUE
      ALFA=0.
      CALL MINOR(NPNO,NPNONM,RMNO,PHINO,ALFA,IBND,IBNDB)
      RETURN
      END
C

