IMPLICIT double precision (A-H,P,R-Y)
 
      character*8 names(0:7)
 
      COMMON / CST5 /PBAR,TK,XC,U1,U2,TR,PR,RJ,PS/ cst11 /fh2o,fco2
 
      data names/'MRK     ','HSMRK   ','QRKMRK  ','TRKMRK  ',
     *           'CORK    ','HOCGRA  ','HOCMRK  ','SAX-FEI '/
 
10    WRITE (*,*) 'Enter P(bar), T(K), and X(CO2/O)'
      READ (*,*) PBAR,TK,XC
 
      IF (PBAR.EQ.0.D0) GOTO 99
 
      WRITE (*,1010)
 
      do 20 irk = 0, 6
         call props (irk,ah2o,aco2,v,vm,xco2,xh2o)
         write (*,1000) names(irk),fh2o,fco2,ah2o,aco2,v,vm,
     *                  xco2, xh2o
20    continue
 
      WRITE (*,*)
      WRITE (*,*) 'Enter three zeroes to quit'
      GOTO 10
 
1000  format (1x,a8,4(1x,g12.5),4(3x,g10.3))
1010  format (/, '          f(H2O,BAR)   f(CO2,bar)    a(H2O)',
     *            '       a(CO2)       V(cm3/mol)  rho(g/cm3)',
     *                          '      X(CO2)      X(H2O)')
 
99    END
 
      BLOCK DATA
C------------------------------------------------------------------
      implicit double precision (A-G,O-Y)
 
      COMMON/ CST5 /P,T,XCO2,U1,U2,TR,PR,R,PS/ cst85 /PP,TT,YY,RR
      DATA R,RR/8.3144126D00,83.14/
      END
 
      subroutine fluid (irk)
c------------------------------------------------------------------
      implicit double precision (a-g,o-z), integer (h-n)

      if (irk.eq.0) then
         call mrk
      else if (irk.eq.1) then
         call hsmrk
      else if (irk.eq.2) then
         call qrkmrk
      else if (irk.eq.3) then
         call trkmrk
      else if (irk.eq.4) then
         call hprk
      else if (irk.eq.5) then 
         call hocgra (fo2)
      else if (irk.eq.6) then
         call hocmrk (fo2)
      else if (irk.eq.7) then 
         call saxfei
      end if
 
      end
 
      subroutine props (irk,ah2o,aco2,v,vm,xco2,xh2o)
c--------------------------------------------------------------------
      implicit double precision (a-g,o-z), integer (h-n)
 
      common / cst11 /fh2o,fco2/ cst26 /avol
     *       / cst5  /pbar,tk,xc,u1,u2,tr,pr,rj,ps
     *       / cstcoh /x(6),g(6),vol(6),isp
 
      xx = xc
      xh = 1. - xc
      xp = pbar
      xt = tk
      xco2 = xc
      xh2o = 1. - xco2
 
      call fluid (irk)
      fmh2o = fh2o
      fmco2 = fco2
c                                     if (irk>=5) coh fluids, make
c                                     other stuff undefined.
      if (irk.ge.5) then
         xh2o = x(1)
         xco2 = x(2)
         v = avol
         vm = -99.
         ah2o = -99.
         aco2 = -99.
         fh2o = dexp(fh2o)
         fco2 = dexp(fco2)
         goto 99
      end if 

      g1 = xh*fh2o + xc*fco2
c                                     estimate volume by finite dif
      pbar = pbar + 1.
      call fluid (irk)
      v = 83.14 * tk * ( xh * fh2o + xc*fco2 - g1 )
      pbar = xp
c                                     get fugacities of pure fluids
      xc = 1.

      call fluid (irk)
      fcp = fco2
 
      xc = 0.
      call fluid (irk)
      fhp = fh2o
 
      xc = xx
 
      ah2o = dexp (fmh2o - fhp)
      aco2 = dexp (fmco2 - fcp)
      fh2o = dexp(fmh2o)
      fco2 = dexp(fmco2)
      vm =  (xh*18.015 + xc*44.00995) / v
 
      if (xc.eq.1.) then
         fh2o = 0.
         ah2o = 0.
      else if (xc.eq.0.) then
         aco2 = 0.
         fco2 = 0.
      end if
 
99    end
 
      function grxn (i)
c--------------------------------------------------------------------
c a dummy routine to allow rk to be linked with rlib.f
c--------------------------------------------------------------------
      implicit double precision (g)
      grxn = 0.d0
      end