#include "dims.h" SUBROUTINE CMPO2O use cons_module,only: len1,len2,rmass,rmassinv,kmax,kmaxp1, | expz,p0,boltz use crates_module,only: rk4,rk5,rk6,rk7,rk8,rk9,rk10,beta2,beta6 implicit none C **** C **** CALCULATES FS ARRAY WHICH GIVES SOURCES AND SINK FOR COMP C **** #include "params.h" #include "fcom.h" #include "vscr.h" #include "index.h" #include "buff.h" #include "crates_tdep.h" #include "mwt.h" #include "phys.h" ! ! Local: integer :: nrjk,nqo2pk,nqopk,k,i,nps1k,nps2k,nmsk,nopk,npnok, | npn4sk,npn2dk,no2pk,nn2pk,nnpk,nnopk,nek,ntk C **** C **** CALCULATE FS ARRAY FOR COMP C **** NRJK = NRJ-1 NQO2PK = NQO2P-1 NQOPK = NQOP-1 DO 1 K=1,KMAX NRJK = NRJK+1 NQO2PK = NQO2PK+1 NQOPK = NQOPK+1 DO 1 I=1,LEN1 C **** C **** S15 = expz (K+1/2) C **** S15(I,K) = expz(K) S12(I,K) = 0.5*(F(I,NRJK)+F(I,NRJK+1)) S11(I,K) = 0.5*(F(I,NQO2PK)+F(I,NQO2PK+1)) S9(I,K) = 0.5*(F(I,NQOPK)+F(I,NQOPK+1)) 1 CONTINUE C **** C **** SOURCES C **** NPS1K = NJ+NPS NPS2K = NPS1K+KMAXP1 NMSK = NJ+NMS NOPK = NJ+NOP NPNOK = NJ+NPNO NPN4SK = NJ+NPN4S NPN2DK = NJ+NPN2D NO2PK = NJ+NO2P NN2PK = NN2P NNPK = NNP NNOPK = NNOP NEK = NJ+NE NTK = NJ+NT DO 2 I=1,LEN2 C **** C **** S15 = N*MBAR (K+1/2) C **** S15(I,1) = S15(I,1)*p0/(boltz*F(I,NTK)*(F(I,NPS1K)*rmassinv(1)+ 1 F(I,NPS2K)*rmassinv(2)+(1.-F(I,NPS1K)-F(I,NPS2K)) 2 *rmassinv(3))) 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*(BETA3(I,1)*F(I,NPN4SK)/RMN4S*F(I,NPNOK) 1 /RMNO+BETA6*F(I,NPN2DK)/RMN2D*F(I,NPNOK)/RMNO) 2 +0.5*(BETA8(I,1)+BETA8(I+LEN1,1))*F(I,NPNOK)/RMNO 3 *S15(I,1)+S15(I,1)*(RK4*F(I,NO2PK)*F(I,NPN4SK) 4 /RMN4S+RK10*F(I,NOPK)*F(I,NPN2DK)/RMN2D) 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)+ 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.*RKM12(I,1)*S15(I,1)/(.5*(F(I,NMSK)+F(I,NMSK+1))) ! ! 1/7/00: fixed bug in following line (added "I" to F(NN2PK)) ! S4(I,1) = RK3(I,1)*F(NN2PK)+RK8*F(I,NNPK) S4(I,1) = RK3(I,1)*F(I,NN2PK)+RK8*F(I,NNPK) S5(I,1) = S9(I,1) C **** C **** P(O2)=S6(I,1)*N(OX)**2+S9(I,1)*N(OX)+S10(I,1) C **** S6(I,1) = RKM12(I,1)*S15(I,1)/(.5*(F(I,NMSK)+F(I,NMSK+1))) S9(I,1) =0. S10(I,1) = RK5*F(I,NPNOK)/RMNO*F(I,NO2PK)*S15(I,1) C **** C **** L(O2)=S13(I,1)*N(O2)+S14(I,1) C **** S13(I,1) = S15(I,1)* 1 (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) S14(I,1) = S11(I,1) C **** C **** MATRIX COEFFICIENTS FOR O-O2-N2 SOLUTION C **** C **** NOW CALCULATE CONTRIBUTIONS TO FS ARRAY C **** FS(I,1,1,1) = -S13(I,1) FS(I,1,1,2) = S15(I,1)*S6(I,1)*F(I,NPS2K)*rmassinv(2)*RMASS(1) 1 *rmassinv(2) FS(I,1,2,1) = S2(I,1)*RMASS(2)*rmassinv(1) FS(I,1,2,2) = -S4(I,1)-S3(I,1)*F(I,NPS2K)*rmassinv(2)*S15(I,1) FS(I,1,1,0) = (S10(I,1)-S14(I,1))*RMASS(1)/S15(I,1) FS(I,1,2,0) = (S1(I,1)-S5(I,1))*RMASS(2)/S15(I,1) 2 CONTINUE ! do k=1,kmax ! write(6,"('cmpo2o: lat=',i3,' k=',i3)") j,k ! write(6,"('fs(:,k,1,1)=',/,(6e12.4))") fs(:,k,1,1) ! write(6,"('fs(:,k,1,2)=',/,(6e12.4))") fs(:,k,1,2) ! write(6,"('fs(:,k,2,1)=',/,(6e12.4))") fs(:,k,2,1) ! write(6,"('fs(:,k,2,2)=',/,(6e12.4))") fs(:,k,2,2) ! write(6,"('fs(:,k,1,0)=',/,(6e12.4))") fs(:,k,1,0) ! write(6,"('fs(:,k,2,0)=',/,(6e12.4))") fs(:,k,2,0) ! enddo ! call addfsech('XNMBAR',' ',' ',s15,zimxp,zkmxp,zkmx,j) ! call addfsech('POX1',' ',' ',s1,zimxp,zkmxp,zkmx,j) ! call addfsech('POX2',' ',' ',s2,zimxp,zkmxp,zkmx,j) ! call addfsech('LOX1',' ',' ',s3,zimxp,zkmxp,zkmx,j) ! call addfsech('LOX2',' ',' ',s4,zimxp,zkmxp,zkmx,j) ! call addfsech('LOX3',' ',' ',s5,zimxp,zkmxp,zkmx,j) ! call addfsech('PO21',' ',' ',s6,zimxp,zkmxp,zkmx,j) ! call addfsech('PO22',' ',' ',s9,zimxp,zkmxp,zkmx,j) ! call addfsech('PO23',' ',' ',s10,zimxp,zkmxp,zkmx,j) ! call addfsech('LO21',' ',' ',s13,zimxp,zkmxp,zkmx,j) ! call addfsech('LO22',' ',' ',s14,zimxp,zkmxp,zkmx,j) RETURN END C