#include "dims.h" SUBROUTINE QJNNO use cons_module,only: len1,len2,kmax,kmaxp1,kmaxm1,avo, | rmassinv_o2,rmassinv_o,rmassinv_n2 implicit none C **** C **** CALCULATES ADDITIONS TO NEUTRAL GAS HEATING AND O2 C **** DISSOCIATION DUE TO N, NO CHEMISTRY C **** C **** NOTE: CMPN2D MUST BE CALLED BEFORE THIS SUBROUTINE C **** IS CALLED 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 "mwt.h" #include "phys.h" ! ! Local: real :: e1d,eo21s,eo21d,eps integer :: i integer :: npnok,npn4sk,npn2dk,ntk,nps1k,nps2k,nno2k,nek,nqk, | nrjk,npohk,npho2k,npo3k,npo1k,npno2k,npcok,npco2k,nmsk,nph2ok, | nph2k,nphk,npch4k,ncpk ! E1D=1.96 ; EO21S=0.98 ; EO21D=0.65 ; EPS=0.6 NPNOK=NJNP+NPNO NPN4SK=NJNP+NPN4S NPN2DK=NPN2D+NJNP NTK=NJ+NT NPS1K=NJ+NPS NPS2K=NPS1K+KMAXP1 NNO2K=NNO2 NEK=NJ+NE NQK=NQ NRJK=NRJ C **** C **** S1 = NMBAR (K+1/2) C **** S3 = PSI(N2)/RMASS(3) C **** DO 1 I=1,LEN2 S1(I,1)=XNMBAR(I,1) S3(I,1)=(1.-F(I,NPS1K)-F(I,NPS2K))*rmassinv_n2 1 CONTINUE NPOHK = NJNP+NPOH NPHO2K = NJNP+NPHO2 NPO3K = NJ+NPO3 NPO1K = NJ+NPO1 NPNO2K = NJNP+NPNO2 NPCOK = NJNP+NPCO NPCO2K = NJNP+NPCO2 NMSK = NJ+NMS NPH2OK = NJNP+NPH2O NPH2K = NJNP+NPH2 NPHK = NJNP+NPH NPCH4K = NJNP+NPCH4 DO 3 I=1,LEN2 C **** C **** S2 = DELTA(Q) (K+1/2) C **** C **** HEATING FROM NOX CHEMISTRY C **** S2(I,1)=1.602E-12*avo*S1(I,1)*(F(I,NPN4SK)/RMN4S*(BETA1(I,1)* 1F(I,NPS1K)*rmassinv_o2*1.4+BETA3(I,1)*F(I,NPNOK)/RMNO*2.68)+ 2F(I,NPN2DK)/RMN2D*(BETA2*F(I,NPS1K)*rmassinv_o2*1.8+BETA4* 3F(I,NPO1K)*rmassinv_o*2.38+BETA5(I,1)*.5*(F(I,NEK)+F(I,NEK+1))* 4 2.38/S1(I,1)+BETA6*F(I,NPNOK)/RMNO*5.63) 5+BETA8*F(I,NPN4SK)/RMN4S*F(I,NPOHK)/RMOH*2.10 6+BETA9(I,1)*F(I,NPNOK)/RMNO*F(I,NPO3K)/RMO3*2.08 7+BETA10(I,1)*F(I,NPHO2K)/RMHO2*F(I,NPNOK)/RMNO*0.35 8+BETA11*F(I,NPO1K)/RMO1*F(I,NPNO2K)/RMNO2*1.98 9+BETA12(I,1)*F(I,NPO3K)/RMO3*F(I,NPNO2K)/RMNO2*1.08 1+BETA13*F(I,NPN4SK)/RMN4S*F(I,NPNO2K)/RMNO2*1.81) C **** C **** HEATING FROM METASTABLES O2(1DELTA) AND O2(1SIGMA) C **** C S2(I,1)=S2(I,1)+1.602E-12*avo*S1(I,1)*( C 1 (RKM9(I,1)*F(I,NPS1K)*rmassinv_o2*0.98+RKM10*S3(I,1)*0.98 C 2 +RKM11*F(I,NPO1K)/RMO1*0.98)*XNO21S(I,1)+(RKM13* C 3 S3(I,1)*0.65 C 4 +RKM14*F(I,NPCO2K)/RMCO2*0.65+RKM15*F(I,NPO3K)/ C 5 RMO3*0.65+RKM16*F(I,NPO1K)/RMO1*0.65+RKM17* C 6 F(I,NPS1K)*rmassinv_o2*0.65)*XNO21D(I,1))*rmassinv_o2 C 7 -1.602E-12*avo*EO21S*ASG*XNO21S(I,1)*rmassinv_o2 C 8 -1.602E-12*avo*EO21D*ADL*XNO21D(I,1)*rmassinv_o2 C **** C **** HEATING FROM HOX CHEMISTRY C **** S2(I,1)=S2(I,1)+1.602E-12*avo*S1(I,1)*( 1 RKM25(I,1)*F(I,NPO1K)/RMO1*F(I,NPOHK)/RMOH*0.72 2+RKM26(I,1)*F(I,NPO1K)/RMO1*F(I,NPHO2K)/RMHO2*2.33 3+RKM27(I,1)*F(I,NPO1K)/RMO1*XNH2O2(I,1)/RMH2O2*3.44 4+RKM28(I,1)*F(I,NPO1K)/RMO1*F(I,NPH2K)/RMH2*0.08 5+RKM29(I,1)*F(I,NPOHK)/RMOH*F(I,NPO3K)/RMO3*1.73 6+RKM30(I,1)*F(I,NPOHK)/RMOH*F(I,NPOHK)/RMOH*0.73 7+RKM31(I,1)*F(I,NPOHK)/RMOH*F(I,NPHO2K)/RMHO2*3.06 8+RKM32(I,1)*F(I,NPOHK)/RMOH*XNH2O2(I,1)/RMH2O2*1.35 9+RKM33(I,1)*F(I,NPOHK)/RMOH*F(I,NPH2K)/RMH2*0.65 1+RKM34(I,1)*F(I,NPHO2K)/RMHO2*F(I,NPO3K)/RMO3*1.23 2+RKM35(I,1)*1.7*(F(I,NPHO2K)/RMHO2)**2 3+RKM36(I,1)*F(I,NPHK)/RMH*F(I,NPS1K)*rmassinv_o2*S1(I,1)/ 4 (.5*(F(I,NMSK)+F(I,NMSK+1)))*2.11 5+RKM37(I,1)*F(I,NPHK)/RMH*F(I,NPO3K)/RMO3*3.34*EPS 6+RKM38*F(I,NPHK)/RMH*F(I,NPHO2K)/RMHO2*2.41 7+RKM39(I,1)*F(I,NPHK)/RMH*F(I,NPHO2K)/RMHO2*1.61 8+RKM40(I,1)*F(I,NPHK)/RMH*F(I,NPHO2K)/RMHO2*2.34 9+RKM41(I,1)*(F(I,NPHK)/RMH)**2*S1(I,1)/ 1 (.5*(F(I,NMSK)+F(I,NMSK+1)))*4.52 2+RKM42(I,1)*F(I,NPCOK)/RMCO*F(I,NPOHK)/RMOH*1.07) C **** C **** HEATING FROM OX CHEMISTRY C **** ! 6/10/98 btf: F(I,NPO1) changed to F(I,NPO1K) in last line ! of next statement. ! S2(I,1)=S2(I,1)+1.602E-12*avo*S1(I,1)**2*( 1 RKM20(I,1)/F(I,NMSK)*(F(I,NPO1K)/RMO1)**2*5.12 2+RKM21(I,1)*F(I,NPS1K)*rmassinv_o2*(F(I,NPO1K)/RMO1)**2*1.10 3+RKM22(I,1)*(F(I,NPS1K)*rmassinv_o2)**2*F(I,NPO1K)/RMO1*1.10 4+RKM23(I,1)*S3(I,1)*F(I,NPS1K)*rmassinv_o2*F(I,NPO1K)/RMO1*1.10 5+RKM24(I,1)*F(I,NPO1K)/RMO1*F(I,NPO3K)/RMO3*4.06/S1(I,1)) C **** C **** HEATING FROM O(1D) QUENCHING AND REACTIONS C **** S2(I,1)=S2(I,1)+1.602E-12*avo*S1(I,1)*( 1 (RKM1(I,1)*S3(I,1)*1.96+(RKM2A(I,1)*0.33+RKM2B(I,1)* 2 1.96)*F(I,NPS1K)*rmassinv_o2+RKM3*F(I,NPH2OK)/ 3 RMH2O*1.23+RKM4*F(I,NPH2K)/RMH2*1.88 4 +(RKM5A*1.85 5 +RKM5B*4.89)*F(I,NPCH4K)/RMCH4+RKM6(I,1)* 6 F(I,NPCO2K)/RMCO2*1.96+(RKM7A*6.02+RKM7B 7 *0.86)*F(I,NPO3K)/RMO3+RKM8*F(I,NPO1K)* 8 rmassinv_o*1.96)*XNO1D(I,1)/RMO1) 9 -1.602E-12*avo*E1D*A1D*XNO1D(I,1)/RMO1 C **** C **** HEATING FORM CH4 CHEMISTRY C **** S2(I,1) = S2(I,1)+1.602E-12*avo*S1(I,1)* 1 (GAM1(I,1)*F(I,NPOHK)/RMOH*F(I,NPCH4K)/RMCH4*0.62 2 +GAM2A*XNO1D(I,1)/RMO1*F(I,NPCH4K)/RMCH4*1.85 3 +GAM2B*XNO1D(I,1)/RMO1*F(I,NPCH4K)/RMCH4*4.89 4 +GAM3(I,1)*CH3(I,1)*F(I,NPS1K)*rmassinv_o/ 5 (.5*(F(I,NMSK)+F(I,NMSK+1)))*1.22 6 +GAM15*XNO1D(I,1)/RMO1*F(I,NPCO2K)/RMCO2*1.61 7 -GAM14(I,1)*F(I,NPCOK)/RMCO*F(I,NPS2K)*rmassinv_o*S1(I,1)/ 8 (.5*(F(I,NMSK)+F(I,NMSK+1)))*5.51 9 -GAM13(I,1)*F(I,NPO1K)/RMO1*F(I,NPCH4K)/RMCH4*0.11) 1 +1.602E-12*avo*( 2 GAM4*F(I,NPS2K)*rmassinv_o*CH3(I,1)*2.96 3 +GAM5(I,1)*F(I,NPNOK)/RMNO*CH3O2(I,1)*0.72 4 +GAM6(I,1)*F(I,NPHO2K)/RMHO2*CH3O2(I,1)*1.74 5 +GAM7(I,1)*CH3O2(I,1)*CH3O2(I,1)*0.24/S1(I,1) 6 +GAM8(I,1)*F(I,NPOHK)/RMOH*CH3OOH(I,1)*1.32 7 +GAM9(I,1)*F(I,NPS1K)*rmassinv_o2*CH3O(I,1)*1.15 8 +GAM10*F(I,NPOHK)/RMOH*CH2O(I,1)*2.92 9 +GAM11(I,1)*F(I,NPO1K)/RMO1*CH2O(I,1)*2.18 1 -GAM12(I,1)*F(I,NPS1K)*rmassinv_o2*CHO(I,1)*0.14) C **** C **** HEATING FORM CLX CHEMISTRY C **** S2(I,1) = S2(I,1)+1.602E-12*avo*S1(I,1)/ 1 (.5*(F(I,NMSK)+F(I,NMSK+1))) 2 *(DEL1(I,1)*RMCL(I,1)*F(I,NPO3K)/RMO3*1.68+DEL2(I,1) 3 *RMCLO(I,1)*F(I,NPO1K)/RMO1*2.38) 3 CONTINUE C **** C **** ADD DELTA(Q) TO Q (K) C **** C **** LEVELS 2 THU KMAX C **** DO 4 I=LEN1+1,LEN2 s7(i,1) = s2(i,0)*s2(i,1) if (s7(i,1) < 0.) s7(i,1) = 1.e-20 F(I,NQK) = F(I,NQK)+SQRT(S7(I,1)) 4 CONTINUE C **** LEVELS 1 AND KMAXP1 DO 5 I=1,LEN1 F(I,NQK) = F(I,NQK)+1.5*S2(I,1)-0.5*S2(I,2) F(I,NQK+KMAX) = F(I,NQK+KMAX)+1.5*S2(I,KMAX)-0.5* 1 S2(I,KMAXM1) 5 CONTINUE c c Add chemical heating CHEMHT to secondary histories: c subroutine addfsech(fname,f,idim1,idim2,ilat) c ! ncpk = ncp ! do i=1,len2 ! S2(I,1) = S2(i,1)*86400./f(i,ncpk) ! enddo ! call addfsech('CHEMHT',' ',' ',S2,zimxp,kmaxp1,kmax,j) RETURN END