program isokor c---------------------------------------------------------------------- c ************************ c * * c * isokor.sep.1991 * c * * c ************************ c---------------------------------------------------------------------- c a fortran program to convert a Gibbs function data file to a c helmholtz function data file. the new data file is written c to 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, * record*80,blank5*5,blnk10*10, * dname*40,cmpnt*5,vname*8,gname*78,xname*18, * sixty*60,name,y*1 dimension icod(8),delt(5) common/ cst6 /icomp,istct,iphct,icp/ cst79 /isoct * / csta2 /xname(5),vname(5),gname(5)/ cst83 /ig(5) * / cst43 /therm(k4),comp(k0),idh2o,idco2,ikind * / cst202 /tm(9,3),td(9),ilam,idiso,lamin,idsin * / cst5 /v(5),tr,pr,r,ps/ cst9 /vmax(5),vmin(5),dv(5) * / cst41 /n1,n2,n3,n4,n5,n6,n7,n8,n9,io3,io4,io5,io9 * / cst37 /iprct,ixct,iexyn,istbyn * / cst59 /istbct,idst(10,5),ister(10) * / csta5 /dname(8),cmpnt(k0) data blank5,blank8,blnk10/' ',' ',' '/ c----------------------------------------------------------------------- c read file header c----------------------------------------------------------------------- c read the number of data bases c represented in the data file: write (*,*) * ' enter the name of the input thermodynamic data file:' read (*,1060) record open (n2,file=record,status='old') write (*,*) * ' enter the name of the output thermodynamic data file:' read (*,1060) record open (n6,file=record,iostat=ierr,status='new') if (ierr.ne.0) then write (*,1210) record read (*,1090) y if (y.ne.'Y'.and.y.ne.'y') goto 999 open (n6,file=record) end if read (n2,*) idat,iddat c read the extrinsic variable names: read (n2,1000) (vname(i),i=1,3) read (n2,1010) (ig(i),gname(i),i=1,3) read (n2,*) delt,dtol,utol,ptol c read data base codes and titles c and the data base reference state c conditions consistent with v1 and v2. do 4 i=1,idat read (n2,*) icod(i), p, t 4 read (n2,1170) dname(i) c read the number of components in c the data bases. read (n2,*) icmpn c read the component names sequentially. read (n2,1180) (cmpnt(zi),zi=1,icmpn) read (n2,*) idh2o,idco2 write (*,2010) (zi,cmpnt(zi),zi=1,icmpn) write (*,2020) read (*,*) inum write (vname(1),2030) cmpnt(inum) cmpnt(inum) = 'V ' write (n6,*) idat,iddat write (n6,1000) (vname(i),i=1,3) write (n6,1010) (ig(i),gname(i),i=1,3) write (n6,1080) delt,dtol,utol,ptol do 5 i=1,idat write (n6,*) icod(i), 0.0, t 5 write (n6,1170) dname(i) write (n6,*) icmpn write (n6,1180) (cmpnt(zi),zi=1,icmpn) write (n6,*) idh2o,idco2 c----------------------------------------------------------------------- c read and modify individual entries c----------------------------------------------------------------------- write (*,1300) 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 vol = therm(3) therm(3) = -comp(inum) comp(inum) = vol therm(1) = therm(1) - p*vol do 52 i = 11, 16 52 therm(i) = 0.0 if ((ilam.lt.10).and.(ilam.ne.0)) then write (*,*) ' throwing out lambda transition for ', * name ilam = 0 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.eq.10) then do 53 i = 1, jlam 53 write (n6,1050) (tm(zj,i),zj=1,9) end if if (idiso.ne.0) write (n6,1050) td end if goto 220 1000 format (3(a8,18x)) 1010 format (i2,a78) 1020 format (a8,i2,i2,i2,i2) 1030 format (a8,i2,i2,i2,i2,a60) 1040 format (12(f5.2,1x)) 1050 format (5(g13.7,1x)) 1060 format (a80) 1080 format (8(g9.3,1x)) 1090 format (a1) 1170 format (a40) 1180 format (6(a5,1x)/6(a5,1x)) 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,12(a5,1x)) 2010 format (/,' The database components are:', * /,3(6(i2,'-',a5,1x),/)) 2020 format (/,' Which one do you want to replace with V (volume)?', * /,' (identify the component by number) ',/) 2030 format ('u(',a5,')') 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