************************************************************************ * MASTER MECHANISM - ROUTINE NAME : rdfixmch * * * * PURPOSE: read fixed chemical scheme (e.g. inorganic chemistry) * * * * INPUT: name of the file to be read * * * * OUTPUT: none - the reactions in "filename" are just read and copied * * in mechanism given in the output (unit lout) * * * * NOTE: This is a very preliminary version - species names in * * filename may not exist in the dictionnary. This point need * * to be checked in future version. * ************************************************************************ SUBROUTINE rdfixmch(filename) IMPLICIT NONE INCLUDE 'general.h' * input CHARACTER(LEN=llin) filename * local CHARACTER(LEN=100) line, line1, line2 INTEGER label, lout REAL A,n,E,m, fact REAL one, zero REAL F0_300, Finf_300,E0,Einf REAL Fc1, Fc2, Fc3, Fc4 INTEGER n1,n2 CHARACTER(LEN=80) reaction,info INTEGER i,iunit CHARACTER(LEN=4) oxid * initialize one=1. zero=0. lout=17 * open the file OPEN (10,FILE=filename,STATUS='OLD') !,FORM='FORMATTED') * read next line 10 READ (10,'(a)',end=222) line IF (line(1:1).eq.'*') GOTO 10 IF (line(1:3).eq.'END') GOTO 20 * check fall off reaction * ----------------------- IF (INDEX(line,'(+M)').NE.0) THEN * check that the reaction is correctly formatted n1 = INDEX(line,':') n2 = INDEX(line,';') IF (n1.eq.0) THEN WRITE(6,*) '--error1--, while reading in ', filename WRITE(6,*) line STOP ENDIF IF (n2.eq.0) THEN WRITE(6,*) '--error2--, while reading in ', filename WRITE(6,*) line STOP ENDIF READ(line(n1+1:n2-1),*,err=666) Fc1, Fc2, Fc3, Fc4 reaction = line(1:n1-1) line(n2:n2)='/' info=line(n1+1:n2) READ(10,'(a)')line1 READ(line1,*,err=667) F0_300, n, E0 READ(10,'(a)')line2 READ(line2,*,err=668) Finf_300, m, Einf * write reaction to the output file WRITE(lout,100) reaction,Finf_300,-m,Einf WRITE(lout,120) 'LOW /',F0_300,-n,E0,'/' 120 FORMAT (2X,A6,ES10.3,1X,f4.1,1X,f7.0,A1) line=' TROE /' // info c WRITE(lout,'(a)') ' TROE /',info(1:n2-n1),'/' WRITE(lout,'(a)') line * check extra reaction * -------------------- ELSE IF (INDEX(line,'EXTRA').NE.0) THEN * check that the reaction is correctly formatted n1 = INDEX(line,':') n2 = INDEX(line,';') IF (n1.eq.0) THEN WRITE(6,*) '--error1--, while reading in ', filename WRITE(6,*) line STOP ENDIF IF (n2.eq.0) THEN WRITE(6,*) '--error2--, while reading in ', filename WRITE(6,*) line STOP ENDIF reaction = line(1:n1-1) READ(line(n1+1:100),*,err=776) A, n, E READ (10,'(a)') line1 n1 = INDEX(line1,':') n2 = INDEX(line1,';') IF (n1.eq.0) THEN WRITE(6,*) '--error1--, while reading in ', filename WRITE(6,*) line WRITE(6,*) line1 STOP ENDIF IF (n2.eq.0) THEN WRITE(6,*) '--error2--, while reading in ', filename WRITE(6,*) line WRITE(6,*) line1 STOP ENDIF READ (line1(1:n1-1),*,err=777) label line1(n2:n2)='/' info=' ' info=ADJUSTL(line1(n1+1:n2)) * write reaction to the output file WRITE(lout,100) reaction,A,n,E WRITE(lout,140)'EXTRA /',label,info 140 FORMAT(2X,A7,i4,1X,A50) * check photolytic reaction * ------------------------- ELSE IF (INDEX(line,'HV').NE.0) THEN * check that the reaction is correctly formatted n1 = INDEX(line,':') n2 = INDEX(line,';') IF (n1.eq.0) THEN WRITE(6,*) '--error1--, while reading in ', filename WRITE(6,*) line STOP ENDIF IF (n2.eq.0) THEN WRITE(6,*) '--error2--, while reading in ', filename WRITE(6,*) line STOP ENDIF reaction = line(1:n1-1) READ(line(n1+1:n2-1),*,err=876) label, fact * write reaction to the output file WRITE(lout,100) reaction,one,zero,zero WRITE(lout,'(A6,i5,1x,f5.2,A1)') ' HV /',label,fact,'/' * otherwise thermal reaction * --------------------------- ELSE n1 = INDEX(line,':') n2 = INDEX(line,';') IF (n1.eq.0) THEN WRITE(6,*) '--error1--, while reading in ', filename WRITE(6,*) line STOP ENDIF IF (n2.eq.0) THEN WRITE(6,*) '--error2--, while reading in ', filename WRITE(6,*) line STOP ENDIF reaction = line(1:n1-1) READ(line(n1+1:n2-1),*,err=976) A,n,E * write reaction to the output file WRITE(lout,100) reaction,A,n,E 100 FORMAT(A70,19X,ES10.3,1X,f4.1,1X,f7.0) * write OH/NO3/O3 fixed-mech reaction rates to units 70/71/72 IF(INDEX(filename,"inorg").EQ.0)THEN DO i = 1,3 iunit = 69+i n1 = 0 n2 = 0 SELECT CASE(i) CASE (1) oxid = "GO3 " CASE (2) oxid = "GNO3" CASE (3) oxid = "GHO " END SELECT n1 = INDEX(reaction,oxid) n2 = INDEX(reaction,'=>') IF(n1.GT.0.AND.n1.LT.n2)THEN n2 = INDEX(reaction,' ') WRITE(iunit,*) reaction(2:n2-1),' ',A,n,E!,' ',reaction ENDIF ENDDO ENDIF * checked all types of reactions ENDIF GOTO 10 * end of file 20 CONTINUE CLOSE(10) RETURN * stop error 222 WRITE(6,*) '--error222--, while reading in ', filename WRITE(6,*) 'keyword end not found' STOP 666 WRITE(6,*) '--error666--, while reading in ', filename WRITE(6,*) line STOP 668 WRITE(6,*) '--error667--, while reading in ', filename WRITE(6,*) line WRITE(6,*) line1 STOP 667 WRITE(6,*) '--error668--, while reading in ', filename WRITE(6,*) line WRITE(6,*) line1 WRITE(6,*) line2 STOP 776 WRITE(6,*) '--error776--, while reading in ', filename WRITE(6,*) line STOP 777 WRITE(6,*) '--error777--, while reading in ', filename WRITE(6,*) line WRITE(6,*) line1 STOP 876 WRITE(6,*) '--error876--, while reading in ', filename WRITE(6,*) line STOP 976 WRITE(6,*) '--error976--, while reading in ', filename WRITE(6,*) line STOP END