52 rgt_variant =
'phase_cell' 58 IF ( num /= 0 )
CALL set_default_eos_numerical
63 CALL eos_const ( ap, bp )
69 CALL bubblepointcalculation
79 SUBROUTINE set_default_eos_numerical
99 END SUBROUTINE set_default_eos_numerical
126 IF (converg == 1)
CALL output
127 IF (converg /= 1)
write (*,*)
' NO PHASE SPLIT DETECTED' 148 INTEGER :: i, converg, calcopt, state
149 REAL :: steps, end_x, end_p, end_t, start_p, start_t
150 REAL :: lnphi(np,nc), density(np), w(np,nc), t_sav
152 REAL :: pges, zges, b_cal
159 IF ( ncomp /= 1 )
THEN 160 write (*,*)
'SPECIFY ONLY ONE COMPONENT IN THE INPUT-FILE:' 161 write (*,*)
' ./input_file/INPUT.INP' 165 WRITE (*,*)
' CALCULATE VLE (1)' 166 WRITE (*,*)
' CALCULATE ISOTHERMS (2)' 167 WRITE (*,*)
' CALCULATE ISOBARS (3)' 168 WRITE (*,*)
' CALCULATE VIRIAL COEFFICIENTS (4)' 169 WRITE (*,*)
' CRITICAL POINT (5)' 172 IF (calcopt == 1)
THEN 184 IF (eos >= 4) val_init(4) = 1.e-3
188 write (*,*)
' CHOOSE END TEMPERATURE [units as in input-file]:' 190 end_x = end_x + u_in_t
193 CALL phase_equilib(end_x,steps,converg)
196 IF (eos < 4)
CALL critical ( tc, pc, rhoc )
202 WRITE(*,
'(a,3(f16.5))')
'tc, pc, rhoc',tc-u_out_t, pc/u_out_p, rhoc
203 WRITE (40,
'(5(2x,f18.8))') tc-u_out_t, pc/u_out_p, rhoc, rhoc
206 ELSEIF ( calcopt == 2 .OR. calcopt == 3 )
THEN 215 IF ( calcopt == 2 )
THEN 216 WRITE(*,*)
' SPECIFY END-PRESSURE [units as in input-file]' 220 WRITE(*,*)
' SPECIFY END-TEMPERATURE [units as input-file]' 224 WRITE (*,*)
' SPECIFY LIQUID (1) or VAPOR (2) state' 227 IF (state == 2) densta(1) = 1.e-5
230 p = start_p + (end_p-start_p)*
REAL(i)/steps
231 t = start_t + (end_t-start_t)*
REAL(i)/steps
232 CALL fugacity (lnphi)
233 IF (num /= 2)
CALL enthalpy_etc
234 CALL si_dens (density,w)
235 WRITE (*,
'(8(2x,g16.9))') t-u_out_t,p/u_out_p,dense(1),density(1),cpres(1),enthal(1), &
236 gibbs(1), speed_of_sound(1)
237 WRITE(40,
'(7(2x,g16.9))') t-u_out_t,p/u_out_p,density(1),cpres(1),enthal(1),gibbs(1), &
241 ELSEIF (calcopt == 4)
THEN 248 WRITE(*,*)
' SPECIFY END-TEMPERATURE [units as input-file]' 250 end_t = end_t + u_in_t
252 WRITE (*,*)
' T ,B / cm**3/mol' 253 WRITE(40,*)
' T ,B / cm**3/mol' 256 t = start_t + (end_t-start_t)*
REAL(i)/steps
257 CALL p_calc (pges,zges)
258 CALL si_dens (density,w)
260 b_cal = (zges-1.0)/density(1)*1000.0*mm(1)
261 WRITE (*,
'(2(2x,f14.8))') t-u_out_t,b_cal
262 WRITE(40,
'(2(2x,f14.8))') t-u_out_t,b_cal
268 IF ( eos < 4)
CALL critical (tc,pc,rhoc)
269 WRITE (*,
'(a,3(f16.5))')
'tc,pc,rhoc',tc-u_out_t, pc/u_out_p,rhoc
270 WRITE (40,
'(5(2x,f18.8))') tc-u_out_t, pc/u_out_p, rhoc, rhoc
274 END SUBROUTINE pure_comp
291 CALL set_default_eos_numerical
300 densta(1) =
REAL(101-i) / 100.0 * 0.45
304 CALL fugacity (lnphi)
305 write (*,
'(3G18.8)') lnphi(1,1)+log(rho), pges/1.e5, eta
319 SUBROUTINE rgt_fit_parameters
322 USE fitting_rgt_parameters
326 SUBROUTINE crit_dev ( fmin, optpara, n )
327 INTEGER,
INTENT(IN) :: n
328 REAL,
INTENT(IN) :: optpara(:)
329 REAL,
INTENT(IN OUT) :: fmin
330 END SUBROUTINE crit_dev
334 INTEGER :: nadjust, PRIN
335 REAL :: fmin, t0, h0, MACHEP
336 REAL,
ALLOCATABLE :: optpara(:)
348 write(*,*)
'SPECIFY ONLY ONE COMPONENT IN THE INPUT-FILE' 353 ALLOCATE( optpara(nadjust) )
401 optpara(1) = (2.1 -0.0 ) *1.0
402 optpara(2) = (35.0 -0.0 ) /20.0
403 optpara(3) = (0.23 -0.0 ) *5.0
465 call praxis( t0, machep, h0, nadjust, prin, optpara, crit_dev, fmin )
473 WRITE (*,
'(a,1(f16.8))')
'deviation %',fmin*100.0
474 WRITE (*,*) optpara(1),optpara(2)*20.0,optpara(3)/5.0
476 DEALLOCATE( optpara )
478 END SUBROUTINE rgt_fit_parameters
485 SUBROUTINE crit_dev ( fmin, optpara, nadjust )
488 USE fitting_rgt_parameters
489 use utilities
, only: critical
493 INTEGER,
INTENT(IN) :: nadjust
494 REAL,
INTENT(IN) :: optpara(nadjust)
495 REAL,
INTENT(IN OUT) :: fmin
501 phifit = optpara(2) *20.0
502 chapfit = optpara(3) /5.0
508 WRITE (*,
'(3(f18.12))') optpara(1),optpara(2)*20.0,optpara(3)/5.0
509 CALL critical ( tc, pc, rhoc )
511 fmin = 100.0 * abs(1.0-tc/tcf )**2 &
512 + abs(1.0-pc/pcf )**2 &
513 + 1.e-1 * abs(1.0-rhoc/rcf)**2
518 WRITE (*,
'(a,3(f16.5))')
'tc,pc,rhoc',tc-u_out_t, pc/u_out_p,rhoc
519 WRITE (*,
'(a,1(f16.8))')
'deviation %',fmin*100.0
521 WRITE (40,
'(5(2x,f18.6))') tc-u_out_t, pc/u_out_p, rhoc, rhoc
522 WRITE (40,*) fmin,optpara(1),optpara(2)*20.0,optpara(3)/5.0
524 END SUBROUTINE crit_dev
539 INTEGER :: converg, ncompsave, phaseindex
540 REAL :: steps, end_x, startcon
549 CALL set_default_eos_numerical
552 hb_term =
'TPT1_Chap' 592 IF (ncompsave == 1)
THEN 602 CALL phase_equilib(end_x,steps,converg)
604 write (*,*)
'pressure=',p/1.e6,
'MPa' 605 write (*,*)
'eta =',dense(1),dense(2)
606 write (*,*)
'alpha =',alpha_nematic
612 IF (ncompsave > 1)
THEN 616 startcon = log(0.000001)
617 write(*,*)
' specify desired end-composition of:' 618 write(*,*)
' component 2 (molefraction)' 619 write(*,*)
' component 2 is:',compna(2)
625 val_init(5) = log(1.0 - exp(startcon - 0.0))
626 val_init(6) = startcon - 0.0
627 val_init(7) = log(1.0 - exp(startcon))
628 val_init(8) = startcon
630 write(*,*)
' Is this composition specified for the LC-phase (1)' 631 write(*,*)
' or for the isotropic phase (2)' 632 read (*,*) phaseindex
634 IF (phaseindex == 1)
THEN 648 CALL phase_equilib(end_x,steps,converg)
655 write(*,*)
' CHOOSE END TEMPERATURE [units as in input-file]:' 657 end_x = end_x + u_in_t
661 CALL phase_equilib(end_x,steps,converg)
663 write (77,*) val_conv
666 END SUBROUTINE lc_comp
679 use utilities
, only: si_dens
683 INTEGER :: i, converg
684 REAL :: density(np), w(np,nc)
689 write(*,*)
'we assume the phase 1 to have a target composition !!' 702 val_init(1) = 0.436817011049269
703 val_init(2) = 0.435497920638304
704 val_init(3) = 308.850000000000
705 val_init(4) = 1858758.08530477
706 val_init(5) = -0.160891853903475
707 val_init(6) = -1.90639042291856
708 val_init(7) = -0.173218595064226
709 val_init(8) = -1.83856034172500
713 xi(3,2) = 1.0 - xi(3,1)
714 lnx(3,1) = log(xi(3,1))
715 lnx(3,2) = log(xi(3,2))
716 val_init(9) = lnx(3,1)
717 val_init(10)= lnx(3,2)
721 CALL objective_ctrl (converg)
723 IF (converg == 1)
THEN 724 CALL si_dens (density,w)
726 write(*,*)
' 3-phase equilibrium calc. successful' 729 write(*,*) val_conv(3)-u_out_t,val_conv(4)/u_out_p
730 write(*,*)
' x11 x21 x31' 731 write(*,*) exp(val_conv(5)),exp(val_conv(7)),exp(val_conv(9))
732 write(*,*) exp(val_conv(6)),exp(val_conv(8)),exp(val_conv(10))
733 write(*,*)
' eta1 , eta2 , eta3' 734 write(*,*) dense(1),dense(2),dense(3)
736 write(*,*)
' output written to file: ./output_file/3-phase.xlo' 738 OPEN (67,file=
'./output_file/3-phase.xlo')
740 write(67,*) val_conv(3)-u_out_t,val_conv(4)/u_out_p
741 write(67,*)
' x11 x21 x31' 742 write(67,*)exp(val_conv(5)),exp(val_conv(7)),exp(val_conv(9))
743 write(67,*)exp(val_conv(6)),exp(val_conv(8)),exp(val_conv(10))
744 write(67,*)
' rho1[kg/m3] rho2[kg/m3] rho3[kg/m3]' 745 write(67,*) density(1),density(2),density(3)
746 write(67,
'(6e16.8)') val_conv(3), val_conv(4)/u_out_p, &
747 1.0-exp(val_conv(5)),exp(val_conv(7)),exp(val_conv(9))
751 DO i=1,(4+ncomp*nphas)
752 val_init(i)=val_conv(i)
754 val_init(3) = val_init(3) + 0.2
759 END DO loop_condition
761 END SUBROUTINE lc_3phase
772 SUBROUTINE jt_inversion
776 use utilities
, only: dens_calc, si_dens
782 REAL :: zdT2, zges1, zges2, zges3, start_t, delta
783 REAL :: density(np), w(np,nc)
791 write(*,*)
'SPECIFY ONLY ONE COMPONENT IN THE INPUT-FILE:' 792 write(*,*)
' ./input_file/INPUT.INP' 799 WRITE (*,*)
' SPECIFY LIQUID (1) or VAPOR (2) state' 802 IF (state == 2) densta(1) = 1.e-5
804 DO WHILE ( abs(zdt) > 1.e-10 )
807 CALL dens_calc(rho_phas)
808 CALL si_dens (density,w)
809 zges1 = p/(density(1)*1000.0/mm(1)*rgas*t)
811 CALL dens_calc(rho_phas)
812 CALL si_dens (density,w)
813 zges3 = p/(density(1)*1000.0/mm(1)*rgas*t)
815 CALL dens_calc(rho_phas)
816 CALL si_dens (density,w)
817 zges2 = p/(density(1)*1000.0/mm(1)*rgas*t)
818 zdt = (zges3-zges1)/(2.0*delta)
819 zdt2 = (zges3-2.0*zges2+zges1)/delta**2
820 start_t = t - zdt / zdt2
821 write (*,*) start_t ,p, zdt
824 write (40,*)
'T/K p/kPa error=dz_dT' 825 write (40,*) start_t ,p/1000.0, zdt
826 write (*,*)
'result written to: output_file/output.xlo' 828 END SUBROUTINE jt_inversion
855 use utilities
, only: select_sum_rel
859 INTEGER :: iso_x, converg
860 REAL :: steps, end_x, pinit
880 IF (converg == 1)
THEN 882 write(*,*)
' CHOOSE YOUR CALCULATION OPTION:' 883 write(*,*)
' ISOTHERM (1) or ISOBAR (2) or MOL-FRACTION-SCAN (3)' 889 write (*,*)
'Specify end pressure [units as in input-file]' 894 CALL select_sum_rel (1,0,1)
895 CALL select_sum_rel (2,0,2)
896 ELSEIF (iso_x == 2)
THEN 897 write (*,*)
'Specify end temperature [units as in input-file]' 899 end_x = end_x + u_in_t
902 CALL select_sum_rel (1,0,1)
903 CALL select_sum_rel (2,0,2)
904 ELSEIF (iso_x == 3)
THEN 905 write (*,*)
' YOU HAVE DECIDED TO VARY THE MOLEFRACTION' 906 write (*,*)
' CHOOSE AN END-CONCENTRAION, FOR EXAMPLE:' 907 write (*,*)
' CALCULATE TOWARDS xi(1) = 0 (0)' 908 write (*,*)
' CALCULATE TOWARDS xi(1) = 1 (1)' 909 write (*,*)
' COMPOUND #1 IS: ',compna(1)
911 IF (end_x <= 0.0)
THEN 918 write(*,*)
' ISOTHERM (1) or ISOBAR (2)' 920 IF (iso_x == 1) it(1) =
'p' 921 IF (iso_x == 2) it(1) =
't' 925 CALL phase_equilib(end_x,steps,converg)
927 IF ( .NOT.second .AND. iso_x == 1 .AND. running /=
'x11')
THEN 931 CALL start_var(converg)
933 IF (eos >= 4) end_x = 1.e-3
935 CALL phase_equilib(end_x,steps,converg)
940 write (*,*)
' CALCULATE ANOTHER TEMPERATURE ?' 941 write (*,*)
' CHOOSE (0 FOR NO, 1 FOR YES)' 948 write (*,*)
'Specify temperature [units as in input-file]' 952 CALL start_var(converg)
966 write (*,*)
'kij(1,2)',kij(1,2)
968 END SUBROUTINE binmix
982 INTEGER :: i, steps_i
990 OPEN (71,file=
'./output_file/PT-crit.xlo')
993 xif(2) =
REAL( i ) /
REAL( steps_i )
994 xif(1) = 1.0 - xif(2)
996 CALL heidemann_khalil
997 write (71,
'(8(2x,f18.8))') dense(1), t-u_out_t,p/u_out_p, &
1002 write (*,*)
'kij(1,2)',kij(1,2)
1004 END SUBROUTINE bincrit
1019 use utilities
, only: enthalpy_etc, si_dens
1023 INTEGER :: i, i_steps
1024 REAL :: density(np),w(np,nc)
1025 REAL :: lnphi(np,nc)
1030 OPEN (68,file=
'./output_file/caloric.xlo')
1031 WRITE (68,*)
'phi1 phi2 cp_res[J/molK] h_res[J/mol] g_res[J/mol] rho t[K] p[Pa] xi(1)' 1033 IF (ncomp /= 2)
THEN 1034 WRITE (*,*)
'CALCULATION FOR BINARY MIXTURE ONLY!' 1044 xi(1,1) = 1.0 -
REAL(i-1)/
REAL(i_steps)
1045 xi(1,2) = 1.0 - xi(1,1)
1047 CALL fugacity (lnphi)
1050 CALL si_dens (density,w)
1051 WRITE (*,*) cpres(1),enthal(1),dense(1),density(1),t,p,xi(1,1)
1052 WRITE (*,*) gibbs(1),xi(1,1)
1053 WRITE (68,
'(9G15.7)') exp(lnphi(1,1)),exp(lnphi(1,2)), &
1054 cpres(1),enthal(1),gibbs(1),density(1),t,p,xi(1,1)
1058 END SUBROUTINE he_mix
1069 SUBROUTINE state_prop
1072 use utilities
, only: enthalpy_etc, si_dens
1077 REAL :: density(np), w(np,nc)
1078 REAL :: lnphi(np,nc), aver_m
1086 WRITE (*,*)
' This subroutine calculates the physical properties' 1087 WRITE (*,*)
' of a one-phase (liquid) multicomponent mixture at' 1088 WRITE (*,*)
' given concentration' 1090 WRITE (*,
'(a,i3,a)')
' SPECIFY MOL FRACTION OF ALL',ncomp,
' COMPONENTS' 1096 OPEN (68,file=
'./output_file/state_point.xlo')
1098 CALL fugacity (lnphi)
1101 CALL si_dens (density,w)
1103 aver_m = sum( xi(1,1:ncomp)*mm(1:ncomp) )
1105 WRITE (*,*) cpres(1),enthal(1),dense(1),density(1),t-u_out_t, p/u_out_p
1107 WRITE (*,*) (xi(1,i), i = 1,ncomp)
1108 WRITE (68,*)
'cp_res[J/molK] h_res[J/mol] g_res[J/mol] rho t p ' 1109 WRITE (68,*) cpres(1),enthal(1),gibbs(1),density(1),t-u_out_t, p/u_out_p
1111 WRITE (68,*)
'x(i) ' 1112 WRITE (68,*) (compna(i),i=1,ncomp)
1113 WRITE (68,*) (xi(1,i),i=1,ncomp)
1115 WRITE (68,*)
'w(i) ' 1116 WRITE (68,*) ((xi(1,i)*mm(i)/aver_m),i=1,ncomp)
1118 WRITE (68,*)
'average molar mass' 1120 write (69,*) dense(1),dense(2),p
1122 END SUBROUTINE state_prop
1134 use utilities
, only: p_calc
1149 DO WHILE (dense(1) < 0.25)
1151 dense(1) = dense(1) + 0.01
1152 CALL p_calc (pges,zges)
1153 write (71,*) dense(1),pges
1157 END SUBROUTINE p_line
1167 SUBROUTINE p_t_diagram
1171 use utilities
, only: molefrac, switch
1175 INTEGER :: i, iso_x, converg, swtch, ncompsave
1176 REAL :: steps, end_x, end_x1, end_x2, startcon
1191 write (*,*)
' CHOOSE A MASS FRACTION FOR COMP. #1 :',converg
1192 write (*,*)
' COMPOUND #1 IS ',compna(1)
1194 IF (ncomp == 2)
THEN 1195 w(1,2) =1.0 - w(1,1)
1196 CALL molefrac (w,1,0)
1197 end_x1 = LOG(xi(1,1))
1200 write(*,*)
' FOR APPROACHING THE END CONCENTRATION FOR' 1201 write(*,*)
' COMPONENT # 1 CHOOSE CALCULATION PATH: ' 1202 write(*,*)
' ISOTHERM (1) or ISOBAR (2)' 1205 write(*,*)
' END CONC. LEFT OF CRIT. POINT (yes:1 / no:0)' 1207 IF (swtch == 1)
THEN 1214 IF (iso_x == 1) it(1)=
'p' 1215 IF (iso_x == 2) it(1)=
't' 1222 CALL phase_equilib(end_x1,steps,converg)
1224 ELSEIF (ncomp == 3)
THEN 1226 write (*,*)
' CHOOSE A MASS FRACTION FOR COMP. #3 :' 1227 write (*,*)
' COMPOUND #3 IS ',compna(3)
1230 w(1,2) =1.0 - w(1,1) - w(1,3)
1231 CALL molefrac (w,1,0)
1232 end_x1 = LOG(xi(1,1))
1233 end_x2 = LOG(xi(1,3))
1239 val_init(5) = val_conv(5)
1240 val_init(6) = val_conv(6)
1241 val_init(7) = startcon
1242 val_init(8) = val_conv(7)
1243 val_init(9) = val_conv(8)
1245 val_init(10) = startcon + (end_x2-startcon)/steps
1247 write(*,*)
' END CONC. LEFT OF CRIT. POINT (yes:1 / no:0)' 1249 IF (swtch == 1)
CALL switch
1252 write(*,*)
' FOR APPROACHING THE END CONCENTRATION FOR' 1253 write(*,*)
' COMPONENT # 3 CHOOSE CALCULATION PATH: ' 1254 write(*,*)
' ISOTHERM (1) or ISOBAR (2)' 1256 IF (iso_x == 1) it(1)=
'p' 1257 IF (iso_x == 2) it(1)=
't' 1265 CALL phase_equilib(end_x2,steps,converg)
1269 write(*,*)
' FOR APPROACHING THE END CONCENTRATION FOR' 1270 write(*,*)
' COMPONENT # 1 CHOOSE CALCULATION PATH: ' 1271 write(*,*)
' ISOTHERM (1) or ISOBAR (2)' 1273 IF (iso_x == 1) it(1)=
'p' 1274 IF (iso_x == 2) it(1)=
't' 1282 CALL phase_equilib(end_x1,steps,converg)
1289 write(*,*)
' SPECIFY TEMPERATURE (1)' 1290 write(*,*)
' OR PRESSURE (2)' 1292 IF (iso_x == 1)
THEN 1293 write(*,*)
' CHOOSE END TEMPERATURE [units as in input-file]:' 1295 end_x = end_x + u_in_t
1298 ELSEIF (iso_x == 2)
THEN 1299 write(*,*)
' CHOOSE END PRESSURE [units as in input-file]:' 1301 end_x = end_x*u_in_p
1307 CALL phase_equilib(end_x,steps,converg)
1309 END SUBROUTINE p_t_diagram
1318 SUBROUTINE tern_diagram
1322 use utilities
, only: molefrac, switch
1326 INTEGER :: converg, spec_ph, spec_comp
1327 REAL :: steps, end_x
1338 write (*,*)
' THE MOLE FRACTION OF OF PHASE 1 OR OF PHASE 2' 1339 write (*,*)
' CAN NOW BE CHANGED. SELECT:' 1340 write (*,*)
' PHASE 1 (1)' 1341 write (*,*)
' PHASE 2 (2)' 1345 write (*,*)
' SELECT A COMPONENT TO BE SPECIFIED' 1346 write (*,*)
' COMPONENT #1 ',compna(1),
' (1)' 1347 write (*,*)
' COMPONENT #2 ',compna(2),
' (2)' 1348 write (*,*)
' COMPONENT #3 ',compna(3),
' (3)' 1349 READ (*,*) spec_comp
1354 write (*,*)
' CHOOSE AN END MOLE FRACTION FOR COMP. #',spec_comp
1355 write (*,*)
' (CAUTION: THREE-PHASE EQUIL. ARE NOT DETECTED)' 1367 IF (spec_ph == 1)
THEN 1368 IF (spec_comp == 1) running=
'l11' 1369 IF (spec_comp == 1) it(1)=
'x13' 1370 IF (spec_comp == 2) running=
'l12' 1371 IF (spec_comp == 2) sum_rel(1)=
'x13' 1372 IF (spec_comp == 3) running=
'l13' 1373 ELSEIF (spec_ph == 2)
THEN 1374 IF (spec_comp == 1) running=
'l21' 1375 IF (spec_comp == 1) it(2)=
'x13' 1376 IF (spec_comp == 2) running=
'l22' 1377 IF (spec_comp == 2) it(2)=
'x13' 1378 IF (spec_comp == 2) sum_rel(2)=
'x21' 1379 IF (spec_comp == 3) running=
'l23' 1380 IF (spec_comp == 3) it(2)=
'x13' 1381 IF (spec_comp == 3) it(3)=
'x21' 1382 ELSEIF (spec_ph == 3)
THEN 1390 CALL phase_equilib(end_x,steps,converg)
1392 END SUBROUTINE tern_diagram
1401 SUBROUTINE bin_3phase
1405 use utilities
, only: si_dens
1409 INTEGER :: k, ph, iso_x, converg, i
1410 REAL :: density(np), w(np,nc)
1419 IF (converg == 1)
THEN 1421 write (*,*)
' LLE detected for starting values' 1423 write (*,*)
' starting 3-phase calculation' 1427 write(*,*)
' CHOOSE YOUR CALCULATION OPTION:' 1428 write(*,*)
' ISOTHERM (1) or ISOBAR (2)' 1435 IF (iso_x == 1) it(4)=
'p ' 1436 IF (iso_x == 2) it(4)=
't ' 1443 xi(3,2) = 1.0 - xi(3,1)
1444 lnx(3,1) = log(xi(3,1))
1445 lnx(3,2) = log(xi(3,2))
1451 val_init(4+k+(ph-1)*ncomp) = lnx(ph,k)
1457 CALL objective_ctrl (converg)
1459 IF (converg == 1)
THEN 1460 CALL si_dens (density,w)
1462 write(*,*)
' 3-phase equilibrium calc. successful' 1465 write(*,*) val_conv(3)-u_out_t,val_conv(4)/u_out_p
1466 write(*,*)
' x11 x21 x31' 1467 write(*,*) exp(val_conv(5)),exp(val_conv(7)),exp(val_conv(9))
1468 write(*,*) exp(val_conv(6)),exp(val_conv(8)),exp(val_conv(10))
1469 write(*,*)
' eta1 , eta2 , eta3' 1470 write(*,*) dense(1),dense(2),dense(3)
1472 write(*,*)
' output written to file: ./output_file/3-phase.xlo' 1474 OPEN (67,file=
'./output_file/3-phase.xlo')
1476 write(67,*) val_conv(3)-u_out_t,val_conv(4)/u_out_p
1477 write(67,*)
' x11 x21 x31' 1478 write(67,*)exp(val_conv(5)),exp(val_conv(7)),exp(val_conv(9))
1479 write(67,*)exp(val_conv(6)),exp(val_conv(8)),exp(val_conv(10))
1480 write(67,*)
' rho1[kg/m3] rho2[kg/m3] rho3[kg/m3]' 1481 write(67,*) density(1),density(2),density(3)
1482 write(67,
'(6e16.8)') val_conv(3), val_conv(4)/u_out_p, &
1483 1.0-exp(val_conv(5)),exp(val_conv(7)),exp(val_conv(9))
1486 IF (t.lt.210.15)
THEN 1487 DO i=1,(4+ncomp*nphas)
1488 val_init(i)=val_conv(i)
1490 val_init(3) = val_init(3) + 0.025
1493 EXIT other_condition
1496 END DO other_condition
1498 END SUBROUTINE bin_3phase
1507 SUBROUTINE tern_3phase
1510 use utilities
, only: si_dens
1514 INTEGER :: k, ph, converg
1515 REAL :: density(np), w(np,nc)
1521 lnx(1,1) = -4.375218662
1522 lnx(1,2) = -0.241363748
1523 lnx(1,3) = -1.600186935
1524 lnx(2,1) = -14.98669354
1525 lnx(2,2) = -0.395440676
1526 lnx(2,3) = -1.118968702
1528 lnx(3,2) = -0.821288895
1529 lnx(3,3) = -0.579576292
1554 val_init(4+k+(ph-1)*ncomp) = lnx(ph,k)
1560 CALL objective_ctrl (converg)
1562 IF (converg == 1)
THEN 1563 CALL si_dens (density,w)
1565 write(*,*)
' 3-phase equilibrium calc. successful' 1568 write(*,*) val_conv(3)-u_out_t,val_conv(4)/u_out_p
1569 write(*,*)
' x_phase1 x_phase2 x_phase3' 1570 write(*,*)exp(val_conv(5)),exp(val_conv(8)),exp(val_conv(11))
1571 write(*,*)exp(val_conv(6)),exp(val_conv(9)),exp(val_conv(12))
1572 write(*,*)exp(val_conv(7)),exp(val_conv(10)),exp(val_conv(13))
1573 write(*,*)
' w_phase1 w_phase2 w_phase3' 1574 write(*,*)w(1,1),w(2,1),w(3,1)
1575 write(*,*)w(1,2),w(2,2),w(3,2)
1576 write(*,*)w(1,3),w(2,3),w(3,3)
1577 write(*,*)
' eta1 , eta2 , eta3' 1578 write(*,*) dense(1),dense(2),dense(3)
1580 write(*,*)
' output written to file: ./output_file/3-phase.xlo' 1582 OPEN (67,file=
'./output_file/3-phase.xlo')
1584 write(67,*) val_conv(3)-u_out_t,val_conv(4)/u_out_p
1585 write(67,*)
' x_phase1 x_phase2 x_phase3' 1586 write(67,*)exp(val_conv(5)),exp(val_conv(8)),exp(val_conv(11))
1587 write(67,*)exp(val_conv(6)),exp(val_conv(9)),exp(val_conv(12))
1588 write(67,*)exp(val_conv(7)),exp(val_conv(10)),exp(val_conv(13))
1589 write(67,*)
' rho1[kg/m3] rho2[kg/m3] rho3[kg/m3]' 1590 write(67,*) density(1),density(2),density(3)
1591 write(67,
'(6e16.8)') val_conv(3), val_conv(4)/u_out_p, &
1592 1.0-exp(val_conv(5)),exp(val_conv(7)),exp(val_conv(9))
1596 write (*,*) parame(1,13),parame(1,16)
1597 write (*,*) parame(1,3),kij(1,2),kij(1,3)
1598 write (*,*)
'modify parameter eps(1)/k' 1599 read(*,*) parame(1,3)
1600 write (*,*)
'modify parameter eps_assoc' 1601 read(*,*) parame(1,13)
1603 write (*,*)
'modify parameter kij(1,2)' 1606 write (*,*)
'modify parameter kij(1,3)' 1619 END SUBROUTINE tern_3phase
1634 SUBROUTINE pariter_crit
1637 USE utilities
, only: critical, paus
1641 INTEGER :: i, j, converg
1642 REAL :: sig_new, eps_new, fvek1, fvek2
1643 REAL :: sig_save, eps_save
1644 REAL :: df1dx, df2dx, df1dy, df2dy
1645 REAL :: betrag, attenu
1646 REAL :: tc, pc, rhoc, omega, seg_new, par1_sv, par2_sv
1647 REAL :: par3_sv, omeg_sv, omeg_nw, err_sv, err_nw, derrdr
1648 REAL :: steps, end_x
1652 OPEN (10,file =
'./output_file/crit-par.out')
1655 write (*,*)
' ENTER MOLECULAR MASS M / g/mol :' 1658 write (*,*)
' ENTER CRITICAL TEMPERATURE Tc / K :' 1661 write (*,*)
' ENTER CRITICAL PRESSURE Pc / bar :' 1664 write (*,*)
' ENTER ACENTRIC FACTOR omega :' 1677 seg_new = mm(1)*0.05
1695 DO WHILE ( (abs(fvek1)+abs(fvek2)) > 2.6e-4 )
1698 parame(1,2) = sig_new
1699 parame(1,3) = eps_new
1703 parame(1,1) = seg_new + 0.01*
REAL(i-1)
1707 CALL critical (tc,pc,rhoc)
1713 sig_save = parame(1,2)
1714 parame(1,2) = sig_save*1.0002
1716 CALL critical (tc,pc,rhoc)
1718 df1dx = (fvek1-(t-tc)/tc )/( sig_save-parame(1,2) )
1719 df2dx = (fvek2-(p-pc)/pc )/( sig_save-parame(1,2) )
1720 parame(1,2) = sig_save
1725 eps_save = parame(1,3)
1726 parame(1,3) = eps_save*1.0002
1728 CALL critical (tc,pc,rhoc)
1730 df1dy = (fvek1-(t-tc)/tc )/( eps_save-parame(1,3) )
1731 df2dy = (fvek2-(p-pc)/pc )/( eps_save-parame(1,3) )
1732 parame(1,3) = eps_save
1734 betrag = df1dx*df2dy - df1dy*df2dx
1735 sig_new = parame(1,2) - attenu / betrag * (df2dy*fvek1+(-df1dy)*fvek2)
1736 eps_new = parame(1,3) - attenu / betrag * ((-df2dx)*fvek1+df1dx*fvek2)
1738 write (10,*) parame(1,2),parame(1,3),fvek1,fvek2,i
1739 write (*,*) parame(1,2),parame(1,3),fvek1,fvek2,i
1753 val_init(3) = 0.7*tc
1762 CALL phase_equilib(end_x,steps,converg)
1763 IF (converg /= 1)
THEN 1764 call paus (
'PARITER_CRIT: equilibrium calculation failed')
1768 par1_sv = parame(1,2)
1769 par2_sv = parame(1,3)
1770 par3_sv = parame(1,1)
1771 omeg_sv = -1.0 - log10(val_conv(4)/pc)
1772 err_sv = omeg_sv-omega
1773 write (10,*)
'error',i,err_sv
1774 write (*,*)
'error',i,err_sv
1776 omeg_nw = -1.0 - log10(val_conv(4)/pc)
1777 err_nw = omeg_nw-omega
1778 write (10,*)
'error',i,err_nw
1779 write (*,*)
'error',i,err_nw
1781 write (10,*)
'omega',i,-1.0 - log10(val_conv(4)/pc)
1782 write (*,*)
'omega',i,-1.0 - log10(val_conv(4)/pc)
1786 derrdr =(err_sv - err_nw)/(par3_sv-parame(1,1))
1787 seg_new = par3_sv - 0.9 * err_sv/derrdr
1788 write (10,*)
'derivative',derrdr
1789 write (10,*)
'new value for m',seg_new
1790 write (*,*)
'derivative',derrdr
1791 write (*,*)
'new value for m',seg_new
1793 IF (abs(err_sv) <= 3.e-5)
EXIT crit_loop
1798 write (*,*)
' Pure component parameters :' 1800 write (*,*)
' sigma = ',par1_sv
1801 write (*,*)
' eps/k = ',par2_sv
1802 write (*,*)
' m = ',par3_sv
1804 write (10,*)
' Pure component parameters :' 1806 write (10,*)
' mm(i) = ',mm(1)
1807 write (10,*)
' parame(i,1) = ',par3_sv
1808 write (10,*)
' parame(i,2) = ',par1_sv
1809 write (10,*)
' parame(i,3) = ',par2_sv
1813 END SUBROUTINE pariter_crit
WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW This module contains constant...
WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW This module contains paramete...
WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW This module contains paramete...
WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW Module STARTING_VALUES This m...
WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW This module contains paramete...
WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW This module contains paramete...
subroutine, public start_var(converg)
subroutine start_var
program pc_saft
Starting Point of PC-SAFT program.