C =====================================================================| C Program VOLCAL | C | C Modified from program GEOCAL (N.F. Spycher and M.H. Reed, | C 1988). Modifications beginning 2/92 by R. Symonds | C | C This program has been made to create input files for program | C SOLVGAS and GASWORKS. This program allows the user to make | C unit conversions. | C | C The I/O device unit numbers of read and write statements | C should correspond to the correct disks file names. To run | C VOLCAL on the mainframe, these files must be assigned | C prior to running the program. In this version, unit numbers | C are explicitly assigned to filenames in the code. | C The values of the I/O unit numbers are assigned to I/O variables | C in the block data. The I/O variables correspond to the following | C files: | C | C IOUT1: Created SOLVGAS input file: GASRUN.DAT | C IOUT2: Created GASWORKS input file: WORKRUN.DAT | C IOUT3: Output data from this program | C INP2 : Gas stoichiometry data | C INP4 : Component species from GASTHERM | C | C Main arrays and variables | C | C coef(N,I) : Stochiometric coefficient of species I in gas N | C Gas : Input gas analysis, reset to mole % for output | C GasTOT : Total moles of gas | C GWF : Weight percent of gas species | C Gmol : Moles of gas species | C GWT : Weight of gas species in grams | C GSmol : Total amount of component species in moles | C GSMLY : Total amount of component species in grams | C GSppm : Total amount of component species in ppm | C GMW : Molecular weight of gas species | C GName : Name of gas species | C IOUT : Output unit numbers | C INP : Input device numbers | C ISPEC(N,I) : Component species I in gas N | C ISTOC(N) : Total # of component species in gas N. Must | C be 0 if no stoichiometry is available | C NG : Total # of gases read in gas file | C NGS : # of component species in solution with gases | C added or subtracted. | C =====================================================================| C ---------------------------------------------------------------------| C * Block Data * | C ---------------------------------------------------------------------| Block Data Implicit double precision (A-H,O-Z) Integer BG1,BG2 Parameter (BG1=100,BG2=50) Integer ICONV, IGSAQ(BG2) Integer INP2, INP3, INP4 Integer IOUT1, IOUT2, IOUT3 Integer ISPEC(BG1,7), NGS, NSTOT Character * 8 GName(BG1), Title(20) Double precision GSppm(BG2), coef(BG1,7) Double precision Gas(BG1), GWT(BG1), Gmol(BG1), GasTOT, GMW(BG1) Double precision GSMLY(BG2), GSmol(BG2), GWF(BG1), Try(BG2) Common /Input / INP2, INP3, INP4 Common /Outpu / IOUT1, IOUT2, IOUT3 Common /Gases / Gas, GWF, GWT, Gmol, GSmol, GasTOT, GSMLY, GMW, & GName, coef, ISPEC, IGSAQ, Try, GSppm Common /Autre / Title, ICONV, NSTOT, NGS Data IOUT1, IOUT2, IOUT3 /8, 9, 10/ Data INP2, INP3, INP4 /1, 2, 3/ Data GSppm /BG2*0.0/ Data Gas /BG1*0.0/ Data GWT /BG1*0.0/ Data Gmol /BG1*0.0/ Data GMW /BG1*0.0/ Data GName /BG1*'NONE '/ Data GSMLY /BG2*0.0/ Data GSmol /BG2*0.0/ Data GWF /BG1*0.0/ Data IGSAQ /BG2*0/ Data Title /20*' '/ Data Try /BG2*0.0/ End Program VOLCAL C =====================================================================| C Main program | C This program converts a gas analysis to mole units. | C to moles units and vice versa for given gases. | C Gas data such as name, mol. wt. and stochiometry are read in | C a file similar in format to the GASTHERM data file. | C The major gas analysis has to be: | C - In mole % | C or | C - In moles of gas | C | C The trace elements must be in: | C - In mole % | C - In moles of gas | C or | C - In ppm in condensate | C ---------------------------------------------------------------------| Implicit double precision (A-H,O-Z) Integer BG1,BG2 Parameter (BG1=100,BG2=50) Integer I, ICONV, ICHLOR, ICOR(10), IFLUOR, IGSAQ(BG2), II, III Integer INORM,INP1, INP2, INP3, INP4 Integer IOUT1, IOUT2, IOUT3, IOUT4 Integer ISPEC(BG1,7), ISTOC(BG1), ITOT,N,NG,NG3 Integer NGas,NGS, NSTOT, NSTOT1, NTrace, NTR3, ITrace Integer PGas(BG1),PTrace(BG2) Character * 1 ANS Character * 3 STA(BG1) Character * 8 Blank,CFT,CName(BG2),Dummy,GName(BG1) Character * 8 Title(20) Double precision GSppm(BG2),CMW(BG2),coef(BG1,7) Double precision Corr(BG2),CTrace(BG2),Gas(BG1),GWT(BG1) Double precision Gmol(BG1),GasTOT,GMW(BG1),GSMLY(BG2) Double precision GSmol(BG2),GWF(BG1) Double precision TOTM,TOTMP,TOTW,Try(BG2) Common /Input / INP2, INP3, INP4 Common /OUTPU / IOUT1, IOUT2, IOUT3 Common /Gases / Gas, GWF, GWT, Gmol, GSmol, GasTOT, GSMLY, GMW, & GName, coef, ISPEC, IGSAQ, Try, GSppm Common /AUTRE / Title, ICONV, NSTOT, NGS Data CTrace /BG2*0.0/ Data CName /BG2*'NONE '/ Data Corr /BG2 * 0.0/ Data ICHLOR /0/ Data IFLUOR /0/ Data ICOR /10 * 0 / Data ISTOC /BG1 * 0 / Data Blank /' '/ Data CFT /'********'/ Data PGas /BG1*BG1/ Data PTrace /BG2*BG2/ Data STA /BG1*' '/ DO 8 J = 1,7 DO 7 I = 1,BG1 coef(I,J) = 0.0 7 ISPEC(I,J) = 0 8 Continue C----------------------------------------------------------------------| C Here are some of the filename assignments, others are located | C with the write statements. All these open statements | C can be disabled for use in a mainframe environment | C where more flexibility in file names and locations can be | C achieved by making filespec assignments at run-time. | C (with an 'EXEC' file (IBM), '.com' file (dec), etc.) | C ---------------------------------------------------------------------| Open (IOUT3, File = 'volout.dat') Open (INP4 , File = 'gastherm.dat', STATUS = 'old') Open (INP2 , File = 'gascal.sto', STATUS = 'old') WRITE (*, 501) 'Program VOLCAL ' 501 Format (/30X, A, //) 1 Continue Write (*, 503) 503 Format (//5X, 'Enter highest index number of component species', & /,5X,'To be used from the GASTHERM file'/) Read (*, *) NSTOT NSTOT1 = NSTOT + 1 C ---------------------------------------------------------------------| C Note: NSTOT is the highest index number of component species to | C be used from the GASTHERM data file. It must be no | C larger than the total number of available component | C species (currently 42), but may be smaller. For example, | C if your system does not include any species with an index | C number higher than 7 (HBr), you can enter 7 (HBr) for | C NSTOT to avoid being prompted for NaCl, KCl, etc. | C ---------------------------------------------------------------------| If (NSTOT .GT. 42) go to 1 C ---------------------------------------------------------------------| C Skips comments until the list of component species, and then | C reads names and molecular weights of component species. | C ---------------------------------------------------------------------| 3 Continue Read (INP4, 705, End = 2) Dummy If (Dummy .eq. CFT) go to 4 go to 3 2 Continue Write (*, 502) 502 Format (//5X, 'Cannot find "CFT " Record in GASTHERM file'/) STOP 4 Continue DO 5 I = 1, NSTOT Read (INP4, 740) GName(I), GMW(I), CName(I), CMW(I) coef(I,1) = 1.0 ISTOC(I) = 1 ISPEC(I,1) = I 5 Continue C ---------------------------------------------------------------------| C Start input data | C ---------------------------------------------------------------------| Write (*, 505) 505 Format (///5X, 'Input title, two lines maximum',/) Read (*, 705) Title Write (IOUT3, 850) Title C ---------------------------------------------------------------------| C Read gas name, mol.wt. and stochiometry in gas data file. | C Read until eof of blank name (line) | C ---------------------------------------------------------------------| N = NSTOT+1 10 Continue Read (INP2, 710, End = 114) GName(N), ITOT, & (coef(N,I), ISPEC(N,I), I = 1, ITOT-1) If (GName(N) .eq. Blank) go to 111 ITOT = ITOT-1 DO 109 I = 1,ITOT GMW(N) = GMW(N) + GMW(ISPEC(N,I))*coef(N,I) 109 Continue ISTOC(N) = ITOT N = N + 1 go to 10 111 Continue GName(N) = 'None ' 114 Continue NG = N - 1 If (NG .NE. 0) go to 12 Write (*, 504) 'Warning. Gas data file is empty or ', & 'Unassigned !' 504 Format (//5X, A, A, //) STOP 12 Continue C----------------------------------------------------------------------| C Input the type of analysis | C----------------------------------------------------------------------| Write (*, 490) 490 Format (/,5X, 'Is the analysis in:', & //,5X, ' (1) mole % for all species', & //,5X, ' (2) moles for all species', & //,5X, ' (3) mole % for major gases and', & /,5X ' ppm in condensate for trace elements,' & //,5X, ' (4) moles for major gases and', & /,5X, ' ppm in condensate for trace elements?'/) Read (*,*) ITrace If (ITrace.eq.1.OR.ITrace.eq.3) then ICONV = 1 else ICONV = 2 INORM = 1 Write (*,516) 516 Format (/5X, 'Do you want to normalize the analysis to 1.0 mole', 1 ' of gas?'/) Read (*,'(A1)') ANS If(ANS.eq.'N'.OR.ANS.eq.'n') INORM = 0 EndIf If (NSTOT.LE.6.OR.ITrace.LT.3) go to 14 C----------------------------------------------------------------------| C Read the condensate analysis and print it out to check it | C----------------------------------------------------------------------| Write (*, 500) 500 Format (/5X, 'Enter the condensate analysis' /) NTrace = 0 DO 115 I = 4,NSTOT If (I.eq.37) then go to 115 Else if (I.eq.4) then CName(4) = 'SO4 ' CMW(4) = 2*CMW(2) + CMW(4) EndIf Write (*,515) CName (I) Read (*, *) CTrace(I) NTrace = NTrace + 1 PTrace(NTrace) = I 115 Continue 116 Continue NTR3 = NTrace/3 If(MOD(NTrace,3).NE.0) NTR3 = NTR3 + 1 Write (IOUT3,511) Write (*,511) DO 117 I = 1, NTR3 II = I + NTR3 III = I + 2*NTR3 Write (*, 525) I, CName(PTrace(I)), CTrace(PTrace(I)), II, & CName(PTrace(II)), CTrace(PTrace(II)), III, CName(PTrace(III)), & CTrace(PTrace(III)) Write (IOUT3, 525) I, CName(PTrace(I)), CTrace(PTrace(I)), II, & CName(PTrace(II)), CTrace(PTrace(II)), III, CName(PTrace(III)), & CTrace(PTrace(III)) 117 Continue Write (IOUT3,520) Write (*, 530) Read (*, 715) ANS If (ANS .NE. 'Y' .and. ANS .NE. 'y') go to 14 C ---------------------------------------------------------------------| C In case of corrections | C ---------------------------------------------------------------------| Write (*, 435) 435 Format(/5X,'Enter indices of elements to be corrected,' & ' Slash to end',/) Read (*, *) (ICOR(I), I = 1, 10) DO 25 I = 1, 10 If (ICOR(I) .eq. 0) go to 116 ICOR(I) = PTrace(ICOR(I)) If (ICOR(I) .GT. NSTOT) go to 116 Write (*, 440) CName(ICOR(I)), CTrace(ICOR(I)) 440 Format (//5X, A4, ' Old value:', E12.5, /, 5X, 'Enter new value:') Read (*, *) CTrace(ICOR(I)) ICOR(I) = 0 25 Continue C ---------------------------------------------------------------------| C Read gas analysis in mole percent or moles and print it out to | C check it | C ---------------------------------------------------------------------| 14 Write (*, 509) 509 Format (//5X, 'Enter the gas analysis' /) NGas = 0 DO 20 I = 1, NG If (I.GT.6.and.I.LE.NSTOT.and.I.NE.37.and.ITrace.GT.2) go to 20 Write (*, 515) GName(I) Read (*, *) Gas(I) NGas = NGas + 1 PGas(NGas) = I 20 Continue 135 Continue Write (*, '(/)') TOTMP = 0.0 DO 30 I = 1, NG TOTMP = TOTMP + Gas(I) 30 Continue If (ICONV.eq.1) then Write(IOUT3,518) Write(*,518) else Write(IOUT3,519) Write(*,519) EndIf NG3 = NGas/3 If(MOD(NGas,3).NE.0) NG3 = NG3 + 1 DO 37 I = 1, NG3 II = I + NG3 III = I + 2*NG3 Write (*, 525) I,GName(PGas(I)),Gas(I),II,GName(PGas(II)), & Gas(PGas(II)),III,GName(PGas(III)), Gas(PGas(III)) Write (IOUT3, 525) I,GName(PGas(I)),Gas(I),II,GName(PGas(II)), & Gas(PGas(II)),III,GName(PGas(III)), Gas(PGas(III)) 37 Continue If (TOTMP.NE.100.0.and.ICONV.eq.1) Write (*, 526) TOTMP If (TOTMP.NE.100.0.and.ICONV.eq.1) Write (IOUT3, 526) TOTMP Write (IOUT3,520) Write (*, 530) 511 Format(//5X,'Here is the condensate analysis in ppm',/) 515 Format(/5X, A8, 2X) 518 Format (//5X,'Here is the raw gas analysis in mole percent',/) 519 Format (//5X,'Here is the raw gas analysis in moles',/) 520 Format(/) 525 Format (2X, 3(I2, 1X, A8, ': ', E10.5, 2X)) 526 Format (/7X, 'Warning !!! mole % does not add to 100%!!!'/ & 15X, 'Total= ', F10.4) 530 Format(/5X,'Do you want to correct anything ?'/) Read (*, 715) ANS If (ANS .NE. 'Y' .and. ANS .NE. 'y') go to 120 C ---------------------------------------------------------------------| C In case of corrections | C ---------------------------------------------------------------------| Write (*, 535) 535 Format(/5X,'Enter indices of gases to be corrected, slash to end', & /) Read (*, *) (ICOR(I), I = 1, 10) DO 35 I = 1, 10 If (ICOR(I) .eq. 0 .OR. ICOR(I) .GT. NG) go to 135 ICOR(I) = PGas(ICOR(I)) If (ICOR(I).GT.NG) go to 135 Write (*, 540) GName(ICOR(I)), Gas(ICOR(I)) 540 Format (//5X, A4, ' Old value:', E12.5, /, 5X, 'Enter new value:') Read (*, *) Gas(ICOR(I)) ICOR(I) = 0 35 Continue 120 Continue If (ITrace.LT.3) go to 130 C ---------------------------------------------------------------------| C Add the trace element data and ajust mass balances of Cl and F | C ---------------------------------------------------------------------| CTrace(2) = 1000000. DO 118 I = 4,NSTOT If (I.eq.37) go to 118 CTrace(2) = CTrace(2) - CTrace(I) CTrace(I) = CTrace(I)/CMW(I) 118 Continue CTrace(2) = CTrace(2)/(2*CMW(1)+CMW(2)) DO 26 I = 7, NSTOT If (I.eq.37) go to 26 Gas(I) = CTrace(I)*Gas(2)/CTrace(2) If (I.eq.8.or.I.eq.9.or.I.eq.14.or.I.eq.32.or.I.eq.33.or.I.eq.34 & .or.I.eq.39) then Gas(5) = Gas(5) - Gas(I) ICHLOR = 1 Else if (I.eq.10.or.I.eq.11.or.I.eq.16.or.I.eq.22.or.I.eq.23.or. & I.eq.26.or.I.eq.27.or.I.eq.28.or.I.eq.30.or.I.eq.38) then Gas(5) = Gas(5) - 2*Gas(I) ICHLOR = 1 Else if (I.eq.15.OR.I.eq.19.OR.I.eq.20.OR.I.eq.31) then Gas(5) = Gas(5) - 3*Gas(I) ICHLOR = 1 Else if (I.eq.25.OR.I.eq.29) then Gas(5) = Gas(5) - 4*Gas(I) ICHLOR = 1 Else if (I.eq.13) then Gas(6) = Gas(6) - 3*Gas(I) IFLUOR = 1 Else if (I.eq.21.OR.I.eq.24) then Gas(6) = Gas(6) - 4*Gas(I) IFLUOR = 1 EndIf 26 Continue If (ICHLOR.eq.1) STA(5) = 'CM ' If (IFLUOR.eq.1) STA(6) = 'CM ' 130 Continue If (ICONV .NE. 1) go to 150 C ---------------------------------------------------------------------| C Converts analysis from moles% to 1.0 mole of gas | C ---------------------------------------------------------------------| GasTOT = 0.0 TOTM = 0.0 TOTW = 0.0 DO 38 I = 1,NG Gmol(I) = Gas(I) GWT(I) = Gmol(I) * GMW(I) TOTW = TOTW + GWT(I) TOTM = TOTM + Gmol(I) 38 Continue TOTW = TOTW/TOTM DO 40 I = 1, NG GWT(I) = GWT(I)/TOTM GWF(I) = GWT(I) * 100. / TOTW Gmol(I) = Gmol(I)/TOTM GasTOT = GasTOT + Gmol(I) Gas(I) = Gmol(I) * 100. 40 Continue go to 200 C ---------------------------------------------------------------------| C Converts analysis from input moles to 1.0 mole of gas | C ---------------------------------------------------------------------| 150 Continue If (INORM.eq.0) go to 180 GasTOT = 0.0 TOTW = 0.0 TOTM = 0.0 DO 50 I = 1,NG Gmol(I) = Gas(I) GWT(I) = Gmol(I) * GMW(I) TOTW = TOTW + GWT(I) TOTM = TOTM + Gmol(I) 50 Continue TOTW = TOTW / TOTM DO 60 I = 1, NG GWT(I) = GWT(I)/TOTM GWF(I) = GWT(I) * 100. / TOTW Gmol(I) = Gmol(I) / TOTM GasTOT = GasTOT + Gmol(I) Gas(I) = Gmol(I) * 100.0 60 Continue go to 200 C ---------------------------------------------------------------------| C Original number of moles is not changed | C ---------------------------------------------------------------------| 180 Continue GasTOT = 0.0 TOTW = 0.0 DO 70 I = 1,NG Gmol(I) = Gas(I) GWT(I) = Gmol(I) * GMW(I) TOTW = TOTW + GWT(I) GasTOT = GasTOT + Gmol(I) 70 Continue DO 80 I = 1, NG GWF(I) = GWT(I) * 100. / TOTW Gas(I) = Gmol(I) * 100.0 / GasTOT 80 Continue 200 Continue C ---------------------------------------------------------------------| C Prints part of output | C ---------------------------------------------------------------------| Write (IOUT3, 800) Write (IOUT3, 805) DO 300 I = 1, NG If (GWF(I) .eq. 0.0) go to 300 Write (IOUT3, 810) GName(I),Gas(I),GWF(I),Gmol(I),STA(I),GWT(I) 300 Continue Write (IOUT3, 811) GasTOT, TOTW If(ICHLOR.eq.1.OR.IFLUOR.eq.1) write(IOUT3,808) C ---------------------------------------------------------------------| C Here we express the gases in terms of the component species | C given in the gas data file. Corr(i) is total amount of | C species i contained in total gas. | C ---------------------------------------------------------------------| DO 100 N=1,NG J=ISTOC(N) If(J.eq.0) go to 100 DO 110 I=1,J Corr(ISPEC(N,I))=Corr(ISPEC(N,I)) + coef(N,I)*Gmol(N) 110 Continue 100 Continue C ---------------------------------------------------------------------| C Add gas | C ---------------------------------------------------------------------| N=1 DO 112 I=1,NSTOT If(Corr(I).eq.0.0) go to 112 GSmol(I)= Corr(I) GSMLY(I)=GSmol(I)*GMW(I) GSppm(I)=GSmol(I)*GMW(I)*1000000./TOTW IGSAQ(N)=I N=N+1 112 Continue NGS=N-1 C ---------------------------------------------------------------------| C Prints output | C ---------------------------------------------------------------------| Write (IOUT3, 815) DO 310 N = NSTOT1, NG If (Gmol(N) .eq. 0.0) go to 310 J = ISTOC(N) If (J .eq. 0) go to 309 Write (IOUT3, 820) GName(N),(coef(N,I),GName(ISPEC(N,I)),I=1,J) go to 310 309 Write(IOUT3,821) GName(N) 310 Continue Write(IOUT3,833) Write(IOUT3,835) DO 330 I=1,NGS Try(IGSAQ(I))=Gmol(IGSAQ(I)) Write(IOUT3,840) GName(IGSAQ(I)),GSppm(IGSAQ(I)),GSmol(IGSAQ(I)), 1 STA(IGSAQ(I)),GSMLY(IGSAQ(I)) 330 Continue Write(IOUT3,841) GasTOT, TOTW If(ICHLOR.eq.1.OR.IFLUOR.eq.1) Write(IOUT3,808) Write(*,575) 575 Format(//5X,'Okay... I have some results for you') Call files STOP C 705 Format (10A8) 710 Format (A8, 8X, I1, 8X, 6(F6.3, I2), F5.3, I2) 715 Format(A1) 740 Format(A8,5X,F9.4,4X,A8,F8.4) 800 Format(' ',65('+'),/,26X,'Input gas analysis',/ 2 ,26X,'------------------',/) 805 Format(/,2X,'Species mole % Weight %', 2 ' moles Weight (grams)',/,2X,65('+')/) 808 Format(2X,'CM means the moles of this species was adjusted for', & /,2x,' the amounts of other halide component species'///) 810 Format(2X,A8,1X,2(E11.5,3X),E11.5,1X,A3,2X,E11.5) 811 Format(/2X,'Total:',31X,2(E11.5,6X)/) 815 Format(/,' Stoichiometries of derived species:',/,2X,33('-'),/) 820 Format(2X,A8,': ',F6.3,'*',1X,A8,6(' ',F6.3,'*',1X,A8)) 821 Format(2X,A8,': No stoichiometry data for this gas') 833 Format(///,2X,65('+'),/24X,'Component species ',/24X,17('-')) 835 Format(/5X,'Species',3X,' ppm ',2X,' moles ',4X, 2 'Grams',/,2X,65('+'),/) 840 Format(6X,A8,2X,E11.5,4X,E11.5,1X,A3,E11.5) 841 Format(/6X,'Total:',19X,2(E11.5,4X)/) 850 Format('1 ',10A8,/,3X,10A8) End Subroutine files C =====================================================================| C This subroutine creates input files for programs SOLVGAS and | C GASWORKS with the data input in main and cgas. To get a | C description of the various parameters used here, check the | C source listing of these programs, or their user's manuals. | C | C Revised 5/88 by: N.S. | C Last revised 2/89 by: B.C. | C ---------------------------------------------------------------------| Implicit double precision (A-H,O-Z) Integer BG1,BG2 Parameter (BG1=100,BG2=50) Integer I, ICONV, ICOR(10), ICVAL(13), IFILE, IGSAQ(BG2) Integer INP1, INP2, INP3, INP4 Integer IOUT1, IOUT2, IOUT3, IOUT4 Integer ISPEC(BG1,7), ISVAL(9), J, NGS, NSTOT Character * 1 ANS Character * 8 GName(BG1), ICPAR(13), ISPAR(9) Character * 8 RCPAR(13), RSPAR(7) Character * 8 Title(20) Double precision GSppm(BG2),coef(BG1,7),DUM Double precision GAM,Gas(BG1),GWT(BG1),Gmol(BG1),GasTOT Double precision GMW(BG1),GSMLY(BG2),GSmol(BG2),GWF(BG1) Double precision RCVAL(13),RSVAL(7), Try(BG2) Common /Input / INP2, INP3, INP4 Common /Outpu / IOUT1, IOUT2, IOUT3 Common /Gases / Gas, GWF, GWT, Gmol, GSmol, GasTOT, GSMLY, GMW, & GName, coef, ISPEC, IGSAQ, Try, GSppm Common /AUTRE / Title, ICONV, NSTOT, NGS Data ICOR /10 * 0/ Data ICPAR /'BSTOT ', 'IFRAC ', 'IPUNCH ', 'NLOOP ', & 'ISTEP ', 'LIMSOL ', 'LOOC ', 'ITREF ', & 'IDEAL ', 'INCREM ', 'INCP ', 'MINSOL ', & 'OFLAG '/ Data ICVAL /42, 0, 1, 90, 0, 0, 0, 0, 0, 0, 0, 0, 0/ Data ISPAR /'BSTOT ', 'Ntemp ', 'NMTT ', 'Nmole ', & 'IGAMP ', 'NLOOP ', 'NSUNK ', 'IPRINT ', & 'ITREF '/ Data ISVAL /42, 0, 1, 0, 0, 90, 0, 0, 0/ Data RCPAR /'ERPC ', 'logFO2 ', 'PFLUID ', 'temp ', & 'SINC ', 'Slim ', 'GasTOT ', 'tempC ', & 'TOTMIX ', 'SOLMIN ', 'RM ', 'GasGRM ', & 'SUPRNT '/ Data RCVAL /0.1E-11, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, & 0.0, 0.0, 0.0, 0.1D-75/ Data RSPAR /'ERPC ', 'FO2log ', 'UNACT ', 'GasTOT ', & 'tempC ', 'PF ', 'RAT '/ Data RSVAL /0.1E-11, 0.0, 0.0, 1.0, 0.0, 1.0,-.3E+3/ C =====================================================================| RCVAL(7) = GasTOT RSVAL(4) = GasTOT GAM = 1.0 DUM = 0.0 1000 Write(*,500) 500 Format (//5X, 'Enter the appropriate number to create an input ', 1 'File for:',/,5X,'SOLVGAS (1) or GASWORKS (2), or to quit (0)'/) Read(*,700) IFILE If(IFILE.LT.0.or.IFILE.GT.3) go to 1000 If(IFILE.eq.0) STOP Write(*,505) 505 Format(//5X,'Enter the temperature, pressure, and log(FO2):'/) Read(*,*) RCVAL(4),RCVAL(3),RCVAL(2) RSVAL(5)=RCVAL(4) RSVAL(6)=RCVAL(3) RSVAL(2)=RCVAL(2) Write(*,506) 506 Format(//5X,'Do you want default values for MTRYS ?'/) Read(*,705) ANS If (ANS .eq. 'Y' .or. ANS .eq. 'y') go to 99 Write(*,507) 507 Format(///5X,'Okay, then input MTRYS now '/) DO 410 I=1,NGS Write(*,706) GName(IGSAQ(I)) Read(*,*) Try(IGSAQ(I)) 410 Continue C 99 Continue If(IFILE.eq.2) go to 300 C C SOLVGAS input file C 100 Continue Write(*,510) 510 Format(///5X,'The current GASRUN control parameters are:'/) 105 DO 10 I=1,7 10 Write(*,512) I, RSPAR(I), RSVAL(I) DO 15 I=1,9 15 Write(*,515) I+7, ISPAR(I), ISVAL(I) C Write(*,520) Read(*,705) ANS If (ANS .NE. 'Y' .and. ANS .NE. 'y') go to 150 C C To reset parameter values C Write(*,525) Read(*,*) (ICOR(I),I=1,10) DO 20 I=1,10 If(ICOR(I).eq.0.OR.ICOR(I).GT.16) go to 105 If(ICOR(I).GT.7) go to 110 Write(*,530) RSPAR(ICOR(I)),RSVAL(ICOR(I)) Read(*,*) RSVAL(ICOR(I)) go to 20 110 ICOR(I)=ICOR(I)-7 Write(*,532) ISPAR(ICOR(I)),ISVAL(ICOR(I)) Read(*,*) ISVAL(ICOR(I)) ICOR(I)=0 20 Continue C Writes SOLVGAS input file C 150 Continue C Writes SOLVGAS input file with gases Open(IOUT1,file='gasrun.dat') Write(IOUT1,800) Title Write(IOUT1,801) Write(IOUT1,805) (RSVAL(I), I=1,7) Write(IOUT1,802) Write(IOUT1,810) (ISVAL(I),I=1,9) Write(IOUT1,803) DO 43 I=1,NGS J = IGSAQ(I) Write(IOUT1,804) J, GName(J), GSmol(J), Try(J), GAM 43 Continue Write(IOUT1,702) C* Write(IOUT1,806) C* Write(*,822) Go to 400 C C GASWORKS input file C 300 Continue Write(*,535) 535 Format(///5X,'Enter the increment size (SINC),', & 'and the run limit (SLIM)'/) Read(*,*) RCVAL(5), RCVAL(6) Write(*,605) 605 Format(/5X,'The current workrun control parameters are:'/) 305 DO 155 I=1,6 155 Write(*,513) I,RCPAR(I),RCVAL(I),I+7,RCPAR(I+7),RCVAL(I+7) Write(*,513) 7,RCPAR(7),RCVAL(7) 156 Continue Write(*,702) DO 160 I=1,6 160 Write(*,516) I+13,ICPAR(I),ICVAL(I),I+20,ICPAR(I+7),ICVAL(I+7) Write(*,516) 20,ICPAR(7),ICVAL(7) Write(*,520) Read(*,705) ANS If (ANS .NE. 'Y' .and. ANS .NE. 'y') go to 350 C C To reset parameters values C Write(*,525) Read(*,*) (ICOR(I),I=1,10) DO 170 I=1,10 If(ICOR(I).eq.0.OR.ICOR(I).GT.26) go to 305 If(ICOR(I).GT.13) go to 165 Write(*,530) RCPAR(ICOR(I)),RCVAL(ICOR(I)) Read(*,*) RCVAL(ICOR(I)) go to 170 165 ICOR(I)=ICOR(I)-13 Write(*,532) ICPAR(ICOR(I)),ICVAL(ICOR(I)) Read(*,*) ICVAL(ICOR(I)) ICOR(I)=0 170 Continue 350 Continue C ---------------------------------------------------------------------| C Writes the GASWORKS input file | C ---------------------------------------------------------------------| Open (IOUT2, file = 'workrun.dat') Write (IOUT2, 800) Title Write (IOUT2, 811) Write (IOUT2, 820) (RCVAL(I), I = 1, 7) Write (IOUT2, 812) Write (IOUT2, 821) (RCVAL(I), I = 8, 13) Write (IOUT2, 813) Write (IOUT2, 810) (ICVAL(I), I = 1, 13) Write (IOUT2, 814) DO 382 I = 1, NGS J = IGSAQ(I) Write (IOUT2,804) J, GName(J), GSmol(J), Try(J), GAM, DUM 382 Continue Write (IOUT2, 825) Write (IOUT2, 826) Write (IOUT2, 827) C* Write (IOUT2, 828) Write (*,823) 400 Continue Write(*,620) 620 Format(/5X,'Do you want to create another file ?'/) Read(*,705) ANS If (ANS .NE. 'Y' .and. ANS .NE. 'y') return go to 1000 700 Format(I1) 702 Format(/) 705 Format(A1) 706 Format(5X,A8) 800 Format(10A8) 801 Format(/'< ERPC >< FO2log >< UNACT >< GasTOT >< tempC >', 1 '< PF >< RAT >') 802 Format(/' BSTO NTEM NMTT Nmol IGAM NLOO NSUN IPRI ITRE') 803 Format(/' < Name > < mtot >< mtry >' 1 ,'< gamma >') 804 Format(I5,1X,A8,4X,2E16.9,F8.4,2X,E10.4) 805 Format(E10.5,E10.4,4E10.5,E10.4) 806 Format(/' ieq> ') 810 Format(13I5) 811 Format(/'< ERPC >< logFO2 >< PFLUID >< temp >< SINC >' 1 ,'< SLIM >< GasTOT >') 812 Format(/'< tempC >< TOTMIX >< SOLMIN >< RM >< GasGRM >' 1 ,'< SUPRNT >') 813 Format(/' bsto ifra ipun nloo iste lims looc itre idea incr incp' 1 ,' mins ofla') 814 Format(/,' < name > < mtot >< mtry >' 1 ,' < comtot >') 820 Format(E10.4,3F10.5,2G10.4,F10.5) 821 Format(F10.5,G10.4,E10.4,2F10.5,E10.4) 822 Format(/3X,'Remember: to force equilibration with any', 1' Minerals,',/,5X,'You must add that info to GASRUN file.') 823 Format (/3X, 'Remember: info for mixing options must be added', & ' To WORKRUN file by editing', & /,5X, '(Reactant composition, mixer fraction, ', & 'Mixer fluid temp, etc.)') 825 Format (/'< min > < mintry >') 826 Format (/' < wtpc >') 827 Format (/'') 828 Format (/'') 512 Format (5X,I2,1X,A8,':',E10.4) 513 Format (2(5X,I2,1X,A8,':',E10.4)) 515 Format (5X,I2,1X,A8,':',I2) 516 Format (2(5X,I2,1X,A8,':',I2)) 520 Format (/5X,'Do you want to change any parameters ?') 525 Format (/5X,'Input parameter indices, slash to end'/) 530 Format (/5X,A8,' Old value is ',E10.4,' Input new value:') 532 Format (/5X,A8,' Old value is ',I2,' Input new value:') End