SUBROUTINE ACT_SPN(T, X2, X3, X4, X5, S1, S2, S3, S4, 1 XMG2TET, XFE2TET, XAL3TET, XFE3TET, XCR3TET, XMG2OCT, 2 XFE2OCT, XAL3OCT, XFE3OCT, XTI4OCT, XCR3OCT, 3 HERCYNITE, SPINEL, ULVOSPINEL, MAGNETITE, MGTITANATE, 4 MGFERRITE, CHROMITE, MGCHROMITE, LSTOP) C C T (input) Temperature (K) C X2 (input) mole fraction MgAl2O4 C X3 (input) mole fraction FeCr2O3 C X4 (input) mole fraction Fe2TiO4 C X5 (input) mole fraction Fe3O4 C S1 (output) ordering variable C S2 (output) ordering variable C S3 (output) ordering variable C S4 (output) ordering variable C XMG2TET (output) X Mg2+ on tetrahedral site C XFE2TET (output) X Fe2+ on tetrahedral site C XAL3TET (output) X Al3+ on tetrahedral site C XFE3TET (output) X Fe3+ on tetrahedral site C XCR3TET (output) X Cr3+ on tetrahedral site C XMG2OCT (output) X Mg2+ on octahedral site C XFE2OCT (output) X Fe2+ on octahedral site C XAL3OCT (output) X Al3+ on octahedral site C XFE3OCT (output) X Fe3+ on octahedral site C XTI4OCT (output) X Ti4+ on octahedral site C XCR3OCT (output) X Cr3+ on octahedral site C HERCYNITE (output) a of hercynite [ ref to Fe2+(Al,Al)2O4 ] C SPINEL (output) a of spinel [ ref to Mg(Al,Al)2O4 ] C ULVOSPINEL (output) a of ulvospinel [ ref to Fe2+(Fe2+,Ti)2O4 ] C MAGNETITE (output) a of magnetite [ ref to Fe3+(Fe2+,Fe3+)2O4 ] C MGTITANATE (output) a of Mg-titanate [ ref to Mg(Mg,Ti)2O4 ] C MGFERRITE (output) a of Mg-ferrite [ ref to Fe3+(Mg,Fe3+)2O4 ] C CHROMITE (output) a of chromite [ ref to Fe2+(Cr3+,Cr3+)2O4 ] C MGCHROMITE (output) a of Mg-chromite [ ref to Mg2+(Cr3+,Cr3+)2O4 ] C IMPLICIT DOUBLE PRECISION(A-H,O-Z) IMPLICIT INTEGER(I-N) C DOUBLE PRECISION MAGNETITE, MGTITANATE, MGFERRITE, MGCHROMITE LOGICAL LSTOP C COMMON /PARAM/ H11, S11, H55, S55, HX, SX, HEX, SEX, H24, S24, 1 H25, S25, W11, W22, W55, W15, W1P5, W15P, W1P5P, W14, W1P4, 2 W24U, W2P4U, W2P5U, W25PU, WOCT, WTET, W45, W45P, W4U5PU C COMMON /PARAMCR/ H33, S33, H23, S23, W33, W13, W1P3, W13P, 1 W1P3P, W2P3U, W23PU, W34, W3P4, W3PU4U, W35, W3P5, W35P, 2 W3P5P C H11 = -8.7 S11 = 0.0 W11 = 4.5 W14 = 20.8 W1P4 = 12.4 W15 = 10.0 W1P5 = 14.4 W15P = 11.7 W1P5P = 7.0 H21 = -88.40 S21 = -0.0098 W22 = 3.6 H24 = 6.55 S24 = 0.0000 W24U = 12.6 W2P4U = 10.9 H25 = 8.05 S25 = 0.0 W25PU = 15.3 W2P5U = 14.4 W45 = 6.0 W45P = 2.0 W4U5PU = 1.8 H55 = 6.25 S55 = 0.0 W55 = 0.0 HEX = -3.6 SEX = 0.0 HX = 2.4 SX = 0.0 WOCT = 2.0 WTET = 2.0 C H33 = -20.0 S33 = 0.0 H23 = 0.0 S23 = 0.0 W33 = 7.0 W13 = 10.0 W1P3 = 15.2 W13P = 11.3 W1P3P = 5.9 W2P3U = 10.0 W23PU = 9.7 W34 = 12.5 W3P4 = 10.0 W3PU4U = 10.4 W35 = 0.0 W3P5 = 10.0 W35P = 8.0 W3P5P = 0.0 C LSTOP = .FALSE. C C Get ordering parameters at this T (K) C T, X2, X3, X4 and X5 are input, other variables are returned C CALL ORD_SPN(T, X2, X3, X4, X5, S1, S2, S3, S4, 1 XMG2TET, XFE2TET, XAL3TET, XFE3TET, XCR3TET, XMG2OCT, 2 XFE2OCT, XAL3OCT, XFE3OCT, XTI4OCT, XCR3OCT, LSTOP) IF(LSTOP) THEN WRITE(*,1000) 1000 FORMAT(1X,78('*'),/, 1 1X,'%SPN_F_NCONV, Failed to converge in ordering parameter ', 2 'subroutine.',/, 2 1X,78('*')) HERCYNITE = 0.0 SPINEL = 0.0 ULVOSPINEL = 0.0 MAGNETITE = 0.0 MGTITANATE = 0.0 MGFERRITE = 0.0 CHROMITE = 0.0 MGCHROMITE = 0.0 RETURN END IF IF( ((XMG2TET.LT.0.0).AND.(ABS(XMG2TET).GT.1.0D-12)).OR. 1 ((XFE2TET.LT.0.0).AND.(ABS(XFE2TET).GT.1.0D-12)).OR. 2 ((XAL3TET.LT.0.0).AND.(ABS(XAL3TET).GT.1.0D-12)).OR. 3 ((XFE3TET.LT.0.0).AND.(ABS(XFE3TET).GT.1.0D-12)).OR. 4 ((XCR3TET.LT.0.0).AND.(ABS(XCR3TET).GT.1.0D-12)).OR. 5 ((XMG2OCT.LT.0.0).AND.(ABS(XMG2OCT).GT.1.0D-12)).OR. 6 ((XFE2OCT.LT.0.0).AND.(ABS(XFE2OCT).GT.1.0D-12)).OR. 7 ((XAL3OCT.LT.0.0).AND.(ABS(XAL3OCT).GT.1.0D-12)).OR. 8 ((XFE3OCT.LT.0.0).AND.(ABS(XFE3OCT).GT.1.0D-12)).OR. 9 ((XTI4OCT.LT.0.0).AND.(ABS(XTI4OCT).GT.1.0D-12)).OR. A ((XCR3OCT.LT.0.0).AND.(ABS(XCR3OCT).GT.1.0D-12)) ) THEN LSTOP = .TRUE. WRITE(*,1001) 1001 FORMAT(1X,78('*'),/, 1 1X,'%SPN_F_DEPN, Failed to converge. Ordering parameter ', 2 'relationship detected.',/, 3 1X,78('*')) HERCYNITE = 0.0 SPINEL = 0.0 ULVOSPINEL = 0.0 MAGNETITE = 0.0 MGTITANATE = 0.0 MGFERRITE = 0.0 CHROMITE = 0.0 MGCHROMITE = 0.0 IF(XMG2TET.LT.0.0) WRITE(*,1002) 'XMg2+ tet', XMG2TET 1002 FORMAT(14X,A9,' is equal to ',G20.13) IF(XFE2TET.LT.0.0) WRITE(*,1002) 'XFe2+ tet', XFE2TET IF(XAL3TET.LT.0.0) WRITE(*,1002) 'XAl3+ tet', XAL3TET IF(XFE3TET.LT.0.0) WRITE(*,1002) 'XFe3+ tet', XFE3TET IF(XCR3TET.LT.0.0) WRITE(*,1002) 'XCr3+ tet', XCR3TET IF(XMG2OCT.LT.0.0) WRITE(*,1002) 'XMg2+ oct', XMG2OCT IF(XFE2OCT.LT.0.0) WRITE(*,1002) 'XFe2+ oct', XFE2OCT IF(XAL3OCT.LT.0.0) WRITE(*,1002) 'XAl3+ oct', XAL3OCT IF(XFE3OCT.LT.0.0) WRITE(*,1002) 'XFe3+ oct', XFE3OCT IF(XTI4OCT.LT.0.0) WRITE(*,1002) 'XTi4+ oct', XTI4OCT IF(XCR3OCT.LT.0.0) WRITE(*,1002) 'XCr3+ oct', XCR3OCT RETURN END IF C G1 = 0.0 ! Standard state parameters in MACSYMA expressions G2 = 0.0 ! are zeroed out (this leaves them intact G3 = 0.0 G4 = 0.0 G5 = 0.0 R = 0.00198726 C G11 = H11 - T*S11 G33 = H33 - T*S33 G55 = H55 - T*S55 ! Not used in expressions below GX = HX - T*SX GEX = HEX - T*SEX G24 = H24 - T*S24 G23 = H23 - T*S23 G25 = H25 - T*S25 C C Activity expression generated by MACSYMA C HERCYNITE = W15*X5**2-W45*X4*X5+W15*X4*X5+W14*X4*X5-W35*X3*X5+W15* 1 X3*X5+W13*X3*X5-W2P5U*X2*X5/2.0+W22*X2*X5/2.0+W1P5*X2*X5/2.0-W1 2 1*X2*X5/2.0-G25*X2*X5-S4*W55*X5-S3*W3P5*X5+S3*W35*X5-S1*W2P5U*X 3 5/2.0+S1*W22*X5/2.0-S2*W1P5*X5+S1*W1P5*X5/2.0+W1P5*X5+S4*W15P*X 4 5-S4*W15*X5+S2*W15*X5-W15*X5+S3*W13P*X5-S3*W13*X5+S2*W11*X5-S1* 5 W11*X5/2.0-W11*X5+W14*X4**2-W34*X3*X4+W14*X3*X4+W13*X3*X4-WTET* 6 X2*X4/2.0+W24U*X2*X4/2.0-W14*X2*X4/2.0-GX*X2*X4/4.0+GEX*X2*X4/4 7 .0-G24*X2*X4/2.0-S1*WTET*X4/2.0-S4*W45P*X4+S4*W45*X4-S3*W3P4*X4 8 +S3*W34*X4+S1*W24U*X4/2.0-S2*W1P4*X4+W1P4*X4+S4*W15P*X4-S4*W15* 9 X4+S2*W14*X4-S1*W14*X4/2.0-W14*X4+S3*W13P*X4-S3*W13*X4+S2*W11*X : 4-W11*X4+GX*S1*X4/4.0-GEX*S1*X4/4.0+G24*S1*X4/2.0+W13*X3**2-W2P ; 3U*X2*X3/2.0+W22*X2*X3/2.0+W1P3*X2*X3/2.0-W11*X2*X3/2.0-G23*X2* < X3-S4*W35P*X3+S4*W35*X3-S3*W33*X3-S1*W2P3U*X3/2.0+S1*W22*X3/2.0 = -S2*W1P3*X3+S1*W1P3*X3/2.0+W1P3*X3+S4*W15P*X3-S4*W15*X3+S3*W13P > *X3-S3*W13*X3+S2*W13*X3-W13*X3+S2*W11*X3-S1*W11*X3/2.0-W11*X3+W ? TET*X2**2/4.0+WOCT*X2**2/4.0+GX*X2**2/4.0-S4*WTET*X2/2.0-S3*WTE @ T*X2/2.0-S2*WTET*X2/2.0+S1*WTET*X2/2.0+WTET*X2/2.0+S4*WOCT*X2/2 1 .0+S3*WOCT*X2/2.0+S2*WOCT*X2/2.0-S1*WOCT*X2/2.0-WOCT*X2/2.0-S4* 2 W4U5PU*X2+S4*W45P*X2-S3*W3PU4U*X2+S3*W3P4*X2+S4*W2P5U*X2/2.0-S2 3 *W2P4U*X2+W2P4U*X2+S3*W2P3U*X2/2.0+S4*W25PU*X2/2.0+S3*W23PU*X2/ 4 2.0-S4*W22*X2/2.0-S3*W22*X2/2.0+S2*W22*X2/2.0-W22*X2/2.0-S4*W1P 5 5*X2/2.0+S2*W1P4*X2-W1P4*X2-S3*W1P3*X2/2.0-S4*W15P*X2/2.0-S3*W1 6 3P*X2/2.0+S4*W11*X2/2.0+S3*W11*X2/2.0-S2*W11*X2/2.0+W11*X2/2.0+ 7 GEX*S4*X2/2.0+G25*S4*X2-G24*S4*X2+GEX*S3*X2/2.0-G24*S3*X2+G23*S 8 3*X2+GEX*S2*X2/2.0-G24*S2*X2-GEX*X2/2.0+G24*X2-S1*S4*WTET/2.0-S 9 1*S3*WTET/2.0-S1*S2*WTET/2.0+S1**2*WTET/4.0+S1*WTET/2.0-S1*S4*W : OCT/2.0-S1*S3*WOCT/2.0-S1*S2*WOCT/2.0+S1**2*WOCT/4.0+S1*WOCT/2. ; 0+S4**2*W55-S3*S4*W3P5P+S3*S4*W3P5+S3*S4*W35P-S3*S4*W35+S3**2*W < 33+S1*S4*W2P5U/2.0+S1*S3*W2P3U/2.0+S1*S4*W25PU/2.0+S1*S3*W23PU/ = 2.0-S1*S4*W22/2.0-S1*S3*W22/2.0+S1*S2*W22/2.0-S1*W22/2.0-S2*S4* > W1P5P+S4*W1P5P+S2*S4*W1P5-S1*S4*W1P5/2.0-S4*W1P5-S2*S3*W1P3P+S3 ? *W1P3P+S2*S3*W1P3-S1*S3*W1P3/2.0-S3*W1P3+S2*S4*W15P-S1*S4*W15P/ @ 2.0-S4*W15P-S2*S4*W15+S4*W15+S2*S3*W13P-S1*S3*W13P/2.0-S3*W13P- 1 S2*S3*W13+S3*W13+S1*S4*W11/2.0+S1*S3*W11/2.0+S2**2*W11-S1*S2*W1 2 1/2.0-2*S2*W11+S1*W11/2.0+W11+GX*S1*S4/2.0+GX*S1*S3/2.0+GX*S1*S 3 2/2.0-GX*S1**2/4.0-GX*S1/2.0+G11+G1 C IF((XFE2TET.GT.0.0).AND.(XAL3OCT.GT.0.0)) THEN HERCYNITE = HERCYNITE + R*T*(LOG(XFE2TET) + 2.0*LOG(XAL3OCT)) C Pure Hercynite: [x2=0, x3=0, x4=0, x5=0, s1=0, s3=0, s4=0] DX2 = 0.0D0 DX3 = 0.0D0 DX4 = 0.0D0 DX5 = 0.0D0 CALL ORD_SPN(T, DX2, DX3, DX4, DX5, DS1, DS2, DS3, DS4, 1 DUMMY1, DUMMY2, DUMMY3, DUMMY4, DUMMY5, DUMMY6, 2 DUMMY7, DUMMY8, DUMMY9, DUMMY10, DUMMY11, LSTOP) IF(LSTOP) WRITE(*,'(1X,''Failed in Hc call to ORD_SPN.'')') PURE = R*T*(2.0*LOG(DS2+1.0)+LOG(DS2)-2.0*LOG(2.0)) PURE = PURE + DS2**2*W11 - 2.0*DS2*W11 + W11 + G11 + G1 HERCYNITE = EXP((HERCYNITE-PURE)/(R*T)) ELSE HERCYNITE = 0.0 END IF C SPINEL = W15*X5**2-W45*X4*X5+W15*X4*X5+W14*X4*X5-W35*X3*X5+W15*X3* 1 X5+W13*X3*X5-W2P5U*X2*X5/2.0+W22*X2*X5/2.0+W1P5*X2*X5/2.0-W11*X 2 2*X5/2.0-G25*X2*X5-S4*W55*X5-S3*W3P5*X5+S3*W35*X5-S1*W2P5U*X5/2 3 .0+W2P5U*X5+S1*W22*X5/2.0-W22*X5-S2*W1P5*X5+S1*W1P5*X5/2.0+S4*W 4 15P*X5-S4*W15*X5+S2*W15*X5-W15*X5+S3*W13P*X5-S3*W13*X5+S2*W11*X 5 5-S1*W11*X5/2.0+G25*X5+W14*X4**2-W34*X3*X4+W14*X3*X4+W13*X3*X4- 6 WTET*X2*X4/2.0+W24U*X2*X4/2.0-W14*X2*X4/2.0-GX*X2*X4/4.0+GEX*X2 7 *X4/4.0-G24*X2*X4/2.0-S1*WTET*X4/2.0+WTET*X4-S4*W45P*X4+S4*W45* 8 X4-S3*W3P4*X4+S3*W34*X4+S1*W24U*X4/2.0-W24U*X4-S2*W1P4*X4+W1P4* 9 X4+S4*W15P*X4-S4*W15*X4+S2*W14*X4-S1*W14*X4/2.0+S3*W13P*X4-S3*W : 13*X4+S2*W11*X4-W11*X4+GX*S1*X4/4.0-GEX*S1*X4/4.0+G24*S1*X4/2.0 ; +W13*X3**2-W2P3U*X2*X3/2.0+W22*X2*X3/2.0+W1P3*X2*X3/2.0-W11*X2* < X3/2.0-G23*X2*X3-S4*W35P*X3+S4*W35*X3-S3*W33*X3-S1*W2P3U*X3/2.0 = +W2P3U*X3+S1*W22*X3/2.0-W22*X3-S2*W1P3*X3+S1*W1P3*X3/2.0+S4*W15 > P*X3-S4*W15*X3+S3*W13P*X3-S3*W13*X3+S2*W13*X3-W13*X3+S2*W11*X3- ? S1*W11*X3/2.0+G23*X3+WTET*X2**2/4.0+WOCT*X2**2/4.0+GX*X2**2/4.0 @ -S4*WTET*X2/2.0-S3*WTET*X2/2.0-S2*WTET*X2/2.0+S1*WTET*X2/2.0-WT 1 ET*X2/2.0+S4*WOCT*X2/2.0+S3*WOCT*X2/2.0+S2*WOCT*X2/2.0-S1*WOCT* 2 X2/2.0-WOCT*X2/2.0-S4*W4U5PU*X2+S4*W45P*X2-S3*W3PU4U*X2+S3*W3P4 3 *X2+S4*W2P5U*X2/2.0-S2*W2P4U*X2+W2P4U*X2+S3*W2P3U*X2/2.0+S4*W25 4 PU*X2/2.0+S3*W23PU*X2/2.0-S4*W22*X2/2.0-S3*W22*X2/2.0+S2*W22*X2 5 /2.0-W22*X2/2.0-S4*W1P5*X2/2.0+S2*W1P4*X2-W1P4*X2-S3*W1P3*X2/2. 6 0-S4*W15P*X2/2.0-S3*W13P*X2/2.0+S4*W11*X2/2.0+S3*W11*X2/2.0-S2* 7 W11*X2/2.0+W11*X2/2.0+GEX*S4*X2/2.0+G25*S4*X2-G24*S4*X2+GEX*S3* 8 X2/2.0-G24*S3*X2+G23*S3*X2+GEX*S2*X2/2.0-G24*S2*X2-GX*X2/2.0-GE 9 X*X2/2.0+G24*X2-S1*S4*WTET/2.0+S4*WTET-S1*S3*WTET/2.0+S3*WTET-S : 1*S2*WTET/2.0+S2*WTET+S1**2*WTET/4.0-S1*WTET/2.0-S1*S4*WOCT/2.0 ; -S1*S3*WOCT/2.0-S1*S2*WOCT/2.0+S1**2*WOCT/4.0+S1*WOCT/2.0+S4**2 < *W55+S4*W4U5PU-S4*W45P+S3*W3PU4U-S3*S4*W3P5P+S3*S4*W3P5-S3*W3P4 = +S3*S4*W35P-S3*S4*W35+S3**2*W33+S1*S4*W2P5U/2.0-S4*W2P5U+S2*W2P > 4U+S1*S3*W2P3U/2.0-S3*W2P3U+S1*S4*W25PU/2.0-S4*W25PU+W24U+S1*S3 ? *W23PU/2.0-S3*W23PU-S1*S4*W22/2.0+S4*W22-S1*S3*W22/2.0+S3*W22+S @ 1*S2*W22/2.0-S2*W22-S1*W22/2.0-S2*S4*W1P5P+S4*W1P5P+S2*S4*W1P5- 1 S1*S4*W1P5/2.0-S2*W1P4-S2*S3*W1P3P+S3*W1P3P+S2*S3*W1P3-S1*S3*W1 2 P3/2.0+S2*S4*W15P-S1*S4*W15P/2.0-S2*S4*W15+S4*W15-W14+S2*S3*W13 3 P-S1*S3*W13P/2.0-S2*S3*W13+S3*W13+S1*S4*W11/2.0-S4*W11+S1*S3*W1 4 1/2.0-S3*W11+S2**2*W11-S1*S2*W11/2.0-S2*W11+S1*W11/2.0+W11+GX*S 5 1*S4/2.0-GX*S4/2.0-GEX*S4/2.0-G25*S4+G24*S4+GX*S1*S3/2.0-GX*S3/ 6 2.0-GEX*S3/2.0+G24*S3-G23*S3+GX*S1*S2/2.0-GX*S2/2.0-GEX*S2/2.0+ 7 G24*S2-GX*S1**2/4.0+GX/2.0+GEX/2.0+G24+G2+G11 C IF((XMG2TET.GT.0.0).AND.(XAL3OCT.GT.0.0)) THEN SPINEL = SPINEL + R*T*(LOG(XMG2TET) + 2.0*LOG(XAL3OCT)) C Pure Spinel: [x2=1, x3=0, x4=0, x5=0, s1=2*s2-1, s3=0, s4=0] DX2 = 1.0D0 DX3 = 0.0D0 DX4 = 0.0D0 DX5 = 0.0D0 CALL ORD_SPN(T, DX2, DX3, DX4, DX5, DS1, DS2, DS3, DS4, 1 DUMMY1, DUMMY2, DUMMY3, DUMMY4, DUMMY5, DUMMY6, 2 DUMMY7, DUMMY8, DUMMY9, DUMMY10, DUMMY11, LSTOP) IF(LSTOP) WRITE(*,'(1X,''Failed in Sp call to ORD_SPN.'')') PURE = R*T*(2.0*LOG(DS2+1.0)+LOG(DS2)-2.0*LOG(2.0)) PURE = PURE + W2P4U + W24U + DS2**2*W22 - 2.0*DS2*W22 - W1P4 1 - W14 + W11 + 2.0*G24 + G2 + G11 SPINEL = EXP((SPINEL-PURE)/(R*T)) ELSE SPINEL = 0.0 END IF C ULVOSPINEL = W15*X5**2-W45*X4*X5+W15*X4*X5+W14*X4*X5-W35*X3*X5+W15 1 *X3*X5+W13*X3*X5-W2P5U*X2*X5/2.0+W22*X2*X5/2.0+W1P5*X2*X5/2.0-W 2 11*X2*X5/2.0-G25*X2*X5-S4*W55*X5+W45*X5-S3*W3P5*X5+S3*W35*X5-S1 3 *W2P5U*X5/2.0+S1*W22*X5/2.0-S2*W1P5*X5+S1*W1P5*X5/2.0+S4*W15P*X 4 5-S4*W15*X5+S2*W15*X5-W15*X5-W14*X5+S3*W13P*X5-S3*W13*X5+S2*W11 5 *X5-S1*W11*X5/2.0+W14*X4**2-W34*X3*X4+W14*X3*X4+W13*X3*X4-WTET* 6 X2*X4/2.0+W24U*X2*X4/2.0-W14*X2*X4/2.0-GX*X2*X4/4.0+GEX*X2*X4/4 7 .0-G24*X2*X4/2.0-S1*WTET*X4/2.0-S4*W45P*X4+S4*W45*X4-S3*W3P4*X4 8 +S3*W34*X4+S1*W24U*X4/2.0-S2*W1P4*X4+S4*W15P*X4-S4*W15*X4+S2*W1 9 4*X4-S1*W14*X4/2.0-2*W14*X4+S3*W13P*X4-S3*W13*X4+S2*W11*X4+GX*S : 1*X4/4.0-GEX*S1*X4/4.0+G24*S1*X4/2.0+W13*X3**2-W2P3U*X2*X3/2.0+ ; W22*X2*X3/2.0+W1P3*X2*X3/2.0-W11*X2*X3/2.0-G23*X2*X3-S4*W35P*X3 < +S4*W35*X3+W34*X3-S3*W33*X3-S1*W2P3U*X3/2.0+S1*W22*X3/2.0-S2*W1 = P3*X3+S1*W1P3*X3/2.0+S4*W15P*X3-S4*W15*X3-W14*X3+S3*W13P*X3-S3* > W13*X3+S2*W13*X3-W13*X3+S2*W11*X3-S1*W11*X3/2.0+WTET*X2**2/4.0+ ? WOCT*X2**2/4.0+GX*X2**2/4.0-S4*WTET*X2/2.0-S3*WTET*X2/2.0-S2*WT @ ET*X2/2.0+S1*WTET*X2/2.0+WTET*X2/2.0+S4*WOCT*X2/2.0+S3*WOCT*X2/ 1 2.0+S2*WOCT*X2/2.0-S1*WOCT*X2/2.0-S4*W4U5PU*X2+S4*W45P*X2-S3*W3 2 PU4U*X2+S3*W3P4*X2+S4*W2P5U*X2/2.0-S2*W2P4U*X2+S3*W2P3U*X2/2.0+ 3 S4*W25PU*X2/2.0-W24U*X2/2.0+S3*W23PU*X2/2.0-S4*W22*X2/2.0-S3*W2 4 2*X2/2.0+S2*W22*X2/2.0-S4*W1P5*X2/2.0+S2*W1P4*X2-S3*W1P3*X2/2.0 5 -S4*W15P*X2/2.0+W14*X2/2.0-S3*W13P*X2/2.0+S4*W11*X2/2.0+S3*W11* 6 X2/2.0-S2*W11*X2/2.0+GEX*S4*X2/2.0+G25*S4*X2-G24*S4*X2+GEX*S3*X 7 2/2.0-G24*S3*X2+G23*S3*X2+GEX*S2*X2/2.0-G24*S2*X2+GX*X2/4.0-GEX 8 *X2/4.0+G24*X2/2.0-S1*S4*WTET/2.0-S1*S3*WTET/2.0-S1*S2*WTET/2.0 9 +S1**2*WTET/4.0+S1*WTET/2.0-S1*S4*WOCT/2.0-S1*S3*WOCT/2.0-S1*S2 : *WOCT/2.0+S1**2*WOCT/4.0+S4**2*W55+S4*W45P-S4*W45-S3*S4*W3P5P+S ; 3*S4*W3P5+S3*W3P4+S3*S4*W35P-S3*S4*W35-S3*W34+S3**2*W33+S1*S4*W < 2P5U/2.0+S1*S3*W2P3U/2.0+S1*S4*W25PU/2.0-S1*W24U/2.0+S1*S3*W23P = U/2.0-S1*S4*W22/2.0-S1*S3*W22/2.0+S1*S2*W22/2.0-S2*S4*W1P5P+S2* > S4*W1P5-S1*S4*W1P5/2.0+S2*W1P4-S2*S3*W1P3P+S2*S3*W1P3-S1*S3*W1P ? 3/2.0+S2*S4*W15P-S1*S4*W15P/2.0-S4*W15P-S2*S4*W15+S4*W15-S2*W14 @ +S1*W14/2.0+W14+S2*S3*W13P-S1*S3*W13P/2.0-S3*W13P-S2*S3*W13+S3* 1 W13+S1*S4*W11/2.0+S1*S3*W11/2.0+S2**2*W11-S1*S2*W11/2.0-S2*W11+ 2 GX*S1*S4/2.0+GX*S1*S3/2.0+GX*S1*S2/2.0-GX*S1**2/4.0-GX*S1/4.0+G 3 EX*S1/4.0-G24*S1/2.0+G4 C IF((XFE2TET.GT.0.0).AND. 1 (XFE2OCT.GT.0.0).AND.(XTI4OCT.GT.0.0)) THEN ULVOSPINEL = ULVOSPINEL + R*T*(LOG(XFE2TET) + LOG(XFE2OCT) 1 + LOG(XTI4OCT)) C Pure Ulvospinel: [x2=0, x3=0, x4=1, x5=0, s1=0, s2=0, s3=0, s4=0] PURE = - 2.0*R*T*LOG(2.0) + G4 ULVOSPINEL = EXP((ULVOSPINEL-PURE)/(R*T)) ELSE ULVOSPINEL = 0.0 END IF C MAGNETITE = W15*X5**2-W45*X4*X5+W15*X4*X5+W14*X4*X5-W35*X3*X5+W15* 1 X3*X5+W13*X3*X5-W2P5U*X2*X5/2.0+W22*X2*X5/2.0+W1P5*X2*X5/2.0-W1 2 1*X2*X5/2.0-G25*X2*X5-S4*W55*X5-S3*W3P5*X5+S3*W35*X5-S1*W2P5U*X 3 5/2.0+S1*W22*X5/2.0-S2*W1P5*X5+S1*W1P5*X5/2.0+S4*W15P*X5-S4*W15 4 *X5+S2*W15*X5-2*W15*X5+S3*W13P*X5-S3*W13*X5+S2*W11*X5-S1*W11*X5 5 /2.0+W14*X4**2-W34*X3*X4+W14*X3*X4+W13*X3*X4-WTET*X2*X4/2.0+W24 6 U*X2*X4/2.0-W14*X2*X4/2.0-GX*X2*X4/4.0+GEX*X2*X4/4.0-G24*X2*X4/ 7 2.0-S1*WTET*X4/2.0-S4*W45P*X4+S4*W45*X4+W45*X4-S3*W3P4*X4+S3*W3 8 4*X4+S1*W24U*X4/2.0-S2*W1P4*X4+S4*W15P*X4-S4*W15*X4-W15*X4+S2*W 9 14*X4-S1*W14*X4/2.0-W14*X4+S3*W13P*X4-S3*W13*X4+S2*W11*X4+GX*S1 : *X4/4.0-GEX*S1*X4/4.0+G24*S1*X4/2.0+W13*X3**2-W2P3U*X2*X3/2.0+W ; 22*X2*X3/2.0+W1P3*X2*X3/2.0-W11*X2*X3/2.0-G23*X2*X3-S4*W35P*X3+ < S4*W35*X3+W35*X3-S3*W33*X3-S1*W2P3U*X3/2.0+S1*W22*X3/2.0-S2*W1P = 3*X3+S1*W1P3*X3/2.0+S4*W15P*X3-S4*W15*X3-W15*X3+S3*W13P*X3-S3*W > 13*X3+S2*W13*X3-W13*X3+S2*W11*X3-S1*W11*X3/2.0+WTET*X2**2/4.0+W ? OCT*X2**2/4.0+GX*X2**2/4.0-S4*WTET*X2/2.0-S3*WTET*X2/2.0-S2*WTE @ T*X2/2.0+S1*WTET*X2/2.0+S4*WOCT*X2/2.0+S3*WOCT*X2/2.0+S2*WOCT*X 1 2/2.0-S1*WOCT*X2/2.0-S4*W4U5PU*X2+S4*W45P*X2-S3*W3PU4U*X2+S3*W3 2 P4*X2+S4*W2P5U*X2/2.0+W2P5U*X2/2.0-S2*W2P4U*X2+S3*W2P3U*X2/2.0+ 3 S4*W25PU*X2/2.0+S3*W23PU*X2/2.0-S4*W22*X2/2.0-S3*W22*X2/2.0+S2* 4 W22*X2/2.0-W22*X2/2.0-S4*W1P5*X2/2.0-W1P5*X2/2.0+S2*W1P4*X2-S3* 5 W1P3*X2/2.0-S4*W15P*X2/2.0-S3*W13P*X2/2.0+S4*W11*X2/2.0+S3*W11* 6 X2/2.0-S2*W11*X2/2.0+W11*X2/2.0+GEX*S4*X2/2.0+G25*S4*X2-G24*S4* 7 X2+GEX*S3*X2/2.0-G24*S3*X2+G23*S3*X2+GEX*S2*X2/2.0-G24*S2*X2+G2 8 5*X2-S1*S4*WTET/2.0-S1*S3*WTET/2.0-S1*S2*WTET/2.0+S1**2*WTET/4. 9 0-S1*S4*WOCT/2.0-S1*S3*WOCT/2.0-S1*S2*WOCT/2.0+S1**2*WOCT/4.0+S : 4**2*W55+S4*W55-S3*S4*W3P5P+S3*S4*W3P5+S3*W3P5+S3*S4*W35P-S3*S4 ; *W35-S3*W35+S3**2*W33+S1*S4*W2P5U/2.0+S1*W2P5U/2.0+S1*S3*W2P3U/ < 2.0+S1*S4*W25PU/2.0+S1*S3*W23PU/2.0-S1*S4*W22/2.0-S1*S3*W22/2.0 = +S1*S2*W22/2.0-S1*W22/2.0-S2*S4*W1P5P+S2*S4*W1P5-S1*S4*W1P5/2.0 > +S2*W1P5-S1*W1P5/2.0-S2*S3*W1P3P+S2*S3*W1P3-S1*S3*W1P3/2.0+S2*S ? 4*W15P-S1*S4*W15P/2.0-S4*W15P-S2*S4*W15+S4*W15-S2*W15+W15+S2*S3 @ *W13P-S1*S3*W13P/2.0-S3*W13P-S2*S3*W13+S3*W13+S1*S4*W11/2.0+S1* 1 S3*W11/2.0+S2**2*W11-S1*S2*W11/2.0-S2*W11+S1*W11/2.0+GX*S1*S4/2 2 .0+GX*S1*S3/2.0+GX*S1*S2/2.0-GX*S1**2/4.0+G5 C IF((XFE3TET.GT.0.0).AND. 1 (XFE2OCT.GT.0.0).AND.(XFE3OCT.GT.0.0)) THEN MAGNETITE = MAGNETITE + R*T*(LOG(XFE3TET) + LOG(XFE3OCT) + 1 LOG(XFE2OCT)) C Pure Magnetite: [x2=0, x3=0, x4=0, x5=1, s1=0, s2=0, s3=0] DX2 = 0.0D0 DX3 = 0.0D0 DX4 = 0.0D0 DX5 = 1.0D0 CALL ORD_SPN(T, DX2, DX3, DX4, DX5, DS1, DS2, DS3, DS4, 1 DUMMY1, DUMMY2, DUMMY3, DUMMY4, DUMMY5, DUMMY6, 2 DUMMY7, DUMMY8, DUMMY9, DUMMY10, DUMMY11, LSTOP) IF(LSTOP) WRITE(*,'(1X,''Failed in Mt call to ORD_SPN.'')') PURE = R*T*(LOG(DS4+1.0)+2.0*LOG(1.0-DS4)-2.0*LOG(2.0)) PURE = PURE + DS4**2*W55 + G5 MAGNETITE = EXP((MAGNETITE-PURE)/(R*T)) ELSE MAGNETITE = 0.0 END IF C MGTITANATE = W15*X5**2-W45*X4*X5+W15*X4*X5+W14*X4*X5-W35*X3*X5+W15 1 *X3*X5+W13*X3*X5-W2P5U*X2*X5/2.0+W22*X2*X5/2.0+W1P5*X2*X5/2.0-W 2 11*X2*X5/2.0-G25*X2*X5-S4*W55*X5+W45*X5-S3*W3P5*X5+S3*W35*X5-S1 3 *W2P5U*X5/2.0+W2P5U*X5+S1*W22*X5/2.0-W22*X5-S2*W1P5*X5+S1*W1P5* 4 X5/2.0-W1P5*X5+S4*W15P*X5-S4*W15*X5+S2*W15*X5-W15*X5-W14*X5+S3* 5 W13P*X5-S3*W13*X5+S2*W11*X5-S1*W11*X5/2.0+W11*X5+2*G25*X5+W14*X 6 4**2-W34*X3*X4+W14*X3*X4+W13*X3*X4-WTET*X2*X4/2.0+W24U*X2*X4/2. 7 0-W14*X2*X4/2.0-GX*X2*X4/4.0+GEX*X2*X4/4.0-G24*X2*X4/2.0-S1*WTE 8 T*X4/2.0+WTET*X4-S4*W45P*X4+S4*W45*X4-S3*W3P4*X4+S3*W34*X4+S1*W 9 24U*X4/2.0-W24U*X4-S2*W1P4*X4+S4*W15P*X4-S4*W15*X4+S2*W14*X4-S1 : *W14*X4/2.0-W14*X4+S3*W13P*X4-S3*W13*X4+S2*W11*X4+GX*S1*X4/4.0- ; GEX*S1*X4/4.0+G24*S1*X4/2.0+GX*X4/2.0-GEX*X4/2.0+G24*X4+W13*X3* < *2-W2P3U*X2*X3/2.0+W22*X2*X3/2.0+W1P3*X2*X3/2.0-W11*X2*X3/2.0-G = 23*X2*X3-S4*W35P*X3+S4*W35*X3+W34*X3-S3*W33*X3-S1*W2P3U*X3/2.0+ > W2P3U*X3+S1*W22*X3/2.0-W22*X3-S2*W1P3*X3+S1*W1P3*X3/2.0-W1P3*X3 ? +S4*W15P*X3-S4*W15*X3-W14*X3+S3*W13P*X3-S3*W13*X3+S2*W13*X3-W13 @ *X3+S2*W11*X3-S1*W11*X3/2.0+W11*X3+2*G23*X3+WTET*X2**2/4.0+WOCT 1 *X2**2/4.0+GX*X2**2/4.0-S4*WTET*X2/2.0-S3*WTET*X2/2.0-S2*WTET*X 2 2/2.0+S1*WTET*X2/2.0-WTET*X2/2.0+S4*WOCT*X2/2.0+S3*WOCT*X2/2.0+ 3 S2*WOCT*X2/2.0-S1*WOCT*X2/2.0-WOCT*X2-S4*W4U5PU*X2+S4*W45P*X2-S 4 3*W3PU4U*X2+S3*W3P4*X2+S4*W2P5U*X2/2.0-S2*W2P4U*X2+S3*W2P3U*X2/ 5 2.0+S4*W25PU*X2/2.0-W24U*X2/2.0+S3*W23PU*X2/2.0-S4*W22*X2/2.0-S 6 3*W22*X2/2.0+S2*W22*X2/2.0-S4*W1P5*X2/2.0+S2*W1P4*X2-S3*W1P3*X2 7 /2.0-S4*W15P*X2/2.0+W14*X2/2.0-S3*W13P*X2/2.0+S4*W11*X2/2.0+S3* 8 W11*X2/2.0-S2*W11*X2/2.0+GEX*S4*X2/2.0+G25*S4*X2-G24*S4*X2+GEX* 9 S3*X2/2.0-G24*S3*X2+G23*S3*X2+GEX*S2*X2/2.0-G24*S2*X2+(-3.0*GX* : X2)/4.0-GEX*X2/4.0+G24*X2/2.0-S1*S4*WTET/2.0+S4*WTET-S1*S3*WTET ; /2.0+S3*WTET-S1*S2*WTET/2.0+S2*WTET+S1**2*WTET/4.0-S1*WTET/2.0- < S1*S4*WOCT/2.0-S4*WOCT-S1*S3*WOCT/2.0-S3*WOCT-S1*S2*WOCT/2.0-S2 = *WOCT+S1**2*WOCT/4.0+S1*WOCT+WOCT+S4**2*W55+2*S4*W4U5PU-S4*W45P > -S4*W45+2*S3*W3PU4U-S3*S4*W3P5P+S3*S4*W3P5-S3*W3P4+S3*S4*W35P-S ? 3*S4*W35-S3*W34+S3**2*W33+S1*S4*W2P5U/2.0-S4*W2P5U+2*S2*W2P4U+S @ 1*S3*W2P3U/2.0-S3*W2P3U+S1*S4*W25PU/2.0-S4*W25PU-S1*W24U/2.0+W2 1 4U+S1*S3*W23PU/2.0-S3*W23PU-S1*S4*W22/2.0+S4*W22-S1*S3*W22/2.0+ 2 S3*W22+S1*S2*W22/2.0-S2*W22-S2*S4*W1P5P+S2*S4*W1P5-S1*S4*W1P5/2 3 .0+S4*W1P5-S2*W1P4-S2*S3*W1P3P+S2*S3*W1P3-S1*S3*W1P3/2.0+S3*W1P 4 3+S2*S4*W15P-S1*S4*W15P/2.0-S2*S4*W15+S4*W15-S2*W14+S1*W14/2.0+ 5 S2*S3*W13P-S1*S3*W13P/2.0-S2*S3*W13+S3*W13+S1*S4*W11/2.0-S4*W11 6 +S1*S3*W11/2.0-S3*W11+S2**2*W11-S1*S2*W11/2.0+GX*S1*S4/2.0-GEX* 7 S4-2*G25*S4+2*G24*S4+GX*S1*S3/2.0-GEX*S3+2*G24*S3-2*G23*S3+GX*S 8 1*S2/2.0-GEX*S2+2*G24*S2-GX*S1**2/4.0-GX*S1/4.0+GEX*S1/4.0-G24* 9 S1/2.0+GX/2.0+GEX/2.0+G4+G24+2*G2-2*G1 C IF((XMG2TET.GT.0.0).AND. 1 (XMG2OCT.GT.0.0).AND.(XTI4OCT.GT.0.0)) THEN MGTITANATE = MGTITANATE + R*T*(LOG(XMG2TET) + LOG(XMG2OCT) + 1 LOG(XTI4OCT)) C Pure Mg-Titanate: [x2=2, x3=0, x4=1, x5=0, s1=0, s2=0, s3=0, s4=0] PURE = - 2.0*R*T*LOG(2.0) PURE = PURE + G4 + 2.0*G24 + 2.0*G2 - 2.0*G1 MGTITANATE = EXP((MGTITANATE-PURE)/(R*T)) ELSE MGTITANATE = 0.0 END IF C MGFERRITE = W15*X5**2-W45*X4*X5+W15*X4*X5+W14*X4*X5-W35*X3*X5+W15* 1 X3*X5+W13*X3*X5-W2P5U*X2*X5/2.0+W22*X2*X5/2.0+W1P5*X2*X5/2.0-W1 2 1*X2*X5/2.0-G25*X2*X5-S4*W55*X5-S3*W3P5*X5+S3*W35*X5-S1*W2P5U*X 3 5/2.0+S1*W22*X5/2.0-S2*W1P5*X5+S1*W1P5*X5/2.0+S4*W15P*X5-S4*W15 4 *X5+S2*W15*X5-2*W15*X5+S3*W13P*X5-S3*W13*X5+S2*W11*X5-S1*W11*X5 5 /2.0+G25*X5+W14*X4**2-W34*X3*X4+W14*X3*X4+W13*X3*X4-WTET*X2*X4/ 6 2.0+W24U*X2*X4/2.0-W14*X2*X4/2.0-GX*X2*X4/4.0+GEX*X2*X4/4.0-G24 7 *X2*X4/2.0-S1*WTET*X4/2.0-S4*W45P*X4+S4*W45*X4+W45*X4-S3*W3P4*X 8 4+S3*W34*X4+S1*W24U*X4/2.0-S2*W1P4*X4+S4*W15P*X4-S4*W15*X4-W15* 9 X4+S2*W14*X4-S1*W14*X4/2.0-W14*X4+S3*W13P*X4-S3*W13*X4+S2*W11*X : 4+GX*S1*X4/4.0-GEX*S1*X4/4.0+G24*S1*X4/2.0+GX*X4/2.0-GEX*X4/2.0 ; +G24*X4+W13*X3**2-W2P3U*X2*X3/2.0+W22*X2*X3/2.0+W1P3*X2*X3/2.0- < W11*X2*X3/2.0-G23*X2*X3-S4*W35P*X3+S4*W35*X3+W35*X3-S3*W33*X3-S = 1*W2P3U*X3/2.0+S1*W22*X3/2.0-S2*W1P3*X3+S1*W1P3*X3/2.0+S4*W15P* > X3-S4*W15*X3-W15*X3+S3*W13P*X3-S3*W13*X3+S2*W13*X3-W13*X3+S2*W1 ? 1*X3-S1*W11*X3/2.0+G23*X3+WTET*X2**2/4.0+WOCT*X2**2/4.0+GX*X2** @ 2/4.0-S4*WTET*X2/2.0-S3*WTET*X2/2.0-S2*WTET*X2/2.0+S1*WTET*X2/2 1 .0+S4*WOCT*X2/2.0+S3*WOCT*X2/2.0+S2*WOCT*X2/2.0-S1*WOCT*X2/2.0- 2 WOCT*X2-S4*W4U5PU*X2+S4*W45P*X2-S3*W3PU4U*X2+S3*W3P4*X2+S4*W2P5 3 U*X2/2.0+W2P5U*X2/2.0-S2*W2P4U*X2+S3*W2P3U*X2/2.0+S4*W25PU*X2/2 4 .0+S3*W23PU*X2/2.0-S4*W22*X2/2.0-S3*W22*X2/2.0+S2*W22*X2/2.0-W2 5 2*X2/2.0-S4*W1P5*X2/2.0-W1P5*X2/2.0+S2*W1P4*X2-S3*W1P3*X2/2.0-S 6 4*W15P*X2/2.0-S3*W13P*X2/2.0+S4*W11*X2/2.0+S3*W11*X2/2.0-S2*W11 7 *X2/2.0+W11*X2/2.0+GEX*S4*X2/2.0+G25*S4*X2-G24*S4*X2+GEX*S3*X2/ 8 2.0-G24*S3*X2+G23*S3*X2+GEX*S2*X2/2.0-G24*S2*X2-GX*X2/2.0+G25*X 9 2-S1*S4*WTET/2.0-S1*S3*WTET/2.0-S1*S2*WTET/2.0+S1**2*WTET/4.0-S : 1*S4*WOCT/2.0-S4*WOCT-S1*S3*WOCT/2.0-S3*WOCT-S1*S2*WOCT/2.0-S2* ; WOCT+S1**2*WOCT/4.0+S1*WOCT+WOCT+S4**2*W55+S4*W55+S4*W4U5PU-S4* < W45P+S3*W3PU4U-S3*S4*W3P5P+S3*S4*W3P5+S3*W3P5-S3*W3P4+S3*S4*W35 = P-S3*S4*W35-S3*W35+S3**2*W33+S1*S4*W2P5U/2.0+S1*W2P5U/2.0+S2*W2 > P4U+S1*S3*W2P3U/2.0+S1*S4*W25PU/2.0+S1*S3*W23PU/2.0-S1*S4*W22/2 ? .0-S1*S3*W22/2.0+S1*S2*W22/2.0-S1*W22/2.0-S2*S4*W1P5P+S2*S4*W1P @ 5-S1*S4*W1P5/2.0+S2*W1P5-S1*W1P5/2.0-S2*W1P4-S2*S3*W1P3P+S2*S3* 1 W1P3-S1*S3*W1P3/2.0+S2*S4*W15P-S1*S4*W15P/2.0-S4*W15P-S2*S4*W15 2 +S4*W15-S2*W15+W15+S2*S3*W13P-S1*S3*W13P/2.0-S3*W13P-S2*S3*W13+ 3 S3*W13+S1*S4*W11/2.0+S1*S3*W11/2.0+S2**2*W11-S1*S2*W11/2.0-S2*W 4 11+S1*W11/2.0+GX*S1*S4/2.0+GX*S4/2.0-GEX*S4/2.0-G25*S4+G24*S4+G 5 X*S1*S3/2.0+GX*S3/2.0-GEX*S3/2.0+G24*S3-G23*S3+GX*S1*S2/2.0+GX* 6 S2/2.0-GEX*S2/2.0+G24*S2-GX*S1**2/4.0-GX*S1/2.0+G5+G2-G1 C IF((XFE3TET.GT.0.0).AND. 1 (XMG2OCT.GT.0.0).AND.(XFE3OCT.GT.0.0)) THEN MGFERRITE = MGFERRITE + R*T*(LOG(XFE3TET) + LOG(XMG2OCT) + 1 LOG(XFE3OCT)) C Pure Mg-Ferrite: [x2=1, x3=0, x4=0, x5=1, s1=2*s4-1, s2=0, s3=0] DX2 = 1.0D0 DX3 = 0.0D0 DX4 = 0.0D0 DX5 = 1.0D0 CALL ORD_SPN(T, DX2, DX3, DX4, DX5, DS1, DS2, DS3, DS4, 1 DUMMY1, DUMMY2, DUMMY3, DUMMY4, DUMMY5, DUMMY6, 2 DUMMY7, DUMMY8, DUMMY9, DUMMY10, DUMMY11, LSTOP) IF(LSTOP) WRITE(*,'(1X,''Failed in Mf call to ORD_SPN.'')') PURE = R*T*(LOG(DS4+1.0)+2.0*LOG(1.0-DS4)-2.0*LOG(2.0)) PURE = PURE + DS4**2*W55 + DS4**2*W2P5U + DS4**2*W25PU 1 - DS4**2*W22 - DS4**2*W1P5 - DS4**2*W15P + DS4**2*W11 2 + G5 + G25 + G2 - G1 MGFERRITE = EXP((MGFERRITE-PURE)/(R*T)) ELSE MGFERRITE = 0.0 END IF C CHROMITE = W15*X5**2-W45*X4*X5+W15*X4*X5+W14*X4*X5-W35*X3*X5+W15*X 1 3*X5+W13*X3*X5-W2P5U*X2*X5/2.0+W22*X2*X5/2.0+W1P5*X2*X5/2.0-W11 2 *X2*X5/2.0-G25*X2*X5-S4*W55*X5-S3*W3P5*X5+W3P5*X5+S3*W35*X5-S1* 3 W2P5U*X5/2.0+S1*W22*X5/2.0-S2*W1P5*X5+S1*W1P5*X5/2.0+S4*W15P*X5 4 -S4*W15*X5+S2*W15*X5-W15*X5+S3*W13P*X5-W13P*X5-S3*W13*X5+S2*W11 5 *X5-S1*W11*X5/2.0+W14*X4**2-W34*X3*X4+W14*X3*X4+W13*X3*X4-WTET* 6 X2*X4/2.0+W24U*X2*X4/2.0-W14*X2*X4/2.0-GX*X2*X4/4.0+GEX*X2*X4/4 7 .0-G24*X2*X4/2.0-S1*WTET*X4/2.0-S4*W45P*X4+S4*W45*X4-S3*W3P4*X4 8 +W3P4*X4+S3*W34*X4+S1*W24U*X4/2.0-S2*W1P4*X4+S4*W15P*X4-S4*W15* 9 X4+S2*W14*X4-S1*W14*X4/2.0-W14*X4+S3*W13P*X4-W13P*X4-S3*W13*X4+ : S2*W11*X4+GX*S1*X4/4.0-GEX*S1*X4/4.0+G24*S1*X4/2.0+W13*X3**2-W2 ; P3U*X2*X3/2.0+W22*X2*X3/2.0+W1P3*X2*X3/2.0-W11*X2*X3/2.0-G23*X2 < *X3-S4*W35P*X3+S4*W35*X3-S3*W33*X3+W33*X3-S1*W2P3U*X3/2.0+S1*W2 = 2*X3/2.0-S2*W1P3*X3+S1*W1P3*X3/2.0+S4*W15P*X3-S4*W15*X3+S3*W13P > *X3-W13P*X3-S3*W13*X3+S2*W13*X3-W13*X3+S2*W11*X3-S1*W11*X3/2.0+ ? WTET*X2**2/4.0+WOCT*X2**2/4.0+GX*X2**2/4.0-S4*WTET*X2/2.0-S3*WT @ ET*X2/2.0-S2*WTET*X2/2.0+S1*WTET*X2/2.0+WTET*X2/2.0+S4*WOCT*X2/ 1 2.0+S3*WOCT*X2/2.0+S2*WOCT*X2/2.0-S1*WOCT*X2/2.0-WOCT*X2/2.0-S4 2 *W4U5PU*X2+S4*W45P*X2-S3*W3PU4U*X2+W3PU4U*X2+S3*W3P4*X2-W3P4*X2 3 +S4*W2P5U*X2/2.0-S2*W2P4U*X2+S3*W2P3U*X2/2.0+S4*W25PU*X2/2.0+S3 4 *W23PU*X2/2.0-W23PU*X2/2.0-S4*W22*X2/2.0-S3*W22*X2/2.0+S2*W22*X 5 2/2.0-S4*W1P5*X2/2.0+S2*W1P4*X2-S3*W1P3*X2/2.0-S4*W15P*X2/2.0-S 6 3*W13P*X2/2.0+W13P*X2/2.0+S4*W11*X2/2.0+S3*W11*X2/2.0-S2*W11*X2 7 /2.0+GEX*S4*X2/2.0+G25*S4*X2-G24*S4*X2+GEX*S3*X2/2.0-G24*S3*X2+ 8 G23*S3*X2+GEX*S2*X2/2.0-G24*S2*X2-GEX*X2/2.0+G24*X2-S1*S4*WTET/ 9 2.0-S1*S3*WTET/2.0-S1*S2*WTET/2.0+S1**2*WTET/4.0+S1*WTET/2.0-S1 : *S4*WOCT/2.0-S1*S3*WOCT/2.0-S1*S2*WOCT/2.0+S1**2*WOCT/4.0+S1*WO ; CT/2.0+S4**2*W55-S3*S4*W3P5P+S4*W3P5P+S3*S4*W3P5-S4*W3P5+S3*S4* < W35P-S3*S4*W35+S3**2*W33-S3*W33+S1*S4*W2P5U/2.0+S1*S3*W2P3U/2.0 = +S1*S4*W25PU/2.0+S1*S3*W23PU/2.0-S1*W23PU/2.0-S1*S4*W22/2.0-S1* > S3*W22/2.0+S1*S2*W22/2.0-S2*S4*W1P5P+S2*S4*W1P5-S1*S4*W1P5/2.0- ? S2*S3*W1P3P+S2*W1P3P+S2*S3*W1P3-S1*S3*W1P3/2.0+S2*S4*W15P-S1*S4 @ *W15P/2.0-S4*W15P-S2*S4*W15+S4*W15+S2*S3*W13P-S1*S3*W13P/2.0-S3 1 *W13P-S2*W13P+S1*W13P/2.0+W13P-S2*S3*W13+S3*W13+S1*S4*W11/2.0+S 2 1*S3*W11/2.0+S2**2*W11-S1*S2*W11/2.0-S2*W11+GX*S1*S4/2.0+GX*S1* 3 S3/2.0+GX*S1*S2/2.0-GX*S1**2/4.0-GX*S1/2.0+G33+G3 C IF((XFE2TET.GT.0.0).AND.(XCR3OCT.GT.0.0)) THEN CHROMITE = CHROMITE + R*T*(LOG(XFE2TET) + 2.0*LOG(XCR3OCT)) C Pure Chromite: [x2=0, x3=1, x4=0, x5=0, s1=0, s2=0, s3=1, s4=0] PURE = G33 + G3 CHROMITE = EXP((CHROMITE-PURE)/(R*T)) ELSE CHROMITE = 0.0 END IF C MGCHROMITE = W15*X5**2-W45*X4*X5+W15*X4*X5+W14*X4*X5-W35*X3*X5+ 1 W15*X3*X5+W13*X3*X5-W2P5U*X2*X5/2.0+W22*X2*X5/2.0+W1P5*X2*X5/2. 2 0-W11*X2*X5/2.0-G25*X2*X5-S4*W55*X5-S3*W3P5*X5+W3P5*X5+S3*W35*X 3 5-S1*W2P5U*X5/2.0+W2P5U*X5+S1*W22*X5/2.0-W22*X5-S2*W1P5*X5+S1*W 4 1P5*X5/2.0-W1P5*X5+S4*W15P*X5-S4*W15*X5+S2*W15*X5-W15*X5+S3*W13 5 P*X5-W13P*X5-S3*W13*X5+S2*W11*X5-S1*W11*X5/2.0+W11*X5+G25*X5+W1 6 4*X4**2-W34*X3*X4+W14*X3*X4+W13*X3*X4-WTET*X2*X4/2.0+W24U*X2*X4 7 /2.0-W14*X2*X4/2.0-GX*X2*X4/4.0+GEX*X2*X4/4.0-G24*X2*X4/2.0-S1* 8 WTET*X4/2.0+WTET*X4-S4*W45P*X4+S4*W45*X4-S3*W3P4*X4+W3P4*X4+S3* 9 W34*X4+S1*W24U*X4/2.0-W24U*X4-S2*W1P4*X4+S4*W15P*X4-S4*W15*X4+S : 2*W14*X4-S1*W14*X4/2.0+S3*W13P*X4-W13P*X4-S3*W13*X4+S2*W11*X4+G ; X*S1*X4/4.0-GEX*S1*X4/4.0+G24*S1*X4/2.0+W13*X3**2-W2P3U*X2*X3/2 < .0+W22*X2*X3/2.0+W1P3*X2*X3/2.0-W11*X2*X3/2.0-G23*X2*X3-S4*W35P = *X3+S4*W35*X3-S3*W33*X3+W33*X3-S1*W2P3U*X3/2.0+W2P3U*X3+S1*W22* > X3/2.0-W22*X3-S2*W1P3*X3+S1*W1P3*X3/2.0-W1P3*X3+S4*W15P*X3-S4*W ? 15*X3+S3*W13P*X3-W13P*X3-S3*W13*X3+S2*W13*X3-W13*X3+S2*W11*X3-S @ 1*W11*X3/2.0+W11*X3+G23*X3+WTET*X2**2/4.0+WOCT*X2**2/4.0+GX*X2* 1 *2/4.0-S4*WTET*X2/2.0-S3*WTET*X2/2.0-S2*WTET*X2/2.0+S1*WTET*X2/ 2 2.0-WTET*X2/2.0+S4*WOCT*X2/2.0+S3*WOCT*X2/2.0+S2*WOCT*X2/2.0-S1 3 *WOCT*X2/2.0-WOCT*X2/2.0-S4*W4U5PU*X2+S4*W45P*X2-S3*W3PU4U*X2+W 4 3PU4U*X2+S3*W3P4*X2-W3P4*X2+S4*W2P5U*X2/2.0-S2*W2P4U*X2+S3*W2P3 5 U*X2/2.0+S4*W25PU*X2/2.0+S3*W23PU*X2/2.0-W23PU*X2/2.0-S4*W22*X2 6 /2.0-S3*W22*X2/2.0+S2*W22*X2/2.0-S4*W1P5*X2/2.0+S2*W1P4*X2-S3*W 7 1P3*X2/2.0-S4*W15P*X2/2.0-S3*W13P*X2/2.0+W13P*X2/2.0+S4*W11*X2/ 8 2.0+S3*W11*X2/2.0-S2*W11*X2/2.0+GEX*S4*X2/2.0+G25*S4*X2-G24*S4* 9 X2+GEX*S3*X2/2.0-G24*S3*X2+G23*S3*X2+GEX*S2*X2/2.0-G24*S2*X2-GX : *X2/2.0-GEX*X2/2.0+G24*X2-S1*S4*WTET/2.0+S4*WTET-S1*S3*WTET/2.0 ; +S3*WTET-S1*S2*WTET/2.0+S2*WTET+S1**2*WTET/4.0-S1*WTET/2.0-S1*S < 4*WOCT/2.0-S1*S3*WOCT/2.0-S1*S2*WOCT/2.0+S1**2*WOCT/4.0+S1*WOCT = /2.0+S4**2*W55+S4*W4U5PU-S4*W45P+S3*W3PU4U-S3*S4*W3P5P+S4*W3P5P > +S3*S4*W3P5-S4*W3P5-S3*W3P4+S3*S4*W35P-S3*S4*W35+S3**2*W33-S3*W ? 33+S1*S4*W2P5U/2.0-S4*W2P5U+S2*W2P4U+S1*S3*W2P3U/2.0-S3*W2P3U+S @ 1*S4*W25PU/2.0-S4*W25PU+W24U+S1*S3*W23PU/2.0-S3*W23PU-S1*W23PU/ 1 2.0-S1*S4*W22/2.0+S4*W22-S1*S3*W22/2.0+S3*W22+S1*S2*W22/2.0-S2* 2 W22-S2*S4*W1P5P+S2*S4*W1P5-S1*S4*W1P5/2.0+S4*W1P5-S2*W1P4-S2*S3 3 *W1P3P+S2*W1P3P+S2*S3*W1P3-S1*S3*W1P3/2.0+S3*W1P3+S2*S4*W15P-S1 4 *S4*W15P/2.0-S2*S4*W15+S4*W15-W14+S2*S3*W13P-S1*S3*W13P/2.0-S2* 5 W13P+S1*W13P/2.0+W13P-S2*S3*W13+S3*W13+S1*S4*W11/2.0-S4*W11+S1* 6 S3*W11/2.0-S3*W11+S2**2*W11-S1*S2*W11/2.0+GX*S1*S4/2.0-GX*S4/2. 7 0-GEX*S4/2.0-G25*S4+G24*S4+GX*S1*S3/2.0-GX*S3/2.0-GEX*S3/2.0+G2 8 4*S3-G23*S3+GX*S1*S2/2.0-GX*S2/2.0-GEX*S2/2.0+G24*S2-GX*S1**2/4 9 .0+GX/2.0+GEX/2.0+G33+G3+G24+G2-G1 C IF((XMG2TET.GT.0.0).AND.(XCR3OCT.GT.0.0)) THEN MGCHROMITE = MGCHROMITE + R*T*(LOG(XMG2TET) + 2.0*LOG(XCR3OCT)) C Pure Chromite: [x2=1, x3=1, x4=0, x5=0, s1=1, s2=0, s3=1, s4=0] PURE = W3PU4U - W3P4 + W24U - W23PU - W14 + W13P + G33 + G3 1 + 2.0*G24 + G2 - G1 MGCHROMITE = EXP((MGCHROMITE-PURE)/(R*T)) ELSE MGCHROMITE = 0.0 END IF C RETURN END SUBROUTINE ORD_SPN(T, X2, X3, X4, X5, S1, S2, S3, S4, 1 XMG2TET, XFE2TET, XAL3TET, XFE3TET, XCR3TET, XMG2OCT, 2 XFE2OCT, XAL3OCT, XFE3OCT, XTI4OCT, XCR3OCT, LSTOP) C IMPLICIT DOUBLE PRECISION(A-H,O-Z) IMPLICIT INTEGER(I-N) C COMMON /PARAM/ H11, S11, H55, S55, HX, SX, HEX, SEX, H24, S24, 1 H25, S25, W11, W22, W55, W15, W1P5, W15P, W1P5P, W14, W1P4, 2 W24U, W2P4U, W2P5U, W25PU, WOCT, WTET, W45, W45P, W4U5PU C COMMON /PARAMCR/ H33, S33, H23, S23, W33, W13, W1P3, W13P, 1 W1P3P, W2P3U, W23PU, W34, W3P4, W3PU4U, W35, W3P5, W35P, 2 W3P5P C LOGICAL CONVERGED, LSTOP C LSTOP = .FALSE. C C T is input in Kelvins, X2, X4 and X5 are input compositions C Everything else is output C G11 = H11 - T*S11 G33 = H33 - T*S33 G55 = H55 - T*S55 GX = HX - T*SX GEX = HEX - T*SEX G23 = H23 - T*S23 G24 = H24 - T*S24 G25 = H25 - T*S25 C H5PU5U = H55 + 2.0*H24 - H25 + (W24U-W14) + (W4U5PU-W45P) 1 - (W25PU-W15P) S5PU5U = S55 + 2.0*S24 - S25 W5U5PU = W55 + (W2P5U+W25PU+W11) - (W1P5+W15P+W22) W4U5U = W45 + H25 + (W24U+W2P5U+W11) - (W14+W1P5+W22) G5PU5U = H5PU5U - T*S5PU5U W4U5U = W4U5U - T*S25 H22 = 2.0*H24+H11+(W24U+W2P4U+W11)-(W14+W1P4+W22) S22 = 2.0*S24+S11 G22 = H22 - T*S22 C GS1 = 0.5*(-WOCT + W24U - W14 + 0.5*GX + 0.5*GEX + G24) GS2 = W11 + G11 GS3 = W13P - W13 + G33 GS4 = W15P - W15 + G55 GX2X2 = -0.25*(WTET + WOCT + GX) GX3X3 = - W13 GX4X4 = -W14 GX5X5 = -W15 GS1S1 = 0.25*(-WTET - WOCT + GX) GS2S2 = -W11 GS3S3 = -W33 GS4S4 = -W55 GS1S2= 0.5*(WTET - W22 + W11 + WOCT -GX) GS1S3 = 0.5*(WTET + WOCT - W2P3U - W23PU + W22 + W1P3 + W13P 1 - W11 - GX) GS1S4 = 0.5*(WTET + WOCT + W22 - W11 - W2P5U - W25PU + W1P5 + W15P 1 - GX) GS2S3 = W1P3P - W1P3 - W13P + W13 GS2S4 = W1P5P - W1P5 - W15P + W15 GS3S4 = W3P5P - W3P5 - W35P + W35 GX2X3 = 0.5*(W2P3U - W22 -W1P3 + W11 + 2.0*G23) GX2X4 = 0.5*(WTET - W24U + W14 + 0.5*GX - 0.5*GEX + G24) GX2X5 = 0.5*(-W22 + W11 + W2P5U - W1P5 + 2.0*G25) GX3X4 = W34 - W14 - W13 GX3X5 = W35 - W15 -W13 GX4X5 = W45 - W15 - W14 GX2S1 = 0.5*(WOCT - WTET) GX2S2 = 0.5*(WTET - W22 + W11 - WOCT + 2.0*W2P4U - 2.0*W1P4 - GEX 1 + 2.0*G24) GX2S3 = 0.5*(WTET - WOCT + 2.0*W3PU4U - 2.0*W3P4 - W2P3U - W23PU 1 + W22 + W1P3 + W13P - W11 - GEX + 2.0*G24 - 2.0*G23) GX2S4 = 0.5*(WTET - WOCT - W11 + W22 + 2.0*W4U5PU - 2.0*W45P 1 - W2P5U - W25PU + W1P5 + W15P - GEX - 2.0*G25 + 2.0*G24) GX3S1 = 0.5*(W2P3U - W22 - W1P3 + W11) GX3S2 = W1P3 - W13 - W11 GX3S3 = W33 - W13P + W13 GX3S4 = W35P - W35 - W15P + W15 GX4S1 = 0.5*(WTET - W24U + W14 - 0.5*GX + 0.5*GEX - G24) GX4S2 = -W11 + W1P4 - W14 GX4S3 = W3P4 - W34 - W13P + W13 GX4S4 = W45P - W45 - W15P + W15 GX5S1 = 0.5*(-W22 + W11 + W2P5U - W1P5) GX5S2 = -W11 + W1P5 - W15 GX5S3 = W3P5 - W35 - W13P + W13 GX5S4 = W55 - W15P + W15 IF((X2.EQ.1.0D0).AND.(X3.EQ.0.0D0).AND.(X4.EQ.0.0D0).AND. 1 (X5.EQ.0.0D0)) THEN S2 = 1.0 S1 = 2.0*S2 - 1.0 S3 = 0.0 S4 = 0.0 ELSE IF((X2.EQ.1.0D0).AND.(X3.EQ.1.0D0).AND.(X4.EQ.0.0D0).AND. 1 (X5.EQ.0.0D0)) THEN S2 = 0.0 S3 = 1.0 S4 = 0.0 S1 = 2.0*S3 - 1.0 ELSE IF((X2.EQ.1.0D0).AND.(X3.EQ.0.0D0).AND.(X4.EQ.0.0D0).AND. 1 (X5.EQ.1.0D0)) THEN S2 = 0.0 S3 = 0.0 S4 = 0.0 S1 = 2.0*S4 - 1.0 ELSE S1 = 0.5*X2 S2 = X2 S3 = X3 S4 = 0.0 END IF R1 = .001987 J = 0 CONVERGED = .FALSE. RELERR = 1.0D-6 SMALL = 1.0D-12 DO WHILE(.NOT.CONVERGED.AND.(J.LE.1000)) S1OLD = S1 S2OLD = S2 S4OLD = S4 C IF((X2.EQ.1.0D0).AND.(X3.EQ.0.0D0).AND.(X4.EQ.0.0D0).AND. 1 (X5.EQ.0.0D0)) THEN S1 = 2.0*S2 - 1.0 ELSE IF((X2.EQ.1.0D0).AND.(X3.EQ.1.0D0).AND.(X4.EQ.0.0D0).AND. 1 (X5.EQ.0.0D0)) THEN S1 = 2.0*S3 - 1.0 ELSE IF((X2.EQ.1.0D0).AND.(X3.EQ.0.0D0).AND.(X4.EQ.0.0D0).AND. 1 (X5.EQ.1.0D0)) THEN S1 = 2.0*S4 - 1.0 ELSE A = 2.0*GS1 + 4.0*GS1S1*S1 + 2.0*GX2S1*X2 + 2.0*GX4S1*X4 1 + 2.0*GX5S1*(X5) + 2.0*GS1S2*S2 + 2.0*GS1S4*S4 2 + 2.0*GX3S1*X3 + 2.0*GS1S3*S3 A = EXP(A/(R1*T)) C1 = (2.0*X2*X4 + 2.0*X2*S2 + 2.0*X2*S3 + 2.0*X2*S4 - X2**2) 1 - A*(2.0*X2 - X2**2 - 2.0*X2*S2 - 2.0*X2*S3 - 2.0*X2*S4) B1 = (-2.0*X4 - 2.0*S2 - 2.0*S3 - 2.0*S4) 1 - A*(2.0 - 2.0*S2 - 2.0*S3 - 2.0*S4) A1 = 1.0 - A Q = SQRT(B1**2 -4.0*A1*C1) IF(A1.NE.0.0) THEN S1 = (-B1 -Q) / (2.0*A1) ELSE S1 = -C1/B1 END IF END IF C IF((X2.EQ.1.0D0).AND.(X3.EQ.0.0D0).AND.(X4.EQ.0.0D0).AND. 1 (X5.EQ.0.0D0)) THEN A = G22 + W22*(1.0-2.0*S2) A = EXP(A/(R1*T)) A1 = (1.0 - A) B1 = -2.0 - A C1 = 1.0 Q = SQRT(B1**2-4.0*A1*C1) IF(A1.NE.0.0) THEN S2 = (-B1-Q)/(2.0*A1) ELSE S2 = -C1/B1 END IF S1 = 2.0*S2 - 1.0 ELSE A = GS2 + 2.0*GS2S2*S2 + GX2S2*X2 + GX3S2*X3 + GX4S2*X4 1 + GX5S2*(X5) + GS1S2*S1 +GS2S3*S3 + GS2S4*S4 A = EXP(A/(R1*T)) C1 = (1.0 - 0.5*X2 + 0.5*S1 - S3 - S4 -X3 + 0.5*X2*X3 1 - 0.5*S1*X3 + S3*X3 ) C1 = C1 + (S4*X3 - X4 + 0.5*X2*X4 - 0.5*S1*X4 + S3*X4 1 + S4*X4 - X5 + 0.5*X2*X5) C1 = C1 + (-0.5*S1*X5 + S3*X5 + S4*X5) C1 = C1 - A*(X4 - 0.5*X2 - 0.5*S1 + S3 + S4) C1 = C1 - A*(-X4*X3 + 0.5*X2*X3 + 0.5*S1*X3 - S3*X3 - S4*X3) C1 = C1 - A*(-X4*X4 + 0.5*X2*X4 + 0.5*S1*X4 - S3*X4 - S4*X4) C1 = C1 - A*(-X4*X5 + 0.5*X2*X5 + 0.5*S1*X5 - S3*X5 - S4*X5) B1 = (-1.0 + X3 + X4 + X5 -1.0 + 0.5*X2 - 0.5*S1 + S3 + S4) B1 = B1 - A*(1.0 - X3 - X4 - X5 + X4 - 0.5*X2 - 0.5*S1 1 + S3 + S4) A1 = 1.0 - A Q = SQRT(B1**2-4.0*A1*C1) IF(A1.NE.0.0) THEN S2 = (-B1-Q) / (2.0*A1) ELSE S2 = -C1/B1 END IF END IF C IF((X2.EQ.1.0D0).AND.(X3.EQ.0.0D0).AND.(X4.EQ.0.0D0).AND. 1 (X5.EQ.1.0D0)) THEN A = G5PU5U + W5U5PU*(1.0-2.0*S4) A = EXP(A/(R1*T)) A1 = (1.0 - A) B1 = -2.0 - A C1 = 1.0 Q = SQRT(B1**2-4.0*A1*C1) IF(A1.NE.0.0) THEN S4 = (-B1-Q)/(2.0*A1) ELSE S4 = -C1/B1 END IF S1 = 2.0*S4 - 1.0 ELSE A = GS4 + 2.0*GS4S4*S4 + GX2S4*X2 + GX3S4*X3 + GX4S4*X4 1 + GX5S4*(X5) + GS1S4*S1 + GS2S4*S2 + GS3S4*S3 A = EXP(A/(R1*T)) C1 = (X5 - 0.5*X2*X5 + 0.5*S1*X5 - S2*X5 -S3*X5) -A*(X4*X5 1 - 0.5*X2*X5 - 0.5*S1*X5 + S2*X5 + S3*X5) B1 = (-X5 -1.0 + 0.5*X2 - 0.5*S1 + S2 + S3) 1 - A*(X5 + X4 - 0.5*X2 - 0.5*S1 + S2 + S3) A1 = 1.0- A Q = SQRT(B1**2 -4.0*A1*C1) IF(A1.NE.0.0) THEN S4 = (-B1 -Q) / (2.0*A1) ELSE S4 = -C1/B1 END IF END IF C J = J + 1 IF(J.GT.1000) THEN WRITE(*,1000) 1000 FORMAT(1X,'Iteration limit (1000) exceeded in ORD_SPN!') LSTOP = .TRUE. END IF CONVERGED = (ABS(S1-S1OLD) .LE. RELERR*ABS(S1)) .OR. 1 (ABS(S1-S1OLD) .LE. SMALL) CONVERGED = CONVERGED .AND. ( 1 (ABS(S2-S2OLD) .LE. RELERR*ABS(S2)) .OR. 2 (ABS(S2-S2OLD) .LE. SMALL) ) CONVERGED = CONVERGED .AND. ( 1 (ABS(S4-S4OLD) .LE. RELERR*ABS(S4)) .OR. 2 (ABS(S4-S4OLD) .LE. SMALL) ) C C WRITE(*,'(1X,''s1, s1old: '', 3G20.13)') S1, S1OLD, C 1 ABS(S1-S1OLD) C WRITE(*,'(1X,''s2, s2old: '', 3G20.13)') S2, S2OLD, C 1 ABS(S2-S2OLD) C WRITE(*,'(1X,''s4, s4old: '', 3G20.13)') S4, S4OLD, C 1 ABS(S4-S4OLD) C END DO C C WRITE(*,*) 'Iterations = ', J C XMG2TET = 0.5*(X2 + S1) XFE2TET = (X4 - 0.5*X2 - 0.5*S1 + S2 + S3 + S4) XAL3TET = (1.0 - X3 - X4 - X5 - S2) XFE3TET= X5 - S4 XCR3TET = X3 - S3 XMG2OCT = 0.25*(X2 - S1) XFE2OCT = 0.25*(2.0 - X2 + S1 - 2.0*S2 - 2.0*S3 - 2.0*S4) XAL3OCT = 0.5*(1.0 - X3 - X4 - X5 + S2) XFE3OCT = 0.5*(X5 + S4) XCR3OCT = 0.5*(X3 + S3) XTI4OCT = 0.5*X4 C RETURN END