From a48b4100c730360d0ef65e37fe8d97439d6f4f14 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Sat, 5 Aug 2023 10:43:55 -0300 Subject: [PATCH 01/48] feat(envelopes): basic fluid injection module --- src/new/mod_inj_envelopes.f90 | 239 ++++++++++++++++++++++++++++++++++ 1 file changed, 239 insertions(+) create mode 100644 src/new/mod_inj_envelopes.f90 diff --git a/src/new/mod_inj_envelopes.f90 b/src/new/mod_inj_envelopes.f90 new file mode 100644 index 0000000..00ae514 --- /dev/null +++ b/src/new/mod_inj_envelopes.f90 @@ -0,0 +1,239 @@ +module inj_envelopes + use constants, only: pr, R + use dtypes, only: envelope + use linalg, only: solve_system + + implicit none + + integer :: max_iters = 500 + integer, parameter :: max_points = 1000 + real(pr), allocatable :: z_0(:) + real(pr), allocatable :: z_injection(:) + real(pr) :: T + real(pr) :: del_S = 0.1 + character(len=:), allocatable :: injection_case +contains + ! ============================================================================= + ! Injection envelopes + ! ----------------------------------------------------------------------------- + subroutine F_injection(X, ns, S, F, dF) + use iso_fortran_env, only: error_unit + real(pr), intent(in) :: X(:) + integer, intent(in) :: ns + real(pr), intent(in) :: S + real(pr), intent(out) :: F(size(X)) + real(pr), intent(out) :: df(size(x), size(X)) + + ! X variables + real(pr) :: K(size(X) - 2) + real(pr) :: alpha + real(pr) :: P + + ! Main phase variables + real(pr) :: Vz + real(pr), dimension(size(X)-2) :: z, lnfug_z, dlnphi_dt_z, dlnphi_dp_z + real(pr), dimension(size(X)-2, size(X)-2) :: dlnphi_dn_z + + ! Incipient phase variables + real(pr) :: Vy + real(pr), dimension(size(X)-2) :: y, lnfug_y, dlnphi_dt_y, dlnphi_dp_y + real(pr), dimension(size(X)-2, size(X)-2) :: dlnphi_dn_y + + real(pr) :: dzda(size(X)-2) + + integer :: i, j, n + + n = size(X) - 2 + K = exp(X(1:n)) + P = exp(X(n+1)) + alpha = X(n+2) + + select case(injection_case) + case("displace") + z = (z_injection * alpha + (1.0_pr - alpha) * z_0) + dzda = z_injection - z_0 + case("dilution") + z = (z_injection * alpha + z_0)/sum(z_injection * alpha + z_0) + dzda = -(alpha*z_injection + z_0) & + * sum(z_injection) / sum(alpha*z_injection + z_0)**2 & + + z_injection / sum(alpha*z_injection + z_0) + case default + z = (z_injection * alpha + (1.0_pr - alpha) * z_0) + dzda = z_injection - z_0 + end select + + y = K * z + + call TERMO(n, 0, 4, T, P, y, Vy, lnfug_y, dlnphi_dp_y, dlnphi_dt_y, dlnphi_dn_y) + call TERMO(n, 0, 4, T, P, z, Vz, lnfug_z, dlnphi_dp_z, dlnphi_dt_z, dlnphi_dn_z) + + F(1:n) = X(:n) + lnfug_y - lnfug_z + F(n+1) = sum(y - z) + F(n+2) = X(ns) - S + + df = 0 + + do i=1,n + do j=1,n + df(i, j) = y(j) * dlnphi_dn_y(i, j) + end do + df(i, i) = df(i, i) + 1 + df(i, n+2) = sum(K * dlnphi_dn_y(i, :) * dzda - dlnphi_dn_z(i, :) * dzda) + end do + + df(:n, n+1) = P * (dlnphi_dp_y - dlnphi_dp_z) + df(n+1, :n) = y + df(n+1, n+2) = sum(dzda*(K-1)) + + df(n+2, :) = 0 + df(n+2, ns) = 1 + end subroutine + + subroutine injection_envelope(X0, spec_number, envels) + !! Subroutine to calculate Px phase envelopes + real(pr), intent(in) :: X0(:) !! Vector of variables + integer, intent(in) :: spec_number !! Number of specification + type(envelope), allocatable, intent(out) :: envels(:) !! Calculated envelopes + + real(pr) :: X(size(X0)) + integer :: ns + real(pr) :: S + real(pr) :: XS(max_points, size(X0)) + + real(pr) :: F(size(X0)), dF(size(X0), size(X0)), dXdS(size(X0)) + + integer :: point, iters, n + + X = X0 + + n = size(X0) - 2 + + ns = spec_number + S = X(ns) + + print *, "#", X(n+2) + print *, "X0", iters, ns, X + do point=1, max_points + call full_newton(f_injection, iters, X, ns, S, F, dF) + + if (iters >= max_iters) then + print *, "Breaking due to not converged point" + exit + end if + + print *, "SOL", iters, ns, X + + update_spec: block + real(pr) :: dFdS(size(X0)) + integer :: ns_new + + dFdS = dF(n+2, :) + dXdS = solve_system(dF, dFdS) + + ns_new = maxloc(abs(dXdS), dim=1) + ns_new = ns + + if (ns_new /= ns) then + dXdS = dXdS/dXdS(ns_new) + del_S = dXdS(ns_new) * del_S ! translation of delS to the new specification variable + end if + ns = ns_new + + del_S = sign(1.0_pr, del_S) * minval( [ & + max(sqrt(abs(X(ns)))/10, 0.1), & + abs(del_S) * 3/iters & + ] & + ) + ! del_S = del_S*10 + end block update_spec + + fix_step: block + real(pr) :: Xnew(size(X0)) + real(pr) :: dP, dalpha + Xnew = X + dXdS * del_S + dP = exp(Xnew(n+1)) - exp(X(n+1)) + dalpha = exp(Xnew(n+2)) - exp(X(n+2)) + + if (& + abs(dalpha) > 0.1 & + .or. abs(dP) > 50 & + ) then + + Xnew = X + dXdS * del_S + dP = exp(Xnew(n+1)) - exp(X(n+1)) + dalpha = exp(Xnew(n+2)) - exp(X(n+2)) + + dXdS = dXdS/50.0_pr + end if + end block fix_step + + detect_critical: block + real(pr) :: K(size(X0) - 2), Knew(size(X0) - 2), fact + fact = 50 + K = X(:n) + Knew = X(:n) + fact * dXdS(:n) * del_S + ! print *, "EXTRAPOL", ns, point, Knew + if (all(K * Knew < 0)) then + dXdS = fact * dXdS + end if + end block detect_critical + + X = X + dXdS * del_S + S = X(ns) + + ! if (any(break_conditions(X, ns, S))) exit + end do + end subroutine + + subroutine full_newton(fun, iters, X, ns, S, F, dF) + interface + subroutine fun(X, ns, S, F, dF) + import pr + real(pr), intent(in) :: X(:) + integer, intent(in) :: ns + real(pr), intent(in) :: S + real(pr), intent(out) :: F(size(X)) + real(pr), intent(out) :: dF(size(X), size(X)) + end subroutine + end interface + integer, intent(out) :: iters + real(pr), intent(in out) :: X(:) + integer, intent(in) :: ns + real(pr), intent(in) :: S + real(pr), intent(out) :: F(size(X)) + real(pr), intent(out) :: df(size(X), size(X)) + + real(pr) :: b(size(X)), A(size(X), size(X)) + + real(pr) :: dX(size(X)), tol=1e-5 + + dX = 20 + + newton: do iters=1, max_iters*10 + if (maxval(abs(dx)) < tol) exit newton + call fun(X, ns, S, b, A) + + b = -b + dX = solve_system(A, b) + + do while (maxval(abs(dX)) > 1) + dX = dX/10 + end do + + X = X + dX + end do newton + + F = b + dF = A + end subroutine + + function break_conditions(X, ns, S) + real(pr) :: X(:) + integer :: ns + real(pr) :: S + + logical :: break_conditions(1) + + break_conditions(1) = (X(size(X)) > 1) + end function +end module From a0b30fed16a5dc697d08029b8bbfae7770e8fa96 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Fri, 18 Aug 2023 16:09:14 -0300 Subject: [PATCH 02/48] refactor: Moved the envelopes logic to single subroutines --- app/main.f90 | 51 ++++++++++++++++++++++++++------------------------- 1 file changed, 26 insertions(+), 25 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index 34b1890..d1ca313 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -1,29 +1,30 @@ program main - use envelopes, only: envelope2, max_points, k_wilson_bubble - use dtypes, only: envelope - use constants, only: pr - use io_nml, only: read_system, write_system - use system, only: z, nc - implicit none - - real(pr), allocatable :: tv(:) ! Temperatures [K] - real(pr), allocatable :: pv(:) ! Pressures [bar] - real(pr), allocatable :: dv(:) ! Pressures [bar] - real(pr) :: tcri(4) ! Critical points temperatures - real(pr) :: pcri(4) ! Critical points pressures - real(pr) :: dcri(4) ! Critical points densities - real(pr) :: t, p ! Temperature and pressure - real(pr), allocatable :: k(:) ! K factors - integer :: n_points, icri(4), ncri, funit_system - - type(envelope) :: env - - allocate(tv(max_points), pv(max_points), dv(max_points), k(max_points)) - call read_system("input.nml") - - open(newunit=funit_system, file="systemdata.nml") - call write_system(funit_system) - close(funit_system) + use envelopes, only: envelope2, max_points, k_wilson_bubble, & + max_points, p_wilson, k_wilson + use dtypes, only: envelope + use constants, only: pr + use system, only: z, nc + + implicit none + + real(pr), allocatable :: tv(:) ! Temperatures [K] + real(pr), allocatable :: pv(:) ! Pressures [bar] + real(pr), allocatable :: dv(:) ! Densities [mol/L] + + real(pr) :: tcri(4) ! Critical points temperatures + real(pr) :: pcri(4) ! Critical points pressures + real(pr) :: dcri(4) ! Critical points densities + + real(pr) :: t, p ! Temperature and pressure + real(pr), allocatable :: k(:) ! K factors + + integer :: n_points, icri(4), ncri, i + + type(envelope) :: bub_env, dew_env + + call setup ! + call pt_envelopes + call px_envelopes call k_wilson_bubble(z, t, p, k) From 02afdb59e560d5504ca19df98cf4af21dce3fff9 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Fri, 18 Aug 2023 16:09:41 -0300 Subject: [PATCH 03/48] feat(setup): Logic to read input files --- app/main.f90 | 28 +++++++++++++++++++--------- 1 file changed, 19 insertions(+), 9 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index d1ca313..753c7cf 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -25,13 +25,23 @@ program main call setup ! call pt_envelopes call px_envelopes - - call k_wilson_bubble(z, t, p, k) - - call envelope2(& - 1, nc, z, T, P, k, & - n_points, Tv, Pv, Dv, ncri, icri, Tcri, Pcri, Dcri, & - env & - ) - call env%write("output.csv") +contains + subroutine setup + use io_nml, only: read_system, write_system + use system, only: kij + use inj_envelopes, only: setup_inj => from_nml + integer :: funit_system + character(len=254) :: infile + call get_command_argument(1, value=infile) + + call read_system(trim(infile)) + call setup_inj(trim(infile)) + + open (newunit=funit_system, file="systemdata.nml") + call write_system(funit_system) + close (funit_system) + + allocate (tv(max_points), pv(max_points), dv(max_points)) + allocate (k(size(z))) + end subroutine end program main From 23a1d0eecbc51fabe8c51ebe0d88838f04bcbf35 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Fri, 18 Aug 2023 16:10:30 -0300 Subject: [PATCH 04/48] feat(PT envelopes): Calculation of 2ph-PT envelopes --- app/main.f90 | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) diff --git a/app/main.f90 b/app/main.f90 index 753c7cf..72347e9 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -44,4 +44,52 @@ subroutine setup allocate (tv(max_points), pv(max_points), dv(max_points)) allocate (k(size(z))) end subroutine + + subroutine pt_envelopes + !! Calculation of PT envelopes of the main system. + + integer :: n + + ! ===================================================================== + ! Bubble envel + ! --------------------------------------------------------------------- + call k_wilson_bubble(z, t, p, k) + call envelope2( & + 1, nc, z, T, P, k, & + n_points, Tv, Pv, Dv, ncri, icri, Tcri, Pcri, Dcri, & + bub_env & + ) + ! ===================================================================== + + ! ===================================================================== + ! Dew/AOP envelopes + ! --------------------------------------------------------------------- + t = 315 + p = p_wilson(z, t) + do while (p > 0.1) + t = t - 5 + p = p_wilson(z, t) + end do + k = 1/k_wilson(t, p) + + call envelope2( & + 2, nc, z, T, P, k, & + n_points, Tv, Pv, Dv, ncri, icri, Tcri, Pcri, Dcri, & + dew_env & + ) + + ! Remove the low pressure parts. + n = 1 + do i = 2, size(dew_env%t) + n = n + 1 + if (dew_env%t(i) - dew_env%t(i - 1) < 0) exit + end do + + if (n /= size(dew_env%t)) then + dew_env%t = dew_env%t(i:) + dew_env%p = dew_env%p(i:) + dew_env%logk = dew_env%logk(i:, :) + end if + ! ===================================================================== + end subroutine end program main From 19b675b694b1aed6230d21705fc3e9a99fa6e08e Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Fri, 18 Aug 2023 16:10:58 -0300 Subject: [PATCH 05/48] feat(Px envelopes): Main logic to calculate the system of Px envelopes --- app/main.f90 | 117 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 117 insertions(+) diff --git a/app/main.f90 b/app/main.f90 index 72347e9..2bd3278 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -92,4 +92,121 @@ subroutine pt_envelopes end if ! ===================================================================== end subroutine + + subroutine px_envelopes + !! Calculation of Px envelopes at selected temperature. + use inj_envelopes, only: F_injection, full_newton, z_injection, & + T_inj => T, injection_envelope, z_0, injection_case, & + injelope, funit_output + use envelopes, only: envelope, k_wilson, p_wilson + use linalg, only: interpol + + real(pr), allocatable :: X(:), F(:), F2(:), dF(:, :), df_num(:, :) + real(pr) :: alpha, S + integer :: ns, i, iters, idx, ti + integer, allocatable :: i_inj(:) + real(pr), allocatable :: ts_envel(:), ts(:) + real(pr) :: t_tol = 2 + + type(injelope) :: bub_envels, dew_envels + allocate (X(nc + 2), F(nc + 2), dF(nc + 2, nc + 2), df_num(nc + 2, nc + 2), F2(nc + 2)) + + ! ====================================================================== + ! Setup system + ! ---------------------------------------------------------------------- + alpha = 0.0 + z_injection = z_injection/sum(z_injection) + ns = nc + 2 + open (newunit=funit_output, file="px.dat") + ! ====================================================================== + + ! ====================================================================== + ! Bubble envelope + ! ---------------------------------------------------------------------- + print *, "Running Bubble" + bubble: block + real(pr) :: pold + pold = 0 + ts_envel = pack(bub_env%t, mask=abs(bub_env%t - t_inj) < t_tol) + do i = 1, size(ts_envel) + idx = findloc(bub_env%t, value=ts_envel(i), dim=1) + print *, ts_envel(i) + + p = interpol( & + bub_env%t(idx), bub_env%t(idx + 1), & + bub_env%p(idx), bub_env%p(idx + 1), & + t_inj) + + if (abs(p - pold) < 5) cycle + pold = p + + k = exp(interpol( & + bub_env%t(idx), bub_env%t(idx + 1), & + bub_env%logk(idx, :), bub_env%logk(idx + 1, :), & + t_inj)) + + X(1:nc) = log(K) + X(nc + 1) = log(P) + X(nc + 2) = alpha + + call injection_envelope(X, ns, 0.01_pr, bub_envels) + end do + end block bubble + ! ====================================================================== + + ! ====================================================================== + ! Dew envelope + ! ---------------------------------------------------------------------- + print *, "Running Dew" + dew: block + real(pr) :: pold + pold = 0 + ts_envel = pack(dew_env%t, mask=abs(dew_env%t - t_inj) < t_tol) + do i = 1, size(ts_envel) + idx = findloc(dew_env%t, value=ts_envel(i), dim=1) + + alpha = 0 + + p = interpol( & + dew_env%t(idx), dew_env%t(idx + 1), & + dew_env%p(idx), dew_env%p(idx + 1), & + t_inj) + + if (abs(p - pold) < 5) cycle + pold = p + print *, ts_envel(i), p + + k = exp(interpol( & + dew_env%t(idx), dew_env%t(idx + 1), & + dew_env%logk(idx, :), dew_env%logk(idx + 1, :), & + t_inj)) + + X(1:nc) = log(K) + X(nc + 1) = log(P) + X(nc + 2) = alpha + + call injection_envelope(X, ns, 0.01_pr, dew_envels) + end do + end block dew + ! ====================================================================== + + ! ====================================================================== + ! Look for crossings + ! ---------------------------------------------------------------------- + check_crossings: block + use linalg, only: point, intersection + type(point), allocatable :: inter(:) + inter = intersection( & + dew_envels%alpha, dew_envels%p, & + bub_envels%alpha, bub_envels%p & + ) + + do i = 1, size(inter) + print *, inter(i) + end do + end block check_crossings + ! ====================================================================== + close (funit_output) + print *, "END" + end subroutine end program main From c1990b8ebeacc910fadf9b15ea95772b057aee3b Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Fri, 18 Aug 2023 16:11:21 -0300 Subject: [PATCH 06/48] format --- src/new/constants.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/new/constants.f90 b/src/new/constants.f90 index 34282eb..1f22afc 100644 --- a/src/new/constants.f90 +++ b/src/new/constants.f90 @@ -6,5 +6,4 @@ module constants real(pr), parameter :: R = 0.08314472 character(len=254) :: database_path = "database/" character(len=1) :: path_sep = "/" - end module constants From 03f23b1e00c6c573de5667dcd8e3d58b6fe8a2ee Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Fri, 18 Aug 2023 16:12:01 -0300 Subject: [PATCH 07/48] feat(linalg): interpolation function --- src/linalg.f90 | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/linalg.f90 b/src/linalg.f90 index d4305e2..3c586b8 100644 --- a/src/linalg.f90 +++ b/src/linalg.f90 @@ -24,4 +24,13 @@ function solve_system(a, b) result(x) x = b_lapack end function solve_system + elemental function interpol(x1, x2, y1, y2, x_obj) result(y) + real(pr), intent(in) :: x1 + real(pr), intent(in) :: x2 + real(pr), intent(in) :: y1 + real(pr), intent(in) :: y2 + real(pr), intent(in) :: x_obj + real(pr) :: y + y = (y2 - y1)/(x2 - x1) * (x_obj - x1) + y1 + end function end module linalg \ No newline at end of file From d760afe115a3046b0e11d5c0b145b4fa304fe016 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Fri, 18 Aug 2023 16:13:05 -0300 Subject: [PATCH 08/48] feat(intersections): Get the inteserction between two lines --- src/linalg.f90 | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/linalg.f90 b/src/linalg.f90 index 3c586b8..14fedf2 100644 --- a/src/linalg.f90 +++ b/src/linalg.f90 @@ -24,6 +24,21 @@ function solve_system(a, b) result(x) x = b_lapack end function solve_system + subroutine intersects(x1, x2, x3, x4, y1, y2, y3, y4, s, t) + real(pr), intent(in) :: x1, x2, x3, x4, y1, y2, y3, y4 + real(pr), intent(out) :: s, t + + real(pr) :: A(2,2), b(2), tmp + + A(1, :) = [x2-x1, x3-x4] + A(2, :) = [y2-y1, y3-y4] + b = [x3-x1, y3-y1] + + b = solve_system(a, b) + s = b(1) + t = b(2) + end subroutine + elemental function interpol(x1, x2, y1, y2, x_obj) result(y) real(pr), intent(in) :: x1 real(pr), intent(in) :: x2 From d60bf97963054cb0280cbcf92e8b597a600c2607 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Fri, 18 Aug 2023 16:13:45 -0300 Subject: [PATCH 09/48] feat(intersect): Function to get a self cross --- src/linalg.f90 | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/src/linalg.f90 b/src/linalg.f90 index 14fedf2..247c363 100644 --- a/src/linalg.f90 +++ b/src/linalg.f90 @@ -24,6 +24,44 @@ function solve_system(a, b) result(x) x = b_lapack end function solve_system + function intersect_one_line(lx, ly) result(intersections) + real(pr), intent(in) :: lx(:), ly(:) + type(point), allocatable :: intersections(:) + character(len=*), parameter :: fmt="(*(G0,:,', '))" + + real(pr) :: s, t + integer :: i, j + + real(pr) :: x, y, xold=9999, yold=9999 + + allocate(intersections(0)) + line1: do i=2, size(lx)-1 + line2: do j=i+15, size(lx) + associate(x1 => lx(i-1), x2 => lx(i), x3 => lx(j), x4 => lx(j-1), & + y1 => ly(i-1), y2 => ly(i), y3 => ly(j), y4 => ly(j-1)) + call intersects(x1, x2, x3, x4, y1, y2, y3, y4, s, t) + if (0 <= s .and. s <= 1 .and. 0 <= t .and. t <= 1) then + + x = s*(x2 - x1) + x1 + y = s*(y2 - y1) + y1 + + if (abs(x - xold) > 1 .and. abs(y - yold) > 1) then + print *, "CROSS" + print *, i, j, x, y + write(*, fmt) "x1, y1 = ", x1, y1 + write(*, fmt) "x2, y2 = ", x2, y2 + write(*, fmt) "x3, y3 = ", x3, y3 + write(*, fmt) "x4, y4 = ", x4, y4 + xold = x + yold = y + intersections = [intersections, point(x, y, i, j)] + end if + end if + end associate + end do line2 + end do line1 + end function + subroutine intersects(x1, x2, x3, x4, y1, y2, y3, y4, s, t) real(pr), intent(in) :: x1, x2, x3, x4, y1, y2, y3, y4 real(pr), intent(out) :: s, t From f1e6a25ea295e9db5891f305ad19ebbdfe59133f Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Fri, 18 Aug 2023 16:13:59 -0300 Subject: [PATCH 10/48] feat(intersect): Two lines intersection --- src/linalg.f90 | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/src/linalg.f90 b/src/linalg.f90 index 247c363..1e4b7e8 100644 --- a/src/linalg.f90 +++ b/src/linalg.f90 @@ -24,6 +24,42 @@ function solve_system(a, b) result(x) x = b_lapack end function solve_system + + function intersect_two_lines(l1_x, l1_y, l2_x, l2_y) result(intersections) + real(pr), intent(in) :: l1_x(:), l1_y(:), l2_x(:), l2_y(:) + type(point), allocatable :: intersections(:) + + real(pr) :: s, t + integer :: i, j + + real(pr) :: x, y, xold=9999, yold=9999 + + allocate(intersections(0)) + + line1: do i=2, size(l1_x) + line2: do j=2, size(l2_x) + associate(x1 => l1_x(i-1), x2 => l1_x(i), x3 => l2_x(j-1), x4 => l2_x(j), & + y1 => l1_y(i-1), y2 => l1_y(i), y3 => l2_y(j-1), y4 => l2_y(j)) + call intersects(x1, x2, x3, x4, y1, y2, y3, y4, s, t) + + if (0 <= s .and. s <= 1 .and. 0 <= t .and. t <= 1) then + x = s * (x2-x1) + x1 + y = s * (y2-y1) + y1 + + if (abs(x - xold) > 1 .and. abs(y - yold) > 1) then + print *, "CROSS", x, y + xold = x + yold = y + intersections = [intersections, point(x, y, i, j)] + exit line2 + end if + + end if + end associate + end do line2 + end do line1 + end function + function intersect_one_line(lx, ly) result(intersections) real(pr), intent(in) :: lx(:), ly(:) type(point), allocatable :: intersections(:) From bfc5c1008a56633d74ddcae668bfb7f36406007d Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Fri, 18 Aug 2023 16:15:26 -0300 Subject: [PATCH 11/48] refactor(types): Moved point dtype to linalg --- src/linalg.f90 | 12 ++++ src/types.f90 | 192 ++----------------------------------------------- 2 files changed, 16 insertions(+), 188 deletions(-) diff --git a/src/linalg.f90 b/src/linalg.f90 index 1e4b7e8..01e62bd 100644 --- a/src/linalg.f90 +++ b/src/linalg.f90 @@ -2,6 +2,18 @@ module linalg !! Wrapper module around LAPACK's `dgesv` use constants, only: pr implicit none + + type :: point + real(pr) :: x + real(pr) :: y + integer :: i + integer :: j + end type point + + interface intersection + module procedure :: intersect_two_lines + module procedure :: intersect_one_line + end interface contains function solve_system(a, b) result(x) real(pr), intent(in out) :: b(:) diff --git a/src/types.f90 b/src/types.f90 index 4f23ab9..c7be3b1 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -7,17 +7,13 @@ module dtypes private public :: envelope public :: env3 - public :: point - public :: kfcross public :: print_header - public :: find_cross - public :: find_self_cross public :: critical_point - type :: critical_point real(pr) :: t real(pr) :: p + real(pr) :: alpha end type critical_point type :: envelope @@ -42,16 +38,7 @@ module dtypes contains procedure :: write => write_envel_3 end type env3 - - type :: point - real(pr) :: x - real(pr) :: y - integer :: i - integer :: j - end type point - contains - subroutine write_critical_points(self, file_name) type(critical_point), intent(in) :: self(:) character(len=*), optional, intent(in) :: file_name !! Ouptut file name @@ -73,7 +60,7 @@ subroutine write_critical_points(self, file_name) end do close(file_unit) end subroutine - + subroutine write_envel_2(self, file_name) class(envelope), intent(in):: self character(len=*), optional, intent(in) :: file_name !! Ouptut file name @@ -104,9 +91,9 @@ subroutine write_envel_2(self, file_name) end associate ! Write Critical Points file - filename = filename // "-CP" + ! filename = filename // "-CP" - call write_critical_points(self%critical_points, filename) + ! call write_critical_points(self%critical_points, filename) deallocate(filename) end subroutine write_envel_2 @@ -151,22 +138,6 @@ subroutine write_envel_3(self, file_name) deallocate(filename) end subroutine write_envel_3 - function kfcross(i, t_values, logk, target_t) - !! Estimate the Kvalues of an envelope by interpolation from a near point. - integer, intent(in) :: i - real(pr), allocatable, intent(in) :: t_values(:) !! Envelope's temperatures - real(pr), allocatable, intent(in) :: logk(:, :) !! Envelope's kvalues - real(pr), intent(in) :: target_t !! Target temperature where to interpolate - - real(pr), allocatable :: kfcross(:) !! Kvalues at desired point - - kfcross = (logk(i, :) - logk(i - 1, :)) & - /& - (t_values(i) - t_values(i - 1)) & - * (target_t - t_values(i - 1)) & - + logk(i - 1, :) - end function - subroutine print_header(name) character(len=250), intent(in) :: name @@ -174,159 +145,4 @@ subroutine print_header(name) print *, "!", name print *, "-----------------------------------" end subroutine print_header - - subroutine find_cross(tv1, tv2, pv1, pv2, crossings, crossed) - !! Find crossings between two given lines - !! - !! Returns an array of crossigns, containings the crosses found. Each row - !! contains the data from each found cross - !! - !! | --------| ------- | ---------------- | ----------------- | - !! | x_cross | y_cross | first_line_index | second_line_index | - !! | --------| ------- | ---------------- | ----------------- | - !! - - real(pr), intent(in) :: tv1(:) !! First line x values - real(pr), intent(in) :: tv2(:) !! Second line x values - real(pr), intent(in) :: pv1(:) !! First line y values - real(pr), intent(in) :: pv2(:) !! Second line y values - logical, optional, intent(out) :: crossed - - type(point), allocatable :: crossings(:) !! Array of crossings - type(point) :: current_cross - - real(pr) :: x11, x12, x21, x22, y11, y12, y21, y22 - - real(pr) :: x_cross, y_cross, m1, b1, m2, b2, xlow, xup, ylow, yup - real(pr), dimension(2) :: xpair_1, xpair_2, ypair_1, ypair_2 - integer :: i, j, n - - if (present(crossed)) then - crossed = .false. - end if - - if (allocated(crossings)) then - deallocate (crossings) - end if - - allocate (crossings(0)) - n = 0 - - do i = 2, size(tv1) - xpair_1 = tv1(i - 1:i) - ypair_1 = pv1(i - 1:i) - - x11 = xpair_1(1) - x12 = xpair_1(2) - y11 = ypair_1(1) - y12 = ypair_1(2) - - m1 = (y12 - y11)/(x12 - x11) - b1 = y11 - m1*x11 - - do j = 2, size(tv2) - xpair_2 = tv2(j - 1:j) - ypair_2 = pv2(j - 1:j) - - x21 = xpair_2(1) - x22 = xpair_2(2) - y21 = ypair_2(1) - y22 = ypair_2(2) - - m2 = (y22 - y21)/(x22 - x21) - b2 = y21 - m2*x21 - - x_cross = (b1 - b2)/(m2 - m1) - y_cross = m1*x_cross + b1 - - xlow = max(minval(xpair_1), minval(xpair_2)) - xup = min(maxval(xpair_1), maxval(xpair_2)) - ylow = max(minval(ypair_1), minval(ypair_2)) - yup = min(maxval(ypair_1), maxval(ypair_2)) - - if ( & - (xlow <= x_cross) .and. (x_cross <= xup) .and. & - (ylow <= y_cross) .and. (y_cross <= yup) & - ) then - if (present(crossed)) crossed = .true. - print *, "CROSS:", i, j, x_cross, y_cross - - ! TODO: This should get back, but for some reason now - ! there is a dimension 0 error that didn't appear before - - ! if ((abs(x_cross - crossings(n)%x) < 0.1) .and. & - ! (abs(y_cross - crossings(n)%y) < 0.1)) then - ! print *, "CROSS: Repeated cross, skipping..." - ! cycle - ! end if - - current_cross = point(x_cross, y_cross, i, j) - n = n + 1 - crossings = [crossings, current_cross] - - end if - end do - end do - end subroutine find_cross - - subroutine find_self_cross(array_x, array_y, found_cross, crossed) - use constants, only: pr - use array_operations, only: diff, mask - - real(pr), intent(in) :: array_x(:) - real(pr), intent(in) :: array_y(size(array_x)) - type(point), allocatable, intent(in out) :: found_cross(:) - logical, optional, intent(out) :: crossed - - logical, allocatable :: filter(:) - integer, allocatable :: msk(:) - real(pr) :: min_x, max_x - - integer :: i, idx, idy - - if(present(crossed)) crossed = .false. - - ! All the values with positive delta - filter = diff(array_x) > 0 - - return - - i = 1 - do while(filter(i)) - ! Find the first ocurrence of a negative delta x - ! This will give the index of the cricondentherm - i = i + 1 - end do - - ! if (i < size(array_x)) then - ! msk = mask(filter(i:)) + i - ! max_x = maxval(array_x(msk)) - ! min_x = minval(array_x(msk)) - - ! ! - ! filter = array_x <= max_x - 5 .and. array_x >= min_x - 5 .and. array_y >= 10 - ! msk = mask(filter) - - ! call find_cross(& - ! array_x(msk), array_x(msk), array_y(msk), array_y(msk), found_cross, crossed & - ! ) - - ! if (size(found_cross) > 1) then - ! found_cross%i = found_cross%i + msk(1) - ! found_cross%j = found_cross%j + msk(1) - ! end if - ! end if - - - ! if (size(found_cross) > 0) then - ! do i=1,size(found_cross) - ! ! TODO: This assumes there is only one self-cross, should be better defined - ! idx = minloc(abs(array_x - found_cross(i)%x), dim=1) - ! idy = minloc(abs(array_y - found_cross(i)%y), dim=1) - - ! found_cross(i)%i = idx - ! found_cross(i)%j = idy - ! end do - ! end if - end subroutine find_self_cross end module dtypes From 93975e700f277318aaa34db10accd230ac8f13de Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Fri, 18 Aug 2023 16:16:18 -0300 Subject: [PATCH 12/48] feat(testing): Simple test to check intersections --- test/test_intersect.f90 | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) create mode 100644 test/test_intersect.f90 diff --git a/test/test_intersect.f90 b/test/test_intersect.f90 new file mode 100644 index 0000000..d5e4231 --- /dev/null +++ b/test/test_intersect.f90 @@ -0,0 +1,38 @@ +module test_lines + use constants, only: pr + real(pr) :: self_x(374), self_y(374) +contains + + subroutine read_selfxy + integer :: i, funit + open(newunit=funit, file="test/self_cross_line") + do i=1,374 + read(funit, *) self_x(i), self_y(i) + end do + close(funit) + end subroutine +end module + +program test_intersect + use constants, only: pr + use test_lines, only: self_x, self_y, read_selfxy + use linalg, only: intersection + implicit none + integer, parameter :: n=2001 + real(pr) :: l1_x(n), l2_x(n) + real(pr) :: l1_y(n), l2_y(n) + integer :: i + + real(pr) :: inter + + l1_x = [(real(i, pr)/100._pr, i=-1000,1000)] + l2_x = [(real(i, pr)/100._pr, i=-1000,1000)] + + l1_y = 2 * l1_x + l2_y = l2_x ** 2 + + call intersection(l1_x, l1_y, l2_x, l2_y, inter) + call read_selfxy + call intersection(self_x, self_y, inter) +end program + From f7896fefbfeefff1a2d31aa0b9d7a0a0e6696610 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Fri, 18 Aug 2023 16:17:17 -0300 Subject: [PATCH 13/48] refactor(crossings): Removed crossings logic Should get back later for whole phase diagrams --- src/new/envelopes.f90 | 317 ++++++++---------------------------------- 1 file changed, 57 insertions(+), 260 deletions(-) diff --git a/src/new/envelopes.f90 b/src/new/envelopes.f90 index adcb908..87e420e 100644 --- a/src/new/envelopes.f90 +++ b/src/new/envelopes.f90 @@ -7,11 +7,17 @@ module envelopes use dtypes, only: envelope implicit none - integer :: max_points = 1000 + integer, parameter :: max_points = 2000 integer :: env_number = 0 - interface F - module procedure :: F2 + interface + function F(X, ns, S) + import pr + real(pr), intent(in) :: X(:) + integer, intent(in) :: ns + real(pr), intent(in) :: S + real(pr) :: F + end function end interface contains ! =========================================================================== @@ -26,18 +32,31 @@ subroutine k_wilson_bubble(z, t, p, k) real(pr), intent(out) :: k(size(z)) - P = 11.0 - T = 205.0 + P = 100.0 + T = 200.0 do while (P > 10) T = T - 5._pr - P = sum(z*pc*exp(5.373_pr*(1 + w)*(1 - tc/T))) + P = 1.0_pr/sum(z*pc*exp(5.373_pr*(1 + w)*(1 - tc/T))) end do - - k = pc*exp(5.373_pr*(1.0_pr + w)*(1.0_pr - tc/t))/p + k = k_wilson(t, p) end subroutine - + + function k_wilson(t, p) result(k) + use system, only: pc, tc, w + real(pr), intent(in) :: t, p + real(pr) :: k(size(pc)) + k = pc * exp(5.373_pr * (1.0_pr + w) * (1.0_pr - tc/t))/p + end function + + function p_wilson(z, t) result(p) + use system, only: pc, tc, w + real(pr), intent(in) :: t, z(:) + real(pr) :: p + P = 1.0_pr/sum(z*pc*exp(5.373_pr*(1 + w)*(1 - tc/T))) + end function ! =========================================================================== + ! =========================================================================== ! General routines ! --------------------------------------------------------------------------- @@ -192,6 +211,7 @@ subroutine fix_delx(& integer, intent(in) :: point integer, intent(in) :: iterations integer, intent(in) :: desired_iterations + real(pr), intent(in) :: first_tol real(pr), intent(in) :: tol real(pr), intent(in out) :: delX(:) @@ -217,8 +237,8 @@ subroutine fix_delx(& subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always exist n_points, Tv, Pv, Dv, ncri, icri, Tcri, Pcri, Dcri, & ! This shouldnt be here in the future this_envelope) ! This output should encapsulate everything - use dtypes, only: envelope, point, critical_point - use linalg, only: solve_system + use dtypes, only: envelope, critical_point + use linalg, only: point, solve_system implicit none ! number of compounds in the system and starting point type @@ -291,9 +311,7 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e integer :: black_i ! Number of steps while trying to escape the CP real(pr) :: stepx - integer :: funit_it integer :: funit_env - character(len=20) :: fname_it character(len=20) :: fname_env ! ============================================================================= @@ -371,10 +389,6 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e dFdS = 0.d0 dFdS(n + 2) = -1.d0 - write(fname_it, *) ichoice - fname_it = trim(adjustl("X_it_2ph" // "_" //adjustl(trim(fname_it)))) - - open(newunit=funit_it, file=fname_it) do while (run) i = i + 1 if (i > max_points - 50) then @@ -412,11 +426,7 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e y = z*KFACT T = exp(X(n + 1)) P = exp(X(n + 2)) - - write(funit_it, *) i, iter, T, P, KFACT end do - write(funit_it, *) " " - write(funit_it, *) " " ! Point converged (unless it jumped out because of high number of iterations) write(funit_env, *) T, P, exp(X(:n)) @@ -447,7 +457,7 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e run = .false. end if - print *, incipient_phase, i, T, P, ns, iter + ! print *, incipient_phase, i, T, P, ns, iter if (i > max_points - 50) exit if (sum(X(:n) * Xold(:n)) < 0) then ! critical point detected @@ -459,7 +469,6 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e Pcri(ncri) = Pv(i - 1) + frac*(P - Pv(i - 1)) Dcri(ncri) = Dv(i - 1) + frac*(Dv(i) - Dv(i - 1)) - select case (incipient_phase) case("liquid") incipient_phase = "vapor" @@ -556,7 +565,6 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e end do end block critical_region - T = exp(X(n + 1)) if (.not. passingcri .and. abs(T - Told) > 7) then @@ -575,8 +583,8 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e if ((dXdS(n + 1)*delS < 0 .and. P < 0.1 .or. T < 120.0) & ! dew line stops when P<0.1 bar or T<150K .or. (P > 1.0 .and. T < 150.0) & ! bubble line stops when T<150K .or. (P > 1500) & - .or. (abs(dels) < 1.d-8)) then - run = .false. + .or. (abs(dels) < 1.d-10)) then + run = .false. end if end if end do @@ -594,7 +602,6 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e ! Define envelope values, omit the last point to avoid not really ! converged cases - close(funit_it) close(funit_env) this_envelope%logk = tmp_logk(:n_points - 1, :) this_envelope%logphi = tmp_logphi(:n_points - 1, :) @@ -609,239 +616,29 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e end subroutine envelope2 ! =========================================================================== - ! ============================================================================= - ! Crossing related - ! ----------------------------------------------------------------------------- - subroutine find_crossings(& - dew, bub, hpl, & - Tcr1, Pcr1, Tcr2, Pcr2, & - kfcr1, kscr1, kfcr2, kscr2, & - crossings, stat & - ) - !! Find the crossings between the whole set of two-phase lines - !! - !! Possible cases (found yet): - !! - No cross - !! - Two crosses - !! - Single cross at high T (between HPLL and Dew line) - !! - Self cross and a low T cross - use dtypes, only: envelope, kfcross, point, find_cross, find_self_cross - implicit none - - type(envelope), intent(in out) :: dew !! Dew envelope (AOP) - type(envelope), intent(in out) :: bub !! Bubble envelope - type(envelope), intent(in out) :: hpl !! HPLL envelope - real(pr), intent(out) :: Tcr1, Pcr1, Tcr2, Pcr2 - real(pr), intent(out) :: kfcr1(:), kscr1(:), kfcr2(:), kscr2(:) - type(point), intent(out) :: crossings(2) - character(len=50), intent(in out) :: stat - - type(point), allocatable :: self_cross(:) - type(point), allocatable :: dew_bub_cross(:) - type(point), allocatable :: dew_hpl_cross(:) - type(point), allocatable :: bub_hpl_cross(:) - - logical :: has_hpll_line - - logical :: crossed_dew_hpl - logical :: crossed_bub_hpl - logical :: crossed_dew_dew - logical :: crossed_dew_bub - logical :: crossed_self - - tcr1 = 0 - tcr2 = 0 - pcr1 = 0 - pcr2 = 0 - - has_hpll_line = allocated(hpl%t) - stat = "0" - - ! ======================================================================== - ! Find the crossings - ! ------------------------------------------------------------------------ - - ! First check if the dew_envelope or the low_t_envelope self_cross - call find_self_cross(dew%t, dew%p, self_cross, crossed_self) - - ! Then: - ! - Check if HPLL line has been traced - ! - [Cross dew bub?]|[Cross bub HPLL andor Cross dew HPLL] - if (has_hpll_line) then - call find_cross(dew%t, hpl%t, dew%p, hpl%p, dew_hpl_cross, crossed_dew_hpl) - call find_cross(bub%t, hpl%t, bub%p, hpl%p, bub_hpl_cross, crossed_bub_hpl) - call find_cross(dew%t, bub%t, dew%p, bub%p, dew_bub_cross, crossed_dew_bub) - else - call find_cross(dew%t, bub%t, dew%p, bub%p, dew_bub_cross, crossed_dew_bub) - end if - - if (size(dew_bub_cross) > 10) then - ! With this amount of crosses it's more probable that both - ! are the same line - crossed_dew_bub = .false. - end if - ! ======================================================================== - - if (has_hpll_line) then - if (crossed_bub_hpl .and. crossed_dew_bub) then - ! HPLL line crossed with bubble, and bubble crossed with dew - call get_values(bub_hpl_cross, 1, hpl, bub, tcr1, pcr1, kscr1, kfcr1) - call get_values(dew_bub_cross, 1, bub, dew, tcr2, pcr2, kfcr2, kscr2) - - crossings(1) = bub_hpl_cross(1) - crossings(2) = dew_bub_cross(1) - stat = "2_HPL_BUB_DEW" - else if (crossed_dew_hpl) then - ! HPLL line crossed with dew line - call get_values(dew_hpl_cross, 1, hpl, dew, tcr2, pcr2, kfcr2, kscr2) - if (allocated(dew%critical_points)) then - if (size(dew%critical_points) > 0) then - if (tcr2 < dew%critical_points(1)%t) then - tcr1 = tcr2 - pcr1 = pcr2 - end if - end if - end if - crossings(1) = dew_hpl_cross(1) - stat = "1_HPL_DEW" - end if - else - if (crossed_dew_bub) then - call get_values(dew_bub_cross, 1, bub, dew, tcr2, pcr2, kfcr2, kscr2) - call get_values(dew_bub_cross, 2, bub, dew, tcr1, pcr1, kfcr1, kscr1) - crossings(1) = dew_bub_cross(2) - crossings(2) = dew_bub_cross(1) - stat = "2_BUB_DEW" - end if - end if - - if (crossed_self) then - call get_values(self_cross, 1, dew, dew, tcr2, pcr2, kfcr2, kscr2) - crossings(2) = self_cross(1) - stat = "SELF_CROSS" - end if - contains - subroutine get_values(& - cross, index, envelope1, envelope2, t, p, kf, ks & - ) - use dtypes, only: point - type(point), allocatable, intent(in) :: cross(:) - type(envelope), intent(in) :: envelope1, envelope2 - integer, intent(in) :: index - real(pr), intent(out) :: t - real(pr), intent(out) :: p - real(pr), intent(out) :: kf(size(kfcr1)) - real(pr), intent(out) :: ks(size(kscr1)) - - integer :: icross, jcross - - icross = cross(index)%i - jcross = cross(index)%j - - t = cross(index)%x - p = cross(index)%y - - kf = kfcross(jcross, envelope1%t, envelope1%logk, t) - ks = kfcross(icross, envelope2%t, envelope2%logk, t) - end subroutine - end subroutine find_crossings - ! =========================================================================== - subroutine get_stable(& - dew, bub, hpl, crossings, cross_type, & - dew_stable, bub_stable, hpl_stable & - ) - use dtypes, only: point - use, intrinsic :: ieee_arithmetic, only: IEEE_Value, IEEE_QUIET_NAN - - type(envelope), intent(in) :: dew, bub, hpl - type(point), intent(in) :: crossings(2) - character(len=50), intent(in) :: cross_type - type(envelope), intent(out) :: dew_stable, bub_stable, hpl_stable + ! ============================================================================= - integer :: idx_c1, idx_c2 - - real(pr) :: nan - nan = IEEE_VALUE(nan, IEEE_QUIET_NAN) - - dew_stable = dew - bub_stable = bub - hpl_stable = hpl - - print *, cross_type - - select case(cross_type) - case("0") - bub_stable%t = nan - bub_stable%p = nan - bub_stable%logk = nan - case("2_BUB_DEW") - idx_c2 = crossings(2)%i - idx_c1 = crossings(1)%i - - dew_stable%t(idx_c2:idx_c1) = nan - dew_stable%p(idx_c2:idx_c1) = nan - - dew_stable%t(idx_c2) = crossings(2)%x - dew_stable%p(idx_c2) = crossings(2)%y - dew_stable%t(idx_c1) = crossings(1)%x - dew_stable%p(idx_c1) = crossings(1)%y - - idx_c1 = crossings(1)%j - idx_c2 = crossings(2)%j - - bub_stable%t(:idx_c1) = nan - bub_stable%p(:idx_c1) = nan - bub_stable%t(idx_c1) = crossings(1)%x - bub_stable%p(idx_c1) = crossings(1)%y - - bub_stable%t(idx_c2:) = nan - bub_stable%p(idx_c2:) = nan - - bub_stable%t(idx_c2) = crossings(2)%x - bub_stable%p(idx_c2) = crossings(2)%y - case ("2_HPL_BUB_DEW") - idx_c1 = crossings(1)%j - - hpl_stable%t(idx_c1:) = nan - hpl_stable%t(idx_c1) = crossings(1)%x - hpl_stable%p(idx_c1:) = nan - hpl_stable%p(idx_c1) = crossings(1)%y - - idx_c1 = crossings(1)%i - idx_c2 = crossings(2)%j - - bub_stable%t(:idx_c1) = nan - bub_stable%t(idx_c1) = crossings(1)%x - bub_stable%p(:idx_c1) = nan - bub_stable%p(idx_c1) = crossings(1)%y - - bub_stable%t(idx_c2:) = nan - bub_stable%t(idx_c2) = crossings(2)%x - bub_stable%p(idx_c2:) = nan - bub_stable%p(idx_c2) = crossings(2)%y - - idx_c2 = crossings(2)%i - dew_stable%t(idx_c2:) = nan - dew_stable%t(idx_c2) = crossings(2)%x - dew_stable%p(idx_c2:) = nan - dew_stable%p(idx_c2) = crossings(2)%y - case ("1_HPL_DEW") - idx_c1 = crossings(1)%j - - hpl_stable%t(idx_c1:) = nan - hpl_stable%t(idx_c1) = crossings(1)%x - hpl_stable%p(idx_c1:) = nan - hpl_stable%p(idx_c1) = crossings(1)%y - - idx_c1 = crossings(1)%i - dew_stable%t(idx_c1:) = nan - dew_stable%t(idx_c1) = crossings(1)%x - dew_stable%p(idx_c1:) = nan - dew_stable%p(idx_c1) = crossings(1)%y - - bub_stable%t = nan - bub_stable%p = nan - end select - end subroutine + ! subroutine two_phase_envelope(X0, spec_number, specification, envels) + ! real(pr), intent(in) :: X0(:) + ! integer, intent(in) :: spec_number + ! real(pr), intent(in) :: specification + ! type(envelope), allocatable, intent(out) :: envels(:) + + ! real(pr) :: X(size(X)) + ! integer :: ns + ! real(pr) :: S + ! real(pr) :: XS(max_points, size(X0)) + + ! integer :: i + ! ns = spec_number + ! S = specification + + ! do i=1,max_points + ! call solve_point + ! call update_specification + ! call detect_critical + ! call check_end + ! end do + ! end subroutine end module envelopes From 803f9ebe7323baa6e2431c2ae5e8c2460776ff83 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Fri, 18 Aug 2023 16:19:02 -0300 Subject: [PATCH 14/48] feat: Px envelopes module New module to realize the calculation of Px envelopes via the continuation method. Right now works with 2phase lines, with a starting point of three phase lines calculation. --- src/new/mod_inj_envelopes.f90 | 311 +++++++++++++++++++++++++++------- 1 file changed, 252 insertions(+), 59 deletions(-) diff --git a/src/new/mod_inj_envelopes.f90 b/src/new/mod_inj_envelopes.f90 index 00ae514..7f56990 100644 --- a/src/new/mod_inj_envelopes.f90 +++ b/src/new/mod_inj_envelopes.f90 @@ -1,28 +1,65 @@ module inj_envelopes + !! Module to calculate Px phase envelopes use constants, only: pr, R - use dtypes, only: envelope - use linalg, only: solve_system + use dtypes, only: envelope, critical_point + use linalg, only: solve_system, interpol implicit none - integer :: max_iters = 500 - integer, parameter :: max_points = 1000 - real(pr), allocatable :: z_0(:) - real(pr), allocatable :: z_injection(:) - real(pr) :: T - real(pr) :: del_S = 0.1 - character(len=:), allocatable :: injection_case + type, extends(envelope) :: injelope + real(pr), allocatable :: alpha(:) !! Ammount of injected fluid + real(pr), allocatable :: z_inj(:) !! Injected fluid composition + real(pr), allocatable :: z_mix(:, :) !! Composition at each step + end type + + integer :: max_iters = 500 !! Maximum number of iterations for a newton step + integer, parameter :: max_points = 800 !! Maximum number of points for each envelope + real(pr), allocatable :: z_0(:) !! Original fluid composition + real(pr), allocatable :: z_injection(:) !! Injection fluid composition + real(pr) :: T !! Temperature of injection + real(pr) :: del_S = 0.1 !! Specificiation variation + character(len=:), allocatable :: injection_case !! Kind of injection displace|dilute + integer :: funit_output !! Output file unit contains - ! ============================================================================= - ! Injection envelopes - ! ----------------------------------------------------------------------------- + + subroutine from_nml(filepath) + use system, only: nc + character(len=*), intent(in) :: filepath + integer :: funit + + namelist /nml_px/ T ,z_0, z_injection, injection_case + + allocate(z_0(nc), z_injection(nc)) + + open(newunit=funit, file=filepath) + read(funit, nml=nml_px) + close(funit) + + print *, z_0 + print *, z_injection + end subroutine + subroutine F_injection(X, ns, S, F, dF) + !! Function to solve at each point of the phase envelope. + !! + !! The vector of variables X corresponds to: + !! \( X = [lnK_i, lnP, \alpha] \) + !! + !! While the equations are: + !! + !! \( F = [lnK_i - ln \phi_i(y, P, T) + ln \phi_i(z, P, T), + !! \sum_{i=1}^N, X_{ns} - S] \) + !! + !! The injection can be considered as two kinds of injection: + !! - Displacement: \( z = \alpha z_i + (1-\alpha) z_0 \) + !! - Addition: \( z = \frac{\alpha z_i + (1-\alpha) z_0}{\sum_{i=1}^N \alpha z_i + (1-\alpha) z_0} \) + !! use iso_fortran_env, only: error_unit - real(pr), intent(in) :: X(:) - integer, intent(in) :: ns - real(pr), intent(in) :: S - real(pr), intent(out) :: F(size(X)) - real(pr), intent(out) :: df(size(x), size(X)) + real(pr), intent(in) :: X(:) !! Vector of variables + integer, intent(in) :: ns !! Number of specification + real(pr), intent(in) :: S !! Specification value + real(pr), intent(out) :: F(size(X)) !! Vector of functions valuated + real(pr), intent(out) :: df(size(x), size(X)) !! Jacobian matrix ! X variables real(pr) :: K(size(X) - 2) @@ -39,6 +76,7 @@ subroutine F_injection(X, ns, S, F, dF) real(pr), dimension(size(X)-2) :: y, lnfug_y, dlnphi_dt_y, dlnphi_dp_y real(pr), dimension(size(X)-2, size(X)-2) :: dlnphi_dn_y + ! Derivative of z wrt alpha real(pr) :: dzda(size(X)-2) integer :: i, j, n @@ -52,7 +90,7 @@ subroutine F_injection(X, ns, S, F, dF) case("displace") z = (z_injection * alpha + (1.0_pr - alpha) * z_0) dzda = z_injection - z_0 - case("dilution") + case("dilute") z = (z_injection * alpha + z_0)/sum(z_injection * alpha + z_0) dzda = -(alpha*z_injection + z_0) & * sum(z_injection) / sum(alpha*z_injection + z_0)**2 & @@ -61,6 +99,7 @@ subroutine F_injection(X, ns, S, F, dF) z = (z_injection * alpha + (1.0_pr - alpha) * z_0) dzda = z_injection - z_0 end select + if (any(z < 0)) z = 0 y = K * z @@ -88,12 +127,130 @@ subroutine F_injection(X, ns, S, F, dF) df(n+2, :) = 0 df(n+2, ns) = 1 end subroutine - - subroutine injection_envelope(X0, spec_number, envels) - !! Subroutine to calculate Px phase envelopes + +! subroutine F_injection_three_phases(Xvars, ns, S, F, dF) +! !! Function to solve at each point of the phase envelope. +! !! +! !! The vector of variables X corresponds to: +! !! \( X = [lnK_i, lnP, \alpha] \) +! !! +! !! While the equations are: +! !! +! !! \( F = [lnK_i - ln \phi_i(y, P, T) + ln \phi_i(z, P, T), +! !! \sum_{i=1}^N, X_{ns} - S] \) +! !! +! !! The injection can be considered as two kinds of injection: +! !! - Displacement: \( z = \alpha z_i + (1-\alpha) z_0 \) +! !! - Addition: \( z = \frac{\alpha z_i + (1-\alpha) z_0}{\sum_{i=1}^N \alpha z_i + (1-\alpha) z_0} \) +! +! use iso_fortran_env, only: error_unit +! real(pr), intent(in) :: Xvars(:) !! Vector of variables +! integer, intent(in) :: ns !! Number of specification +! real(pr), intent(in) :: S !! Specification value +! real(pr), intent(out) :: F(size(Xvars)) !! Vector of functions valuated +! real(pr), intent(out) :: df(size(Xvars), size(Xvars)) !! Jacobian matrix +! +! ! Xvars variables +! real(pr) :: Kx(size(Xvars) - 2) +! real(pr) :: Ky(size(Xvars) - 2) +! real(pr) :: P +! real(pr) :: beta +! real(pr) :: alpha +! +! ! Main phase 1 variables +! real(pr) :: Vx +! real(pr), dimension(size(Xvars)-2) :: x, lnfug_x, dlnphi_dt_x, dlnphi_dp_x +! real(pr), dimension(size(Xvars)-2, sixe(Xvars)-2) :: dlnphi_dn_x +! +! ! Main phase 2 variables +! real(pr) :: Vy +! real(pr), dimension(size(Xvars)-2) :: y, lnfug_y, dlnphi_dt_y, dlnphi_dp_y +! real(pr), dimension(size(Xvars)-2, size(Xvars)-2) :: dlnphi_dn_y +! +! ! Incipient phase variables +! real(pr) :: Vw +! real(pr), dimension(size(Xvars)-2) :: w, lnfug_w, dlnphi_dt_w, dlnphi_dp_w +! real(pr), dimension(size(Xvars)-2, size(Xvars)-2) :: dlnphi_dn_w +! +! ! Derivative of z wrt alpha +! real(pr) :: dzda(size(Xvars)-2) +! +! integer :: i, j, n +! +! n = size(Xvars) - 2 +! Kx = exp(Xvars(1:n)) +! Ky = exp(Xvars(n+1:2*n)) +! P = exp(Xvars(2*n+1)) +! beta = Xvars(2*n+3) +! alpha = Xvars(2*n+3) +! +! select case(injection_case) +! case("displace") +! z = (z_injection * alpha + (1.0_pr - alpha) * z_0) +! dzda = z_injection - z_0 +! case("dilute") +! z = (z_injection * alpha + z_0)/sum(z_injection * alpha + z_0) +! dzda = -(alpha*z_injection + z_0) & +! * sum(z_injection) / sum(alpha*z_injection + z_0)**2 & +! + z_injection / sum(alpha*z_injection + z_0) +! case default +! z = (z_injection * alpha + (1.0_pr - alpha) * z_0) +! dzda = z_injection - z_0 +! end select +! if (any(z < 0)) z = 0 +! +! w = z / (beta * Ky + (1-beta) * Kx) +! x = w * Kx +! y = w * Ky +! +! +! call TERMO(n, 0, 4, T, P, y, Vy, lnfug_y, dlnphi_dp_y, dlnphi_dt_y, dlnphi_dn_y) +! call TERMO(n, 0, 4, T, P, x, Vx, lnfug_x, dlnphi_dp_x, dlnphi_dt_x, dlnphi_dn_x) +! call TERMO(n, 0, 4, T, P, w, Vw, lnfug_w, dlnphi_dp_w, dlnphi_dt_w, dlnphi_dn_w) +! +! F(1:n) = X(:n) + lnfug_x - lnfug_w +! F(n+1:2*n) = X(n+1:2*n) + lnfug_y - lnfug_w +! +! F(2*n+1) = sum(w - 1) +! F(2*n+2) = sum(x - y) +! F(2*n+3) = X(ns) - S +! +! df = 0 +! +! do i=1,n +! do j=1,n +! ! Derivatives wrt Kx +! df(i, j) = x(j) * dlnphi_dn_x(i, j) + w(j)**2 * dlnphi_dn_w(i, j) +! df(i+n, j) = w(j)**2 * dlnphi_dn_w(i, j) +! end do +! +! do j=n+1,2*n +! ! Derivatives wrt Ky +! df(i, j) = w(j-n)**2 * dlnphi_dn_w(i, j-n) +! df(i+n, j) = y(j-n)* dlnphi_dn_y(i, j-n) + w(j-n)**2 * dlnphi_dn_w(i, j-n) +! end do +! +! df(i, i) = df(i, i) + 1 +! ! df(i, n+2) = sum(K * dlnphi_dn_y(i, :) * dzda - dlnphi_dn_z(i, :) * dzda) +! end do +! +! df(:n, 2*n+1) = P * (dlnphi_dp_x - dlnphi_dp_w) +! df(n+1:2*n, 2*n+1) = P * (dlnphi_dp_y - dlnphi_dp_w) +! +! df(n+1, n+2) = sum(dzda*(K-1)) +! +! df(n+2, :) = 0 +! df(n+2, ns) = 1 +! end subroutine + + subroutine injection_envelope(X0, spec_number, del_S0, envels) + !! Subroutine to calculate Px phase envelopes via continuation method real(pr), intent(in) :: X0(:) !! Vector of variables integer, intent(in) :: spec_number !! Number of specification - type(envelope), allocatable, intent(out) :: envels(:) !! Calculated envelopes + real(pr), intent(in) :: del_S0 !! \(\Delta S_0\) + type(injelope), intent(out) :: envels !! Calculated envelopes + + type(critical_point), allocatable :: cps(:) real(pr) :: X(size(X0)) integer :: ns @@ -104,90 +261,117 @@ subroutine injection_envelope(X0, spec_number, envels) integer :: point, iters, n + allocate(cps(0)) X = X0 - n = size(X0) - 2 - ns = spec_number S = X(ns) + del_S = del_S0 - print *, "#", X(n+2) - print *, "X0", iters, ns, X - do point=1, max_points + write(funit_output, * ) "#", T + write(funit_output, *) "X0", iters, ns, X(n+2), exp(X(n+1)), X(:n) + enveloop: do point=1, max_points call full_newton(f_injection, iters, X, ns, S, F, dF) if (iters >= max_iters) then - print *, "Breaking due to not converged point" - exit + exit enveloop end if - print *, "SOL", iters, ns, X + write(funit_output, *) "SOL", iters, ns, X(n+2), exp(X(n+1)), X(:n) + XS(point, :) = X update_spec: block real(pr) :: dFdS(size(X0)) integer :: ns_new - dFdS = dF(n+2, :) + dFdS = 0 + dFdS(n+2) = 1 + dXdS = solve_system(dF, dFdS) ns_new = maxloc(abs(dXdS), dim=1) - ns_new = ns if (ns_new /= ns) then - dXdS = dXdS/dXdS(ns_new) del_S = dXdS(ns_new) * del_S ! translation of delS to the new specification variable + dXdS = dXdS/dXdS(ns_new) + ns = ns_new end if - ns = ns_new del_S = sign(1.0_pr, del_S) * minval( [ & max(sqrt(abs(X(ns)))/10, 0.1), & abs(del_S) * 3/iters & ] & ) - ! del_S = del_S*10 + + if (injection_case == "dilution") del_S = 50*del_S end block update_spec fix_step: block real(pr) :: Xnew(size(X0)) real(pr) :: dP, dalpha + Xnew = X + dXdS * del_S dP = exp(Xnew(n+1)) - exp(X(n+1)) - dalpha = exp(Xnew(n+2)) - exp(X(n+2)) + dalpha = Xnew(n+2) - X(n+2) - if (& - abs(dalpha) > 0.1 & - .or. abs(dP) > 50 & - ) then + do while (abs(dP) > 50 .or. abs(dalpha) > 0.03) + dXdS = dXdS/10.0_pr Xnew = X + dXdS * del_S dP = exp(Xnew(n+1)) - exp(X(n+1)) - dalpha = exp(Xnew(n+2)) - exp(X(n+2)) - - dXdS = dXdS/50.0_pr - end if + dalpha = Xnew(n+2) - X(n+2) + end do end block fix_step detect_critical: block - real(pr) :: K(size(X0) - 2), Knew(size(X0) - 2), fact - fact = 50 + real(pr) :: K(size(X0) - 2), Knew(size(X0) - 2), Xnew(size(X0)), fact + real(pr) :: pc, alpha_c, dS_c + integer :: max_changing + fact = 2.5 + + Xnew = X + fact * dXdS * del_S + K = X(:n) - Knew = X(:n) + fact * dXdS(:n) * del_S - ! print *, "EXTRAPOL", ns, point, Knew + Knew = Xnew(:n) + if (all(K * Knew < 0)) then - dXdS = fact * dXdS + max_changing = maxloc(abs(K - Knew), dim=1) + + dS_c = - k(max_changing) * (Xnew(ns) - X(ns))/(Knew(max_changing) - K(max_changing)) + del_S = dS_c * 1.1 + + Xnew = X + dXdS * dS_c + alpha_c = Xnew(n+2) + pc = Xnew(n+1) + + cps = [cps, critical_point(t, pc, alpha_c)] end if end block detect_critical X = X + dXdS * del_S S = X(ns) - ! if (any(break_conditions(X, ns, S))) exit - end do + if (any(break_conditions(X, ns, S))) exit enveloop + end do enveloop + + point = point - 1 + + envels%z = z_0 + envels%z_inj = z_injection + envels%logk = XS(:point, :n) + envels%alpha = XS(:point, n+2) + envels%p = exp(XS(:point, n+1)) + envels%critical_points = cps + + write(funit_output, *) "" + write(funit_output, *) "" end subroutine subroutine full_newton(fun, iters, X, ns, S, F, dF) + !! Subroutine to solve a point in the envelope. interface subroutine fun(X, ns, S, F, dF) + !! Function to solve import pr real(pr), intent(in) :: X(:) integer, intent(in) :: ns @@ -196,12 +380,12 @@ subroutine fun(X, ns, S, F, dF) real(pr), intent(out) :: dF(size(X), size(X)) end subroutine end interface - integer, intent(out) :: iters - real(pr), intent(in out) :: X(:) - integer, intent(in) :: ns - real(pr), intent(in) :: S - real(pr), intent(out) :: F(size(X)) - real(pr), intent(out) :: df(size(X), size(X)) + integer, intent(out) :: iters !! Number of iterations needed + real(pr), intent(in out) :: X(:) !! Variables vector + integer, intent(in) :: ns !! Number of specification + real(pr), intent(in) :: S !! Specification value + real(pr), intent(out) :: F(size(X)) !! Function values at solved point + real(pr), intent(out) :: df(size(X), size(X)) !! Jacobian values real(pr) :: b(size(X)), A(size(X), size(X)) @@ -228,12 +412,21 @@ subroutine fun(X, ns, S, F, dF) end subroutine function break_conditions(X, ns, S) + !! Set of conditions to break the tracing. real(pr) :: X(:) integer :: ns real(pr) :: S - logical :: break_conditions(1) + integer :: n + real(pr) :: p, alpha + logical, allocatable :: break_conditions(:) + + n = size(X) - 2 + p = exp(X(n+1)) + alpha = X(n+2) - break_conditions(1) = (X(size(X)) > 1) + break_conditions = [& + p < 10 .or. p > 1000 & + ] end function end module From 40a854f4fd91c506ef72958ab1e7365b34125c0a Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Fri, 18 Aug 2023 16:19:17 -0300 Subject: [PATCH 15/48] format --- src/new/io_nml.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/new/io_nml.f90 b/src/new/io_nml.f90 index c314d97..f305219 100644 --- a/src/new/io_nml.f90 +++ b/src/new/io_nml.f90 @@ -60,9 +60,7 @@ module io_nml private public :: setup_input, read_system, write_system - contains - subroutine setup_input(filepath) !> Setup input file to be used character(len=*), intent(in) :: filepath !! Path to input file @@ -227,6 +225,7 @@ subroutine read_system(filepath) call setup_input(filepath) call read_model() call read_components() + close(nunit_input) end subroutine subroutine write_system(file_unit) From 5569f3b91e3ed5dbfdf887b397dfaaeb11a2f2b1 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Fri, 18 Aug 2023 16:20:41 -0300 Subject: [PATCH 16/48] feat(input): New namelist Added a new namelist to input files. --- input.nml | 47 ++++++++++++++++++++++++++++++++--------------- 1 file changed, 32 insertions(+), 15 deletions(-) diff --git a/input.nml b/input.nml index 0569aba..5d5dcf5 100644 --- a/input.nml +++ b/input.nml @@ -7,30 +7,47 @@ ! - Volume: L ! ========================= - &nml_setup - nc=5, ! Number of components - model="PR78", ! SRK PR76 PR78 - mixrule="ClassicVdW" ! only ClassicVdW + nc=8, ! Number of components + model="PR78", ! SRK PR76 PR78 RKPR + mixrule="ClassicVdW" ! ClassicVdW / &nml_composition - names="PC1" "PC2" "PC3" "PC4" "H2O" + names="CO2" "C1-N2" "C2-C3" "C4" "C5" "C6" "C7+n" "Asph" spec="critical", ! critical or parameters - z=0.15 0.10 0.10 0.15 0.50 + z=0.0246 0.3694 0.0752 0.0193 0.0157 0.0162 0.47145 0.00815 / &nml_classicvdw - kij(1, :)=0 0 0 0 0.7192 - kij(2, :)=0 0 0 0 0.4598 - kij(3, :)=0 0 0 0 0.2673 - kij(4, :)=0 0 0 0 0.2417 - kij(5, :)=0.7192 0.4598 0.2673 0.2417 0 - lij(:, :) = 0 + kij(1, :)=0 0 0 0 0 0 0 0 + kij(2, :)=0 0 0 0 0 0 0.053 0.135 + kij(3, :)=0 0 0 0 0 0 0 0.135 + kij(4, :)=0 0 0 0 0 0 0 0.135 + kij(5, :)=0 0 0 0 0 0 0 0.135 + kij(6, :)=0 0 0 0 0 0 0 0 + kij(7, :)=0 0.053 0 0 0 0 0 0 + kij(8, :)=0 0.135 0.135 0.135 0.135 0 0 0 + + lij(1, :)=0 0 0 0 0 0 0 0 + lij(2, :)=0 0 0 0 0 0 0 0 + lij(3, :)=0 0 0 0 0 0 0 0 + lij(4, :)=0 0 0 0 0 0 0 0 + lij(5, :)=0 0 0 0 0 0 0 0 + lij(6, :)=0 0 0 0 0 0 0 0 + lij(7, :)=0 0 0 0 0 0 0 0 + lij(8, :)=0 0 0 0 0 0 0 0 / &nml_critical - tc=305.586 638.889 788.889 838.889 647.3 - pc=48.82 19.65 10.2 7.72 220.89 - w=0.098 0.535 0.891 1.085 0.344 + tc=304.0390 189.4280 339.8720 419.8170 465.0940 507.3170 860.3720 1424.8170 + pc=73.7900 45.8300 45.4100 37.5400 33.8000 32.9000 12.4600 12.2900 + w=0.225000 0.008500 0.127100 0.187800 0.239700 0.275000 1.022000 1.441000 / + +&nml_px + T=500.0 + z_0=0.0246 0.3694 0.0752 0.0193 0.0157 0.0162 0.47145 0.00815 + z_injection=1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + injection_case="displace" ![dilute|displace] +/ \ No newline at end of file From 18f15251c7d67f7c6641868f3840ec7edd3f21f7 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Fri, 18 Aug 2023 16:21:01 -0300 Subject: [PATCH 17/48] test data --- test/self_cross_line | 374 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 374 insertions(+) create mode 100644 test/self_cross_line diff --git a/test/self_cross_line b/test/self_cross_line new file mode 100644 index 0000000..6535342 --- /dev/null +++ b/test/self_cross_line @@ -0,0 +1,374 @@ +310.00000000000006 3.4450445821278923E-022 +310.93314403203209 4.5926299583620674E-022 +311.99050478667272 6.3463954986381519E-022 +312.33208913959567 7.0416545935731927E-022 +312.84604451957165 8.2298926582474535E-022 +313.62055226442584 1.0398459255672441E-021 +314.49704330044580 1.3528024453015731E-021 +315.48970476304402 1.8187579544288386E-021 +316.61490880173039 2.5373053291382546E-021 +316.97850185386653 2.8238932593811003E-021 +317.52565646759609 3.3155795893241166E-021 +318.14375182616681 3.9717458914921143E-021 +318.84235455947680 4.8663380998537155E-021 +319.63242274043665 6.1156934379373722E-021 +320.52653619368505 7.9083919911172993E-021 +321.53917257404936 1.0560338439344614E-020 +322.68704033726641 1.4620283222861853E-020 +323.05796178791644 1.6231707042039508E-020 +323.61614859744958 1.8987800067729448E-020 +324.45751831460575 2.4023452297737963E-020 +325.40997476431414 3.1301070915976407E-020 +326.48905478818568 4.2154058735308633E-020 +327.71271138427340 4.6798584562393671E-310 +328.10823062404910 6.5616089169586479E-020 +328.70353340336766 7.7111894928007201E-020 +329.37616987621601 9.2468286409506563E-020 +330.13661003380781 1.1342759962855128E-019 +330.99685804092292 1.4273476543190313E-019 +331.97070926286443 1.8484595791812550E-019 +333.07405920327454 2.4723842271889100E-019 +334.32527719419500 3.4292444177856212E-019 +334.72971409345075 3.8094750635125160E-019 +335.33844736244373 4.4602861521709283E-019 +336.25625523937993 5.6507168276374464E-019 +337.29560440045236 7.3735890856770454E-019 +338.47359492607546 9.9469736824328417E-019 +339.81001394246863 1.3929687303664341E-018 +340.24211833115970 1.5521991243570211E-018 +340.89261174685629 1.8258024922609320E-018 +341.62779089607631 2.1916414068406525E-018 +342.45917141838345 2.6915014556850083E-018 +343.39997028962989 3.3913018549590760E-018 +344.46539410382212 4.3982158716186178E-018 +345.67298785829030 5.8923684716686980E-018 +347.04305709293158 8.1877859688694405E-018 +347.48605589779152 9.1009776317424172E-018 +348.15296399128408 1.0665165296959127E-017 +349.15878853410356 1.3529462877214640E-017 +350.29825297296651 1.7680659097291160E-017 +351.59028351909490 2.3890862436978282E-017 +353.05681583838697 3.3519059141749253E-017 +353.53115678534721 3.7372976091935180E-017 +354.24538864114527 4.4000066541540243E-017 +355.05282847347371 5.2869645830278986E-017 +355.96621243231050 6.5001415654344110E-017 +357.00017525577147 8.2006144574269696E-017 +358.17157725246170 1.0650646815137283E-016 +359.49989975157149 1.4291726500559336E-016 +361.00772663280287 1.9894889455902107E-016 +361.49544764080684 2.2126535681194143E-016 +362.22984698243243 2.5951832829581603E-016 +363.06011710426247 3.1050944107626284E-016 +363.99936656520930 3.7993909343786168E-016 +365.06266040684528 4.7676071000207604E-016 +366.26735776633541 6.1546100133648269E-016 +367.63352036628805 8.2025845124850000E-016 +369.18441016723460 1.1331274209947643E-015 +369.68608468276625 1.2571311114747658E-015 +370.44151862781450 1.4690277076871576E-015 +371.58129671554968 1.8556521579983421E-015 +372.87315288363681 2.4134347736042339E-015 +374.33880457163190 3.2436050158508243E-015 +376.00347346926492 4.5232593875263067E-015 +376.54214376811547 5.0334906783029278E-015 +377.35346340249794 5.9087033060676492E-015 +378.27098699105636 7.0764028505264620E-015 +379.30931657524923 8.6679431086415330E-015 +380.48525593701373 1.0889894432114499E-014 +381.81819669725672 1.4076946307968297E-014 +383.33058715862654 1.8789463670194535E-014 +385.04850571744942 2.6000249509814306E-014 +385.60444462320532 2.8861242313100673E-014 +386.44180814470690 3.3753390130144496E-014 +387.70569363357362 4.2688625094649185E-014 +389.13893712569671 5.5595997915485178E-014 +390.76592696194666 7.4834173988715579E-014 +392.61504452759675 1.0453638592352302E-013 +393.17370138411536 1.1556154821205966E-013 +394.01511492884924 1.3431617875604926E-013 +395.28501351779636 1.6830309776373882E-013 +396.72493042645715 2.1691459871822660E-013 +398.35930835799746 2.8856517141825750E-013 +400.21658053036612 3.9780728670788126E-013 +400.77765035314599 4.3802314191906114E-013 +401.62265372194514 5.0609233762421871E-013 +402.89786906050375 6.2852167101274669E-013 +404.34366722202043 8.0197282427327678E-013 +405.98453082785608 1.0549043123294632E-012 +407.84892800959653 1.4359117368434352E-012 +409.97009617787558 2.0312131679365476E-012 +410.61141356126893 2.2539191735106105E-012 +411.57773643356882 2.6345581362700359E-012 +413.03709183634709 3.3292856335300130E-012 +414.69319991981547 4.3319547953255614E-012 +416.57473517271939 5.8248946743202277E-012 +418.71516469967730 8.1272130433851520E-012 +419.36225590385567 8.9811562366673263E-012 +420.33723553756755 1.0433100262126094E-011 +421.80956457749386 1.3062437827755005E-011 +423.48025062327793 1.6819795643074349E-011 +425.37816129537566 2.2352266047397467E-011 +427.53697765811137 3.0777549318436764E-011 +428.18957685813655 3.3876797350053584E-011 +429.17281052040403 3.9120109380208820E-011 +430.65750337771061 4.8544032313989090E-011 +432.34207123160257 6.1883228491001797E-011 +434.25556113361330 8.1314806839817758E-011 +436.43185187863878 1.1055160833842016E-010 +438.91063393592202 1.5617145039738138E-010 +439.66065463627797 1.7322303464432857E-010 +440.79128097755466 2.0235108292808209E-010 +442.49993901988324 2.5547093017909862E-010 +444.44067092245808 3.3205633515570072E-010 +446.64778764548544 4.4595382982258552E-010 +449.16147631417954 6.2136153092609053E-010 +449.92201614161576 6.8636273367230747E-010 +451.06846209932610 7.9682244546938806E-010 +452.80094188369202 9.9668841853927244E-010 +454.76860609088419 1.2819961844084246E-009 +457.00619041898403 1.7015860157331346E-009 +459.55436958367557 2.3396903862112279E-009 +460.32530097273957 2.5742024264599659E-009 +461.48737279458493 2.9707286638785398E-009 +463.24337820645201 3.6828108320123487E-009 +465.23763357188483 4.6896456173429893E-009 +467.50529133429819 6.1545247642366223E-009 +470.08750415089560 8.3554928464302278E-009 +473.03268653049571 1.1784283606455277E-008 +473.92468439578522 1.3064516945878004E-008 +475.27008955899578 1.5250025600266351E-008 +477.30505728326813 1.9231718814797073E-008 +479.61894813196966 2.4965049188534269E-008 +482.25372906629826 3.3479324907559211E-008 +485.25876809469713 4.6570091679768867E-008 +486.16887351581778 5.1415834110422737E-008 +487.54157200515488 5.9644910329638906E-008 +489.61777989300691 7.4519428770189150E-008 +491.97850263703344 9.5725033476393160E-008 +494.66653183196973 1.2686477327148757E-007 +497.73220104709281 1.7414089412857538E-007 +498.66064784485991 1.9149576796263895E-007 +500.06099193500967 2.2082002413885776E-007 +502.17897191044227 2.7342509306124897E-007 +504.58713007693785 3.4770473451595735E-007 +507.32909308877061 4.5561045134107167E-007 +510.45617235923464 6.1745238864248497E-007 +514.02905096822064 8.6906971358406363E-007 +515.04460419354245 9.5674200465746125E-007 +516.57686176147456 1.1050843555589218E-006 +518.89558028295460 1.3717472418917420E-006 +521.53377556379053 1.7492632776370088E-006 +524.53999972007000 2.2992807919430518E-006 +527.97151086414294 3.1269192131420841E-006 +531.89622875220971 4.4183621001347368E-006 +533.01257256219992 4.8694029810111605E-006 +534.69756139397055 5.6335973148928260E-006 +537.24891623966505 7.0101063292163996E-006 +540.15402549405690 8.9638028159079636E-006 +543.46729935291432 1.1818330430713389E-005 +547.25309649324993 1.6127357542445564E-005 +551.58801886434867 2.2875034820504783E-005 +552.82202015952691 2.5237050523226877E-005 +554.68542382762882 2.9244216354273794E-005 +557.50882351771475 3.6476268101341950E-005 +560.72648907465543 4.6766052596190416E-005 +564.39988095296565 6.1841612953071552E-005 +568.60194199985813 8.4668351970931048E-005 +569.79731010028149 9.2486763957807085E-005 +571.60169240160587 1.0558553203327487E-004 +574.33409504219605 1.2878408769396887E-004 +577.44574765505092 1.6101231658689075E-004 +580.99509775258355 2.0697820368713194E-004 +585.05131379165459 2.7450505949647554E-004 +589.69676780535997 3.7705856225174554E-004 +591.01934074636677 4.1225199440427537E-004 +593.01663849994088 4.7127883755008056E-004 +596.04324834137560 5.7598953752791525E-004 +599.49299394060108 7.2175583396781064E-004 +603.43197627848213 9.3013044056021162E-004 +607.93868262095611 1.2370182981680639E-003 +609.22087417716239 1.3402511831086114E-003 +609.94497941432564 1.4020495970017441E-003 +611.03504042806242 1.5001144377552410E-003 +612.67897950190752 1.6601797417791265E-003 +615.16501718082668 1.9327536993482910E-003 +618.94012721501383 2.4274584234977603E-003 +623.25466651889496 3.1362320739579904E-003 +624.48126868351756 3.3704199558112751E-003 +627.26257875083093 3.9630302316159705E-003 +630.42758768539045 4.7546394570428339E-003 +634.03472408914035 5.8349078163780072E-003 +638.15290807532904 7.3449070375211237E-003 +639.32282849818171 7.8357840169943627E-003 +641.97419507810923 9.0630295623004026E-003 +646.00144835858396 1.1271771296351428E-002 +650.60568816853038 1.4402906897518605E-002 +651.91493315225841 1.5430202563587363E-002 +654.88407253960395 1.8016156939262746E-002 +658.26351907962862 2.1444124930188220E-002 +662.11586923084587 2.6081786977265747E-002 +666.51493526870945 3.2501166187931980E-002 +667.76480529924038 3.4574563977120824E-002 +670.59757174737263 3.9733368687660219E-002 +674.90079829768558 4.8940646666674616E-002 +676.12292180342263 5.1892932681100602E-002 +678.89193748612377 5.9198955819007762E-002 +683.09597218800263 7.2117453457990699E-002 +684.28939636966186 7.6231165822077354E-002 +686.99250055840707 8.6359400449076112E-002 +691.09405607043072 0.10411038931447904 +692.25784590007686 0.10972589473288649 +694.89291734290839 0.12348470002302057 +698.88876519850362 0.14739723869911114 +703.44662338072055 0.17982730041733350 +704.74051813346080 0.19016145300306561 +707.67110803702701 0.21561733262732691 +712.11725901197326 0.26026758367749980 +713.37861122576942 0.27440049955183926 +716.23408093673163 0.30904140688161824 +720.56236576510378 0.36928320204579607 +721.78938937658313 0.38822977042144347 +724.56563138262197 0.43445112274885178 +728.76965293407591 0.51417988524035196 +729.96049684892250 0.53910345257208470 +732.65326190610381 0.59963504292953618 +736.72642672218024 0.70324470444475851 +741.35582167065490 0.84105460267505572 +742.66647761080799 0.88440611920823664 +745.62873902999104 0.99017729987375380 +750.10487395554276 1.1726505121937469 +751.37044196765305 1.2296954407279213 +754.22788523107590 1.3682400263848977 +758.53754436204486 1.6053667372498093 +759.75417930545916 1.6790601248768233 +762.49794748100703 1.8572628935732833 +766.62731484679693 2.1599856061254235 +767.79101765646442 2.2535380228406541 +770.41193440532368 2.4788346447973764 +774.34679481372279 2.8588485869273366 +778.77109769133062 3.3549307585330124 +780.01358216375502 3.5090541469095951 +782.80399029683815 3.8816524419368750 +786.96985750718864 4.5142799565529774 +788.13576527090663 4.7097008592372269 +790.74727281811840 5.1801577124738296 +794.62669401255937 5.9731713587932775 +798.92021287897705 7.0074426918975785 +800.11116263040151 7.3285587460730310 +802.75924938091327 8.1044668396514332 +805.67846357277745 9.0732778823266198 +808.87264228127390 10.298335453468676 +812.32942969767703 11.869429588941367 +816.00785888208657 13.916272090857492 +819.81693924979481 16.630126864089394 +822.87666631342233 19.507601678681592 +825.26564252444098 22.506841922733535 +827.06261600057132 25.585698783260199 +828.60935715906794 29.538879691231543 +829.38322275455789 32.886645141608817 +829.79157680266064 37.093274250560881 +829.56791901407041 42.449696037173581 +828.32054212008416 49.227937340356164 +827.07653968141904 53.487636094440745 +825.13631936277670 58.702921789882055 +822.17261963746228 65.150180543676356 +817.68728240573944 73.202209143710192 +816.20028814647708 75.592437039979345 +812.42091870969830 81.235862436087331 +807.37749759144765 88.039421752153288 +805.79321883462160 90.042012109314058 +801.93907585852060 94.693163063733536 +797.08759306603667 100.16760622452026 +795.61765836827760 101.75338251415955 +792.13015111226002 105.39468554914504 +787.89205646982725 109.61055044038511 +786.63691727575952 110.81854431671569 +783.70672946994273 113.57133171023496 +780.22763392468971 116.72405434978552 +776.07024160656692 120.33787123445254 +774.85255225521223 121.36635090919184 +772.03208507620343 123.69868124784223 +768.72125032535303 126.35084966585535 +764.81469103964855 129.36668249922567 +760.17853179971496 132.79398665786633 +758.82680112092692 133.76339358785546 +755.70605495316590 135.95157166865258 +752.06011188186415 138.42205286106099 +747.78098782148436 141.20718335397629 +746.54261806111140 141.99070861705070 +743.69886344849886 143.75255419380852 +740.40254504664904 145.73064021406935 +736.56788519214126 147.94693633502214 +732.08931231209783 150.42243776556896 +730.80378108982768 151.11090635395095 +727.90491376370323 152.62773014120353 +724.63485352740554 154.28012039193166 +720.94851359968072 156.06931177839641 +716.79903552667486 157.99134010414420 +712.14429193932222 160.03314599069040 +710.84183605240150 160.58306049084291 +707.93225241393657 161.77799145572419 +704.72068735291191 163.04349138086721 +701.28007681873214 164.33748342722643 +698.00726659841882 165.50950239936040 +696.39042316077393 166.06746247637457 +696.47509429726347 166.03858154606004 +696.82028890317815 165.92042498648783 +697.39308881846898 165.72290942881642 +698.15811859901453 165.45627449102585 +699.08844266673611 165.12763229446426 +700.16591430694518 164.74091825611254 +701.37843596275297 164.29781861032271 +702.71721375334857 163.79869846349212 +704.17464159703150 163.24334413797644 +705.74273120636940 162.63156156304359 +707.41190045268240 161.96370387956739 +709.16998500274769 161.24118315285270 +711.00139328364526 160.46700191227373 +712.88638994630469 159.64631545980654 +714.80044560938734 158.78705096107802 +716.71375945657712 157.90054069974522 +718.59088659505881 157.00218465364296 +720.39054901154589 156.11209238358245 +722.06563634024917 155.25566962132086 +723.56340928819952 154.46409960834657 +724.82589953633885 153.77466334537979 +725.79047274151151 153.23084107629040 +726.39049812240694 152.88213527326644 +726.55603294860305 152.78356063684754 +726.21441439999114 152.99474658040103 +725.29063677068370 153.57860075365747 +724.65050713117239 153.98908071607804 +723.80835061140181 154.53388469115396 +722.72380691457170 155.24124851496558 +721.35120731535108 156.14294420092361 +719.63929547631619 157.27405469372951 +717.53099473429552 158.67245930649725 +714.96318913496123 160.37796373412948 +713.61179353432169 161.27481116823694 +712.04374388502504 162.31373169437006 +710.22475264312084 163.51559770688382 +708.11579540496950 164.90325538292149 +705.67271511283366 166.50124032191090 +702.93101390860295 168.28027873893350 +700.21357565882988 170.02672985733395 +697.53466436219321 171.73039686442803 +694.90596253573597 173.38347236146421 +692.33709471624911 174.98007196101000 +689.83603379272495 176.51585575426103 +687.40939117761025 177.98773420825262 +685.06267371150852 179.39361446496270 +682.80046677406710 180.73220380246849 +680.62658906625370 182.00284494880782 +678.54420741697959 183.20538638438165 +676.55306097930111 184.34171045349655 +674.55559721498798 185.46821739186547 +672.55280634994460 186.58412379779315 +670.54561763583820 187.68871895435461 +668.53493594282281 188.78134396828591 +666.52169323755425 189.86136337271333 +664.50706710948384 190.92805265557621 +662.49396069306056 191.97984973912813 +661.59209983481765 192.44649469567815 +660.28098173542628 193.12002079734881 From f91b97e112da22cbd5c6fc79dfbd72c2166e0235 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Wed, 23 Aug 2023 09:31:56 -0300 Subject: [PATCH 18/48] refactor: EoS framework Now the EoS come from an external library, yaeos. The calls are still direct to the legacy code, so an enventual fix should occur. But first an IO must be defined on the yaeos side, to include any kind of model from an input file. --- app/main.f90 | 68 ++-- fpm.toml | 7 +- src/MulticompSRK_PR.f90 | 183 --------- src/ThermoRoutines_RKPR.f90 | 730 ---------------------------------- src/linalg.f90 | 13 + src/new/constants.f90 | 1 + src/new/envelopes.f90 | 96 ++--- src/new/io_nml.f90 | 7 +- src/new/mod_inj_envelopes.f90 | 46 ++- src/new/thermo.f90 | 301 -------------- 10 files changed, 133 insertions(+), 1319 deletions(-) delete mode 100644 src/MulticompSRK_PR.f90 delete mode 100644 src/ThermoRoutines_RKPR.f90 delete mode 100644 src/new/thermo.f90 diff --git a/app/main.f90 b/app/main.f90 index 2bd3278..943deac 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -1,34 +1,28 @@ program main - use envelopes, only: envelope2, max_points, k_wilson_bubble, & - max_points, p_wilson, k_wilson use dtypes, only: envelope use constants, only: pr - use system, only: z, nc + ! use system, only: z, nc + use legacy_ar_models, only: z, nc implicit none - - real(pr), allocatable :: tv(:) ! Temperatures [K] - real(pr), allocatable :: pv(:) ! Pressures [bar] - real(pr), allocatable :: dv(:) ! Densities [mol/L] - - real(pr) :: tcri(4) ! Critical points temperatures - real(pr) :: pcri(4) ! Critical points pressures - real(pr) :: dcri(4) ! Critical points densities - - real(pr) :: t, p ! Temperature and pressure - real(pr), allocatable :: k(:) ! K factors - - integer :: n_points, icri(4), ncri, i - + real(pr) :: et, st + type(envelope) :: bub_env, dew_env - call setup ! + call setup + + call cpu_time(st) call pt_envelopes + call cpu_time(et) + print *, "PT: ", (et-st) * 1000 , "ms" + + call cpu_time(st) call px_envelopes + call cpu_time(et) + print *, "PX: ", (et-st) * 1000 , "ms" contains subroutine setup use io_nml, only: read_system, write_system - use system, only: kij use inj_envelopes, only: setup_inj => from_nml integer :: funit_system character(len=254) :: infile @@ -40,16 +34,30 @@ subroutine setup open (newunit=funit_system, file="systemdata.nml") call write_system(funit_system) close (funit_system) - - allocate (tv(max_points), pv(max_points), dv(max_points)) - allocate (k(size(z))) end subroutine subroutine pt_envelopes + use legacy_ar_models, only: z + use envelopes, only: envelope2, max_points, k_wilson_bubble, & + max_points, p_wilson, k_wilson !! Calculation of PT envelopes of the main system. - + real(pr), allocatable :: tv(:) ! Temperatures [K] + real(pr), allocatable :: pv(:) ! Pressures [bar] + real(pr), allocatable :: dv(:) ! Densities [mol/L] + + real(pr) :: tcri(4) ! Critical points temperatures + real(pr) :: pcri(4) ! Critical points pressures + real(pr) :: dcri(4) ! Critical points densities + + real(pr) :: t, p ! Temperature and pressure + real(pr), allocatable :: k(:) ! K factors + integer :: n_points, icri(4), ncri, i + integer :: n + allocate (tv(max_points), pv(max_points), dv(max_points)) + allocate (k(size(z))) + ! ===================================================================== ! Bubble envel ! --------------------------------------------------------------------- @@ -97,7 +105,7 @@ subroutine px_envelopes !! Calculation of Px envelopes at selected temperature. use inj_envelopes, only: F_injection, full_newton, z_injection, & T_inj => T, injection_envelope, z_0, injection_case, & - injelope, funit_output + injelope use envelopes, only: envelope, k_wilson, p_wilson use linalg, only: interpol @@ -106,6 +114,8 @@ subroutine px_envelopes integer :: ns, i, iters, idx, ti integer, allocatable :: i_inj(:) real(pr), allocatable :: ts_envel(:), ts(:) + real(pr) :: t, p + real(pr), allocatable :: k(:) real(pr) :: t_tol = 2 type(injelope) :: bub_envels, dew_envels @@ -117,7 +127,6 @@ subroutine px_envelopes alpha = 0.0 z_injection = z_injection/sum(z_injection) ns = nc + 2 - open (newunit=funit_output, file="px.dat") ! ====================================================================== ! ====================================================================== @@ -182,8 +191,8 @@ subroutine px_envelopes t_inj)) X(1:nc) = log(K) - X(nc + 1) = log(P) - X(nc + 2) = alpha + X(nc+1) = log(P) + X(nc+2) = alpha call injection_envelope(X, ns, 0.01_pr, dew_envels) end do @@ -199,14 +208,11 @@ subroutine px_envelopes inter = intersection( & dew_envels%alpha, dew_envels%p, & bub_envels%alpha, bub_envels%p & - ) - + ) do i = 1, size(inter) print *, inter(i) end do end block check_crossings ! ====================================================================== - close (funit_output) - print *, "END" end subroutine end program main diff --git a/fpm.toml b/fpm.toml index 80414b4..a56dc48 100644 --- a/fpm.toml +++ b/fpm.toml @@ -15,8 +15,9 @@ auto-examples = true library = false [dependencies] -ftools = {git = "https://github.com/fedebenelli/ftools"} +ftools = { git = "https://github.com/fedebenelli/ftools" } +yaeos = { git = "https://github.com/fedebenelli/yaeos" } [fortran] -implicit-external = true # default: false -implicit-typing = true # default: false +implicit-external = false # default: false +implicit-typing = false # default: false \ No newline at end of file diff --git a/src/MulticompSRK_PR.f90 b/src/MulticompSRK_PR.f90 deleted file mode 100644 index 4122c8b..0000000 --- a/src/MulticompSRK_PR.f90 +++ /dev/null @@ -1,183 +0,0 @@ -subroutine read2PcubicNC(nc, nin, nout) - !! Subroutine to read a GPECIN-like file and set up the system - - ! Critical constants must be given in K and bar - ! b will be in L/mol and ac in bar*(L/mol)**2 - ! -> EoS parameters will be calculated from the critical constants - ! to assure thermodynamic consistency - - use constants - use system, only: setup, SRK_factory, PR76_factory, PR78_factory, & - z, bij, kij_mod => kij - use system, only: z, nmodel => thermo_model, & - tc, pc, dceos => dc, om => w, & - ac, b, del1, k, kij, & - ntdep => tdep, ncomb => mixing_rule, bij, kinf, tstar, lij - - implicit none - common /NAMES/ fluid - - integer, parameter :: nco=64 - - integer, intent(in) :: nc !! number of components - integer, intent(in) :: nin, nout !! IO units - - character*18 fluid(nco) - - real(pr) :: vc(nc) - - integer :: i, j - - read (NIN, *) ncomb, NTDEP - - call setup(nc, nmodel, ntdep, ncomb) - - Tstar = 0.d0 - if (nmodel .eq. 1) then - del1 = 1.0D0 - write (nout, *) ' Model: Soave-Redlich-Kwong (1972)' - else - del1 = 1.0D0 + sqrt(2.0) - write (nout, *) ' Model: Peng-Robinson (1976)' - end if - - write (nout, *) ' Fluid Tc(K) Pc(bar) Vceos(L/mol) W' - do i = 1, nc - read (NIN, '(A)') fluid(i) - read (NIN, *) Tc(i), Pc(i), OM(i), Vc(i) - dceos(i) = 1/Vc(i) - write (nout, 1) fluid(i), Tc(i), Pc(i), Vc(i), OM(i) - read (NIN, *) ac(i), b(i), k(i) - - Kij(i, i) = 0.0D0 - Lij(i, i) = 0.0D0 - if (i .gt. 1) then - if (ncomb .lt. 2) then - read (NIN, *) (Kij(j, i), j=1, i - 1) - Kij(i, :i - 1) = Kij(:i - 1, i) - if (NTDEP >= 1) read (NIN, *) (Tstar(j, i), j=1, i - 1) - Tstar(i, :i - 1) = Tstar(:i - 1, i) - if (NTDEP == 2) read (NIN, *) (Kinf(j, i), j=1, i - 1) - Kinf(i, :i - 1) = Kinf(:i - 1, i) - read (NIN, *) (lij(j, i), j=1, i - 1) - lij(i, :i - 1) = lij(:i - 1, i) - end if - end if - end do - - write (nout, *) 'Fluid ac(bar*L2/mol2) b(L/mol) d1 k' - do I = 1, NC - write (nout, 1) fluid(i), ac(i), b(i), del1(i), k(i) - end do - - write (NOUT, *) - if (ncomb .lt. 2) then - if (NTDEP .eq. 0) then - write (NOUT, *) ' Kij MATRIX' - else - write (NOUT, *) ' K0ij MATRIX' - end if - do I = 1, NC - write (NOUT, 6) FLUID(I), (Kij(j, i), j=1, i - 1) - end do - if (NTDEP .eq. 1) then - write (NOUT, *) - write (NOUT, *) ' T* MATRIX' - do I = 1, NC - write (NOUT, 6) FLUID(I), (Tstar(j, i), j=1, i - 1) - end do - end if - write (NOUT, *) - write (NOUT, *) ' LIJ MATRIX' - do I = 1, NC - write (NOUT, 6) FLUID(I), (Lij(j, i), j=1, i - 1) - end do - end if - - - select case(nmodel) - case (1) - call SRK_factory(z, tc_in=tc, pc_in=pc, w_in=om) - case (2) - call PR76_factory(z, tc_in=tc, pc_in=pc, w_in=om) - case (3) - call PR78_factory(z, tc_in=tc, pc_in=pc, w_in=om) - end select - - write (NOUT, *) - write (NOUT, *) ' Combining rules:' - if (ncomb .eq. 0) then - write (NOUT, *) ' 0: Classical or van der Waals ' - do i = 1, nc - do j = i, nc - bij(i, j) = (1 - lij(i, j))*(b(i) + b(j))/2 - bij(j, i) = bij(i, j) - end do - end do - end if - -1 format(A18, F8.3, 5x, F7.3, 3x, F7.3, 3x, F7.3) -6 format(A18, 20F10.5) -7 format(9x, F7.4, 2x, F7.4) -8 format(9x, F7.2, 2x, F7.2) -end - -subroutine HelmSRKPR(nc, ND, NT, rn, V, T, Ar, ArV, ArTV, ArV2, Arn, ArVn, ArTn, Arn2) - use constants, only: pr, R - use system, only: del1, mixing_rule - - implicit real(pr)(A - H, O - Z) - - real(pr) :: rn(nc), Arn(nc), ArVn(nc), ArTn(nc), Arn2(nc, nc) - real(pr) :: dBi(nc), dBij(nc, nc) - real(pr) :: dDi(nc), dDij(nc, nc), dDiT(nc) - - TOTN = sum(rn) - D1 = del1(1) - D2 = (1 - D1)/(1 + D1) - - if (mixing_rule .lt. 2) then - call Bnder(nc, rn, Bmix, dBi, dBij) - call DandTnder(NT, nc, T, rn, D, dDi, dDiT, dDij, dDdT, dDdT2) - end if - - ! The f's and g's used here are for Ar, not F (reduced Ar) - ! This requires to multiply by R all g, f and its derivatives as defined by Mollerup - f = log((V + D1*Bmix)/(V + D2*Bmix))/Bmix/(D1 - D2) - g = R*log(1 - Bmix/V) - fv = -1/((V + D1*Bmix)*(V + D2*Bmix)) - fB = -(f + V*fv)/Bmix - gv = R*Bmix/(V*(V - Bmix)) - fv2 = (-1/(V + D1*Bmix)**2 + 1/(V + D2*Bmix)**2)/Bmix/(D1 - D2) - gv2 = R*(1/V**2 - 1/(V - Bmix)**2) - - ! Reduced Helmholtz Energy and derivatives - Ar = -TOTN*g*T - D*f - ArV = -TOTN*gv*T - D*fv - ArV2 = -TOTN*gv2*T - D*fv2 - - AUX = R*T/(V - Bmix) - FFB = TOTN*AUX - D*fB - FFBV = -TOTN*AUX/(V - Bmix) + D*(2*fv + V*fv2)/Bmix - FFBB = TOTN*AUX/(V - Bmix) - D*(2*f + 4*V*fv + V**2*fv2)/Bmix**2 - do i = 1, nc - Arn(i) = -g*T + FFB*dBi(i) - f*dDi(i) - ArVn(i) = -gv*T + FFBV*dBi(i) - fv*dDi(i) - if (ND .eq. 2) then - do j = 1, i - Arn2(i, j) = AUX*(dBi(i) + dBi(j)) - fB*(dBi(i)*dDi(j) + dBi(j)*dDi(i)) & - + FFB*dBij(i, j) + FFBB*dBi(i)*dBi(j) - f*dDij(i, j) - Arn2(j, i) = Arn2(i, j) - end do - end if - end do - ! TEMPERATURE DERIVATIVES - if (NT .eq. 1) then - ArT = -TOTN*g - dDdT*f - ArTV = -TOTN*gv - dDdT*fV - ArTT = -dDdT2*f - do i = 1, nc - ArTn(i) = -g + (TOTN*AUX/T - dDdT*fB)*dBi(i) - f*dDiT(i) - end do - end if -end subroutine HelmSRKPR \ No newline at end of file diff --git a/src/ThermoRoutines_RKPR.f90 b/src/ThermoRoutines_RKPR.f90 deleted file mode 100644 index d6d742c..0000000 --- a/src/ThermoRoutines_RKPR.f90 +++ /dev/null @@ -1,730 +0,0 @@ -!TODO: -! - Termo and zTVTermo should be joined in a single subroutine with optional -! arguments - -subroutine readRKPRNC(nc, nin, nout) - ! Critical constants must be given in K and bar - ! b will be in L/mol and ac in bar*(L/mol)**2 - ! PARAMETER (A0=0.0017,B0=1.9681,C0=-2.7238) - ! PARAMETER (A1=-2.4407,B1=7.4513,C1=12.504) - ! D=[0.428363, 18.496215, 0.338426, 0.660,789.723105, 2.512392] - use constants - use system, only: bij - implicit real(pr)(A - H, O - Z) - parameter(nco=64, RGAS=0.08314472d0) - double precision Kij(nco, nco), lij(nco, nco), Kinf(nco, nco), Tstar(nco, nco) - dimension ac(nco), b(nco), del1(nco), rk(nco), diam(nc), vc(nc) - real(pr) :: Vceos(nc) - character*18 fluid(nco) - - common /CRIT/ TC(nco), PC(nco), DCeos(nco), OM(nco) - common /NAMES/ fluid - common /Vshift/ iVshift, Vs(nco) ! added June 2016 - common /COMPONENTS/ ac, b, del1, rk, Kij, NTDEP - common /rule/ ncomb - common /Tdep/ Kinf, Tstar - common /lforin/ lij - - Tstar = 0.d0 - Kinf = 0.d0 - read (NIN, *) ncomb, NTDEP - do i = 1, nc - read (NIN, '(A)') fluid(i) - read (NIN, *) Tc(i), Pc(i), OM(i), Vceos(i) ! ,Zrat - RT = RGAS*Tc(i) - Zc = Pc(i)*Vceos(i)/RT - Zcin = Zc/Zrat - Vc(i) = Vceos(i)/Zrat - dceos(i) = 1/Vceos(i) - if (iVshift == 1) then - read (NIN, *) ac(i), b(i), del1(i), rk(i), Vs(i) - else - read (NIN, *) ac(i), b(i), del1(i), rk(i) - end if - ! 4 bb1(i)=b(i) - write (nout, '(A)') fluid(i) - write (nout, 1) Tc(i), Pc(i), Vc(i), OM(i) - write (nout, 3) Zcin, Zrat, Zc, Vceos(i) - write (nout, 2) ac(i), b(i), del1(i), rk(i) - Kij(i, i) = 0.0D0 - Lij(i, i) = 0.0D0 - if (i .gt. 1) then - if (ncomb .lt. 2) then - read (NIN, *) (Kij(j, i), j=1, i - 1) - Kij(i, :i - 1) = Kij(:i - 1, i) - if (NTDEP >= 1) read (NIN, *) (Tstar(j, i), j=1, i - 1) - Tstar(i, :i - 1) = Tstar(:i - 1, i) - if (NTDEP == 2) read (NIN, *) (Kinf(j, i), j=1, i - 1) - Kinf(i, :i - 1) = Kinf(:i - 1, i) - read (NIN, *) (lij(j, i), j=1, i - 1) - lij(i, :i - 1) = lij(:i - 1, i) - end if - end if - end do - write (NOUT, *) - write (nout, *) 'Tc, Pc and Vc are given in K, bar and L/mol respectively' - write (NOUT, *) - if (ncomb .lt. 2) then - if (NTDEP .eq. 0) then - write (NOUT, *) ' Kij MATRIX' - else - write (NOUT, *) ' K0ij MATRIX' - end if - do I = 1, NC - write (NOUT, 6) FLUID(I), (Kij(j, i), j=1, i - 1) - end do - if (NTDEP >= 1) then - write (NOUT, *) - write (NOUT, *) ' T* MATRIX' - do I = 1, NC - write (NOUT, 6) FLUID(I), (Tstar(j, i), j=1, i - 1) - end do - end if - if (NTDEP == 2) then - write (NOUT, *) - write (NOUT, *) ' Kinf MATRIX' - do I = 1, NC - write (NOUT, 6) FLUID(I), (Kinf(j, i), j=1, i - 1) - end do - end if - write (NOUT, *) - write (NOUT, *) ' LIJ MATRIX' - do I = 1, NC - write (NOUT, 6) FLUID(I), (Lij(j, i), j=1, i - 1) - end do - else - if (NTDEP .eq. 0) then - write (NOUT, *) ' Kijk: 112 122' - write (NOUT, 7) K01, K02 - write (NOUT, *) - else - write (NOUT, *) ' K0ijk: 112 122' - write (NOUT, 7) K01, K02 - write (NOUT, *) - write (NOUT, *) 'Kinfijk: 112 122' - write (NOUT, 7) Kinf1, Kinf2 - write (NOUT, *) - write (NOUT, *) 'Tstar : 112 122' - write (NOUT, 8) Tstar1, Tstar2 - write (NOUT, *) - end if - if (NTDEP .eq. 2) then - write (NOUT, *) ' Cijk: 112 122' - write (NOUT, 7) C1, C2 - write (NOUT, *) - end if - write (NOUT, *) ' Lijk: 112 122' - ! write(NOUT,7)Lijk(1,1,2),Lijk(1,2,2) - write (NOUT, *) - end if - write (NOUT, *) - write (NOUT, *) ' Combining rules:' - if (ncomb .eq. 0) then - write (NOUT, *) ' 0: Classical or van der Waals ' - do i = 1, nc - do j = i, nc - bij(i, j) = (1 - lij(i, j))*(b(i) + b(j))/2 - bij(j, i) = bij(i, j) - end do - end do - else if (ncomb .eq. 3) then - else - write (NOUT, *) ' 1: Lorentz-Berthelot' - third = 1.0d0/3 - do i = 1, nc - diam(i) = b(i)**third - end do - do i = 1, nc - do j = i, nc - bij(i, j) = ((1 - lij(i, j))*(diam(i) + diam(j))/2)**3 - bij(j, i) = bij(i, j) - end do - end do - end if - -1 format('Tc=', F9.4, ' Pc =', F9.4, ' Vc =', F8.4, ' OM =', F7.4) -2 format('ac=', F9.4, ' b =', F9.4, ' del1=', F8.4, ' k =', F7.4) -3 format('Zc=', F9.4, ' Zcrat=', F9.4, ' Zceos=', F8.4, ' Vceos=', F7.4) -6 format(A18, 20F10.5) -7 format(9x, F7.4, 2x, F7.4) -8 format(9x, F7.2, 2x, F7.2) -end subroutine readRKPRNC - -subroutine aTder(ac, Tc, k, T, a, dadT, dadT2) - ! Given ac,Tc and the k parameter of the RKPR correlation, as well as the actual T, - ! this subroutine calculates a(T) and its first and second derivatives with T. - use constants - use system, only: thermo_model - implicit none - real(pr), intent(in) :: ac - real(pr), intent(in) :: Tc - real(pr), intent(in) :: k - real(pr), intent(in) :: T - real(pr), intent(out) :: a - real(pr), intent(out) :: dadT - real(pr), intent(out) :: dadT2 - - real(pr) :: Tr - - Tr = T/Tc - - if (thermo_model .le. 3) then - a = ac*(1 + k*(1 - sqrt(Tr)))**2 - dadT = ac*k*(k - (k + 1)/sqrt(Tr))/Tc - dadT2 = ac*k*(k + 1)/(2*Tc**2*Tr**1.5D0) - else if (thermo_model == 4) then - a = ac*(3/(2 + Tr))**k - dadT = -k*a/Tc/(2 + Tr) - dadT2 = -(k + 1)*dadT/Tc/(2 + Tr) - end if -end subroutine aTder - -subroutine aijTder(NTD, nc, T, aij, daijdT, daijdT2) - use constants - use system, only: ac, rk => k, tc, kij0 => kij, ntdep => tdep - implicit none - - integer, intent(in) :: ntd - integer, intent(in) :: nc - real(pr), intent(in) :: T - real(pr), intent(out) :: aij(nc, nc), daijdT(nc, nc), daijdT2(nc, nc) - - real(pr) :: kij(nc, nc) - - real(pr) :: Kinf(nc, nc), Tstar(nc, nc) - - real(pr) :: ai(nc), daidT(nc), daidT2(nc) - - real(pr) :: aux(nc, nc), ratK(nc, nc) - integer :: i, j - - if (NTDEP .ge. 1) then - Kij = 0.0D0 - do i = 1, nc - Kij(:i - 1, i) = Kinf(:i - 1, i) + Kij0(:i - 1, i)*exp(-T/Tstar(:i - 1, i)) - end do - else - Kij = Kij0 - end if - - do i = 1, nc - call aTder(ac(i), Tc(i), rk(i), T, ai(i), daidT(i), daidT2(i)) - aij(i, i) = ai(i) - daijdT(i, i) = daidT(i) - daijdT2(i, i) = daidT2(i) - if (i .gt. 1) then - do j = 1, i - 1 - aij(j, i) = sqrt(ai(i)*ai(j))*(1 - Kij(j, i)) - aij(i, j) = aij(j, i) - if (NTD .eq. 1) then - daijdT(j, i) = (1 - Kij(j, i))*(sqrt(ai(i)/ai(j))*daidT(j) + sqrt(ai(j)/ai(i))*daidT(i))/2 - daijdT(i, j) = daijdT(j, i) - daijdT2(j, i) = (1 - Kij(j, i))*(daidT(j)*daidT(i)/sqrt(ai(i)*ai(j)) & - + sqrt(ai(i)/ai(j))*(daidT2(j) - daidT(j)**2/(2*ai(j))) & - + sqrt(ai(j)/ai(i))*(daidT2(i) - daidT(i)**2/(2*ai(i))))/2 - daijdT2(i, j) = daijdT2(j, i) - end if - end do - end if - end do - - if (NTDEP .ge. 1 .and. NTD .eq. 1) then - do i = 1, nc - aux(:i - 1, i) = daijdT(:i - 1, i) - ratK(:i - 1, i) = Kij(:i - 1, i)/(1 - Kij(:i - 1, i))/Tstar(:i - 1, i) - daijdT(:i - 1, i) = aux(:i - 1, i) + aij(:i - 1, i)*ratK(:i - 1, i) - daijdT(i, :i - 1) = daijdT(:i - 1, i) - daijdT2(:i - 1, i) = daijdT2(:i - 1, i) + (2*aux(:i - 1, i) - aij(:i - 1, i)/Tstar(:i - 1, i))*ratK(:i - 1, i) - daijdT2(i, :i - 1) = daijdT2(:i - 1, i) - end do - end if -end subroutine aijTder - -subroutine DandTnder(NTD, nc, T, rn, D, dDi, dDiT, dDij, dDdT, dDdT2) - use constants - implicit none - - integer, intent(in) :: ntd - integer, intent(in) :: nc - - real(pr), intent(in) :: T - real(pr), intent(in) :: rn(nc) - real(pr), intent(out) :: D - real(pr), intent(out) :: dDiT(nc) - real(pr), intent(out) :: dDdT - real(pr), intent(out) :: dDdT2 - real(pr), intent(out) :: dDi(nc) - real(pr), intent(out) :: dDij(nc, nc) - - real(pr) :: aij(nc, nc), daijdT(nc, nc), daijdT2(nc, nc) - real(pr) :: aux, aux2 - - integer :: i, j - - call aijTder(NTD, nc, T, aij, daijdT, daijdT2) - - D = 0 - dDdT = 0 - dDdT2 = 0 - do i = 1, nc - aux = 0 - aux2 = 0 - dDi(i) = 0 - dDiT(i) = 0 - do j = 1, nc - dDi(i) = dDi(i) + 2*rn(j)*aij(i, j) - if (NTD .eq. 1) then - dDiT(i) = dDiT(i) + 2*rn(j)*daijdT(i, j) - aux2 = aux2 + rn(j)*daijdT2(i, j) - end if - dDij(i, j) = 2*aij(i, j) - aux = aux + rn(j)*aij(i, j) - end do - D = D + rn(i)*aux - if (NTD .eq. 1) then - dDdT = dDdT + rn(i)*dDiT(i)/2 - dDdT2 = dDdT2 + rn(i)*aux2 - end if - end do -end subroutine DandTnder - -subroutine DELTAnder(nc, rn, D1m, dD1i, dD1ij) - use constants - use system, only: ac, b, d1 => del1, rk => k, kij, ntdep => tdep - implicit real(pr)(A - H, O - Z) - parameter(nco=64) - dimension rn(nc), dD1i(nc), dD1ij(nc, nc) - - D1m = 0.0d0 - do i = 1, nc - D1m = D1m + rn(i)*d1(i) - end do - - TOTN = sum(rn) - D1m = D1m/totn - - do i = 1, nc - dD1i(i) = (d1(i) - D1m)/totn - do j = 1, nc - dD1ij(i, j) = (2.0D0*D1m - d1(i) - d1(j))/totn**2 - end do - end do -end subroutine DELTAnder - -subroutine Bnder(nc, rn, Bmix, dBi, dBij) - use constants - use system, only: bij - implicit real(pr)(A - H, O - Z) - - real(pr) :: rn(nc), dBi(nc), dBij(nc, nc), aux(nc) - - TOTN = sum(rn) - Bmix = 0.0D0 - aux = 0.0D0 - - do i = 1, nc - do j = 1, nc - aux(i) = aux(i) + rn(j)*bij(i, j) - end do - Bmix = Bmix + rn(i)*aux(i) - end do - Bmix = Bmix/totn - do i = 1, nc - dBi(i) = (2*aux(i) - Bmix)/totn - do j = 1, i - dBij(i, j) = (2*bij(i, j) - dBi(i) - dBi(j))/totn - dBij(j, i) = dBij(i, j) - end do - end do -end subroutine Bnder - -subroutine HelmRKPR(nco, NDE, NTD, rn, V, T, Ar, ArV, ArTV, ArV2, Arn, ArVn, ArTn, Arn2) - !! Calculate the reduced residual Helmholtz Energy and it's derivatives with the RKPR EOS - use constants - use system, only: ncomb => mixing_rule - implicit real(pr)(A - H, O - Z) - parameter(RGAS=0.08314472d0) - real(pr) :: rn(nco), Arn(nco), ArVn(nco), ArTn(nco), Arn2(nco, nco) - real(pr) :: dBi(nco), dBij(nco, nco), dD1i(nco), dD1ij(nco, nco) - real(pr) :: dDi(nco), dDij(nco, nco), dDiT(nco) - - nc = nco - TOTN = sum(rn) - call DELTAnder(nc, rn, D1, dD1i, dD1ij) - D2 = (1 - D1)/(1 + D1) - - if (ncomb .lt. 2) then - call Bnder(nc, rn, Bmix, dBi, dBij) - call DandTnder(NTD, nc, T, rn, D, dDi, dDiT, dDij, dDdT, dDdT2) - else - ! call Bcubicnder(nc,rn,Bmix,dBi,dBij) - ! call DCubicandTnder(NTD,nc,T,rn,D,dDi,dDiT,dDij,dDdT,dDdT2) - end if - - ! The f's and g's used here are for Ar, not F (reduced Ar) - ! This requires to multiply by R all g, f and its derivatives as defined by Mollerup - f = log((V + D1*Bmix)/(V + D2*Bmix))/Bmix/(D1 - D2) - g = RGAS*log(1 - Bmix/V) - fv = -1/((V + D1*Bmix)*(V + D2*Bmix)) - fB = -(f + V*fv)/Bmix - gv = RGAS*Bmix/(V*(V - Bmix)) - fv2 = (-1/(V + D1*Bmix)**2 + 1/(V + D2*Bmix)**2)/Bmix/(D1 - D2) - gv2 = RGAS*(1/V**2 - 1/(V - Bmix)**2) - - ! DERIVATIVES OF f WITH RESPECT TO DELTA1 - auxD2 = (1 + 2/(1 + D1)**2) - fD1 = (1/(V + D1*Bmix) + 2/(V + D2*Bmix)/(1 + D1)**2) - f*auxD2 - fD1 = fD1/(D1 - D2) - fBD1 = -(fB*auxD2 + D1/(V + D1*Bmix)**2 + 2*D2/(V + D2*Bmix)**2/(1 + D1)**2) - fBD1 = fBD1/(D1 - D2) - fVD1 = -(fV*auxD2 + 1/(V + D1*Bmix)**2 + 2/(V + D2*Bmix)**2/(1 + D1)**2)/(D1 - D2) - fD1D1 = 4*(f - 1/(V + D2*Bmix))/(1 + D1)**3 + Bmix*(-1/(V + D1*Bmix)**2 & - + 4/(V + D2*Bmix)**2/(1 + D1)**4) - 2*fD1*(1 + 2/(1 + D1)**2) - fD1D1 = fD1D1/(D1 - D2) - - ! Reduced Helmholtz Energy and derivatives - Ar = -TOTN*g*T - D*f - ArV = -TOTN*gv*T - D*fv - ArV2 = -TOTN*gv2*T - D*fv2 - - AUX = RGAS*T/(V - Bmix) - FFB = TOTN*AUX - D*fB - FFBV = -TOTN*AUX/(V - Bmix) + D*(2*fv + V*fv2)/Bmix - FFBB = TOTN*AUX/(V - Bmix) - D*(2*f + 4*V*fv + V**2*fv2)/Bmix**2 - - do i = 1, nc - Arn(i) = -g*T + FFB*dBi(i) - f*dDi(i) - D*fD1*dD1i(i) - ArVn(i) = -gv*T + FFBV*dBi(i) - fv*dDi(i) - D*fVD1*dD1i(i) - if (NDE .eq. 2) then - do j = 1, i - Arn2(i, j) = AUX*(dBi(i) + dBi(j)) - fB*(dBi(i)*dDi(j) + dBi(j)*dDi(i)) & - + FFB*dBij(i, j) + FFBB*dBi(i)*dBi(j) - f*dDij(i, j) - Arn2(i, j) = Arn2(i, j) - D*fBD1*(dBi(i)*dD1i(j) + dBi(j)*dD1i(i)) & - - fD1*(dDi(i)*dD1i(j) + dDi(j)*dD1i(i)) & - - D*fD1*dD1ij(i, j) - D*fD1D1*dD1i(i)*dD1i(j) - Arn2(j, i) = Arn2(i, j) - end do - end if - end do - - ! TEMPERATURE DERIVATIVES - if (NTD .eq. 1) then - ArT = -TOTN*g - dDdT*f - ArTV = -TOTN*gv - dDdT*fV - ArTT = -dDdT2*f - do i = 1, nc - ArTn(i) = -g + (TOTN*AUX/T - dDdT*fB)*dBi(i) - f*dDiT(i) - dDdT*fD1*dD1i(i) - end do - end if -end subroutine HelmRKPR - -subroutine TERMO(nc, MTYP, INDIC, T, P, rn, V, PHILOG, DLPHIP, DLPHIT, FUGN) - ! MTYP TYPE OF ROOT DESIRED (-1 vapor, 1 liquid, 0 lower Gibbs energy phase) - ! rn mixture mole numbers (input) - ! t temperature (k) (input)x, y - ! p pressure (bar) (input) - ! v volume (L) (output) - ! PHILOG vector of ln(phi(i)*P) (output) INDIC < 5 - ! DLPHIT t-derivative of ln(phi(i)) (const P, n) (output) INDIC = 2 or 4 - ! DLPHIP P-derivative of ln(phi(i)) (const T, n) (output) INDIC < 5 - ! FUGN comp-derivative of ln(phi(i)) (const t & P)(output) INDIC > 2 - ! ------------------------------------------------------------------------- - use constants - implicit none - real(pr), parameter :: RGAS=0.08314472 - - integer, intent(in) :: nc !! Number of components - integer, intent(in) :: indic !! Desired element, this should be setted with optionals - integer, intent(in) :: mtyp !! Type of root desired (-1 vapor, 1 liquid, 0 lower Gr) - real(pr), intent(in) :: t !! Temperature [K] - real(pr), intent(in) :: p !! Pressure [bar] - real(pr), intent(in) :: rn(nc) !! Mixture mole numbers - - real(pr), intent(out) :: v !! Volume [L] - real(pr), intent(out) :: PHILOG(nc) !! ln(phi*p) vector - real(pr), intent(out) :: DLPHIT(nc) !! ln(phi) Temp derivative - real(pr), intent(out) :: DLPHIP(nc) !! ln(phi) Presssure derivative - real(pr), intent(out) :: FUGN(nc, nc) !! ln(phi) compositional derivative - - real(pr) :: ar, arv, artv, arv2 - real(pr) :: RT, Z, dpv, dpdt - real(pr) :: Arn(nc) - real(pr) :: ArVn(nc) - real(pr) :: ArTn(nc) - real(pr) :: Arn2(nc, nc) - real(pr) :: DPDN(nc) - real(pr) :: totn - integer :: ntemp, igz, nder, i, k - - - ! The output PHILOG is actually the vector ln(phi(i)*P) - NTEMP = 0 - IGZ = 0 - NDER = 1 - if (INDIC .gt. 2) NDER = 2 - if (INDIC .eq. 2 .or. INDIC .eq. 4) NTEMP = 1 - TOTN = sum(rn) - ! if (P .le. 0.0d0) MTYP = 1 - call VCALC(MTYP, NC, NTEMP, rn, T, P, V) - RT = RGAS*T - Z = V/(TOTN*RT) ! this is Z/P - call ArVnder(nc, NDER, NTEMP, rn, V, T, Ar, ArV, ArTV, ArV2, Arn, ArVn, ArTn, Arn2) - DPV = -ArV2 - RT*TOTN/V**2 - DPDT = -ArTV + TOTN*RGAS/V - - do I = 1, NC - PHILOG(I) = -log(Z) + Arn(I)/RT - DPDN(I) = RT/V - ArVn(I) - DLPHIP(I) = -DPDN(I)/DPV/RT - 1.D0/P - if (NTEMP .ne. 0) then - DLPHIT(I) = (ArTn(I) - Arn(I)/T)/RT + DPDN(I)*DPDT/DPV/RT + 1.D0/T - end if - end do - - if (NDER .ge. 2) then - do I = 1, NC - do K = I, NC - FUGN(I, K) = 1.D0/TOTN + (Arn2(I, K) + DPDN(I)*DPDN(K)/DPV)/RT - FUGN(K, I) = FUGN(I, K) - end do - end do - end if -end subroutine TERMO - -subroutine zTVTERMO(nc, INDIC, T, rn, V, P, DPV, PHILOG, DLPHIP, DLPHIT, FUGN) - ! rn mixture mole numbers (input) - ! t temperature (k) (input) - ! v volume (L) (input) - ! p pressure (bar) (output) - ! PHILOG vector of ln(phi(i)*P) (output) 0 < INDIC < 5 - ! DLPHIT t-derivative of ln(phi(i)) (const P, n) (output) 0 < INDIC = 2 or 4 - ! DLPHIP P-derivative of ln(phi(i)) (const T, n) (output) 0 < INDIC < 5 - ! FUGN comp-derivative of ln(phi(i)) (const t & P)(output) 2 < INDIC - ! ------------------------------------------------------------------------- - use constants - implicit none - real(pr), parameter :: RGAS=0.08314472 - - integer, intent(in) :: nc, indic - real(pr), intent(in) :: t, rn(nc), v - - real(pr), intent(out) :: p, dpv - real(pr), intent(out) :: PHILOG(nc), DLPHIT(nc), DLPHIP(nc) - real(pr), intent(out) :: FUGN(nc, nc) - - real(pr) :: Arn(nc), ArVn(nc), ArTn(nc), Arn2(nc, nc), DPDN(nc), totn - real(pr) :: ar, arv, artv, arv2, RT, Z, dpdt - - integer :: ntemp, igz, nder, i, k - - NTEMP = 0 - IGZ = 0 - NDER = 1 - - if (INDIC .gt. 2) NDER = 2 - if (INDIC .eq. 2 .or. INDIC .eq. 4) NTEMP = 1 - - TOTN = sum(rn) - - RT = RGAS*T - Z = V/(TOTN*RT) ! this is Z/P - - call ArVnder(nc, NDER, NTEMP, rn, V, T, Ar, ArV, ArTV, ArV2, Arn, ArVn, ArTn, Arn2) - P = TOTN*RT/V - ArV - DPV = -ArV2 - RT*TOTN/V**2 - DPDT = -ArTV + TOTN*RGAS/V - - if (INDIC > 0) then - do I = 1, NC - PHILOG(I) = -log(Z) + Arn(I)/RT - DPDN(I) = RT/V - ArVn(I) - DLPHIP(I) = -DPDN(I)/DPV/RT - 1.D0/P - if (NTEMP .ne. 0) then - DLPHIT(I) = (ArTn(I) - Arn(I)/T)/RT + DPDN(I)*DPDT/DPV/RT + 1.D0/T - end if - end do - end if - - if (NDER .ge. 2) then - do I = 1, NC - do K = I, NC - FUGN(I, K) = 1.D0/TOTN + (Arn2(I, K) + DPDN(I)*DPDN(K)/DPV)/RT - FUGN(K, I) = FUGN(I, K) - end do - end do - end if -end subroutine zTVTERMO - -subroutine PUREFUG_CALC(nc, icomp, T, P, V, phi) - use constants - implicit none - real(pr), parameter :: RGAS=0.08314472 - integer, intent(in) :: nc - integer, intent(in) :: icomp - real(pr), intent(in) :: T, P, V - real(pr), intent(out) :: phi - - real(pr) :: rn(nc), Ar, Arv, ArTV, ArV2, Arn(nc), ArVn(nc), ArTn(nc), Arn2(nc, nc) - real(pr) :: RT, Z, philog - rn = 0.0 - rn(icomp) = 1.0 - RT = RGAS*T - Z = P*V/RT - call ArVnder(nc, 0, 0, rn, V, T, Ar, ArV, ArTV, ArV2, Arn, ArVn, ArTn, Arn2) - PHILOG = -log(Z) + Arn(icomp)/RT - phi = exp(PHILOG) -end subroutine purefug_calc - -recursive subroutine VCALC(ITYP, nc, NTEMP, rn, T, P, V) - ! ROUTINE FOR CALCULATION OF VOLUME, GIVEN PRESSURE - - ! INPUT: - ! ITYP: TYPE OF ROOT DESIRED (-1 vapor, 1 liquid, 0 lower Gibbs energy phase) - ! NC: NO. OF COMPONENTS - ! NTEMP: 1 if T-derivatives are required - ! rn: FEED MOLES - ! T: TEMPERATURE - ! P: PRESSURE - - ! OUTPUT: - ! V: VOLUME - use constants - implicit real(pr)(A - H, O - Z) - parameter(RGAS=0.08314472d0) - real(pr) :: rn(nc) - real(pr) :: Arn(nc), ArVn(nc), ArTn(nc), Arn2(nc, nc) - logical FIRST_RUN - NDER = 0 - FIRST_RUN = .true. - TOTN = sum(rn) - call Bcalc(nc, rn, T, B) - CPV = B - S3R = 1.D0/CPV - ITER = 0 - - ZETMIN = 0.D0 - !ZETMAX = 1.D0-0.01*T/5000 !.99D0 This is flexible for low T (V very close to B) - ZETMAX = 1.D0 - 0.01*T/(10000*B) ! improvement for cases with heavy components - if (ITYP .gt. 0) then - ZETA = .5D0 - else - ! IDEAL GAS ESTIMATE - ZETA = min(.5D0, CPV*P/(TOTN*RGAS*T)) - end if - -100 continue - - DEL = 1 - pcalc = 2*p - - do while(abs(DEL) > 1d-10 .and. iter < 100) - V = CPV/ZETA - ITER = ITER + 1 - call ArVnder(& - nc, NDER, NTEMP, rn, V, T, Ar, ArV, ArTV, ArV2, Arn, ArVn, ArTn, Arn2 & - ) - PCALC = TOTN*RGAS*T/V - ArV - - if (PCALC .gt. P) then - ZETMAX = ZETA - else - ZETMIN = ZETA - end if - - AT = (Ar + V*P)/(T*RGAS) - TOTN*log(V) - ! AT is something close to Gr(P,T) - - DER = (ArV2*V**2 + TOTN*RGAS*T)*S3R ! this is dPdrho/B - DEL = -(PCALC - P)/DER - ZETA = ZETA + max(min(DEL, 0.1D0), -.1D0) - - if (ZETA .gt. ZETMAX .or. ZETA .lt. ZETMIN) & - ZETA = .5D0*(ZETMAX + ZETMIN) - end do - - if (ITYP .eq. 0) then - ! FIRST RUN WAS VAPOUR; RERUN FOR LIQUID - if (FIRST_RUN) then - VVAP = V - AVAP = AT - FIRST_RUN = .false. - ZETA = 0.5D0 - ZETMAX = 1.D0 - 0.01*T/500 - goto 100 - else - if (AT .gt. AVAP) V = VVAP - end if - end if -end subroutine vcalc - -subroutine ArVnder(nc, NDER, NTD, rn, V, T, Ar, ArV, ArTV, ArV2, Arn, ArVn, ArTn, Arn2) - use constants - use system, only: nmodel => thermo_model - implicit none - integer, intent(in) :: nc - integer, intent(in) :: nder - integer, intent(in) :: ntd - - real(pr), intent(in) :: rn(nc) - real(pr), intent(in) :: V - real(pr), intent(in) :: T - real(pr), intent(out) :: ar, arv, artv, arv2 - real(pr), intent(out) :: Arn(nc), ArVn(nc), ArTn(nc), Arn2(nc, nc) - - if (NMODEL .le. 3) then - ! SRK or PR76/78 - call HelmSRKPR(nc, NDER, NTD, rn, V, T, Ar, ArV, ArTV, ArV2, Arn, ArVn, ArTn, Arn2) - else if (NMODEL .eq. 4) then - call HelmRKPR(nc, NDER, NTD, rn, V, T, Ar, ArV, ArTV, ArV2, Arn, ArVn, ArTn, Arn2) - else if (NMODEL .eq. 5) then - ! CALL HelmPCSAFT(NDER,NTD,rn,V,T,Ar,ArV,ArTV,ArV2,Arn,ArVn,ArTn,Arn2) - else if (NMODEL .eq. 6) then - ! CALL HelmSPHCT(NDER,NTD,rn,V,T,Ar,ArV,ArTV,ArV2,Arn,ArVn,ArTn,Arn2) - else if (NMODEL .eq. 8) then - ! CALL HelmESD (NDER,NTD,rn,V,T,Ar,ArV,ArTV,ArV2,Arn,ArVn,ArTn,Arn2) - else - ! GC-EOS 5 (or GCA 7) - ! CALL HelmGC(NDER,NTD,rn,V,T,Ar,ArV,ArTV,ArV2,Arn,ArVn,ArTn,Arn2) - end if -end subroutine ArVnder - -subroutine Bcalc(nc, x, T, BMIX) - ! This general subroutine provides the "co-volume" for specified composition, - ! that will be used by Evalsecond or Vcalc - use constants, only: pr - use system, only: nmodel => thermo_model, ncomb => mixing_rule - implicit none - integer, intent(in) :: nc - real(pr), intent(in) :: T - real(pr), intent(out) :: bmix - real(pr) :: x(nc), b, dBi(nc), dBij(nc, nc) - ! common/MIXRULE/NSUB - ! common/BMIX/B - ! common/NG/NGR - ! NG = NGR - if (NMODEL .eq. 5 .or. NMODEL .eq. 7) then - ! CALL PARAGC(T,nc,NG,1) - ! PI=3.1415926536D0 - ! XLAM3=0.0d0 - ! DO 3 I=1,nc - ! DGC=D(I) - ! 3 XLAM3=XLAM3+X(I)*DGC**3 - ! B=PI/6.D0*XLAM3/1.0D3 - else if (NMODEL .eq. 4) then - ! DD=DDB - ! CALL DIAMET(nc,T,DIA,DD,DDT,DTT,NSUB) - ! B=RGAS*(DD(3,1)*X(1)+DD(3,2)*X(2)) !S3 - else if (NMODEL .eq. 6) then - ! CALL Mixture_Param(NSUB,NC,X,T) - ! B=VCPM - else if (NMODEL .eq. 8) then - ! B=x(1)*VX(1)+x(2)*VX(2) - else - if (ncomb <= 2) then - call Bnder(nc, x, B, dBi, dBij) ! Bmix is used in EVALSECOND - else - ! call Bcubicnder(2,x,B,dBi,dBij) - end if - end if - BMIX = B -end subroutine bcalc diff --git a/src/linalg.f90 b/src/linalg.f90 index 01e62bd..4ea615e 100644 --- a/src/linalg.f90 +++ b/src/linalg.f90 @@ -25,6 +25,19 @@ function solve_system(a, b) result(x) integer :: n, nrhs, lda, ipiv(size(b)), ldb, info + interface + subroutine dgesv(n, nrhs, a, lda, ipiv, b, ldb, info) + integer :: n + integer :: nrhs + real(8) :: a(n,n) + integer :: lda + integer :: ipiv(n) + real(8) :: b(n) + integer :: ldb + integer :: info + end subroutine + end interface + n = size(a, dim=1) nrhs = 1 lda = n diff --git a/src/new/constants.f90 b/src/new/constants.f90 index 1f22afc..b96a97c 100644 --- a/src/new/constants.f90 +++ b/src/new/constants.f90 @@ -5,5 +5,6 @@ module constants integer, parameter :: pr = real64 real(pr), parameter :: R = 0.08314472 character(len=254) :: database_path = "database/" + character(len=254) :: ouput_path = "output/" character(len=1) :: path_sep = "/" end module constants diff --git a/src/new/envelopes.f90 b/src/new/envelopes.f90 index 87e420e..6fdf2e8 100644 --- a/src/new/envelopes.f90 +++ b/src/new/envelopes.f90 @@ -3,8 +3,9 @@ module envelopes !! phase envelopes use constants, only: pr use linalg, only: solve_system - use system, only: nc + ! use system, only: nc use dtypes, only: envelope + use legacy_ar_models, only: nc, termo implicit none integer, parameter :: max_points = 2000 @@ -25,7 +26,8 @@ function F(X, ns, S) ! --------------------------------------------------------------------------- subroutine k_wilson_bubble(z, t, p, k) !! Find the Wilson Kfactors at ~10 bar to initialize a bubble point - use system, only: pc, tc, w + ! use system, only: pc, tc, w + use legacy_ar_models, only: pc, tc, w real(pr), intent(in) :: z(:) real(pr), intent(in out) :: p real(pr), intent(in out) :: t @@ -37,20 +39,22 @@ subroutine k_wilson_bubble(z, t, p, k) do while (P > 10) T = T - 5._pr - P = 1.0_pr/sum(z*pc*exp(5.373_pr*(1 + w)*(1 - tc/T))) + P = 1.0_pr/sum(z * pc*exp(5.373_pr*(1 + w)*(1 - tc/T))) end do k = k_wilson(t, p) end subroutine function k_wilson(t, p) result(k) - use system, only: pc, tc, w + ! use system, only: pc, tc, w + use legacy_ar_models, only: pc, tc, w real(pr), intent(in) :: t, p real(pr) :: k(size(pc)) k = pc * exp(5.373_pr * (1.0_pr + w) * (1.0_pr - tc/t))/p end function function p_wilson(z, t) result(p) - use system, only: pc, tc, w + ! use system, only: pc, tc, w + use legacy_ar_models, only: pc, tc, w real(pr), intent(in) :: t, z(:) real(pr) :: p P = 1.0_pr/sum(z*pc*exp(5.373_pr*(1 + w)*(1 - tc/T))) @@ -117,7 +121,8 @@ subroutine update_specification(iter, passingcri, X, dF, ns, S, delS, dXdS) ! Specification function derivatives ! --------------------------------------------------------------------------- subroutine dFdS(dF_dS) - use system, only: nc + ! use system, only: nc + use legacy_ar_models, only: nc real(pr), intent(out) :: dF_dS(nc + 2) dF_dS = 0 @@ -239,6 +244,7 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e this_envelope) ! This output should encapsulate everything use dtypes, only: envelope, critical_point use linalg, only: point, solve_system + use constants, only: ouput_path implicit none ! number of compounds in the system and starting point type @@ -275,7 +281,7 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e ! Intermediate variables during calculation process real(pr), dimension(n) :: y - integer, dimension(n + 2) :: ipiv + integer, dimension(n + 2) :: ipiv real(pr), dimension(n + 2) :: X, Xold, Xold2, delX, bd, F, dFdS, dXdS real(pr), dimension(n + 2, n + 2) :: JAC, AJ real(pr) :: Vy, Vx @@ -286,7 +292,7 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e type(envelope), intent(out) :: this_envelope real(pr) :: tmp_logk(max_points, n) real(pr) :: tmp_logphi(max_points, n) - + ! Extrapolation of variables to detect critical points real(pr) :: extra_slope(n + 2) real(pr) :: lnK_extrapolated(n) @@ -311,18 +317,18 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e integer :: black_i ! Number of steps while trying to escape the CP real(pr) :: stepx - integer :: funit_env - character(len=20) :: fname_env + integer :: funit_output + character(len=254) :: fname_env ! ============================================================================= ! OUTPUT file ! ----------------------------------------------------------------------------- env_number = env_number + 1 write(fname_env, *) env_number - print *, fname_env - fname_env = "ENV2_OUT" // "_" // trim(adjustl(fname_env)) - print *, fname_env - open(newunit=funit_env, file=fname_env) + fname_env = "env-2ph-PT" // "_" // trim(adjustl(fname_env)) + fname_env = trim(adjustl(ouput_path)) // trim(fname_env) // ".dat" + + open(newunit=funit_output, file=fname_env) ! ============================================================================= ! Initialize with zero Tv and Pv @@ -343,8 +349,6 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e i = 0 ncri = 0 JAC(n + 1, :) = 0.d0 - ! lda = n + 2 - ! ldb = n + 2 X(:n) = log(KFACT) X(n + 1) = log(T) X(n + 2) = log(P) @@ -361,21 +365,21 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e case (3) incipient_phase = "2ndliquid" end select - write(funit_env, *) incipient_phase + write(funit_output, *) "#", incipient_phase - if (ichoice <= 2) then + if (ichoice <= 2) then ! low T bub (1) or dew (2) ! x will be vapor phase during the first part, ! and liquid after a critical point is crossed if (ichoice == 1) iy = -1 - if (ichoice == 2) ix = -1 + if (ichoice == 2) ix = -1 ns = n + 1 S = log(T) delS = 0.005 ! Wilson estimate for vapor (or liquid) composition - y = KFACT*z - else + y = KFACT*z + else ! (ichoice==3) high P L-L sat ! PmaxDewC = maxval(PdewC(1:ilastDewC)) ns = n + 2 @@ -415,7 +419,7 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e if (.not. passingcri .and. i /= 1 & .and. iter > 10 & .and. maxval(abs(delX)) > 0.001) then - ! Too many iterations-->Reduce step to new point + ! Too many iterations --> Reduce step to new point delS = delS*2.0/4.0 S = S - delS @@ -429,7 +433,7 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e end do ! Point converged (unless it jumped out because of high number of iterations) - write(funit_env, *) T, P, exp(X(:n)) + write(funit_output, *) "SOL", iter, ns, T, P, exp(X(:n)) if (iter > max_iter) run = .false. if (P > maxP) maxP = P @@ -451,7 +455,7 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e ! rho_y = 1/Vy incipient phase density - if (incipient_phase == "2ndliquid" .and. P < 1.0) then + if (incipient_phase == "2ndliquid" .and. P < 0.1) then ! isolated LL line detected. ! Stop and start a new one from low T false bubble point run = .false. @@ -476,9 +480,9 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e incipient_phase = "liquid" end select - write(funit_env, *) " " - write(funit_env, *) " " - write(funit_env, *) incipient_phase + write(funit_output, *) " " + write(funit_output, *) " " + write(funit_output, *) "#", incipient_phase end if if (run) then @@ -592,17 +596,17 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e n_points = i - write(funit_env, *) " " - write(funit_env, *) " " - ! write(funit_env, *) "critical" - if (ncri == 0) write(funit_env, *) "NaN NaN" + write(funit_output, *) " " + write(funit_output, *) " " + write(funit_output, *) "#critical" + if (ncri == 0) write(funit_output, *) "NaN NaN" do i=1, ncri - write(funit_env, *) Tcri(i), Pcri(i) + write(funit_output, *) Tcri(i), Pcri(i) end do ! Define envelope values, omit the last point to avoid not really ! converged cases - close(funit_env) + close(funit_output) this_envelope%logk = tmp_logk(:n_points - 1, :) this_envelope%logphi = tmp_logphi(:n_points - 1, :) this_envelope%t = Tv(:n_points - 1) @@ -615,30 +619,4 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e this_envelope%critical_points = critical_points end subroutine envelope2 ! =========================================================================== - - - ! ============================================================================= - - ! subroutine two_phase_envelope(X0, spec_number, specification, envels) - ! real(pr), intent(in) :: X0(:) - ! integer, intent(in) :: spec_number - ! real(pr), intent(in) :: specification - ! type(envelope), allocatable, intent(out) :: envels(:) - - ! real(pr) :: X(size(X)) - ! integer :: ns - ! real(pr) :: S - ! real(pr) :: XS(max_points, size(X0)) - - ! integer :: i - ! ns = spec_number - ! S = specification - - ! do i=1,max_points - ! call solve_point - ! call update_specification - ! call detect_critical - ! call check_end - ! end do - ! end subroutine end module envelopes diff --git a/src/new/io_nml.f90 b/src/new/io_nml.f90 index f305219..2c5111e 100644 --- a/src/new/io_nml.f90 +++ b/src/new/io_nml.f90 @@ -43,8 +43,8 @@ module io_nml !! / !! use constants, only: pr - use system, only: nc, thermo_model, mixing_rule, tdep, & - & names, z, & + use legacy_ar_models, only: nc, thermo_model, mixing_rule, tdep, & + & z, & & tc, pc, w, & & ac, b, k, & & kij, lij, bij, & @@ -56,6 +56,7 @@ module io_nml character(len=50) :: model, mixrule character(len=254) :: path_to_file character(len=50) :: spec + character(len=50), allocatable :: names(:) private @@ -100,6 +101,8 @@ subroutine read_model() ! Allocate in memory all the parameters call setup(nc, thermo_model, tdep, mixing_rule) + allocate(names(nc)) + allocate(z(nc)) end subroutine subroutine read_components() diff --git a/src/new/mod_inj_envelopes.f90 b/src/new/mod_inj_envelopes.f90 index 7f56990..b36daa2 100644 --- a/src/new/mod_inj_envelopes.f90 +++ b/src/new/mod_inj_envelopes.f90 @@ -6,6 +6,8 @@ module inj_envelopes implicit none + integer :: env_number = 0 + type, extends(envelope) :: injelope real(pr), allocatable :: alpha(:) !! Ammount of injected fluid real(pr), allocatable :: z_inj(:) !! Injected fluid composition @@ -18,12 +20,12 @@ module inj_envelopes real(pr), allocatable :: z_injection(:) !! Injection fluid composition real(pr) :: T !! Temperature of injection real(pr) :: del_S = 0.1 !! Specificiation variation - character(len=:), allocatable :: injection_case !! Kind of injection displace|dilute - integer :: funit_output !! Output file unit + character(len=10) :: injection_case !! Kind of injection displace|dilute contains subroutine from_nml(filepath) - use system, only: nc + ! use system, only: nc + use legacy_ar_models, only: nc character(len=*), intent(in) :: filepath integer :: funit @@ -34,9 +36,6 @@ subroutine from_nml(filepath) open(newunit=funit, file=filepath) read(funit, nml=nml_px) close(funit) - - print *, z_0 - print *, z_injection end subroutine subroutine F_injection(X, ns, S, F, dF) @@ -55,6 +54,7 @@ subroutine F_injection(X, ns, S, F, dF) !! - Addition: \( z = \frac{\alpha z_i + (1-\alpha) z_0}{\sum_{i=1}^N \alpha z_i + (1-\alpha) z_0} \) !! use iso_fortran_env, only: error_unit + use legacy_ar_models, only: TERMO real(pr), intent(in) :: X(:) !! Vector of variables integer, intent(in) :: ns !! Number of specification real(pr), intent(in) :: S !! Specification value @@ -244,6 +244,7 @@ subroutine F_injection(X, ns, S, F, dF) ! end subroutine subroutine injection_envelope(X0, spec_number, del_S0, envels) + use constants, only: ouput_path !! Subroutine to calculate Px phase envelopes via continuation method real(pr), intent(in) :: X0(:) !! Vector of variables integer, intent(in) :: spec_number !! Number of specification @@ -260,6 +261,9 @@ subroutine injection_envelope(X0, spec_number, del_S0, envels) real(pr) :: F(size(X0)), dF(size(X0), size(X0)), dXdS(size(X0)) integer :: point, iters, n + integer :: i + integer :: funit_output + character(len=254) :: fname_env allocate(cps(0)) X = X0 @@ -268,8 +272,20 @@ subroutine injection_envelope(X0, spec_number, del_S0, envels) S = X(ns) del_S = del_S0 + ! ====================================================================== + ! Output file + ! ---------------------------------------------------------------------- + env_number = env_number + 1 + + write(fname_env, *) env_number + fname_env = "env-2ph-PX" // "_" // trim(adjustl(fname_env)) + fname_env = trim(adjustl(ouput_path)) // trim(fname_env) // ".dat" + + open(funit_output, file=fname_env) write(funit_output, * ) "#", T write(funit_output, *) "X0", iters, ns, X(n+2), exp(X(n+1)), X(:n) + ! ====================================================================== + enveloop: do point=1, max_points call full_newton(f_injection, iters, X, ns, S, F, dF) @@ -345,6 +361,8 @@ subroutine injection_envelope(X0, spec_number, del_S0, envels) pc = Xnew(n+1) cps = [cps, critical_point(t, pc, alpha_c)] + write(funit_output, *) "" + write(funit_output, *) "" end if end block detect_critical @@ -356,15 +374,22 @@ subroutine injection_envelope(X0, spec_number, del_S0, envels) point = point - 1 + write(funit_output, *) "#critical" + if (size(cps) > 0 ) then + do i=1,size(cps) + write(funit_output, *) cps(i)%t, cps(i)%p + end do + else + write(funit_output, *) "NaN NaN" + endif + + close(funit_output) envels%z = z_0 envels%z_inj = z_injection envels%logk = XS(:point, :n) envels%alpha = XS(:point, n+2) envels%p = exp(XS(:point, n+1)) envels%critical_points = cps - - write(funit_output, *) "" - write(funit_output, *) "" end subroutine subroutine full_newton(fun, iters, X, ns, S, F, dF) @@ -426,7 +451,8 @@ function break_conditions(X, ns, S) alpha = X(n+2) break_conditions = [& - p < 10 .or. p > 1000 & + p < 10 .or. p > 1000, & + abs(del_S) < 1e-8 & ] end function end module diff --git a/src/new/thermo.f90 b/src/new/thermo.f90 deleted file mode 100644 index 979b85f..0000000 --- a/src/new/thermo.f90 +++ /dev/null @@ -1,301 +0,0 @@ -module system - ! Module for a cubic eos system, - ! this should be later adapted into a simple oop system where an eos object - ! stores the relevant parameters - use constants, only: pr, R - implicit none - - ! Model settings - integer :: thermo_model !! Which thermodynamic model to use - integer :: tdep !! Temperature dependance of kij - integer :: mixing_rule !! What mixing rule to use - integer :: nc !! Number of components - character(len=50), allocatable :: names(:) - - ! Mole fracions - real(pr), allocatable :: z(:) - real(pr), allocatable :: moles(:) - - ! Critical constants - real(pr), allocatable :: tc(:) !! Critical temperature [K] - real(pr), allocatable :: pc(:) !! Critical pressure [bar] - real(pr), allocatable :: dc(:) !! Critical density [mol/L] - real(pr), allocatable :: w(:) !! Acentric factor - - ! Model parameters - real(pr), allocatable :: ac(:) !! Critical attractive parameter [bar (L/mol)^2] - real(pr), allocatable :: b(:) !! repulsive parameter [L] - real(pr), allocatable :: del1(:) !! $$\delta_1$$ parameter - real(pr), allocatable :: k(:) !! Attractive parameter constant - real(pr), allocatable :: kij(:, :) !! Attractive BIP - real(pr), allocatable :: lij(:, :) !! Repulsive BIP - - ! T dependant mixing rule parameters - real(pr), allocatable :: kinf(:, :), tstar(:, :) - real(pr), allocatable :: bij(:, :) - -contains - - subroutine setup(n, nmodel, ntdep, ncomb) - integer, intent(in) :: n - integer, intent(in) :: nmodel - integer, intent(in) :: ntdep - integer, intent(in) :: ncomb - - integer :: stat - - thermo_model = nmodel - tdep = ntdep - mixing_rule = ncomb - nc = n - - allocate(names(n)) - allocate(z(n), stat=stat) - allocate(tc(n)) - allocate(pc(n)) - allocate(dc(n)) - allocate(w(n)) - allocate(ac(n)) - allocate(b(n)) - allocate(del1(n)) - allocate(k(n)) - allocate(kij(n, n)) - allocate(lij(n, n)) - allocate(kinf(n, n)) - allocate(tstar(n, n)) - ! allocate(aij(n, n)) - ! allocate(daijdt(n, n)) - ! allocate(daijdt2(n, n)) - allocate(bij(n, n)) - end subroutine setup - - subroutine destroy() - deallocate(names) - deallocate(z) - deallocate(tc) - deallocate(pc) - deallocate(dc) - deallocate(w) - deallocate(ac) - deallocate(b) - deallocate(del1) - deallocate(k) - deallocate(kij) - deallocate(lij) - deallocate(kinf) - deallocate(tstar) - deallocate(bij) - end subroutine - - subroutine PR78_factory(moles_in, ac_in, b_in, tc_in, pc_in, w_in, k_in) - !! PengRobinson 78 factory - real(pr), intent(in) :: moles_in(nc) - real(pr), optional, intent(in) :: ac_in(nc) - real(pr), optional, intent(in) :: b_in(nc) - real(pr), optional, intent(in) :: tc_in(nc) - real(pr), optional, intent(in) :: pc_in(nc) - real(pr), optional, intent(in) :: w_in(nc) - real(pr), optional, intent(in) :: k_in(nc) - - integer :: i - - logical :: params_spec, critical_spec - real(pr) :: zc(nc), oma(nc), omb(nc) - real(pr) :: vceos(nc), al, be, ga(nc) - real(pr) :: RTc(nc) - - del1 = 1 + sqrt(2.0_pr) - z = moles_in - - params_spec = (present(ac_in) .and. present(b_in) .and. present(k_in)) - critical_spec = (present(tc_in) .and. present(pc_in) .and. present(w_in)) - - if (params_spec) then - ac = ac_in - b = b_in - k = k_in - - call get_Zc_OMa_OMb(del1, zc, oma, omb) - Tc = OMb * ac / (OMa * R* b) - RTc = R * Tc - Pc = OMb * RTc / b - Vceos = Zc * RTc / Pc - al = -0.26992 - be = 1.54226 - ga = 0.37464 - k - w = 0.5 * (-be + sqrt(be**2 - 4 * al * ga)) / al - else if (critical_spec) then - tc = tc_in - pc = pc_in - w = w_in - RTc = R*Tc - - call get_Zc_OMa_OMb(del1, Zc, OMa, OMb) - - ac = OMa * RTc**2 / Pc - b = OMb * RTc / Pc - Vceos = Zc * RTc / Pc - ! k (or m) constant to calculate attractive parameter depending on temperature - do i=1,nc - if (w(i) <= 0.491) then - ! m from PR - k(i) = 0.37464 + 1.54226 * w(i) - 0.26992 * w(i)**2 - else - ! PR78 - k(i) = 0.379642 + 1.48503 * w(i) - 0.164423 * w(i)**2 + 0.016666 * w(i)**3 - end if - end do - end if - end subroutine - - subroutine PR76_factory(moles_in, ac_in, b_in, tc_in, pc_in, w_in, k_in) - !! PengRobinson 76 factory - real(pr), intent(in) :: moles_in(nc) - real(pr), optional, intent(in) :: ac_in(nc) - real(pr), optional, intent(in) :: b_in(nc) - real(pr), optional, intent(in) :: tc_in(nc) - real(pr), optional, intent(in) :: pc_in(nc) - real(pr), optional, intent(in) :: w_in(nc) - real(pr), optional, intent(in) :: k_in(nc) - - integer :: i - - logical :: params_spec, critical_spec - real(pr) :: zc(nc), oma(nc), omb(nc) - real(pr) :: vceos(nc), al, be, ga(nc) - real(pr) :: RTc(nc) - - del1 = 1 + sqrt(2.0_pr) - z = moles_in - - params_spec = (present(ac_in) .and. present(b_in) .and. present(k_in)) - critical_spec = (present(tc_in) .and. present(pc_in) .and. present(w_in)) - - if (params_spec) then - ac = ac_in - b = b_in - k = k_in - - call get_Zc_OMa_OMb(del1, zc, oma, omb) - Tc = OMb * ac / (OMa * R* b) - RTc = R * Tc - Pc = OMb * RTc / b - Vceos = Zc * RTc / Pc - al = -0.26992 - be = 1.54226 - ga = 0.37464 - k - w = 0.5 * (-be + sqrt(be**2 - 4 * al * ga)) / al - else if (critical_spec) then - tc = tc_in - pc = pc_in - w = w_in - RTc = R*Tc - - call get_Zc_OMa_OMb(del1, Zc, OMa, OMb) - - ac = OMa * RTc**2 / Pc - b = OMb * RTc / Pc - Vceos = Zc * RTc / Pc - ! k (or m) constant to calculate attractive parameter depending on temperature - do i=1,nc - k(i) = 0.37464 + 1.54226 * w(i) - 0.26992 * w(i)**2 - end do - end if - end subroutine - - subroutine SRK_factory(moles_in, ac_in, b_in, tc_in, pc_in, w_in, k_in) - !! SoaveRedlichKwong factory - real(pr), intent(in) :: moles_in(nc) - real(pr), optional, intent(in) :: ac_in(nc) - real(pr), optional, intent(in) :: b_in(nc) - real(pr), optional, intent(in) :: tc_in(nc) - real(pr), optional, intent(in) :: pc_in(nc) - real(pr), optional, intent(in) :: w_in(nc) - real(pr), optional, intent(in) :: k_in(nc) - - logical :: params_spec, critical_spec - real(pr) :: zc(nc), oma(nc), omb(nc) - real(pr) :: vceos(nc), al, be, ga(nc) - real(pr) :: RTc(nc) - - del1 = 1 - z = moles_in - - params_spec = (present(ac_in) .and. present(b_in) .and. present(k_in)) - critical_spec = (present(tc_in) .and. present(pc_in) .and. present(w_in)) - - if (params_spec) then - ac = ac_in - b = b_in - k = k_in - - call get_Zc_OMa_OMb(del1, zc, oma, omb) - Tc = OMb * ac / (OMa * R* b) - RTc = R * Tc - Pc = OMb * RTc / b - Vceos = Zc * RTc / Pc - dc = 1/vceos - al = -0.26992 - be = 1.54226 - ga = 0.37464 - k - w = 0.5 * (-be + sqrt(be**2 - 4 * al * ga)) / al - else if (critical_spec) then - tc = tc_in - pc = pc_in - w = w_in - RTc = R * Tc - - call get_Zc_OMa_OMb(del1, Zc, OMa, OMb) - - ac = OMa * RTc**2 / Pc - b = OMb * RTc / Pc - Vceos = Zc * RTc / Pc - - k = 0.48 + 1.574 * w - 0.175 * w**2 - end if - end subroutine - - subroutine get_Zc_OMa_OMb(del1, Zc, OMa, OMb) - !! Calculate Zc, OMa and OMb from the delta_1 parameter. - real(pr), intent(in) :: del1(:) !! delta_1 parameter - real(pr), intent(out) :: Zc(:) !! Critical compressibility factor - real(pr), intent(out) :: OMa(:) !! OMa - real(pr), intent(out) :: OMb(:) !! OMb - - real(pr) :: d1(size(del1)), y(size(del1)) - - d1 = (1._pr + del1**2._pr)/(1._pr + del1) - y = 1._pr + (2._pr*(1._pr + del1))**(1.0_pr/3._pr) + (4._pr/(1._pr + del1))**(1.0_pr/3) - OMa = (3._pr*y*y + 3._pr*y*d1 + d1**2._pr + d1 - 1.0_pr)/(3._pr*y + d1 - 1.0_pr)**2._pr - OMb = 1._pr/(3._pr*y + d1 - 1.0_pr) - Zc = y/(3._pr*y + d1 - 1.0_pr) - end subroutine get_Zc_OMa_OMb - -end module system - -module thermo - use constants, only: pr, R - use system - -contains - - subroutine pressure(v, t, p) - real(pr), intent(in) :: v(:), t - real(pr), intent(out) :: p(size(v)) - - real(pr) :: tmp, ArV, tmpn(nc), tmpn2(nc, nc) - - integer :: i - - do i=1, size(v) - call ArVnder(& - nc, 0, 0, moles, V(i), T, tmp, ArV, & - tmp, tmp, tmpn, tmpn, tmpn, tmpn2 & - ) - - p(i) = R*T/V(i) - ArV - - end do - - end subroutine pressure -end module thermo From bfb923dc81d221860fb7c9e0dae590664fa39e50 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 13:36:09 -0300 Subject: [PATCH 19/48] refactor(eos): Now using legacy eos from yaeos --- app/main.f90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index 943deac..73cc475 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -1,8 +1,6 @@ program main use dtypes, only: envelope - use constants, only: pr - ! use system, only: z, nc - use legacy_ar_models, only: z, nc + use legacy_ar_models, only: nc implicit none real(pr) :: et, st From c7ce25edca2e2986c42f59c690808ddfe91b6e56 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 13:37:10 -0300 Subject: [PATCH 20/48] feat(main): Adding a cli logic to the main program. Now the main program gets part of it's settings from the cli library `flap` --- app/main.f90 | 31 ++++++++++++++++++++++++++----- 1 file changed, 26 insertions(+), 5 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index 73cc475..9c043ee 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -1,21 +1,41 @@ program main use dtypes, only: envelope + use constants, only: pr, ouput_path use legacy_ar_models, only: nc + use flap, only: command_line_interface implicit none real(pr) :: et, st + + type(command_line_interface) :: cli + integer :: cli_error + character(len=99) :: cli_string type(envelope) :: bub_env, dew_env - call setup + call cli%init(progname="envelopes", description="Phase Envelopes") + call cli%add(& + switch="--infile", & + switch_ab="-i", & + help="Input file", & + error=cli_error, & + required=.true.) + call cli%parse(error=cli_error) + + if (cli_error /= 0) stop + + call system("mkdir -p " // trim(ouput_path)) + call system("rm " // trim(ouput_path) // "*") + + call setup ! Setup module variables call cpu_time(st) - call pt_envelopes + call pt_envelopes ! Calculate PT envelopes at the system's composition call cpu_time(et) print *, "PT: ", (et-st) * 1000 , "ms" call cpu_time(st) - call px_envelopes + call px_envelopes ! Calculate Px envelopes call cpu_time(et) print *, "PX: ", (et-st) * 1000 , "ms" contains @@ -23,8 +43,9 @@ subroutine setup use io_nml, only: read_system, write_system use inj_envelopes, only: setup_inj => from_nml integer :: funit_system - character(len=254) :: infile - call get_command_argument(1, value=infile) + character(len=500) :: infile + + call cli%get(val=infile, switch="--infile", error=cli_error) call read_system(trim(infile)) call setup_inj(trim(infile)) From 4377d7443002f7175a5e7402674be72425aa84ea Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 13:38:21 -0300 Subject: [PATCH 21/48] feat(PT): Find intersections between PT lines --- app/main.f90 | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/app/main.f90 b/app/main.f90 index 9c043ee..58d0539 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -118,6 +118,23 @@ subroutine pt_envelopes dew_env%logk = dew_env%logk(i:, :) end if ! ===================================================================== + + ! ====================================================================== + ! Look for crossings + ! ---------------------------------------------------------------------- + check_crossings: block + use linalg, only: point, intersection + type(point), allocatable :: inter(:) + inter = intersection( & + dew_env%t, dew_env%p, & + bub_env%t, bub_env%p & + ) + print *, "Intersections: ", size(inter) + do i = 1, size(inter) + print *, inter(i) + end do + end block check_crossings + ! ====================================================================== end subroutine subroutine px_envelopes From d3fdf40db5563646f0177dba1e21519e5f832249 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 13:41:16 -0300 Subject: [PATCH 22/48] feat(Px): 3ph-Px lines Added the calculation of three-phase Px lines. For now it's a beta-stage, where only a three-phase region is calculated based on finding an intersection. This verifies that the three-phase lines model works properly, and later on more ways of initialization will be implemented. --- app/main.f90 | 59 +++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 58 insertions(+), 1 deletion(-) diff --git a/app/main.f90 b/app/main.f90 index 58d0539..681eff7 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -248,7 +248,64 @@ subroutine px_envelopes do i = 1, size(inter) print *, inter(i) end do - end block check_crossings ! ====================================================================== + three_phase: block + use inj_envelopes, only: del_S + integer :: i, j + real(pr) :: lnKx(nc), lnKy(nc), alpha, beta, X(2*nc+3) + real(pr) :: phase_x(nc), phase_y(nc), z(nc) + type(injelope) :: bub_3 + i = inter(1)%i + j = inter(1)%j + + alpha = inter(1)%x + p = inter(1)%y + + lnKx = interpol(& + dew_envels%alpha(i), dew_envels%alpha(i+1), & + dew_envels%logk(i, :), dew_envels%logk(i+1, :), & + alpha & + ) + + lnKy = interpol(& + bub_envels%alpha(j), bub_envels%alpha(j+1), & + bub_envels%logk(j, :), bub_envels%logk(j+1, :), & + alpha & + ) + + z = alpha * z_injection + (1-alpha) * z_0 + + ! Bubble line composition + phase_y = exp(lnKy) * z + ! Dew line composition + phase_x = exp(lnKx) * z + + ! ==================================================================== + ! Line with incipient phase gas + ! -------------------------------------------------------------------- + lnKx = log(phase_x/phase_y) + lnKy = log(z/phase_y) + beta = 1 + del_S = -0.1_pr + X = [lnKx, lnKy, log(p), alpha, beta] + ns = 2*nc+3 + call injection_envelope_three_phase(X, ns, del_S, bub_3) + + print *, bub_3%critical_points + ! ==================================================================== + + ! ==================================================================== + ! Line with incipient phase liquid + ! -------------------------------------------------------------------- + lnKx = log(phase_y/phase_x) + lnKy = log(z/phase_x) + beta = 1 + del_S = -0.1 + X = [lnKx, lnKy, log(p), alpha, beta] + ns = 2*nc+3 + call injection_envelope_three_phase(X, ns, del_S, bub_3) + ! ==================================================================== + end block three_phase + end block check_crossings end subroutine end program main From 153c83a41715e0b5d8fe36d89507ce5e7534c0bd Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 13:41:39 -0300 Subject: [PATCH 23/48] feat(Px): Detection of intersections --- app/main.f90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index 681eff7..4f28faa 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -240,11 +240,13 @@ subroutine px_envelopes ! ---------------------------------------------------------------------- check_crossings: block use linalg, only: point, intersection - type(point), allocatable :: inter(:) + type(point), allocatable :: inter(:), self_inter(:) inter = intersection( & dew_envels%alpha, dew_envels%p, & - bub_envels%alpha, bub_envels%p & - ) + bub_envels%alpha, bub_envels%p ) + self_inter = intersection(dew_envels%alpha, dew_envels%p) + print *, "Px Intersections: ", size(inter) + print *, "Px Self-Intersections: ", size(self_inter) do i = 1, size(inter) print *, inter(i) end do From e81db16bf7b11357dcafd5f309c25257ada2bd07 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 13:49:30 -0300 Subject: [PATCH 24/48] fprettified --- app/main.f90 | 220 +++++++++++++++++++++++++-------------------------- 1 file changed, 106 insertions(+), 114 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index 4f28faa..858a19d 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -10,34 +10,34 @@ program main type(command_line_interface) :: cli integer :: cli_error character(len=99) :: cli_string - + type(envelope) :: bub_env, dew_env call cli%init(progname="envelopes", description="Phase Envelopes") - call cli%add(& - switch="--infile", & - switch_ab="-i", & - help="Input file", & - error=cli_error, & - required=.true.) + call cli%add( & + switch="--infile", & + switch_ab="-i", & + help="Input file", & + error=cli_error, & + required=.true.) call cli%parse(error=cli_error) if (cli_error /= 0) stop - call system("mkdir -p " // trim(ouput_path)) - call system("rm " // trim(ouput_path) // "*") - - call setup ! Setup module variables + call system("mkdir -p "//trim(ouput_path)) + call system("rm "//trim(ouput_path)//"*") + + call setup ! Setup module variables call cpu_time(st) call pt_envelopes ! Calculate PT envelopes at the system's composition call cpu_time(et) - print *, "PT: ", (et-st) * 1000 , "ms" + print *, "PT: ", (et - st)*1000, "ms" call cpu_time(st) call px_envelopes ! Calculate Px envelopes call cpu_time(et) - print *, "PX: ", (et-st) * 1000 , "ms" + print *, "PX: ", (et - st)*1000, "ms" contains subroutine setup use io_nml, only: read_system, write_system @@ -58,7 +58,7 @@ subroutine setup subroutine pt_envelopes use legacy_ar_models, only: z use envelopes, only: envelope2, max_points, k_wilson_bubble, & - max_points, p_wilson, k_wilson + max_points, p_wilson, k_wilson !! Calculation of PT envelopes of the main system. real(pr), allocatable :: tv(:) ! Temperatures [K] real(pr), allocatable :: pv(:) ! Pressures [bar] @@ -77,26 +77,27 @@ subroutine pt_envelopes allocate (tv(max_points), pv(max_points), dv(max_points)) allocate (k(size(z))) - ! ===================================================================== + ! ======================================================================== ! Bubble envel - ! --------------------------------------------------------------------- + ! ------------------------------------------------------------------------ call k_wilson_bubble(z, t, p, k) call envelope2( & 1, nc, z, T, P, k, & n_points, Tv, Pv, Dv, ncri, icri, Tcri, Pcri, Dcri, & bub_env & ) - ! ===================================================================== + ! ======================================================================== - ! ===================================================================== + ! ======================================================================== ! Dew/AOP envelopes - ! --------------------------------------------------------------------- + ! ------------------------------------------------------------------------ t = 315 p = p_wilson(z, t) do while (p > 0.1) t = t - 5 p = p_wilson(z, t) end do + k = 1/k_wilson(t, p) call envelope2( & @@ -117,57 +118,54 @@ subroutine pt_envelopes dew_env%p = dew_env%p(i:) dew_env%logk = dew_env%logk(i:, :) end if - ! ===================================================================== - - ! ====================================================================== + ! ======================================================================== + + ! ======================================================================== ! Look for crossings - ! ---------------------------------------------------------------------- + ! ------------------------------------------------------------------------ check_crossings: block use linalg, only: point, intersection type(point), allocatable :: inter(:) inter = intersection( & dew_env%t, dew_env%p, & bub_env%t, bub_env%p & - ) + ) print *, "Intersections: ", size(inter) do i = 1, size(inter) print *, inter(i) end do end block check_crossings - ! ====================================================================== + ! ======================================================================== end subroutine subroutine px_envelopes !! Calculation of Px envelopes at selected temperature. - use inj_envelopes, only: F_injection, full_newton, z_injection, & - T_inj => T, injection_envelope, z_0, injection_case, & - injelope + use inj_envelopes, only: full_newton, z_injection, & + T_inj => T, injection_envelope, z_0, & + injelope, injection_envelope_three_phase use envelopes, only: envelope, k_wilson, p_wilson use linalg, only: interpol - real(pr), allocatable :: X(:), F(:), F2(:), dF(:, :), df_num(:, :) - real(pr) :: alpha, S - integer :: ns, i, iters, idx, ti - integer, allocatable :: i_inj(:) - real(pr), allocatable :: ts_envel(:), ts(:) - real(pr) :: t, p + real(pr), allocatable :: X(:) + real(pr) :: alpha + integer :: ns, i, idx + real(pr), allocatable :: ts_envel(:) + real(pr) :: p real(pr), allocatable :: k(:) real(pr) :: t_tol = 2 - type(injelope) :: bub_envels, dew_envels - allocate (X(nc + 2), F(nc + 2), dF(nc + 2, nc + 2), df_num(nc + 2, nc + 2), F2(nc + 2)) - ! ====================================================================== + ! ======================================================================== ! Setup system - ! ---------------------------------------------------------------------- + ! ------------------------------------------------------------------------ alpha = 0.0 z_injection = z_injection/sum(z_injection) ns = nc + 2 - ! ====================================================================== + ! ======================================================================== - ! ====================================================================== + ! ======================================================================== ! Bubble envelope - ! ---------------------------------------------------------------------- + ! ------------------------------------------------------------------------ print *, "Running Bubble" bubble: block real(pr) :: pold @@ -175,8 +173,6 @@ subroutine px_envelopes ts_envel = pack(bub_env%t, mask=abs(bub_env%t - t_inj) < t_tol) do i = 1, size(ts_envel) idx = findloc(bub_env%t, value=ts_envel(i), dim=1) - print *, ts_envel(i) - p = interpol( & bub_env%t(idx), bub_env%t(idx + 1), & bub_env%p(idx), bub_env%p(idx + 1), & @@ -197,11 +193,11 @@ subroutine px_envelopes call injection_envelope(X, ns, 0.01_pr, bub_envels) end do end block bubble - ! ====================================================================== + ! ======================================================================== - ! ====================================================================== + ! ======================================================================== ! Dew envelope - ! ---------------------------------------------------------------------- + ! ------------------------------------------------------------------------ print *, "Running Dew" dew: block real(pr) :: pold @@ -209,9 +205,7 @@ subroutine px_envelopes ts_envel = pack(dew_env%t, mask=abs(dew_env%t - t_inj) < t_tol) do i = 1, size(ts_envel) idx = findloc(dew_env%t, value=ts_envel(i), dim=1) - alpha = 0 - p = interpol( & dew_env%t(idx), dew_env%t(idx + 1), & dew_env%p(idx), dew_env%p(idx + 1), & @@ -219,95 +213,93 @@ subroutine px_envelopes if (abs(p - pold) < 5) cycle pold = p - print *, ts_envel(i), p - k = exp(interpol( & dew_env%t(idx), dew_env%t(idx + 1), & dew_env%logk(idx, :), dew_env%logk(idx + 1, :), & t_inj)) X(1:nc) = log(K) - X(nc+1) = log(P) - X(nc+2) = alpha + X(nc + 1) = log(P) + X(nc + 2) = alpha call injection_envelope(X, ns, 0.01_pr, dew_envels) end do end block dew - ! ====================================================================== + ! ======================================================================== - ! ====================================================================== + ! ======================================================================== ! Look for crossings - ! ---------------------------------------------------------------------- + ! ------------------------------------------------------------------------ check_crossings: block use linalg, only: point, intersection type(point), allocatable :: inter(:), self_inter(:) inter = intersection( & dew_envels%alpha, dew_envels%p, & - bub_envels%alpha, bub_envels%p ) + bub_envels%alpha, bub_envels%p) self_inter = intersection(dew_envels%alpha, dew_envels%p) print *, "Px Intersections: ", size(inter) print *, "Px Self-Intersections: ", size(self_inter) do i = 1, size(inter) print *, inter(i) end do - ! ====================================================================== - three_phase: block - use inj_envelopes, only: del_S - integer :: i, j - real(pr) :: lnKx(nc), lnKy(nc), alpha, beta, X(2*nc+3) - real(pr) :: phase_x(nc), phase_y(nc), z(nc) - type(injelope) :: bub_3 - i = inter(1)%i - j = inter(1)%j - - alpha = inter(1)%x - p = inter(1)%y - - lnKx = interpol(& - dew_envels%alpha(i), dew_envels%alpha(i+1), & - dew_envels%logk(i, :), dew_envels%logk(i+1, :), & - alpha & - ) - - lnKy = interpol(& - bub_envels%alpha(j), bub_envels%alpha(j+1), & - bub_envels%logk(j, :), bub_envels%logk(j+1, :), & - alpha & - ) - - z = alpha * z_injection + (1-alpha) * z_0 - - ! Bubble line composition - phase_y = exp(lnKy) * z - ! Dew line composition - phase_x = exp(lnKx) * z - - ! ==================================================================== - ! Line with incipient phase gas - ! -------------------------------------------------------------------- - lnKx = log(phase_x/phase_y) - lnKy = log(z/phase_y) - beta = 1 - del_S = -0.1_pr - X = [lnKx, lnKy, log(p), alpha, beta] - ns = 2*nc+3 - call injection_envelope_three_phase(X, ns, del_S, bub_3) - - print *, bub_3%critical_points - ! ==================================================================== - - ! ==================================================================== - ! Line with incipient phase liquid - ! -------------------------------------------------------------------- - lnKx = log(phase_y/phase_x) - lnKy = log(z/phase_x) - beta = 1 - del_S = -0.1 - X = [lnKx, lnKy, log(p), alpha, beta] - ns = 2*nc+3 - call injection_envelope_three_phase(X, ns, del_S, bub_3) - ! ==================================================================== - end block three_phase + ! ===================================================================== + three_phase: block + use inj_envelopes, only: del_S + integer :: i, j + real(pr) :: lnKx(nc), lnKy(nc), alpha, beta, X(2*nc + 3) + real(pr) :: phase_x(nc), phase_y(nc), z(nc) + type(injelope) :: bub_3 + i = inter(1)%i + j = inter(1)%j + + alpha = inter(1)%x + p = inter(1)%y + + lnKx = interpol( & + dew_envels%alpha(i), dew_envels%alpha(i + 1), & + dew_envels%logk(i, :), dew_envels%logk(i + 1, :), & + alpha & + ) + + lnKy = interpol( & + bub_envels%alpha(j), bub_envels%alpha(j + 1), & + bub_envels%logk(j, :), bub_envels%logk(j + 1, :), & + alpha & + ) + + z = alpha*z_injection + (1 - alpha)*z_0 + + ! Bubble line composition + phase_y = exp(lnKy)*z + ! Dew line composition + phase_x = exp(lnKx)*z + + ! ================================================================== + ! Line with incipient phase gas + ! ------------------------------------------------------------------ + lnKx = log(phase_x/phase_y) + lnKy = log(z/phase_y) + beta = 1 + del_S = -0.1_pr + X = [lnKx, lnKy, log(p), alpha, beta] + ns = 2*nc + 3 + call injection_envelope_three_phase(X, ns, del_S, bub_3) + + print *, bub_3%critical_points + ! ================================================================== + + ! ================================================================== + ! Line with incipient phase liquid + ! ------------------------------------------------------------------ + lnKx = log(phase_y/phase_x) + lnKy = log(z/phase_x) + beta = 1 + del_S = -0.1 + X = [lnKx, lnKy, log(p), alpha, beta] + ns = 2*nc + 3 + call injection_envelope_three_phase(X, ns, del_S, bub_3) + ! ================================================================== + end block three_phase end block check_crossings end subroutine end program main From fc927b545a9da5cf35774a60e8f9b238a9891b20 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 13:49:55 -0300 Subject: [PATCH 25/48] New dependencies --- fpm.toml | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/fpm.toml b/fpm.toml index a56dc48..fca5b20 100644 --- a/fpm.toml +++ b/fpm.toml @@ -6,7 +6,7 @@ maintainer = "fedebenelli@outlook.com" copyright = "Copyright 2023, Federico E. Benelli" [build] -link = "lapack" +link = ["lapack", "minpack"] auto-executables = true auto-tests = true auto-examples = true @@ -17,7 +17,14 @@ library = false [dependencies] ftools = { git = "https://github.com/fedebenelli/ftools" } yaeos = { git = "https://github.com/fedebenelli/yaeos" } +FLAP = { git = "https://github.com/szaghi/FLAP", tag="v1.2.5" } +fordiff = {git="https://github.com/gha3mi/fordiff.git"} +forsolver = { git="https://github.com/gha3mi/forsolver.git" } [fortran] -implicit-external = false # default: false -implicit-typing = false # default: false \ No newline at end of file +implicit-external = true # default: false +implicit-typing = false # default: false + +[preprocess] +[preprocess.cpp] +[preprocess.fypp] From 65be855ca67401db937734ed3353ae01c567465c Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 13:51:01 -0300 Subject: [PATCH 26/48] refactor(PT): Minor details --- src/new/envelopes.f90 | 16 ++++------------ 1 file changed, 4 insertions(+), 12 deletions(-) diff --git a/src/new/envelopes.f90 b/src/new/envelopes.f90 index 6fdf2e8..cc2e501 100644 --- a/src/new/envelopes.f90 +++ b/src/new/envelopes.f90 @@ -281,10 +281,9 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e ! Intermediate variables during calculation process real(pr), dimension(n) :: y - integer, dimension(n + 2) :: ipiv real(pr), dimension(n + 2) :: X, Xold, Xold2, delX, bd, F, dFdS, dXdS real(pr), dimension(n + 2, n + 2) :: JAC, AJ - real(pr) :: Vy, Vx + real(pr) :: Vx logical :: run, passingcri, minT, minmaxT character(len=:), allocatable :: incipient_phase @@ -320,16 +319,16 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e integer :: funit_output character(len=254) :: fname_env - ! ============================================================================= + ! ======================================================================== ! OUTPUT file - ! ----------------------------------------------------------------------------- + ! ------------------------------------------------------------------------ env_number = env_number + 1 write(fname_env, *) env_number fname_env = "env-2ph-PT" // "_" // trim(adjustl(fname_env)) fname_env = trim(adjustl(ouput_path)) // trim(fname_env) // ".dat" open(newunit=funit_output, file=fname_env) - ! ============================================================================= + ! ======================================================================== ! Initialize with zero Tv and Pv allocate(this_envelope%vars(max_points-50, n+2)) @@ -447,13 +446,8 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e Tv(i) = T Pv(i) = P - Dv(i) = 1/Vx ! saturated phase density this_envelope%vars(i, :) = X - tmp_logk(i, :n) = X(:n) - ! tmp_logphi(i, :n) = philogx(:n) - - ! rho_y = 1/Vy incipient phase density if (incipient_phase == "2ndliquid" .and. P < 0.1) then ! isolated LL line detected. @@ -461,11 +455,9 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e run = .false. end if - ! print *, incipient_phase, i, T, P, ns, iter if (i > max_points - 50) exit if (sum(X(:n) * Xold(:n)) < 0) then ! critical point detected - print *, "Found critical!" ncri = ncri + 1 icri(ncri) = i - 1 frac = -Xold(ns)/(X(ns) - Xold(ns)) From c0ad1551a93bdd186da1f9c2f7bffc0bcd07644a Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 13:52:03 -0300 Subject: [PATCH 27/48] feat(PX): Added calculation routines for 3ph-Px --- src/new/mod_inj_envelopes.f90 | 410 ++++++++++++++++++++++++---------- 1 file changed, 296 insertions(+), 114 deletions(-) diff --git a/src/new/mod_inj_envelopes.f90 b/src/new/mod_inj_envelopes.f90 index b36daa2..8b133b2 100644 --- a/src/new/mod_inj_envelopes.f90 +++ b/src/new/mod_inj_envelopes.f90 @@ -128,120 +128,144 @@ subroutine F_injection(X, ns, S, F, dF) df(n+2, ns) = 1 end subroutine -! subroutine F_injection_three_phases(Xvars, ns, S, F, dF) -! !! Function to solve at each point of the phase envelope. -! !! -! !! The vector of variables X corresponds to: -! !! \( X = [lnK_i, lnP, \alpha] \) -! !! -! !! While the equations are: -! !! -! !! \( F = [lnK_i - ln \phi_i(y, P, T) + ln \phi_i(z, P, T), -! !! \sum_{i=1}^N, X_{ns} - S] \) -! !! -! !! The injection can be considered as two kinds of injection: -! !! - Displacement: \( z = \alpha z_i + (1-\alpha) z_0 \) -! !! - Addition: \( z = \frac{\alpha z_i + (1-\alpha) z_0}{\sum_{i=1}^N \alpha z_i + (1-\alpha) z_0} \) -! -! use iso_fortran_env, only: error_unit -! real(pr), intent(in) :: Xvars(:) !! Vector of variables -! integer, intent(in) :: ns !! Number of specification -! real(pr), intent(in) :: S !! Specification value -! real(pr), intent(out) :: F(size(Xvars)) !! Vector of functions valuated -! real(pr), intent(out) :: df(size(Xvars), size(Xvars)) !! Jacobian matrix -! -! ! Xvars variables -! real(pr) :: Kx(size(Xvars) - 2) -! real(pr) :: Ky(size(Xvars) - 2) -! real(pr) :: P -! real(pr) :: beta -! real(pr) :: alpha -! -! ! Main phase 1 variables -! real(pr) :: Vx -! real(pr), dimension(size(Xvars)-2) :: x, lnfug_x, dlnphi_dt_x, dlnphi_dp_x -! real(pr), dimension(size(Xvars)-2, sixe(Xvars)-2) :: dlnphi_dn_x -! -! ! Main phase 2 variables -! real(pr) :: Vy -! real(pr), dimension(size(Xvars)-2) :: y, lnfug_y, dlnphi_dt_y, dlnphi_dp_y -! real(pr), dimension(size(Xvars)-2, size(Xvars)-2) :: dlnphi_dn_y -! -! ! Incipient phase variables -! real(pr) :: Vw -! real(pr), dimension(size(Xvars)-2) :: w, lnfug_w, dlnphi_dt_w, dlnphi_dp_w -! real(pr), dimension(size(Xvars)-2, size(Xvars)-2) :: dlnphi_dn_w -! -! ! Derivative of z wrt alpha -! real(pr) :: dzda(size(Xvars)-2) -! -! integer :: i, j, n -! -! n = size(Xvars) - 2 -! Kx = exp(Xvars(1:n)) -! Ky = exp(Xvars(n+1:2*n)) -! P = exp(Xvars(2*n+1)) -! beta = Xvars(2*n+3) -! alpha = Xvars(2*n+3) -! -! select case(injection_case) -! case("displace") -! z = (z_injection * alpha + (1.0_pr - alpha) * z_0) -! dzda = z_injection - z_0 -! case("dilute") -! z = (z_injection * alpha + z_0)/sum(z_injection * alpha + z_0) -! dzda = -(alpha*z_injection + z_0) & -! * sum(z_injection) / sum(alpha*z_injection + z_0)**2 & -! + z_injection / sum(alpha*z_injection + z_0) -! case default -! z = (z_injection * alpha + (1.0_pr - alpha) * z_0) -! dzda = z_injection - z_0 -! end select -! if (any(z < 0)) z = 0 -! -! w = z / (beta * Ky + (1-beta) * Kx) -! x = w * Kx -! y = w * Ky -! -! -! call TERMO(n, 0, 4, T, P, y, Vy, lnfug_y, dlnphi_dp_y, dlnphi_dt_y, dlnphi_dn_y) -! call TERMO(n, 0, 4, T, P, x, Vx, lnfug_x, dlnphi_dp_x, dlnphi_dt_x, dlnphi_dn_x) -! call TERMO(n, 0, 4, T, P, w, Vw, lnfug_w, dlnphi_dp_w, dlnphi_dt_w, dlnphi_dn_w) -! -! F(1:n) = X(:n) + lnfug_x - lnfug_w -! F(n+1:2*n) = X(n+1:2*n) + lnfug_y - lnfug_w -! -! F(2*n+1) = sum(w - 1) -! F(2*n+2) = sum(x - y) -! F(2*n+3) = X(ns) - S -! -! df = 0 -! -! do i=1,n -! do j=1,n -! ! Derivatives wrt Kx -! df(i, j) = x(j) * dlnphi_dn_x(i, j) + w(j)**2 * dlnphi_dn_w(i, j) -! df(i+n, j) = w(j)**2 * dlnphi_dn_w(i, j) -! end do -! -! do j=n+1,2*n -! ! Derivatives wrt Ky -! df(i, j) = w(j-n)**2 * dlnphi_dn_w(i, j-n) -! df(i+n, j) = y(j-n)* dlnphi_dn_y(i, j-n) + w(j-n)**2 * dlnphi_dn_w(i, j-n) -! end do -! -! df(i, i) = df(i, i) + 1 -! ! df(i, n+2) = sum(K * dlnphi_dn_y(i, :) * dzda - dlnphi_dn_z(i, :) * dzda) -! end do -! -! df(:n, 2*n+1) = P * (dlnphi_dp_x - dlnphi_dp_w) -! df(n+1:2*n, 2*n+1) = P * (dlnphi_dp_y - dlnphi_dp_w) -! -! df(n+1, n+2) = sum(dzda*(K-1)) -! -! df(n+2, :) = 0 -! df(n+2, ns) = 1 -! end subroutine + subroutine F_injection_three_phases(Xvars, ns, S, F, dF) + use legacy_ar_models, only: TERMO + !! Function to solve at each point of a three phase envelope. + !! + !! The vector of variables X corresponds to: + !! \( X = [lnKx_i, lnKy_i lnP, \alpha, \beta] \) + !! + !! While the equations are: + !! + !! \( F = [ + !! lnKx_i - ln \phi_i(x, P, T) + ln \phi_i(w, P, T), + !! lnKy_i - ln \phi_i(y, P, T) + ln \phi_i(w, P, T), + !! \sum_{i=1}^N (w_i) - 1, + !! \sum_{i=1}^N (x_i - y_i), + !! X_{ns} - S + !! ] \) + use iso_fortran_env, only: error_unit + real(pr), intent(in) :: Xvars(:) !! Vector of variables + integer, intent(in) :: ns !! Number of specification + real(pr), intent(in) :: S !! Specification value + real(pr), intent(out) :: F(size(Xvars)) !! Vector of functions valuated + real(pr), intent(out) :: df(size(Xvars), size(Xvars)) !! Jacobian matrix + +#define N (size(Xvars) - 3 )/2 + ! Xvars variables + real(pr) :: z(N) + real(pr) :: Kx(N) + real(pr) :: Ky(N) + real(pr) :: P + real(pr) :: beta + real(pr) :: alpha + + ! Main phase 1 variables + real(pr) :: Vx + real(pr), dimension(N) :: x, lnfug_x, dlnphi_dt_x, dlnphi_dp_x + real(pr), dimension(N, N) :: dlnphi_dn_x + + ! Main phase 2 variables + real(pr) :: Vy + real(pr), dimension(N) :: y, lnfug_y, dlnphi_dt_y, dlnphi_dp_y + real(pr), dimension(N, N) :: dlnphi_dn_y + + ! Incipient phase variables + real(pr) :: Vw + real(pr), dimension(N) :: w, lnfug_w, dlnphi_dt_w, dlnphi_dp_w + real(pr), dimension(N, N) :: dlnphi_dn_w + + ! Derivative of z wrt alpha + real(pr) :: dzda(N), dwda(N) + + ! Derivative of w wrt beta + real(pr) :: dwdb(N) + + real(pr) :: dwdKx(N), dxdKx(N), dydKx(N) + real(pr) :: dwdKy(N), dxdKy(N), dydKy(N) + + integer :: i, j, n + + n = N +#undef N + + Kx = exp(Xvars(1:n)) + Ky = exp(Xvars(n+1:2*n)) + P = exp(Xvars(2*n+1)) + alpha = Xvars(2*n+2) + beta = Xvars(2*n+3) + + call get_z(alpha, z, dzda) + if (any(z < 0)) z = 0 + + w = z / (beta * Ky + (1-beta) * Kx) + x = w * Kx + y = w * Ky + + call TERMO(n, 0, 4, T, P, x, Vx, lnfug_x, dlnphi_dp_x, dlnphi_dt_x, dlnphi_dn_x) + call TERMO(n, 0, 4, T, P, y, Vy, lnfug_y, dlnphi_dp_y, dlnphi_dt_y, dlnphi_dn_y) + call TERMO(n, 0, 4, T, P, w, Vw, lnfug_w, dlnphi_dp_w, dlnphi_dt_w, dlnphi_dn_w) + + F(1:n) = Xvars(1:n) + lnfug_x - lnfug_w + F(n+1:2*n) = Xvars(n+1:2*n) + lnfug_y - lnfug_w + + F(2*n+1) = sum(w) - 1 + F(2*n+2) = sum(x - y) + F(2*n+3) = Xvars(ns) - S + + df = 0 + dwda = 1.0_pr / (beta * Ky + (1-beta) * Kx) * dzda + dwdb = z * (Kx - Ky) / ((1 - beta) * Kx + beta * Ky)**2 + + dwdKx = -z * (1-beta) / (Ky*beta + (1-beta)*Kx)**2 + dxdKx = Kx * dwdKx + w + dydKx = Ky * dwdKx + + dwdKy = -z * (beta) / (Ky*beta + (1-beta)*Kx)**2 + dxdKy = Kx * dwdKy + dydKy = Ky * dwdKy + w + + do i=1,n + do j=1,n + df(i, j) = Kx(j) * (dlnphi_dn_x(i, j) * dxdKx(j) - dlnphi_dn_w(i,j) * dwdKx(j)) + df(i+n, j) = Kx(j) * (dlnphi_dn_y(i, j) * dydKx(j) - dlnphi_dn_w(i,j) * dwdKx(j)) + + df(i, j+n) = Ky(j) * (dlnphi_dn_x(i, j) * dxdKy(j) - dlnphi_dn_w(i,j) * dwdKy(j)) + df(i+n, j+n) = Ky(j) * (dlnphi_dn_y(i, j) * dydKy(j) - dlnphi_dn_w(i,j) * dwdKy(j)) + end do + + df(i, i) = df(i, i) + 1 + df(i+n, i+n) = df(i+n, i+n) + 1 + + df(i, 2*n+2) = sum(Kx * dlnphi_dn_x(i, :) * dwda - dlnphi_dn_w(i, :) * dwda) + df(i+n, 2*n+2) = sum(Ky * dlnphi_dn_y(i, :) * dwda - dlnphi_dn_w(i, :) * dwda) + + df(i, 2*n+3) = sum(Kx * dlnphi_dn_x(i, :) * dwdb - dlnphi_dn_w(i, :) * dwdb) + df(i+n, 2*n+3) = sum(Ky * dlnphi_dn_y(i, :) * dwdb - dlnphi_dn_w(i, :) * dwdb) + + df(2*n+1, i) = Kx(i) * dwdKx(i) + df(2*n+1, i+n) = Ky(i) * dwdKy(i) + + df(2*n+2, i) = Kx(i) * dxdKx(i) - Kx(i) * dydKx(i) + df(2*n+2, i+n) = Ky(i) * dxdKy(i) - Ky(i) * dydKy(i) + end do + + ! Derivatives wrt P + df(:n, 2*n+1) = P * (dlnphi_dp_x - dlnphi_dp_w) + df(n+1:2*n, 2*n+1) = P * (dlnphi_dp_y - dlnphi_dp_w) + + ! Derivatives wrt alpha + df(2*n+1, 2*n+2) = sum(dwda) + df(2*n+2, 2*n+2) = sum(Kx * dwda - Ky * dwda) + + ! Derivatives wrt beta + df(2*n+1, 2*n+3) = sum(dwdb) + df(2*n+2, 2*n+3) = sum(Kx * dwdb - Ky * dwdb) + + ! Derivatives wrt Xs + df(2*n+3, :) = 0 + df(2*n+3, ns) = 1 + end subroutine subroutine injection_envelope(X0, spec_number, del_S0, envels) use constants, only: ouput_path @@ -391,6 +415,164 @@ subroutine injection_envelope(X0, spec_number, del_S0, envels) envels%p = exp(XS(:point, n+1)) envels%critical_points = cps end subroutine + + subroutine injection_envelope_three_phase(X0, spec_number, del_S0, envels) + use constants, only: ouput_path + !! Subroutine to calculate Px phase envelopes via continuation method. + !! Three phases version. + real(pr), intent(in) :: X0(:) !! Vector of variables + integer, intent(in) :: spec_number !! Number of specification + real(pr), intent(in) :: del_S0 !! \(\Delta S_0\) + type(injelope), intent(out) :: envels !! Calculated envelopes + + type(critical_point), allocatable :: cps(:) + + real(pr) :: X(size(X0)) + integer :: ns + real(pr) :: S + real(pr) :: XS(max_points, size(X0)) + + real(pr) :: F(size(X0)), dF(size(X0), size(X0)), dXdS(size(X0)) + + integer :: point, iters, n + integer :: i + integer :: funit_output + character(len=254) :: fname_env + + allocate(cps(0)) + X = X0 + n = (size(X0) - 3)/2 + ns = spec_number + S = X(ns) + del_S = del_S0 + + ! ====================================================================== + ! Output file + ! ---------------------------------------------------------------------- + env_number = env_number + 1 + + write(fname_env, *) env_number + fname_env = "env-3ph-PX" // "_" // trim(adjustl(fname_env)) + fname_env = trim(adjustl(ouput_path)) // trim(fname_env) // ".dat" + + open(newunit=funit_output, file=fname_env) + write(funit_output, * ) "#", T + write(funit_output, *) "X0", iters, ns, X(2*n+2), exp(X(2*n+1)), X(2*n+3), X(:2*n) + ! ====================================================================== + + enveloop: do point=1, max_points + call full_newton(F_injection_three_phases, iters, X, ns, S, F, dF) + if (iters >= max_iters) then + exit enveloop + end if + + write(funit_output, *) "SOL", iters, ns, X(2*n+2), exp(X(2*n+1)), X(2*n+3), X(:2*n) + XS(point, :) = X + + update_spec: block + real(pr) :: dFdS(size(X0)) + integer :: ns_new + + dFdS = 0 + ! Actually it's -dFdS + dFdS(2*n+3) = 1 + + dXdS = solve_system(dF, dFdS) + + + if (maxval(abs(X(:2*n))) < 1) then + ns_new = maxloc(abs(dXdS(:2*n)), dim=1) ! T and P not allowed to be chosen close to a critical point + else + ns_new = maxloc(abs(dXdS), dim=1) + end if + + if (ns_new /= ns) then + del_S = dXdS(ns_new) * del_S ! translation of delS to the new specification variable + dXdS = dXdS/dXdS(ns_new) + ns = ns_new + end if + + del_S = sign(1.0_pr, del_S) * minval( [ & + max(sqrt(abs(X(ns))), 0.1), & + abs(del_S) * 3/iters & + ] & + ) + + if (injection_case == "dilution") del_S = 50*del_S + end block update_spec + + fix_step: block + real(pr) :: Xnew(size(X0)) + real(pr) :: dP, dalpha + + Xnew = X + dXdS * del_S + dP = exp(Xnew(2*n+1)) - exp(X(n+1)) + dalpha = Xnew(2*n+2) - X(n+2) + + do while (abs(dP) > 50 .or. abs(dalpha) > 0.03) + dXdS = dXdS/10.0_pr + + Xnew = X + dXdS * del_S + dP = exp(Xnew(2*n+1)) - exp(X(2*n+1)) + dalpha = Xnew(2*n+2) - X(2*n+2) + end do + end block fix_step + + detect_critical: block + real(pr) :: K((size(X0) - 3)/2), Knew((size(X0) - 3)/2), Xnew(size(X0)), fact + real(pr) :: pc, alpha_c, dS_c, dXdS_in(size(X0)) + integer :: max_changing, i + fact = 15.0_pr + + Xnew = X + fact * dXdS * del_S + do i=0,1 + K = X(i*n+1:(i+1)*n) + Knew = Xnew(i*n+1:(i+1)*n) + max_changing = minloc(abs(Knew - K), dim=1) + + if (all(K * Knew < 0)) then + dS_c = - k(max_changing) * (Xnew(ns) - X(ns))/(Knew(max_changing) - K(max_changing)) + del_S = sign(15.0_pr, dS_c) ! dS_c * 15_pr + + Xnew = X + dXdS * dS_c + alpha_c = Xnew(2*n+2) + pc = exp(Xnew(2*n+1)) + + cps = [cps, critical_point(t, pc, alpha_c)] + write(funit_output, *) "" + write(funit_output, *) "" + end if + end do + end block detect_critical + + if (x(2*n+3) > 1) exit enveloop + + X = X + dXdS * del_S + S = X(ns) + if (any(break_conditions_three_phases(X, ns, S))) exit enveloop + end do enveloop + + point = point - 1 + + write(funit_output, *) "" + write(funit_output, *) "" + write(funit_output, *) "#critical" + if (size(cps) > 0) then + do i=1,size(cps) + write(funit_output, *) cps(i)%alpha, cps(i)%p + end do + else + write(funit_output, *) "NaN NaN" + endif + + close(funit_output) + envels%z = z_0 + envels%z_inj = z_injection + envels%logk = XS(:point, :n) + envels%alpha = XS(:point, n+2) + envels%p = exp(XS(:point, n+1)) + envels%critical_points = cps + end subroutine subroutine full_newton(fun, iters, X, ns, S, F, dF) !! Subroutine to solve a point in the envelope. From 0a11ce6de17f0898632ef6dddc6cd0f98e374c5a Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 13:52:28 -0300 Subject: [PATCH 28/48] fix(newton): Newton solver details --- src/new/mod_inj_envelopes.f90 | 45 +++++++++++++++++++---------------- 1 file changed, 24 insertions(+), 21 deletions(-) diff --git a/src/new/mod_inj_envelopes.f90 b/src/new/mod_inj_envelopes.f90 index 8b133b2..3da227f 100644 --- a/src/new/mod_inj_envelopes.f90 +++ b/src/new/mod_inj_envelopes.f90 @@ -587,35 +587,38 @@ subroutine fun(X, ns, S, F, dF) real(pr), intent(out) :: dF(size(X), size(X)) end subroutine end interface - integer, intent(out) :: iters !! Number of iterations needed - real(pr), intent(in out) :: X(:) !! Variables vector - integer, intent(in) :: ns !! Number of specification - real(pr), intent(in) :: S !! Specification value - real(pr), intent(out) :: F(size(X)) !! Function values at solved point - real(pr), intent(out) :: df(size(X), size(X)) !! Jacobian values + integer, intent(out) :: iters !! Number of iterations needed + real(pr), intent(in out) :: X(:) !! Variables vector + integer, intent(in) :: ns !! Number of specification + real(pr), intent(in) :: S !! Specification value + real(pr), intent(out) :: F(size(X)) !! Function values at solved point + real(pr), intent(out) :: df(size(X), size(X)) !! Jacobian values - real(pr) :: b(size(X)), A(size(X), size(X)) + real(pr) :: b(size(X)), A(size(X), size(X)) - real(pr) :: dX(size(X)), tol=1e-5 + real(pr) :: dX(size(X)), tol=1e-5 - dX = 20 + integer :: n, info + integer :: i - newton: do iters=1, max_iters*10 - if (maxval(abs(dx)) < tol) exit newton - call fun(X, ns, S, b, A) + n = size(X) + dX = 20 - b = -b - dX = solve_system(A, b) + newton: do iters=1, max_iters*10 + if (maxval(abs(dx)) < tol) exit newton + call fun(X, ns, S, b, a) + b = -b + dX = solve_system(A, b) - do while (maxval(abs(dX)) > 1) - dX = dX/10 - end do + do while (maxval(abs(dx)) > 0.5*maxval(abs(x))) + dX = dX/2 + end do - X = X + dX - end do newton + X = X + dX + end do newton - F = b - dF = A + F = -b + dF = A end subroutine function break_conditions(X, ns, S) From 18e4d9c3f073c5b1aa7eb8d50f3e447d0b2b60e5 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 13:53:05 -0300 Subject: [PATCH 29/48] feat(PX): Delimited some break conditions for solving --- src/new/mod_inj_envelopes.f90 | 31 +++++++++++++++++++++++++------ 1 file changed, 25 insertions(+), 6 deletions(-) diff --git a/src/new/mod_inj_envelopes.f90 b/src/new/mod_inj_envelopes.f90 index 3da227f..8a071ed 100644 --- a/src/new/mod_inj_envelopes.f90 +++ b/src/new/mod_inj_envelopes.f90 @@ -622,10 +622,10 @@ subroutine fun(X, ns, S, F, dF) end subroutine function break_conditions(X, ns, S) - !! Set of conditions to break the tracing. - real(pr) :: X(:) - integer :: ns - real(pr) :: S + !! Set of conditions to break the tracing of a two phase line. + real(pr) :: X(:) !! Vector of variables + integer :: ns !! Number of specification + real(pr) :: S !! Specification value integer :: n real(pr) :: p, alpha @@ -636,8 +636,27 @@ function break_conditions(X, ns, S) alpha = X(n+2) break_conditions = [& - p < 10 .or. p > 1000, & - abs(del_S) < 1e-8 & + p < 10 .or. p > 2000, & + abs(del_S) < 1e-18 & + ] + end function + + function break_conditions_three_phases(X, ns, S) + !! Set of conditions to break the tracing. + real(pr) :: X(:) !! Variables vector + integer :: ns !! Number of specification + real(pr) :: S !! Value of specification + + integer :: n + real(pr) :: p, alpha + logical, allocatable :: break_conditions_three_phases(:) + + n = (size(X) - 3)/2 + p = exp(X(2*n+1)) + alpha = X(2*n+2) + + break_conditions_three_phases = [& + p < 10 .or. p > 3000 & ] end function end module From bd704ff1102653df83759d7c98c7a960dc7d4bba Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 13:53:37 -0300 Subject: [PATCH 30/48] refactor(Px): Moved out calculation of z and dzda --- src/new/mod_inj_envelopes.f90 | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/src/new/mod_inj_envelopes.f90 b/src/new/mod_inj_envelopes.f90 index 8a071ed..18928b5 100644 --- a/src/new/mod_inj_envelopes.f90 +++ b/src/new/mod_inj_envelopes.f90 @@ -659,4 +659,30 @@ function break_conditions_three_phases(X, ns, S) p < 10 .or. p > 3000 & ] end function + + subroutine get_z(alpha, z, dzda) + !! Calculate the fluid composition based on an amount of addition + !! of second fluid. + !! + !! The injection can be considered as two kinds of injection: + !! - Displacement: \( z = \alpha z_i + (1-\alpha) z_0 \) + !! - Addition: \( z = \frac{\alpha z_i + (1-\alpha) z_0}{\sum_{i=1}^N \alpha z_i + (1-\alpha) z_0} \) + real(pr), intent(in) :: alpha !! Addition percentaje \( \alpha \) + real(pr), intent(out) :: z(size(z_0)) !! New composition + real(pr), intent(out) :: dzda(size(z_0)) !! Derivative wrt \(\alpha\) + + select case(injection_case) + case("displace") + z = (z_injection * alpha + (1.0_pr - alpha) * z_0) + dzda = z_injection - z_0 + case("dilute") + z = (z_injection * alpha + z_0)/sum(z_injection * alpha + z_0) + dzda = -(alpha*z_injection + z_0) & + * sum(z_injection) / sum(alpha*z_injection + z_0)**2 & + + z_injection / sum(alpha*z_injection + z_0) + case default + z = (z_injection * alpha + (1.0_pr - alpha) * z_0) + dzda = z_injection - z_0 + end select + end subroutine end module From a3d0bba9da787378155a83ed8add40b55f1a6d91 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 14:30:14 -0300 Subject: [PATCH 31/48] refactor(Px_mod): Format --- src/new/mod_inj_envelopes.f90 | 938 +++++++++++++++++----------------- 1 file changed, 483 insertions(+), 455 deletions(-) diff --git a/src/new/mod_inj_envelopes.f90 b/src/new/mod_inj_envelopes.f90 index 18928b5..e3cfddc 100644 --- a/src/new/mod_inj_envelopes.f90 +++ b/src/new/mod_inj_envelopes.f90 @@ -1,41 +1,42 @@ module inj_envelopes - !! Module to calculate Px phase envelopes + !! Module to calculate Px phase envelopes use constants, only: pr, R use dtypes, only: envelope, critical_point use linalg, only: solve_system, interpol implicit none - integer :: env_number = 0 - type, extends(envelope) :: injelope real(pr), allocatable :: alpha(:) !! Ammount of injected fluid real(pr), allocatable :: z_inj(:) !! Injected fluid composition real(pr), allocatable :: z_mix(:, :) !! Composition at each step end type + ! ========================================================================== + ! Parameters + ! -------------------------------------------------------------------------- + integer :: env_number = 0 !! Number of calculated envelope integer :: max_iters = 500 !! Maximum number of iterations for a newton step - integer, parameter :: max_points = 800 !! Maximum number of points for each envelope + integer, parameter :: max_points = 1000 !! Maximum number of points for each envelope real(pr), allocatable :: z_0(:) !! Original fluid composition real(pr), allocatable :: z_injection(:) !! Injection fluid composition real(pr) :: T !! Temperature of injection real(pr) :: del_S = 0.1 !! Specificiation variation character(len=10) :: injection_case !! Kind of injection displace|dilute + ! ========================================================================== contains - subroutine from_nml(filepath) - ! use system, only: nc - use legacy_ar_models, only: nc - character(len=*), intent(in) :: filepath - integer :: funit + use legacy_ar_models, only: nc + character(len=*), intent(in) :: filepath + integer :: funit - namelist /nml_px/ T ,z_0, z_injection, injection_case + namelist /nml_px/ T, z_0, z_injection, injection_case - allocate(z_0(nc), z_injection(nc)) + allocate (z_0(nc), z_injection(nc)) - open(newunit=funit, file=filepath) - read(funit, nml=nml_px) - close(funit) + open (newunit=funit, file=filepath) + read (funit, nml=nml_px) + close (funit) end subroutine subroutine F_injection(X, ns, S, F, dF) @@ -46,7 +47,7 @@ subroutine F_injection(X, ns, S, F, dF) !! !! While the equations are: !! - !! \( F = [lnK_i - ln \phi_i(y, P, T) + ln \phi_i(z, P, T), + !! \( F = [lnK_i - ln \phi_i(y, P, T) + ln \phi_i(z, P, T), !! \sum_{i=1}^N, X_{ns} - S] \) !! !! The injection can be considered as two kinds of injection: @@ -68,68 +69,60 @@ subroutine F_injection(X, ns, S, F, dF) ! Main phase variables real(pr) :: Vz - real(pr), dimension(size(X)-2) :: z, lnfug_z, dlnphi_dt_z, dlnphi_dp_z - real(pr), dimension(size(X)-2, size(X)-2) :: dlnphi_dn_z + real(pr), dimension(size(X) - 2) :: z, lnfug_z, dlnphi_dt_z, dlnphi_dp_z + real(pr), dimension(size(X) - 2, size(X) - 2) :: dlnphi_dn_z ! Incipient phase variables real(pr) :: Vy - real(pr), dimension(size(X)-2) :: y, lnfug_y, dlnphi_dt_y, dlnphi_dp_y - real(pr), dimension(size(X)-2, size(X)-2) :: dlnphi_dn_y + real(pr), dimension(size(X) - 2) :: y, lnfug_y, dlnphi_dt_y, dlnphi_dp_y + real(pr), dimension(size(X) - 2, size(X) - 2) :: dlnphi_dn_y ! Derivative of z wrt alpha - real(pr) :: dzda(size(X)-2) + real(pr) :: dzda(size(X) - 2) integer :: i, j, n n = size(X) - 2 K = exp(X(1:n)) - P = exp(X(n+1)) - alpha = X(n+2) - - select case(injection_case) - case("displace") - z = (z_injection * alpha + (1.0_pr - alpha) * z_0) - dzda = z_injection - z_0 - case("dilute") - z = (z_injection * alpha + z_0)/sum(z_injection * alpha + z_0) - dzda = -(alpha*z_injection + z_0) & - * sum(z_injection) / sum(alpha*z_injection + z_0)**2 & - + z_injection / sum(alpha*z_injection + z_0) - case default - z = (z_injection * alpha + (1.0_pr - alpha) * z_0) - dzda = z_injection - z_0 - end select + P = exp(X(n + 1)) + alpha = X(n + 2) + + call get_z(alpha, z, dzda) + if (any(z < 0)) z = 0 - - y = K * z - call TERMO(n, 0, 4, T, P, y, Vy, lnfug_y, dlnphi_dp_y, dlnphi_dt_y, dlnphi_dn_y) - call TERMO(n, 0, 4, T, P, z, Vz, lnfug_z, dlnphi_dp_z, dlnphi_dt_z, dlnphi_dn_z) + y = K*z + + call TERMO( & + n, 0, 4, T, P, y, Vy, lnfug_y, dlnphi_dp_y, dlnphi_dt_y, dlnphi_dn_y & + ) + call TERMO( & + n, 0, 4, T, P, z, Vz, lnfug_z, dlnphi_dp_z, dlnphi_dt_z, dlnphi_dn_z & + ) F(1:n) = X(:n) + lnfug_y - lnfug_z - F(n+1) = sum(y - z) - F(n+2) = X(ns) - S + F(n + 1) = sum(y - z) + F(n + 2) = X(ns) - S df = 0 - do i=1,n - do j=1,n - df(i, j) = y(j) * dlnphi_dn_y(i, j) + do i = 1, n + do j = 1, n + df(i, j) = y(j)*dlnphi_dn_y(i, j) end do df(i, i) = df(i, i) + 1 - df(i, n+2) = sum(K * dlnphi_dn_y(i, :) * dzda - dlnphi_dn_z(i, :) * dzda) + df(i, n + 2) = sum(K*dlnphi_dn_y(i, :)*dzda - dlnphi_dn_z(i, :)*dzda) end do - df(:n, n+1) = P * (dlnphi_dp_y - dlnphi_dp_z) - df(n+1, :n) = y - df(n+1, n+2) = sum(dzda*(K-1)) + df(:n, n + 1) = P*(dlnphi_dp_y - dlnphi_dp_z) + df(n + 1, :n) = y + df(n + 1, n + 2) = sum(dzda*(K - 1)) - df(n+2, :) = 0 - df(n+2, ns) = 1 + df(n + 2, :) = 0 + df(n + 2, ns) = 1 end subroutine - + subroutine F_injection_three_phases(Xvars, ns, S, F, dF) - use legacy_ar_models, only: TERMO !! Function to solve at each point of a three phase envelope. !! !! The vector of variables X corresponds to: @@ -144,9 +137,10 @@ subroutine F_injection_three_phases(Xvars, ns, S, F, dF) !! \sum_{i=1}^N (x_i - y_i), !! X_{ns} - S !! ] \) + use legacy_ar_models, only: TERMO use iso_fortran_env, only: error_unit real(pr), intent(in) :: Xvars(:) !! Vector of variables - integer, intent(in) :: ns !! Number of specification + integer, intent(in) :: ns !! Number of specification real(pr), intent(in) :: S !! Specification value real(pr), intent(out) :: F(size(Xvars)) !! Vector of functions valuated real(pr), intent(out) :: df(size(Xvars), size(Xvars)) !! Jacobian matrix @@ -164,7 +158,7 @@ subroutine F_injection_three_phases(Xvars, ns, S, F, dF) real(pr) :: Vx real(pr), dimension(N) :: x, lnfug_x, dlnphi_dt_x, dlnphi_dp_x real(pr), dimension(N, N) :: dlnphi_dn_x - + ! Main phase 2 variables real(pr) :: Vy real(pr), dimension(N) :: y, lnfug_y, dlnphi_dt_y, dlnphi_dp_y @@ -174,7 +168,7 @@ subroutine F_injection_three_phases(Xvars, ns, S, F, dF) real(pr) :: Vw real(pr), dimension(N) :: w, lnfug_w, dlnphi_dt_w, dlnphi_dp_w real(pr), dimension(N, N) :: dlnphi_dn_w - + ! Derivative of z wrt alpha real(pr) :: dzda(N), dwda(N) @@ -185,436 +179,464 @@ subroutine F_injection_three_phases(Xvars, ns, S, F, dF) real(pr) :: dwdKy(N), dxdKy(N), dydKy(N) integer :: i, j, n - + n = N #undef N - Kx = exp(Xvars(1:n)) - Ky = exp(Xvars(n+1:2*n)) - P = exp(Xvars(2*n+1)) - alpha = Xvars(2*n+2) - beta = Xvars(2*n+3) + Kx = exp(Xvars(1:n)) + Ky = exp(Xvars(n + 1:2*n)) + P = exp(Xvars(2*n + 1)) + alpha = Xvars(2*n + 2) + beta = Xvars(2*n + 3) call get_z(alpha, z, dzda) if (any(z < 0)) z = 0 - w = z / (beta * Ky + (1-beta) * Kx) - x = w * Kx - y = w * Ky - - call TERMO(n, 0, 4, T, P, x, Vx, lnfug_x, dlnphi_dp_x, dlnphi_dt_x, dlnphi_dn_x) - call TERMO(n, 0, 4, T, P, y, Vy, lnfug_y, dlnphi_dp_y, dlnphi_dt_y, dlnphi_dn_y) - call TERMO(n, 0, 4, T, P, w, Vw, lnfug_w, dlnphi_dp_w, dlnphi_dt_w, dlnphi_dn_w) - - F(1:n) = Xvars(1:n) + lnfug_x - lnfug_w - F(n+1:2*n) = Xvars(n+1:2*n) + lnfug_y - lnfug_w - - F(2*n+1) = sum(w) - 1 - F(2*n+2) = sum(x - y) - F(2*n+3) = Xvars(ns) - S - - df = 0 - dwda = 1.0_pr / (beta * Ky + (1-beta) * Kx) * dzda - dwdb = z * (Kx - Ky) / ((1 - beta) * Kx + beta * Ky)**2 - - dwdKx = -z * (1-beta) / (Ky*beta + (1-beta)*Kx)**2 - dxdKx = Kx * dwdKx + w - dydKx = Ky * dwdKx - - dwdKy = -z * (beta) / (Ky*beta + (1-beta)*Kx)**2 - dxdKy = Kx * dwdKy - dydKy = Ky * dwdKy + w - - do i=1,n - do j=1,n - df(i, j) = Kx(j) * (dlnphi_dn_x(i, j) * dxdKx(j) - dlnphi_dn_w(i,j) * dwdKx(j)) - df(i+n, j) = Kx(j) * (dlnphi_dn_y(i, j) * dydKx(j) - dlnphi_dn_w(i,j) * dwdKx(j)) - - df(i, j+n) = Ky(j) * (dlnphi_dn_x(i, j) * dxdKy(j) - dlnphi_dn_w(i,j) * dwdKy(j)) - df(i+n, j+n) = Ky(j) * (dlnphi_dn_y(i, j) * dydKy(j) - dlnphi_dn_w(i,j) * dwdKy(j)) - end do + w = z/(beta*Ky + (1 - beta)*Kx) + x = w*Kx + y = w*Ky - df(i, i) = df(i, i) + 1 - df(i+n, i+n) = df(i+n, i+n) + 1 + call TERMO( & + n, 0, 4, T, P, x, Vx, lnfug_x, dlnphi_dp_x, dlnphi_dt_x, dlnphi_dn_x & + ) + call TERMO( & + n, 0, 4, T, P, y, Vy, lnfug_y, dlnphi_dp_y, dlnphi_dt_y, dlnphi_dn_y & + ) + call TERMO( & + n, 0, 4, T, P, w, Vw, lnfug_w, dlnphi_dp_w, dlnphi_dt_w, dlnphi_dn_w & + ) - df(i, 2*n+2) = sum(Kx * dlnphi_dn_x(i, :) * dwda - dlnphi_dn_w(i, :) * dwda) - df(i+n, 2*n+2) = sum(Ky * dlnphi_dn_y(i, :) * dwda - dlnphi_dn_w(i, :) * dwda) - - df(i, 2*n+3) = sum(Kx * dlnphi_dn_x(i, :) * dwdb - dlnphi_dn_w(i, :) * dwdb) - df(i+n, 2*n+3) = sum(Ky * dlnphi_dn_y(i, :) * dwdb - dlnphi_dn_w(i, :) * dwdb) + F(1:n) = Xvars(1:n) + lnfug_x - lnfug_w + F(n + 1:2*n) = Xvars(n + 1:2*n) + lnfug_y - lnfug_w - df(2*n+1, i) = Kx(i) * dwdKx(i) - df(2*n+1, i+n) = Ky(i) * dwdKy(i) + F(2*n + 1) = sum(w) - 1 + F(2*n + 2) = sum(x - y) + F(2*n + 3) = Xvars(ns) - S - df(2*n+2, i) = Kx(i) * dxdKx(i) - Kx(i) * dydKx(i) - df(2*n+2, i+n) = Ky(i) * dxdKy(i) - Ky(i) * dydKy(i) + df = 0 + dwda = 1.0_pr/(beta*Ky + (1 - beta)*Kx)*dzda + dwdb = z*(Kx - Ky)/((1 - beta)*Kx + beta*Ky)**2 + + dwdKx = -z*(1 - beta)/(Ky*beta + (1 - beta)*Kx)**2 + dxdKx = Kx*dwdKx + w + dydKx = Ky*dwdKx + + dwdKy = -z*(beta)/(Ky*beta + (1 - beta)*Kx)**2 + dxdKy = Kx*dwdKy + dydKy = Ky*dwdKy + w + + do i = 1, n + do j = 1, n + df(i, j) = Kx(j)*(dlnphi_dn_x(i, j)*dxdKx(j) & + - dlnphi_dn_w(i, j)*dwdKx(j)) + df(i + n, j) = Kx(j)*(dlnphi_dn_y(i, j)*dydKx(j) & + - dlnphi_dn_w(i, j)*dwdKx(j)) + + df(i, j + n) = Ky(j)*(dlnphi_dn_x(i, j)*dxdKy(j) & + - dlnphi_dn_w(i, j)*dwdKy(j)) + df(i + n, j + n) = Ky(j)*(dlnphi_dn_y(i, j)*dydKy(j) & + - dlnphi_dn_w(i, j)*dwdKy(j)) + end do + + df(i, i) = df(i, i) + 1 + df(i + n, i + n) = df(i + n, i + n) + 1 + df(i, 2*n + 2) = sum( & + Kx*dlnphi_dn_x(i, :)*dwda - dlnphi_dn_w(i, :)*dwda & + ) + df(i + n, 2*n + 2) = sum(Ky*dlnphi_dn_y(i, :)*dwda & + - dlnphi_dn_w(i, :)*dwda) + df(i, 2*n + 3) = sum(Kx*dlnphi_dn_x(i, :)*dwdb & + - dlnphi_dn_w(i, :)*dwdb) + df(i + n, 2*n + 3) = sum(Ky*dlnphi_dn_y(i, :)*dwdb & + - dlnphi_dn_w(i, :)*dwdb) + df(2*n + 1, i) = Kx(i)*dwdKx(i) + df(2*n + 1, i + n) = Ky(i)*dwdKy(i) + + df(2*n + 2, i) = Kx(i)*dxdKx(i) - Kx(i)*dydKx(i) + df(2*n + 2, i + n) = Ky(i)*dxdKy(i) - Ky(i)*dydKy(i) end do ! Derivatives wrt P - df(:n, 2*n+1) = P * (dlnphi_dp_x - dlnphi_dp_w) - df(n+1:2*n, 2*n+1) = P * (dlnphi_dp_y - dlnphi_dp_w) + df(:n, 2*n + 1) = P*(dlnphi_dp_x - dlnphi_dp_w) + df(n + 1:2*n, 2*n + 1) = P*(dlnphi_dp_y - dlnphi_dp_w) ! Derivatives wrt alpha - df(2*n+1, 2*n+2) = sum(dwda) - df(2*n+2, 2*n+2) = sum(Kx * dwda - Ky * dwda) - + df(2*n + 1, 2*n + 2) = sum(dwda) + df(2*n + 2, 2*n + 2) = sum(Kx*dwda - Ky*dwda) + ! Derivatives wrt beta - df(2*n+1, 2*n+3) = sum(dwdb) - df(2*n+2, 2*n+3) = sum(Kx * dwdb - Ky * dwdb) + df(2*n + 1, 2*n + 3) = sum(dwdb) + df(2*n + 2, 2*n + 3) = sum(Kx*dwdb - Ky*dwdb) ! Derivatives wrt Xs - df(2*n+3, :) = 0 - df(2*n+3, ns) = 1 + df(2*n + 3, :) = 0 + df(2*n + 3, ns) = 1 end subroutine subroutine injection_envelope(X0, spec_number, del_S0, envels) - use constants, only: ouput_path - !! Subroutine to calculate Px phase envelopes via continuation method - real(pr), intent(in) :: X0(:) !! Vector of variables - integer, intent(in) :: spec_number !! Number of specification - real(pr), intent(in) :: del_S0 !! \(\Delta S_0\) - type(injelope), intent(out) :: envels !! Calculated envelopes - - type(critical_point), allocatable :: cps(:) - - real(pr) :: X(size(X0)) - integer :: ns - real(pr) :: S - real(pr) :: XS(max_points, size(X0)) - - real(pr) :: F(size(X0)), dF(size(X0), size(X0)), dXdS(size(X0)) - - integer :: point, iters, n - integer :: i - integer :: funit_output - character(len=254) :: fname_env - - allocate(cps(0)) - X = X0 - n = size(X0) - 2 - ns = spec_number - S = X(ns) - del_S = del_S0 - - ! ====================================================================== - ! Output file - ! ---------------------------------------------------------------------- - env_number = env_number + 1 - - write(fname_env, *) env_number - fname_env = "env-2ph-PX" // "_" // trim(adjustl(fname_env)) - fname_env = trim(adjustl(ouput_path)) // trim(fname_env) // ".dat" - - open(funit_output, file=fname_env) - write(funit_output, * ) "#", T - write(funit_output, *) "X0", iters, ns, X(n+2), exp(X(n+1)), X(:n) - ! ====================================================================== - - enveloop: do point=1, max_points - call full_newton(f_injection, iters, X, ns, S, F, dF) - - if (iters >= max_iters) then - exit enveloop - end if - - write(funit_output, *) "SOL", iters, ns, X(n+2), exp(X(n+1)), X(:n) - XS(point, :) = X - - update_spec: block - real(pr) :: dFdS(size(X0)) - integer :: ns_new - - dFdS = 0 - dFdS(n+2) = 1 - - dXdS = solve_system(dF, dFdS) - - ns_new = maxloc(abs(dXdS), dim=1) - - if (ns_new /= ns) then - del_S = dXdS(ns_new) * del_S ! translation of delS to the new specification variable - dXdS = dXdS/dXdS(ns_new) - ns = ns_new - end if - - del_S = sign(1.0_pr, del_S) * minval( [ & - max(sqrt(abs(X(ns)))/10, 0.1), & - abs(del_S) * 3/iters & - ] & - ) - - if (injection_case == "dilution") del_S = 50*del_S - end block update_spec - - fix_step: block - real(pr) :: Xnew(size(X0)) - real(pr) :: dP, dalpha - - Xnew = X + dXdS * del_S - dP = exp(Xnew(n+1)) - exp(X(n+1)) - dalpha = Xnew(n+2) - X(n+2) - - do while (abs(dP) > 50 .or. abs(dalpha) > 0.03) - dXdS = dXdS/10.0_pr - - Xnew = X + dXdS * del_S - dP = exp(Xnew(n+1)) - exp(X(n+1)) - dalpha = Xnew(n+2) - X(n+2) - end do - end block fix_step - - detect_critical: block - real(pr) :: K(size(X0) - 2), Knew(size(X0) - 2), Xnew(size(X0)), fact - real(pr) :: pc, alpha_c, dS_c - integer :: max_changing - fact = 2.5 - - Xnew = X + fact * dXdS * del_S - - K = X(:n) - Knew = Xnew(:n) - - if (all(K * Knew < 0)) then - max_changing = maxloc(abs(K - Knew), dim=1) - - dS_c = - k(max_changing) * (Xnew(ns) - X(ns))/(Knew(max_changing) - K(max_changing)) - del_S = dS_c * 1.1 - - Xnew = X + dXdS * dS_c - alpha_c = Xnew(n+2) - pc = Xnew(n+1) - - cps = [cps, critical_point(t, pc, alpha_c)] - write(funit_output, *) "" - write(funit_output, *) "" - end if - end block detect_critical - - X = X + dXdS * del_S - S = X(ns) - - if (any(break_conditions(X, ns, S))) exit enveloop - end do enveloop - - point = point - 1 - - write(funit_output, *) "#critical" - if (size(cps) > 0 ) then - do i=1,size(cps) - write(funit_output, *) cps(i)%t, cps(i)%p - end do - else - write(funit_output, *) "NaN NaN" - endif - - close(funit_output) - envels%z = z_0 - envels%z_inj = z_injection - envels%logk = XS(:point, :n) - envels%alpha = XS(:point, n+2) - envels%p = exp(XS(:point, n+1)) - envels%critical_points = cps + use constants, only: ouput_path + !! Subroutine to calculate Px phase envelopes via continuation method + real(pr), intent(in) :: X0(:) !! Vector of variables + integer, intent(in) :: spec_number !! Number of specification + real(pr), intent(in) :: del_S0 !! \(\Delta S_0\) + type(injelope), intent(out) :: envels !! Calculated envelopes + + type(critical_point), allocatable :: cps(:) + + real(pr) :: X(size(X0)) + integer :: ns + real(pr) :: S + real(pr) :: XS(max_points, size(X0)) + + real(pr) :: F(size(X0)), dF(size(X0), size(X0)), dXdS(size(X0)) + + integer :: point, iters, n + integer :: i + integer :: funit_output + character(len=254) :: fname_env + + allocate (cps(0)) + X = X0 + n = size(X0) - 2 + ns = spec_number + S = X(ns) + del_S = del_S0 + + ! ====================================================================== + ! Output file + ! ---------------------------------------------------------------------- + env_number = env_number + 1 + + write (fname_env, *) env_number + fname_env = "env-2ph-PX"//"_"//trim(adjustl(fname_env)) + fname_env = trim(adjustl(ouput_path))//trim(fname_env)//".dat" + + open (funit_output, file=fname_env) + write (funit_output, *) "#", T + write (funit_output, *) "X0", iters, ns, X(n + 2), exp(X(n + 1)), X(:n) + ! ====================================================================== + + enveloop: do point = 1, max_points + call full_newton(f_injection, iters, X, ns, S, F, dF) + + if (iters >= max_iters) then + exit enveloop + end if + + XS(point, :) = X + + update_spec: block + real(pr) :: dFdS(size(X0)) + integer :: ns_new + + dFdS = 0 + dFdS(n + 2) = 1 + + dXdS = solve_system(dF, dFdS) + + ns_new = maxloc(abs(dXdS), dim=1) + + if (ns_new /= ns) then + ! translation of delS and dXdS to the new specification variable + del_S = dXdS(ns_new)*del_S + dXdS = dXdS/dXdS(ns_new) + ns = ns_new + end if + + del_S = sign(1.0_pr, del_S)*minval([ & + max(sqrt(abs(X(ns)))/10, 0.1), & + abs(del_S)*3/iters & + ] & + ) + + if (injection_case == "dilution") del_S = 50*del_S + end block update_spec + + fix_step: block + real(pr) :: Xnew(size(X0)) + real(pr) :: dP, dalpha + + Xnew = X + dXdS*del_S + dP = exp(Xnew(n + 1)) - exp(X(n + 1)) + dalpha = Xnew(n + 2) - X(n + 2) + + do while (abs(dP) > 50 .or. abs(dalpha) > 0.03) + dXdS = dXdS/10.0_pr + + Xnew = X + dXdS*del_S + dP = exp(Xnew(n + 1)) - exp(X(n + 1)) + dalpha = Xnew(n + 2) - X(n + 2) + end do + end block fix_step + + detect_critical: block + real(pr) :: K(size(X0) - 2), Knew(size(X0) - 2), & + Xnew(size(X0)), fact + real(pr) :: pc, alpha_c, dS_c + integer :: max_changing + fact = 2.5 + + Xnew = X + fact*dXdS*del_S + + K = X(:n) + Knew = Xnew(:n) + + if (all(K*Knew < 0)) then + max_changing = maxloc(abs(K - Knew), dim=1) + + dS_c = ( & + -k(max_changing)*(Xnew(ns) - X(ns)) & + /(Knew(max_changing) - K(max_changing)) & + ) + del_S = dS_c*1.1 + + Xnew = X + dXdS*dS_c + alpha_c = Xnew(n + 2) + pc = Xnew(n + 1) + + cps = [cps, critical_point(t, pc, alpha_c)] + write (funit_output, *) "" + write (funit_output, *) "" + end if + end block detect_critical + + X = X + dXdS*del_S + S = X(ns) + + if (any(break_conditions(X, ns, S))) exit enveloop + write (funit_output, *) "SOL", iters, ns, X(n + 2), exp(X(n + 1)), & + X(:n) + end do enveloop + + point = point - 1 + + write (funit_output, *) "" + write (funit_output, *) "" + write (funit_output, *) "#critical" + if (size(cps) > 0) then + do i = 1, size(cps) + write (funit_output, *) cps(i)%t, cps(i)%p + end do + else + write (funit_output, *) "NaN NaN" + end if + + close (funit_output) + envels%z = z_0 + envels%z_inj = z_injection + envels%logk = XS(:point, :n) + envels%alpha = XS(:point, n + 2) + envels%p = exp(XS(:point, n + 1)) + envels%critical_points = cps end subroutine - + subroutine injection_envelope_three_phase(X0, spec_number, del_S0, envels) - use constants, only: ouput_path - !! Subroutine to calculate Px phase envelopes via continuation method. - !! Three phases version. - real(pr), intent(in) :: X0(:) !! Vector of variables - integer, intent(in) :: spec_number !! Number of specification - real(pr), intent(in) :: del_S0 !! \(\Delta S_0\) - type(injelope), intent(out) :: envels !! Calculated envelopes - - type(critical_point), allocatable :: cps(:) - - real(pr) :: X(size(X0)) - integer :: ns - real(pr) :: S - real(pr) :: XS(max_points, size(X0)) - - real(pr) :: F(size(X0)), dF(size(X0), size(X0)), dXdS(size(X0)) - - integer :: point, iters, n - integer :: i - integer :: funit_output - character(len=254) :: fname_env - - allocate(cps(0)) - X = X0 - n = (size(X0) - 3)/2 - ns = spec_number - S = X(ns) - del_S = del_S0 - - ! ====================================================================== - ! Output file - ! ---------------------------------------------------------------------- - env_number = env_number + 1 - - write(fname_env, *) env_number - fname_env = "env-3ph-PX" // "_" // trim(adjustl(fname_env)) - fname_env = trim(adjustl(ouput_path)) // trim(fname_env) // ".dat" - - open(newunit=funit_output, file=fname_env) - write(funit_output, * ) "#", T - write(funit_output, *) "X0", iters, ns, X(2*n+2), exp(X(2*n+1)), X(2*n+3), X(:2*n) - ! ====================================================================== - - enveloop: do point=1, max_points - call full_newton(F_injection_three_phases, iters, X, ns, S, F, dF) - if (iters >= max_iters) then - exit enveloop - end if - - write(funit_output, *) "SOL", iters, ns, X(2*n+2), exp(X(2*n+1)), X(2*n+3), X(:2*n) - XS(point, :) = X - - update_spec: block - real(pr) :: dFdS(size(X0)) - integer :: ns_new - - dFdS = 0 - ! Actually it's -dFdS - dFdS(2*n+3) = 1 - - dXdS = solve_system(dF, dFdS) - - - if (maxval(abs(X(:2*n))) < 1) then - ns_new = maxloc(abs(dXdS(:2*n)), dim=1) ! T and P not allowed to be chosen close to a critical point - else - ns_new = maxloc(abs(dXdS), dim=1) - end if - - if (ns_new /= ns) then - del_S = dXdS(ns_new) * del_S ! translation of delS to the new specification variable - dXdS = dXdS/dXdS(ns_new) - ns = ns_new - end if - - del_S = sign(1.0_pr, del_S) * minval( [ & - max(sqrt(abs(X(ns))), 0.1), & - abs(del_S) * 3/iters & - ] & - ) - - if (injection_case == "dilution") del_S = 50*del_S - end block update_spec - - fix_step: block - real(pr) :: Xnew(size(X0)) - real(pr) :: dP, dalpha - - Xnew = X + dXdS * del_S - dP = exp(Xnew(2*n+1)) - exp(X(n+1)) - dalpha = Xnew(2*n+2) - X(n+2) - - do while (abs(dP) > 50 .or. abs(dalpha) > 0.03) + use constants, only: ouput_path + !! Subroutine to calculate Px phase envelopes via continuation method. + !! Three phases version. + real(pr), intent(in) :: X0(:) !! Vector of variables + integer, intent(in) :: spec_number !! Number of specification + real(pr), intent(in) :: del_S0 !! \(\Delta S_0\) + type(injelope), intent(out) :: envels !! Calculated envelopes + + type(critical_point), allocatable :: cps(:) + + real(pr) :: X(size(X0)) + integer :: ns + real(pr) :: S + real(pr) :: XS(max_points, size(X0)) + + real(pr) :: F(size(X0)), dF(size(X0), size(X0)), dXdS(size(X0)) + + integer :: point, iters, n + integer :: i + integer :: funit_output + character(len=254) :: fname_env + + allocate (cps(0)) + X = X0 + n = (size(X0) - 3)/2 + ns = spec_number + S = X(ns) + del_S = del_S0 + + ! ====================================================================== + ! Output file + ! ---------------------------------------------------------------------- + env_number = env_number + 1 + + write (fname_env, *) env_number + fname_env = "env-3ph-PX"//"_"//trim(adjustl(fname_env)) + fname_env = trim(adjustl(ouput_path))//trim(fname_env)//".dat" + + open (newunit=funit_output, file=fname_env) + write (funit_output, *) "#", T + write (funit_output, *) "X0", iters, ns, X(2*n + 2), exp(X(2*n + 1)), & + X(2*n + 3), X(:2*n) + ! ====================================================================== + + enveloop: do point = 1, max_points + call full_newton(F_injection_three_phases, iters, X, ns, S, F, dF) + if (iters >= max_iters) then + exit enveloop + end if + + write (funit_output, *) "SOL", iters, ns, X(2*n + 2), & + exp(X(2*n + 1)), X(2*n + 3), X(:2*n) + XS(point, :) = X + + update_spec: block + real(pr) :: dFdS(size(X0)) + integer :: ns_new + + dFdS = 0 + ! Actually it's -dFdS + dFdS(2*n + 3) = 1 + + dXdS = solve_system(dF, dFdS) + + if (maxval(abs(X(:2*n))) < 1) then + ! T and P not allowed to be chosen close to a critical point + ns_new = maxloc(abs(dXdS(:2*n)), dim=1) + else + ns_new = maxloc(abs(dXdS), dim=1) + end if + + if (ns_new /= ns) then + del_S = dXdS(ns_new)*del_S ! translation of delS to the new specification variable + dXdS = dXdS/dXdS(ns_new) + ns = ns_new + end if + + del_S = sign(1.0_pr, del_S)*minval([ & + max(sqrt(abs(X(ns))), 0.1), & + abs(del_S)*3/iters & + ] & + ) + + if (injection_case == "dilution") del_S = 50*del_S + end block update_spec + + fix_step: block + real(pr) :: Xnew(size(X0)) + real(pr) :: dP, dalpha + + Xnew = X + dXdS*del_S + dP = exp(Xnew(2*n + 1)) - exp(X(n + 1)) + dalpha = Xnew(2*n + 2) - X(n + 2) + + do while (abs(dP) > 50 .or. abs(dalpha) > 0.03) dXdS = dXdS/10.0_pr - Xnew = X + dXdS * del_S - dP = exp(Xnew(2*n+1)) - exp(X(2*n+1)) - dalpha = Xnew(2*n+2) - X(2*n+2) - end do - end block fix_step - - detect_critical: block - real(pr) :: K((size(X0) - 3)/2), Knew((size(X0) - 3)/2), Xnew(size(X0)), fact - real(pr) :: pc, alpha_c, dS_c, dXdS_in(size(X0)) - integer :: max_changing, i - fact = 15.0_pr - - Xnew = X + fact * dXdS * del_S - do i=0,1 - K = X(i*n+1:(i+1)*n) - Knew = Xnew(i*n+1:(i+1)*n) - max_changing = minloc(abs(Knew - K), dim=1) - - if (all(K * Knew < 0)) then - dS_c = - k(max_changing) * (Xnew(ns) - X(ns))/(Knew(max_changing) - K(max_changing)) - del_S = sign(15.0_pr, dS_c) ! dS_c * 15_pr - - Xnew = X + dXdS * dS_c - alpha_c = Xnew(2*n+2) - pc = exp(Xnew(2*n+1)) - - cps = [cps, critical_point(t, pc, alpha_c)] - write(funit_output, *) "" - write(funit_output, *) "" - end if - end do - end block detect_critical - - if (x(2*n+3) > 1) exit enveloop - - X = X + dXdS * del_S - S = X(ns) - if (any(break_conditions_three_phases(X, ns, S))) exit enveloop - end do enveloop - - point = point - 1 - - write(funit_output, *) "" - write(funit_output, *) "" - write(funit_output, *) "#critical" - if (size(cps) > 0) then - do i=1,size(cps) - write(funit_output, *) cps(i)%alpha, cps(i)%p - end do - else - write(funit_output, *) "NaN NaN" - endif - - close(funit_output) - envels%z = z_0 - envels%z_inj = z_injection - envels%logk = XS(:point, :n) - envels%alpha = XS(:point, n+2) - envels%p = exp(XS(:point, n+1)) - envels%critical_points = cps + Xnew = X + dXdS*del_S + dP = exp(Xnew(2*n + 1)) - exp(X(2*n + 1)) + dalpha = Xnew(2*n + 2) - X(2*n + 2) + end do + end block fix_step + + detect_critical: block + real(pr) :: K((size(X0) - 3)/2), Knew((size(X0) - 3)/2), & + Xnew(size(X0)), fact + real(pr) :: pc, alpha_c, dS_c, dXdS_in(size(X0)) + integer :: max_changing, i + fact = 15.0_pr + + Xnew = X + fact*dXdS*del_S + do i = 0, 1 + K = X(i*n + 1:(i + 1)*n) + Knew = Xnew(i*n + 1:(i + 1)*n) + max_changing = minloc(abs(Knew - K), dim=1) + + if (all(K*Knew < 0)) then + dS_c = ( & + -k(max_changing)*(Xnew(ns) - X(ns)) & + /(Knew(max_changing) - K(max_changing)) & + ) + del_S = sign(15.0_pr, dS_c) ! dS_c * 15_pr + + Xnew = X + dXdS*dS_c + alpha_c = Xnew(2*n + 2) + pc = exp(Xnew(2*n + 1)) + + cps = [cps, critical_point(t, pc, alpha_c)] + write (funit_output, *) "" + write (funit_output, *) "" + end if + end do + end block detect_critical + + if (x(2*n + 3) > 1) exit enveloop + + X = X + dXdS*del_S + S = X(ns) + if (any(break_conditions_three_phases(X, ns, S))) exit enveloop + end do enveloop + + point = point - 1 + + write (funit_output, *) "" + write (funit_output, *) "" + write (funit_output, *) "#critical" + if (size(cps) > 0) then + do i = 1, size(cps) + write (funit_output, *) cps(i)%alpha, cps(i)%p + end do + else + write (funit_output, *) "NaN NaN" + end if + + close (funit_output) + envels%z = z_0 + envels%z_inj = z_injection + envels%logk = XS(:point, :n) + envels%alpha = XS(:point, n + 2) + envels%p = exp(XS(:point, n + 1)) + envels%critical_points = cps end subroutine subroutine full_newton(fun, iters, X, ns, S, F, dF) !! Subroutine to solve a point in the envelope. + !! + !! Procedure that solves a point with the Newton-Raphson method. interface subroutine fun(X, ns, S, F, dF) !! Function to solve import pr real(pr), intent(in) :: X(:) - integer, intent(in) :: ns + integer, intent(in) :: ns real(pr), intent(in) :: S real(pr), intent(out) :: F(size(X)) real(pr), intent(out) :: dF(size(X), size(X)) end subroutine end interface + !&< integer, intent(out) :: iters !! Number of iterations needed real(pr), intent(in out) :: X(:) !! Variables vector integer, intent(in) :: ns !! Number of specification real(pr), intent(in) :: S !! Specification value real(pr), intent(out) :: F(size(X)) !! Function values at solved point real(pr), intent(out) :: df(size(X), size(X)) !! Jacobian values + !&> real(pr) :: b(size(X)), A(size(X), size(X)) + real(pr) :: dX(size(X)), tol = 1e-5 - real(pr) :: dX(size(X)), tol=1e-5 - - integer :: n, info - integer :: i + integer :: n n = size(X) dX = 20 - newton: do iters=1, max_iters*10 - if (maxval(abs(dx)) < tol) exit newton - call fun(X, ns, S, b, a) - b = -b - dX = solve_system(A, b) + newton: do iters = 1, max_iters*10 + if (maxval(abs(dx)) < tol) exit newton + call fun(X, ns, S, b, a) + b = -b + dX = solve_system(A, b) - do while (maxval(abs(dx)) > 0.5*maxval(abs(x))) - dX = dX/2 - end do + do while (maxval(abs(dx)) > 0.5*maxval(abs(x))) + dX = dX/2 + end do - X = X + dX + X = X + dX end do newton F = -b @@ -632,13 +654,13 @@ function break_conditions(X, ns, S) logical, allocatable :: break_conditions(:) n = size(X) - 2 - p = exp(X(n+1)) - alpha = X(n+2) + p = exp(X(n + 1)) + alpha = X(n + 2) - break_conditions = [& - p < 10 .or. p > 2000, & - abs(del_S) < 1e-18 & - ] + break_conditions = [ & + p < 10 .or. p > 2000, & + abs(del_S) < 1e-18 & + ] end function function break_conditions_three_phases(X, ns, S) @@ -652,16 +674,16 @@ function break_conditions_three_phases(X, ns, S) logical, allocatable :: break_conditions_three_phases(:) n = (size(X) - 3)/2 - p = exp(X(2*n+1)) - alpha = X(2*n+2) + p = exp(X(2*n + 1)) + alpha = X(2*n + 2) - break_conditions_three_phases = [& - p < 10 .or. p > 3000 & - ] + break_conditions_three_phases = [ & + p < 10 .or. p > 3000 & + ] end function subroutine get_z(alpha, z, dzda) - !! Calculate the fluid composition based on an amount of addition + !! Calculate the fluid composition based on an amount of addition !! of second fluid. !! !! The injection can be considered as two kinds of injection: @@ -671,18 +693,24 @@ subroutine get_z(alpha, z, dzda) real(pr), intent(out) :: z(size(z_0)) !! New composition real(pr), intent(out) :: dzda(size(z_0)) !! Derivative wrt \(\alpha\) - select case(injection_case) - case("displace") - z = (z_injection * alpha + (1.0_pr - alpha) * z_0) - dzda = z_injection - z_0 - case("dilute") - z = (z_injection * alpha + z_0)/sum(z_injection * alpha + z_0) - dzda = -(alpha*z_injection + z_0) & - * sum(z_injection) / sum(alpha*z_injection + z_0)**2 & - + z_injection / sum(alpha*z_injection + z_0) - case default - z = (z_injection * alpha + (1.0_pr - alpha) * z_0) - dzda = z_injection - z_0 + select case (injection_case) + case ("displace") + z = (z_injection*alpha + (1.0_pr - alpha)*z_0) + dzda = z_injection - z_0 + case ("dilute") + z = (z_injection*alpha + z_0)/sum(z_injection*alpha + z_0) + dzda = -(alpha*z_injection + z_0) & + *sum(z_injection)/sum(alpha*z_injection + z_0)**2 & + + z_injection/sum(alpha*z_injection + z_0) + case default + z = (z_injection*alpha + (1.0_pr - alpha)*z_0) + dzda = z_injection - z_0 end select end subroutine + + function get_case(dew_envel, bub_envel) result(n_case) + type(injelope), intent(in) :: dew_envel + type(injelope), intent(in) :: bub_envel + integer :: n_case + end function end module From 03b7f084c9ac7556b02b458c9f3679d30a724f49 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 14:32:46 -0300 Subject: [PATCH 32/48] fix(interserction): Modified tolerances Modified the tolerances to assure the same intersection is not repeated. This probably should be revisited with more tests later. --- src/linalg.f90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/linalg.f90 b/src/linalg.f90 index 4ea615e..898d7c9 100644 --- a/src/linalg.f90 +++ b/src/linalg.f90 @@ -71,11 +71,10 @@ function intersect_two_lines(l1_x, l1_y, l2_x, l2_y) result(intersections) x = s * (x2-x1) + x1 y = s * (y2-y1) + y1 - if (abs(x - xold) > 1 .and. abs(y - yold) > 1) then - print *, "CROSS", x, y + if (abs((x - xold)) > 1e-5_pr .and. abs((y - yold)) > 1e-5_pr) then xold = x yold = y - intersections = [intersections, point(x, y, i, j)] + intersections = [intersections, point(x, y, i, j)] exit line2 end if From c8e1a8a9968a4a8b670338ae5265b1e6212e48a7 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 14:33:15 -0300 Subject: [PATCH 33/48] refactor(linalg): Format and deleted some prints --- src/linalg.f90 | 24 +++++++++--------------- 1 file changed, 9 insertions(+), 15 deletions(-) diff --git a/src/linalg.f90 b/src/linalg.f90 index 898d7c9..13326b9 100644 --- a/src/linalg.f90 +++ b/src/linalg.f90 @@ -1,5 +1,5 @@ module linalg - !! Wrapper module around LAPACK's `dgesv` + !! Wrapper module around LAPACK's `dgesv` and lines intersections detector use constants, only: pr implicit none @@ -99,23 +99,17 @@ function intersect_one_line(lx, ly) result(intersections) line2: do j=i+15, size(lx) associate(x1 => lx(i-1), x2 => lx(i), x3 => lx(j), x4 => lx(j-1), & y1 => ly(i-1), y2 => ly(i), y3 => ly(j), y4 => ly(j-1)) + call intersects(x1, x2, x3, x4, y1, y2, y3, y4, s, t) if (0 <= s .and. s <= 1 .and. 0 <= t .and. t <= 1) then - x = s*(x2 - x1) + x1 y = s*(y2 - y1) + y1 - - if (abs(x - xold) > 1 .and. abs(y - yold) > 1) then - print *, "CROSS" - print *, i, j, x, y - write(*, fmt) "x1, y1 = ", x1, y1 - write(*, fmt) "x2, y2 = ", x2, y2 - write(*, fmt) "x3, y3 = ", x3, y3 - write(*, fmt) "x4, y4 = ", x4, y4 - xold = x - yold = y - intersections = [intersections, point(x, y, i, j)] - end if + if (abs(x - xold) > 1 .and. abs(y - yold) > 1) then + xold = x + yold = y + ! Use earliest point for the "other" line + intersections = [intersections, point(x, y, i, j-1)] + end if end if end associate end do line2 @@ -146,4 +140,4 @@ elemental function interpol(x1, x2, y1, y2, x_obj) result(y) real(pr) :: y y = (y2 - y1)/(x2 - x1) * (x_obj - x1) + y1 end function -end module linalg \ No newline at end of file +end module linalg From 8e40597536ff6ee809c83a6896610c304d15a79d Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 14:45:48 -0300 Subject: [PATCH 34/48] interpol --- src/linalg.f90 | 119 ++++++++++++++++++++++++++++++++----------------- 1 file changed, 77 insertions(+), 42 deletions(-) diff --git a/src/linalg.f90 b/src/linalg.f90 index 13326b9..207a9f3 100644 --- a/src/linalg.f90 +++ b/src/linalg.f90 @@ -29,7 +29,7 @@ function solve_system(a, b) result(x) subroutine dgesv(n, nrhs, a, lda, ipiv, b, ldb, info) integer :: n integer :: nrhs - real(8) :: a(n,n) + real(8) :: a(n, n) integer :: lda integer :: ipiv(n) real(8) :: b(n) @@ -57,24 +57,29 @@ function intersect_two_lines(l1_x, l1_y, l2_x, l2_y) result(intersections) real(pr) :: s, t integer :: i, j - real(pr) :: x, y, xold=9999, yold=9999 + real(pr) :: x, y, xold = 9999, yold = 9999 - allocate(intersections(0)) + allocate (intersections(0)) - line1: do i=2, size(l1_x) - line2: do j=2, size(l2_x) - associate(x1 => l1_x(i-1), x2 => l1_x(i), x3 => l2_x(j-1), x4 => l2_x(j), & - y1 => l1_y(i-1), y2 => l1_y(i), y3 => l2_y(j-1), y4 => l2_y(j)) + line1: do i = 2, size(l1_x) + line2: do j = 2, size(l2_x) + associate ( & + x1 => l1_x(i - 1), x2 => l1_x(i), & + x3 => l2_x(j - 1), x4 => l2_x(j), & + y1 => l1_y(i - 1), y2 => l1_y(i), & + y3 => l2_y(j - 1), y4 => l2_y(j)) call intersects(x1, x2, x3, x4, y1, y2, y3, y4, s, t) if (0 <= s .and. s <= 1 .and. 0 <= t .and. t <= 1) then - x = s * (x2-x1) + x1 - y = s * (y2-y1) + y1 + x = s*(x2 - x1) + x1 + y = s*(y2 - y1) + y1 - if (abs((x - xold)) > 1e-5_pr .and. abs((y - yold)) > 1e-5_pr) then + if ( & + abs((x - xold)) > 1e-5_pr .and. abs((y - yold)) > 1e-5_pr & + ) then xold = x yold = y - intersections = [intersections, point(x, y, i, j)] + intersections = [intersections, point(x, y, i, j)] exit line2 end if @@ -83,34 +88,36 @@ function intersect_two_lines(l1_x, l1_y, l2_x, l2_y) result(intersections) end do line2 end do line1 end function - + function intersect_one_line(lx, ly) result(intersections) real(pr), intent(in) :: lx(:), ly(:) type(point), allocatable :: intersections(:) - character(len=*), parameter :: fmt="(*(G0,:,', '))" real(pr) :: s, t integer :: i, j - real(pr) :: x, y, xold=9999, yold=9999 - - allocate(intersections(0)) - line1: do i=2, size(lx)-1 - line2: do j=i+15, size(lx) - associate(x1 => lx(i-1), x2 => lx(i), x3 => lx(j), x4 => lx(j-1), & - y1 => ly(i-1), y2 => ly(i), y3 => ly(j), y4 => ly(j-1)) - - call intersects(x1, x2, x3, x4, y1, y2, y3, y4, s, t) - if (0 <= s .and. s <= 1 .and. 0 <= t .and. t <= 1) then - x = s*(x2 - x1) + x1 - y = s*(y2 - y1) + y1 - if (abs(x - xold) > 1 .and. abs(y - yold) > 1) then - xold = x - yold = y - ! Use earliest point for the "other" line - intersections = [intersections, point(x, y, i, j-1)] + real(pr) :: x, y, xold = 9999, yold = 9999 + + allocate (intersections(0)) + line1: do i = 2, size(lx) - 1 + line2: do j = i + 15, size(lx) + associate ( & + x1 => lx(i - 1), x2 => lx(i), & + x3 => lx(j), x4 => lx(j - 1), & + y1 => ly(i - 1), y2 => ly(i), & + y3 => ly(j), y4 => ly(j - 1)) + + call intersects(x1, x2, x3, x4, y1, y2, y3, y4, s, t) + if (0 <= s .and. s <= 1 .and. 0 <= t .and. t <= 1) then + x = s*(x2 - x1) + x1 + y = s*(y2 - y1) + y1 + if (abs(x - xold) > 1 .and. abs(y - yold) > 1) then + xold = x + yold = y + ! Use earliest point for the "other" line + intersections = [intersections, point(x, y, i, j - 1)] + end if end if - end if end associate end do line2 end do line1 @@ -120,11 +127,11 @@ subroutine intersects(x1, x2, x3, x4, y1, y2, y3, y4, s, t) real(pr), intent(in) :: x1, x2, x3, x4, y1, y2, y3, y4 real(pr), intent(out) :: s, t - real(pr) :: A(2,2), b(2), tmp + real(pr) :: A(2, 2), b(2), tmp - A(1, :) = [x2-x1, x3-x4] - A(2, :) = [y2-y1, y3-y4] - b = [x3-x1, y3-y1] + A(1, :) = [x2 - x1, x3 - x4] + A(2, :) = [y2 - y1, y3 - y4] + b = [x3 - x1, y3 - y1] b = solve_system(a, b) s = b(1) @@ -132,12 +139,40 @@ subroutine intersects(x1, x2, x3, x4, y1, y2, y3, y4, s, t) end subroutine elemental function interpol(x1, x2, y1, y2, x_obj) result(y) - real(pr), intent(in) :: x1 - real(pr), intent(in) :: x2 - real(pr), intent(in) :: y1 - real(pr), intent(in) :: y2 - real(pr), intent(in) :: x_obj - real(pr) :: y - y = (y2 - y1)/(x2 - x1) * (x_obj - x1) + y1 + !! Linear interpolation. + !! + !! Calculates the linear interpolation between two points at a desired + !! x value with the equation: + !! \[ + !! y = \frac{y_2 - y_1}{x_2 - x_1} \cdot (x_{obj}) - x_1 + y_1 + !! \] + !! + !! Since this function is defined as `elemental` it will also interpolate + !! a set of vectors. + !! + !! Examples of usage: + !! + !! ```fortran + !! x1 = 2 + !! x2 = 5 + !! y1 = 2 + !! y2 = 9 + !! y = interpol(x1, x2, y1, y2, 2.3) + !! ``` + !! + !! ```fortran + !! x1 = 2 + !! x2 = 5 + !! y1 = [2, 6] + !! y2 = [9, 15] + !! y = interpol(x1, x2, y1, y2, 2.3) + !! ``` + real(pr), intent(in) :: x1 !! First point x value + real(pr), intent(in) :: x2 !! Second point x value + real(pr), intent(in) :: y1 !! First point y value + real(pr), intent(in) :: y2 !! Second point y value + real(pr), intent(in) :: x_obj !! Desired x value to interpolate + real(pr) :: y !! y value at `x_obj` + y = (y2 - y1)/(x2 - x1)*(x_obj - x1) + y1 end function end module linalg From dc2367093fbb8e2ae82b667eb82a678b2727ef4b Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 14:47:17 -0300 Subject: [PATCH 35/48] Simple plotter of Pxvelopes --- plot_x.gnu | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 plot_x.gnu diff --git a/plot_x.gnu b/plot_x.gnu new file mode 100644 index 0000000..854e9fe --- /dev/null +++ b/plot_x.gnu @@ -0,0 +1,17 @@ +#!/usr/bin/gnuplot -persist + +set key left +set mytics 4 +set mxtics 5 + +set xlabel "x" +set ylabel "P [bar]" + +plot "./output/env-2ph-PX_1.dat" u 4:5 w lp t "Bubble Line", \ + "./output/env-2ph-PX_2.dat" u 4:5 w lp t "Dew Line", \ + "./output/env-3ph-PX_3.dat" u 4:5 w lp t "3ph-vapor", \ + "./output/env-3ph-PX_4.dat" u 4:5 w lp t "3ph-liquid", \ + "./output/env-3ph-PX_3.dat" index "critical" u 1:2 w p t "" pt 7 lc rgb "black", \ + "./output/env-3ph-PX_4.dat" index "critical" u 1:2 w p t "" pt 7 lc rgb "black" + +pause mouse close From c6395ba57e1c278f7ec8b94b406f7c9849137070 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 14:47:47 -0300 Subject: [PATCH 36/48] test --- test/test_intersect.f90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/test/test_intersect.f90 b/test/test_intersect.f90 index d5e4231..71d992e 100644 --- a/test/test_intersect.f90 +++ b/test/test_intersect.f90 @@ -2,7 +2,6 @@ module test_lines use constants, only: pr real(pr) :: self_x(374), self_y(374) contains - subroutine read_selfxy integer :: i, funit open(newunit=funit, file="test/self_cross_line") @@ -16,14 +15,14 @@ subroutine read_selfxy program test_intersect use constants, only: pr use test_lines, only: self_x, self_y, read_selfxy - use linalg, only: intersection + use linalg, only: intersection, point implicit none integer, parameter :: n=2001 real(pr) :: l1_x(n), l2_x(n) real(pr) :: l1_y(n), l2_y(n) integer :: i - real(pr) :: inter + type(point), allocatable :: inter(:) l1_x = [(real(i, pr)/100._pr, i=-1000,1000)] l2_x = [(real(i, pr)/100._pr, i=-1000,1000)] @@ -31,8 +30,8 @@ program test_intersect l1_y = 2 * l1_x l2_y = l2_x ** 2 - call intersection(l1_x, l1_y, l2_x, l2_y, inter) + inter = intersection(l1_x, l1_y, l2_x, l2_y) call read_selfxy - call intersection(self_x, self_y, inter) + inter = intersection(self_x, self_y) end program From 09db282a43f4b51e5ffcfee3b9dfde23af5aa7d1 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Tue, 12 Sep 2023 15:01:04 -0300 Subject: [PATCH 37/48] test(Px): Comparison between num jacobian and analitical --- test/test_f_injection_three_phases.f90 | 57 ++++++++++++++++++++++++++ 1 file changed, 57 insertions(+) create mode 100644 test/test_f_injection_three_phases.f90 diff --git a/test/test_f_injection_three_phases.f90 b/test/test_f_injection_three_phases.f90 new file mode 100644 index 0000000..26220d7 --- /dev/null +++ b/test/test_f_injection_three_phases.f90 @@ -0,0 +1,57 @@ +program main + use constants, only: pr + use inj_envelopes, only: F_injection_three_phases, from_nml, z_0 + use envelopes, only: k_wilson + use io_nml, only: read_system + use fordiff, only: derivative + integer, parameter :: nvars = 16+3 + character(len=*), parameter :: infile="test/test_f3.nml" + + real(pr) :: X(nvars), F(nvars), Fdx(nvars), df(nvars, nvars), dx + real(pr) :: jac(nvars, nvars), numjac(nvars, nvars), S + integer :: i, j, ns + + call read_system(infile) + call from_nml(infile) + X = [-0.41981837560016311, & + -0.79828389545752954, & + -0.93607212819652841, & + -1.1294431131109890, & + -1.2738268650266098, & + -0.37650048779143636, & + -1.0324858608887026, & + 4.5238362455206769, & + 0.29641441051264411, & + 0.62818018210875071, & + 7.9138737267353043E-002, & + -0.25915674873115258, & + -0.47420214799519028, & + -0.72823939039186159, & + -4.5112757160826309, & + -16.235569521702651, & + 4.8671594176813775, & + 0.30843430279212669, & + 1.0000000474974513E-003] + + ns = nvars + S = X(ns) + call F_injection_three_phases(X, ns, S, F, dF) + jac = df + + numjac = derivative(f=fun, x=X, h=1e-15_pr, method='central') + + do ns=1, nvars + print *, ns + do i=1, nvars + print "(I3, x, 3(E10.3, 2x))", i, jac(i,ns), numjac(i,ns), (numjac(i, ns) - jac(i, ns)) * 100 + end do + end do + +contains + function fun(x) + real(pr), intent(in) :: x(:) + real(pr), allocatable :: fun(:) + call F_injection_three_phases(X, ns, S, F, dF) + fun = F + end function +end program From d8e99980bf4bf69e202aad8da59d64b7604a475a Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Wed, 13 Sep 2023 09:33:04 -0300 Subject: [PATCH 38/48] Added Flash subroutine in a phase_equilibria module This should be part of the `yaeos` set later --- src/Flash.f90 | 278 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 278 insertions(+) create mode 100644 src/Flash.f90 diff --git a/src/Flash.f90 b/src/Flash.f90 new file mode 100644 index 0000000..b5c6db1 --- /dev/null +++ b/src/Flash.f90 @@ -0,0 +1,278 @@ +module phase_equilibria + implicit none + +contains + subroutine flash(spec, FIRST, n, z, t, p, v, x, y, rho_x, rho_y, beta, iter) + use constants + use system, only: & + nmodel => thermo_model, ncomb => mixing_rule, ntdep => tdep, & + ac, b, delta1 => del1, rk_or_m => k, & + tc, pc, dceos => dc, omg => w, & + kij_or_k0 => kij, lij, bij + implicit real(pr)(A - H, O - Z) + integer, parameter :: nco=64 + + common /keepK/ saveK, LOG_K2, Pold, Pold2, Told, Told2 + + ! Flash specification, eos id and number of compounds in the system + character*4, intent(in) :: spec + logical, intent(in out) :: FIRST + logical :: stopflash + double precision Kinf + + ! composition of the system + integer, intent(in) :: n + real*8, intent(in) :: z(n) + + ! Temperature and Pressure for the flash + real*8, intent(in) :: t ! Temperature for the flash (K) + real*8 :: p ! (bar) Pressure for the flash (TP) or resulting from (TV) + real*8 :: v ! (L/mol) Molar vol for the flash (TV) or resulting from (TP) + + ! Results from flash calculation + real*8, dimension(n), intent(out) :: x ! composition of liquid (molar fractions) + real*8, dimension(n), intent(out) :: y ! composition of vapour (molar fractions) + real*8, intent(out) :: rho_x ! density of liquid (moles/L) + real*8, intent(out) :: rho_y ! density of vapour (moles/L) + real*8, intent(out) :: beta ! total fraction of vapour (molar base) + integer, intent(out) :: iter ! number of iterations required to converge + + ! Intermediate variables during calculation process + real*8, dimension(n) :: PHILOGy, PHILOGx, DLPHIT, DLPHIP + real*8, dimension(n) :: KFACT, LOG_K, AUXK, var_K, denom, varKold, logKold + real*8, dimension(n, n) :: FUGN + real*8 :: g0, g1 ! function g valuated at beta=0 and 1, based on Wilson K factors + real*8 :: g, dg, bmin, bmax, Vy, Vx + + ! real*8, dimension(nco, nco) :: Kij_or_K0, Tstar + real*8, dimension(nco) :: saveK, LOG_K2 + + do i = 1, n + do j = i, n + bij(i, j) = (1 - lij(i, j))*(b(i) + b(j))/2 + bij(j, i) = bij(i, j) + end do + end do + ! + !----------------------------------------------------------- + ! This algorithm assumes that the specified T and P correspond to + ! vapor-liquid separation predicted by the provided model (00 and g1<0 and therefore 0 1.d-6) + if (maxval(abs(var_K)) > 1.10) then ! 26/11/2014 + g0 = sum(z*KFACT) - 1.D0 + g1 = 1.D0 - sum(z/KFACT) + + if (g0 < 0 .or. g1 > 0) then ! bring beta back to range, by touching KFACT + call betato01(n, z, KFACT) + call betalimits(n, z, KFACT, bmin, bmax) + beta = (bmin + bmax)/2 ! new guess for beta + end if + + end if + + iter = iter + 1 + ! Newton starts here (Rachford-Rice) + g = 1.0 + step = 1.0 + + do while (abs(g) > 1.d-5 .and. abs(step) > 1.d-10) + denom = 1 + beta*(KFACT - 1.D0) + g = sum(z*(KFACT - 1.D0)/denom) + dg = -sum(z*(KFACT - 1.D0)**2/denom**2) + step = -g/dg + beta = beta + step + + do while ((beta < bmin .or. bmax < beta) .and. step > 1e-10) ! much better (GUARANTED!) 3/3/15 + step = step/2 + beta = beta - step + end do + + end do + + denom = 1 + beta*(KFACT - 1.D0) + y = z*KFACT/denom + x = y/KFACT + + ! new for TV Flash + if (spec == 'TV' .or. spec == 'isoV') then ! find Vy,Vx (vV and vL) from V balance and P equality equations + dVydVl = -(1 - beta)/beta + call Bcalc(n, x, T, Bx) + if (Vx < Bx) Vx = 1.625*Bx ! First evaluation will be with Vx = 1.5*Bx + ! Pl = -1.0 + call zTVTERMO(n, 0, T, x, Vx, Pl, DPVl, PHILOGy, DLPHIP, DLPHIT, FUGN) ! 26/06/15 + do while (Pl < 0 .or. DPVl >= 0) + Vx = Vx - 0.2*(Vx - Bx) + call zTVTERMO(n, 0, T, x, Vx, Pl, DPVl, PHILOGy, DLPHIP, DLPHIT, FUGN) + end do + Vy = (v - (1 - beta)*Vx)/beta + h = 1.0 + iterv = 0 + stopflash = .false. + do while (abs(h) > 1.d-4) ! Newton for solving P equality, with Vx as independent variable + iterv = iterv + 1 + if (iterv >= 100) then + write (2, *) 'volume convergence problems' + P = -1.0 + stopflash = .true. + exit + end if + call zTVTERMO(n, 0, T, x, Vx, Pl, DPVl, PHILOGy, DLPHIP, DLPHIT, FUGN) + call zTVTERMO(n, 0, T, y, Vy, Pv, DPVv, PHILOGy, DLPHIP, DLPHIT, FUGN) + h = Pv - Pl + dh = -DPVv*dVydVl - DPVl + stepv = -h/dh + if (iterv >= 10) stepv = stepv/2 + Vx = Vx + stepv + do while (Vx < 1.001*Bx) + stepv = stepv/2 + Vx = Vx - stepv + end do + Vy = (v - (1 - beta)*Vx)/beta + end do + if (stopflash .eqv. .true.) exit + call zTVTERMO(n, 1, T, x, Vx, Pl, DPVl, PHILOGx, DLPHIP, DLPHIT, FUGN) + call zTVTERMO(n, 1, T, y, Vy, Pv, DPVv, PHILOGy, DLPHIP, DLPHIT, FUGN) + else + ! for TP Flash + ! nc,MTYP,INDIC,T,P,rn,V,PHILOG,DLPHI + MTYP = 0 ! -1 (with 0, generalized also fo LL and not only VL) + call TERMO(n, MTYP, 1, T, P, y, Vy, PHILOGy, DLPHIP, DLPHIT, FUGN) + MTYP = 1 + call TERMO(n, MTYP, 1, T, P, x, Vx, PHILOGx, DLPHIP, DLPHIT, FUGN) + end if + + varKold = var_K + logKold = LOG_K ! From previous iteration step + var_K = PHILOGx - PHILOGy - LOG_K ! variation in LOG_K = new - old + LOG_K = PHILOGx - PHILOGy + aux = sum(var_K + varKold) + + if (iter > 10 .and. abs(aux) < 0.05) then ! oscilation behavior detected (27/06/15) + LOG_K = (LOG_K + logKold)/2 + end if + + KFACT = exp(LOG_K) + call betalimits(n, z, KFACT, bmin, bmax) ! 26/06/15 + + if ((beta < bmin) .or. (bmax < beta)) then + beta = (bmin + bmax)/2 + end if + + if (iter > 500) then + p = -1 + return + end if + + end do + + ! WRITE (2,4) (KFACT(i),i=1,N) + rho_x = 1/Vx + rho_y = 1/Vy + if (spec == 'TP') v = beta*Vy + (1 - beta)*Vx + if (spec == 'TV' .or. spec == 'isoV') write (4, *) T, P, Pv + if (spec == 'TV' .or. spec == 'isoV') P = Pv + FIRST = .false. + + if (maxval(KFACT) < 1.001 .and. minval(KFACT) > 0.999) then ! trivial solution + P = -1.0 + return + !go to 31 + end if + saveK(1:n) = KFACT + ! 3 format('KWilson ', 15E12.4) + ! 4 format('KFinal ', 15E12.4) + !----------------------------------------------------------- + + ! print *, x ! Estos print son los que "lee" tanto Fluids como Sur + ! print *, y + ! print *, rho_x + ! print *, rho_y + ! print *, beta + end subroutine flash + + + subroutine betato01(n, z, KFACT) + implicit none + integer, intent(in) :: n ! number of compounds in the system + real*8, dimension(n), intent(in) :: z ! composition of the system + real*8, dimension(n) :: KFACT ! K factors (modified in this routine) + real*8 :: g0, g1 ! function g valuated at beta=0 and 1, based on K factors + + g1 = 1.0 + do while (g0 < 0 .or. g1 > 0) + g0 = sum(z*KFACT) - 1.D0 + g1 = 1.D0 - sum(z/KFACT) + if (g0 < 0) then + KFACT = 1.1*KFACT ! increased volatiliy will bring the solution from subcooled liquid into VLE + else if (g1 > 0) then + KFACT = 0.9*KFACT ! decreased volatiliy will bring the solution from superheated vapor into VLE + end if + end do + end subroutine betato01 + + + subroutine betalimits(n, z, KFACT, bmin, bmax) + implicit none + integer, intent(in) :: n ! number of compounds in the system + real*8, dimension(n), intent(in) :: z, KFACT ! composition of the system and K factors + real*8, intent(out) :: bmin, bmax + real*8, dimension(n) :: vmin, vmax + integer :: i, in, ix + + in = 0 + ix = 0 + vmin = 0.d0 + ! max=1.001d0 ! modified 3/3/15 (not to generate false separations with beta 0.9999...) + vmax = 1.00001d0 ! modified 28/6/15 (to prevent overshooting in the Newton for solving RR eq.) + do i = 1, n + if (KFACT(i)*z(i) > 1) then + in = in + 1 + vmin(in) = (KFACT(i)*z(i) - 1.d0)/(KFACT(i) - 1.d0) + else if (KFACT(i) < z(i)) then + ix = ix + 1 + vmax(ix) = (1.d0 - z(i))/(1.d0 - KFACT(i)) + end if + end do + bmin = maxval(vmin) + bmax = minval(vmax) + end subroutine betalimits +end module From 544f41f87ca5b23ca5828d9a1e932f3cd8565564 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Mon, 18 Sep 2023 11:11:31 -0300 Subject: [PATCH 39/48] fpm details --- fpm.toml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/fpm.toml b/fpm.toml index fca5b20..9941349 100644 --- a/fpm.toml +++ b/fpm.toml @@ -1,8 +1,8 @@ -name = "envelopes" +name = "fenvelopes" version = "0.1.0" license = "license" author = "Federico E. Benelli" -maintainer = "fedebenelli@outlook.com" +maintainer = "federico.benelli@mi.unc.edu.ar" copyright = "Copyright 2023, Federico E. Benelli" [build] @@ -27,4 +27,4 @@ implicit-typing = false # default: false [preprocess] [preprocess.cpp] -[preprocess.fypp] +[preprocess.fypp] \ No newline at end of file From 42d2490a143a05a40810922e695715399ee29ba3 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Mon, 18 Sep 2023 11:11:57 -0300 Subject: [PATCH 40/48] Some (very little) standarization of Flash routine --- src/Flash.f90 | 52 +++++++++++++++++++++++++-------------------------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/src/Flash.f90 b/src/Flash.f90 index b5c6db1..c774d14 100644 --- a/src/Flash.f90 +++ b/src/Flash.f90 @@ -1,28 +1,17 @@ module phase_equilibria + use constants, only: pr + use legacy_ar_models, only: zTVTERMO, termo, n => nc, omg => w, tc, pc implicit none contains - subroutine flash(spec, FIRST, n, z, t, p, v, x, y, rho_x, rho_y, beta, iter) - use constants - use system, only: & - nmodel => thermo_model, ncomb => mixing_rule, ntdep => tdep, & - ac, b, delta1 => del1, rk_or_m => k, & - tc, pc, dceos => dc, omg => w, & - kij_or_k0 => kij, lij, bij - implicit real(pr)(A - H, O - Z) - integer, parameter :: nco=64 - - common /keepK/ saveK, LOG_K2, Pold, Pold2, Told, Told2 - + subroutine flash(spec, FIRST, z, t, p, v, x, y, rho_x, rho_y, beta, iter) ! Flash specification, eos id and number of compounds in the system - character*4, intent(in) :: spec + character(len=*), intent(in) :: spec !! Flash specification [PT | VT] logical, intent(in out) :: FIRST logical :: stopflash - double precision Kinf ! composition of the system - integer, intent(in) :: n - real*8, intent(in) :: z(n) + real*8, intent(in) :: z(:) ! Temperature and Pressure for the flash real*8, intent(in) :: t ! Temperature for the flash (K) @@ -30,8 +19,8 @@ subroutine flash(spec, FIRST, n, z, t, p, v, x, y, rho_x, rho_y, beta, iter) real*8 :: v ! (L/mol) Molar vol for the flash (TV) or resulting from (TP) ! Results from flash calculation - real*8, dimension(n), intent(out) :: x ! composition of liquid (molar fractions) - real*8, dimension(n), intent(out) :: y ! composition of vapour (molar fractions) + real*8, dimension(size(z)), intent(out) :: x ! composition of liquid (molar fractions) + real*8, dimension(size(z)), intent(out) :: y ! composition of vapour (molar fractions) real*8, intent(out) :: rho_x ! density of liquid (moles/L) real*8, intent(out) :: rho_y ! density of vapour (moles/L) real*8, intent(out) :: beta ! total fraction of vapour (molar base) @@ -45,14 +34,21 @@ subroutine flash(spec, FIRST, n, z, t, p, v, x, y, rho_x, rho_y, beta, iter) real*8 :: g, dg, bmin, bmax, Vy, Vx ! real*8, dimension(nco, nco) :: Kij_or_K0, Tstar - real*8, dimension(nco) :: saveK, LOG_K2 + ! real*8, dimension(nco) :: saveK, LOG_K2 + real(8) :: aux, bx, savek(n), log_k2(n) + integer :: MTYP - do i = 1, n - do j = i, n - bij(i, j) = (1 - lij(i, j))*(b(i) + b(j))/2 - bij(j, i) = bij(i, j) - end do - end do + real(8) :: dh, dpv, DPVl, dpvv, dVydVl, h, pl, pold, pold2, pv, step, stepv + real(8) :: told, told2, bij(n, n) + + integer :: i, j, iterv, nco + + ! do i = 1, n + ! do j = i, n + ! bij(i, j) = (1 - lij(i, j))*(b(i) + b(j))/2 + ! bij(j, i) = bij(i, j) + ! end do + ! end do ! !----------------------------------------------------------- ! This algorithm assumes that the specified T and P correspond to @@ -135,7 +131,9 @@ subroutine flash(spec, FIRST, n, z, t, p, v, x, y, rho_x, rho_y, beta, iter) ! new for TV Flash if (spec == 'TV' .or. spec == 'isoV') then ! find Vy,Vx (vV and vL) from V balance and P equality equations dVydVl = -(1 - beta)/beta - call Bcalc(n, x, T, Bx) + ! call Bcalc(n, x, T, Bx) + ! TODO: Add this intiial volume + if (Vx < Bx) Vx = 1.625*Bx ! First evaluation will be with Vx = 1.5*Bx ! Pl = -1.0 call zTVTERMO(n, 0, T, x, Vx, Pl, DPVl, PHILOGy, DLPHIP, DLPHIT, FUGN) ! 26/06/15 @@ -146,6 +144,7 @@ subroutine flash(spec, FIRST, n, z, t, p, v, x, y, rho_x, rho_y, beta, iter) Vy = (v - (1 - beta)*Vx)/beta h = 1.0 iterv = 0 + stopflash = .false. do while (abs(h) > 1.d-4) ! Newton for solving P equality, with Vx as independent variable iterv = iterv + 1 @@ -169,6 +168,7 @@ subroutine flash(spec, FIRST, n, z, t, p, v, x, y, rho_x, rho_y, beta, iter) Vy = (v - (1 - beta)*Vx)/beta end do if (stopflash .eqv. .true.) exit + call zTVTERMO(n, 1, T, x, Vx, Pl, DPVl, PHILOGx, DLPHIP, DLPHIT, FUGN) call zTVTERMO(n, 1, T, y, Vy, Pv, DPVv, PHILOGy, DLPHIP, DLPHIT, FUGN) else From 86bcd885f8eb4b98aa1519b457cda11d4c7f25c2 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Mon, 18 Sep 2023 11:13:02 -0300 Subject: [PATCH 41/48] refactor(envelopes) Don't write if passed max of iterations --- src/new/envelopes.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/new/envelopes.f90 b/src/new/envelopes.f90 index cc2e501..910e840 100644 --- a/src/new/envelopes.f90 +++ b/src/new/envelopes.f90 @@ -432,10 +432,11 @@ subroutine envelope2(ichoice, n, z, T, P, KFACT, & ! This will probably always e end do ! Point converged (unless it jumped out because of high number of iterations) - write(funit_output, *) "SOL", iter, ns, T, P, exp(X(:n)) if (iter > max_iter) run = .false. if (P > maxP) maxP = P + if (run) write(funit_output, *) "SOL", iter, ns, T, P, exp(X(:n)) + if (incipient_phase == "liquid" .and. i > 1) then ! TODO: If this is the way the low p dew line finishes, ! I think this could be better, like using dPdT From 71a62f5781308271b4ed38ae99192d7db860d9a1 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Mon, 18 Sep 2023 11:13:22 -0300 Subject: [PATCH 42/48] feat(CI and docs) --- .github/workflows/CI.yml | 70 ++++++++++++++++++++++++++++++++++++++ .github/workflows/docs.yml | 48 ++++++++++++++++++++++++++ doc/ford-front-matter.md | 28 +++++++++++++++ 3 files changed, 146 insertions(+) create mode 100644 .github/workflows/CI.yml create mode 100644 .github/workflows/docs.yml create mode 100644 doc/ford-front-matter.md diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml new file mode 100644 index 0000000..46e8e21 --- /dev/null +++ b/.github/workflows/CI.yml @@ -0,0 +1,70 @@ +name: CI +on: [push] + +jobs: + Build: + runs-on: ${{ matrix.os }} + strategy: + fail-fast: false + matrix: + os: [ubuntu-latest] + gcc_v: [10] # Version of GFortran we want to use. + python-version: [3.9] + env: + FC: gfortran-${{ matrix.gcc_v }} + GCC_V: ${{ matrix.gcc_v }} + + steps: + - name: Checkout code + uses: actions/checkout@v2 + with: + submodules: recursive + + - name: Install Python + uses: actions/setup-python@v1 # Use pip to install latest CMake, & FORD/Jin2For, etc. + with: + python-version: ${{ matrix.python-version }} + + - name: Setup Graphviz + uses: ts-graphviz/setup-graphviz@v1 + + - name: Setup Fortran Package Manager + uses: fortran-lang/setup-fpm@v4 + with: + github-token: ${{ secrets.GITHUB_TOKEN }} + + - name: Install Python dependencies + if: contains( matrix.os, 'ubuntu') + run: | + python -m pip install --upgrade pip + pip install ford numpy matplotlib + if [ -f requirements.txt ]; then pip install -r requirements.txt; fi + + - name: Install GFortran Linux + if: contains( matrix.os, 'ubuntu') + run: | + sudo apt-get install lcov + sudo update-alternatives \ + --install /usr/bin/gcc gcc /usr/bin/gcc-${{ matrix.gcc_v }} 100 \ + --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-${{ matrix.gcc_v }} \ + --slave /usr/bin/gcov gcov /usr/bin/gcov-${{ matrix.gcc_v }} + + # - name: Compile + # run: fpm build --profile release + + - name: Run tests + run: fpm test --profile debug --flag -coverage + + # - name: Create coverage report + # run: | + # mkdir -p ${{ env.COV_DIR }} + # lcov --capture --initial --base-directory . --directory build/gfortran_*/ --output-file ${{ env.COV_DIR }}/coverage.base + # lcov --capture --base-directory . --directory build/gfortran_*/ --output-file ${{ env.COV_DIR }}/coverage.capture + # lcov --add-tracefile ${{ env.COV_DIR }}/coverage.base --add-tracefile ${{ env.COV_DIR }}/coverage.capture --output-file ${{ env.COV_DIR }}/coverage.info + # env: + # COV_DIR: build/coverage + + # - name: Upload coverage report + # uses: codecov/codecov-action@v2 + # with: + # files: build/coverage/coverage.info \ No newline at end of file diff --git a/.github/workflows/docs.yml b/.github/workflows/docs.yml new file mode 100644 index 0000000..7d41228 --- /dev/null +++ b/.github/workflows/docs.yml @@ -0,0 +1,48 @@ +name: Build and Deploy Documentation + +on: [push, pull_request] + +jobs: + documentation: + runs-on: ubuntu-22.04 + + env: + FC: gfortran + GCC_V: 12 + + steps: + - name: Checkout code + uses: actions/checkout@v3 + + - name: Install Dependencies Ubuntu + run: | + sudo apt-get update + sudo apt install -y gfortran-${GCC_V} python3-dev graphviz + sudo pip install ford markdown==3.3.4 + + - name: Build Developer Documentation + run: | + ford doc/ford-front-matter.md + + - name: Upload Documentation + uses: actions/upload-artifact@v2 + with: + name: documentation + path: doc/ford_site + if-no-files-found: error + + - name: Broken Link Check + if: ${{ github.ref == 'refs/heads/main'}} + uses: technote-space/broken-link-checker-action@v1 + with: + TARGET: file://${{ github.workspace }}/ford_site/index.html + RECURSIVE: true + ASSIGNEES: ${{ github.actor }} + + - name: Deploy API Documentation + uses: JamesIves/github-pages-deploy-action@4.1.0 + if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/main' }} + with: + github_token: ${{ secrets.GITHUB_TOKEN }} + branch: gh-pages + folder: doc/ford_site diff --git a/doc/ford-front-matter.md b/doc/ford-front-matter.md new file mode 100644 index 0000000..577429f --- /dev/null +++ b/doc/ford-front-matter.md @@ -0,0 +1,28 @@ +project: fenvelopes +summary: Calculation of phase envelops using Equations of State +project_github: https://github.com/fedebenelli/fenvelopes +author: Federico Benelli +author_description: PhD student with focus on reservoir PVT simulation. +author_email: federico.benelli@mi.unc.edu.ar +github: https://github.com/fedebenelli +src_dir: ../src +exclude_dir: ../test ../doc +output_dir: ../doc/ford_site +preprocessor: gfortran -E +display: public + protected + private +source: false +proc_internals: true +sort: permission-alpha +docmark_alt: -| +docmark: | +predocmark_alt: * +print_creation_date: true +creation_date: %Y-%m-%d %H:%M %z +md_extensions: markdown.extensions.toc + markdown.extensions.smarty +graph: true +license: MIT + +{!../README.md!} \ No newline at end of file From e361c1dadc44f64f4c10d3fa762e8c9518ecd78e Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Mon, 18 Sep 2023 11:59:01 -0300 Subject: [PATCH 43/48] moved out gnuplotting --- plot.gnu | 17 ----------------- plot_x.gnu | 17 ----------------- 2 files changed, 34 deletions(-) delete mode 100644 plot.gnu delete mode 100644 plot_x.gnu diff --git a/plot.gnu b/plot.gnu deleted file mode 100644 index dc11b43..0000000 --- a/plot.gnu +++ /dev/null @@ -1,17 +0,0 @@ -#!/usr/bin/env gnuplot --persist - -set terminal qt 0 size 500,400 font ",20" - -set key left - -set mxtics -set mytics - -set xlabel "Temperature [K]" -set ylabel "Pressure [bar]" - -plot "ENV2_OUT_1" index 0 using 1:2 with lines linecolor rgb "black" title "inc: Vapor", \ - "ENV2_OUT_1" index 1 using 1:2 with lines linecolor rgb "blue" title "inc: Liquid", \ - "ENV2_OUT_1" index 2 using 1:2 with points linestyle 7 lc rgb "black" title "CP" - -pause mouse close diff --git a/plot_x.gnu b/plot_x.gnu deleted file mode 100644 index 854e9fe..0000000 --- a/plot_x.gnu +++ /dev/null @@ -1,17 +0,0 @@ -#!/usr/bin/gnuplot -persist - -set key left -set mytics 4 -set mxtics 5 - -set xlabel "x" -set ylabel "P [bar]" - -plot "./output/env-2ph-PX_1.dat" u 4:5 w lp t "Bubble Line", \ - "./output/env-2ph-PX_2.dat" u 4:5 w lp t "Dew Line", \ - "./output/env-3ph-PX_3.dat" u 4:5 w lp t "3ph-vapor", \ - "./output/env-3ph-PX_4.dat" u 4:5 w lp t "3ph-liquid", \ - "./output/env-3ph-PX_3.dat" index "critical" u 1:2 w p t "" pt 7 lc rgb "black", \ - "./output/env-3ph-PX_4.dat" index "critical" u 1:2 w p t "" pt 7 lc rgb "black" - -pause mouse close From 52bcfbc801a1862e0830634ac2e0a84c9cdec548 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Mon, 18 Sep 2023 11:59:17 -0300 Subject: [PATCH 44/48] external tools --- tools/plot_pt.gnu | 16 ++++++++++++++++ tools/plot_px.gnu | 32 ++++++++++++++++++++++++++++++++ tools/run.py | 16 ++++++++++++++++ 3 files changed, 64 insertions(+) create mode 100644 tools/plot_pt.gnu create mode 100644 tools/plot_px.gnu create mode 100644 tools/run.py diff --git a/tools/plot_pt.gnu b/tools/plot_pt.gnu new file mode 100644 index 0000000..5c6382c --- /dev/null +++ b/tools/plot_pt.gnu @@ -0,0 +1,16 @@ +#!/usr/bin/env gnuplot --persist + +set terminal qt 0 size 500,400 font ",20" + +set key left + +set mxtics +set mytics + +set xlabel "Temperature [K]" +set ylabel "Pressure [bar]" + +plot "output/env-2ph-PT_1.dat" u 4:5 w l lc "blue" ,\ + "output/env-2ph-PT_2.dat" u 4:5 w l lc "black" ,\ + +pause mouse close \ No newline at end of file diff --git a/tools/plot_px.gnu b/tools/plot_px.gnu new file mode 100644 index 0000000..aeb5ac7 --- /dev/null +++ b/tools/plot_px.gnu @@ -0,0 +1,32 @@ +#!/usr/bin/gnuplot -persist + +set key left +set mytics 4 +set mxtics 5 + +set xlabel "x" +set ylabel "P [bar]" + +set xrange [0:1] +set xrange [0:1] +set yrange [0:2000] + +dew_2ph = 1 +bub_2ph = 2 +dew_3ph = 3 +bub_3ph = 4 + +set style line dew_2ph lc rgb "blue" +set style line bub_2ph lc rgb "black" + +set style line dew_3ph lc rgb "blue" dashtype 2 +set style line bub_3ph lc rgb "black" dashtype 2 + + +plot "./output/env-2ph-PX_1.dat" u 4:5 w l ls bub_2ph t "Bubble Line", \ + "./output/env-2ph-PX_2.dat" u 4:5 w l ls dew_2ph t "Dew Line", \ + "./output/env-3ph-PX_3.dat" u 4:5 w l ls bub_3ph t "3ph-vapor", \ + "./output/env-3ph-PX_4.dat" u 4:5 w l ls dew_3ph t "3ph-liquid", \ + "./output/env-3ph-PX_3.dat" index "critical" u 1:2 w p t "" pt 7 lc rgb "black", \ + "./output/env-3ph-PX_4.dat" index "critical" u 1:2 w p t "" pt 7 lc rgb "black" +pause mouse close diff --git a/tools/run.py b/tools/run.py new file mode 100644 index 0000000..61d7d6f --- /dev/null +++ b/tools/run.py @@ -0,0 +1,16 @@ +import f90nml +import os +import shutil as sh + +nml = f90nml.read("infiles/case2.nml") + +z_c2 = [0, 5, 10, 15, 20, 25, 30] + +z_c2 = [int(i) for i in range(0, 101, 5)] + +for z in z_c2: + nml["nml_px"]["z_injection"][3] = 100 - z + nml["nml_px"]["z_injection"][4] = z + nml.write("tmp_infile.nml", force=True) + os.system("fpm run --profile release -- --infile tmp_infile.nml") + sh.copytree("output", f"run_outputs/output_{z:03d}") \ No newline at end of file From 87741136c2c9bebf69742df4c94459dd673879cf Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Mon, 18 Sep 2023 11:59:45 -0300 Subject: [PATCH 45/48] Added minpack dependency to CI --- .github/workflows/CI.yml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 46e8e21..3217504 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -48,6 +48,11 @@ jobs: --install /usr/bin/gcc gcc /usr/bin/gcc-${{ matrix.gcc_v }} 100 \ --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-${{ matrix.gcc_v }} \ --slave /usr/bin/gcov gcov /usr/bin/gcov-${{ matrix.gcc_v }} + + - name: Install dependencies + if: contains( matrix.os, 'ubuntu') + run: | + sudo apt-get install minpack-dev # - name: Compile # run: fpm build --profile release From 2b8e8fb053bf32f38f20737a4deb84420922cf47 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Mon, 18 Sep 2023 11:59:56 -0300 Subject: [PATCH 46/48] refactor(output_dir) --- src/new/constants.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/new/constants.f90 b/src/new/constants.f90 index b96a97c..f985e16 100644 --- a/src/new/constants.f90 +++ b/src/new/constants.f90 @@ -5,6 +5,6 @@ module constants integer, parameter :: pr = real64 real(pr), parameter :: R = 0.08314472 character(len=254) :: database_path = "database/" - character(len=254) :: ouput_path = "output/" + character(len=254) :: ouput_path = "fenvelopes_output/" character(len=1) :: path_sep = "/" end module constants From 881fa9425efbbbfa1491070ba67b8757272a3557 Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Mon, 18 Sep 2023 12:00:13 -0300 Subject: [PATCH 47/48] Updated readme --- README.md | 108 ++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 85 insertions(+), 23 deletions(-) diff --git a/README.md b/README.md index 560197a..7ee9f59 100644 --- a/README.md +++ b/README.md @@ -1,11 +1,37 @@ -# envelopes -Simple program to calculate biphasic phase envolopes +# fenvelopes +Fortran program to calculate phase envelopes. -## Input files -The program assumes there is a `input.nml` file at it's path, which contains -all the relevant data for the system. +This is an ongoing project that intends te be a fully fledged generator of phase +equilibria diagrams using Equations of State. + +## Capabilities +Right now `fenvelopes` calculates three kinds of phase-envelopes. + +- [x] Two-phase PT envelopes +- [ ] Three-phase PT envelopes +- [x] Two-phase Px envelopes +- [ ] Three-phase Px envelopes + - [x] Px envelopes based on double saturation points. + - [ ] Isolated Px envelopes. +- [ ] Python wrappers to ease up scripting and plotting. + +## Usage +This program is intended to be used as a `CLI` software. The command used to +calculate phase diagrams is: + +```bash +fenvelopes --infile input_file.nml +``` + +This will generate an `fenvelopes_output` directory. Which contains all the +generated output files with the relevant data. + +### Input files +The input files ```fortran +! input.nml +! ! Namelist based input file ! ========================= ! @@ -17,24 +43,26 @@ all the relevant data for the system. &nml_setup + ! General settings nc=5, ! Number of components model="PR78", ! SRK PR76 PR78 - mixrule="ClassicVdW" ! only ClassicVdW + mixrule="ClassicVdW" ! only ClassicVdW for now / &nml_composition names="PC1" "PC2" "PC3" "PC4" "H2O" - spec="critical", ! critical or parameters + spec="critical", ! critical or parameters specification z=0.15 0.10 0.10 0.15 0.50 / -&nml_classicvdw +&nml_classicvdw ! Classic VdW mixing rule parameters ! kij matrix - kij(1, :)=0 0 0 0 0.7192 - kij(2, :)=0 0 0 0 0.4598 - kij(3, :)=0 0 0 0 0.2673 - kij(4, :)=0 0 0 0 0.2417 - kij(5, :)=0.7192 0.4598 0.2673 0.2417 0 + kij(1, :)=0 0 0 0 0.7192 + kij(2, :)=0 0 0 0 0.4598 + kij(3, :)=0 0 0 0 0.2673 + kij(4, :)=0 0 0 0 0.2417 + kij(5, :)=0.7192 0.4598 0.2673 0.2417 0 + ! lij matrix lij(:, :) = 0 / @@ -51,18 +79,52 @@ all the relevant data for the system. ! Acentric Factor w=0.098 0.535 0.891 1.085 0.344 / + +&nml_px ! Px envelopes relevant info + ! Temperature + T=350.0 + + ! Initial composition, ussualy the same as the main fluid. + z_0=0.15 0.10 0.10 0.15 0.50 + + ! Injection fluid composition + z_injection=1 0 0 0 0 + + ! Which kind of injection to realize + injection_case="displace" ! [dilute|displace] +/ ``` -## Execution -This program is intended to work with `fpm`, to run it just use `fpm run` +### Output +All the output is directed to a generated folder `fenvelopes_output`. With the files + +`env-ph-_.dat` + +Were all the envelope's calculated points are written in a `csv-like` format, +delimited by spaces. + +## Installation +This program uses [`fpm`](https://fpm.fortran-lang.org) as a builder. `fpm` +handles all the needed dependencies and compiling procedures. +It is distributed in many ways, but we recommend the `pip` distribution. -## Output -Several output files are produced, `X_it*` files correspond to each iteration -point, `ENV2_OUT*` files correspond to the phase envelope structured to plot -with gnuplot, and there is also an `output.csv` file that contains the same -information but on another format. +```bash +# using pipx +pipx install fpm +``` + +To install this program is as simple as: + +``` +git clone https://www.github.com/fedebenelli/envelopes +cd envelopes +fpm install --profile release +``` +This will make `fenvelopes` accessible from any directory of your computer -There is a simple `gnuplot` script to plot the phase envelope, just run -`gnuplot plot.gnu` to make the plot. It should look like this: +If you don't want to install the program and just run it you can also run it +with `fpm` -![](figs/example.png) +```bash +fpm run --profile release -- --infile +``` \ No newline at end of file From d4c2af12a54695efe7e456eb77b3a33361b456dd Mon Sep 17 00:00:00 2001 From: "Federico E. Benelli" Date: Mon, 18 Sep 2023 12:32:52 -0300 Subject: [PATCH 48/48] test infile --- test/test_f3.nml | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 test/test_f3.nml diff --git a/test/test_f3.nml b/test/test_f3.nml new file mode 100644 index 0000000..a8a2397 --- /dev/null +++ b/test/test_f3.nml @@ -0,0 +1,44 @@ +&nml_setup + nc=8, ! Number of components + model="PR78", ! SRK PR76 PR78 RKPR + mixrule="ClassicVdW" ! ClassicVdW +/ + +&nml_composition + names="CO2" "C1-N2" "C2-C3" "C4" "C5" "C6" "C7+n" "Asph" + spec="critical", ! critical or parameters + z=0.0246 0.3694 0.0752 0.0193 0.0157 0.0162 0.47145 0.00815 +/ + +&nml_classicvdw + kij(1, :)=0 0 0 0 0 0 0 0 + kij(2, :)=0 0 0 0 0 0 0.053 0.135 + kij(3, :)=0 0 0 0 0 0 0 0.135 + kij(4, :)=0 0 0 0 0 0 0 0.135 + kij(5, :)=0 0 0 0 0 0 0 0.135 + kij(6, :)=0 0 0 0 0 0 0 0 + kij(7, :)=0 0.053 0 0 0 0 0 0 + kij(8, :)=0 0.135 0.135 0.135 0.135 0 0 0 + + lij(1, :)=0 0 0 0 0 0 0 0 + lij(2, :)=0 0 0 0 0 0 0 0 + lij(3, :)=0 0 0 0 0 0 0 0 + lij(4, :)=0 0 0 0 0 0 0 0 + lij(5, :)=0 0 0 0 0 0 0 0 + lij(6, :)=0 0 0 0 0 0 0 0 + lij(7, :)=0 0 0 0 0 0 0 0 + lij(8, :)=0 0 0 0 0 0 0 0 +/ + +&nml_critical + tc=304.0390 189.4280 339.8720 419.8170 465.0940 507.3170 860.3720 1424.8170 + pc=73.7900 45.8300 45.4100 37.5400 33.8000 32.9000 12.4600 12.2900 + w=0.225000 0.008500 0.127100 0.187800 0.239700 0.275000 1.022000 1.441000 +/ + +&nml_px + T=500.0 + z_0=0.0246 0.3694 0.0752 0.0193 0.0157 0.0162 0.47145 0.00815 + z_injection=1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + injection_case="displace" ! [dilute|displace] +/