#include "dims.h" SUBROUTINE HOXPION use cons_module,only: len1,len3,kmax,kmaxp1,p0,boltz,expz implicit none C **** C **** CALCULATES HOX PRODUCTION FROM D-REGION ION CHEMISTRY C **** #include "params.h" #include "fcom.h" #include "vscr.h" #include "index.h" #include "buff.h" #include "crates_const.h" #include "crates_tdep.h" #include "lowbnd.h" #include "phys.h" #include "mwt.h" ! ! Local: real :: rin14,rin15,rin16,rin22,rin23,rin24,rin25,rin41,rin44, | rin45,rin48,rin49,alph2 integer :: i,n,k,nqpk C **** C **** NUMBER DENSITY MIXING RATIO OF HOX AT LOWER BOUNDARY C **** RIN14=1.e-9 ; RIN15=1.e-9 ; RIN16=1.e-9 ; RIN22=1.e-9 RIN23=1.e-9 ; RIN24=1.e-9 ; RIN25=7.e-11 ; RIN41=1.5e-9 RIN44=1.e-9 ; RIN45=2.e-10 ; RIN48=3.e-10 ; RIN49=4.4e-10 ALPH2=3.e-6 C **** C **** DO 1 I=1,LEN3 S1(I,1) = 0. 1 CONTINUE C **** C **** SUMMATION OVER 5 ION SPECIES, PRODUCTION RATES C **** DO 2 N=1,5 NQPK=NQO2P+(N-1)*KMAXP1 DO 2 I=1,LEN3 S1(I,1) = S1(I,1)+F(I,NQPK) 2 CONTINUE DO 3 K=1,KMAX DO 3 I=1,LEN1 C **** C **** S3 = EXPS (K+1/2) C **** S3(I,K) = expz(K) C **** S2(I,K) = .5*(S1(I,K)+S1(I,K+1)) C PHOXIC(I,K) = 0. PHOXIC(I,K) = 1.E-60 3 CONTINUE C **** C NTK = NJ+NT C NPS1K = NJ+NPS C NPS2K = NPS1K+KMAXP1 C NPO1K = NJ+NPO1 C NMSK = NJ+NMS C NPNOK = NJ+NPNO C NPH2OK = NJ+NPH2O C NPCO2K = NJ+NPCO2 C NEK = NJ+NE C LEM = 21*LEN1 C DO 4 I=1,LEM C **** C **** S3 = N*MBAR (K+1/2) C **** C S3(I,1) = S3(I,1)*p0/(boltz*F(I,NTK)*(F(I,NPS1K)*rmassinv_o2+ C 1 F(I,NPS2K)*rmassinv_o+(1.-F(I,NPS1K)-F(I,NPS2K)) C 2 /rmassinv_n2)) C **** C **** ION PRODUCTION OF HOX FROM O2+ ION CHEMICAL CHAIN C **** C S9(I,1) = .5*(F(I,NMSK)+F(I,NMSK+1)) C S10(I,1) = RIN40(I,1)*F(I,NPS1K)*rmassinv_o2*S3(I,1)**2/S9(I,1) C 1 /(RA2(I,1)*F(I,NEK)+RIN40(I,1)*F(I,NPS1K)*rmassinv_o2 C 2 *S3(I,1)**2/S9(I,1)+RK5*F(I,NPNOK)/RMNO* C 3 S3(I,1)) C S11(I,1) = RIN41/(RIN48*F(I,NPO1K) C 1 *rmassinv_o*S3(I,1)+ALPH2*F(I,NEK)+RIN41*F(I,NPH2OK) C 2 /RMH2O*S3(I,1)) C S12(I,1) = (RIN44+RIN45)*F(I,NPH2OK)/RMH2O*S3(I,1)/((RIN44+ C 1 RIN45)*F(I,NPH2OK)/RMH2O*S3(I,1)+ALPH2*F(I,NEK)) C S13(I,1) = 2.*(0.904+RIN48*F(I,NPO1K)*rmassinv_o*S3(I,1) C 1 *(0.904*S10(I,1)/(ALPH2*F(I,NEK)+RIN41* C 2 F(I,NPH2OK)/RMH2O*S3(I,1)+(1.-S10(I,1))*RIN48* C 3 F(I,NPO1K)*rmassinv_o*S3(I,1)))) C 4 *S10(I,1)*S11(I,1)*S12(I,1) C **** C **** ION PRODUCTION OF HOX FROM NO+ ION CHEMICAL CHAIN C **** C S1(I,1) = (RIN9(I,1)*(1.-F(I,NPS1K)-F(I,NPS2K))*rmassinv_n2(3)+ C 1 RIN11(I,1)*F(I,NPCO2K)/RMCO2+RIN13(I,1)*F(I,NPH2OK) C 2 /RMH2O)*S3(I,1)**2/S9(I,1)+ALPH2*F(I,NEK) C S4(I,1) = RIN12(I,1)*S3(I,1)/S9(I,1)+RIN15*F(I,NPH2OK)/RMH2O* C 1 S3(I,1)+ALPH2*F(I,NEK) C S5(I,1) = RIN10(I,1)*S3(I,1)/S9(I,1)+(RIN14*F(I,NPCO2K)/RMCO2 C 1 +RIN16*F(I,NPH2OK)/RMH2O)*S3(I,1)+ALPH2*F(I,NEK) C S6(I,1) = RIN9(I,1)*(1.-F(I,NPS1K)-F(I,NPS2K))*rmassinv_n2* C 1 S3(I,1)**2/S9(I,1) C S7(I,1) = 1.-(ALPH2*F(I,NEK)/(S1(I,1)-S3(I,1)/S9(I,1)*( C 1 RIN10(I,1)*S6(I,1)/S5(I,1)+RIN12(I,1)*(RIN11(I,1)* C 2 F(I,NPCO2K)/RMCO2*S3(I,1)**2/S9(I,1)+S6(I,1)*RIN14* C 3 F(I,NPCO2K)/RMCO2*S3(I,1))/S5(I,1)/S4(I,1)))) C S8(I,1) = (RIN17(I,1)*(1.-F(I,NPS1K)-F(I,NPS2K))*rmassinv_n2+ C 1 RIN19(I,1)*F(I,NPCO2K)/RMCO2+RIN21(I,1)*F(I,NPH2OK) C 2 /RMH2O)*S3(I,1)**2/S9(I,1)+ALPH2*F(I,NEK) C S14(I,1) = RIN23*F(I,NPH2OK)/RMH2O*S3(I,1)+RIN20(I,1)*S3(I,1)/ C 1 S9(I,1)+ALPH2*F(I,NEK) C S15(I,1) = (RIN22*F(I,NPCO2K)/RMCO2+RIN24*F(I,NPH2OK)/RMH2O)* C 1 S3(I,1)+RIN18(I,1)*S3(I,1)/S9(I,1)+ALPH2*F(I,NEK) C S1(I,1) = RIN17(I,1)*(1.-F(I,NPS1K)-F(I,NPS2K))*rmassinv_n2* C 1 S3(I,1)**2/S9(I,1) C S4(I,1)=1.-(ALPH2*F(I,NEK)/(S8(I,1)-S3(I,1)/S9(I,1)*(RIN18(I,1) C 1 *S1(I,1)/S15(I,1)+RIN20(I,1)*(RIN19(I,1)*F(I,NPCO2K) C 2 /RMCO2*S3(I,1)**2/S9(I,1)+S1(I,1)*RIN22*F(I,NPCO2K) C 3 /RMCO2*S3(I,1))/S15(I,1)/S14(I,1)))) C S5(I,1) = RIN25/(RIN25*F(I,NPH2OK)/ C 1 RMH2O*S3(I,1)+ALPH2*F(I,NEK)) C S10(I,1) = 2.*S7(I,1)*S4(I,1)*S5(I,1)*(.096+.904*RIN49*S3(I,1)* C 1 F(I,NPNOK)/RMNO*(1.+RA1(I,1)*RIN48*F(I,NPO1K)*rmassinv_o C 2 *S3(I,1)/(ALPH2*F(I,NEK)+RIN41*F(I,NPH2OK)/RMH2O C 3 *S3(I,1)+(1.-RA1(I,1))*RIN48*F(I,NPO1K)*rmassinv_o C 3 *S3(I,1) C 4 ))/(ALPH2*F(I,NEK)+RIN40(I,1)*F(I,NPS1K)*rmassinv_o2* C 5 S3(I,1)**2/S9(I,1)+RIN49*F(I,NPNOK)/RMNO*S3(I,1))) C PHOXIC(I,1) = (S13(I,1)+S10(I,1))*S2(I,1) C 4 CONTINUE C **** RETURN END C