program actcor c---------------------------------------------------------------------- c ************************ c * * c * actcor.may.1989 * c * * c ************************ c---------------------------------------------------------------------- c a fortran program for making fixed activity corrections to the c thermodynamic data file for vertex. actcor creates a new data file c with the corrected data on unit n6 c----------------------------------------------------------------------- c files (see vertex program documentation for additional information): c----------------------------------------------------------------------- implicit double precision (a-g,o-y),integer (h-m,z) parameter (k0=25,k4=16) character*8 blank8,dname*40,cmpnt*5,sixty*60,name,y*1 common/ cst43 /therm(k4),comp(k0),atwt(k0),idh2o,idco2,ikind * / cst202 /tm(9,3),td(9),ilam,idiso,lamin,idsin * / cst41 /n1,n2,n3,n4,n5,n6,n7,n8,n9,io3,io4,io5,io9 * / cst5 /p,t,xco2,u1,u2,tr,pr,r,ps * / csta5 /dname(8),cmpnt(k0) data blank8/' '/ c----------------------------------------------------------------------- write (*,1300) c open files call fopen c read and echo file header call topn2 (4,icmpn) c read and modify individual entries 220 read (n2,1030,end=999) name,ibase,ikind,ilam,idiso,sixty read (n2,*) (comp(zi),zi=1,icmpn),therm if (ilam.ne.0) then c determine number of transitions from c flag ilam: jlam=ilam if (ilam.gt.3) jlam=ilam-3 if (ilam.gt.6) jlam=ilam-6 if (ilam.gt.9) jlam=ilam-9 do 51 zi=1,jlam 51 read (n2,*) (tm(zj,zi),zj=1,9) end if if (idiso.ne.0) read (n2,*) td write (*,*) ' include phase (y/n): ',name read (*,1090) y if (y.eq.'y'.or.y.eq.'Y') then write (*,*) ' make an activity correction ', * ' for ',name,' (y/n)?' read (*,1090) y c if (y.eq.'y'.or.y.eq.'Y') then c write (*,*) ' enter phase that ',name, * ' is a solution in (left justified): ' read (*,1020) blank8 c write (*,*) 'the stoichiometry of ',name,' is: ' write (*,2000) (cmpnt(zi),zi=1,icmpn) write (*,1040) (comp(zi),zi=1,icmpn) write (*,*) write (*,*) ' ideal activity model (y/n)?' read (*,1090) y if (y.eq.'y'.or.y.eq.'Y') then write (*,*) ' enter mole fraction (x) of ',name, * ' in ',blank8,' :' read (*,*) xmole write (*,*) ' activity of ',name,' will be computed as ', * 'x**n' write (*,*) ' enter number of mixing sites (n):' read (*,*) xmix act = xmole**xmix else write (*,*) ' enter activity of ',name,' :' read (*,*) act end if write (*,*) ' activity of ',name,' in ',blank8,' is:', * act therm(1) = therm(1) + t * 8.314413 * dlog(act) therm(2) = therm(2) - 8.314413 * dlog(act) name = blank8 end if write (n6,1030) name,ibase,ikind,ilam,idiso,sixty write (n6,1040) (comp(zi),zi=1,icmpn) write (n6,1050) therm if (ilam.ne.0) then do 52 zi = 1, jlam 52 write (n6,1050) (tm(zj,zi), zj = 1, 9) end if if (idiso.ne.0) write (n6,1050) td end if goto 220 1020 format (a8,i2,i2,i2,i2) 1030 format (a8,i2,i2,i2,i2,a60) 1040 format (13(f5.2,1x)) 1050 format (5(g13.7,1x)) 1090 format (a1) 1210 format (/,' The file ',a14,' exists, do you', * ' really want to overwrite it (y/n)? ') 1300 format (/,' NO is the default answer to all prompts',/) 2000 format (/,1x,13(a5,1x),/,1x,13(a5,1x)) 999 end block data c----------------------------------------------------------------------- implicit double precision (a-g,o-y),integer (h-m,z) common/ cst41 /n1,n2,n3,n4,n5,n6,n7,n8,n9,io3,io4,io5,io9 c----------------------------------------------------------------------- c the following data statement assigns c logical unit numbers for i/o. data n1,n2,n3,n4,n5,n6,n7,n8,n9/21,22,23,24,25,26, 5, 6,29/ end subroutine fopen c----------------------------------------------------------------------- implicit double precision (a-g,o-y),integer (h-m,z) character*14 n2name,yes*1 common/ cst41 /n1,n2,n3,n4,n5,n6,n7,n8,n9,io3,io4,io5,io9 c----------------------------------------------------------------------- c first the thermo data file 1 write (*,1000) read (*,1030) n2name open (n2,file=n2name,iostat=ierr,status='old') if (ierr.ne.0) then c system could not find the file write (*,1010) n2name read (*,1020) yes if (yes.ne.'Y'.and.yes.ne.'y') goto 999 goto 1 c try again end if write (*,1070) open (n6,file='actcor.dat') return 999 write (*,1060) stop 1000 format (/,' Enter the thermo data file name (e.g.', * ' hp90ver.dat),',/, * ' < 15 characters, left justified: ') 1010 format (/,' **warning ver191** FOPEN file ',a14, * ' could not be opened',//,' try again (y/n)? ') 1020 format (a1) 1030 format (a14) 1060 format (/,' O.K., then i am quitting also.',/) 1070 format (/,' Ouput will be written to file: actcor.dat',/) end