SUBROUTINE XRAY
      implicit none
C     ****
C     ****     CALCULATES PRODUCTION OF IONS, N2N AND N4S BY SOLAR
C     ****     X-RAYS
C     ****
      include "params.h"
      include "blnk.h"
      include "vscr.h"
      include "cons.h"
      include "index.h"
      include "buff.h"
      include "crates.h"
!
! Local:
      real :: sf,epsx,ex
      integer :: ntk,nps1k,nps2k,i,nmsk,k,nno2k,nnok,nnn2k,nqo2pk,nqopk,
     |  nqn2pk,nqnpk
!
      DATA SF/1.0/,EPSX/5.0/
C     EX=0.4
C     EX=0.4+0.5*(C(61)-67.)/(176.*SF)
C     ****  SNOE X-RAYS
      EX=0.3+0.5*(C(61)-67.)/(176.*SF)
C     EX=0.6+0.5*(C(61)-67.)/(176.*SF)
C     ****
C     ****     S1=PSI1(K),  S2=PSI2(K),  S3=T(K)
C     ****
      NTK=NJ+NT
      NPS1K=NJ+NPS
      NPS2K=NJ+NPS2
      DO 1 I=1,LEN2-LEN1
      S1(I,2)=.5*(F(I,NPS1K)+F(I,NPS1K+1))
      S2(I,2)=.5*(F(I,NPS2K)+F(I,NPS2K+1))
      S3(I,2)=.5*(F(I,NTK)+F(I,NTK+1))
    1 CONTINUE
C     ****     BOUNDARIES
      DO 2 I=1,LEN1
      S1(I,1)=1.5*F(I,NPS1K)-0.5*F(I,NPS1K+1)
      S2(I,1)=1.5*F(I,NPS2K)-0.5*F(I,NPS2K+1)
      S3(I,1)=1.5*F(I,NTK)-0.5*F(I,NTK+1)
      S1(I,KMAXP1)=1.5*F(I,NPS1K+KMAXM1)-0.5*F(I,NPS1K+KMAX-2)
      S2(I,KMAXP1)=1.5*F(I,NPS2K+KMAXM1)-0.5*F(I,NPS2K+KMAX-2)
      S3(I,KMAXP1)=1.5*F(I,NTK+KMAXM1)-0.5*F(I,NTK+KMAX-2)
    2 CONTINUE
C     ****
C     ****     S4=N*MBAR
C     ****
      NMSK=NJ+NMS-1
      DO 3 K=1,KMAX
      NMSK=NMSK+1
      DO 3 I=1,LEN1
      S4(I,K)=C(81)*C(87)*EXPS(K)*F(I,NMSK)/(C(84)*S3(I,K))
    3 CONTINUE
C     ****      LEVEL KMAXP1
      NMSK=NMSK+1
      DO 4 I=1,LEN1
      S4(I,KMAXP1)=C(81)*C(86)*EXPS(KMAX)*F(I,NMSK)/(C(84)*S3(I,KMAXP1))
    4 CONTINUE
C     ****
C     ****     S1=N(O2),  S2=N(O),   S3=N(N2),  (K)
C     ****
      DO 5 I=1,LEN3
      S3(I,1)=(1.-S1(I,1)-S2(I,1))/RMASS(3)*S4(I,1)
      S1(I,1)=S1(I,1)/RMASS(1)*S4(I,1)
      S2(I,1)=S2(I,1)/RMASS(2)*S4(I,1)
    5 CONTINUE
C     ****
C     ****     S4=T=2.52E9*EX*EPSX*EXP(-TAU)
C     ****     S1=PX(O2),   S2=PX(O),   S3=PX(N2)     (K)
C     ****
      NNO2K=NNO2
      NNOK=NNO
      NNN2K=NNN2
      DO 6 I=1,LEN3
      S4(I,1)=2.52E9*EX*EPSX*EXP(-(4.4E-19*F(I,NNO2K)+2.0E-19*F(I,NNOK)+
     12.35E-19*F(I,NNN2K)))
      S1(I,1)=4.4E-19*S1(I,1)*S4(I,1)
      S2(I,1)=2.0E-19*S2(I,1)*S4(I,1)
      S3(I,1)=2.35E-19*S3(I,1)*S4(I,1)
    6 CONTINUE
C     ****
C     ****     ADD IONIZATION CONTRIBUTIONS TO NQO2P, NQOP, NQN2P, NQNP
C     ****
      NQO2PK=NQO2P
      NQOPK=NQOP
      NQN2PK=NQN2P
      NQNPK=NQNP
      DO 7 I=1,LEN3
      F(I,NQO2PK)=F(I,NQO2PK)+0.67*S1(I,1)
      F(I,NQOPK)=F(I,NQOPK)+S2(I,1)+0.33*S1(I,1)
      F(I,NQN2PK)=F(I,NQN2PK)+0.64*S3(I,1)
      DISN2P(I,1)=DISN2P(I,1)+0.64*S3(I,1)
      F(I,NQNPK)=F(I,NQNPK)+0.36*S3(I,1)
    7 CONTINUE
      RETURN
      END
C