************************************************************************** **** * **** **** PROGRAM HPRONS2011**** * **** * **** CONVERTS HPTHRM.DAT FORMAT TEXT FILE (HOLLAND AND POWELL 2011 * **** DATASET) TO SPRONS.DAT MINERAL FORMAT TEXT FILE (SUPCRT SEQUENTIAL * **** ACCESS DATASET). * **** * **** ELEMENT ENTROPIES AND ABRREVIATIONS ARE INTERNAL * **** MINERAL NAMES AND ABBREVIATIONS ARE EXTERNAL IN * **** FILE H&PMINS.TBL * **** * **** The database currently contains 18 elements. * **** * **** 1 Si 11 H * **** 2 Ti 12 C * **** 3 Al 13 Cl * **** 4 Fe 14 electron e-, not used * **** 5 Mg 15 Ni * **** 6 Mn 16 Zr * **** 7 Ca 17 S * **** 8 Na 18 Cu * **** 9 K 19 Cr * **** 10 O * **** * **** PARAMETER NELEM = TOTAL NUMBER OF ELEMENTS * **** * ******************************************************************************** * Copyright 1996, James Palandri * James Palandri hereby disclaims all copyright interest in the program * “Hprons2011” (which reformats text data) written by James Palandri * Signature of James Palandri, 24 January 2024 * James Palandri * This file is part of Hprons2011. * Hprons2011 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. Hprons2011 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 Hprons2011. If not, see * , or, scroll to the bottom of this file. *=============================================================================== PARAMETER (NELEM = 19) INTEGER DUMMY INTEGER IELEM(NELEM), ILOOP INTEGER IREAD, IWRT, JWRT INTEGER TCFLAG, ITEMP INTEGER INP1, INP2, IOUT1 INTEGER TCI, COEMAX CHARACTER*6 REF CHARACTER*9 DATE CHARACTER*20 NAME CHARACTER*9 CHRTMP CHARACTER*38 STRING CHARACTER ABBR(8) CHARACTER ABBR2(8) CHARACTER ECFORM(40) CHARACTER SCFORM(40) CHARACTER ELSYMB(NELEM,2) CHARACTER CHRTM2(9) CHARACTER BLNK REAL*8 DUMMY2 REAL*8 COELEM(NELEM) REAL*8 SELEM(NELEM) REAL*8 DFG, DFH, S, V REAL*8 CPA, CPB, CPC, CPD REAL*8 AV, BV, TC REAL*8 SMAX, TMAX DATA BLNK /' '/ INP1 = 4 INP2 = 5 INP3 = 6 IOUT1 = 10 IOUT2 = 11 * ENTROPY OF THE ELEMENTS - J/(mol*K) * Robie and Hemingway, 1995 SELEM(1) = 18.81 !Si SELEM(2) = 30.76 !Ti SELEM(3) = 28.30 !Al SELEM(4) = 27.09 !Fe SELEM(5) = 32.67 !Mg SELEM(6) = 32.01 !Mn SELEM(7) = 42.90 !Ca SELEM(8) = 51.46 !Na SELEM(9) = 64.67 !K SELEM(10) = 102.575 !O O2=205.15 SELEM(11) = 65.34 !H H2=130.68 SELEM(12) = 5.74 !C SELEM(13) = 111.54 !Cl Cl2=223.08 SELEM(14) = 0.0 !e- Not used SELEM(15) = 29.87 !Ni SELEM(16) = 38.87 !Zr SELEM(17) = 32.05 !S SELEM(18) = 33.14 !Cu SELEM(19) = 23.62 !Cr **** READ STRING INTO ELSYMBOL FOR WRITING THE **** ELEMENTAL STRUCTURAL FORMULA STRING = 'SiTiAlFeMgMnCaNaK O H C ClXXNiZrS CuCr' READ (STRING,'(40A1)') (ELSYMB(IREAD,1), ELSYMB(IREAD,2), + IREAD = 1,NELEM) OPEN (INP1 , FILE = 'HPTHRM2011.DAT', STATUS = 'OLD') OPEN (INP2 , FILE = 'HP_PTX.tbl' , STATUS = 'OLD') OPEN (IOUT1, FILE = 'HP_SPRON.OUT', STATUS = 'UNKNOWN') OPEN (IOUT2, FILE = 'MISSMINS.LST', STATUS = 'UNKNOWN') **** READ THE REFERENCE,DATE AND **** MAXIMUM TEMPERATURE FROM HPTHRM.DAT READ (INP1, '(A6)') REF READ (INP1, '(A9)') DATE READ (INP1, '(F7.2)') TMAX **** SET ECFORM AND SCFORM TO BLANKS 10 DO 640 ILOOP = 1,40 ECFORM(ILOOP) = ' ' SCFORM(ILOOP) = ' ' 640 CONTINUE **** READ AN HPTHRM.DAT RECORD READ (INP1,800) (ABBR(IREAD), IREAD = 1,8) 800 FORMAT (8A1) IF (ABBR(8).EQ.BLNK) GOTO 700 BACKSPACE INP1 READ (INP1,805) DUMMY, (IELEM(IREAD), + COELEM(IREAD), IREAD = 1,NELEM) 805 FORMAT (8X,I4,19(I3,F9.4)) READ (INP1,810) DFH, S, V 810 FORMAT (7x,F10.2,F10.5,F9.4) READ (INP1,820) CPA, CPB, CPC, CPD 820 FORMAT (F15.4,F15.9,F10.1,F10.4) READ (INP1,830) TCflag 830 FORMAT (50x,I3) IF (TCFLAG.EQ.1) THEN BACKSPACE INP1 READ (INP1,840) TCI 840 FORMAT (55X,I4) ELSE TCI = 1000 ENDIF **** CALCULATE DFG STOTAL = 0.0 K = 1 120 IF (IELEM(K).EQ.0) THEN GOTO 190 ELSE STOTAL = STOTAL+(SELEM(IELEM(K))*COELEM(K)) K = K + 1 GOTO 120 190 ENDIF STOTAL = S - STOTAL/1000 DFG = DFH - 298.15*STOTAL **** CONVERT TO CALORIES AND V FROM KJ/(KBAR*MOLE) TO CC/MOLE. **** **** NOTE THAT VALUES TABULATED IN HOLLAND AND POWELL'S TEXT **** FILE ARE ACTUAL VALUES, NOT MULTIPLIED BY ANY CONSTANTS, **** AS OPPOSED TO JOURNAL REFERENCE, WHERE S, b, aV, bV AND **** Smax ARE MULTIPLIED BY VARIOUS EXPONENTS OF 10. ENERGY **** UNITS ARE kJ.ADDITIONAL FACTORS FOR CPB, CPC ARE TO MATCH **** SPRONS/DPRONS FORMAT AND SUPCRT READ STATEMENTS. DFG = DFG /4.184 * 1000.0 DFH = DFH /4.184 * 1000.0 S = S /4.184 * 1000.0 SMAX = SMAX/4.184 * 1000.0 CPA = CPA /4.184 * 1000.0 CPB = CPB /4.184 * 1000.0 * 1000.0 CPC = CPC /4.184 * 1000.0 * 0.00001 CPD = CPD /4.184 * 1000.0 V = V * 10.0 TMAX = FLOAT(TCI) **** WRITE THE STRUCTURAL AND ELEMENTAL CHEMICAL FORMULAE **** INTO CHARACTER VARIABLES SCFORM AND ECFORM L = 1 L2 = 1 K = 1 220 IF (IELEM(K).NE.0) THEN SCFORM(L) = ELSYMB(IELEM(K),1) L = L + 1 ECFORM(L2) = ELSYMB(IELEM(K),1) L2 = L2 + 1 IF (ELSYMB(IELEM(K),2).NE.' ') THEN SCFORM(L) = ELSYMB(IELEM(K),2) L = L + 1 ECFORM(L2) = ELSYMB(IELEM(K),2) L2 = L2 + 1 ENDIF **** READ THE REAL COEFFICIENT COELEM INTO SCFORM AND ECFORM. FIRST **** CONVERT TO INTEGER ITEMP, THEN INTO CHARACTER*2 CHRTMP, THEN **** INTO CHARACTER CHRTM2(3) ECFORM(L2) = '(' L2 = L2 + 1 ITEMP = INT4(COELEM(K)) IF (ITEMP.EQ.1) THEN ECFORM(L2) = '1' L2 = L2 + 1 ELSE WRITE (CHRTMP,'(f9.4)') COELEM(K) READ (CHRTMP,'(9A1)') (CHRTM2(IREAD), IREAD = 1,9) DO 100, ILOOP = 1,4 IF (CHRTM2(ILOOP).NE.' ') THEN SCFORM(L) = CHRTM2(ILOOP) L = L + 1 ECFORM(L2) = CHRTM2(ILOOP) L2 = L2 + 1 ENDIF 100 CONTINUE COEMAX = 0 IF (CHRTM2(6).NE.'0') COEMAX = 6 IF (CHRTM2(7).NE.'0') COEMAX = 7 IF (CHRTM2(8).NE.'0') COEMAX = 8 IF (CHRTM2(9).NE.'0') COEMAX = 9 IF (COEMAX.GT.0) THEN SCFORM(L) = '.' L = L + 1 ECFORM(L2) = '.' L2 = L2 + 1 DO 200, ILOOP = 6,COEMAX SCFORM(L) = CHRTM2(ILOOP) L = L + 1 ECFORM(L2) = CHRTM2(ILOOP) L2 = L2 + 1 200 CONTINUE ENDIF ENDIF **** ALWAYS WRITE THE THIRD CHARACTER OF I3 INTEGER COELEM(K) **** AND CLOSING PARENTHESES FOR ECFORM. OMIT FROM SCFORM IF **** COELEM(K) = 1 ECFORM(L2) = ')' L2 = L2 + 1 K = K + 1 GOTO 220 300 ENDIF ******************************************************************************* ******************************************************************************* **** READ AN HP ABBREVIATION, ABBR2(8) AND **** A MINERAL NAME FROM LOOK-UP TABLE 155 READ (INP2,'(A1)') SKPREC IF (SKPREC.EQ.'*') GOTO 155 BACKSPACE INP2 310 READ (INP2,710) (ABBR2(IREAD), 2 IREAD = 1,8), NAME 710 FORMAT (22X,8A1,2X,A20) **** TEST IF HPTHRM.DAT ABBREVIATION ABBR MATCHES **** LOOK-UP TABLE ABBREVIATION ABBR2 AND CONTINUE IF (ABBR(8).EQ.ABBR2(8).AND. 2 ABBR(7).EQ.ABBR2(7).AND. 3 ABBR(6).EQ.ABBR2(6).AND. 4 ABBR(5).EQ.ABBR2(5).AND. 5 ABBR(4).EQ.ABBR2(4)) GOTO 320 **** OR REACH THE END OF THE FILE WITHOUT **** FINDING A MATCH--ALERT THE USER IF (ABBR2(8).EQ.BLNK) GOTO 315 GOTO 310 315 WRITE (IOUT2,'(A14,A4,8A1,A27)') ' WARNING: NAME', 2 ' FOR',ABBR,' NOT FOUND IN LOOK-UP TABLE' 320 REWIND INP2 **** MOVE ABBR FLUSH LEFT DO 400 ILOOP = 1,7 IF (ABBR(1).EQ.' ') THEN DO 350 KLOOP = 1,7 ABBR(KLOOP) = ABBR(KLOOP + 1) 350 CONTINUE ABBR(8) = ' ' ENDIF 400 CONTINUE **** WRITE A SPRONS92 RECORD. WRITE (IOUT1,900) NAME, (SCFORM(IWRT), + IWRT = 1,40) WRITE (IOUT1,910) (ABBR(IWRT), IWRT = 1,8), + (ECFORM(JWRT), JWRT = 1,40) WRITE (IOUT1,920) REF, DATE WRITE (IOUT1,930) DFG, DFH, S, V WRITE (IOUT1,940) CPA, CPB, CPC, CPD 430 WRITE (IOUT1,950) TMAX GOTO 10 700 WRITE (*,'(//,a,//)') ' \O/ Done! ' STOP **** OUTPUT FORMATS FOR SPRONS.DAT 900 FORMAT (1X,A20,40A1) 910 FORMAT (1X,8A1,12X,40A1) 920 FORMAT (1X,A6,14X,A9) 930 FORMAT (4X,2(2X,F12.1),2(2X,F8.3)) 940 FORMAT (4X,4(1X,F13.6)) 950 FORMAT (8X,F7.2,8X,F7.2,10X,F7.4) 960 FORMAT (8X,F7.2,20X,F8.4) 1000 FORMAT (I6,A1,A1) END