c program MINTAB c---------------------------------------------------------------------------- c Version 1.0 (beta) 1/99 c c For compilation with Fortran90 on PC or UNIX platform c (modified for not using EOF function of Fortran95) c c This program reads plot files from CHILLER, GASWORKS, and SOLVEQ and generates c an ASCII file with data in tabular (colums) format for input c into commercial plotting packages. c c N.Spycher, 12/98 c Developed from program MINPLOT originally written by: c Nicolas Spycher U. of O. 1982-1983 c Anthony Michaels, Mark Reed, and Jeff DeBraal U. of O. 1989-1990 c c The type of data to output in tabular format (i.e. temperature, pressure c etc.) can be specified interactively or (faster) by a list of command c strings entered in an ASCII file (MINTAB.PAR). This file can created c with a text editor or by running MINTAB. The default name for this file c is MINTAB.PAR but any other file name can be specified. c ASCII character strings in MINTAB.PAR must be entered one per record, without c heading blanks. These strings identify the parameters to tabulate. String c formats are described in subroutine ReadParam. c c Labels (column headings) of general parameters (i.e. temperature, pressure, c enthalpy, porosity etc.) are assigned to array parlab0 in the BLOCK DATA c program unit. Depending on which version of CHILLER, GASWORKS, or SOLVEQ c you are using, these can be easily reassigned in the BLOCK DATA. c c Maximum allowed array dimensions are defined, and can be modified, c in file MINTABDFx.INC. Most common blocks are set in file MINTABCMx.INC. c c Note: with MINTAB, the number of datasets in the CHILLER, GASWORKS, or c SOLVEQ files is unlimited (no maximum; limited only by the amount of c disk storage). c c-------------------------------------------------------------------------------- c c Definition of important variables: c c Array maximum dimensions c max1 = max. number of general parameters c max2 = max. number of species (component + derived) c max3 = max. number of gases c max4 = max. number of component species c max5 = max. number of variables (data columns) to output c max6 = unused c max7 = max. number of minerals in simulation c c Number of components in simulation c ibstot component species c nst all aqueous species c ngas gases c nmin minerals c c Type of input plot files c ipar_typ =1 CHILLER c =2 GASWORKS c =3 SOLVEQ c c General parameters (such as those on the first record of data sets c in the CHILLER or GASWORKS plot file). The index of these parameters c are in the same order as for array PARLAB0(i,ipar_typ) in the BLOCK c DATA program unit: c par(1) (e.g. temperature) c par(2) (e.g. Pfluid) c par(3) ...and so on... c par(4) c par(5) c par(6) c par(7) c par(8) c c Other variables read in the input plot files c rmtry = molalities of individual species c rmtot = total moles of component species c aqm = aqueous moles of component species c gasnam = the name of the gas c fuga = fugacity of gas c rname = name of saturated mineral or gas c rmol = saturated mineral/gas moles c gra = saturated mineral/gas grams c solf = saturated mineral/gas mole frac. in solid solution c per = saturated mineral/gas weight percent c qklog = log(Q/K) c c Related to input plot files c nset number of datasets read (i.e. # of temperature steps) c ipar_typ flag for CHILLER (1), GASWORKS(2) or SOLVEQ(3) data c c Number of pointers, and pointer values c npar, ipar number and index of par's to save c nmtry,imtry number and index of rmtry's to save c nmtot,imtot number and index of rmtot's to save c naqm,iaqm number and index of aqm's to save c nfuga,ifuga number and index of fuga's to save c nmol,imol number and index of mol's to save c ngra,igra number and index of gra's to save c nsol,isol number and index of solf's to save c nper,iper number and index of per's to save c nqk,iqk number and index of qk's to save c c Labels for tabulated output c parlab labels assigned to selected par values c fugalab labels assigned to selected fuga values c mtrylab labels assigned to selected rmtry values c mtotlab labels assigned to selected rmtot values c aqmlab labels assigned to selected array aqm c mollab labels assigned to selected rmol values c gralab labels assigned to selected gra value c solflab labels assigned to selected solf values c perlab labels assigned to selected per values c qklab labels assigned to selected qk values c c Other labels read in input plot files: c specnam aq. species names c rname mineral names c gasname gas names c c c I/O device numbers (defined in mintabdfx.inc) c c inp1 main plot input file (i.e. chillplt.dat) c inp2 parameter input file (inp2 can be output if created) c inp3 label file (chiller/gasworks data only) c iout1 output file (tabulated data) c iunit1 chillout file c c*********************** block data c*********************** implicit real*4 (a-h,o-z) implicit integer (i-n) c character*12 parlab0(8,3) !default labels for general parameters ! (1=chiller, 2=solvgas and 3=solveq) *ptx character*8 blank character*8 blank, blank8 character*12 blank12 character*20 blank20 character*1 pos c *ptx data blank /' '/ data blank8 /' '/ data blank12 /' '/ data blank20 /' '/ data pos /'y'/ c c Note: the labels below must correspond, in same order, to the variables c output in plot files by chiller, gasworks, and solveq. You can change c these labels to match plot files of various program versions (that's c all you need to do to, then recompile). c Note: if parlab0 for pH is 'pH', input a(H+) is converted automatically c to pH. Otherwise, a(H)+ is output. c c parlab0(i,1) i=1,8 describes the data in par(i) for CHILLER plot files c parlab0(i,2) i=1,8 describes the data in par(i) for GASWORKS plot files c parlab0(i,3) i=1,8 describes the data in par(i) for SOLVEQ output files c data parlab0/'Temp ','Pfluid ','pH ','Mix.frac', !chiller + 'Temp ','Enthalpy','Porosity','Gas_wt.%', !chiller cjp + 'Mix.frac','Tempc ',' ',' ', !gasworks + 'Temp ','Mix.frac',' ',' ', !gasworks + ' ',' ',' ',' ', !gasworks + 'Temp ','Alkalin.','pH ',' ', !solveq + ' ',' ',' ',' '/ !solveq c common /parlab/parlab0 *ptx common /strings/pos,blank common /strings/pos,blank,blank8,blank12,blank20 c end c******************************* c main program c******************************* program mintab include 'mintabdfx.inc' !array dimensions, io numbers etc include 'mintabcmx.inc' !common blocks, declarations c character*1 ans *ptx character*8 name, dummy character*8 dummy character*20 name character*8 title1(10), title2(10) character*80 fil character*12 fildef(3) c logical exists fildef(1)='chillplt.dat' fildef(2)='gasplot.dat' fildef(3)='solout.dat' c c version number c write(*,"(///5x,'*** MINTAB version 1.0 beta ***'///)") c c initialization c do i=1,max7 divmin(i)=1.0 !mineral division factor end do c c define the type of input plot file c write(*,"(/5x,'Type of data file to read:' & //10x,'1 chiller plot file'/10x,'2 gasworks plot file' & /10x,'3 solveq output file' & //5x,'Enter selection (default=1) :> '$)") read(*,"(i1)") ipar_typ if(ipar_typ.le.1.or.ipar_typ.gt.3) ipar_typ=1 c c--Open files c write(*,"(/5x,'Enter name of plot data input file (default=' & a12,')',/5x,':> '$)") fildef(ipar_typ) fil=fildef(ipar_typ) call open_old(inp1,fil) c c default parameter file name paramfil='mintab.par' c c default output file name filout = fil do k = 1,80 if (fil(k:k) .eq. '.') then filout(k+1:k+3) = 'tab' exit end if end do c c default label file name for chiller, gasworks labelfil = fil do k = 1,80 if (fil(k:k) .eq. '.') then labelfil(k+1:k+3) = 'lab' exit end if end do c c look to see if label file exists (chiller/gasworks files only) if(ipar_typ.lt.3) then inquire (file = labelfil, exist = exists) if(.not.exists) call GenLabels(ipar_typ) end if c write(*,"(/5x,'Enter name of tabulated output data file' & /5x,'(default = ',a12,') :> '$)") filout call open_new(iout1,filout) c---------------------------------------------------------------- c Reads the plot file (first time through) c c For CHILLER/GASWORKS plot file only if(ipar_typ.lt.3) then c Read in the numbers ibstot, nst, and ngas in the input file c (correspond to the number of components, complexes, c and the number of gases respectively). read(inp1, *) ibstot, nst, ngas write(*, "( //2x, 'Ibstot = ',i3, 2x,'Nst = ',i3, & 2x,'Ngas = ', i3,//)") ibstot, nst, ngas c if(ibstot.gt.max4) then write(*,"(/5x,'Number of component species (ibstot) exceeded.' & /,5x,'Maximum allowed is: ',i3)") max4 stop c elseif(nst.gt.max2) then write(*,"(/5x,'Number of derived species (nst) exceeded.'/ & ,5x,'Maximum allowed is: ',i3)") max2 stop c elseif(ngas.gt.max3) then write(*,"(/5x,'Number of gases (ngas) exceeded.'/ & ,5x,'Maximum allowed is: ',i3)") max3 stop endif c read (inp1, "( 10a8/10a8)") title1, title2 write (*, "( //2x, 10a8/2x, 10a8/5x, & 'Reading plot file to check and order data...'/)")title1,title2 end if c--------------------------------------------------------------------- c Now we need to read the entire plot file to get the mineral and c gas names and sort them. We will read the file again later, c set by set, to tabulate the data. This way we are not c limited by the plot file size (i.e. do not need to store all c data in memory). c For SOLVEQ data, we also get species names here c nsets=0 !index of data set iend=0 !flag for end-of-file when reading top of set do k = 1,max7 !initialize mineral name variables *ptx rname(k)=blank rname(k)=blank20 end do write(*,*) do if(ipar_typ.lt.3) then !CHILLER/GASWORKS plot file call ReadPlotC(iend,ipar_typ) else !SOLVEQ output file call ReadPlotS(iend) end if if(iend.eq.1) exit !end of file when reading top of set nsets=nsets+1 write (*,"(5x,'Done reading data set number : ',i4, & 8x,' Number of mins : ', i3)") & nsets, nmin end do c c rewind the plot file and advance to the top of the first data set rewind (inp1) if(ipar_typ.lt.3) read (inp1,"(//)") !skip first 3 records c----------------------------------------------------------------------- c c Now we select the data to tabulate c write(*,"(/5x,'Use an existing plot parameter' & 'file (default=yes) ? :> '$)") read(*,"(a1)") ans c if(ans.eq.'N'.or.ans.eq.'n') then c c Select data to tabulate and generate the parameter file do call Select(ipar_typ) write (*, '( ///5x, ''Do you want to tabulate more '', 1 ''data ? (default=yes) :> '', $)') read ( * , '( a1)') ans if(ans.eq.' ') ans = pos if ((ans .ne. 'y') .and. (ans .ne. 'Y')) exit end do call GenParam else c c reads the Parameter file (parameters to tabulate) call ReadParam(ipar_typ) end if c----------------------------------------------------------------- c c Writes labels at top of the output file c --------------------------------------------------------------- c c General parameters do i=1,npar write(iout1,"(1x,a12,$)") parlab(i) end do write (iout1,'(a12,$)') ' ' c c Gas fugacities do i=1,nfuga *ptx write(iout1,"(1x,a12,$)") fugalab(i) !fugacity write(iout1,"(1x,a24,$)") fugalab(i) !fugacity end do c c Selected aq. species do i=1, nmtry *ptx write (iout1,"(1x,a12,$)") mtrylab(i) !molality write (iout1,"(1x,a16,$)") mtrylab(i) !molality end do do i=1, nmtot *ptx write (iout1,"(1x,a12,$)") mtotlab(i) !total moles write (iout1,"(1x,a16,$)") mtotlab(i) !total moles end do do i=1, naqm *ptx write (iout1,"(1x,a12,$)") aqmlab(i) !total aq. molality write (iout1,"(1x,a16,$)") aqmlab(i) !total aq. molality end do c c Selected minerals do i=1,nmol *ptx write (iout1,"(1x,a12,$)") mollab(i) !moles write (iout1,"(1x,a24,$)") mollab(i) !moles end do do i=1,ngra *ptx write (iout1,"(1x,a12,$)") gralab(i) !grams write (iout1,"(1x,a24,$)") gralab(i) !grams end do do i=1,nsol *ptx write (iout1,"(1x,a12,$)") solflab(i) !solid sol. fraction write (iout1,"(1x,a24,$)") solflab(i) !solid sol. fraction end do do i=1,nper *ptx write (iout1,"(1x,a12,$)") perlab(i) !weight percent write (iout1,"(1x,a24,$)") perlab(i) !weight percent end do do i=1,nqk *ptx write (iout1,"(1x,a12,$)") qklab(i) !log q/k write (iout1,"(1x,a24,$)") qklab(i) !log q/k end do write (iout1,"(' ')") !carriage control (next line) c----------------------------------------------------------------- c c Reads each plot data set and output the data in the output file c --------------------------------------------------------------- cc do while (.not.eof(inp1)) !F95 compilers only - use iend instead iend=0 !eof flag do do k = 1,max7 !reset mineral variables for current step rmol(k)=0. per(k)=0. solf(k)=0. gra(k)=0. end do if(ipar_typ.lt.3) then call ReadPlotC(iend,ipar_typ) !read one CHILLER/GASWORKS data set else call ReadPlotS(iend) !read one SOLVEQ data set end if if(iend.eq.1) exit !end of file c c Output selected general parameters do i=1,npar *ptx write(iout1,"(3x,e10.4,$)") par(ipar(i)) write(iout1,"(1x,g12.4,$)") par(ipar(i)) end do c c Output selected gas fugacities do i=1,nfuga *ptx write(iout1,"(3x,e10.4,$)") fuga(ifuga(i)) !fugacity write(iout1,"(15x,e10.4,$)") fuga(ifuga(i)) !fugacity end do c c Output selected data for aq. species do i=1, nmtry *ptx write (iout1,"(3x,e10.4,$)") rmtry(imtry(i)) !molality write (iout1,"(7x,e10.4,$)") rmtry(imtry(i)) !molality end do do i=1, nmtot *ptx write (iout1,"(3x,e10.4,$)") rmtot(imtot(i)) !total moles write (iout1,"(7x,e10.4,$)") rmtot(imtot(i)) !total moles end do do i=1, naqm *ptx write (iout1,"(3x,e10.4,$)") aqm(iaqm(i)) !total aq. molality write (iout1,"(7x,e10.4,$)") aqm(iaqm(i)) !total aq. molality end do c c Output selected data for minerals do i=1,nmol *ptx write (iout1,"(3x,e10.4,$)") rmol(imol(i))/divmin(imol(i)) !mineral moles write (iout1,"(15x,e10.4,$)") rmol(imol(i))/divmin(imol(i)) !mineral moles end do do i=1,ngra *ptx write (iout1,"(3x,e10.4,$)") gra(igra(i)) !mineral grams write (iout1,"(15x,e10.4,$)") gra(igra(i)) !mineral grams end do do i=1,nsol *ptx write (iout1,"(3x,e10.4,$)") solf(isol(i)) !mineral solid sol. fraction write (iout1,"(15x,e10.4,$)") solf(isol(i)) !mineral solid sol. fraction end do do i=1,nper *ptx write (iout1,"(3x,e10.4,$)") per(iper(i)) !mineral weight percent write (iout1,"(15x,e10.4,$)") per(iper(i)) !mineral weight percent end do do i=1,nqk *ptx write (iout1,"(3x,f10.2,$)") qklog(iqk(i)) !mineral log q/k write (iout1,"(15x,f10.4,$)") qklog(iqk(i)) !mineral log q/k end do write (iout1,"(1x)") !carriage control (next line) end do c--- Finished output------------------------------ c get here when eof reached close (unit = inp1) close (unit = iout1) write(*, "( //2x, ' .....Done!'/)") stop end subroutine Select(ipar_typ) c********************************************************** c This routine allows the user to select the plot data c to tabulate. c c ipar_typ =1 CHILLER =2 GASWORKS =3 SOLVEQ data c include 'mintabdfx.inc' !array dimensions, io numbers etc include 'mintabcmx.inc' !common blocks, declarations c integer iplt(max5) c character*1 ans *ptx character*8 name, dummy character*8 dummy character*20 name cjp character*80 lineinp character*150 lineinp c data icall/0/ save icall !flag: nb of time routine is called icall=icall+1 c c if(icall.gt.1) then write(*,"(/5x,'Re-enter general parameters ? (default=no) :> ' + ,$)") read(*,"(a1)") ans if(ans.eq.'Y') ans='y' end if if(icall.eq.1.or.ans.eq.'y') then !general parameters c c Queries the user to select general parameters to tabulate (one or more) c if(icall.eq.1) then !first time do i=1, max5 ipar(i)=0 parlab(i)=' ' end do end if write (*,"(//5x,'General parameters to tabulate:'/)") do i=1,4 write (*, "(12x,i1,' = ',A8,10x,i1,' = ',A8)") + i,parlab0(i,ipar_typ),i+4, parlab0(i+4,ipar_typ) end do c write (*, "(/5x,'Select a list of indexes:> '$)") cjp read(*,"(a80)") lineinp read(*,"(a150)") lineinp read (lineinp,*,end=111) (ipar(i), i=1,8) 111 continue end if c c General parameters, assign labels c do i = 1, max5 parlab(i)=parlab0(ipar(i),ipar_typ) if(ipar(i).eq.0) then npar = i-1 exit end if end do c c Queries the user for other data to tabulate (one at a time) c write (*, '( //5x, ''Other parameters:'')') if (ipar_typ.eq.1) then write (*, '( /12x, ''1 = Individual species molalities'', 1 /12x, ''2 = Total moles of components'', 2 /12x, ''3 = Total aqueous moles'', 3 '' (total molalities of component species)'', 4 /12x, ''4 = Log Fugacities of gases'', 5 /12x, ''5 = Minerals''//)') elseif (ipar_typ.eq.2) then write (*,'( /12x,''1 = Individual species mole numbers'', 1 /12x, ''2 = Total moles of components'', 2 /12x, ''3 = Total gas moles'', 4 /12x, ''4 = '', 5 /12x, ''5 = Minerals''//)') elseif (ipar_typ.eq.3) then write (*, '( /12x, ''1 = Individual species molalities'', 1 /12x, ''2 = Total moles of components'', 2 /12x, ''3 = Total aqueous moles'', 3 '' (total molalities of component species)'', 4 /12x,''4 = Log(Q/K) of Minerals or Gases''//)') endif write (*, '(5x,''Enter one selection (return for none):> ''$)') cjp read (*,"(a80)") lineinp read (*,"(a150)") lineinp read (lineinp ,*) indy if(indy.eq.0) return !done selecting c c If the user had chosen to plot individual species molalities c then call the subprogram to get (or generate) the label file. c From this list of species, the user will be able to choose c the required species c if (indy .eq. 1) then !molalities write(*, '( //)') key = -1 call GetLabels(key,imtry,nmtry,mtrylab,ipar_typ) cc do k=1,nmtry cc l=len_trim(mtotlab(k)) cc mtotlab(k)(l+1:l+4)='_mly' cc end do ccjp do k=1,nmtry ccjp l=len_trim(mtrylab(k)) ccjp mtrylab(k)(l+1:l+4)='_mly' ccjp end do c------------------------------------------------------- elseif (indy .eq. 2) then !total moles key = ibstot call GetLabels(key,imtot,nmtot,mtotlab,ipar_typ) do k=1,nmtot l=len_trim(mtotlab(k)) mtotlab(k)(l+1:l+4)='_tot' end do c elseif (indy .eq. 3) then !total aqueous molalities key = ibstot call GetLabels(key,iaqm,naqm,aqmlab,ipar_typ) do k=1,naqm l=len_trim(aqmlab(k)) aqmlab(k)(l+1:l+4)='_aqm' end do c end if c CHILLER/GASWORKS data - minerals and gases if(ipar_typ.lt.3) then c if (indy .eq. 4) then do i=1,max5 fugalab(i)=' ' ifuga(i)=0 end do do k = 1, ngas write (*, '( 5x, i2, 5x, a8)') k, gasnam(k) end do write (*, "( //5x,'Enter list of gas indexes:> '$)") cjp read(*,"(a80)") lineinp read(*,"(a150)") lineinp read (lineinp,*,end=222) (ifuga(k), k = 1, max5) 222 continue do k = 1, max5 if(ifuga(k).eq.0) then nfuga=k-1 exit else fugalab(k)= gasnam(ifuga(k)) endif end do c elseif (indy .eq. 5) then do i=1,max5 iplt(i)=0 end do c write (*, '( //5x, ''Available mineral data: ''/, 1 /12x, ''1 = Moles'', /12x, ''2 = Grams'', 2 /12x, ''3 = %'', /12x ''4 = Mole Fraction''/)') write (*,"( 5x,'Enter one selection (return if none):> '$)") cjp read(*,"(a80)") lineinp read(*,"(a150)") lineinp read (lineinp,*) inmy minf = 1 cjp do n = 1, 13 cjp n1 = n + 13 cjp n2 = n + 26 cjp write (*, '( 3( 2x, i3, 2x, a8))') cjp 1 n, rname(n), n1, rname(n1), n2, rname(n2) cjp end do do n = 1, 20 n1 = n + 20 n2 = n + 40 *ptx n3 = n + 60 *ptx write (*, '( 4( 2x, i3, 2x, a8))') *ptx 1 n, rname(n), n1, rname(n1), n2, rname(n2), *ptx 2 n3, rname(n3) write (*, '( 4( 2x, i3, 2x, a20))') 1 n, rname(n), n1, rname(n1), n2, rname(n2) end do write (*,"( /5x,'Enter list of mineral indexes:> '$)") cjp read(*,"(a80)") lineinp read(*,"(a150)") lineinp read (lineinp,*,end=333) (iplt(i), i = 1, max5) 333 continue c if (inmy .eq. 1) then !moles minerals write (*, "( //5x, 'Which minerals do you want to', 1 ' divide, if any'/, 5x,'input mineral', 2 ' index and dividing factor (e.g. 6,5.0)')") do cjp read(*,"(a80)") lineinp read(*,"(a150)") lineinp if(lineinp(1:1).eq.'') exit read (lineinp,*,end=444) k, divmin(k) 444 continue c if (k .eq. 0) exit write (*, '( /5x, ''Mineral : '', a8, 1 '' divided by '', f8.3)') rname(k), divmin(k) end do c do i=1,max5 mollab(i)=rname(iplt(i)) l=len_trim(mollab(i)) mollab(i)(l+1:l+4)='_mol' imol(i)=iplt(i) if(iplt(i).eq.0) then nmol=i-1 exit end if end do c elseif (inmy .eq. 2) then !grams minerals do i=1,max5 gralab(i)=rname(iplt(i)) l=len_trim(gralab(i)) gralab(i)(l+1:l+4)='_gra' igra(i)=iplt(i) if(iplt(i).eq.0) then ngra=i-1 exit end if end do c elseif (inmy .eq. 3) then !percent minerals do i=1,max5 perlab(i)=rname(iplt(i)) l=len_trim(perlab(i)) perlab(i)(l+1:l+4)='_per' iper(i)=iplt(i) if(iplt(i).eq.0) then nper=i-1 exit end if end do c elseif (inmy .eq. 4) then !mole fractions do i=1,max5 solflab(i)=rname(iplt(i)) l=len_trim(solflab(i)) solflab(i)(l+1:l+4)='_frc' isol(i)=iplt(i) if(iplt(i).eq.0) then nsol=i-1 exit end if end do end if end if c SOLVEQ data - minerals log Q/K else if (indy .eq. 4) then *ptx nloop=nmin/65 *ptx if(mod(nmin,65).ne.0) nloop=nloop+1 *ptx istart=loop*65-64 *ptx do n = istart, istart+12 *ptx n1 = n + 13 *ptx n2 = n + 26 *ptx n3 = n + 39 *ptx n4 = n + 52 nloop=nmin/48 if(mod(nmin,48).ne.0) nloop=nloop+1 nqk=0 do loop=1,nloop istart=loop*48-47 do n = istart, istart+15 n1 = n + 16 n2 = n + 32 *ptx write (*, '( 5( 2x, i3, 2x, a8))') write (*, '( 5( 2x, i3, 2x, a20))') 1 n, rname(n), n1, rname(n1), n2, rname(n2) end do write (*,"( /5x, 'Enter list of mineral indexes:> '$)") cjp read(*,"(a80)") lineinp read(*,"(a150)") lineinp read (lineinp,*,end=555) (iplt(i), i = nqk+1, max5) 555 continue c do i=nqk+1,max5 if(iplt(i).eq.0) then nqk=i-1 exit end if qklab(i)=rname(iplt(i)) l=len_trim(qklab(i)) qklab(i)(l+1:l+4)='_lqk' iqk(i)=iplt(i) end do end do end if end if return end subroutine open_old (iunit,default) c********************************** c Opens an old file (By N.S. 5/98) c implicit integer (i-n) implicit real*4 (a-h,o-z) logical exists character*80 filenam,default c ifirst=1 do if(ifirst.eq.0) write(*,"(/5x,'Enter another file name' + ' (or q to quit):> '$)") ifirst=0 read(*,"(a40)") filenam if(filenam.ne.' ') default=filenam if((filenam(1:1).eq.'Q'.or.filenam(1:1).eq.'q').and. + filenam(2:2).eq.' ') stop inquire (file = default, exist = exists) if(exists) then open (unit=iunit,file=default,status='old',err=100) return endif c write(*,"(5x,'Warning! File does not exist!'/)") end do c 100 write(*,"(/'Error while opening the file - stop'/)") stop end subroutine open_new (iunit,default) c********************************** c Opens a new file (By N.S. 5/98) c implicit integer (i-n) implicit real*4 (a-h,o-z) logical exists character*80 filenam,default character*1 ans c ifirst=1 c 10 if(ifirst.eq.0) write(*,"(/5x,'Enter another file name:> '$)") ifirst=0 read(*,"(a40)") filenam if(filenam.ne.' ') default=filenam inquire (file = default, exist = exists) if(exists) then write(*,"(/5x,'File already exists. Replace ? (y/n) :> '$)") read(*,"(a1)") ans if(ans.ne.'Y'.and.ans.ne.'y') goto 10 end if open (unit = iunit, file = default, status = 'unknown',err=100) c return 100 write(*,"(/'Error while opening the file - stop'/)") stop end subroutine GetLabels(key,iplt,index,label,ipar_typ) c********************************************************* c This subprogram displays the species on the screen. c The user can select any of these species for graphing c by selecting the corresponding keys. The selected c list of species are then returned to min in order to c extract the selected data corresponding to each species. c GetLabels is called by the main program MINPLOT c c iplt array of selected species indeces c nplt total number of species selected c include 'mintabdfx.inc' !array dimensions, io numbers etc include 'mintabcmx.inc' !common blocks, declarations c character*12 label(max5),dummy *ptxxxx character*16 label(max5),dummy character*20 fmt1, fmt2 cjp character*80 lineinp character*150 lineinp integer iplt(max5) c *pptx data fmt1(1:13) /'(1x,i3,1x,a8)'/ *pptx data fmt1(1:13) /'(1x,i3,1x,a12)'/ data fmt1(1:13) /'(1x,i3,1x,a12)'/ data fmt2(1:16) /'(6(1x,i3,1x,a12))'/ icount=nst c-------------------------------------------------------------------- c CHILLER/GASWORKS plot file only: c Open the label file and read the species names if(ipar_typ.lt.3) then open (unit = inp3, file = labelfil, status = 'old') c icount = 1 do read (inp3, fmt1,end=1000) num, specnam(icount) icount = icount + 1 end do 1000 close (unit = inp3) end if c c SOLVEQ file: specnam read earlier by call to ReadPlotS c-------------------------------------------------------------------- c Initialize the selection array to zero do k = 1, max5 iplt(k) = 0 label(k) = ' ' end do c-------------------------------------------------------------------- c If the last entry key read is not equal -1 then adjust c the count of species by adding 2. if (key .ne. -1) then icount = key + 2 endif c-------------------------------------------------------------------- c This part of the subroutine displays the species on c the screen and reads in the selections from the user. icount = icount - 2 irows = icount / 6 cjp if (mod(icount, 6) .eq. 0) then cjp irows = icount / 6 cjp else cjp irows = (icount / 6) + 1 cjp endif inx = 1 istart = 1 do k = 1, irows if (mod(k, 21) .eq. 0) then write (*,"(//5x,'Enter list of species indexes:> '$)") c cjp read(*,"(a80)") lineinp read(*,"(a150)") lineinp read (lineinp,*,end=111) (iplt(in), in = istart, max5) 111 continue index = istart do if (iplt(index) .eq. 0) exit index = index + 1 end do istart = index endif write (*, fmt2) (j, specnam(j), j = inx, inx + 5) inx = inx + 6 end do c icols = icount - irows * 6 c if (icols .gt. 0) then write (*, fmt2) (j,specnam(j), j = inx, inx + icols - 1) endif c if (mod(k, 21) .ne. 0) then write (*,"( //5x,'Enter list of species indexes:> '$)") cjp read(*,"(a80)") lineinp read(*,"(a150)") lineinp read (lineinp,*,end=222) (iplt(in), in = istart, max5) 222 continue index = istart do if (iplt(index) .eq. 0) exit index = index + 1 end do index=index-1 !total number of indexes selected endif c-------------------------------------------------------------------- do j = 1, index label(j) = specnam(iplt(j)) end do c return end subroutine GenLabels(ipar_typ) c************************************************************ c Subroutine GenLabels is used to generate the label c file xxxxxPLT.LAB which stores the species' name and an c index corresponding to each species. It is used in c subroutine GetLabels to display a list of species c for the user to select from. c This subroutine is called from the main program MINPLOT c and is called whenever xxxxxPLT.LAB doesn't exist. The c label file is also used when graphing the legends. *ptx Used for Chiller and Gasworks include 'mintabdfx.inc' !array dimensions, io numbers etc include 'mintabcmx.inc' !common blocks, declarations c integer indx(max2) *ptx blank8 now assigned elsewhere character*8 intxt, species, blank8, inspec(500) *ptx blanks not used character*12 blanks,fil *pptx character*8 intxt, species, inspec(500) character*8 intxt character*12 species, inspec(500) character*12 fil c logical exists c *ptx blanks not used data blanks /' '/ *ptx blank8 now assigned elsewhere data blank8 /' '/ c-------------------------------------------------------------------- c Querry the user which output file was generated by CHILLER c to generate the xxxxxx.sum file. if (ipar_typ .eq. 1 ) then write (*, 30) 30 format (//4x, ' There is no label file for this data set ' 1 /4x, ' Enter output filename generated by CHILLER', 2 /4x, ' (default = chillout.dat) :> ',$) fil='chillout.dat' call open_old(iunit1,fil) else if ( ipar_typ .eq. 2) then cjp write (*, 31) fil write (*, 31) 31 format ( 4x, ' There is no label file for this data set ' 1 /4x, ' Enter output filename generated by GASWORKS', 2 /4x, ' (default = gasout.dat) :> ',$) fil='gasout.dat' call open_old(iunit1,fil) endif c-------------------------------------------------------------------- c Open and read this output file and read the portion of c the file where the list of species is located. Create c and write this information in the label file. write(*,"(/5x,'Enter the name of the label file to create' & /5x,' (default = ',a12,'):> '$)") labelfil call open_new(inp3,labelfil) 100 continue read (iunit1, 40) intxt 40 format ( 2x, a8) *pptx if (intxt .ne. 'SPECIES ') go to 100 if (intxt .ne. 'Species ') go to 100 read (iunit1, 40) intxt 200 continue read (iunit1, 50) species, index *pptx50 format ( 2x, a8, i5) 50 format ( 2x, a12, i4) *pptx if (species .ne. blank8) then if (species .ne. blank12) then write (*,*) index, species write (inp3, 60) index, species *pptx60 format ( i4, 1x, a8) 60 format ( i4, 1x, a12) go to 200 endif pause 300 continue read (iunit1, 70) intxt *pptx70 format ( 4x, a8) 70 format ( 4x, a8) *pptx if (intxt .ne. 'SPECIES ') go to 300 if (intxt .ne. 'Species ') go to 300 read (iunit1, 70) intxt k = 0 400 k = k + 1 cjp read (iunit1, 80) species, index, inspec(k), indx(k) cjp80 format ( 4x, a8, i6, 23x, a8, i6) If (ipar_typ.eq.2) then read (iunit1, 888) species, index, inspec(k), indx(k) 888 format ( 4x, a8, i7, 24x, a8, i7) else read (iunit1, 80) species, index, inspec(k), indx(k) *pptx80 format ( 4x, a8, i6, 23x, a8, i6) 80 format ( 4x, a12, i6, 23x, a12, i6) endif *pptx if (species .ne. blank8) then if (species .ne. blank12) then write (inp3, 60) index, species go to 400 endif k = k - 1 *pptx if (inspec(k) .eq. blank8) then if (inspec(k) .eq. blank12) then k = k - 1 endif do 500 j = 1, k write (inp3, 60) indx(j), inspec(j) 500 continue c-------------------------------------------------------------------- cc At the very end of our species list add pH with index 0 cc if using Chiller data; add f(O2) if using Gasworks data. c c if ( gtype .eq. 'c' ) then c write (inp3, 90) c90 format ( ' 0 pH') c else if ( gtype .eq. 'g' ) then c write (inp3, 91) c91 format ( ' 0 f(O2)' ) c endif c-------------------------------------------------------------------- close (unit = inp3) close (unit = iunit1) return end subroutine ReadPlotC(iend,ipar_typ) c******************************************************************************* c This routines reads one set of the CHILLER or Gasworks plot file c (without first line and title lines, just the plot data c with blank line at the end). c c include 'mintabdfx.inc' !array dimensions, io numbers etc include 'mintabcmx.inc' !common blocks, declarations c *ptx character*8 name, dummy character*20 name, dummy c c Defaults for mineral parameters for this set c (in case some minerals not present at all steps) *ptx do n=1,nmin do n=1,nmin_save rmol(n) = 0. gra(n) = 0. solf(n) = 1.0 per(n) = 0. end do c c Read in first record of parameters read (inp1, '( 8e10.4)',end=1000) (par(i), i=1,max1) c The preceding statement reads the chillplt file general parameters c assigned as defined for parlab0(i,ipar_typ) in the BLOCK DATA c (for example,temp, pfluid, act(H+) etc.. c converts aH+ to pH (needs a 'pH' label to work) do i=1,max1 if(parlab0(i,ipar_typ)(1:2).eq.'pH') then par(i)=-alog10(par(i)) exit end if end do c Read in data for aq. species read (inp1, '(8e10.4)') (rmtry(j), j = 1, nst) read (inp1, '(8e10.4)') (rmtot(j), j = 1, ibstot) read (inp1, '(8e10.4)') (aqm(j), j = 1, ibstot) c Read in the gas fugacities (logarithm) do n = 1,ngas *pptx read (inp1, '( i3,2x,a8,2x,f10.4)') j, gasnam(j), fuga(j) read (inp1, '( i3,2x,a20,2x,f10.4)') j, gasnam(j), fuga(j) end do c Read in the mineral data nmin = 0 do n = 0 *pptx read (inp1, '( i3,2x,a8,2x,6e10.4)') read (inp1, '( i3,2x,a20,2x,6e10.4)') & mm, name, rmil, rgr, rpr, rsol if (mm .ne. 0) then do n = n + 1 if(n.ge.nmin) nmin=n *ptx if((name.eq.rname(n)).or.(rname(n).eq.blank)) exit if((name.eq.rname(n)).or.(rname(n).eq.blank20)) exit end do c if(nmin.gt.max7) then write(*,"(/5x,'Number of minerals (max7) exceeded.'/ & ,5x,'Maximum allowed is: ',i3)") max7 stop endif rname(n) = name rmol(n) = rmil gra(n) = rgr solf(n) = rsol per(n) = rpr else exit endif end do c c Read in 2nd blank line at end of mineral list (marks end of dataset) read (inp1, '( a8)') name c *ptx if (name .ne. blank) then if (name .ne. blank20) then write (*,"( //10x,'Error in reading CHILLER data file //')") close (unit = inp1) stop endif return 1000 iend=1 !end-of-file at top of set return end subroutine GenParam c********************************** c c This routine generates a table parameter file (.i.e. an ASCII file c with commands to automatically tabulate selected data. c include 'mintabdfx.inc' !array dimensions, io numbers etc include 'mintabcmx.inc' !common blocks, declarations c write(*,"(/5x,'Enter name of parameter file to create' & /5x,'(default = ',a12,') :> '$)") paramfil call open_new(inp2,paramfil) !inp2 is output in this case c write(inp2,"('ipar_typ ',i1)") ipar_typ c General parameters do i=1,npar write(inp2,"(a12)") parlab(i) end do c c Gas fugacities do i=1,nfuga *ptx write(inp2,"(a12)") fugalab(i) !fugacity write(inp2,"(a24)") fugalab(i) !fugacity end do c c Selected aq. species do i=1, nmtry *ptx write (inp2,"(a12)") mtrylab(i) !molality write (inp2,"(a16)") mtrylab(i) !molality end do do i=1, nmtot *ptx write (inp2,"(a12)") mtotlab(i) !total moles write (inp2,"(a16)") mtotlab(i) !total moles end do do i=1, naqm *ptx write (inp2,"(a12)") aqmlab(i) !total aq. molality write (inp2,"(a16)") aqmlab(i) !total aq. molality end do c c Selected minerals do i=1,nmol *ptx write (inp2,"(a12,f5.0)") mollab(i), divmin(imol(i)) !moles write (inp2,"(a24,f5.0)") mollab(i), divmin(imol(i)) !moles end do do i=1,ngra *ptx write (inp2,"(a12)") gralab(i) !grams write (inp2,"(a24)") gralab(i) !grams end do do i=1,nsol *ptx write (inp2,"(a12)") solflab(i) !solid sol. fraction write (inp2,"(a24)") solflab(i) !solid sol. fraction end do do i=1,nper *ptx write (inp2,"(a12)") perlab(i) !weight percent write (inp2,"(a24)") perlab(i) !weight percent end do do i=1,nqk *ptx write (inp2,"(a12)") qklab(i) !log q/k write (inp2,"(a24)") qklab(i) !log q/k end do write(inp2,"('endlist')") !end record return end subroutine ReadParam(ipar_typ) c************************************ c c This routine reads the parameter file (.i.e. reads the file c containing info on the type of data to tabulate) c This file is run-independent and contains character strings c that tell mintab what data to tabulate as follows (in any order c except for ipar_typ c c Plot type (must be first entry or defaults to 1!) c ipar_typ type of plot file to read (1=chiller,2=gasworks, and c 3=solveq) c c c General parameters. These must be identical to the labels c defined for array parlab0, currently: c Temp temperature c Pfluid fluid pressure c a(H+) hydrogen ion activity c Mix.frac mixing fraction c Tempc temperature of mixing solution c Enthalpy total enthalpy c Porosity porosity c Gas_wt.% gas weight percent of water+gas system c c Aq. species, gases and mineral to select must have the c exact same name as in the soltherm data file, and must be c followed directly with the following strings: c _aqm total aq. molality e.g. NaCl_aqm c _tot total moles e.g. SO4--_tot c (blank) molality of individual species e.g. Cl- c _gra gram mineral e.g quartz_gra c _mol moles mineral, followed by division factor (optional) c (div. factor 1 by default, separated by at least one blank) c _per wt. percent minerals c _frc mole frcation mineral solid solution c c Final record (mandatory): c endlist (or blank, or any record) c include 'mintabdfx.inc' !array dimensions, io numbers etc include 'mintabcmx.inc' !common blocks, declarations c *ptx character*12 string character*24 string character*80 record1 integer ltrim c c opens the parameter file c write(*,"(/5x,'Enter name of parameter file to use' & /5x,'(default = ',a12,') :> '$)") paramfil call open_old(inp2,paramfil) c c CHILLER/GASWORKS files only if(ipar_typ.lt.3) then c opens and reads the label file (aqueous species names) c (this file is run-dependent and created from main) open (unit = inp3, file = labelfil, status = 'old') icount = 1 do read (inp3,"(1x,i3,1x,a12)",end=1000) & indx, specnam(icount) icount = icount + 1 end do 1000 close (unit = inp3) end if c c SOLVEQ files: specnam was read by call to ReadPlotS earlier c c initialize all table data index parameters c npar=0 !number of general parameters to select nfuga=0 !number of gas species fugacity values to select nmtry=0 !number of species molality values to select nmtot=0 !number of components total moles values to select naqm=0 !number of species aq. molality values to select nmol=0 !number of mineral moles values to select ngra=0 !number of mineral grams values nsol=0 !number of mineral mole fraction values to select nper=0 !number of mineral weight percent to select nqk=0 !number of mineral log q/k c ipar_typ=1 !default c At this stage, nothing is selected c c reads the parameter file and assigns the data to be tabulated c according to the content of the parameter file c do !main loop (reads each record) iloop=0 !flag =1 to loop back to read next entry read(inp2,"(a80)",end=2000) record1 *ptx string = record1(1:12) string = record1(1:24) write (*,'(a24)') string c c checks plot type first, if none defaults to 1 c if (string(1:8).eq.'ipar_typ') then c read(record1(10:80),*) ipar_typ c if(ipar_typ.lt.1.or.ipar_typ.gt.3) ipar_typ=1 c iloop=1 c end if c if(iloop.eq.1) cycle c checks for general parameters l=len_trim(string) !length without trailing blanks do i=1,max1 if(string(1:l).eq.parlab0(i,ipar_typ)(1:l)) then npar=npar+1 ipar(npar)=i parlab(npar)=string iloop=1 exit end if end do if(iloop.eq.1) cycle c checks for aqueous species do i = 1, nst cc l=len_trim(specnam(i)) ltrim=len_trim(specnam(i)) l=len_trim(string) if(l.gt.4.and.string(l-3:l-3).eq.'_') l=l-4 cjp if(string(1:l).eq.specnam(i)(1:l)) then if(string(1:l).eq.specnam(i)(1:ltrim)) then c found species match, check for type of data select case (string(l+1:l+4)) case('_aqm') !total aqueous molalities naqm=naqm+1 iaqm(naqm)=i aqmlab(naqm)=string iloop=1 exit case('_tot') !total molalities nmtot=nmtot+1 imtot(nmtot)=i mtotlab(nmtot)=string iloop=1 exit case default !molalities of actual species nmtry=nmtry+1 imtry(nmtry)=i mtrylab(nmtry)=string iloop=1 exit end select end if end do if(iloop.eq.1) cycle c checks for gases do i = 1, ngas l=len_trim(gasnam(i)) if(string(1:l).eq.gasnam(i)(1:l) & .and.string(l+1:l+1).ne.'_') then c found gas match, check for type of data nfuga=nfuga+1 ifuga(nfuga)=i fugalab(nfuga)=string iloop=1 exit end if end do if(iloop.eq.1) cycle c checks for minerals *ptx do i = 1, nmin nmin_save = nmin do i = 1, nmin_save l=len_trim(rname(i)) if(string(1:l).eq.rname(i)(1:l)) then c found mineral match, check for type of data select case (string(l+1:l+4)) case('_mol') !moles of mineral nmol=nmol+1 imol(nmol)=i mollab(nmol)=string iloop=1 read(record1(l+6:80),*,end=100) divmin(i) 100 if(divmin(i).eq.0.) divmin(i)=1.0 exit case('_gra') !grams of mineral ngra=ngra+1 igra(ngra)=i gralab(ngra)=string iloop=1 exit case('_per') !wt. percent of mineral nper=nper+1 iper(nper)=i perlab(nper)=string iloop=1 exit case('_frc') !wt. percent of mineral nsol=nsol+1 isol(nsol)=i solflab(nsol)=string iloop=1 exit case('_lqk') !wt. percent of mineral nqk=nqk+1 iqk(nqk)=i qklab(nqk)=string iloop=1 exit end select end if end do if(iloop.eq.1) cycle end do 2000 close(inp2) return end subroutine ReadPlotS(iend) c********************************************************** c This routines reads one set of the SOLVEQ output file c The top of each set is assumed to start with the c string ' Temperature:' c c include 'mintabdfx.inc' !array dimensions, io numbers etc include 'mintabcmx.inc' !common blocks, declarations c *ptx character*8 name, dummy character*20 name, dummy character*80 record1 character*25 string c Defaults for mineral parameters for this set c (in case some minerals not present at all steps) do n=1,nmin qklog(n)=-500. end do c c Looks for the top of the data set (temperature record) do string='Temperature field' read (inp1, "(a80)",end=1000) record1 if(record1(1:14).eq.' Temperature:') exit end do c reads temperature read(record1(15:23),*) par(1) c c Looks for water do string='Kg of water' read (inp1, "(a80)",end=1001) record1 if(record1(1:8).eq.' Water:') exit end do *ptxc reads alkalinity * reads kg H2O read(record1(9:19),*) rmtry(2) c c Looks for alkalinity do string='Alkalinity field' read (inp1, "(a80)",end=1001) record1 if(record1(49:58).eq.'Alkalinity') exit end do c reads alkalinity read(record1(61:73),*) par(2) c c Looks for a(H+) do string='First H+ field' read (inp1, "(a80)",end=1001) record1 if(record1(1:8).eq.' 1 H+ ') exit end do c reads a(H+) read(record1(43:54),*) par(3) par(3)=-alog10(par(3)) !get pH c c Reads mtrys and species names *ptx* read(record1(1:28),"(i4,1x,a8,4x,e11.4)") indx,specnam(1),rmtry(1) read(record1(1:30),"(i4,1x,a12,1x,e12.4)") + indx,specnam(1),rmtry(1) *ptx* read(inp1,"(i4,1x,a8)") indx, specnam(2) read(inp1,"(i4,1x,a12)") indx, specnam(2) c do i=3,max2 *ptx* read(inp1,"(i4,1x,a8,4x,e11.4)") indx,specnam(i),rmtry(i) read(inp1,"(i4,1x,a12,1x,e12.4)") indx,specnam(i),rmtry(i) if(indx.eq.0) exit end do nst=i-1 c c Looks for list of comp. species, starting with H+ do string='Second H+ field' read (inp1, "(a80)",end=1001) record1 if(record1(1:8).eq.' 1 H+ ') exit end do c reads a(H+) *ptx* read(record1(1:39),"(i4,1x,a8,2x,2e12.4)") read(record1(1:43),"(i4,1x,a12,2(1X,e12.4))") + indx,dummy,aqm(1),rmtot(1) c c Reads total molality and moles do i=2,max4 *ptx* read(inp1,"(i4,1x,a8,2x,2e12.4)") read(inp1,"(i4,1x,a12,2(1x,e12.4))") + indx,dummy,aqm(i),rmtot(i) if(indx.eq.0) exit end do ibstot=i-1 c Reads the mineral data c looks for +++++++ line do string='++++++ after species data' read (inp1, "(a80)",end=1001) record1 if(record1(1:12).eq.' ++++++++++') exit end do c Now we are either at the top of the mineral list c or at the top of the next set if there are no mineral list. c Check for mineral header: read(inp1,"(/////a80)") record1 if(record1(1:9).ne.' Mineral') return read(inp1,"(a1)") dummy !skips blank line nmin = 0 !initialize number of minerals do k=1,2 !two passes for each mineral set (supersat+undersat) do !loop reading through minerals n = 0 string='Mineral names' read (inp1,"(a80)",end=1002) record1 *ptxdebug write (*,*) record1 *ptx if (record1(1:8).eq.blank) exit if (record1(1:8).eq.blank8) exit if (record1(1:4).eq.' ') exit !case if other text c if (record1(15:21).eq.'skipped') exit !case if no data at high T *ptx read(record1(1:39),"(2x,a8,20x,f9.2)") name, qkdat read(record1(1:55),"(2x,a20,23x,f10.4)") name, qkdat *ptxdebug write (*,'(a1,8a10)') 'x',(record1(10*i+1:10*i+11), i = 0,14) *ptxdebug write (*,"(a20,2x,f10.4)") name, qkdat *ptxdebug pause do n = n + 1 if(n.ge.nmin) nmin=n *ptx nmin_save added to get mineral Q/Ks dropped at high P, T because of absent data if(nmin.ge.nmin_save) nmin_save = nmin *ptx if((name.eq.rname(n)).or.(rname(n).eq.blank)) exit if((name.eq.rname(n)).or.(rname(n).eq.blank20)) exit end do c if(nmin.gt.max7) then write(*,"(/5x,'Number of minerals (max7) exceeded.'/ & ,5x,'Maximum allowed is: ',i3)") max7 stop endif rname(n) = name qklog(n) = qkdat end do c c At this point, we reached a blank line. Check to see if there c is another list of minerals (i.e. UNDERSATURATED ONES) c read(inp1,"(a80)", end=1002) record1 if(record1(21:34).ne.'UNDERSATURATED') exit string='Undersaturated minerals' read(inp1,"(//a80)",end=1001) record1 !skip to top of undersat minerals end do c c Finished reading one set c 1002 return 1000 iend=1 !end-of-file when reading top of set return 1001 write(*,"(//5x,'End-of-file encountered when looking for:', + a25/5x,'in SOLVEQ output file'/)") string stop end