************************************************************************ * MASTER MECHANISM - ROUTINE NAME : rdkwreact * * * * PURPOSE: - read the kwown reaction of a given series (e.g. OH+VOC, * * NO3+VOC, ...) * * * * INPUT: * * - filename : name of the file to be read * * * * OUTPUT: * * - nkwdat : number of VOC having known products for the * * reaction with ox * * - kwrct(i) : chemical formula of the VOC having a known * * chemistry for the reaction with ox * * - nkwpd(i) : number of known products for ith known reacting VOC * * - kwpd(i,j) : chemical formula of the jth product for the * * reaction of the ith VOC with ox * * - kwcopd(i,j,k): name (6 character) of the kth coproduct of the jth * * product for the reaction of the ith VOC with ox * * - kwyld(i,j) : yield of the jth product for the reaction of the * * ith VOC with ox * ************************************************************************ SUBROUTINE rdkwreact(filename, & nkwdat,nkwpd,kwrct,kwpd,kwcopd,kwyld) IMPLICIT NONE INCLUDE 'general.h' * input CHARACTER(LEN=llin) filename * output INTEGER nkwdat,nkwpd(mkr) REAL kwyld(mkr,mnr) CHARACTER(LEN=lfo) :: kwrct(mkr),kwpd(mkr,mnr) CHARACTER(LEN=lco) :: kwcopd(mkr,mnr,mcp) * local : CHARACTER*200 line REAL yield INTEGER i,j,k,n1,n2,ndat,ncop,istart,iend CHARACTER(LEN=lsb) :: progname='*rdkwreact* ' CHARACTER(LEN=ler) :: mesg !---------------- * initialize !---------------- nkwdat = 0 kwrct=' ' kwpd=' ' kwyld=0. kwcopd=' ' * open the file !OPEN(10,FILE=filename, FORM='FORMATTED',STATUS='OLD') OPEN(10,FILE=filename,STATUS='OLD') * read the data DO 10 i=1,10000 READ (10,'(a)',end=222) line IF (line(1:3).eq.'END') GOTO 20 IF (line(1:1).eq.'*') GOTO 10 * check that the line is correctly formatted n1=index(line,':') IF (n1.eq.0) THEN WRITE (6,'(a)') line mesg = ' character ":" not found at quoted line' CALL errexit(progname,mesg,filename(1:40)) ENDIF nkwdat=nkwdat+1 IF (nkwdat.GE.mkr) THEN mesg = 'number of reactions is greater than mkr' CALL errexit(progname,mesg,filename(1:40)) ENDIF * read reactant(s) and the number of products to be read kwrct(nkwdat) = ADJUSTL(line(1:n1-1)) READ(line(n1+1:) ,*,err=440) ndat CALL stdchm(kwrct(nkwdat)) nkwpd(nkwdat) = ndat * loop over the products DO 30 j=1,ndat READ (10,'(a)',end=222) line n1=index(line,':') IF (n1.eq.0) THEN WRITE (6,'(a)') line mesg = ' character ":" not found at quoted line' CALL errexit(progname,mesg,filename(1:40)) ENDIF * count the number of coproducts ncop=0 DO k=n1+1,200 IF (line(k:k).eq.'+') ncop=ncop+1 ENDDO IF (ncop.gt.mcp) THEN WRITE (6,'(a)') line mesg = ' number of coproducts is greater than mcp' CALL errexit(progname,mesg,filename(1:40)) ENDIF * read the yield and the 'main' product READ (line(1:n1-1),*,err=444) kwyld(nkwdat,j) IF (ncop.eq.0) THEN kwpd(nkwdat,j) = line(n1+2:) ELSE n2=index(line,'+') kwpd(nkwdat,j) = line(n1+2:n2-1) * read the coproduct (if any) istart=n2 DO k=1,ncop iend=index(line(istart+1:),'+') iend=istart+iend IF (iend.eq.istart) iend=200 kwcopd(nkwdat,j,k) = line(istart+2:iend-1) istart=iend ENDDO ENDIF * check for extra space - be sure the line was corretly formatted ! IF (kwpd(nkwdat,j)(1:1).ne.'C') THEN ! WRITE (6,'(a)') line ! mesg = ' the prod. formula does not begin with C' ! CALL errexit(progname,mesg,filename(1:40)) ! ENDIF ! TEST REMOVED IN CASE OF O3 REACTION, OH CAN BE A MAIN PRODUCT CALL stdchm(kwpd(nkwdat,j)) IF (ncop.gt.0) THEN DO k=1, ncop IF (kwcopd(nkwdat,j,k)(1:1).eq.' ') THEN WRITE (6,'(a)') line mesg = ' the coprod. formula begins with " " ' CALL errexit(progname,mesg,filename(1:40)) ENDIF ENDDO ENDIF 30 CONTINUE 10 CONTINUE 20 CONTINUE CLOSE(10) * check that sum of yields for all channels = 1.0 (tolerance = 0.0001) * THIS TEST HAS BEEN REMOVED FOR THE OZONE FORCED REACTION ! DO i=1,nkwdat ! yield=0. ! DO j=1,mnr ! yield=yield+kwyld(i,j) ! ENDDO ! IF (yield.LT.0.9999.OR.yield.GT.1.0001) THEN ! WRITE (6,'(a)') 'file :',filename(1:40) ! mesg = ' sum of channel yields is not equal to 1' ! CALL errexit(progname,mesg,kwrct(i)(1:25)) ! ENDIF ! ENDDO RETURN * error report 222 WRITE(6,*) '--error222--, while reading oh_rate.dat' WRITE(6,*) ' , keyword END not found' STOP 333 WRITE (6,'(a)') '--error333--, in rdkwreac' WRITE (6,'(a)') ' while reading file :',filename(1:40) WRITE (6,'(a)') ' species can not be read at line' WRITE (6,'(a)') line STOP 440 WRITE (6,'(a)') '--error440--, in rdkwreac' WRITE (6,'(a)') ' while reading file :',filename(1:40) WRITE (6,'(a)') ' number of product can not read at line:' WRITE (6,'(a)') line STOP 444 WRITE (6,'(a)') '--error444--, in rdkwreac' WRITE (6,'(a)') ' while reading file :',filename(1:40) WRITE (6,'(a)') ' yield can not be read at line:' WRITE (6,'(a)') line STOP 555 WRITE (6,'(a)') '--error555--, in rdkwreac' WRITE (6,'(a)') ' while reading file :',filename(1:40) WRITE (6,'(a)') ' product can not be read at line:' WRITE (6,'(a)') line STOP 666 WRITE (6,'(a)') '--error666--, in rdkwreac' WRITE (6,'(a)') ' while reading file :',filename(1:40) WRITE (6,'(a)') ' coproduct can not be read at line:' WRITE (6,'(a)') line STOP END