#include "dims.h"
      SUBROUTINE CMPNO
      use cons_module,only: len1,len2,kmax,kmaxp1,rmassinv,expz,boltz,
     |  p0,expzmid_inv,nob
      use crates_module,only: rk5,beta6,beta2
      implicit none
C     ****
C     ****     ADVANCES PSI(NO) BY ONE TIME STEP
C     ****
#include "params.h"
#include "fcom.h"
#include "vscr.h"
#include "index.h"
#include "buff.h"
#include "crates_tdep.h"
#include "phys.h"
#include "mwt.h"
!
! Local:
      real :: nnob,PHINO(3),alfa
      integer :: i,k,ibndb,nmsk,ntk,npnok,npn4sk,npn2dk,nps1k,
     |  nps2k,nno2k,nek,no2pk,ibnd
!
      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*boltz*F(I,NTK)/(p0*expzmid_inv*expz(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 = expz
      S3(I,K)=expz(K)
    2 CONTINUE
      DO 3 I=1,LEN2
C     ****     S3 = N*MBAR   (K+1/2)
      S3(I,1)=p0*S3(I,1)/(boltz*F(I,NTK)*(F(I,NPS1K)*rmassinv(1)+
     1F(I,NPS2K)*rmassinv(2)+(1.-F(I,NPS2K)-F(I,NPS1K))*rmassinv(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,1)=S3(I,1)**2*F(I,NPS1K)*rmassinv(1)*(BETA1(I,1)*F(I,NPN4SK)/
     |  RMN4S
     1+BETA2*F(I,NPN2DK)/RMN2D)
      S2(I,1)=S2(I,1)+S3(I,1)**3*BETA17(I,1)*F(I,NPS2K)*rmassinv(2)*(1.
     1-F(I,NPS2K)-F(I,NPS1K))*rmassinv(3)*F(I,NPN4SK)/RMN4S


C     ****     S1 = (NUMBER DENSITY LOSS)/N(NO)
      S1(I,1)=-S3(I,1)*(BETA3(I,1)*F(I,NPN4SK)/RMN4S+BETA6*
     |  F(I,NPN2DK)
     1/RMN2D)-.5*(BETA8(I,1)+BETA8(I+LEN1,1)+BETA9(I,1)+BETA9(I+LEN1,1))
     2-RK5*F(I,NO2PK)
     3      -.5*(BETA9N(I,1)+BETA9N(I+LEN1,1))
    3 CONTINUE

!     call addfsech('XNMBAR'  ,' ',' ',s3,zimxp,zkmxp,zkmx,j)
!     call addfsech('NO_PROD' ,' ',' ',s2,zimxp,zkmxp,zkmx,j)
!     call addfsech('NO_LOSS' ,' ',' ',s1,zimxp,zkmxp,zkmx,j)

      ALFA=0.
      CALL MINOR(NPNO,NPNONM,RMNO,PHINO,ALFA,IBND,IBNDB,0)

!     call addfsech('NO_OUT',' ',' ',f(1,njnp+npno),zimxp,zkmxp,zkmx,j)
!     call addfsech('NO_TM1',' ',' ',f(1,njnp+npnonm),zimxp,zkmxp,
!    |  zkmx,j)

      RETURN
      END
C