c------------------------------------------------------------- c subroutine to read models for configurational entropy c of solutions with dependent site mixing or disordered c endmembers, see documentation section 1.3.1, equation (8b) c------------------------------------------------------------- implicit double precision (a-g,o-z),integer (h-n) integer isp(3) double precision x(3,3) common/ cst107 /a0(5,5),acoef(5,5,5),smult(5), * ecoef(3,3,3),nsite,nspm1(5),nterm(5,5), * nsub1(5,5,5,4),nsub2(5,5,5,4),nttyp(5,5,5) character*10 sname n9 = 10 open (n9,file='scon.dat') 99 read (n9,1000) sname write (*,*) sname read (n9,*) isite read (n9,*) (isp(i),i=1,3) c read # of mixing sites read (n9,*) nsite if (nsite.gt.5) call error (31,r,i,sname) c if (nsite.lt.isite) call error (30,r,isite,sname) c for each site do 10 i = 1, nsite c read # of species, and site c multiplicty. read (n9,*) nsp,smult(i) nspm1(i) = nsp - 1 c for each species, read c function to define the c site fraction of the species: do 20 j = 1, nspm1(i) c read # of terms in the c site fraction function and a0. read (n9,*) nterm(i,j), a0(i,j) c for each term: do 30 k = 1, nterm(i,j) c read term type: read (n9,*) nttyp(i,j,k) if (nttyp(i,j,k).lt.4) then read (n9,*) acoef(i,j,k), (nsub1(i,j,k,l), * nsub2(i,j,k,l), * l = 1, nttyp(i,j,k) ) else call error (29,r,nttyp(i,j,k),sname) end if 30 continue 20 continue 10 continue c get normalization constants: do 40 i = 1, isp(1) c set x's to endmember values: x(1,i) = 1. do 50 i1 = 1, isp(1) 50 if (i1.ne.i) x(1,i1) = 0. do 60 j = 1, isp(2) x(2,j) = 1. do 70 j1 = 1, isp(2) 70 if (j1.ne.j) x(2,j1) = 0. do 80 k = 1, isp(3) x(3,k) = 1. do 90 k1 = 1, isp(3) 90 if (k1.ne.k) x(3,k1) = 0. c x's now set, evaluate ln W: call omega (x,dlnw,sname) ecoef(i,j,k) = -dlnw write (*,*) i,j,k,-dlnw 80 continue 60 continue 40 continue goto 99 1000 format (a10) end subroutine omega (x,dlnw,sname) c-------------------------------------------------------------------- c subroutine to evaluate the log of the number of site configurations c per mole of a solution (dlnw) with composition x. c-------------------------------------------------------------------- implicit double precision (a-g,o-z),integer (h-n) character*10 sname double precision x(3,3) common/ cst107 /a0(5,5),acoef(5,5,5),smult(5), * ecoef(3,3,3),nsite,nspm1(5),nterm(5,5), * nsub1(5,5,5,4),nsub2(5,5,5,4),nttyp(5,5,5) dlnw = 0.0 c for each site do 10 i = 1, nsite zt = 0. c get site fractions do 20 j = 1, nspm1(i) z = a0(i,j) c for each term: do 30 k = 1, nterm(i,j) zad = acoef(i,j,k) do 40 l = 1, nttyp(i,j,k) 40 zad = zad * x(nsub1(i,j,k,l),nsub2(i,j,k,l)) z = z + zad 30 continue if (z.gt.0.0.and.z.lt.1.0) then dlnw = dlnw + smult(i) * z * dlog (z) zt = zt + z else if (z.le.0.and.z.gt.-1d-5) then goto 20 else if (z.ge.1.and.z.lt.1.0000001) then goto 20 else call error (32,z,i,sname) end if 20 continue z = 1. - zt if (z.gt.0.0.and.z.lt.1.0) then dlnw = dlnw + smult(i) * z * dlog (z) else if (z.le.0.and.z.gt.-1d-5) then goto 10 else if (z.ge.1.and.z.lt.1.0000001) then goto 10 else call error (32,z,i,sname) end if 10 continue end subroutine error (ier,real,int,char) c----------------------------------------------------------------------- c write error messages and terminate execution c----------------------------------------------------------------------- implicit double precision (a-g,o-y),integer (h-m,z) character char*14 parameter (k1=500,k2=1200,k3=1200,k4=16,k5=12,k6=7) parameter (l2=5,l3=3,l4=2,l5=100,l6=200,l7=400,l8=100,l9=100) parameter (m1=21,m2=35,m3=35,m4=21,m5=7,h1=100,h2=100) parameter (j1=50,j2=1200,j3=400,j4=400,j5=600,j6=200,j7=100) parameter (h3=20,h4=20,j8=1600,j9=600) if (ier.eq.14) then write (*,14) char else if (ier.eq.15) then write (*,15) char else if (ier.eq.16) then write (*,16) int else if (ier.eq.17) then write (*,17) int else if (ier.eq.18) then write (*,18) char else if (ier.eq.19) then write (*,19) char else if (ier.eq.20) then write (*,20) int, char else if (ier.eq.21) then write (*,21) char else if (ier.eq.23) then write (*,23) char else if (ier.eq.24) then write (*,24) int else if (ier.eq.25) then write (*,25) int else if (ier.eq.26) then write (*,26) int, char else if (ier.eq.27) then write (*,27) char else if (ier.eq.28) then write (*,28) int, char else if (ier.eq.29) then write (*,29) int, char else if (ier.eq.30) then write (*,30) int,char else if (ier.eq.31) then write (*,31) sname else if (ier.eq.32) then write (*,32) real,int, char else if (ier.eq.34) then write (*,34) else if (ier.eq.35) then write (*,35) else if (ier.eq.36) then write (*,36) else if (ier.eq.61) then write (*,61) char else if (ier.eq.106) then write (*,106) else if (ier.eq.110) then write (*,110) else if (ier.eq.111) then write (*,111) else if (ier.eq.112) then write (*,112) else if (ier.eq.113) then write (*,113) else if (ier.eq.115) then write (*,115) else if (ier.eq.116) then write (*,116) else if (ier.eq.117) then write (*,117) else if (ier.eq.118) then write (*,118) else if (ier.eq.119) then write (*,119) char else if (ier.eq.120) then write (*,120) char else if (ier.eq.121) then write (*,121) char else if (ier.eq.124) then write (*,124) char else if (ier.eq.169) then write (*,169) int else if (ier.eq.180) then write (*,180) k1 else if (ier.eq.181) then write (*,181) k2 else if (ier.eq.182) then write (*,182) k3 else if (ier.eq.183) then write (*,183) l5 else if (ier.eq.184) then write (*,184) l6 else if (ier.eq.185) then write (*,185) l7 else if (ier.eq.186) then write (*,186) l8 else if (ier.eq.187) then write (*,187) l9 else if (ier.eq.188) then write (*,188) j1 else if (ier.eq.189) then write (*,189) j2 else if (ier.eq.190) then write (*,190) j3 else if (ier.eq.191) then write (*,191) j4 else if (ier.eq.192) then write (*,192) j8 else if (ier.eq.193) then write (*,193) j6 else if (ier.eq.194) then write (*,194) j7 else if (ier.eq.195) then write (*,195) else if (ier.eq.196) then write (*,196) else if (ier.eq.197) then write (*,197) else if (ier.eq.198) then write (*,198) h1 else if (ier.eq.199) then write (*,199) h2 else if (ier.eq.200) then write (*,200) else if (ier.eq.201) then write (*,201) h3 else if (ier.eq.202) then write (*,202) j5 else if (ier.eq.203) then write (*,203) h4 else if (ier.eq.204) then write (*,204) j9 else if (ier.eq.205) then write (*,205) int else if (ier.eq.206) then write (*,206) k2 else if (ier.eq.207) then write (*,207) real,char else if (ier.eq.279) then write (*,279) int else if (ier.eq.323) then write (*,323) else write (*,999) ier,real,int,char end if stop 14 format (' **error ver014** programming error, routine ',a6) 15 format (' **error ver015** missing composant for ',a5) 16 format (' **error ver016** too many saturated components, ', * 'increase dimension h5 (',i2,') and recompile.') 17 format (' **error ver017** too many composants for a saturation', * ' constraint increase dimension h6 (',i3, * ') and recompile') 18 format (' **error ver018** ',a5,' is defined as a saturated ', * 'phase component in the thermodynamic data file.') 19 format (' **error ver019** probable cause missing composant,', * ' executing routine ',a6) 20 format (' **error ver020**error reading the solution model', * ' data file.',/,' Last model read without an error was', * ' for:',a10,' Check data formatting.') 21 format (' **error ver021**error reading ', * 'the header section of the',/,' thermodynamic data ', * 'file:',a14,' Check data formatting') 23 format (' **error ver023**error occurred while reading', * ' the thermodynamic data file.',/,' Last data read', * ' without error was for phase:',a8,' Check data', * ' formatting.') 24 format (' **error ver024** too many solution models in the', * ' solution model file',/,' increase parameter i9 (', * i3,') and recompile vertex.') 25 format (' **error ver025** too many solution models ', * ' increase parameter h9 (',i3,') and recompile.') 26 format (' **error ver026** the number of fixed components (', * i2,') in ',a10,/,' is >= the number of components ',/) 27 format (' **error ver027** no endmembers were found for the', * ' solution: ',a10,/,' in the thermodynamic data file.',/) 28 format (/,' **error ver028** invalid buffer choice (',i3,') in', * ' routine: ',a6,/) 29 format (/,' **error ver029** unknown term type ',i6,' for', * ' solution model: ',a10,/) 30 format (/,' **error ver030** the number of mixing sites ',i2, * ' is < the number of independent sites',/,' for', * ' solution model: ',a10,/) 31 format (/,' **error ver031** erroneous solution model', * ' parameter for: ',a10,/) 32 format (/,' **error ver032** a site fraction is > 1 (',g12.6,')', * ' on site ',i2,' for solution: ',a10,/) 34 format (' **error ver034** vmax is lt vmin, check input.') 35 format (' **error ver035** dv is lt 0, check input.') 36 format (' **error ver036** missing composant for the saturated', * ' phase,',/,' you have probably excluded either H2O or', * ' CO2.',/) 61 format (' **error ver061** the solution phase ' * ,a10,' has two or more',/,' endmembers with transitions as *currently programmed vertex will ignore the transition.',/, * ' recommended temporary solution: omit transition data') 106 format (' **error ver106** programming error in miscib') 110 format (' **error ver110** you have requested a calculation ', * 'with the composition ',/,' of a saturated phase as a ', * 'variable, but you have not defined its composition') 111 format (' **error ver111** you have requested a calculation ', * 'with the composition ',/,' of a saturated phase as a ', * 'variable, but the phase has only one component') 112 format (' **error ver112** the maximum value of an independent ' * ,'variable',/,'is less than or equal to the minimum value') 113 format (' **error ver113** the default increment of an ', * 'independent variable is zero') 115 format (' **error ver115** the default increment of an ', * 'independent variable is less than',/,' 0.1 percent of ', * 'its range, execution is stopped. To avoid this error ' * ,'use a larger increment or change the error test limit') 116 format (' **error ver116** an independent variable, or at least' * ,' its name, is undefined') 117 format (' **error ver117** vmax(iv(3)) ne vmin(iv(3) but no ', * 'sectioning variable v(iv(3)) is defined') 118 format (' **error ver118** the default increment of the ', * 'sectioning variable will result ',/, * 'in the generation of more ', * 'than 10 sections, to avoid this',/,' error increase ', * 'the increment or modify this test') 119 format (' **error ver119** input1 the thermodynamic data base ', * 'file ',a14,' read on lun n2 could not be opened,',/, * ' check if it exists') 120 format (' **error ver120** input1 file ',a14,' read on lun n1', * ' could not be opened',/,' this file is normally', * ' created by build, check if it exists') 121 format (' **error ver121** input1 the solution model file ', * a14,' read on lun n9 could not be opened,',/, * ' check if it exists') 124 format (' **error ver124** no match for an endmember compound ', * 'of the solution: ',a10,/,' in the data from n2') 169 format (' **error ver169** cart, imod=',i2,' is an invalid ', * 'request') 180 format (' **error ver180** too many phases,', * ' increase dimension k1 (',i3,') and ', * 'and recompile vertex.') 181 format (' **error ver181** too many reactions,', * ' increase dimension k2 (',i3,') and ', * 'and recompile vertex.') 182 format (' **error ver182** too many invariant points,', * ' problem increase dimension k1 (',i3,') and ', * 'and recompile vertex.') 183 format (' **error ver183** too many phases in a unary, increase ', * 'dimension l5 (',i3,') and recompile vertex',/) 184 format (' **error ver184** too many phases in a binary, increase', * ' dimension l6 (',i3,') and recompile vertex',/) 185 format (' **error ver185** too many phases in a ternary, increas', * 'e dimension l7 (',i3,') and recompile vertex',/) 186 format (' **error ver186** too many phases in a quaternary, incr', * 'ease dimension l8 (',i3,') and recompile vertex',/) 187 format (' **error ver187** too many phases in a quinary, inc', * 'rease dimension l9 (',i3,') and recompile vertex',/) 188 format (' **error ver188** too many binary assemblages, increa', * 'se dimension j1 (',i4,') and recompile vertex',/) 189 format (' **error ver189** too many ternary assemblages, incre', * 'ase dimension j2 (',i4,') and recompile vertex',/) 190 format (' **error ver190** too many quaternary assemblages, in', * 'crease dimension j3 (',i4,') and recompile vertex',/) 191 format (' **error ver191** too many quinary assemblages, increa', * 'se dimension j4 (',i4,') and recompile vertex',/) 192 format (' **error ver192** too many pseudo facets, increa', * 'se dimension j8 (',i4,') and recompile vertex',/) 193 format (' **error ver193** too many stable ternary phases incre', * 'ase dimension j6 (',i4,') and recompile vertex',/) 194 format (' **error ver194** too many stable quaternary phases, i', * 'ncrease dimension j7 (',i4,') and recompile vertex',/) 195 format (' **error ver195** the dreaded jj error in simpl5, try ', * 'changing the order you enter components.',/) 196 format (' **error ver196** the dreaded jj error in simpl4, try ', * 'changing the order you enter components.',/) 197 format (' **error ver197** to many components, increase k6 if ', * 'it is less than 7 and recompile vertex.',/) 198 format (' **error ver198** too many hexary phases, i', * 'ncrease dimension h1 (',i4,') and recompile vertex',/) 199 format (' **error ver199** too many septary phases, i', * 'ncrease dimension h2 (',i4,') and recompile vertex',/) 200 format (' **error ver200** you are trying to use a fluid ', * 'equation of state for an invalid component',/) 201 format (' **error ver201** too many stable quinary phases, i', * 'ncrease dimension h3 (',i4,') and recompile vertex',/) 202 format (' **error ver202** too many stable hexary facets, i', * 'ncrease dimension j5 (',i4,') and recompile vertex',/) 203 format (' **error ver203** too many stable hexary phases, i', * 'ncrease dimension h4 (',i4,') and recompile vertex',/) 204 format (' **error ver204** too many stable septary facets, i', * 'ncrease dimension h4 (',i4,') and recompile vertex',/) 205 format (' **error ver205** too many new phase assemblages, ', * 'found by routine newhld i', * 'ncrease dimension h7 (',i5,') and recompile vertex',/) 206 format (' **error ver206** too many univariant assemblages ', * 'intersect the edges of the diagram, i', * 'ncrease dimension k2 (',i4,') and recompile vertex',/) 207 format (/,' **error ver207** the value of the stretching ', * ' parameter (',g13.6,')',/,' for solution ',a10, * ' is invalid (<1) for transform subdivision,',/, * ' check section 4 of PERPLEX documentation.',/) 279 format (' **error ver279** you have got a problem ',i3) 323 format (' **error ver323** prime9, imd(i)=0 is the only',/, * 'subdivision scheme permitted for this version' ) 999 format (' **error vertex** unspecified error ier=',i3, * ' real=',g13.6,' i=',i3,' char=',a6) end