#include "dims.h"
      SUBROUTINE NEWTON
      use cons_module,only: expz,t0,rmassinv,len1,kmax,avo,gask,
     |  boltz,p0,expzmid_inv,avto
      implicit none
C     ****
C     ****     E.C.RIDLEY     11/24/86
C     ****     CALCULATE IMPLICIT & EXPLICIT COOLING TERMS IN NWTI &
C     ****     NWTE. S9, S10, S11 AND S12 ARE USED AS WORK SPACE.
C     ****
#include "params.h"
#include "fcom.h"
#include "vscr.h"
#include "index.h"
#include "buff.h"
#include "mwt.h"
#include "phys.h"
!     real :: ttbound,nob,avto,hor
!     COMMON/RUNTIM/TTBOUND,NOB(ZJMX),AVTO,HOR(ZJMX)
      DATA RMCO2/44./
      DATA XCO2U/350.E-6/
!
! Local:
      real :: rmco2,xco2u
      integer :: nmsk,i,k,ncpk,ntk,nps1k,nps2k,nwtik,nwtek,
     |  npnok
!
C     ****
C     ****     S10 = INTEGRAL(M(C02)*DZ/MBAR)
C     ****
      NMSK=NJ+NMS
C     ****     LOWEST LEVEL
      DO 1 I=1,LEN1
      S10(I,1)=.25*RMCO2*(1./F(I,NMSK)+1./F(I,NMSK+1))*dz
    1 CONTINUE
C     ****     LEVELS 2 THRU KMAX
      DO 2 K=2,KMAX
      NMSK=NMSK+1
      DO 2 I=1,LEN1
      S10(I,K)=S10(I,K-1)+RMCO2/F(I,NMSK)*dz
    2 CONTINUE

!     call addfsech('XMCO2',' ',' ',s10,zimxp,zkmxp,zkmxp,j)

      NCPK=NCP-1
      NTK=NJ+NT-1
      NPS1K=NJ+NPS-1
      NPS2K=NJ+NPS2-1
      NMSK=NJ+NMS-1
      NWTIK=NWTI-1
      NWTEK=NWTE-1
      NPNOK=NJ+NPNO-1
      DO 3 K=1,KMAX
      NCPK=NCPK+1
      NTK=NTK+1
      NPS1K=NPS1K+1
      NPS2K=NPS2K+1
      NMSK=NMSK+1
      NWTIK=NWTIK+1
      NWTEK=NWTEK+1
      NPNOK=NPNOK+1
      DO 3 I=1,LEN1
C     ****
C     ****     S10 = N(CO2)
C     ****
      S10(I,K)=XCO2U*p0*expz(1)*expzmid_inv/(boltz*(F(I,NTK)+
     1.5*(T0(K)+T0(K+1))))*EXP(-S10(I,K))
C     ****
C     ****     S11 = A(CO2)
C     ****     S12 = B(CO2)
C     ****
      if (F(I,NTK)+.5*(T0(K)+T0(K+1))-200.>=0.) then
        S11(I,K)=2.5E-15*(1.+0.03*(F(I,NTK)+.5*(T0(K)+T0(K+1))-200.))
      else
        S11(I,K)=2.5E-15
      endif
      if (F(I,NTK)+.5*(T0(K)+T0(K+1))-300.>=0.) then
        S12(I,K)=AVTO*((F(I,NTK)+.5*(T0(K)+T0(K+1)))/300.)
      else
        S12(I,K)=AVTO
      endif
C     ****
C     ****     S12 = CO2 CONTRIBUTION TO COOLING.
C     ****
      S12(I,K)=2.65E-13*S10(I,K)*EXP(-960./F(I,NTK))*
     |  avo*((F(I,NPS1K)*rmassinv(1)+(1.-F(I,NPS1K)-
     |  F(I,NPS2K))*rmassinv(3))*S11(I,K)+F(I,NPS2K)*rmassinv(2)*
     |  S12(I,K))
C     ****
C     ****     S10 = N(NO)/RHO
C     ****
      S10(I,K)=avo*F(I,NPNOK)/RMNO
C     ****
C     ****     S11 = A(NO)
C     ****
      S11(I,K)=.5*(F(I,NMSK)+F(I,NMSK+1))*avo*p0*expz(K)/(gask*
     |  (F(I,NTK)+.5*(T0(K)+T0(K+1))))*(6.5E-11*F(I,NPS2K)*rmassinv(2)+
     |  2.4E-14*F(I,NPS1K)*rmassinv(1))
C     ****
C     ****     FORM NO COOLING CONTRIBUTION IN S11
C     ****
      S11(I,K)=4.956E-12*S10(I,K)*(S11(I,K)/(S11(I,K)+13.3))*
     |  EXP(-2700./F(I,NTK))
C     ****
C     ****     FORM TOTAL COOLING TERMS IN S9, S10
C     ****
      F(I,NWTIK)=(2700.*S11(I,K)+960.*S12(I,K))/(.5*(F(I,NCPK)+
     |  F(I,NCPK+1))*F(I,NTK)**2)
      F(I,NWTEK)=((1.-2700./F(I,NTK))*S11(I,K)+(1.-960./F(I,NTK))*
     |  S12(I,K))*expz(K)
    3 CONTINUE

!     call addfsech('CO2_COOL',' ',' ',s12,zimxp,zkmxp,zkmxp,j)
!     call addfsech('NO_COOL' ,' ',' ',s11,zimxp,zkmxp,zkmxp,j)
!     call addfsech('COOL_IMP' ,' ',' ',f(1,nwti),zimxp,zkmxp,zkmxp,j)
!     call addfsech('COOL_EXP' ,' ',' ',f(1,nwte),zimxp,zkmxp,zkmxp,j)

      RETURN
      END
C