c   ctransf is a program to read a vertex thermo-data file and
c   rewrite the data in a new file with transformed components.  

      implicit double precision (a-g,o-y),integer (h-m,z)
c-----------------------------------------------------------------------
      write (*,1000)
c                               assign data files
      call fopen
c                               Read THERMODYNAMIC DATA file (N2):
c                               read the data base header
      call topn2 (5,icmpn)
c                               read and echo data cards with
c                               component conversion
35    call getphi (icmpn,*99)
      goto 35
      
1000  format (//,' NO is the default answer to all Y/N prompts',/)

99    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='ctransf.dat')
 
      return
 
999   write (*,1060)
 
      stop
 
1000  format (/,' Enter thermodynamic data file name (e.g.',
     *         ' hp94ver.dat), 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: ctransf.dat',/)
 
      end
  
      subroutine getphi (icmpn,*)
c------------------------------------------------------------------------
      implicit double precision (a-g,o-y),integer (h-m,z)
 
      parameter (k0=25,k4=16,k5=12,m6=3,m7=9,m8=9)
 
      character*8 name, oname, note*40
 
      common/ cst41  /n1,n2,n3,n4,n5,n6,n7,n8,n9,io3,io4,io5,io9
     *      / cst43  /therm(k4),comp(k0),atwt(k0),idh2o,idco2,ikind
     *      / cst202 /tm(m7,m6),td(m8),ilam,idiso,lamin,idsin
     *      / cst207 /ctrans(k0,k5),ictr(k5),itrans
 
      save oname
 
      data oname/' '/
 
30    read (n2,1020,end=90,err=98)
     *                     name, ibase, ikind, ilam, idiso, note
      if (name.eq.'  ') goto 30
      write (n6,1020) name, ibase, ikind, ilam, idiso, note

      read (n2,*,err=98) (comp(i), i=1, icmpn), therm
c                               do component transformation if
c                               itrans is not zero
         do 10 i = 1, itrans
            it = ictr(i)
            if (comp(it).eq.0.d0) goto 10
c                                ct is how much of the new
c                                component is in the phase.
            ct =  comp(it) / ctrans(it,i)
 
            do 20 j = 1, icmpn
20             comp(j) = comp(j) - ct * ctrans(j,i)
 
            comp(it) = ct
10       continue

      write (n6,1040) (comp(i), i=1, icmpn)
      write (n6,1050) 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 1 i= 1, jlam
            read (n2,*,err=98) (tm(j,i), j = 1, m7)
1           write (n6,1050) (tm(j,i), j = 1, m7)
      end if
 
      if (idiso.ne.0) then 
         read (n2,*,err=98) td
         write (n6,1050) td
      end if 
  
      oname = name
 
      return
 
90    return 1

98    if (oname.ne.' ') then
         call error (23,r,i,oname)
       else
         call error (23,r,i,'  none  ')
       end if

1020  format (a8,i2,i2,i2,i2,1x,a40)
1040  format (12(f5.2,1X))
1050  format (5(g13.7,1X))
 
      end