#include "dims.h" SUBROUTINE CMPOX use cons_module,only: len1,len2,kmax,kmaxp1,rmass_o2, | rmassinv_o2,rmassinv_o,rmassinv_n2 implicit none C **** C **** CALCULATES THE FS ARRAYS FOR THE PARTITIONING OF OX C **** INTO O AND O3 BEFORE THE CALL TO COMP C **** NOTE: THIS IS DIAGNOSTIC. CALL BEFORE COMP 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: integer :: NJO3DK,NJO3PK,NRJK,NQO2PK,NQO2JK,NJH2OLK,NQOPK,NPS1K, | NPS2K,NMSK,NOPK,NPH2OK,NPOHK,NPHO2K,NPH2K,NPHK,NPO1K,NPO3K, | NPNOK,NPNO2K,NPN4SK,NPN2DK,NO2PK,NN2PK,NNPK,NNOPK,NEK,NPCOK, | NPCH4K,NDNK,ntk integer :: i,k real :: XLO(ZIMXP,ZKMXP),XN2N(ZIMXP,ZKMXP),XO2N(ZIMXP,ZKMXP), | XOXN(ZIMXP,ZKMXP),XO3N(ZIMXP,ZKMXP),XON(ZIMXP,ZKMXP) ! NJO3DK = NJO3D-1 NJO3PK = NJO3P-1 NRJK = NRJ-1 NQO2PK = NQO2P-1 NQO2JK = NQO2J-1 NJH2OLK = NJH2OL-1 NQOPK = NQOP-1 NPS1K = NJ+NPS NPS2K = NPS1K+KMAXP1 NMSK = NJ+NMS NOPK = NJNP+NOP NPH2OK = NJNP+NPH2O NPOHK = NJNP+NPOH NPHO2K = NJNP+NPHO2 NPH2K = NJNP+NPH2 NPHK = NJNP+NPH NPO1K = NJ+NPO1 NPO3K = NJ+NPO3 NPNOK = NJNP+NPNO NPNO2K = NJNP+NPNO2 NPN4SK = NJNP+NPN4S NPN2DK = NJNP+NPN2D NO2PK = NJ+NO2P NN2PK = NN2P NNPK = NNP NNOPK = NNOP NEK = NJNP+NE NPCOK = NJNP+NPCO NPCH4K = NJNP+NPCH4 NDNK = NDN DO 2 K=1,KMAX NJO3DK = NJO3DK+1 NJO3PK = NJO3PK+1 NRJK = NRJK+1 NQO2PK = NQO2PK+1 NQO2JK = NQO2JK+1 NJH2OLK = NJH2OLK+1 NQOPK = NQOPK+1 DO 2 I=1,LEN1 C **** C **** S15 = EXPS (K+1/2) C **** S14(I,K) = 0.5*(F(I,NJH2OLK)+F(I,NJH2OLK+1)) S13(I,K) = 0.5*(F(I,NJO3DK)+F(I,NJO3DK+1)) 1 +0.5*(F(I,NJO3PK)+F(I,NJO3PK+1)) S12(I,K) = 0.5*(F(I,NRJK)+F(I,NRJK+1)) S11(I,K) = 0.5*(F(I,NQO2PK)+F(I,NQO2PK+1)) S10(I,K) = 0.5*(F(I,NQO2JK)+F(I,NQO2JK+1)) S9(I,K) = 0.5*(F(I,NQOPK)+F(I,NQOPK+1)) S2(I,K) = 0.5*(XJNO2(I,K)+XJNO2(I,K+1)) 2 CONTINUE C **** C **** SOURCES C **** NTK = NJ+NT DO 3 I=1,LEN2 C **** C **** S15 = N*MBAR (K+1/2) C **** S15(I,1) = XNMBAR(I,1) C **** C **** PARTITIONING OF OX: S7=O3/O RATIO, C **** S8=O/OX RATIO C **** S7(I,1) = S15(I,1)*RKM21(I,1)*F(I,NPS1K)*rmassinv_o2*S15(I,1)/ 1 (.5*(F(I,NMSK)+F(I,NMSK+1))) 2 /(S15(I,1)*(RKM24(I,1)*F(I,NPO1K)*rmassinv_o+ 3 (RKM7A+RKM7B)*XNO1D(I,1)/RMO1+ 4 RKM29(I,1)*F(I,NPOHK)/RMOH+RKM34(I,1)*F(I,NPHO2K)/RMHO2 5 +RKM37(I,1)*F(I,NPHK)/RMH+BETA9(I,1)*F(I,NPNOK)/RMNO 6 +BETA12(I,1)*F(I,NPNO2K)/RMNO2)+S13(I,1)+DEL1(I,1)* 7 RMCL(I,1)*S15(I,1)/(.5*(F(I,NMSK)+F(I,NMSK+1)))) S8(I,1) = 1./(1.+S7(I,1)) C **** C **** P(OX)=S1(I,1)+S2(I,1)*N(O2) IS THE PRODUCTION OF OX C **** S1(I,1) = S15(I,1)**2*(RKM30(I,1)*(F(I,NPOHK)/RMOH)**2+ 1 RKM40(I,1)*F(I,NPHK)/RMH*F(I,NPHO2K)/RMHO2+ 2 BETA3(I,1)*F(I,NPN4SK)/RMN4S*F(I,NPNOK)/RMNO+ 3 BETA6*F(I,NPN2DK)/RMN2D*F(I,NPNOK)/RMNO+ 4 BETA13*F(I,NPN4SK)/RMN4S*F(I,NPNO2K)/RMNO2) 6 +0.5*(XJNO(I,1)+XJNO(I+LEN1,1)) 7 *F(I,NPNOK)/RMNO*S15(I,1)+S2(I,1)*F(I,NPNO2K)/RMNO2* 8 S15(I,1)+S15(I,1)*(RK4*F(I,NO2PK)*F(I,NPN4SK)/RMN4S+ 9 RK10*F(I,NOPK)*F(I,NPN2DK)/RMN2D+RK12*F(I,NOPK) 1 *F(I,NPHK)/RMH 2 +(RK16*XIOP2P(I,1)+RK24*XIOP2D(I,1))*(1.- 3 F(I,NPS1K)-F(I,NPS2K))*rmassinv_n2) 4 +(RA1(I,1)*F(I,NNOPK)+2.*RA2(I,1)*F(I,NO2PK)) 5 *SQRT(F(I,NEK)*F(I,NEK+1)) S2(I,1) = S15(I,1)*(BETA1(I,1)*F(I,NPN4SK)/RMN4S+BETA2 1 *F(I,NPN2DK)/RMN2D)+RK1(I,1)*F(I,NOPK)+RK7* 2 F(I,NNPK)+RK23*XIOP2P(I,1)+RK27*XIOP2D(I,1) 3 + 2.*S12(I,1) C **** C **** L(OX)=S3(I,1)*N(OX)**2+S4(I,1)*N(OX)+S5 C **** S3(I,1) = (2.*RKM20(I,1)*S15(I,1)/(.5*(F(I,NMSK)+F(I,NMSK+1))) 1 +2.*RKM24(I,1)*S7(I,1))*S8(I,1)**2 S4(I,1) = (S15(I,1)*(RKM29(I,1)*F(I,NPOHK)/RMOH*S7(I,1)+RKM34(I,1) 1 *F(I,NPHO2K)/RMHO2*S7(I,1)+RKM37(I,1)*F(I,NPHK)/RMH*S7(I,1) 2 +RKM25(I,1)*F(I,NPOHK)/RMOH+RKM26(I,1)*F(I,NPHO2K)/RMHO2 3 +RKM27(I,1)*XNH2O2(I,1)/RMH2O2+GAM13(I,1)*F(I,NPCH4K)/ 4 RMCH4+RKM28(I,1)*F(I,NPH2K)/RMH2+GAM14(I,1)*S15(I,1)/ 5 (.5*(F(I,NMSK)+F(I,NMSK+1))) 6 *F(I,NPCOK)/RMCO+BETA9(I,1)*F(I,NPNOK)/RMNO*S7(I,1)+ 7 BETA12(I,1)*F(I,NPNO2K)/RMNO2*S7(I,1) 8 +BETA11*F(I,NPNO2K)/RMNO2) 9 +GAM4*CH3(I,1)+GAM11(I,1)*CH2O(I,1) 1 +RK3(I,1)*F(I,NN2PK)+RK8*F(I,NNPK)+RK11(I,1) 2 *XNHP(I,1))*S8(I,1) 3 +(DEL1(I,1)*RMCL(I,1)*S7(I,1)*S8(I,1)+DEL2(I,1) 4 *RMCLO(I,1)*S8(I,1)) 5 *S15(I,1)/(.5*(F(I,NMSK)+F(I,NMSK+1))) S5(I,1) = S9(I,1) C XLO(I,1) = S3(I,1)*(F(I,NPO1K)/RMO1*S7(I,1))**2+S4(I,1)*F(I,NPO1K)/RMO1 C 1 *S7(I,1)+S5(I,1) XN2N(I,1) = (1.-F(I,NPS1K)-F(I,NPS2K))*rmassinv_n2*S15(I,1) XO2N(I,1) = F(I,NPS1K)*rmassinv_o2*S15(I,1) XOXN(I,1) = F(I,NPS2K)/RMO1*S15(I,1) ! OX (O+O3) number density XON(I,1) = F(I,NPO1K)/RMO1*S15(I,1) ! O1 number density XO3N(I,1) = F(I,NPO3K)/RMO3*S15(I,1) ! ! 10/23/01 bf: Use O1 (NPO1K) instead of OX (NPS2K) in XLO O1 loss rate: ! XLO(I,1) = 2.*RKM20(I,1)*((F(I,NPO1K)*rmassinv_o*S15(I,1))**2) 1 *(1.-F(I,NPS1K)-F(I,NPO1K))*rmassinv_n2*S15(I,1) 2 +RKM21(I,1)*F(I,NPO1K)*rmassinv_o*S15(I,1) 3 *F(I,NPO1K)*rmassinv_o*S15(I,1)*F(I,NPS1K)*rmassinv_o2 4 *S15(I,1) 5 +RKM22(I,1)*F(I,NPO1K)*rmassinv_o*S15(I,1) 6 *F(I,NPS1K)*rmassinv_o2*S15(I,1)*F(I,NPS1K)*rmassinv_o2 7 *S15(I,1) 8 +RKM23(I,1)*F(I,NPO1K)*rmassinv_o*S15(I,1) 9 *F(I,NPS1K)*rmassinv_o2*S15(I,1)*(1.-F(I,NPS1K) 1 -F(I,NPO1K))*rmassinv_n2*S15(I,1) 2 +RKM24(I,1)*F(I,NPO1K)*rmassinv_o*S15(I,1)*F(I,NPO3K)/ 3 RMO3*S15(I,1) 2 +RKM25(I,1)*F(I,NPO1K)*rmassinv_o*S15(I,1)*F(I,NPOHK)/ 3 RMOH*S15(I,1) 2 +RKM26(I,1)*F(I,NPO1K)*rmassinv_o*S15(I,1)*F(I,NPHO2K)/ 3 RMHO2*S15(I,1) 2 +RKM28(I,1)*F(I,NPO1K)*rmassinv_o*S15(I,1)*F(I,NPH2K)/ 3 RMH2*S15(I,1) C C **** C **** P(O2)=S6(I,1)*N(OX)**2+S9(I,1)*N(OX)+S10(I,1) C **** S6(I,1) = (RKM20(I,1)*S15(I,1)/(.5*(F(I,NMSK)+F(I,NMSK+1))) 1 +2.*RKM24(I,1)*S7(I,1))*S8(I,1)**2 S9(I,1) =((RKM25(I,1)*F(I,NPOHK)/RMOH+RKM26(I,1)*F(I,NPHO2K) 1 /RMHO2+ 2 RKM29(I,1)*F(I,NPOHK)/RMOH*S7(I,1)+2.*RKM34(I,1)* 3 F(I,NPHO2K)/RMHO2*S7(I,1)+RKM37(I,1)*F(I,NPHK)/RMH* 4 S7(I,1)+BETA9(I,1)*F(I,NPNOK)/RMNO*S7(I,1)+BETA11* 5 F(I,NPNO2K)/RMNO2+BETA12(I,1)*F(I,NPNO2K)/RMNO2*S7(I,1)) 6 *S15(I,1)+S13(I,1)*S7(I,1))*S8(I,1) 7 +(DEL1(I,1)*RMCL(I,1)*S7(I,1)*S8(I,1)+DEL2(I,1) 8 *RMCLO(I,1)*S8(I,1)) 9 *S15(I,1)/(.5*(F(I,NMSK)+F(I,NMSK+1))) S10(I,1) = S15(I,1)**2*(RKM31(I,1)*F(I,NPOHK)/RMOH*F(I,NPHO2K) 1 /RMHO2+RKM38*F(I,NPHK)/RMH*F(I,NPHO2K)/RMHO2+ 2 RKM35(I,1)*(F(I,NPHO2K)/RMHO2)**2) 3 +RK5*F(I,NPNOK)/RMNO*F(I,NO2PK)*S15(I,1) 4 +GAM6(I,1)*CH3O2(I,1)*F(I,NPHO2K)/RMHO2*S15(I,1) 5 +GAM7(I,1)*CH3O2(I,1)**2 6 +GAM15*F(I,NPCOK)/RMCO*XNO1D(I,1)/RMO1*S15(I,1)**2 C **** C **** L(O2)=S13(I,1)*N(O2)+S14(I,1) C **** S13(I,1) = S15(I,1)*(RKM36(I,1)*S15(I,1)/ 1 (.5*(F(I,NMSK)+F(I,NMSK+1)))*F(I,NPHK)/ 1 RMH+BETA1(I,1)*F(I,NPN4SK)/RMN4S+BETA2*F(I,NPN2DK) 2 /RMN2D)+RK1(I,1)*F(I,NOPK)+(RK6+RK7)* 3 F(I,NNPK)+RK9*F(I,NN2PK)+S12(I,1) 4 +RK23*XIOP2P(I,1)+RK27*XIOP2D(I,1) 5 +GAM3(I,1)*CH3(I,1)*S15(I,1)/(.5*(F(I,NMSK)+F(I,NMSK+1))) 6 +GAM9(I,1)*CH3O(I,1)+GAM12(I,1)*CHO(I,1) S14(I,1) = S11(I,1) C **** C **** MATRIX COEFFICIENTS FOR OX SOLUTION C **** C **** C **** S7(I,1) = RMOX(TRUE) (K+1/2) C **** S7(I,1) = S8(I,1)*(RMO1+S7(I,1)*RMO3) FS(I,1,1,1) = -S13(I,1)-S15(I,1)**2*S8(I,1)*F(I,NPS2K)/S7(I,1) 1 *(1./3.*RKM21(I,1)*S8(I,1)*F(I,NPS2K)/S7(I,1)+2./3.* 2 RKM22(I,1)*F(I,NPS1K)*rmassinv_o2+1./2.*RKM23(I,1)*(1.- 3 F(I,NPS1K)-F(I,NPS2K))*rmassinv_n2) FS(I,1,1,2) = (S9(I,1)+S15(I,1)*S6(I,1)*F(I,NPS2K)/S7(I,1) 1 -S15(I,1)**2 2 *S8(I,1)*F(I,NPS1K)*rmassinv_o2*(2./3.*RKM21(I,1)*S8(I,1) 3 *F(I,NPS2K)/S7(I,1)+1./3.*RKM22(I,1)*F(I,NPS1K)*rmassinv_o2 4 +1./2.*RKM23(I,1)*(1.-F(I,NPS1K)-F(I,NPS2K))*rmassinv_n2)) 5 *rmass_o2/S7(I,1) FS(I,1,2,1) = S2(I,1)*S7(I,1)*rmassinv_o2 FS(I,1,2,2) = -S4(I,1)-S3(I,1)*F(I,NPS2K)/S7(I,1)*S15(I,1) FS(I,1,1,0) = (S10(I,1)-S14(I,1))*rmass_o2/S15(I,1) FS(I,1,2,0) = (S1(I,1)-S5(I,1))*S7(I,1)/S15(I,1) 3 CONTINUE call addfsech('XLO' ,' ',' ',XLO ,zimxp,zkmxp,zkmx,j) call addfsech('XN2N',' ',' ',XN2N,zimxp,zkmxp,zkmx,j) call addfsech('XO2N',' ',' ',XO2N,zimxp,zkmxp,zkmx,j) call addfsech('XON' ,' ',' ',XON ,zimxp,zkmxp,zkmx,j) call addfsech('XOXN',' ',' ',XOXN,zimxp,zkmxp,zkmx,j) call addfsech('XO3N',' ',' ',XO3N,zimxp,zkmxp,zkmx,j) RETURN END