************************************************************************ * PROGRAM cod2form * * * * PURPOSE : read the chemical scheme given as output by the generator * * (i.e. using the 6 characters name for the species) and * * provide as output the chemical using the chemical formula * * of the various species * * * * INPUT (files): * * - fort.7 : dictionnary provided by the generator's output * * - fort.17 : list of reactions provided by the generator's output * * - general.h : size of various parameters in the generator * * * * OUTPUT (file): * * - scheme.out : chemical scheme using the chemical formula * * * * WARNING: * * The program assume that the reactions are given in a fixed format. * * Inorganic reactions as well as the C1 reactions are provided in a * * different format and the program may produce no sense results for * * these reactions * * * ************************************************************************ PROGRAM cod2form IMPLICIT NONE INCLUDE 'general.h' CHARACTER*(lco) name(mni) CHARACTER*(lfo) chem(mni) CHARACTER*12 toto CHARACTER*(lco+1) r1,r2,r3,p1,p2,p3,p4 CHARACTER*(lco) iname CHARACTER*2 c2 CHARACTER*300 line,line1 CHARACTER*6 sc1,sc2,sc3,sc4 REAL ar1,ar2,ar3,f298,fratio CHARACTER*(ldi) dicto(mni) INTEGER i,j,nspec,nr,ind,srh5,nc,pos * ---------------- * OPEN FILES * ---------------- OPEN(10,FILE='fort.17',STATUS='OLD') OPEN(20,FILE='fort.7',STATUS='OLD') OPEN(66,FILE='scheme.out') WRITE(66,12)'A','n','E/R','REACTIONS' 12 FORMAT(1X,A1,10X,A1,4X,A3,8X,A9) * ---------------- * READ DICTIONNARY * ---------------- nspec=0 DO i=1,mni READ(20,'(A120)',END=50)dicto(i) ENDDO 50 CONTINUE nspec=i-2 CALL dctsort(nspec,dicto) DO i=1,nspec READ(dicto(i),'(a6,3x,a100,a12)') name(i),chem(i),toto ENDDO * ---------------- * READ REACTION * ---------------- nr=0 10 READ(10,'(a)',END=51) line1 IF (line1(1:1).eq.'/') THEN WRITE(66,'(a)') line1 GOTO 10 ENDIF IF (line1(1:5).eq.' LOW') THEN WRITE(66,'(a)') line1 GOTO 10 ENDIF IF (line1(1:6).eq.' TROE') THEN WRITE(66,'(a)') line1 GOTO 10 ENDIF IF (line1(1:4).eq.' HV') THEN WRITE(66,'(a)') line1 GOTO 10 ENDIF READ(line1,101) R1,R2,R3, & C2,SC1,P1,SC2,P2,SC3,P3,SC4,P4,ar1,ar2,ar3 nr=nr+1 line=' ' pos=1 101 FORMAT(3(A7,1X),A2,4(A5,1X,A7,2X),4X,E10.3,1X,f4.1,1X,f7.0) * ---------------- * WRITE REACTION * ---------------- * rate constant WRITE(line(1:10),'(E10.3)') ar1 WRITE(line(11:14),'(f4.1)') ar2 WRITE(line(15:21),'(f7.0)') ar3 WRITE(line(22:23),'(a3)') ' : ' pos=25 * first reactant IF (r1(1:1).eq.'G') THEN iname=r1(2:) ELSE iname=r1 ENDIF ind=srh5(iname,name,nspec) IF (ind.le.0) THEN nc=INDEX(r1,' ') line(pos:pos+nc-1)=r1(1:nc-1) pos=pos+nc ELSE nc=INDEX(chem(ind),' ') line(pos:pos+nc-1)=chem(ind)(1:nc-1) pos=pos+nc-1 ENDIF * second reactant IF (r2(1:1).EQ.' ') GOTO 20 IF (r2(1:1).eq.'G') THEN iname=R2(2:) ELSE iname=R2 ENDIF line(pos:pos+3)=' + ' pos=pos+3 ind=srh5(iname,name,nspec) IF (ind.le.0) THEN nc=INDEX(r2,' ') line(pos:pos+nc-1)=r2(1:nc-1) pos=pos+nc ELSE nc=INDEX(chem(ind),' ') line(pos:pos+nc-1)=chem(ind)(1:nc-1) pos=pos+nc-1 ENDIF 20 CONTINUE * third reactant IF (r3(1:1).EQ.' ') GOTO 30 IF (r3(1:1).eq.'G') THEN iname=R3(2:) ELSE iname=R3 ENDIF line(pos:pos+3)=' + ' pos=pos+3 ind=srh5(iname,name,nspec) IF (ind.le.0) THEN nc=INDEX(r3,' ') line(pos:pos+nc-1)=r3(1:nc-1) pos=pos+nc ELSE nc=INDEX(chem(ind),' ') line(pos:pos+nc-1)=chem(ind)(1:nc-1) pos=pos+nc-1 ENDIF 30 CONTINUE * reaction arrow line(pos:pos+4) = ' => ' pos=pos+4 * first product IF (p1(1:1).EQ.' ') GOTO 200 IF (p1(1:1).eq.'G') THEN iname=p1(2:) ELSE iname=p1 ENDIF ind=srh5(iname,name,nspec) IF (sc1.NE.' ') THEN IF (sc1(2:2).EQ.' ') sc1(2:2)='0' line(pos:pos+5)=sc1 line(pos+6:pos+6)=' ' pos=pos+6 ENDIF IF (ind.le.0) THEN nc=INDEX(p1,' ') line(pos:pos+nc-1)=p1(1:nc-1) pos=pos+nc ELSE nc=INDEX(chem(ind),' ') line(pos:pos+nc-1)=chem(ind)(1:nc-1) pos=pos+nc ENDIF 200 CONTINUE * second product IF (p2(1:1).EQ.' ') GOTO 210 IF (p2(1:1).eq.'G') THEN iname=p2(2:) ELSE iname=p2 ENDIF ind=srh5(iname,name,nspec) IF (sc2.NE.' ') THEN IF (sc2(1:1).EQ.' ') sc2(1:1)='+' IF (sc2(2:2).EQ.' ') sc2(2:2)='0' line(pos:pos+5)=sc2 line(pos+6:pos+6)=' ' pos=pos+6 ELSE line(pos:pos+1)='+ ' pos=pos+2 ENDIF IF (ind.le.0) THEN nc=INDEX(p2,' ') line(pos:pos+nc-1)=p2(1:nc-1) pos=pos+nc ELSE nc=INDEX(chem(ind),' ') line(pos:pos+nc-1)=chem(ind)(1:nc-1) pos=pos+nc ENDIF 210 CONTINUE * third product IF (p3(1:1).EQ.' ') GOTO 220 IF (p3(1:1).eq.'G') THEN iname=p3(2:) ELSE iname=p3 ENDIF ind=srh5(iname,name,nspec) IF (sc3.NE.' ') THEN IF (sc3(1:1).EQ.' ') sc3(1:1)='+' IF (sc3(2:2).EQ.' ') sc3(2:2)='0' line(pos:pos+5)=sc3 line(pos+6:pos+6)=' ' pos=pos+6 ELSE line(pos:pos+1)='+ ' pos=pos+2 ENDIF IF (ind.le.0) THEN nc=INDEX(p3,' ') line(pos:pos+nc-1)=p3(1:nc-1) pos=pos+nc ELSE nc=INDEX(chem(ind),' ') line(pos:pos+nc-1)=chem(ind)(1:nc-1) pos=pos+nc ENDIF 220 CONTINUE * forth product IF (p4(1:1).EQ.' ') GOTO 230 IF (p4(1:1).eq.'G') THEN iname=p4(2:) ELSE iname=p4 ENDIF ind=srh5(iname,name,nspec) IF (sc4.NE.' ') THEN IF (sc4(1:1).EQ.' ') sc4(1:1)='+' IF (sc4(2:2).EQ.' ') sc4(2:2)='0' line(pos:pos+5)=sc4 line(pos+6:pos+6)=' ' pos=pos+6 ELSE line(pos:pos+1)='+ ' pos=pos+2 ENDIF IF (ind.le.0) THEN nc=INDEX(p4,' ') line(pos:pos+nc-1)=p4(1:nc-1) pos=pos+nc ELSE nc=INDEX(chem(ind),' ') line(pos:pos+nc-1)=chem(ind)(1:nc-1) pos=pos+nc ENDIF 230 CONTINUE * ---------------- * WRITE CURRENT REACTION AND READ NEXT * ---------------- WRITE (66,'(a)') line GOTO 10 * ---------------- * END OF REACTIOSN * ---------------- 51 CONTINUE WRITE(*,*) 'nr=',nr END ************************************************************* * SUBROUTINE : simple bubble sort ************************************************************* SUBROUTINE dctsort(ns,s) IMPLICIT NONE INCLUDE 'general.h' * input/output INTEGER ns CHARACTER*(ldi) s(ns) * internal CHARACTER*(ldi) store INTEGER i,j 20 i=1 30 j=i+1 IF (s(i).LE.s(j)) GO TO 10 store = s(j) s(j) = s(i) s(i) = store i = i-1 IF (i.EQ.0) GO TO 20 GO TO 30 10 IF (j.EQ.ns) GO TO 40 i = i + 1 GO TO 30 40 RETURN END ********************************************************* * FUNCTION : search entry in the list ************************************************************* INTEGER FUNCTION srh5(aseek,alist,nlist) IMPLICIT NONE INCLUDE 'general.h' * input: INTEGER nlist CHARACTER*(lco) aseek, alist(nlist) * internal: INTEGER jhi, jlo, jold, j * initialize: srh5 = 0 jold = 0 jlo = 1 jhi = nlist + 1 10 j = (jhi+jlo)/2 IF(j.EQ.jold) GO TO 40 jold = j IF(aseek.GT.alist(j)) GO TO 20 IF(aseek.EQ.alist(j)) GO TO 30 jhi = j GO TO 10 20 jlo = j go to 10 30 srh5 = j RETURN 40 srh5 = -j * end of SRH5 RETURN END