* Program Soltab * Reformats Supcrt96 output to be compatible with Soltherm * Originally written in 1996 for soltherm.dat * Updated in 2008 to read soltherm.xpt * Soltab uses two name index tables to find equivalent names for Sprons and Soltherm * - Mins_ptx.tbl Minerals and Gases * - Aqss_pec.tbl Aqueous species * One record at at time: * - Read the entire record for a single item from the SUPCRT96 output file * - Search the name index table for proper record * - Read the old Soltherm record from the old Soltherm * - Write the new Soltherm record with updated log K data * Be certain to use the same version of SOLTHERM that was used with program * Suprxn to create the Supcrt reaction files * The records must be in the same order * Copyright 1996, 2008, 2026 James Palandri * James Palandri hereby disclaims all copyright interest in the program * “Soltab” (which reformats text data) written by James Palandri * Signature of James Palandri, 24 January 2024 * James Palandri * This file is part of Soltab. * Soltab is free software: you can redistribute it and/or modify it under * the terms of the GNU General Public License as published by the * Free Software Foundation, either version 3 of the License, or (at your * option) any later version. Soltab is distributed in the hope that it * will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty * of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General * Public License for more details. You should have received a copy of the GNU * General Public License along with Soltab. If not, see * . implicit none integer itotrow, itotcol PARAMETER (ITOTROW = 37) PARAMETER (ITOTCOL = 36) INTEGER MINFLG, TABFLG, ROW, ILOOP, JLOOP, COLIDX, NUMSPC INTEGER ISTOCH(10), SSID, inp1, inp2, inp3, iout1, iout2, iread REAL*8 LOGK(ITOTROW,ITOTCOL), DG(ITOTROW,ITOTCOL), + DH(ITOTROW,ITOTCOL) REAL*8 ALK, MVOLUM, MOLWT, CHARGE, RADIUS, DENS, RSTOCH(10) REAL*8 P_BAR, SSVAL, TEMPK, TEMPC CHARACTER SKIPLN CHARACTER*4 GSFLAG CHARACTER*8 CHRFLG, REF CHARACTER*12 TABFIL, SOLFIL CHARACTER*20 HPNAME, HPNAMTBL, MINNAM, SOLNAM, TEST2 CHARACTER*30 FORMULA CHARACTER*100 LINE INP1 = 20 !Soltherm INP2 = 21 !name index table INP3 = 22 !Output from Supcrt96 IOUT1 = 11 !Soltherm format output IOUT2 = 12 !Names absent from the index table OPEN (inp1, file = 'soltherm.xpt', status = 'old') 10 WRITE (*,'(/,1X,A38,/)') 'Select the data type to be tabulated:' WRITE (*,'(3x,A33,A24)') ' Minerals & gases, index table =', + ' Mins_ptx.tbl, (Enter 1)' WRITE (*,'(3x,A33,A24/)') ' Aqueous species, index table =', + ' Aqss_ptx.tbl, (Enter 2)' READ (*,'(I1)') MINFLG IF (MINFLG.EQ.1) THEN Open (inp2, file = 'Mins_ptx.tbl', status = 'old') open (iout2, file = 'Miss-Stb-min.lst', status = 'replace') ELSE IF (MINFLG.EQ.2) THEN Open (inp2, file = 'Aqss_ptx.tbl', status = 'old') Open (iout2, file = 'Miss-Stb-aqs.lst', status = 'replace') ELSE Goto 10 ENDIF WRITE (*,'(/,A29,A18,/)') ' Enter name of Supcrt output', + ' file to be read: ' READ (*,'(A12)') TABFIL OPEN (INP3, FILE = TABFIL, STATUS = 'OLD') WRITE (*,'(/,A29,A34,/)') ' Enter name of file in which', + 'to write soltherm formatted data.' READ (*,'(A12)') SOLFIL OPEN (IOUT1, FILE = SOLFIL, STATUS = 'UNKNOWN') WRITE (*,'(/,A25,//,A23,/,A25)') ' Tabulate the following:', + ' Log K only (enter 1)', + ' Log K and dH (enter 2)' READ (*,'(I1)') TABFLG ********************************************************************* **** One mineral at a time: Read SUPCRT tab file (INP3) to find **** mineral name, formula, volume, log k's. Find corresponding **** SOLTHERM name in the look-up table (INP2), flag in MISSMINS.LST **** if missing. Find reaction stoichiometries, mol. wt. in SOLTHERM **** (inp1). Write SOLTHERM record if name is found. **** Flag in MISSMINS.LST if missing. ********************************************************************* **** Find start of the appropriate data type in SOLTHERM CALL FINDAT(MINFLG) **** Skip first line of supcrt tab file. 40 READ (INP3,*) **** Read name, formula, mineral volume from tab file. 50 READ (INP3,55,END=1000) HPNAME, FORMULA, MVOLUM 55 FORMAT (A20,2x,A30,2x,16X,F8.3) **** Read tabfile log K records for a mineral or species into array. COLIDX = 3 DO 100 ROW = 1, ITOTROW IF (ROW.LE.12) COLIDX = COLIDX + 1 IF (ROW.EQ.13.OR.ROW.EQ.14) COLIDX = 15 IF (ROW.EQ.15) COLIDX = 16 IF (ROW.EQ.16) COLIDX = 17 IF (ROW.EQ.17) COLIDX = 19 IF (ROW.EQ.18) COLIDX = 20 IF (ROW.EQ.19) COLIDX = 22 IF (ROW.EQ.20) COLIDX = 23 IF (ROW.EQ.21) COLIDX = 25 IF (ROW.EQ.22) COLIDX = 27 IF (ROW.EQ.23) COLIDX = 28 IF (ROW.EQ.24) COLIDX = 30 IF (ROW.EQ.25) COLIDX = 31 IF (ROW.EQ.26) COLIDX = 33 IF (ROW.EQ.27) COLIDX = 34 IF (ROW.GT.27) COLIDX = 36 DO 70 ILOOP = 1, COLIDX READ (INP3,65) P_BAR, TEMPC, TEMPK, LOGK(ROW,ILOOP), + DG(ROW,ILOOP), DH(ROW,ILOOP) 65 FORMAT (20x,3(2x,f9.3,1x),1X,f10.3,1x,1x,f11.1,3x,f11.1) 70 CONTINUE DO 80 JLOOP = COLIDX + 1, ITOTCOL LOGK(ROW,JLOOP) = 99999.999d0 DG(ROW,JLOOP) = 9999999.9d0 DH(ROW,JLOOP) = 9999999.9d0 80 CONTINUE 100 CONTINUE **** Read the look-up table until a match is found. 140 READ (INP2,142,END = 160) MINNAM, HPNAMTBL 142 FORMAT (A20,12X,A20) IF (HPNAME.EQ.MINNAM) GOTO 200 GOTO 140 **** If no match, go to next SUPCRT output file record. 160 WRITE (IOUT2,163) HPNAME,' HAS NO RECORD IN THE LOOK-UP TABLE' 163 FORMAT (2X,A20,A36) GOTO 699 ********************************************************************* **** READ SOLTHERM, WRITE OUTPUT FILE. ********************************************************************* **** Read mineral/gas names from soltherm (SOLNAM), stop and backspace **** when match to lookup table (MINNAM) is found. 200 READ (INP1,'(A20)', END=210) SOLNAM IF (MINNAM.EQ.SOLNAM) GOTO 250 * write (*,*) minnam, solnam GOTO 200 210 WRITE (IOUT2,220) MINNAM, " WAS NOT FOUND IN SOLTHERM" 220 FORMAT (2X,A20,A27) REWIND INP1 GOTO 699 **** Determine if a gas/mineral, or aqeous species. 250 BACKSPACE (INP1) IF (MINFLG.NE.2) THEN READ (INP1,303, END=210) SOLNAM, SSID, SSVAL, GSFLAG 303 FORMAT (A20,T67,I2,T71,F6.3,T81,A4) READ (INP1,'(T14,F8.2,T74,A8)') MOLWT,REF READ (INP1,*) NUMSPC, + (RSTOCH(IREAD), ISTOCH(IREAD), IREAD = 1,NUMSPC) **** Write first gas/mineral line. If ssoln data exist, include. IF (SSID.NE.0) then WRITE (IOUT1,*) WRITE (IOUT1,313) SOLNAM, FORMULA, ' Ssln ID, Coef: ', + SSID, SSVAL, GSFLAG, 'P-T:All ' 313 FORMAT (A20,A30,A16,I2,F8.3,4x,A4,2x,A8) **** Else don't include ssoln data. ELSE WRITE (IOUT1,*) WRITE (IOUT1,323) SOLNAM, FORMULA, GSFLAG, 'P-T:All ' 323 FORMAT (A20,A30,30x,A4,2x,A8) ENDIF **** Determine if a gas or mineral. If a gas... IF (GSFLAG.EQ.'GAS ') THEN **** Write second and third gas lines. WRITE (IOUT1,343) 'Wt.(g/mol) =', MOLWT, 'Ref: ',REF 343 FORMAT (A12,F9.3,47x,A5,A8) WRITE (IOUT1,344) NUMSPC,(RSTOCH(IREAD),ISTOCH(IREAD), + IREAD = 1,(NUMSPC)) 344 FORMAT (I2,1X,10(1X,F8.3,1X,I2)) **** Check if "B,C" line present, copy to output, else backspace. READ (INP1,'(A100)') LINE IF (LINE(1:3).EQ.'B,C') THEN WRITE (IOUT1,'(A100)') LINE ELSE BACKSPACE (INP1) ENDIF **** Else, it must be a mineral. ELSE **** Calculate mineral density. DENS = MOLWT/MVOLUM **** Write second and third mineral lines. WRITE (IOUT1,383) 'Wt.(g/mol) =', MOLWT, + 'V(cc/mol) =', MVOLUM, 'D(g/cc) =',DENS,'Ref: ',REF 383 FORMAT (A12,F9.3,4X,A11,F8.3,4X,A9,F7.3,4x,A5,A8) WRITE (IOUT1,344) NUMSPC,(RSTOCH(IREAD),ISTOCH(IREAD), + IREAD = 1,(NUMSPC)) ENDIF **** Else do aqueous species. ELSE READ (INP1,'(A20)') SOLNAM READ (INP1,'(T9,F3.0,T28,F5.2,T42,F6.3,T74,A8)') + CHARGE, RADIUS, ALK, REF READ (INP1, *) NUMSPC, + (RSTOCH(IREAD), ISTOCH(IREAD), IREAD = 1,(NUMSPC)) **** Write aqueous species reactions. WRITE (IOUT1,*) WRITE (IOUT1,593) SOLNAM, FORMULA, 'P-T:All ' 593 FORMAT (A20,A30,36X,A8) WRITE (IOUT1,594)'Charge =',CHARGE, 'Radius(Ĺ) =', + Radius,'Alk. =', ALK,'Ref: ',REF 594 FORMAT (A8,F3.0,4X,A11,F5.2,4x,A6,F6.3,21X,A5,A8) WRITE (IOUT1,344) NUMSPC,(RSTOCH(IREAD),ISTOCH(IREAD), + IREAD = 1,(NUMSPC)) ENDIF **** Write log K array for each that exists. 699 DO 800 ROW = 1, ITOTROW WRITE (IOUT1,'(36F10.3)') (LOGK(ROW,ILOOP), ILOOP = 1, ITOTCOL) 800 CONTINUE IF (TABFLG.EQ.2) THEN **** Write DH's too. DO 900 ROW = 1, ITOTROW WRITE (IOUT1,803) (DH(ROW,ILOOP), ILOOP = 1, ITOTCOL) 803 FORMAT (36F10.1) 900 CONTINUE ENDIF REWIND INP2 GOTO 50 1000 CONTINUE **** Finds data missing data in supcrt output. Development tool **** not currently needed, runs deathly slow because of multiple **** tabfile rewinds and read searchs. * CALL MISMIN(SKIPLN,INP2,INP3,IOUT1,HPNAME,TEST2,HPNAMTBL) CLOSE (INP1) CLOSE (INP2) CLOSE (INP3) CLOSE (IOUT1) CLOSE (IOUT2) WRITE (*,'(/,A21)') ' EXECUTION COMPLETED.' END *======================================================================= * Finds start of data in soltherm. *======================================================================= SUBROUTINE FINDAT(MINFLG) INTEGER MINFLG CHARACTER*8 CHRFLG INP1 = 20 IF (MINFLG.EQ.2) THEN 20 READ (INP1,30) CHRFLG IF (CHRFLG.NE.'Li+ ') GOTO 20 ELSE 25 READ (INP1,30) CHRFLG 30 FORMAT (A8) IF (CHRFLG.NE.'C123 COE') GOTO 25 ENDIF END *======================================================================= * This subroutine reads all entries in MINNAME.DAT, one at a * time and flags in MISSMINS.LST those which have no data in the * Supcrt tab file. Will need to add rection stoichiometry to SOLTHERM. * Currently, it is currently not needed and is skipped. * This assumes that MINNAME.DAT contains the complete list. *======================================================================= SUBROUTINE MISMIN(SKIPLN,INP2,INP3,IOUT1,HPNAME,TEST2,HPNAMTBL) INTEGER INP2, INP3, IOUT1 CHARACTER*1 SKIPLN CHARACTER*20 HPNAME, HPNAMTBL, TEST2 305 READ (INP2,'(A1)') SKIPLN IF (SKIPLN.EQ.'*') GOTO 305 BACKSPACE INP2 310 READ (INP2,313,END=500) HPNAME 313 FORMAT (20X,A20) IF (HPNAME.EQ.'********************') GOTO 500 REWIND INP3 320 READ (INP3,'(A20)',END=400) TEST2 IF (TEST2.NE.' REACTION TITLE: ') GOTO 320 READ (INP3,'(A1)') SKIPLN READ (INP3,'(6x,A20)') HPNAMTBL IF (HPNAME.EQ.HPNAMTBL) GOTO 310 GOTO 320 400 WRITE (IOUT1,403) HPNAME,' HAS NO DATA IN SUPCRT OUTPUT.' 403 FORMAT (2X,A20,A30) GOTO 310 500 WRITE (IOUT1,*) END *=======================================================================