************************************************************************ * MASTER MECHANISM - ROUTINE NAME : rxwrit3 * * * * PURPOSE: - write the reaction to a file in a standard format * * * * INPUT * * lout : unit number for the output file (where the reaction * * must be written) * * a1 : comment col. 1 (usually type of reaction) * * a2 : comment col. 2 (usually on/off switch) * * a3 : comment col. 18 (usually arrow or split counter) * * a4 : comment col. 19 (usually reaction channel letter) * * r(3) : array of reagents * * s(mnp) : array of stoichiometry coefficients * * p(mnp) : array of products * * ar1 : first arrhenius coefficient * * ar2 : second arrhenius coefficient (power in T) * * ar3 : third arrhenius coefficient (Ea/T) * * f298 : rate constant at 298 K (for the "full" reaction) * * fratio : branching ratio for the given rection at 298 K * * idreac : ID for the type of reaction (AIN, AOU, WIN, WOU, DIMER...)* * nlab : label if the reaction is not thermal * * xlab : weighting factor for HV reaction * * folow : low pressure fall off arrhenius coefficient * * fotroe : troe parameter for fall off reaction * * * * OUTPUT : none * * * * NOTE : variable a1, a2, a3 and a4 are not used anymore (but kept * * since it might be required for the NCAR box model and for * * utilities). * * * * This subroutine computes the number of required splits (npmax * * products per line), adjusts stoichiometry coefficients and rate * * constants accordingly, collapses identical products and blanks out * * unity stoichiometry coefficients * * * * ID number are : * * 1 => AIN * 2 => AOU * 3 => WIN * 4 => WOU * 5 => DIMER * 6 => AEROPHOT ************************************************************************ SUBROUTINE rxwrit_dyn(lout,r,s,p,ar1,ar2,ar3, & idreac,auxinfo,charfrom,charto) IMPLICIT NONE INCLUDE 'general.h' ! maximum number of product in a single reaction before splitting INTEGER npmax PARAMETER (npmax=4) ! input CHARACTER(LEN=lco) r(3), p(mnp) REAL s(mnp),ar1,ar2,ar3 INTEGER lout, idreac ! only 2 needed here, but more might be necessary. Maxaux is 9 in the interpreter REAL auxinfo(9) CHARACTER*1 charfrom,charto ! internal CHARACTER*1 c1,c2,signe(mnp) CHARACTER(LEN=6) charstoi(mnp) INTEGER i,j,k,np,j1,j2,jj CHARACTER(LEN=7) rg(3),pg(mnp) LOGICAL locheck ! clean table of products and stoe coef (just in case) DO i=1,mnp IF (s(i).EQ.0.) p(i) = ' ' IF (p(i)(1:1).EQ.' ') s(i) = 0. ENDDO ! check that species is the same both side IF (r(1).ne.p(1) .and. r(2)(1:3).ne. 'HV ') THEN WRITE(6,*) '--error--, in rxwrit_dyn. The subroutine' WRITE(6,*) 'was called with distinct reactant and product' WRITE(6,'(a)') r(1), '=>', p(1) STOP ENDIF ! check that only p(1) is filled with s(1)=1 IF (s(1).NE.1.) THEN WRITE(6,*) '--error--, in rxwrit_dyn. The subroutine' WRITE(6,*) 'was called with a stoe. coef. not eq. 1' WRITE(6,'(a)') s(1) STOP ENDIF IF (p(1)(1:2).EQ.' ') THEN WRITE(6,*) '--error--, in rxwrit_dyn. The subroutine' WRITE(6,*) 'was called with no product' WRITE(6,'(a)') p(1) STOP ENDIF DO i=2,mnp IF (p(i)(1:2).NE.' ') THEN WRITE(6,*) '--error--, in rxwrit_dyn. The subroutine' WRITE(6,*) 'was called with more than one product' WRITE(6,'(a)') p(i) STOP ENDIF ENDDO ! idreac must be between 1 and 6 IF ((idreac.lt.1).OR.(idreac.gt.6)) THEN WRITE(6,*) '--error--, in rxwrit_dyn. The subroutine' WRITE(6,*) 'was called with idreac out of bound' WRITE(6,'(a)') idreac STOP ENDIF ! check that second is one of the expected keywords locheck=.false. IF (r(2)(1:4).eq.'AIN ' ) locheck=.true. IF (r(2)(1:4).eq.'AOU ' ) locheck=.true. IF (r(2)(1:4).eq.'WIN ' ) locheck=.true. IF (r(2)(1:4).eq.'WOU ' ) locheck=.true. IF (r(2)(1:4).eq.'DIM_' ) locheck=.true. IF (r(2)(1:3).eq.'HV ') locheck=.true. IF (.not.locheck) THEN WRITE(6,*) '--error--, in rxwrit_dyn. The subroutine' WRITE(6,*) 'was called with unexpected keyword :' WRITE(6,'(a)') r(2) STOP ENDIF ! -------------------------------------------- ! write reaction using the format in rxwrit3.f ! -------------------------------------------- ! initialise first DO i=1,npmax charstoi(i)=' ' ! no coef, since should be 1 or 0 signe(i)=' ' pg(i) = ' ' ENDDO DO i=1,3 rg(i) = ' ' ENDDO rg(1)(1:1)=charfrom rg(1)(2:7)=r(1) rg(2)(1:)=r(2)(1:) ! keyword, checked above that it is OK pg(1)(1:1)=charto pg(1)(2:7)=p(1) j1 = 1 j2 = 4 c1='+' c2=' ' WRITE(lout,120) & rg(1),c1,rg(2),c2,rg(3),' ','=>', & (charstoi(jj),pg(jj),signe(jj),jj=j1,j2),ar1,ar2,ar3 120 FORMAT(3(A7,A1),A2,4(A5,1X,A7,1X,A1),4X,ES10.3,1X,f4.1,1X,f7.0) ! ------------------------------------- ! write keyword and label if necessary ! ------------------------------------- IF (idreac.eq.1) THEN !(don't write) ! WRITE(lout,'(A7,f6.1,2x,f8.4,ES11.3,A1)') ! & ' AIN/ ',auxinfo(1),auxinfo(2),auxinfo(3),'/' ELSE IF (idreac.eq.2) THEN WRITE(lout,'(A7,f6.1,2x,f8.4,A1)') & ' AOU/ ',auxinfo(1),auxinfo(2),'/' ! alternate: if also passing diffusion volume ! WRITE(lout,'(A7,f6.1,2x,f8.4,ES11.3,A1)') ! & ' AOU/ ',auxinfo(1),auxinfo(2),auxinfo(3),'/' ELSE IF (idreac.eq.3) THEN WRITE(lout,'(A7,f6.1,2x,f8.4,ES11.3,A1)') & ' WIN/ ',auxinfo(1),auxinfo(2),auxinfo(3),'/' ELSE IF (idreac.eq.4) THEN WRITE(lout,'(A7,f6.1,2x,f8.4,ES11.3,A1)') & ' WOU/ ',auxinfo(1),auxinfo(2),auxinfo(3),'/' ELSE IF (idreac.eq.6) THEN WRITE(lout,'(A5,I5,2x,f6.3,A1)') & ' HV/',int(auxinfo(1)),auxinfo(2),'/' ENDIF ! end RETURN END