From 05b17f3eac3be78e7b09fd994ffa0b2259860396 Mon Sep 17 00:00:00 2001 From: fedebenelli Date: Wed, 18 Dec 2024 13:11:42 -0300 Subject: [PATCH] greg --- example/extra/taperobinson.f90 | 8 +- src/adiff/autodiff_api/tapenade_ar_api.f90 | 17 - src/models/residual_helmholtz/gerg2008.f90 | 3696 ++++++++++++++++++++ src/models/substance.f90 | 1 + test/fixtures/taperobinson.f90 | 8 +- test/test_tapenade.f90 | 1821 ++++++++++ 6 files changed, 5526 insertions(+), 25 deletions(-) create mode 100644 src/models/residual_helmholtz/gerg2008.f90 create mode 100644 test/test_tapenade.f90 diff --git a/example/extra/taperobinson.f90 b/example/extra/taperobinson.f90 index 71e13d53a..d7c4ba4af 100644 --- a/example/extra/taperobinson.f90 +++ b/example/extra/taperobinson.f90 @@ -30,7 +30,7 @@ MODULE autodiff_tapenade_pr76_demo procedure :: ar_b procedure :: ar_d_b procedure :: ar_d_d - procedure :: v0 => VOLUME_INITALIZER + procedure :: get_v0 => VOLUME_INITALIZER end type TPR76 CONTAINS @@ -1352,15 +1352,15 @@ SUBROUTINE AR(model, n, v, t, arval) & arg11))*(r*t) end subroutine AR - PURE FUNCTION VOLUME_INITALIZER(model, n, p, t) RESULT (v0) + FUNCTION VOLUME_INITALIZER(self, n, p, t) RESULT (v0) IMPLICIT NONE - class(TPR76), INTENT(IN) :: model + class(TPR76), INTENT(IN) :: self REAL(pr), INTENT(IN) :: n(:) REAL(pr), INTENT(IN) :: p REAL(pr), INTENT(IN) :: t REAL(pr) :: v0 INTRINSIC SUM - v0 = SUM(n*model%b)/SUM(model%b) + v0 = SUM(n*self%b)/SUM(self%b) end function VOLUME_INITALIZER end module autodiff_tapenade_pr76_demo diff --git a/src/adiff/autodiff_api/tapenade_ar_api.f90 b/src/adiff/autodiff_api/tapenade_ar_api.f90 index 6b4d70779..5c371daeb 100644 --- a/src/adiff/autodiff_api/tapenade_ar_api.f90 +++ b/src/adiff/autodiff_api/tapenade_ar_api.f90 @@ -16,9 +16,7 @@ module yaeos__tapenade_ar_api procedure(tapenade_ar_b), deferred :: ar_b procedure(tapenade_ar_d_b), deferred :: ar_d_b procedure(tapenade_ar_d_d), deferred :: ar_d_d - procedure(tapenade_v0), deferred :: v0 procedure :: residual_helmholtz => residual_helmholtz - procedure :: get_v0 => get_v0 end type abstract interface @@ -73,13 +71,6 @@ subroutine tapenade_ar_d_d(model, n, nd, v, vd0, vd, t, td0, td, & real(pr), intent(in) :: nd(:), vd, td real(pr), intent(out) :: arval, arvald0, arvald, arvaldd end subroutine - - pure function tapenade_v0(model, n, p, t) - import pr, ArModelTapenade - class(ArModelTapenade), intent(in) :: model - real(pr), intent(in) :: n(:), p, t - real(pr) :: tapenade_v0 - end function end interface contains @@ -217,12 +208,4 @@ function get_ArnX(var) get_ArnX = nb end function end subroutine - - function get_v0(self, n, p, t) - class(ArModelTapenade), intent(in) :: self - real(pr), intent(in) :: n(:), p, t - real(pr) :: get_v0 - - get_v0 = self%v0(n, p, t) - end function end module diff --git a/src/models/residual_helmholtz/gerg2008.f90 b/src/models/residual_helmholtz/gerg2008.f90 new file mode 100644 index 000000000..e27cc7b18 --- /dev/null +++ b/src/models/residual_helmholtz/gerg2008.f90 @@ -0,0 +1,3696 @@ +! Generated by TAPENADE (INRIA, Ecuador team) +! Tapenade 3.16 (develop) - 13 Sep 2023 12:36 +! +! Generated by TAPENADE (INRIA, Ecuador team) +! Tapenade 3.16 (develop) - 13 Sep 2023 12:36 +! +! Generated by TAPENADE (INRIA, Ecuador team) +! Tapenade 3.16 (develop) - 13 Sep 2023 12:36 +! +! Generated by TAPENADE (INRIA, Ecuador team) +! Tapenade 3.16 (develop) - 13 Sep 2023 12:36 +! +! Generated by TAPENADE (INRIA, Ecuador team) +! Tapenade 3.16 (develop) - 13 Sep 2023 12:36 +! +MODULE YAEOS__MODELS_AR_GERG2008 + USE YAEOS__TAPENADE_AR_API, ONLY : armodeltapenade + USE YAEOS__TAPENADE_INTERFACES + use yaeos__constants, only: Ryaeos => R !! Ideal gas constants used on yaeos + use yaeos__models_ar_cubic_implementations, only: SoaveRedlichKwong + use yaeos__models_ar_genericcubic, only: CubicEoS + IMPLICIT NONE + + TYPE GERG2008PURE + INTEGER :: kpol + INTEGER :: kexp + REAL(pr), ALLOCATABLE :: n(:) + REAL(pr), ALLOCATABLE :: d(:) + REAL(pr), ALLOCATABLE :: t(:) + REAL(pr), ALLOCATABLE :: c(:) + end type GERG2008PURE + + + TYPE GERG2008BINARY + REAL(pr) :: bv !! Binary volume interaction parameters + REAL(pr) :: gv !! Binary volume interaction parameters + REAL(pr) :: bt !! Binary temperature interaction parameters + REAL(pr) :: gt !! Binary temperature interaction parameters + INTEGER :: kpolij + INTEGER :: kexpij + REAL(pr), ALLOCATABLE :: nij(:) + REAL(pr), ALLOCATABLE :: dij(:) + REAL(pr), ALLOCATABLE :: tij(:) + REAL(pr), ALLOCATABLE :: ethaij(:) + REAL(pr), ALLOCATABLE :: epsij(:) + REAL(pr), ALLOCATABLE :: betaij(:) + REAL(pr), ALLOCATABLE :: gammaij(:) + REAL(pr) :: fij + end type GERG2008BINARY + + type, extends(ArModelTapenade) :: Gerg2008 + type(GERG2008PURE), ALLOCATABLE :: pures(:) + type(GERG2008BINARY), ALLOCATABLE :: binaries(:, :) + type(CubicEoS) :: srk + contains + procedure :: ar + procedure :: ar_d + procedure :: ar_b + procedure :: ar_d_b + procedure :: ar_d_d + procedure :: get_v0 => VOLUME_INITALIZER + end type Gerg2008 + +CONTAINS +! Differentiation of reducing_functions_d in reverse (adjoint) mode (with options noISIZE): +! gradient of useful results: trd tr nd n vrd vr +! with respect to varying inputs: nd n +! Differentiation of reducing_functions in forward (tangent) mode (with options noISIZE): +! variations of useful results: tr vr +! with respect to varying inputs: n + SUBROUTINE REDUCING_FUNCTIONS_D_B(model, n, nb, nd, ndb, vr, vrb, vrd& + & , vrdb, tr, trb, trd, trdb) + IMPLICIT NONE + class(GERG2008), INTENT(IN) :: model + REAL(pr), INTENT(IN) :: n(:) + REAL(pr) :: nb(:) + REAL(pr), INTENT(IN) :: nd(:) + REAL(pr) :: ndb(:) + REAL(pr) :: vr + REAL(pr) :: vrb + REAL(pr) :: vrd + REAL(pr) :: vrdb + REAL(pr) :: tr + REAL(pr) :: trb + REAL(pr) :: trd + REAL(pr) :: trdb + REAL(pr) :: vc(SIZE(n)), tc(SIZE(n)), x(SIZE(n)), rho_c(SIZE(n)) + REAL(pr) :: xb(SIZE(n)) + REAL(pr) :: xd(SIZE(n)) + REAL(pr) :: xdb(SIZE(n)) + REAL(pr) :: bv(SIZE(n), SIZE(n)), gv(SIZE(n), SIZE(n)) + REAL(pr) :: bt(SIZE(n), SIZE(n)), gt(SIZE(n), SIZE(n)) + INTEGER :: i, j, nc + INTRINSIC SUM + INTRINSIC SQRT + INTRINSIC SIZE + REAL(pr), DIMENSION(SIZE(n)) :: arg1 + REAL(pr), DIMENSION(SIZE(n)) :: arg1b + REAL(pr), DIMENSION(SIZE(n)) :: arg1d + REAL(pr), DIMENSION(SIZE(n)) :: arg1db + REAL(pr) :: arg10 + REAL(pr) :: result1 + REAL(pr) :: temp + REAL(pr) :: tempb + REAL(pr) :: temp0 + REAL(pr) :: temp0b + REAL(pr) :: temp1 + REAL(pr) :: temp1b + REAL(pr) :: temp2 + REAL(pr) :: temp2b + REAL(pr) :: temp3 + REAL(pr) :: temp3b + REAL(pr), DIMENSION(SIZE(n, 1)) :: tempb0 + REAL(pr), DIMENSION(SIZE(n, 1)) :: temp4 + REAL(pr) :: temp5 + REAL(pr), DIMENSION(SIZE(n, 1)) :: tempb1 + REAL(pr) :: tempb2 + REAL(pr) :: temp6 + REAL(pr) :: tempb3 + REAL(pr) :: temp7 + REAL(pr) :: tempb4 + INTEGER :: ad_from + REAL(pr) :: result10 + vc = model%components%vc + tc = model%components%tc + bv = model%binaries%bv + gv = model%binaries%gv + bt = model%binaries%bt + gt = model%binaries%gt + rho_c = 1/vc + temp = SUM(n) + xd = (nd-n*SUM(nd)/temp)/temp + x = n/temp + nc = SIZE(n) + arg1d(:) = vc*2*n*nd + arg1(:) = n**2*vc + arg1d(:) = tc*2*n*nd + arg1(:) = n**2*tc + DO i=1,nc + ad_from = i + 1 + DO j=ad_from,nc + CALL PUSHREAL8(temp) + temp = 2*bv(i, j)*gv(i, j)*((rho_c(i)**(-(1.0/3))+rho_c(j)**(-(& + & 1.0/3)))*(rho_c(i)**(-(1.0/3))+rho_c(j)**(-(1.0/3)))*(rho_c(i)& + & **(-(1.0/3))+rho_c(j)**(-(1.0/3)))) + CALL PUSHREAL8(temp3) + arg10 = tc(i)*tc(j) + result1 = SQRT(arg10) + temp3 = 2*bt(i, j)*gt(i, j)*result1 + CALL PUSHREAL8(temp) + END DO + CALL PUSHINTEGER4(ad_from) + END DO + xdb = 0.0_pr + xb = 0.0_pr + DO i=nc,1,-1 + CALL POPINTEGER4(ad_from) + DO j=nc,ad_from,-1 + temp2 = bt(i, j)*bt(i, j) + temp1 = temp2*x(i) + x(j) + temp5 = temp2*xd(i) + xd(j) + tempb4 = temp3*trdb/temp1 + tempb3 = (x(i)+x(j))*tempb4 + tempb = temp3*trb - temp5*tempb4 + temp0 = x(i)*x(j) + temp = temp0*(x(i)+x(j))/temp1 + temp6 = x(j)*xd(i) + x(i)*xd(j) + xb(i) = xb(i) + temp6*tempb4 + xb(j) = xb(j) + temp6*tempb4 + xd(i)*tempb3 + temp0b = (xd(i)+xd(j))*tempb4 + xdb(i) = xdb(i) + temp0*tempb4 + xdb(j) = xdb(j) + temp0*tempb4 + xdb(i) = xdb(i) - temp2*temp*tempb4 + xdb(j) = xdb(j) - temp*tempb4 + temp1b = -(((x(i)+x(j))*temp6+temp0*(xd(i)+xd(j))-temp*temp5)*& + & tempb4/temp1) + xdb(i) = xdb(i) + x(j)*tempb3 + xdb(j) = xdb(j) + x(i)*tempb3 + CALL POPREAL8(temp) + temp7 = temp0/temp1 + xb(i) = xb(i) + xd(j)*tempb3 + temp7*tempb + xb(j) = xb(j) + temp7*tempb + tempb4 = (x(i)+x(j))*tempb/temp1 + temp0b = temp0b + tempb4 + temp1b = temp1b - temp7*tempb4 + xb(i) = xb(i) + x(j)*temp0b + xb(j) = xb(j) + x(i)*temp0b + xb(i) = xb(i) + temp2*temp1b + xb(j) = xb(j) + temp1b + temp0 = bv(i, j)*bv(i, j) + temp1 = 8*(temp0*x(i)+x(j)) + temp2 = x(i)*x(j) + temp3 = temp2*(x(i)+x(j))/temp1 + temp6 = x(j)*xd(i) + x(i)*xd(j) + temp7 = temp0*xd(i) + xd(j) + tempb2 = temp*vrdb/temp1 + temp3b = temp*vrb - 8*temp7*tempb2 + xb(i) = xb(i) + temp6*tempb2 + tempb3 = (x(i)+x(j))*tempb2 + xb(j) = xb(j) + temp6*tempb2 + xd(i)*tempb3 + temp2b = (xd(i)+xd(j))*tempb2 + xdb(i) = xdb(i) + temp2*tempb2 + xdb(j) = xdb(j) + temp2*tempb2 + tempb4 = -(8*temp3*tempb2) + temp1b = -(((x(i)+x(j))*temp6+temp2*(xd(i)+xd(j))-8*temp3*temp7)& + & *tempb2/temp1) + xdb(i) = xdb(i) + temp0*tempb4 + xdb(j) = xdb(j) + tempb4 + xdb(i) = xdb(i) + x(j)*tempb3 + xdb(j) = xdb(j) + x(i)*tempb3 + CALL POPREAL8(temp3) + temp5 = temp2/temp1 + xb(i) = xb(i) + xd(j)*tempb3 + temp5*temp3b + xb(j) = xb(j) + temp5*temp3b + tempb2 = (x(i)+x(j))*temp3b/temp1 + temp2b = temp2b + tempb2 + temp1b = temp1b - temp5*tempb2 + xb(i) = xb(i) + x(j)*temp2b + xb(j) = xb(j) + x(i)*temp2b + xb(i) = xb(i) + temp0*8*temp1b + xb(j) = xb(j) + 8*temp1b + CALL POPREAL8(temp) + END DO + END DO + temp5 = SUM(nd) + tempb0 = xdb/temp + tempb1 = -(temp5*tempb0/temp) + temp4 = n/temp + result10 = SUM((nd-temp5*temp4)*tempb0) + tempb = -(SUM(n*xb)/temp**2) - result10/temp - SUM(temp4*tempb1) + arg1b = 0.0_pr + arg1b = trb + arg1db = 0.0_pr + arg1db = trdb + nb = nb + 2*n*tc*arg1b + nd*tc*2*arg1db + ndb = ndb + n*tc*2*arg1db + arg1b = 0.0_pr + arg1b = vrb + arg1db = 0.0_pr + arg1db = vrdb + nb = nb + 2*n*vc*arg1b + nd*vc*2*arg1db + xb/temp + tempb1 + tempb + ndb = ndb + n*vc*2*arg1db + tempb0 - SUM(temp4*tempb0) + end subroutine REDUCING_FUNCTIONS_D_B + +! Differentiation of reducing_functions in forward (tangent) mode (with options noISIZE): +! variations of useful results: tr vr +! with respect to varying inputs: n + SUBROUTINE REDUCING_FUNCTIONS_D(model, n, nd, vr, vrd, tr, trd) + IMPLICIT NONE + class(GERG2008), INTENT(IN) :: model + REAL(pr), INTENT(IN) :: n(:) + REAL(pr), INTENT(IN) :: nd(:) + REAL(pr), INTENT(OUT) :: vr + REAL(pr), INTENT(OUT) :: vrd + REAL(pr), INTENT(OUT) :: tr + REAL(pr), INTENT(OUT) :: trd + REAL(pr) :: vc(SIZE(n)), tc(SIZE(n)), x(SIZE(n)), rho_c(SIZE(n)) + REAL(pr) :: xd(SIZE(n)) + REAL(pr) :: bv(SIZE(n), SIZE(n)), gv(SIZE(n), SIZE(n)) + REAL(pr) :: bt(SIZE(n), SIZE(n)), gt(SIZE(n), SIZE(n)) + INTEGER :: i, j, nc + INTRINSIC SUM + INTRINSIC SQRT + INTRINSIC SIZE + REAL(pr), DIMENSION(SIZE(n)) :: arg1 + REAL(pr), DIMENSION(SIZE(n)) :: arg1d + REAL(pr) :: arg10 + REAL(pr) :: result1 + REAL(pr) :: temp + REAL(pr) :: temp0 + REAL(pr) :: temp1 + REAL(pr) :: temp2 + REAL(pr) :: temp3 + vc = model%components%vc + tc = model%components%tc + bv = model%binaries%bv + gv = model%binaries%gv + bt = model%binaries%bt + gt = model%binaries%gt + rho_c = 1/vc + temp = SUM(n) + xd = (nd-n*SUM(nd)/temp)/temp + x = n/temp + nc = SIZE(n) + arg1d(:) = vc*2*n*nd + arg1(:) = n**2*vc + vrd = SUM(arg1d(:)) + vr = SUM(arg1(:)) + arg1d(:) = tc*2*n*nd + arg1(:) = n**2*tc + trd = SUM(arg1d(:)) + tr = SUM(arg1(:)) + DO i=1,nc + DO j=i+1,nc + temp = 2*bv(i, j)*gv(i, j)*((rho_c(i)**(-(1.0/3))+rho_c(j)**(-(& + & 1.0/3)))*(rho_c(i)**(-(1.0/3))+rho_c(j)**(-(1.0/3)))*(rho_c(i)& + & **(-(1.0/3))+rho_c(j)**(-(1.0/3)))) + temp0 = bv(i, j)*bv(i, j) + temp1 = 8*(temp0*x(i)+x(j)) + temp2 = x(i)*x(j) + temp3 = temp2*(x(i)+x(j))/temp1 + vrd = vrd + temp*((x(i)+x(j))*(x(j)*xd(i)+x(i)*xd(j))+temp2*(xd(& + & i)+xd(j))-temp3*8*(temp0*xd(i)+xd(j)))/temp1 + vr = vr + temp*temp3 + arg10 = tc(i)*tc(j) + result1 = SQRT(arg10) + temp3 = 2*bt(i, j)*gt(i, j)*result1 + temp2 = bt(i, j)*bt(i, j) + temp1 = temp2*x(i) + x(j) + temp0 = x(i)*x(j) + temp = temp0*(x(i)+x(j))/temp1 + trd = trd + temp3*((x(i)+x(j))*(x(j)*xd(i)+x(i)*xd(j))+temp0*(xd& + & (i)+xd(j))-temp*(temp2*xd(i)+xd(j)))/temp1 + tr = tr + temp3*temp + END DO + END DO + end subroutine REDUCING_FUNCTIONS_D + +! Differentiation of reducing_functions in reverse (adjoint) mode (with options noISIZE): +! gradient of useful results: tr n vr +! with respect to varying inputs: n + SUBROUTINE REDUCING_FUNCTIONS_B(model, n, nb, vr, vrb, tr, trb) + IMPLICIT NONE + class(GERG2008), INTENT(IN) :: model + REAL(pr), INTENT(IN) :: n(:) + REAL(pr) :: nb(:) + REAL(pr) :: vr + REAL(pr) :: vrb + REAL(pr) :: tr + REAL(pr) :: trb + REAL(pr) :: vc(SIZE(n)), tc(SIZE(n)), x(SIZE(n)), rho_c(SIZE(n)) + REAL(pr) :: xb(SIZE(n)) + REAL(pr) :: bv(SIZE(n), SIZE(n)), gv(SIZE(n), SIZE(n)) + REAL(pr) :: bt(SIZE(n), SIZE(n)), gt(SIZE(n), SIZE(n)) + INTEGER :: i, j, nc + INTRINSIC SUM + INTRINSIC SQRT + INTRINSIC SIZE + REAL(pr), DIMENSION(SIZE(n)) :: arg1 + REAL(pr), DIMENSION(SIZE(n)) :: arg1b + REAL(pr) :: arg10 + REAL(pr) :: result1 + REAL(pr) :: temp + REAL(pr) :: temp0 + REAL(pr) :: temp1 + REAL(pr) :: tempb + REAL(pr) :: temp2 + REAL(pr) :: temp3 + REAL(pr) :: temp4 + REAL(pr) :: tempb0 + REAL(pr) :: tempb1 + REAL(pr) :: tempb2 + INTEGER :: ad_from + vc = model%components%vc + tc = model%components%tc + bv = model%binaries%bv + gv = model%binaries%gv + bt = model%binaries%bt + gt = model%binaries%gt + rho_c = 1/vc + x = n/SUM(n) + nc = SIZE(n) + arg1(:) = n**2*vc + arg1(:) = n**2*tc + DO i=1,nc + ad_from = i + 1 + DO j=ad_from,nc + arg10 = tc(i)*tc(j) + CALL PUSHREAL8(result1) + result1 = SQRT(arg10) + END DO + CALL PUSHINTEGER4(ad_from) + END DO + xb = 0.0_pr + DO i=nc,1,-1 + CALL POPINTEGER4(ad_from) + DO j=nc,ad_from,-1 + temp4 = bt(i, j)*bt(i, j) + temp3 = temp4*x(i) + x(j) + temp1 = x(i) + x(j) + temp0 = x(i)*x(j) + tempb1 = bt(i, j)*gt(i, j)*result1*2*trb/temp3 + xb(i) = xb(i) + x(j)*temp1*tempb1 + xb(j) = xb(j) + x(i)*temp1*tempb1 + xb(i) = xb(i) + temp0*tempb1 + xb(j) = xb(j) + temp0*tempb1 + tempb2 = -(temp0*temp1*tempb1/temp3) + xb(i) = xb(i) + temp4*tempb2 + xb(j) = xb(j) + tempb2 + CALL POPREAL8(result1) + temp = bv(i, j)*bv(i, j) + temp0 = 8*(temp*x(i)+x(j)) + temp2 = x(i) + x(j) + temp3 = x(i)*x(j) + tempb = bv(i, j)*2*gv(i, j)*(rho_c(i)**(-(1.0/3))+rho_c(j)**(-(& + & 1.0/3)))**3*vrb/temp0 + xb(i) = xb(i) + x(j)*temp2*tempb + xb(j) = xb(j) + x(i)*temp2*tempb + xb(i) = xb(i) + temp3*tempb + xb(j) = xb(j) + temp3*tempb + tempb0 = -(8*temp3*temp2*tempb/temp0) + xb(i) = xb(i) + temp*tempb0 + xb(j) = xb(j) + tempb0 + END DO + END DO + temp = SUM(n) + arg1b = 0.0_pr + arg1b = trb + nb = nb + 2*n*tc*arg1b + arg1b = 0.0_pr + arg1b = vrb + nb = nb + 2*n*vc*arg1b + xb/temp - SUM(n*xb)/temp**2 + end subroutine REDUCING_FUNCTIONS_B + + SUBROUTINE REDUCING_FUNCTIONS(model, n, vr, tr) + IMPLICIT NONE + class(GERG2008), INTENT(IN) :: model + REAL(pr), INTENT(IN) :: n(:) + REAL(pr), INTENT(OUT) :: vr + REAL(pr), INTENT(OUT) :: tr + REAL(pr) :: vc(SIZE(n)), tc(SIZE(n)), x(SIZE(n)), rho_c(SIZE(n)) + REAL(pr) :: bv(SIZE(n), SIZE(n)), gv(SIZE(n), SIZE(n)) + REAL(pr) :: bt(SIZE(n), SIZE(n)), gt(SIZE(n), SIZE(n)) + INTEGER :: i, j, nc + INTRINSIC SUM + INTRINSIC SQRT + INTRINSIC SIZE + REAL(pr), DIMENSION(SIZE(n)) :: arg1 + REAL(pr) :: arg10 + REAL(pr) :: result1 + vc = model%components%vc + tc = model%components%tc + bv = model%binaries%bv + gv = model%binaries%gv + bt = model%binaries%bt + gt = model%binaries%gt + rho_c = 1/vc + x = n/SUM(n) + nc = SIZE(n) + arg1(:) = n**2*vc + vr = SUM(arg1(:)) + arg1(:) = n**2*tc + tr = SUM(arg1(:)) + DO i=1,nc + DO j=i+1,nc + vr = vr + 2*x(i)*x(j)*bv(i, j)*gv(i, j)*(x(i)+x(j))/(bv(i, j)**2& + & *x(i)+x(j))*1.d0/8*(rho_c(i)**(-(1.d0/3))+rho_c(j)**(-(1.d0/3)& + & ))**3 + arg10 = tc(i)*tc(j) + result1 = SQRT(arg10) + tr = tr + 2*x(i)*x(j)*bt(i, j)*gt(i, j)*(x(i)+x(j))/(bt(i, j)**2& + & *x(i)+x(j))*result1 + END DO + END DO + end subroutine REDUCING_FUNCTIONS + +! Differentiation of ar_pure_d_d in forward (tangent) mode (with options noISIZE): +! variations of useful results: ar ard0 ard ardd +! with respect to varying inputs: taudd taud tau deltad0 deltad +! taud0 delta deltadd +! Differentiation of ar_pure_d in forward (tangent) mode (with options noISIZE): +! variations of useful results: ar ard +! with respect to varying inputs: taud tau deltad delta +! Differentiation of ar_pure in forward (tangent) mode (with options noISIZE): +! variations of useful results: ar +! with respect to varying inputs: tau delta + SUBROUTINE AR_PURE_D_D_D(pure, delta, deltad1, deltad0, deltad0d, & + & deltad, deltadd0, deltadd, deltaddd, tau, taud1, taud0, taud0d, taud& + & , taudd0, taudd, tauddd, ar, ard1, ard0, ard0d, ard, ardd0, ardd, & + & arddd) + IMPLICIT NONE + class(GERG2008PURE), INTENT(IN) :: pure + REAL(pr), INTENT(IN) :: delta + REAL(pr), INTENT(IN) :: deltad1 + REAL(pr), INTENT(IN) :: deltad0 + REAL(pr), INTENT(IN) :: deltad0d + REAL(pr), INTENT(IN) :: deltad + REAL(pr), INTENT(IN) :: deltadd0 + REAL(pr), INTENT(IN) :: deltadd + REAL(pr), INTENT(IN) :: deltaddd + REAL(pr), INTENT(IN) :: tau + REAL(pr), INTENT(IN) :: taud1 + REAL(pr), INTENT(IN) :: taud0 + REAL(pr), INTENT(IN) :: taud0d + REAL(pr), INTENT(IN) :: taud + REAL(pr), INTENT(IN) :: taudd0 + REAL(pr), INTENT(IN) :: taudd + REAL(pr), INTENT(IN) :: tauddd + REAL(pr), INTENT(OUT) :: ar + REAL(pr), INTENT(OUT) :: ard1 + REAL(pr), INTENT(OUT) :: ard0 + REAL(pr), INTENT(OUT) :: ard0d + REAL(pr), INTENT(OUT) :: ard + REAL(pr), INTENT(OUT) :: ardd0 + REAL(pr), INTENT(OUT) :: ardd + REAL(pr), INTENT(OUT) :: arddd + INTEGER :: i, kpol, kexp + REAL(pr) :: n_pol(pure%kpol), d_pol(pure%kpol), t_pol(pure%kpol) + REAL(pr) :: n_exp(pure%kexp), d_exp(pure%kexp), t_exp(pure%kexp) + REAL(pr) :: c_exp(pure%kexp) + INTRINSIC SUM + INTRINSIC EXP + REAL(pr), DIMENSION(pure%kpol) :: arg1 + REAL(pr), DIMENSION(pure%kpol) :: arg1d1 + REAL(pr), DIMENSION(pure%kpol) :: arg1d0 + REAL(pr), DIMENSION(pure%kpol) :: arg1d0d + REAL(pr), DIMENSION(pure%kpol) :: arg1d + REAL(pr), DIMENSION(pure%kpol) :: arg1dd0 + REAL(pr), DIMENSION(pure%kpol) :: arg1dd + REAL(pr), DIMENSION(pure%kpol) :: arg1ddd + REAL(pr), DIMENSION(pure%kexp) :: arg2 + REAL(pr), DIMENSION(pure%kexp) :: arg2d1 + REAL(pr), DIMENSION(pure%kexp) :: arg2d0 + REAL(pr), DIMENSION(pure%kexp) :: arg2d0d + REAL(pr), DIMENSION(pure%kexp) :: arg2d + REAL(pr), DIMENSION(pure%kexp) :: arg2dd0 + REAL(pr), DIMENSION(pure%kexp) :: arg2dd + REAL(pr), DIMENSION(pure%kexp) :: arg2ddd + REAL(pr), DIMENSION(pure%kexp) :: arg3 + REAL(pr), DIMENSION(pure%kexp) :: arg3d1 + REAL(pr), DIMENSION(pure%kexp) :: arg3d0 + REAL(pr), DIMENSION(pure%kexp) :: arg3d0d + REAL(pr), DIMENSION(pure%kexp) :: arg3d + REAL(pr), DIMENSION(pure%kexp) :: arg3dd0 + REAL(pr), DIMENSION(pure%kexp) :: arg3dd + REAL(pr), DIMENSION(pure%kexp) :: arg3ddd + REAL(pr), DIMENSION(pure%kpol) :: temp + REAL(pr), DIMENSION(pure%kpol) :: tempd7 + REAL(pr), DIMENSION(pure%kpol) :: tempd4 + REAL(pr), DIMENSION(pure%kpol) :: tempd4d + REAL(pr), DIMENSION(pure%kpol) :: temp0 + REAL(pr), DIMENSION(pure%kpol) :: temp0d0 + REAL(pr), DIMENSION(pure%kpol) :: temp0d + REAL(pr), DIMENSION(pure%kpol) :: temp0dd + REAL(pr), DIMENSION(pure%kpol) :: tempd + REAL(pr), DIMENSION(pure%kpol) :: tempdd0 + REAL(pr), DIMENSION(pure%kpol) :: tempdd + REAL(pr), DIMENSION(pure%kpol) :: tempddd + REAL(pr), DIMENSION(pure%kpol) :: tempd0 + REAL(pr), DIMENSION(pure%kpol) :: tempd0d0 + REAL(pr), DIMENSION(pure%kpol) :: tempd0d + REAL(pr), DIMENSION(pure%kpol) :: tempd0dd + REAL(pr), DIMENSION(pure%kexp) :: temp1 + REAL(pr), DIMENSION(pure%kexp) :: temp1d0 + REAL(pr), DIMENSION(pure%kexp) :: temp1d + REAL(pr), DIMENSION(pure%kexp) :: temp1dd + REAL(pr), DIMENSION(pure%kexp) :: tempd1 + REAL(pr), DIMENSION(pure%kexp) :: tempd1d0 + REAL(pr), DIMENSION(pure%kexp) :: tempd1d + REAL(pr), DIMENSION(pure%kexp) :: tempd1dd + REAL(pr), DIMENSION(pure%kexp) :: temp2 + REAL(pr), DIMENSION(pure%kexp) :: temp2d0 + REAL(pr), DIMENSION(pure%kexp) :: temp2d + REAL(pr), DIMENSION(pure%kexp) :: temp2dd + REAL(pr), DIMENSION(pure%kexp) :: temp3 + REAL(pr), DIMENSION(pure%kexp) :: temp3d0 + REAL(pr), DIMENSION(pure%kexp) :: temp3d + REAL(pr), DIMENSION(pure%kexp) :: temp3dd + REAL(pr), DIMENSION(pure%kexp) :: tempd2 + REAL(pr), DIMENSION(pure%kexp) :: tempd2d0 + REAL(pr), DIMENSION(pure%kexp) :: tempd2d + REAL(pr), DIMENSION(pure%kexp) :: tempd2dd + REAL(pr), DIMENSION(pure%kexp) :: tempd3 + REAL(pr), DIMENSION(pure%kexp) :: tempd3d0 + REAL(pr), DIMENSION(pure%kexp) :: tempd3d + REAL(pr), DIMENSION(pure%kexp) :: tempd3dd + REAL(pr), DIMENSION(pure%kexp) :: temp4 + REAL(pr), DIMENSION(pure%kexp) :: temp4d0 + REAL(pr), DIMENSION(pure%kexp) :: temp4d + REAL(pr), DIMENSION(pure%kexp) :: temp4dd + INTRINSIC INT + REAL(pr), DIMENSION(pure%kpol) :: temp5 + REAL(pr), DIMENSION(pure%kpol) :: temp5d + REAL(pr), DIMENSION(pure%kpol) :: tempd5 + REAL(pr), DIMENSION(pure%kpol) :: tempd5d + REAL(pr), DIMENSION(pure%kexp) :: temp6 + REAL(pr), DIMENSION(pure%kexp) :: temp6d + REAL(pr), DIMENSION(pure%kexp) :: tempd6 + REAL(pr), DIMENSION(pure%kexp) :: tempd6d + REAL(pr), DIMENSION(pure%kexp) :: temp7 + REAL(pr), DIMENSION(pure%kexp) :: temp7d + REAL(pr), DIMENSION(pure%kpol) :: temp8 + REAL(pr), DIMENSION(pure%kpol) :: tempd8 + REAL(pr), DIMENSION(pure%kexp) :: temp9 + REAL(pr), DIMENSION(pure%kexp) :: tempd9 + REAL(pr), DIMENSION(pure%kexp) :: temp10 + REAL(pr), DIMENSION(pure%kexp) :: temp11 + REAL(pr), DIMENSION(pure%kexp) :: temp12 + LOGICAL, DIMENSION(pure%kpol) :: mask + LOGICAL, DIMENSION(pure%kpol) :: mask0 + LOGICAL, DIMENSION(pure%kpol) :: mask1 + LOGICAL, DIMENSION(pure%kpol) :: mask2 + LOGICAL, DIMENSION(pure%kpol) :: mask3 + LOGICAL, DIMENSION(pure%kpol) :: mask4 + LOGICAL, DIMENSION(pure%kpol) :: mask5 + LOGICAL, DIMENSION(pure%kpol) :: mask6 + LOGICAL, DIMENSION(pure%kpol) :: mask7 + LOGICAL, DIMENSION(pure%kpol) :: mask8 + LOGICAL, DIMENSION(pure%kpol) :: mask9 + LOGICAL, DIMENSION(pure%kpol) :: mask10 + LOGICAL, DIMENSION(pure%kpol) :: mask11 + LOGICAL, DIMENSION(pure%kpol) :: mask12 + LOGICAL, DIMENSION(pure%kpol) :: mask13 + LOGICAL, DIMENSION(pure%kpol) :: mask14 + LOGICAL, DIMENSION(pure%kpol) :: mask15 + LOGICAL, DIMENSION(pure%kpol) :: mask16 + LOGICAL, DIMENSION(pure%kpol) :: mask17 + LOGICAL, DIMENSION(pure%kpol) :: mask18 + LOGICAL, DIMENSION(pure%kpol) :: mask19 + LOGICAL, DIMENSION(pure%kpol) :: mask20 + LOGICAL, DIMENSION(pure%kpol) :: mask21 + LOGICAL, DIMENSION(pure%kpol) :: mask22 + LOGICAL, DIMENSION(pure%kexp) :: mask23 + LOGICAL, DIMENSION(pure%kexp) :: mask24 + LOGICAL, DIMENSION(pure%kexp) :: mask25 + LOGICAL, DIMENSION(pure%kexp) :: mask26 + LOGICAL, DIMENSION(pure%kexp) :: mask27 + LOGICAL, DIMENSION(pure%kexp) :: mask28 + LOGICAL, DIMENSION(pure%kexp) :: mask29 + LOGICAL, DIMENSION(pure%kexp) :: mask30 + LOGICAL, DIMENSION(pure%kexp) :: mask31 + LOGICAL, DIMENSION(pure%kexp) :: mask32 + LOGICAL, DIMENSION(pure%kexp) :: mask33 + LOGICAL, DIMENSION(pure%kexp) :: mask34 + LOGICAL, DIMENSION(pure%kexp) :: mask35 + LOGICAL, DIMENSION(pure%kexp) :: mask36 + LOGICAL, DIMENSION(pure%kexp) :: mask37 + LOGICAL, DIMENSION(pure%kexp) :: mask38 + LOGICAL, DIMENSION(pure%kexp) :: mask39 + LOGICAL, DIMENSION(pure%kexp) :: mask40 + LOGICAL, DIMENSION(pure%kexp) :: mask41 + LOGICAL, DIMENSION(pure%kexp) :: mask42 + LOGICAL, DIMENSION(pure%kexp) :: mask43 + LOGICAL, DIMENSION(pure%kexp) :: mask44 + LOGICAL, DIMENSION(pure%kexp) :: mask45 + LOGICAL, DIMENSION(pure%kexp) :: mask46 + LOGICAL, DIMENSION(pure%kexp) :: mask47 + LOGICAL, DIMENSION(pure%kexp) :: mask48 + LOGICAL, DIMENSION(pure%kexp) :: mask49 + LOGICAL, DIMENSION(pure%kexp) :: mask50 + LOGICAL, DIMENSION(pure%kexp) :: mask51 + LOGICAL, DIMENSION(pure%kexp) :: mask52 + LOGICAL, DIMENSION(pure%kexp) :: mask53 + LOGICAL, DIMENSION(pure%kexp) :: mask54 + LOGICAL, DIMENSION(pure%kexp) :: mask55 + LOGICAL, DIMENSION(pure%kexp) :: mask56 + kpol = pure%kpol + kexp = pure%kexp + n_pol = pure%n(1:kpol) + d_pol = pure%d(1:kpol) + t_pol = pure%t(1:kpol) + n_exp = pure%n(kpol+1:kpol+kexp) + d_exp = pure%d(kpol+1:kpol+kexp) + t_exp = pure%t(kpol+1:kpol+kexp) + c_exp = pure%c + mask = tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. INT(t_pol)& + & ) + WHERE (mask) tempd4 = 0.0_pr + tempd4d = 0.0_pr + mask0 = .NOT.(tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. INT& + & (t_pol))) + WHERE (mask0) + temp8 = tau**(t_pol-1) + mask1 = tau .LE. 0.0 .AND. (t_pol - 1 .EQ. 0.0 .OR. t_pol - 1 .NE.& + & INT(t_pol - 1)) + WHERE (mask1) + tempd8 = 0.0_pr + ELSEWHERE + tempd8 = (t_pol-1)*tau**(t_pol-2)*taud1 + END WHERE + tempd4d = t_pol*(taud0*tempd8+temp8*taud0d) + tempd4 = t_pol*(temp8*taud0) + END WHERE + mask2 = tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. INT(t_pol& + & )) + WHERE (mask2) + tempd7 = 0.0_pr + ELSEWHERE + tempd7 = t_pol*tau**(t_pol-1)*taud1 + END WHERE + temp = tau**t_pol + mask3 = delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. INT(& + & d_pol)) + WHERE (mask3) temp0d = 0.0_pr + temp0dd = 0.0_pr + mask4 = .NOT.(delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. & + & INT(d_pol))) + WHERE (mask4) + temp8 = delta**(d_pol-1) + mask5 = delta .LE. 0.0 .AND. (d_pol - 1 .EQ. 0.0 .OR. d_pol - 1 & + & .NE. INT(d_pol - 1)) + WHERE (mask5) + tempd8 = 0.0_pr + ELSEWHERE + tempd8 = (d_pol-1)*delta**(d_pol-2)*deltad1 + END WHERE + temp0dd = d_pol*(deltad0*tempd8+temp8*deltad0d) + temp0d = d_pol*(temp8*deltad0) + END WHERE + mask6 = delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. INT(& + & d_pol)) + WHERE (mask6) + temp0d0 = 0.0_pr + ELSEWHERE + temp0d0 = d_pol*delta**(d_pol-1)*deltad1 + END WHERE + temp0 = delta**d_pol + mask7 = delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. INT(& + & d_pol)) + WHERE (mask7) tempd = 0.0_pr + tempdd = 0.0_pr + temp5d = 0.0_pr + mask8 = .NOT.(delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. & + & INT(d_pol))) + WHERE (mask8) + mask9 = delta .LE. 0.0 .AND. (d_pol - 1 .EQ. 0.0 .OR. d_pol - 1 & + & .NE. INT(d_pol - 1)) + WHERE (mask9) + temp5d = 0.0_pr + ELSEWHERE + temp5d = (d_pol-1)*delta**(d_pol-2)*deltad1 + END WHERE + temp5 = delta**(d_pol-1) + mask10 = delta .LE. 0.0 .AND. (d_pol - 1 .EQ. 0.0 .OR. d_pol - 1 & + & .NE. INT(d_pol - 1)) + WHERE (mask10) tempd5 = 0.0_pr + END WHERE + tempd5d = 0.0_pr + mask11 = .NOT.(delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. & + & INT(d_pol))) + WHERE (mask11) + mask12 = .NOT.(delta .LE. 0.0 .AND. (d_pol - 1 .EQ. 0.0 .OR. d_pol& + & - 1 .NE. INT(d_pol - 1))) + WHERE (mask12) + temp8 = delta**(d_pol-2) + mask13 = delta .LE. 0.0 .AND. (d_pol - 2 .EQ. 0.0 .OR. d_pol - 2& + & .NE. INT(d_pol - 2)) + WHERE (mask13) + tempd8 = 0.0_pr + ELSEWHERE + tempd8 = (d_pol-2)*delta**(d_pol-3)*deltad1 + END WHERE + tempd5d = (d_pol-1)*(deltad0*tempd8+temp8*deltad0d) + tempd5 = (d_pol-1)*(temp8*deltad0) + END WHERE + END WHERE + tempddd = 0.0_pr + mask14 = .NOT.(delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. & + & INT(d_pol))) + WHERE (mask14) + tempddd = d_pol*(tempd5*deltadd0+deltad*tempd5d+deltadd*temp5d+& + & temp5*deltaddd) + tempdd = d_pol*(deltad*tempd5+temp5*deltadd) + END WHERE + tempdd0 = 0.0_pr + mask15 = .NOT.(delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. & + & INT(d_pol))) + WHERE (mask15) + tempdd0 = d_pol*(deltad*temp5d+temp5*deltadd0) + tempd = d_pol*(temp5*deltad) + END WHERE + mask16 = tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. INT(& + & t_pol)) + WHERE (mask16) tempd0 = 0.0_pr + tempd0d = 0.0_pr + mask17 = .NOT.(tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. & + & INT(t_pol))) + WHERE (mask17) + mask18 = tau .LE. 0.0 .AND. (t_pol - 1 .EQ. 0.0 .OR. t_pol - 1 & + & .NE. INT(t_pol - 1)) + WHERE (mask18) + temp5d = 0.0_pr + ELSEWHERE + temp5d = (t_pol-1)*tau**(t_pol-2)*taud1 + END WHERE + temp5 = tau**(t_pol-1) + mask19 = tau .LE. 0.0 .AND. (t_pol - 1 .EQ. 0.0 .OR. t_pol - 1 & + & .NE. INT(t_pol - 1)) + WHERE (mask19) + tempd5d = 0.0_pr + tempd5 = 0.0_pr + ELSEWHERE + temp8 = tau**(t_pol-2) + mask20 = tau .LE. 0.0 .AND. (t_pol - 2 .EQ. 0.0 .OR. t_pol - 2 & + & .NE. INT(t_pol - 2)) + WHERE (mask20) + tempd8 = 0.0_pr + ELSEWHERE + tempd8 = (t_pol-2)*tau**(t_pol-3)*taud1 + END WHERE + tempd5d = (t_pol-1)*(taud0*tempd8+temp8*taud0d) + tempd5 = (t_pol-1)*(temp8*taud0) + END WHERE + END WHERE + tempd0dd = 0.0_pr + mask21 = .NOT.(tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. & + & INT(t_pol))) + WHERE (mask21) + tempd0dd = t_pol*(tempd5*taudd0+taud*tempd5d+taudd*temp5d+temp5*& + & tauddd) + tempd0d = t_pol*(taud*tempd5+temp5*taudd) + END WHERE + tempd0d0 = 0.0_pr + mask22 = .NOT.(tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. & + & INT(t_pol))) + WHERE (mask22) + tempd0d0 = t_pol*(taud*temp5d+temp5*taudd0) + tempd0 = t_pol*(temp5*taud) + END WHERE + arg1ddd(:) = n_pol*(tempd4*tempdd0+tempd*tempd4d+tempdd*tempd7+temp*& + & tempddd+temp0d*tempd0d0+tempd0*temp0dd+tempd0d*temp0d0+temp0*& + & tempd0dd) + arg1dd(:) = n_pol*(tempd*tempd4+temp*tempdd+tempd0*temp0d+temp0*& + & tempd0d) + arg1dd0(:) = n_pol*(tempd*tempd7+temp*tempdd0+tempd0*temp0d0+temp0*& + & tempd0d0) + arg1d(:) = n_pol*(temp*tempd+temp0*tempd0) + arg1d0d(:) = n_pol*(temp0d*tempd7+temp*temp0dd+tempd4*temp0d0+temp0*& + & tempd4d) + arg1d0(:) = n_pol*(temp*temp0d+temp0*tempd4) + arg1d1(:) = n_pol*(temp*temp0d0+temp0*tempd7) + arg1(:) = n_pol*(temp0*temp) + mask23 = delta .LE. 0.0 .AND. (c_exp .EQ. 0.0 .OR. c_exp .NE. INT(& + & c_exp)) + WHERE (mask23) tempd1 = 0.0_pr + tempd1d = 0.0_pr + temp6d = 0.0_pr + mask24 = .NOT.(delta .LE. 0.0 .AND. (c_exp .EQ. 0.0 .OR. c_exp .NE. & + & INT(c_exp))) + WHERE (mask24) + mask25 = delta .LE. 0.0 .AND. (c_exp - 1 .EQ. 0.0 .OR. c_exp - 1 & + & .NE. INT(c_exp - 1)) + WHERE (mask25) + temp6d = 0.0_pr + ELSEWHERE + temp6d = (c_exp-1)*delta**(c_exp-2)*deltad1 + END WHERE + temp6 = delta**(c_exp-1) + mask26 = delta .LE. 0.0 .AND. (c_exp - 1 .EQ. 0.0 .OR. c_exp - 1 & + & .NE. INT(c_exp - 1)) + WHERE (mask26) tempd6 = 0.0_pr + END WHERE + tempd6d = 0.0_pr + mask27 = .NOT.(delta .LE. 0.0 .AND. (c_exp .EQ. 0.0 .OR. c_exp .NE. & + & INT(c_exp))) + WHERE (mask27) + mask28 = .NOT.(delta .LE. 0.0 .AND. (c_exp - 1 .EQ. 0.0 .OR. c_exp& + & - 1 .NE. INT(c_exp - 1))) + WHERE (mask28) + temp9 = delta**(c_exp-2) + mask29 = delta .LE. 0.0 .AND. (c_exp - 2 .EQ. 0.0 .OR. c_exp - 2& + & .NE. INT(c_exp - 2)) + WHERE (mask29) + tempd9 = 0.0_pr + ELSEWHERE + tempd9 = (c_exp-2)*delta**(c_exp-3)*deltad1 + END WHERE + tempd6d = (c_exp-1)*(deltad0*tempd9+temp9*deltad0d) + tempd6 = (c_exp-1)*(temp9*deltad0) + END WHERE + END WHERE + tempd1dd = 0.0_pr + mask30 = .NOT.(delta .LE. 0.0 .AND. (c_exp .EQ. 0.0 .OR. c_exp .NE. & + & INT(c_exp))) + WHERE (mask30) + tempd1dd = c_exp*(tempd6*deltadd0+deltad*tempd6d+deltadd*temp6d+& + & temp6*deltaddd) + tempd1d = c_exp*(deltad*tempd6+temp6*deltadd) + END WHERE + tempd1d0 = 0.0_pr + mask31 = .NOT.(delta .LE. 0.0 .AND. (c_exp .EQ. 0.0 .OR. c_exp .NE. & + & INT(c_exp))) + WHERE (mask31) + tempd1d0 = c_exp*(deltad*temp6d+temp6*deltadd0) + tempd1 = c_exp*(temp6*deltad) + END WHERE + arg2ddd(:) = -tempd1dd + arg2dd(:) = -tempd1d + arg2dd0(:) = -tempd1d0 + arg2d(:) = -tempd1 + mask32 = delta .LE. 0.0 .AND. (c_exp .EQ. 0.0 .OR. c_exp .NE. INT(& + & c_exp)) + WHERE (mask32) + tempd6d = 0.0_pr + tempd6 = 0.0_pr + ELSEWHERE + temp9 = delta**(c_exp-1) + mask33 = delta .LE. 0.0 .AND. (c_exp - 1 .EQ. 0.0 .OR. c_exp - 1 & + & .NE. INT(c_exp - 1)) + WHERE (mask33) + tempd9 = 0.0_pr + ELSEWHERE + tempd9 = (c_exp-1)*delta**(c_exp-2)*deltad1 + END WHERE + tempd6d = c_exp*(deltad0*tempd9+temp9*deltad0d) + tempd6 = c_exp*(temp9*deltad0) + END WHERE + arg2d0d(:) = -tempd6d + arg2d0(:) = -tempd6 + mask34 = delta .LE. 0.0 .AND. (c_exp .EQ. 0.0 .OR. c_exp .NE. INT(& + & c_exp)) + WHERE (mask34) + tempd9 = 0.0_pr + ELSEWHERE + tempd9 = c_exp*delta**(c_exp-1)*deltad1 + END WHERE + arg2d1(:) = -tempd9 + arg2(:) = -(delta**c_exp) + temp9 = EXP(arg2(:)) + temp1dd = arg2d0(:)*EXP(arg2(:))*arg2d1(:) + temp9*arg2d0d(:) + temp1d = temp9*arg2d0(:) + temp1d0 = EXP(arg2(:))*arg2d1(:) + temp1 = EXP(arg2(:)) + mask35 = tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. INT(& + & t_exp)) + WHERE (mask35) temp2d = 0.0_pr + temp2dd = 0.0_pr + mask36 = .NOT.(tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. & + & INT(t_exp))) + WHERE (mask36) + temp9 = tau**(t_exp-1) + mask37 = tau .LE. 0.0 .AND. (t_exp - 1 .EQ. 0.0 .OR. t_exp - 1 & + & .NE. INT(t_exp - 1)) + WHERE (mask37) + tempd9 = 0.0_pr + ELSEWHERE + tempd9 = (t_exp-1)*tau**(t_exp-2)*taud1 + END WHERE + temp2dd = t_exp*(taud0*tempd9+temp9*taud0d) + temp2d = t_exp*(temp9*taud0) + END WHERE + mask38 = tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. INT(& + & t_exp)) + WHERE (mask38) + temp2d0 = 0.0_pr + ELSEWHERE + temp2d0 = t_exp*tau**(t_exp-1)*taud1 + END WHERE + temp2 = tau**t_exp + mask39 = delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. INT(& + & d_exp)) + WHERE (mask39) temp3d = 0.0_pr + temp3dd = 0.0_pr + mask40 = .NOT.(delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. & + & INT(d_exp))) + WHERE (mask40) + temp9 = delta**(d_exp-1) + mask41 = delta .LE. 0.0 .AND. (d_exp - 1 .EQ. 0.0 .OR. d_exp - 1 & + & .NE. INT(d_exp - 1)) + WHERE (mask41) + tempd9 = 0.0_pr + ELSEWHERE + tempd9 = (d_exp-1)*delta**(d_exp-2)*deltad1 + END WHERE + temp3dd = d_exp*(deltad0*tempd9+temp9*deltad0d) + temp3d = d_exp*(temp9*deltad0) + END WHERE + mask42 = delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. INT(& + & d_exp)) + WHERE (mask42) + temp3d0 = 0.0_pr + ELSEWHERE + temp3d0 = d_exp*delta**(d_exp-1)*deltad1 + END WHERE + temp3 = delta**d_exp + temp4dd = temp3d*temp2d0 + temp2*temp3dd + temp2d*temp3d0 + temp3*& + & temp2dd + temp4d = temp2*temp3d + temp3*temp2d + temp4d0 = temp2*temp3d0 + temp3*temp2d0 + temp4 = temp3*temp2 + mask43 = delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. INT(& + & d_exp)) + WHERE (mask43) tempd2 = 0.0_pr + tempd2d = 0.0_pr + mask44 = .NOT.(delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. & + & INT(d_exp))) + WHERE (mask44) + mask45 = delta .LE. 0.0 .AND. (d_exp - 1 .EQ. 0.0 .OR. d_exp - 1 & + & .NE. INT(d_exp - 1)) + WHERE (mask45) + temp6d = 0.0_pr + ELSEWHERE + temp6d = (d_exp-1)*delta**(d_exp-2)*deltad1 + END WHERE + temp6 = delta**(d_exp-1) + mask46 = delta .LE. 0.0 .AND. (d_exp - 1 .EQ. 0.0 .OR. d_exp - 1 & + & .NE. INT(d_exp - 1)) + WHERE (mask46) + tempd6d = 0.0_pr + tempd6 = 0.0_pr + ELSEWHERE + temp9 = delta**(d_exp-2) + mask47 = delta .LE. 0.0 .AND. (d_exp - 2 .EQ. 0.0 .OR. d_exp - 2& + & .NE. INT(d_exp - 2)) + WHERE (mask47) + tempd9 = 0.0_pr + ELSEWHERE + tempd9 = (d_exp-2)*delta**(d_exp-3)*deltad1 + END WHERE + tempd6d = (d_exp-1)*(deltad0*tempd9+temp9*deltad0d) + tempd6 = (d_exp-1)*(temp9*deltad0) + END WHERE + END WHERE + tempd2dd = 0.0_pr + mask48 = .NOT.(delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. & + & INT(d_exp))) + WHERE (mask48) + tempd2dd = d_exp*(tempd6*deltadd0+deltad*tempd6d+deltadd*temp6d+& + & temp6*deltaddd) + tempd2d = d_exp*(deltad*tempd6+temp6*deltadd) + END WHERE + tempd2d0 = 0.0_pr + mask49 = .NOT.(delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. & + & INT(d_exp))) + WHERE (mask49) + tempd2d0 = d_exp*(deltad*temp6d+temp6*deltadd0) + tempd2 = d_exp*(temp6*deltad) + END WHERE + mask50 = tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. INT(& + & t_exp)) + WHERE (mask50) tempd3 = 0.0_pr + tempd3d = 0.0_pr + mask51 = .NOT.(tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. & + & INT(t_exp))) + WHERE (mask51) + mask52 = tau .LE. 0.0 .AND. (t_exp - 1 .EQ. 0.0 .OR. t_exp - 1 & + & .NE. INT(t_exp - 1)) + WHERE (mask52) + temp6d = 0.0_pr + ELSEWHERE + temp6d = (t_exp-1)*tau**(t_exp-2)*taud1 + END WHERE + temp6 = tau**(t_exp-1) + mask53 = tau .LE. 0.0 .AND. (t_exp - 1 .EQ. 0.0 .OR. t_exp - 1 & + & .NE. INT(t_exp - 1)) + WHERE (mask53) + tempd6d = 0.0_pr + tempd6 = 0.0_pr + ELSEWHERE + temp9 = tau**(t_exp-2) + mask54 = tau .LE. 0.0 .AND. (t_exp - 2 .EQ. 0.0 .OR. t_exp - 2 & + & .NE. INT(t_exp - 2)) + WHERE (mask54) + tempd9 = 0.0_pr + ELSEWHERE + tempd9 = (t_exp-2)*tau**(t_exp-3)*taud1 + END WHERE + tempd6d = (t_exp-1)*(taud0*tempd9+temp9*taud0d) + tempd6 = (t_exp-1)*(temp9*taud0) + END WHERE + END WHERE + tempd3dd = 0.0_pr + mask55 = .NOT.(tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. & + & INT(t_exp))) + WHERE (mask55) + tempd3dd = t_exp*(tempd6*taudd0+taud*tempd6d+taudd*temp6d+temp6*& + & tauddd) + tempd3d = t_exp*(taud*tempd6+temp6*taudd) + END WHERE + tempd3d0 = 0.0_pr + mask56 = .NOT.(tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. & + & INT(t_exp))) + WHERE (mask56) + tempd3d0 = t_exp*(taud*temp6d+temp6*taudd0) + tempd3 = t_exp*(temp6*taud) + END WHERE + temp6d = tempd2*temp2d0 + temp2*tempd2d0 + tempd3*temp3d0 + temp3*& + & tempd3d0 + temp6 = temp2*tempd2 + temp3*tempd3 + temp7d = EXP(arg2(:))*arg2d1(:) + temp7 = EXP(arg2(:)) + temp9 = tempd2*temp2d + temp2*tempd2d + tempd3*temp3d + temp3*& + & tempd3d + temp10 = EXP(arg2(:)) + temp11 = temp4*arg2d(:)*arg2d0(:) + temp12 = arg2d(:)*temp4d + temp4*arg2dd(:) + arg3ddd(:) = n_exp*(temp1d*temp6d+temp6*temp1dd+temp9*temp1d0+temp1*& + & (temp2d*tempd2d0+tempd2*temp2dd+tempd2d*temp2d0+temp2*tempd2dd+& + & temp3d*tempd3d0+tempd3*temp3dd+tempd3d*temp3d0+temp3*tempd3dd)+& + & temp10*(arg2d0(:)*(arg2d(:)*temp4d0+temp4*arg2dd0(:))+temp4*arg2d(& + & :)*arg2d0d(:))+temp11*EXP(arg2(:))*arg2d1(:)+temp12*temp7d+temp7*(& + & temp4d*arg2dd0(:)+arg2d(:)*temp4dd+arg2dd(:)*temp4d0+temp4*arg2ddd& + & (:))) + arg3dd(:) = n_exp*(temp6*temp1d+temp1*temp9+temp11*temp10+temp7*& + & temp12) + arg3dd0(:) = n_exp*(temp6*temp1d0+temp1*temp6d+arg2d(:)*(temp4*& + & temp7d+temp7*temp4d0)+temp7*temp4*arg2dd0(:)) + arg3d(:) = n_exp*(temp1*temp6+temp7*(temp4*arg2d(:))) + arg3d0d(:) = n_exp*(temp4d*temp1d0+temp1*temp4dd+temp1d*temp4d0+& + & temp4*temp1dd) + arg3d0(:) = n_exp*(temp1*temp4d+temp4*temp1d) + arg3d1(:) = n_exp*(temp1*temp4d0+temp4*temp1d0) + arg3(:) = n_exp*(temp4*temp1) + arddd = SUM(arg1ddd(:)) + SUM(arg3ddd(:)) + ardd = SUM(arg1dd(:)) + SUM(arg3dd(:)) + ardd0 = SUM(arg1dd0(:)) + SUM(arg3dd0(:)) + ard = SUM(arg1d(:)) + SUM(arg3d(:)) + ard0d = SUM(arg1d0d(:)) + SUM(arg3d0d(:)) + ard0 = SUM(arg1d0(:)) + SUM(arg3d0(:)) + ard1 = SUM(arg1d1(:)) + SUM(arg3d1(:)) + ar = SUM(arg1(:)) + SUM(arg3(:)) + end subroutine AR_PURE_D_D_D + +! Differentiation of ar_pure_d in forward (tangent) mode (with options noISIZE): +! variations of useful results: ar ard +! with respect to varying inputs: taud tau deltad delta +! Differentiation of ar_pure in forward (tangent) mode (with options noISIZE): +! variations of useful results: ar +! with respect to varying inputs: tau delta + SUBROUTINE AR_PURE_D_D(pure, delta, deltad0, deltad, deltadd, tau, & + & taud0, taud, taudd, ar, ard0, ard, ardd) + IMPLICIT NONE + class(GERG2008PURE), INTENT(IN) :: pure + REAL(pr), INTENT(IN) :: delta + REAL(pr), INTENT(IN) :: deltad0 + REAL(pr), INTENT(IN) :: deltad + REAL(pr), INTENT(IN) :: deltadd + REAL(pr), INTENT(IN) :: tau + REAL(pr), INTENT(IN) :: taud0 + REAL(pr), INTENT(IN) :: taud + REAL(pr), INTENT(IN) :: taudd + REAL(pr), INTENT(OUT) :: ar + REAL(pr), INTENT(OUT) :: ard0 + REAL(pr), INTENT(OUT) :: ard + REAL(pr), INTENT(OUT) :: ardd + INTEGER :: i, kpol, kexp + REAL(pr) :: n_pol(pure%kpol), d_pol(pure%kpol), t_pol(pure%kpol) + REAL(pr) :: n_exp(pure%kexp), d_exp(pure%kexp), t_exp(pure%kexp) + REAL(pr) :: c_exp(pure%kexp) + INTRINSIC SUM + INTRINSIC EXP + REAL(pr), DIMENSION(pure%kpol) :: arg1 + REAL(pr), DIMENSION(pure%kpol) :: arg1d0 + REAL(pr), DIMENSION(pure%kpol) :: arg1d + REAL(pr), DIMENSION(pure%kpol) :: arg1dd + REAL(pr), DIMENSION(pure%kexp) :: arg2 + REAL(pr), DIMENSION(pure%kexp) :: arg2d0 + REAL(pr), DIMENSION(pure%kexp) :: arg2d + REAL(pr), DIMENSION(pure%kexp) :: arg2dd + REAL(pr), DIMENSION(pure%kexp) :: arg3 + REAL(pr), DIMENSION(pure%kexp) :: arg3d0 + REAL(pr), DIMENSION(pure%kexp) :: arg3d + REAL(pr), DIMENSION(pure%kexp) :: arg3dd + REAL(pr), DIMENSION(pure%kpol) :: temp + REAL(pr), DIMENSION(pure%kpol) :: tempd4 + REAL(pr), DIMENSION(pure%kpol) :: temp0 + REAL(pr), DIMENSION(pure%kpol) :: temp0d + REAL(pr), DIMENSION(pure%kpol) :: tempd + REAL(pr), DIMENSION(pure%kpol) :: tempdd + REAL(pr), DIMENSION(pure%kpol) :: tempd0 + REAL(pr), DIMENSION(pure%kpol) :: tempd0d + REAL(pr), DIMENSION(pure%kexp) :: temp1 + REAL(pr), DIMENSION(pure%kexp) :: temp1d + REAL(pr), DIMENSION(pure%kexp) :: tempd1 + REAL(pr), DIMENSION(pure%kexp) :: tempd1d + REAL(pr), DIMENSION(pure%kexp) :: temp2 + REAL(pr), DIMENSION(pure%kexp) :: temp2d + REAL(pr), DIMENSION(pure%kexp) :: temp3 + REAL(pr), DIMENSION(pure%kexp) :: temp3d + REAL(pr), DIMENSION(pure%kexp) :: tempd2 + REAL(pr), DIMENSION(pure%kexp) :: tempd2d + REAL(pr), DIMENSION(pure%kexp) :: tempd3 + REAL(pr), DIMENSION(pure%kexp) :: tempd3d + REAL(pr), DIMENSION(pure%kexp) :: temp4 + REAL(pr), DIMENSION(pure%kexp) :: temp4d + INTRINSIC INT + REAL(pr), DIMENSION(pure%kpol) :: temp5 + REAL(pr), DIMENSION(pure%kpol) :: tempd5 + REAL(pr), DIMENSION(pure%kexp) :: temp6 + REAL(pr), DIMENSION(pure%kexp) :: tempd6 + REAL(pr), DIMENSION(pure%kexp) :: temp7 + LOGICAL, DIMENSION(pure%kpol) :: mask + LOGICAL, DIMENSION(pure%kpol) :: mask0 + LOGICAL, DIMENSION(pure%kpol) :: mask1 + LOGICAL, DIMENSION(pure%kpol) :: mask2 + LOGICAL, DIMENSION(pure%kpol) :: mask3 + LOGICAL, DIMENSION(pure%kpol) :: mask4 + LOGICAL, DIMENSION(pure%kpol) :: mask5 + LOGICAL, DIMENSION(pure%kpol) :: mask6 + LOGICAL, DIMENSION(pure%kexp) :: mask7 + LOGICAL, DIMENSION(pure%kexp) :: mask8 + LOGICAL, DIMENSION(pure%kexp) :: mask9 + LOGICAL, DIMENSION(pure%kexp) :: mask10 + LOGICAL, DIMENSION(pure%kexp) :: mask11 + LOGICAL, DIMENSION(pure%kexp) :: mask12 + LOGICAL, DIMENSION(pure%kexp) :: mask13 + LOGICAL, DIMENSION(pure%kexp) :: mask14 + LOGICAL, DIMENSION(pure%kexp) :: mask15 + LOGICAL, DIMENSION(pure%kexp) :: mask16 + LOGICAL, DIMENSION(pure%kexp) :: mask17 + LOGICAL, DIMENSION(pure%kexp) :: mask18 + kpol = pure%kpol + kexp = pure%kexp + n_pol = pure%n(1:kpol) + d_pol = pure%d(1:kpol) + t_pol = pure%t(1:kpol) + n_exp = pure%n(kpol+1:kpol+kexp) + d_exp = pure%d(kpol+1:kpol+kexp) + t_exp = pure%t(kpol+1:kpol+kexp) + c_exp = pure%c + mask = tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. INT(t_pol)& + & ) + WHERE (mask) + tempd4 = 0.0_pr + ELSEWHERE + tempd4 = t_pol*tau**(t_pol-1)*taud0 + END WHERE + temp = tau**t_pol + mask0 = delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. INT(& + & d_pol)) + WHERE (mask0) + temp0d = 0.0_pr + ELSEWHERE + temp0d = d_pol*delta**(d_pol-1)*deltad0 + END WHERE + temp0 = delta**d_pol + mask1 = delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. INT(& + & d_pol)) + WHERE (mask1) tempd = 0.0_pr + tempdd = 0.0_pr + mask2 = .NOT.(delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. & + & INT(d_pol))) + WHERE (mask2) + temp5 = delta**(d_pol-1) + mask3 = delta .LE. 0.0 .AND. (d_pol - 1 .EQ. 0.0 .OR. d_pol - 1 & + & .NE. INT(d_pol - 1)) + WHERE (mask3) + tempd5 = 0.0_pr + ELSEWHERE + tempd5 = (d_pol-1)*delta**(d_pol-2)*deltad0 + END WHERE + tempdd = d_pol*(deltad*tempd5+temp5*deltadd) + tempd = d_pol*(temp5*deltad) + END WHERE + mask4 = tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. INT(t_pol& + & )) + WHERE (mask4) tempd0 = 0.0_pr + tempd0d = 0.0_pr + mask5 = .NOT.(tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. INT& + & (t_pol))) + WHERE (mask5) + temp5 = tau**(t_pol-1) + mask6 = tau .LE. 0.0 .AND. (t_pol - 1 .EQ. 0.0 .OR. t_pol - 1 .NE.& + & INT(t_pol - 1)) + WHERE (mask6) + tempd5 = 0.0_pr + ELSEWHERE + tempd5 = (t_pol-1)*tau**(t_pol-2)*taud0 + END WHERE + tempd0d = t_pol*(taud*tempd5+temp5*taudd) + tempd0 = t_pol*(temp5*taud) + END WHERE + arg1dd(:) = n_pol*(tempd*tempd4+temp*tempdd+tempd0*temp0d+temp0*& + & tempd0d) + arg1d(:) = n_pol*(temp*tempd+temp0*tempd0) + arg1d0(:) = n_pol*(temp*temp0d+temp0*tempd4) + arg1(:) = n_pol*(temp0*temp) + mask7 = delta .LE. 0.0 .AND. (c_exp .EQ. 0.0 .OR. c_exp .NE. INT(& + & c_exp)) + WHERE (mask7) tempd1 = 0.0_pr + tempd1d = 0.0_pr + mask8 = .NOT.(delta .LE. 0.0 .AND. (c_exp .EQ. 0.0 .OR. c_exp .NE. & + & INT(c_exp))) + WHERE (mask8) + temp6 = delta**(c_exp-1) + mask9 = delta .LE. 0.0 .AND. (c_exp - 1 .EQ. 0.0 .OR. c_exp - 1 & + & .NE. INT(c_exp - 1)) + WHERE (mask9) + tempd6 = 0.0_pr + ELSEWHERE + tempd6 = (c_exp-1)*delta**(c_exp-2)*deltad0 + END WHERE + tempd1d = c_exp*(deltad*tempd6+temp6*deltadd) + tempd1 = c_exp*(temp6*deltad) + END WHERE + arg2dd(:) = -tempd1d + arg2d(:) = -tempd1 + mask10 = delta .LE. 0.0 .AND. (c_exp .EQ. 0.0 .OR. c_exp .NE. INT(& + & c_exp)) + WHERE (mask10) + tempd6 = 0.0_pr + ELSEWHERE + tempd6 = c_exp*delta**(c_exp-1)*deltad0 + END WHERE + arg2d0(:) = -tempd6 + arg2(:) = -(delta**c_exp) + temp1d = EXP(arg2(:))*arg2d0(:) + temp1 = EXP(arg2(:)) + mask11 = tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. INT(& + & t_exp)) + WHERE (mask11) + temp2d = 0.0_pr + ELSEWHERE + temp2d = t_exp*tau**(t_exp-1)*taud0 + END WHERE + temp2 = tau**t_exp + mask12 = delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. INT(& + & d_exp)) + WHERE (mask12) + temp3d = 0.0_pr + ELSEWHERE + temp3d = d_exp*delta**(d_exp-1)*deltad0 + END WHERE + temp3 = delta**d_exp + temp4d = temp2*temp3d + temp3*temp2d + temp4 = temp3*temp2 + mask13 = delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. INT(& + & d_exp)) + WHERE (mask13) tempd2 = 0.0_pr + tempd2d = 0.0_pr + mask14 = .NOT.(delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. & + & INT(d_exp))) + WHERE (mask14) + temp6 = delta**(d_exp-1) + mask15 = delta .LE. 0.0 .AND. (d_exp - 1 .EQ. 0.0 .OR. d_exp - 1 & + & .NE. INT(d_exp - 1)) + WHERE (mask15) + tempd6 = 0.0_pr + ELSEWHERE + tempd6 = (d_exp-1)*delta**(d_exp-2)*deltad0 + END WHERE + tempd2d = d_exp*(deltad*tempd6+temp6*deltadd) + tempd2 = d_exp*(temp6*deltad) + END WHERE + mask16 = tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. INT(& + & t_exp)) + WHERE (mask16) tempd3 = 0.0_pr + tempd3d = 0.0_pr + mask17 = .NOT.(tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. & + & INT(t_exp))) + WHERE (mask17) + temp6 = tau**(t_exp-1) + mask18 = tau .LE. 0.0 .AND. (t_exp - 1 .EQ. 0.0 .OR. t_exp - 1 & + & .NE. INT(t_exp - 1)) + WHERE (mask18) + tempd6 = 0.0_pr + ELSEWHERE + tempd6 = (t_exp-1)*tau**(t_exp-2)*taud0 + END WHERE + tempd3d = t_exp*(taud*tempd6+temp6*taudd) + tempd3 = t_exp*(temp6*taud) + END WHERE + temp6 = temp2*tempd2 + temp3*tempd3 + temp7 = EXP(arg2(:)) + arg3dd(:) = n_exp*(temp6*temp1d+temp1*(tempd2*temp2d+temp2*tempd2d+& + & tempd3*temp3d+temp3*tempd3d)+temp4*arg2d(:)*EXP(arg2(:))*arg2d0(:)& + & +temp7*(arg2d(:)*temp4d+temp4*arg2dd(:))) + arg3d(:) = n_exp*(temp1*temp6+temp7*(temp4*arg2d(:))) + arg3d0(:) = n_exp*(temp1*temp4d+temp4*temp1d) + arg3(:) = n_exp*(temp4*temp1) + ardd = SUM(arg1dd(:)) + SUM(arg3dd(:)) + ard = SUM(arg1d(:)) + SUM(arg3d(:)) + ard0 = SUM(arg1d0(:)) + SUM(arg3d0(:)) + ar = SUM(arg1(:)) + SUM(arg3(:)) + end subroutine AR_PURE_D_D + +! Differentiation of ar_pure_d in reverse (adjoint) mode (with options noISIZE): +! gradient of useful results: taud tau ar deltad ard delta +! with respect to varying inputs: taud tau deltad delta +! Differentiation of ar_pure in forward (tangent) mode (with options noISIZE): +! variations of useful results: ar +! with respect to varying inputs: tau delta + SUBROUTINE AR_PURE_D_B(pure, delta, deltab, deltad, deltadb, tau, taub& + & , taud, taudb, ar, arb, ard, ardb) + IMPLICIT NONE + class(GERG2008PURE), INTENT(IN) :: pure + REAL(pr), INTENT(IN) :: delta + REAL(pr) :: deltab + REAL(pr), INTENT(IN) :: deltad + REAL(pr) :: deltadb + REAL(pr), INTENT(IN) :: tau + REAL(pr) :: taub + REAL(pr), INTENT(IN) :: taud + REAL(pr) :: taudb + REAL(pr) :: ar + REAL(pr) :: arb + REAL(pr) :: ard + REAL(pr) :: ardb + INTEGER :: i, kpol, kexp + REAL(pr) :: n_pol(pure%kpol), d_pol(pure%kpol), t_pol(pure%kpol) + REAL(pr) :: n_exp(pure%kexp), d_exp(pure%kexp), t_exp(pure%kexp) + REAL(pr) :: c_exp(pure%kexp) + INTRINSIC SUM + INTRINSIC EXP + REAL(pr), DIMENSION(pure%kpol) :: arg1 + REAL(pr), DIMENSION(pure%kpol) :: arg1b + REAL(pr), DIMENSION(pure%kpol) :: arg1d + REAL(pr), DIMENSION(pure%kpol) :: arg1db + REAL(pr), DIMENSION(pure%kexp) :: arg2 + REAL(pr), DIMENSION(pure%kexp) :: arg2b + REAL(pr), DIMENSION(pure%kexp) :: arg2d + REAL(pr), DIMENSION(pure%kexp) :: arg2db + REAL(pr), DIMENSION(pure%kexp) :: arg3 + REAL(pr), DIMENSION(pure%kexp) :: arg3b + REAL(pr), DIMENSION(pure%kexp) :: arg3d + REAL(pr), DIMENSION(pure%kexp) :: arg3db + REAL(pr), DIMENSION(pure%kpol) :: temp + REAL(pr), DIMENSION(pure%kpol) :: tempb + REAL(pr), DIMENSION(pure%kpol) :: temp0 + REAL(pr), DIMENSION(pure%kpol) :: temp0b + REAL(pr), DIMENSION(pure%kpol) :: tempd + REAL(pr), DIMENSION(pure%kpol) :: tempdb + REAL(pr), DIMENSION(pure%kpol) :: tempd0 + REAL(pr), DIMENSION(pure%kpol) :: tempd0b + REAL(pr), DIMENSION(pure%kexp) :: temp1 + REAL(pr), DIMENSION(pure%kexp) :: temp1b + REAL(pr), DIMENSION(pure%kexp) :: tempd1 + REAL(pr), DIMENSION(pure%kexp) :: tempd1b + REAL(pr), DIMENSION(pure%kexp) :: temp2 + REAL(pr), DIMENSION(pure%kexp) :: temp2b + REAL(pr), DIMENSION(pure%kexp) :: temp3 + REAL(pr), DIMENSION(pure%kexp) :: temp3b + REAL(pr), DIMENSION(pure%kexp) :: tempd2 + REAL(pr), DIMENSION(pure%kexp) :: tempd2b + REAL(pr), DIMENSION(pure%kexp) :: tempd3 + REAL(pr), DIMENSION(pure%kexp) :: tempd3b + REAL(pr), DIMENSION(pure%kexp) :: temp4 + REAL(pr), DIMENSION(pure%kexp) :: temp4b + INTRINSIC INT + LOGICAL, DIMENSION(pure%kpol) :: mask + LOGICAL, DIMENSION(pure%kpol) :: mask0 + LOGICAL, DIMENSION(pure%kexp) :: mask1 + LOGICAL, DIMENSION(pure%kexp) :: mask2 + LOGICAL, DIMENSION(pure%kexp) :: mask3 + REAL(pr), DIMENSION(pure%kpol) :: tempb0 + REAL(pr), DIMENSION(pure%kexp) :: tempb1 + REAL(pr), DIMENSION(pure%kexp) :: tempb2 + REAL(pr), DIMENSION(pure%kexp) :: tempb3 + LOGICAL, DIMENSION(pure%kexp) :: arg10 + REAL(pr) :: result1 + LOGICAL, DIMENSION(pure%kexp) :: arg20 + REAL(pr) :: result2 + LOGICAL, DIMENSION(pure%kexp) :: arg30 + REAL(pr) :: result3 + LOGICAL, DIMENSION(pure%kexp) :: arg4 + REAL(pr) :: result4 + LOGICAL, DIMENSION(pure%kpol) :: arg5 + REAL(pr) :: result5 + LOGICAL, DIMENSION(pure%kpol) :: arg6 + REAL(pr) :: result6 + LOGICAL, DIMENSION(pure%kpol) :: arg31 + LOGICAL, DIMENSION(pure%kpol) :: arg40 + LOGICAL, DIMENSION(pure%kpol) :: arg21 + kpol = pure%kpol + kexp = pure%kexp + n_pol = pure%n(1:kpol) + d_pol = pure%d(1:kpol) + t_pol = pure%t(1:kpol) + n_exp = pure%n(kpol+1:kpol+kexp) + d_exp = pure%d(kpol+1:kpol+kexp) + t_exp = pure%t(kpol+1:kpol+kexp) + c_exp = pure%c + temp = tau**t_pol + temp0 = delta**d_pol + mask = delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. INT(& + & d_pol)) + WHERE (mask) + tempd = 0.0_pr + ELSEWHERE + tempd = d_pol*delta**(d_pol-1)*deltad + END WHERE + mask0 = tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. INT(t_pol& + & )) + WHERE (mask0) + tempd0 = 0.0_pr + ELSEWHERE + tempd0 = t_pol*tau**(t_pol-1)*taud + END WHERE + arg1d(:) = n_pol*(temp*tempd+temp0*tempd0) + arg1(:) = n_pol*(temp0*temp) + mask1 = delta .LE. 0.0 .AND. (c_exp .EQ. 0.0 .OR. c_exp .NE. INT(& + & c_exp)) + WHERE (mask1) + tempd1 = 0.0_pr + ELSEWHERE + tempd1 = c_exp*delta**(c_exp-1)*deltad + END WHERE + arg2d(:) = -tempd1 + arg2(:) = -(delta**c_exp) + temp1 = EXP(arg2(:)) + temp2 = tau**t_exp + temp3 = delta**d_exp + temp4 = temp3*temp2 + mask2 = delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. INT(& + & d_exp)) + WHERE (mask2) + tempd2 = 0.0_pr + ELSEWHERE + tempd2 = d_exp*delta**(d_exp-1)*deltad + END WHERE + mask3 = tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. INT(t_exp& + & )) + WHERE (mask3) + tempd3 = 0.0_pr + ELSEWHERE + tempd3 = t_exp*tau**(t_exp-1)*taud + END WHERE + arg3d(:) = n_exp*(temp1*(temp2*tempd2+temp3*tempd3)+temp4*EXP(arg2(:& + & ))*arg2d(:)) + arg3(:) = n_exp*(temp4*temp1) + arg1b = 0.0_pr + arg3b = 0.0_pr + arg1b = arb + arg3b = arb + arg1db = 0.0_pr + arg3db = 0.0_pr + arg1db = ardb + arg3db = ardb + temp4b = 0.0_pr + temp1b = 0.0_pr + arg2b = 0.0_pr + tempd2b = 0.0_pr + tempd3b = 0.0_pr + arg2db = 0.0_pr + temp2b = 0.0_pr + temp3b = 0.0_pr + tempb1 = n_exp*arg3db + temp1b = temp4*n_exp*arg3b + (temp2*tempd2+temp3*tempd3)*tempb1 + tempb2 = temp1*tempb1 + arg2b = EXP(arg2)*temp4*arg2d*tempb1 + EXP(arg2)*temp1b + tempb3 = EXP(arg2)*tempb1 + temp4b = temp1*n_exp*arg3b + arg2d*tempb3 + arg2db = temp4*tempb3 + temp2b = tempd2*tempb2 + temp3*temp4b + tempd2b = temp2*tempb2 + temp3b = tempd3*tempb2 + temp2*temp4b + tempd3b = temp3*tempb2 + tempd1b = 0.0_pr + tempd1b = -arg2db + tempb = 0.0_pr + temp0b = 0.0_pr + tempd0b = 0.0_pr + tempdb = 0.0_pr + tempb0 = n_pol*arg1db + temp0b = temp*n_pol*arg1b + tempd0*tempb0 + tempb = temp0*n_pol*arg1b + tempd*tempb0 + tempdb = temp*tempb0 + arg10(:) = .NOT.mask2 .AND. (.NOT.(delta .LE. 0.0 .AND. (d_exp - 1 & + & .EQ. 0.0 .OR. d_exp - 1 .NE. INT(d_exp - 1)))) + result1 = SUM((d_exp-1)*delta**(d_exp-2)*d_exp*tempd2b, mask=arg10(:& + & )) + arg20(:) = .NOT.(delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp & + & .NE. INT(d_exp))) + result2 = SUM(d_exp*delta**(d_exp-1)*temp3b, mask=arg20(:)) + arg30(:) = .NOT.mask1 .AND. (.NOT.(delta .LE. 0.0 .AND. (c_exp - 1 & + & .EQ. 0.0 .OR. c_exp - 1 .NE. INT(c_exp - 1)))) + result3 = SUM((c_exp-1)*delta**(c_exp-2)*c_exp*tempd1b, mask=arg30(:& + & )) + arg4(:) = .NOT.(delta .LE. 0.0 .AND. (c_exp .EQ. 0.0 .OR. c_exp .NE.& + & INT(c_exp))) + result4 = SUM(c_exp*delta**(c_exp-1)*arg2b, mask=arg4(:)) + arg5(:) = .NOT.mask .AND. (.NOT.(delta .LE. 0.0 .AND. (d_pol - 1 & + & .EQ. 0.0 .OR. d_pol - 1 .NE. INT(d_pol - 1)))) + result5 = SUM((d_pol-1)*delta**(d_pol-2)*d_pol*tempdb, mask=arg5(:)) + arg6(:) = .NOT.(delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE.& + & INT(d_pol))) + result6 = SUM(d_pol*delta**(d_pol-1)*temp0b, mask=arg6(:)) + deltab = deltab + result1*deltad + result2 + result3*deltad - & + & result4 + result5*deltad + result6 + arg10(:) = .NOT.mask2 + result1 = SUM(delta**(d_exp-1)*d_exp*tempd2b, mask=arg10(:)) + arg20(:) = .NOT.mask1 + result2 = SUM(delta**(c_exp-1)*c_exp*tempd1b, mask=arg20(:)) + arg31(:) = .NOT.mask + result3 = SUM(delta**(d_pol-1)*d_pol*tempdb, mask=arg31(:)) + deltadb = deltadb + result1 + result2 + result3 + tempd0b = temp0*tempb0 + arg10(:) = .NOT.mask3 .AND. (.NOT.(tau .LE. 0.0 .AND. (t_exp - 1 & + & .EQ. 0.0 .OR. t_exp - 1 .NE. INT(t_exp - 1)))) + result1 = SUM((t_exp-1)*tau**(t_exp-2)*t_exp*tempd3b, mask=arg10(:)) + arg20(:) = .NOT.(tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. & + & INT(t_exp))) + result2 = SUM(t_exp*tau**(t_exp-1)*temp2b, mask=arg20(:)) + arg31(:) = .NOT.mask0 .AND. (.NOT.(tau .LE. 0.0 .AND. (t_pol - 1 & + & .EQ. 0.0 .OR. t_pol - 1 .NE. INT(t_pol - 1)))) + result3 = SUM((t_pol-1)*tau**(t_pol-2)*t_pol*tempd0b, mask=arg31(:)) + arg40(:) = .NOT.(tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. & + & INT(t_pol))) + result4 = SUM(t_pol*tau**(t_pol-1)*tempb, mask=arg40(:)) + taub = taub + result1*taud + result2 + result3*taud + result4 + arg10(:) = .NOT.mask3 + result1 = SUM(tau**(t_exp-1)*t_exp*tempd3b, mask=arg10(:)) + arg21(:) = .NOT.mask0 + result2 = SUM(tau**(t_pol-1)*t_pol*tempd0b, mask=arg21(:)) + taudb = taudb + result1 + result2 + end subroutine AR_PURE_D_B + +! Differentiation of ar_pure in forward (tangent) mode (with options noISIZE): +! variations of useful results: ar +! with respect to varying inputs: tau delta + SUBROUTINE AR_PURE_D(pure, delta, deltad, tau, taud, ar, ard) + IMPLICIT NONE + class(GERG2008PURE), INTENT(IN) :: pure + REAL(pr), INTENT(IN) :: delta + REAL(pr), INTENT(IN) :: deltad + REAL(pr), INTENT(IN) :: tau + REAL(pr), INTENT(IN) :: taud + REAL(pr), INTENT(OUT) :: ar + REAL(pr), INTENT(OUT) :: ard + INTEGER :: i, kpol, kexp + REAL(pr) :: n_pol(pure%kpol), d_pol(pure%kpol), t_pol(pure%kpol) + REAL(pr) :: n_exp(pure%kexp), d_exp(pure%kexp), t_exp(pure%kexp) + REAL(pr) :: c_exp(pure%kexp) + INTRINSIC SUM + INTRINSIC EXP + REAL(pr), DIMENSION(pure%kpol) :: arg1 + REAL(pr), DIMENSION(pure%kpol) :: arg1d + REAL(pr), DIMENSION(pure%kexp) :: arg2 + REAL(pr), DIMENSION(pure%kexp) :: arg2d + REAL(pr), DIMENSION(pure%kexp) :: arg3 + REAL(pr), DIMENSION(pure%kexp) :: arg3d + REAL(pr), DIMENSION(pure%kpol) :: temp + REAL(pr), DIMENSION(pure%kpol) :: temp0 + REAL(pr), DIMENSION(pure%kpol) :: tempd + REAL(pr), DIMENSION(pure%kpol) :: tempd0 + REAL(pr), DIMENSION(pure%kexp) :: temp1 + REAL(pr), DIMENSION(pure%kexp) :: tempd1 + REAL(pr), DIMENSION(pure%kexp) :: temp2 + REAL(pr), DIMENSION(pure%kexp) :: temp3 + REAL(pr), DIMENSION(pure%kexp) :: tempd2 + REAL(pr), DIMENSION(pure%kexp) :: tempd3 + REAL(pr), DIMENSION(pure%kexp) :: temp4 + INTRINSIC INT + LOGICAL, DIMENSION(pure%kpol) :: mask + LOGICAL, DIMENSION(pure%kpol) :: mask0 + LOGICAL, DIMENSION(pure%kexp) :: mask1 + LOGICAL, DIMENSION(pure%kexp) :: mask2 + LOGICAL, DIMENSION(pure%kexp) :: mask3 + kpol = pure%kpol + kexp = pure%kexp + n_pol = pure%n(1:kpol) + d_pol = pure%d(1:kpol) + t_pol = pure%t(1:kpol) + n_exp = pure%n(kpol+1:kpol+kexp) + d_exp = pure%d(kpol+1:kpol+kexp) + t_exp = pure%t(kpol+1:kpol+kexp) + c_exp = pure%c + temp = tau**t_pol + temp0 = delta**d_pol + mask = delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. INT(& + & d_pol)) + WHERE (mask) + tempd = 0.0_pr + ELSEWHERE + tempd = d_pol*delta**(d_pol-1)*deltad + END WHERE + mask0 = tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. INT(t_pol& + & )) + WHERE (mask0) + tempd0 = 0.0_pr + ELSEWHERE + tempd0 = t_pol*tau**(t_pol-1)*taud + END WHERE + arg1d(:) = n_pol*(temp*tempd+temp0*tempd0) + arg1(:) = n_pol*(temp0*temp) + mask1 = delta .LE. 0.0 .AND. (c_exp .EQ. 0.0 .OR. c_exp .NE. INT(& + & c_exp)) + WHERE (mask1) + tempd1 = 0.0_pr + ELSEWHERE + tempd1 = c_exp*delta**(c_exp-1)*deltad + END WHERE + arg2d(:) = -tempd1 + arg2(:) = -(delta**c_exp) + temp1 = EXP(arg2(:)) + temp2 = tau**t_exp + temp3 = delta**d_exp + temp4 = temp3*temp2 + mask2 = delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. INT(& + & d_exp)) + WHERE (mask2) + tempd2 = 0.0_pr + ELSEWHERE + tempd2 = d_exp*delta**(d_exp-1)*deltad + END WHERE + mask3 = tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. INT(t_exp& + & )) + WHERE (mask3) + tempd3 = 0.0_pr + ELSEWHERE + tempd3 = t_exp*tau**(t_exp-1)*taud + END WHERE + arg3d(:) = n_exp*(temp1*(temp2*tempd2+temp3*tempd3)+temp4*EXP(arg2(:& + & ))*arg2d(:)) + arg3(:) = n_exp*(temp4*temp1) + ard = SUM(arg1d(:)) + SUM(arg3d(:)) + ar = SUM(arg1(:)) + SUM(arg3(:)) + end subroutine AR_PURE_D + +! Differentiation of ar_pure in reverse (adjoint) mode (with options noISIZE): +! gradient of useful results: tau ar delta +! with respect to varying inputs: tau delta + SUBROUTINE AR_PURE_B(pure, delta, deltab, tau, taub, ar, arb) + IMPLICIT NONE + class(GERG2008PURE), INTENT(IN) :: pure + REAL(pr), INTENT(IN) :: delta + REAL(pr) :: deltab + REAL(pr), INTENT(IN) :: tau + REAL(pr) :: taub + REAL(pr) :: ar + REAL(pr) :: arb + INTEGER :: i, kpol, kexp + REAL(pr) :: n_pol(pure%kpol), d_pol(pure%kpol), t_pol(pure%kpol) + REAL(pr) :: n_exp(pure%kexp), d_exp(pure%kexp), t_exp(pure%kexp) + REAL(pr) :: c_exp(pure%kexp) + INTRINSIC SUM + INTRINSIC EXP + REAL(pr), DIMENSION(pure%kpol) :: arg1 + REAL(pr), DIMENSION(pure%kpol) :: arg1b + REAL(pr), DIMENSION(pure%kexp) :: arg2 + REAL(pr), DIMENSION(pure%kexp) :: arg2b + REAL(pr), DIMENSION(pure%kexp) :: arg3 + REAL(pr), DIMENSION(pure%kexp) :: arg3b + REAL(pr), DIMENSION(pure%kexp) :: tempb + REAL(pr), DIMENSION(pure%kexp) :: temp + REAL(pr), DIMENSION(pure%kexp) :: temp0 + kpol = pure%kpol + kexp = pure%kexp + n_pol = pure%n(1:kpol) + d_pol = pure%d(1:kpol) + t_pol = pure%t(1:kpol) + n_exp = pure%n(kpol+1:kpol+kexp) + d_exp = pure%d(kpol+1:kpol+kexp) + t_exp = pure%t(kpol+1:kpol+kexp) + c_exp = pure%c + arg1(:) = n_pol*delta**d_pol*tau**t_pol + arg2(:) = -(delta**c_exp) + arg3(:) = n_exp*delta**d_exp*tau**t_exp*EXP(arg2(:)) + arg1b = 0.0_pr + arg3b = 0.0_pr + arg1b = arb + arg3b = arb + arg2b = 0.0_pr + temp = tau**t_exp + temp0 = delta**d_exp + tempb = EXP(arg2)*n_exp*arg3b + arg2b = EXP(arg2)*temp0*temp*n_exp*arg3b + deltab = deltab + SUM(d_exp*delta**(d_exp-1)*temp*tempb, MASK=.NOT.(& + & delta.LE.0.0.AND.(d_exp.EQ.0.0.OR.d_exp.NE.INT(d_exp)))) + SUM(& + & d_pol*delta**(d_pol-1)*tau**t_pol*n_pol*arg1b, MASK=.NOT.(delta& + & .LE.0.0.AND.(d_pol.EQ.0.0.OR.d_pol.NE.INT(d_pol)))) - SUM(c_exp*& + & delta**(c_exp-1)*arg2b, MASK=.NOT.(delta.LE.0.0.AND.(c_exp.EQ.0.0& + & .OR.c_exp.NE.INT(c_exp)))) + taub = taub + SUM(t_exp*tau**(t_exp-1)*temp0*tempb, MASK=.NOT.(tau& + & .LE.0.0.AND.(t_exp.EQ.0.0.OR.t_exp.NE.INT(t_exp)))) + SUM(t_pol*& + & tau**(t_pol-1)*delta**d_pol*n_pol*arg1b, MASK=.NOT.(tau.LE.0.0& + & .AND.(t_pol.EQ.0.0.OR.t_pol.NE.INT(t_pol)))) + end subroutine AR_PURE_B + + SUBROUTINE AR_PURE(pure, delta, tau, ar) + IMPLICIT NONE + class(GERG2008PURE), INTENT(IN) :: pure + REAL(pr), INTENT(IN) :: delta + REAL(pr), INTENT(IN) :: tau + REAL(pr), INTENT(OUT) :: ar + INTEGER :: i, kpol, kexp + REAL(pr) :: n_pol(pure%kpol), d_pol(pure%kpol), t_pol(pure%kpol) + REAL(pr) :: n_exp(pure%kexp), d_exp(pure%kexp), t_exp(pure%kexp) + REAL(pr) :: c_exp(pure%kexp) + INTRINSIC SUM + INTRINSIC EXP + REAL(pr), DIMENSION(pure%kpol) :: arg1 + REAL(pr), DIMENSION(pure%kexp) :: arg2 + REAL(pr), DIMENSION(pure%kexp) :: arg3 + kpol = pure%kpol + kexp = pure%kexp + n_pol = pure%n(1:kpol) + d_pol = pure%d(1:kpol) + t_pol = pure%t(1:kpol) + n_exp = pure%n(kpol+1:kpol+kexp) + d_exp = pure%d(kpol+1:kpol+kexp) + t_exp = pure%t(kpol+1:kpol+kexp) + c_exp = pure%c + arg1(:) = n_pol*delta**d_pol*tau**t_pol + arg2(:) = -(delta**c_exp) + arg3(:) = n_exp*delta**d_exp*tau**t_exp*EXP(arg2(:)) + ar = SUM(arg1(:)) + SUM(arg3(:)) + end subroutine AR_PURE + +! Differentiation of ar_ij_d_d in forward (tangent) mode (with options noISIZE): +! variations of useful results: aijd0 aijd aijdd aij +! with respect to varying inputs: taudd taud tau deltad0 deltad +! taud0 delta deltadd +! Differentiation of ar_ij_d in forward (tangent) mode (with options noISIZE): +! variations of useful results: aijd aij +! with respect to varying inputs: taud tau deltad delta +! Differentiation of ar_ij in forward (tangent) mode (with options noISIZE): +! variations of useful results: aij +! with respect to varying inputs: tau delta + SUBROUTINE AR_IJ_D_D_D(model, delta, deltad1, deltad0, deltad0d, & + & deltad, deltadd0, deltadd, deltaddd, tau, taud1, taud0, taud0d, taud& + & , taudd0, taudd, tauddd, binary, aij, aijd1, aijd0, aijd0d, aijd, & + & aijdd0, aijdd, aijddd) + IMPLICIT NONE + class(GERG2008), INTENT(IN) :: model + REAL(pr), INTENT(IN) :: delta + REAL(pr), INTENT(IN) :: deltad1 + REAL(pr), INTENT(IN) :: deltad0 + REAL(pr), INTENT(IN) :: deltad0d + REAL(pr), INTENT(IN) :: deltad + REAL(pr), INTENT(IN) :: deltadd0 + REAL(pr), INTENT(IN) :: deltadd + REAL(pr), INTENT(IN) :: deltaddd + REAL(pr), INTENT(IN) :: tau + REAL(pr), INTENT(IN) :: taud1 + REAL(pr), INTENT(IN) :: taud0 + REAL(pr), INTENT(IN) :: taud0d + REAL(pr), INTENT(IN) :: taud + REAL(pr), INTENT(IN) :: taudd0 + REAL(pr), INTENT(IN) :: taudd + REAL(pr), INTENT(IN) :: tauddd + class(GERG2008BINARY), INTENT(IN) :: binary + REAL(pr), INTENT(OUT) :: aij + REAL(pr), INTENT(OUT) :: aijd1 + REAL(pr), INTENT(OUT) :: aijd0 + REAL(pr), INTENT(OUT) :: aijd0d + REAL(pr), INTENT(OUT) :: aijd + REAL(pr), INTENT(OUT) :: aijdd0 + REAL(pr), INTENT(OUT) :: aijdd + REAL(pr), INTENT(OUT) :: aijddd + INTEGER :: idx_poly, idx_exp + INTEGER :: k + REAL(pr) :: n_pol(binary%kpolij), d_pol(binary%kpolij), t_pol(binary%& + & kpolij) + REAL(pr) :: n_exp(binary%kexpij), d_exp(binary%kexpij), t_exp(binary%& + & kexpij) + REAL(pr) :: etha(binary%kexpij), eps(binary%kexpij), beta(binary%& + & kexpij), gama(binary%kexpij) + INTRINSIC SUM + INTRINSIC EXP + REAL(pr), DIMENSION(binary%kpolij) :: arg1 + REAL(pr), DIMENSION(binary%kpolij) :: arg1d1 + REAL(pr), DIMENSION(binary%kpolij) :: arg1d0 + REAL(pr), DIMENSION(binary%kpolij) :: arg1d0d + REAL(pr), DIMENSION(binary%kpolij) :: arg1d + REAL(pr), DIMENSION(binary%kpolij) :: arg1dd0 + REAL(pr), DIMENSION(binary%kpolij) :: arg1dd + REAL(pr), DIMENSION(binary%kpolij) :: arg1ddd + REAL(pr), DIMENSION(binary%kexpij) :: arg2 + REAL(pr), DIMENSION(binary%kexpij) :: arg2d1 + REAL(pr), DIMENSION(binary%kexpij) :: arg2d0 + REAL(pr), DIMENSION(binary%kexpij) :: arg2d0d + REAL(pr), DIMENSION(binary%kexpij) :: arg2d + REAL(pr), DIMENSION(binary%kexpij) :: arg2dd0 + REAL(pr), DIMENSION(binary%kexpij) :: arg2dd + REAL(pr), DIMENSION(binary%kexpij) :: arg2ddd + REAL(pr), DIMENSION(binary%kexpij) :: arg3 + REAL(pr), DIMENSION(binary%kexpij) :: arg3d1 + REAL(pr), DIMENSION(binary%kexpij) :: arg3d0 + REAL(pr), DIMENSION(binary%kexpij) :: arg3d0d + REAL(pr), DIMENSION(binary%kexpij) :: arg3d + REAL(pr), DIMENSION(binary%kexpij) :: arg3dd0 + REAL(pr), DIMENSION(binary%kexpij) :: arg3dd + REAL(pr), DIMENSION(binary%kexpij) :: arg3ddd + REAL(pr), DIMENSION(binary%kpolij) :: temp + REAL(pr), DIMENSION(binary%kpolij) :: tempd6 + REAL(pr), DIMENSION(binary%kpolij) :: tempd3 + REAL(pr), DIMENSION(binary%kpolij) :: tempd3d + REAL(pr), DIMENSION(binary%kpolij) :: temp0 + REAL(pr), DIMENSION(binary%kpolij) :: temp0d0 + REAL(pr), DIMENSION(binary%kpolij) :: temp0d + REAL(pr), DIMENSION(binary%kpolij) :: temp0dd + REAL(pr), DIMENSION(binary%kpolij) :: tempd + REAL(pr), DIMENSION(binary%kpolij) :: tempdd0 + REAL(pr), DIMENSION(binary%kpolij) :: tempdd + REAL(pr), DIMENSION(binary%kpolij) :: tempddd + REAL(pr), DIMENSION(binary%kpolij) :: tempd0 + REAL(pr), DIMENSION(binary%kpolij) :: tempd0d0 + REAL(pr), DIMENSION(binary%kpolij) :: tempd0d + REAL(pr), DIMENSION(binary%kpolij) :: tempd0dd + REAL(pr), DIMENSION(binary%kexpij) :: temp1 + REAL(pr), DIMENSION(binary%kexpij) :: temp1d0 + REAL(pr), DIMENSION(binary%kexpij) :: temp1d + REAL(pr), DIMENSION(binary%kexpij) :: temp1dd + REAL(pr), DIMENSION(binary%kexpij) :: temp2 + REAL(pr), DIMENSION(binary%kexpij) :: temp2d0 + REAL(pr), DIMENSION(binary%kexpij) :: temp2d + REAL(pr), DIMENSION(binary%kexpij) :: temp2dd + REAL(pr), DIMENSION(binary%kexpij) :: temp3 + REAL(pr), DIMENSION(binary%kexpij) :: temp3d0 + REAL(pr), DIMENSION(binary%kexpij) :: temp3d + REAL(pr), DIMENSION(binary%kexpij) :: temp3dd + REAL(pr), DIMENSION(binary%kexpij) :: tempd1 + REAL(pr), DIMENSION(binary%kexpij) :: tempd1d0 + REAL(pr), DIMENSION(binary%kexpij) :: tempd1d + REAL(pr), DIMENSION(binary%kexpij) :: tempd1dd + REAL(pr), DIMENSION(binary%kexpij) :: tempd2 + REAL(pr), DIMENSION(binary%kexpij) :: tempd2d0 + REAL(pr), DIMENSION(binary%kexpij) :: tempd2d + REAL(pr), DIMENSION(binary%kexpij) :: tempd2dd + REAL(pr), DIMENSION(binary%kexpij) :: temp4 + REAL(pr), DIMENSION(binary%kexpij) :: temp4d0 + REAL(pr), DIMENSION(binary%kexpij) :: temp4d + REAL(pr), DIMENSION(binary%kexpij) :: temp4dd + INTRINSIC INT + REAL(pr), DIMENSION(binary%kpolij) :: temp5 + REAL(pr), DIMENSION(binary%kpolij) :: temp5d + REAL(pr), DIMENSION(binary%kpolij) :: tempd4 + REAL(pr), DIMENSION(binary%kpolij) :: tempd4d + REAL(pr), DIMENSION(binary%kexpij) :: temp6 + REAL(pr), DIMENSION(binary%kexpij) :: temp6d + REAL(pr), DIMENSION(binary%kexpij) :: tempd5 + REAL(pr), DIMENSION(binary%kexpij) :: tempd5d + REAL(pr), DIMENSION(binary%kexpij) :: temp7 + REAL(pr), DIMENSION(binary%kexpij) :: temp7d + REAL(pr), DIMENSION(binary%kpolij) :: temp8 + REAL(pr), DIMENSION(binary%kpolij) :: tempd7 + REAL(pr), DIMENSION(binary%kexpij) :: temp9 + REAL(pr), DIMENSION(binary%kexpij) :: tempd8 + REAL(pr), DIMENSION(binary%kexpij) :: temp10 + REAL(pr), DIMENSION(binary%kexpij) :: temp11 + REAL(pr), DIMENSION(binary%kexpij) :: temp12 + LOGICAL, DIMENSION(binary%kpolij) :: mask + LOGICAL, DIMENSION(binary%kpolij) :: mask0 + LOGICAL, DIMENSION(binary%kpolij) :: mask1 + LOGICAL, DIMENSION(binary%kpolij) :: mask2 + LOGICAL, DIMENSION(binary%kpolij) :: mask3 + LOGICAL, DIMENSION(binary%kpolij) :: mask4 + LOGICAL, DIMENSION(binary%kpolij) :: mask5 + LOGICAL, DIMENSION(binary%kpolij) :: mask6 + LOGICAL, DIMENSION(binary%kpolij) :: mask7 + LOGICAL, DIMENSION(binary%kpolij) :: mask8 + LOGICAL, DIMENSION(binary%kpolij) :: mask9 + LOGICAL, DIMENSION(binary%kpolij) :: mask10 + LOGICAL, DIMENSION(binary%kpolij) :: mask11 + LOGICAL, DIMENSION(binary%kpolij) :: mask12 + LOGICAL, DIMENSION(binary%kpolij) :: mask13 + LOGICAL, DIMENSION(binary%kpolij) :: mask14 + LOGICAL, DIMENSION(binary%kpolij) :: mask15 + LOGICAL, DIMENSION(binary%kpolij) :: mask16 + LOGICAL, DIMENSION(binary%kpolij) :: mask17 + LOGICAL, DIMENSION(binary%kpolij) :: mask18 + LOGICAL, DIMENSION(binary%kpolij) :: mask19 + LOGICAL, DIMENSION(binary%kpolij) :: mask20 + LOGICAL, DIMENSION(binary%kpolij) :: mask21 + LOGICAL, DIMENSION(binary%kpolij) :: mask22 + LOGICAL, DIMENSION(binary%kexpij) :: mask23 + LOGICAL, DIMENSION(binary%kexpij) :: mask24 + LOGICAL, DIMENSION(binary%kexpij) :: mask25 + LOGICAL, DIMENSION(binary%kexpij) :: mask26 + LOGICAL, DIMENSION(binary%kexpij) :: mask27 + LOGICAL, DIMENSION(binary%kexpij) :: mask28 + LOGICAL, DIMENSION(binary%kexpij) :: mask29 + LOGICAL, DIMENSION(binary%kexpij) :: mask30 + LOGICAL, DIMENSION(binary%kexpij) :: mask31 + LOGICAL, DIMENSION(binary%kexpij) :: mask32 + LOGICAL, DIMENSION(binary%kexpij) :: mask33 + LOGICAL, DIMENSION(binary%kexpij) :: mask34 + LOGICAL, DIMENSION(binary%kexpij) :: mask35 + LOGICAL, DIMENSION(binary%kexpij) :: mask36 + LOGICAL, DIMENSION(binary%kexpij) :: mask37 + LOGICAL, DIMENSION(binary%kexpij) :: mask38 + LOGICAL, DIMENSION(binary%kexpij) :: mask39 + LOGICAL, DIMENSION(binary%kexpij) :: mask40 + LOGICAL, DIMENSION(binary%kexpij) :: mask41 + LOGICAL, DIMENSION(binary%kexpij) :: mask42 + LOGICAL, DIMENSION(binary%kexpij) :: mask43 + LOGICAL, DIMENSION(binary%kexpij) :: mask44 + LOGICAL, DIMENSION(binary%kexpij) :: mask45 + LOGICAL, DIMENSION(binary%kexpij) :: mask46 + idx_poly = binary%kpolij + idx_exp = binary%kexpij + idx_poly + n_pol = binary%nij(1:idx_poly) + d_pol = binary%dij(1:idx_poly) + t_pol = binary%tij(1:idx_poly) + n_exp = binary%nij(idx_poly+1:idx_exp) + d_exp = binary%dij(idx_poly+1:idx_exp) + t_exp = binary%tij(idx_poly+1:idx_exp) + etha = binary%ethaij(1:binary%kexpij) + eps = binary%epsij(1:binary%kexpij) + beta = binary%betaij(1:binary%kexpij) + gama = binary%gammaij(1:binary%kexpij) + mask = tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. INT(t_pol)& + & ) + WHERE (mask) tempd3 = 0.0_pr + tempd3d = 0.0_pr + mask0 = .NOT.(tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. INT& + & (t_pol))) + WHERE (mask0) + temp8 = tau**(t_pol-1) + mask1 = tau .LE. 0.0 .AND. (t_pol - 1 .EQ. 0.0 .OR. t_pol - 1 .NE.& + & INT(t_pol - 1)) + WHERE (mask1) + tempd7 = 0.0_pr + ELSEWHERE + tempd7 = (t_pol-1)*tau**(t_pol-2)*taud1 + END WHERE + tempd3d = t_pol*(taud0*tempd7+temp8*taud0d) + tempd3 = t_pol*(temp8*taud0) + END WHERE + mask2 = tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. INT(t_pol& + & )) + WHERE (mask2) + tempd6 = 0.0_pr + ELSEWHERE + tempd6 = t_pol*tau**(t_pol-1)*taud1 + END WHERE + temp = tau**t_pol + mask3 = delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. INT(& + & d_pol)) + WHERE (mask3) temp0d = 0.0_pr + temp0dd = 0.0_pr + mask4 = .NOT.(delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. & + & INT(d_pol))) + WHERE (mask4) + temp8 = delta**(d_pol-1) + mask5 = delta .LE. 0.0 .AND. (d_pol - 1 .EQ. 0.0 .OR. d_pol - 1 & + & .NE. INT(d_pol - 1)) + WHERE (mask5) + tempd7 = 0.0_pr + ELSEWHERE + tempd7 = (d_pol-1)*delta**(d_pol-2)*deltad1 + END WHERE + temp0dd = d_pol*(deltad0*tempd7+temp8*deltad0d) + temp0d = d_pol*(temp8*deltad0) + END WHERE + mask6 = delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. INT(& + & d_pol)) + WHERE (mask6) + temp0d0 = 0.0_pr + ELSEWHERE + temp0d0 = d_pol*delta**(d_pol-1)*deltad1 + END WHERE + temp0 = delta**d_pol + mask7 = delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. INT(& + & d_pol)) + WHERE (mask7) tempd = 0.0_pr + tempdd = 0.0_pr + temp5d = 0.0_pr + mask8 = .NOT.(delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. & + & INT(d_pol))) + WHERE (mask8) + mask9 = delta .LE. 0.0 .AND. (d_pol - 1 .EQ. 0.0 .OR. d_pol - 1 & + & .NE. INT(d_pol - 1)) + WHERE (mask9) + temp5d = 0.0_pr + ELSEWHERE + temp5d = (d_pol-1)*delta**(d_pol-2)*deltad1 + END WHERE + temp5 = delta**(d_pol-1) + mask10 = delta .LE. 0.0 .AND. (d_pol - 1 .EQ. 0.0 .OR. d_pol - 1 & + & .NE. INT(d_pol - 1)) + WHERE (mask10) tempd4 = 0.0_pr + END WHERE + tempd4d = 0.0_pr + mask11 = .NOT.(delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. & + & INT(d_pol))) + WHERE (mask11) + mask12 = .NOT.(delta .LE. 0.0 .AND. (d_pol - 1 .EQ. 0.0 .OR. d_pol& + & - 1 .NE. INT(d_pol - 1))) + WHERE (mask12) + temp8 = delta**(d_pol-2) + mask13 = delta .LE. 0.0 .AND. (d_pol - 2 .EQ. 0.0 .OR. d_pol - 2& + & .NE. INT(d_pol - 2)) + WHERE (mask13) + tempd7 = 0.0_pr + ELSEWHERE + tempd7 = (d_pol-2)*delta**(d_pol-3)*deltad1 + END WHERE + tempd4d = (d_pol-1)*(deltad0*tempd7+temp8*deltad0d) + tempd4 = (d_pol-1)*(temp8*deltad0) + END WHERE + END WHERE + tempddd = 0.0_pr + mask14 = .NOT.(delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. & + & INT(d_pol))) + WHERE (mask14) + tempddd = d_pol*(tempd4*deltadd0+deltad*tempd4d+deltadd*temp5d+& + & temp5*deltaddd) + tempdd = d_pol*(deltad*tempd4+temp5*deltadd) + END WHERE + tempdd0 = 0.0_pr + mask15 = .NOT.(delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. & + & INT(d_pol))) + WHERE (mask15) + tempdd0 = d_pol*(deltad*temp5d+temp5*deltadd0) + tempd = d_pol*(temp5*deltad) + END WHERE + mask16 = tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. INT(& + & t_pol)) + WHERE (mask16) tempd0 = 0.0_pr + tempd0d = 0.0_pr + mask17 = .NOT.(tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. & + & INT(t_pol))) + WHERE (mask17) + mask18 = tau .LE. 0.0 .AND. (t_pol - 1 .EQ. 0.0 .OR. t_pol - 1 & + & .NE. INT(t_pol - 1)) + WHERE (mask18) + temp5d = 0.0_pr + ELSEWHERE + temp5d = (t_pol-1)*tau**(t_pol-2)*taud1 + END WHERE + temp5 = tau**(t_pol-1) + mask19 = tau .LE. 0.0 .AND. (t_pol - 1 .EQ. 0.0 .OR. t_pol - 1 & + & .NE. INT(t_pol - 1)) + WHERE (mask19) + tempd4d = 0.0_pr + tempd4 = 0.0_pr + ELSEWHERE + temp8 = tau**(t_pol-2) + mask20 = tau .LE. 0.0 .AND. (t_pol - 2 .EQ. 0.0 .OR. t_pol - 2 & + & .NE. INT(t_pol - 2)) + WHERE (mask20) + tempd7 = 0.0_pr + ELSEWHERE + tempd7 = (t_pol-2)*tau**(t_pol-3)*taud1 + END WHERE + tempd4d = (t_pol-1)*(taud0*tempd7+temp8*taud0d) + tempd4 = (t_pol-1)*(temp8*taud0) + END WHERE + END WHERE + tempd0dd = 0.0_pr + mask21 = .NOT.(tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. & + & INT(t_pol))) + WHERE (mask21) + tempd0dd = t_pol*(tempd4*taudd0+taud*tempd4d+taudd*temp5d+temp5*& + & tauddd) + tempd0d = t_pol*(taud*tempd4+temp5*taudd) + END WHERE + tempd0d0 = 0.0_pr + mask22 = .NOT.(tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. & + & INT(t_pol))) + WHERE (mask22) + tempd0d0 = t_pol*(taud*temp5d+temp5*taudd0) + tempd0 = t_pol*(temp5*taud) + END WHERE + arg1ddd(:) = n_pol*(tempd3*tempdd0+tempd*tempd3d+tempdd*tempd6+temp*& + & tempddd+temp0d*tempd0d0+tempd0*temp0dd+tempd0d*temp0d0+temp0*& + & tempd0dd) + arg1dd(:) = n_pol*(tempd*tempd3+temp*tempdd+tempd0*temp0d+temp0*& + & tempd0d) + arg1dd0(:) = n_pol*(tempd*tempd6+temp*tempdd0+tempd0*temp0d0+temp0*& + & tempd0d0) + arg1d(:) = n_pol*(temp*tempd+temp0*tempd0) + arg1d0d(:) = n_pol*(temp0d*tempd6+temp*temp0dd+tempd3*temp0d0+temp0*& + & tempd3d) + arg1d0(:) = n_pol*(temp*temp0d+temp0*tempd3) + arg1d1(:) = n_pol*(temp*temp0d0+temp0*tempd6) + arg1(:) = n_pol*(temp0*temp) + temp6d = etha*2*deltad1 + temp6 = beta + 2*etha*(delta-eps) + arg2ddd(:) = -(etha*2*(deltad0*deltadd0+deltad*deltad0d)) - deltadd*& + & temp6d - temp6*deltaddd + arg2dd(:) = -(deltad*etha*2*deltad0+temp6*deltadd) + arg2dd0(:) = -(deltad*temp6d+temp6*deltadd0) + arg2d(:) = -(temp6*deltad) + temp9 = beta + 2*etha*(delta-eps) + arg2d0d(:) = -(deltad0*etha*2*deltad1+temp9*deltad0d) + arg2d0(:) = -(temp9*deltad0) + arg2d1(:) = -((etha*2*(delta-eps)+beta)*deltad1) + arg2(:) = -(etha*(delta-eps)**2) - beta*(delta-gama) + temp9 = EXP(arg2(:)) + temp1dd = arg2d0(:)*EXP(arg2(:))*arg2d1(:) + temp9*arg2d0d(:) + temp1d = temp9*arg2d0(:) + temp1d0 = EXP(arg2(:))*arg2d1(:) + temp1 = EXP(arg2(:)) + mask23 = tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. INT(& + & t_exp)) + WHERE (mask23) temp2d = 0.0_pr + temp2dd = 0.0_pr + mask24 = .NOT.(tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. & + & INT(t_exp))) + WHERE (mask24) + temp9 = tau**(t_exp-1) + mask25 = tau .LE. 0.0 .AND. (t_exp - 1 .EQ. 0.0 .OR. t_exp - 1 & + & .NE. INT(t_exp - 1)) + WHERE (mask25) + tempd8 = 0.0_pr + ELSEWHERE + tempd8 = (t_exp-1)*tau**(t_exp-2)*taud1 + END WHERE + temp2dd = t_exp*(taud0*tempd8+temp9*taud0d) + temp2d = t_exp*(temp9*taud0) + END WHERE + mask26 = tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. INT(& + & t_exp)) + WHERE (mask26) + temp2d0 = 0.0_pr + ELSEWHERE + temp2d0 = t_exp*tau**(t_exp-1)*taud1 + END WHERE + temp2 = tau**t_exp + mask27 = delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. INT(& + & d_exp)) + WHERE (mask27) temp3d = 0.0_pr + temp3dd = 0.0_pr + mask28 = .NOT.(delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. & + & INT(d_exp))) + WHERE (mask28) + temp9 = delta**(d_exp-1) + mask29 = delta .LE. 0.0 .AND. (d_exp - 1 .EQ. 0.0 .OR. d_exp - 1 & + & .NE. INT(d_exp - 1)) + WHERE (mask29) + tempd8 = 0.0_pr + ELSEWHERE + tempd8 = (d_exp-1)*delta**(d_exp-2)*deltad1 + END WHERE + temp3dd = d_exp*(deltad0*tempd8+temp9*deltad0d) + temp3d = d_exp*(temp9*deltad0) + END WHERE + mask30 = delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. INT(& + & d_exp)) + WHERE (mask30) + temp3d0 = 0.0_pr + ELSEWHERE + temp3d0 = d_exp*delta**(d_exp-1)*deltad1 + END WHERE + temp3 = delta**d_exp + temp4dd = temp3d*temp2d0 + temp2*temp3dd + temp2d*temp3d0 + temp3*& + & temp2dd + temp4d = temp2*temp3d + temp3*temp2d + temp4d0 = temp2*temp3d0 + temp3*temp2d0 + temp4 = temp3*temp2 + mask31 = delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. INT(& + & d_exp)) + WHERE (mask31) tempd1 = 0.0_pr + tempd1d = 0.0_pr + mask32 = .NOT.(delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. & + & INT(d_exp))) + WHERE (mask32) + mask33 = delta .LE. 0.0 .AND. (d_exp - 1 .EQ. 0.0 .OR. d_exp - 1 & + & .NE. INT(d_exp - 1)) + WHERE (mask33) + temp6d = 0.0_pr + ELSEWHERE + temp6d = (d_exp-1)*delta**(d_exp-2)*deltad1 + END WHERE + temp6 = delta**(d_exp-1) + mask34 = delta .LE. 0.0 .AND. (d_exp - 1 .EQ. 0.0 .OR. d_exp - 1 & + & .NE. INT(d_exp - 1)) + WHERE (mask34) tempd5 = 0.0_pr + END WHERE + tempd5d = 0.0_pr + mask35 = .NOT.(delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. & + & INT(d_exp))) + WHERE (mask35) + mask36 = .NOT.(delta .LE. 0.0 .AND. (d_exp - 1 .EQ. 0.0 .OR. d_exp& + & - 1 .NE. INT(d_exp - 1))) + WHERE (mask36) + temp9 = delta**(d_exp-2) + mask37 = delta .LE. 0.0 .AND. (d_exp - 2 .EQ. 0.0 .OR. d_exp - 2& + & .NE. INT(d_exp - 2)) + WHERE (mask37) + tempd8 = 0.0_pr + ELSEWHERE + tempd8 = (d_exp-2)*delta**(d_exp-3)*deltad1 + END WHERE + tempd5d = (d_exp-1)*(deltad0*tempd8+temp9*deltad0d) + tempd5 = (d_exp-1)*(temp9*deltad0) + END WHERE + END WHERE + tempd1dd = 0.0_pr + mask38 = .NOT.(delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. & + & INT(d_exp))) + WHERE (mask38) + tempd1dd = d_exp*(tempd5*deltadd0+deltad*tempd5d+deltadd*temp6d+& + & temp6*deltaddd) + tempd1d = d_exp*(deltad*tempd5+temp6*deltadd) + END WHERE + tempd1d0 = 0.0_pr + mask39 = .NOT.(delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. & + & INT(d_exp))) + WHERE (mask39) + tempd1d0 = d_exp*(deltad*temp6d+temp6*deltadd0) + tempd1 = d_exp*(temp6*deltad) + END WHERE + mask40 = tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. INT(& + & t_exp)) + WHERE (mask40) tempd2 = 0.0_pr + tempd2d = 0.0_pr + mask41 = .NOT.(tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. & + & INT(t_exp))) + WHERE (mask41) + mask42 = tau .LE. 0.0 .AND. (t_exp - 1 .EQ. 0.0 .OR. t_exp - 1 & + & .NE. INT(t_exp - 1)) + WHERE (mask42) + temp6d = 0.0_pr + ELSEWHERE + temp6d = (t_exp-1)*tau**(t_exp-2)*taud1 + END WHERE + temp6 = tau**(t_exp-1) + mask43 = tau .LE. 0.0 .AND. (t_exp - 1 .EQ. 0.0 .OR. t_exp - 1 & + & .NE. INT(t_exp - 1)) + WHERE (mask43) + tempd5d = 0.0_pr + tempd5 = 0.0_pr + ELSEWHERE + temp9 = tau**(t_exp-2) + mask44 = tau .LE. 0.0 .AND. (t_exp - 2 .EQ. 0.0 .OR. t_exp - 2 & + & .NE. INT(t_exp - 2)) + WHERE (mask44) + tempd8 = 0.0_pr + ELSEWHERE + tempd8 = (t_exp-2)*tau**(t_exp-3)*taud1 + END WHERE + tempd5d = (t_exp-1)*(taud0*tempd8+temp9*taud0d) + tempd5 = (t_exp-1)*(temp9*taud0) + END WHERE + END WHERE + tempd2dd = 0.0_pr + mask45 = .NOT.(tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. & + & INT(t_exp))) + WHERE (mask45) + tempd2dd = t_exp*(tempd5*taudd0+taud*tempd5d+taudd*temp6d+temp6*& + & tauddd) + tempd2d = t_exp*(taud*tempd5+temp6*taudd) + END WHERE + tempd2d0 = 0.0_pr + mask46 = .NOT.(tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. & + & INT(t_exp))) + WHERE (mask46) + tempd2d0 = t_exp*(taud*temp6d+temp6*taudd0) + tempd2 = t_exp*(temp6*taud) + END WHERE + temp6d = tempd1*temp2d0 + temp2*tempd1d0 + tempd2*temp3d0 + temp3*& + & tempd2d0 + temp6 = temp2*tempd1 + temp3*tempd2 + temp7d = EXP(arg2(:))*arg2d1(:) + temp7 = EXP(arg2(:)) + temp9 = tempd1*temp2d + temp2*tempd1d + tempd2*temp3d + temp3*& + & tempd2d + temp10 = EXP(arg2(:)) + temp11 = temp4*arg2d(:)*arg2d0(:) + temp12 = arg2d(:)*temp4d + temp4*arg2dd(:) + arg3ddd(:) = n_exp*(temp1d*temp6d+temp6*temp1dd+temp9*temp1d0+temp1*& + & (temp2d*tempd1d0+tempd1*temp2dd+tempd1d*temp2d0+temp2*tempd1dd+& + & temp3d*tempd2d0+tempd2*temp3dd+tempd2d*temp3d0+temp3*tempd2dd)+& + & temp10*(arg2d0(:)*(arg2d(:)*temp4d0+temp4*arg2dd0(:))+temp4*arg2d(& + & :)*arg2d0d(:))+temp11*EXP(arg2(:))*arg2d1(:)+temp12*temp7d+temp7*(& + & temp4d*arg2dd0(:)+arg2d(:)*temp4dd+arg2dd(:)*temp4d0+temp4*arg2ddd& + & (:))) + arg3dd(:) = n_exp*(temp6*temp1d+temp1*temp9+temp11*temp10+temp7*& + & temp12) + arg3dd0(:) = n_exp*(temp6*temp1d0+temp1*temp6d+arg2d(:)*(temp4*& + & temp7d+temp7*temp4d0)+temp7*temp4*arg2dd0(:)) + arg3d(:) = n_exp*(temp1*temp6+temp7*(temp4*arg2d(:))) + arg3d0d(:) = n_exp*(temp4d*temp1d0+temp1*temp4dd+temp1d*temp4d0+& + & temp4*temp1dd) + arg3d0(:) = n_exp*(temp1*temp4d+temp4*temp1d) + arg3d1(:) = n_exp*(temp1*temp4d0+temp4*temp1d0) + arg3(:) = n_exp*(temp4*temp1) + aijddd = SUM(arg1ddd(:)) + SUM(arg3ddd(:)) + aijdd = SUM(arg1dd(:)) + SUM(arg3dd(:)) + aijdd0 = SUM(arg1dd0(:)) + SUM(arg3dd0(:)) + aijd = SUM(arg1d(:)) + SUM(arg3d(:)) + aijd0d = SUM(arg1d0d(:)) + SUM(arg3d0d(:)) + aijd0 = SUM(arg1d0(:)) + SUM(arg3d0(:)) + aijd1 = SUM(arg1d1(:)) + SUM(arg3d1(:)) + aij = SUM(arg1(:)) + SUM(arg3(:)) + end subroutine AR_IJ_D_D_D + +! Differentiation of ar_ij_d in forward (tangent) mode (with options noISIZE): +! variations of useful results: aijd aij +! with respect to varying inputs: taud tau deltad delta +! Differentiation of ar_ij in forward (tangent) mode (with options noISIZE): +! variations of useful results: aij +! with respect to varying inputs: tau delta + SUBROUTINE AR_IJ_D_D(model, delta, deltad0, deltad, deltadd, tau, & + & taud0, taud, taudd, binary, aij, aijd0, aijd, aijdd) + IMPLICIT NONE + class(GERG2008), INTENT(IN) :: model + REAL(pr), INTENT(IN) :: delta + REAL(pr), INTENT(IN) :: deltad0 + REAL(pr), INTENT(IN) :: deltad + REAL(pr), INTENT(IN) :: deltadd + REAL(pr), INTENT(IN) :: tau + REAL(pr), INTENT(IN) :: taud0 + REAL(pr), INTENT(IN) :: taud + REAL(pr), INTENT(IN) :: taudd + class(GERG2008BINARY), INTENT(IN) :: binary + REAL(pr), INTENT(OUT) :: aij + REAL(pr), INTENT(OUT) :: aijd0 + REAL(pr), INTENT(OUT) :: aijd + REAL(pr), INTENT(OUT) :: aijdd + INTEGER :: idx_poly, idx_exp + INTEGER :: k + REAL(pr) :: n_pol(binary%kpolij), d_pol(binary%kpolij), t_pol(binary%& + & kpolij) + REAL(pr) :: n_exp(binary%kexpij), d_exp(binary%kexpij), t_exp(binary%& + & kexpij) + REAL(pr) :: etha(binary%kexpij), eps(binary%kexpij), beta(binary%& + & kexpij), gama(binary%kexpij) + INTRINSIC SUM + INTRINSIC EXP + REAL(pr), DIMENSION(binary%kpolij) :: arg1 + REAL(pr), DIMENSION(binary%kpolij) :: arg1d0 + REAL(pr), DIMENSION(binary%kpolij) :: arg1d + REAL(pr), DIMENSION(binary%kpolij) :: arg1dd + REAL(pr), DIMENSION(binary%kexpij) :: arg2 + REAL(pr), DIMENSION(binary%kexpij) :: arg2d0 + REAL(pr), DIMENSION(binary%kexpij) :: arg2d + REAL(pr), DIMENSION(binary%kexpij) :: arg2dd + REAL(pr), DIMENSION(binary%kexpij) :: arg3 + REAL(pr), DIMENSION(binary%kexpij) :: arg3d0 + REAL(pr), DIMENSION(binary%kexpij) :: arg3d + REAL(pr), DIMENSION(binary%kexpij) :: arg3dd + REAL(pr), DIMENSION(binary%kpolij) :: temp + REAL(pr), DIMENSION(binary%kpolij) :: tempd3 + REAL(pr), DIMENSION(binary%kpolij) :: temp0 + REAL(pr), DIMENSION(binary%kpolij) :: temp0d + REAL(pr), DIMENSION(binary%kpolij) :: tempd + REAL(pr), DIMENSION(binary%kpolij) :: tempdd + REAL(pr), DIMENSION(binary%kpolij) :: tempd0 + REAL(pr), DIMENSION(binary%kpolij) :: tempd0d + REAL(pr), DIMENSION(binary%kexpij) :: temp1 + REAL(pr), DIMENSION(binary%kexpij) :: temp1d + REAL(pr), DIMENSION(binary%kexpij) :: temp2 + REAL(pr), DIMENSION(binary%kexpij) :: temp2d + REAL(pr), DIMENSION(binary%kexpij) :: temp3 + REAL(pr), DIMENSION(binary%kexpij) :: temp3d + REAL(pr), DIMENSION(binary%kexpij) :: tempd1 + REAL(pr), DIMENSION(binary%kexpij) :: tempd1d + REAL(pr), DIMENSION(binary%kexpij) :: tempd2 + REAL(pr), DIMENSION(binary%kexpij) :: tempd2d + REAL(pr), DIMENSION(binary%kexpij) :: temp4 + REAL(pr), DIMENSION(binary%kexpij) :: temp4d + INTRINSIC INT + REAL(pr), DIMENSION(binary%kpolij) :: temp5 + REAL(pr), DIMENSION(binary%kpolij) :: tempd4 + REAL(pr), DIMENSION(binary%kexpij) :: temp6 + REAL(pr), DIMENSION(binary%kexpij) :: tempd5 + REAL(pr), DIMENSION(binary%kexpij) :: temp7 + LOGICAL, DIMENSION(binary%kpolij) :: mask + LOGICAL, DIMENSION(binary%kpolij) :: mask0 + LOGICAL, DIMENSION(binary%kpolij) :: mask1 + LOGICAL, DIMENSION(binary%kpolij) :: mask2 + LOGICAL, DIMENSION(binary%kpolij) :: mask3 + LOGICAL, DIMENSION(binary%kpolij) :: mask4 + LOGICAL, DIMENSION(binary%kpolij) :: mask5 + LOGICAL, DIMENSION(binary%kpolij) :: mask6 + LOGICAL, DIMENSION(binary%kexpij) :: mask7 + LOGICAL, DIMENSION(binary%kexpij) :: mask8 + LOGICAL, DIMENSION(binary%kexpij) :: mask9 + LOGICAL, DIMENSION(binary%kexpij) :: mask10 + LOGICAL, DIMENSION(binary%kexpij) :: mask11 + LOGICAL, DIMENSION(binary%kexpij) :: mask12 + LOGICAL, DIMENSION(binary%kexpij) :: mask13 + LOGICAL, DIMENSION(binary%kexpij) :: mask14 + idx_poly = binary%kpolij + idx_exp = binary%kexpij + idx_poly + n_pol = binary%nij(1:idx_poly) + d_pol = binary%dij(1:idx_poly) + t_pol = binary%tij(1:idx_poly) + n_exp = binary%nij(idx_poly+1:idx_exp) + d_exp = binary%dij(idx_poly+1:idx_exp) + t_exp = binary%tij(idx_poly+1:idx_exp) + etha = binary%ethaij(1:binary%kexpij) + eps = binary%epsij(1:binary%kexpij) + beta = binary%betaij(1:binary%kexpij) + gama = binary%gammaij(1:binary%kexpij) + mask = tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. INT(t_pol)& + & ) + WHERE (mask) + tempd3 = 0.0_pr + ELSEWHERE + tempd3 = t_pol*tau**(t_pol-1)*taud0 + END WHERE + temp = tau**t_pol + mask0 = delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. INT(& + & d_pol)) + WHERE (mask0) + temp0d = 0.0_pr + ELSEWHERE + temp0d = d_pol*delta**(d_pol-1)*deltad0 + END WHERE + temp0 = delta**d_pol + mask1 = delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. INT(& + & d_pol)) + WHERE (mask1) tempd = 0.0_pr + tempdd = 0.0_pr + mask2 = .NOT.(delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. & + & INT(d_pol))) + WHERE (mask2) + temp5 = delta**(d_pol-1) + mask3 = delta .LE. 0.0 .AND. (d_pol - 1 .EQ. 0.0 .OR. d_pol - 1 & + & .NE. INT(d_pol - 1)) + WHERE (mask3) + tempd4 = 0.0_pr + ELSEWHERE + tempd4 = (d_pol-1)*delta**(d_pol-2)*deltad0 + END WHERE + tempdd = d_pol*(deltad*tempd4+temp5*deltadd) + tempd = d_pol*(temp5*deltad) + END WHERE + mask4 = tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. INT(t_pol& + & )) + WHERE (mask4) tempd0 = 0.0_pr + tempd0d = 0.0_pr + mask5 = .NOT.(tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. INT& + & (t_pol))) + WHERE (mask5) + temp5 = tau**(t_pol-1) + mask6 = tau .LE. 0.0 .AND. (t_pol - 1 .EQ. 0.0 .OR. t_pol - 1 .NE.& + & INT(t_pol - 1)) + WHERE (mask6) + tempd4 = 0.0_pr + ELSEWHERE + tempd4 = (t_pol-1)*tau**(t_pol-2)*taud0 + END WHERE + tempd0d = t_pol*(taud*tempd4+temp5*taudd) + tempd0 = t_pol*(temp5*taud) + END WHERE + arg1dd(:) = n_pol*(tempd*tempd3+temp*tempdd+tempd0*temp0d+temp0*& + & tempd0d) + arg1d(:) = n_pol*(temp*tempd+temp0*tempd0) + arg1d0(:) = n_pol*(temp*temp0d+temp0*tempd3) + arg1(:) = n_pol*(temp0*temp) + temp6 = beta + 2*etha*(delta-eps) + arg2dd(:) = -(deltad*etha*2*deltad0+temp6*deltadd) + arg2d(:) = -(temp6*deltad) + arg2d0(:) = -((etha*2*(delta-eps)+beta)*deltad0) + arg2(:) = -(etha*(delta-eps)**2) - beta*(delta-gama) + temp1d = EXP(arg2(:))*arg2d0(:) + temp1 = EXP(arg2(:)) + mask7 = tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. INT(t_exp& + & )) + WHERE (mask7) + temp2d = 0.0_pr + ELSEWHERE + temp2d = t_exp*tau**(t_exp-1)*taud0 + END WHERE + temp2 = tau**t_exp + mask8 = delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. INT(& + & d_exp)) + WHERE (mask8) + temp3d = 0.0_pr + ELSEWHERE + temp3d = d_exp*delta**(d_exp-1)*deltad0 + END WHERE + temp3 = delta**d_exp + temp4d = temp2*temp3d + temp3*temp2d + temp4 = temp3*temp2 + mask9 = delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. INT(& + & d_exp)) + WHERE (mask9) tempd1 = 0.0_pr + tempd1d = 0.0_pr + mask10 = .NOT.(delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. & + & INT(d_exp))) + WHERE (mask10) + temp6 = delta**(d_exp-1) + mask11 = delta .LE. 0.0 .AND. (d_exp - 1 .EQ. 0.0 .OR. d_exp - 1 & + & .NE. INT(d_exp - 1)) + WHERE (mask11) + tempd5 = 0.0_pr + ELSEWHERE + tempd5 = (d_exp-1)*delta**(d_exp-2)*deltad0 + END WHERE + tempd1d = d_exp*(deltad*tempd5+temp6*deltadd) + tempd1 = d_exp*(temp6*deltad) + END WHERE + mask12 = tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. INT(& + & t_exp)) + WHERE (mask12) tempd2 = 0.0_pr + tempd2d = 0.0_pr + mask13 = .NOT.(tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. & + & INT(t_exp))) + WHERE (mask13) + temp6 = tau**(t_exp-1) + mask14 = tau .LE. 0.0 .AND. (t_exp - 1 .EQ. 0.0 .OR. t_exp - 1 & + & .NE. INT(t_exp - 1)) + WHERE (mask14) + tempd5 = 0.0_pr + ELSEWHERE + tempd5 = (t_exp-1)*tau**(t_exp-2)*taud0 + END WHERE + tempd2d = t_exp*(taud*tempd5+temp6*taudd) + tempd2 = t_exp*(temp6*taud) + END WHERE + temp6 = temp2*tempd1 + temp3*tempd2 + temp7 = EXP(arg2(:)) + arg3dd(:) = n_exp*(temp6*temp1d+temp1*(tempd1*temp2d+temp2*tempd1d+& + & tempd2*temp3d+temp3*tempd2d)+temp4*arg2d(:)*EXP(arg2(:))*arg2d0(:)& + & +temp7*(arg2d(:)*temp4d+temp4*arg2dd(:))) + arg3d(:) = n_exp*(temp1*temp6+temp7*(temp4*arg2d(:))) + arg3d0(:) = n_exp*(temp1*temp4d+temp4*temp1d) + arg3(:) = n_exp*(temp4*temp1) + aijdd = SUM(arg1dd(:)) + SUM(arg3dd(:)) + aijd = SUM(arg1d(:)) + SUM(arg3d(:)) + aijd0 = SUM(arg1d0(:)) + SUM(arg3d0(:)) + aij = SUM(arg1(:)) + SUM(arg3(:)) + end subroutine AR_IJ_D_D + +! Differentiation of ar_ij_d in reverse (adjoint) mode (with options noISIZE): +! gradient of useful results: taud tau aijd deltad delta +! aij +! with respect to varying inputs: taud tau deltad delta +! Differentiation of ar_ij in forward (tangent) mode (with options noISIZE): +! variations of useful results: aij +! with respect to varying inputs: tau delta + SUBROUTINE AR_IJ_D_B(model, delta, deltab, deltad, deltadb, tau, taub& + & , taud, taudb, binary, aij, aijb, aijd, aijdb) + IMPLICIT NONE + class(GERG2008), INTENT(IN) :: model + REAL(pr), INTENT(IN) :: delta + REAL(pr) :: deltab + REAL(pr), INTENT(IN) :: deltad + REAL(pr) :: deltadb + REAL(pr), INTENT(IN) :: tau + REAL(pr) :: taub + REAL(pr), INTENT(IN) :: taud + REAL(pr) :: taudb + class(GERG2008BINARY), INTENT(IN) :: binary + REAL(pr) :: aij + REAL(pr) :: aijb + REAL(pr) :: aijd + REAL(pr) :: aijdb + INTEGER :: idx_poly, idx_exp + INTEGER :: k + REAL(pr) :: n_pol(binary%kpolij), d_pol(binary%kpolij), t_pol(binary%& + & kpolij) + REAL(pr) :: n_exp(binary%kexpij), d_exp(binary%kexpij), t_exp(binary%& + & kexpij) + REAL(pr) :: etha(binary%kexpij), eps(binary%kexpij), beta(binary%& + & kexpij), gama(binary%kexpij) + INTRINSIC SUM + INTRINSIC EXP + REAL(pr), DIMENSION(binary%kpolij) :: arg1 + REAL(pr), DIMENSION(binary%kpolij) :: arg1b + REAL(pr), DIMENSION(binary%kpolij) :: arg1d + REAL(pr), DIMENSION(binary%kpolij) :: arg1db + REAL(pr), DIMENSION(binary%kexpij) :: arg2 + REAL(pr), DIMENSION(binary%kexpij) :: arg2b + REAL(pr), DIMENSION(binary%kexpij) :: arg2d + REAL(pr), DIMENSION(binary%kexpij) :: arg2db + REAL(pr), DIMENSION(binary%kexpij) :: arg3 + REAL(pr), DIMENSION(binary%kexpij) :: arg3b + REAL(pr), DIMENSION(binary%kexpij) :: arg3d + REAL(pr), DIMENSION(binary%kexpij) :: arg3db + REAL(pr), DIMENSION(binary%kpolij) :: temp + REAL(pr), DIMENSION(binary%kpolij) :: tempb + REAL(pr), DIMENSION(binary%kpolij) :: temp0 + REAL(pr), DIMENSION(binary%kpolij) :: temp0b + REAL(pr), DIMENSION(binary%kpolij) :: tempd + REAL(pr), DIMENSION(binary%kpolij) :: tempdb + REAL(pr), DIMENSION(binary%kpolij) :: tempd0 + REAL(pr), DIMENSION(binary%kpolij) :: tempd0b + REAL(pr), DIMENSION(binary%kexpij) :: temp1 + REAL(pr), DIMENSION(binary%kexpij) :: temp1b + REAL(pr), DIMENSION(binary%kexpij) :: temp2 + REAL(pr), DIMENSION(binary%kexpij) :: temp2b + REAL(pr), DIMENSION(binary%kexpij) :: temp3 + REAL(pr), DIMENSION(binary%kexpij) :: temp3b + REAL(pr), DIMENSION(binary%kexpij) :: tempd1 + REAL(pr), DIMENSION(binary%kexpij) :: tempd1b + REAL(pr), DIMENSION(binary%kexpij) :: tempd2 + REAL(pr), DIMENSION(binary%kexpij) :: tempd2b + REAL(pr), DIMENSION(binary%kexpij) :: temp4 + REAL(pr), DIMENSION(binary%kexpij) :: temp4b + INTRINSIC INT + LOGICAL, DIMENSION(binary%kpolij) :: mask + LOGICAL, DIMENSION(binary%kpolij) :: mask0 + LOGICAL, DIMENSION(binary%kexpij) :: mask1 + LOGICAL, DIMENSION(binary%kexpij) :: mask2 + REAL(pr), DIMENSION(binary%kpolij) :: tempb0 + REAL(pr), DIMENSION(binary%kexpij) :: tempb1 + REAL(pr), DIMENSION(binary%kexpij) :: tempb2 + REAL(pr), DIMENSION(binary%kexpij) :: tempb3 + LOGICAL, DIMENSION(binary%kexpij) :: arg10 + REAL(pr) :: result1 + LOGICAL, DIMENSION(binary%kexpij) :: arg20 + REAL(pr) :: result2 + LOGICAL, DIMENSION(binary%kpolij) :: arg30 + REAL(pr) :: result3 + REAL(pr) :: result4 + LOGICAL, DIMENSION(binary%kpolij) :: arg4 + REAL(pr) :: result5 + LOGICAL, DIMENSION(binary%kpolij) :: arg21 + idx_poly = binary%kpolij + idx_exp = binary%kexpij + idx_poly + n_pol = binary%nij(1:idx_poly) + d_pol = binary%dij(1:idx_poly) + t_pol = binary%tij(1:idx_poly) + n_exp = binary%nij(idx_poly+1:idx_exp) + d_exp = binary%dij(idx_poly+1:idx_exp) + t_exp = binary%tij(idx_poly+1:idx_exp) + etha = binary%ethaij(1:binary%kexpij) + eps = binary%epsij(1:binary%kexpij) + beta = binary%betaij(1:binary%kexpij) + gama = binary%gammaij(1:binary%kexpij) + temp = tau**t_pol + temp0 = delta**d_pol + mask = delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. INT(& + & d_pol)) + WHERE (mask) + tempd = 0.0_pr + ELSEWHERE + tempd = d_pol*delta**(d_pol-1)*deltad + END WHERE + mask0 = tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. INT(t_pol& + & )) + WHERE (mask0) + tempd0 = 0.0_pr + ELSEWHERE + tempd0 = t_pol*tau**(t_pol-1)*taud + END WHERE + arg1d(:) = n_pol*(temp*tempd+temp0*tempd0) + arg1(:) = n_pol*(temp0*temp) + arg2d(:) = -((etha*2*(delta-eps)+beta)*deltad) + arg2(:) = -(etha*(delta-eps)**2) - beta*(delta-gama) + temp1 = EXP(arg2(:)) + temp2 = tau**t_exp + temp3 = delta**d_exp + temp4 = temp3*temp2 + mask1 = delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. INT(& + & d_exp)) + WHERE (mask1) + tempd1 = 0.0_pr + ELSEWHERE + tempd1 = d_exp*delta**(d_exp-1)*deltad + END WHERE + mask2 = tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. INT(t_exp& + & )) + WHERE (mask2) + tempd2 = 0.0_pr + ELSEWHERE + tempd2 = t_exp*tau**(t_exp-1)*taud + END WHERE + arg3d(:) = n_exp*(temp1*(temp2*tempd1+temp3*tempd2)+temp4*EXP(arg2(:& + & ))*arg2d(:)) + arg3(:) = n_exp*(temp4*temp1) + arg1b = 0.0_pr + arg3b = 0.0_pr + arg1b = aijb + arg3b = aijb + arg1db = 0.0_pr + arg3db = 0.0_pr + arg1db = aijdb + arg3db = aijdb + temp4b = 0.0_pr + temp1b = 0.0_pr + arg2b = 0.0_pr + tempd1b = 0.0_pr + tempd2b = 0.0_pr + arg2db = 0.0_pr + temp2b = 0.0_pr + temp3b = 0.0_pr + tempb1 = n_exp*arg3db + temp1b = temp4*n_exp*arg3b + (temp2*tempd1+temp3*tempd2)*tempb1 + tempb2 = temp1*tempb1 + arg2b = EXP(arg2)*temp4*arg2d*tempb1 + EXP(arg2)*temp1b + tempb3 = EXP(arg2)*tempb1 + temp4b = temp1*n_exp*arg3b + arg2d*tempb3 + arg2db = temp4*tempb3 + temp2b = tempd1*tempb2 + temp3*temp4b + tempd1b = temp2*tempb2 + temp3b = tempd2*tempb2 + temp2*temp4b + tempd2b = temp3*tempb2 + tempb = 0.0_pr + temp0b = 0.0_pr + tempd0b = 0.0_pr + tempdb = 0.0_pr + tempb0 = n_pol*arg1db + temp0b = temp*n_pol*arg1b + tempd0*tempb0 + tempb = temp0*n_pol*arg1b + tempd*tempb0 + tempdb = temp*tempb0 + arg10(:) = .NOT.mask1 .AND. (.NOT.(delta .LE. 0.0 .AND. (d_exp - 1 & + & .EQ. 0.0 .OR. d_exp - 1 .NE. INT(d_exp - 1)))) + result1 = SUM((d_exp-1)*delta**(d_exp-2)*d_exp*tempd1b, mask=arg10(:& + & )) + arg20(:) = .NOT.(delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp & + & .NE. INT(d_exp))) + result2 = SUM(d_exp*delta**(d_exp-1)*temp3b, mask=arg20(:)) + arg30(:) = .NOT.mask .AND. (.NOT.(delta .LE. 0.0 .AND. (d_pol - 1 & + & .EQ. 0.0 .OR. d_pol - 1 .NE. INT(d_pol - 1)))) + result3 = SUM((d_pol-1)*delta**(d_pol-2)*d_pol*tempdb, mask=arg30(:)& + & ) + result4 = SUM((delta-eps)*etha*arg2b) + arg4(:) = .NOT.(delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE.& + & INT(d_pol))) + result5 = SUM(d_pol*delta**(d_pol-1)*temp0b, mask=arg4(:)) + deltab = deltab + result1*deltad + result2 + result3*deltad - 2*& + & result4 - SUM(beta*arg2b) - SUM(etha*arg2db)*2*deltad + result5 + arg10(:) = .NOT.mask1 + result1 = SUM(delta**(d_exp-1)*d_exp*tempd1b, mask=arg10(:)) + arg21(:) = .NOT.mask + result2 = SUM(delta**(d_pol-1)*d_pol*tempdb, mask=arg21(:)) + result3 = SUM((beta+etha*2*(delta-eps))*arg2db) + deltadb = deltadb + result1 + result2 - result3 + tempd0b = temp0*tempb0 + arg10(:) = .NOT.mask2 .AND. (.NOT.(tau .LE. 0.0 .AND. (t_exp - 1 & + & .EQ. 0.0 .OR. t_exp - 1 .NE. INT(t_exp - 1)))) + result1 = SUM((t_exp-1)*tau**(t_exp-2)*t_exp*tempd2b, mask=arg10(:)) + arg20(:) = .NOT.(tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. & + & INT(t_exp))) + result2 = SUM(t_exp*tau**(t_exp-1)*temp2b, mask=arg20(:)) + arg30(:) = .NOT.mask0 .AND. (.NOT.(tau .LE. 0.0 .AND. (t_pol - 1 & + & .EQ. 0.0 .OR. t_pol - 1 .NE. INT(t_pol - 1)))) + result3 = SUM((t_pol-1)*tau**(t_pol-2)*t_pol*tempd0b, mask=arg30(:)) + arg4(:) = .NOT.(tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. & + & INT(t_pol))) + result4 = SUM(t_pol*tau**(t_pol-1)*tempb, mask=arg4(:)) + taub = taub + result1*taud + result2 + result3*taud + result4 + arg10(:) = .NOT.mask2 + result1 = SUM(tau**(t_exp-1)*t_exp*tempd2b, mask=arg10(:)) + arg21(:) = .NOT.mask0 + result2 = SUM(tau**(t_pol-1)*t_pol*tempd0b, mask=arg21(:)) + taudb = taudb + result1 + result2 + end subroutine AR_IJ_D_B + +! Differentiation of ar_ij in forward (tangent) mode (with options noISIZE): +! variations of useful results: aij +! with respect to varying inputs: tau delta + SUBROUTINE AR_IJ_D(model, delta, deltad, tau, taud, binary, aij, aijd) + IMPLICIT NONE + class(GERG2008), INTENT(IN) :: model + REAL(pr), INTENT(IN) :: delta + REAL(pr), INTENT(IN) :: deltad + REAL(pr), INTENT(IN) :: tau + REAL(pr), INTENT(IN) :: taud + class(GERG2008BINARY), INTENT(IN) :: binary + REAL(pr), INTENT(OUT) :: aij + REAL(pr), INTENT(OUT) :: aijd + INTEGER :: idx_poly, idx_exp + INTEGER :: k + REAL(pr) :: n_pol(binary%kpolij), d_pol(binary%kpolij), t_pol(binary%& + & kpolij) + REAL(pr) :: n_exp(binary%kexpij), d_exp(binary%kexpij), t_exp(binary%& + & kexpij) + REAL(pr) :: etha(binary%kexpij), eps(binary%kexpij), beta(binary%& + & kexpij), gama(binary%kexpij) + INTRINSIC SUM + INTRINSIC EXP + REAL(pr), DIMENSION(binary%kpolij) :: arg1 + REAL(pr), DIMENSION(binary%kpolij) :: arg1d + REAL(pr), DIMENSION(binary%kexpij) :: arg2 + REAL(pr), DIMENSION(binary%kexpij) :: arg2d + REAL(pr), DIMENSION(binary%kexpij) :: arg3 + REAL(pr), DIMENSION(binary%kexpij) :: arg3d + REAL(pr), DIMENSION(binary%kpolij) :: temp + REAL(pr), DIMENSION(binary%kpolij) :: temp0 + REAL(pr), DIMENSION(binary%kpolij) :: tempd + REAL(pr), DIMENSION(binary%kpolij) :: tempd0 + REAL(pr), DIMENSION(binary%kexpij) :: temp1 + REAL(pr), DIMENSION(binary%kexpij) :: temp2 + REAL(pr), DIMENSION(binary%kexpij) :: temp3 + REAL(pr), DIMENSION(binary%kexpij) :: tempd1 + REAL(pr), DIMENSION(binary%kexpij) :: tempd2 + REAL(pr), DIMENSION(binary%kexpij) :: temp4 + INTRINSIC INT + LOGICAL, DIMENSION(binary%kpolij) :: mask + LOGICAL, DIMENSION(binary%kpolij) :: mask0 + LOGICAL, DIMENSION(binary%kexpij) :: mask1 + LOGICAL, DIMENSION(binary%kexpij) :: mask2 + idx_poly = binary%kpolij + idx_exp = binary%kexpij + idx_poly + n_pol = binary%nij(1:idx_poly) + d_pol = binary%dij(1:idx_poly) + t_pol = binary%tij(1:idx_poly) + n_exp = binary%nij(idx_poly+1:idx_exp) + d_exp = binary%dij(idx_poly+1:idx_exp) + t_exp = binary%tij(idx_poly+1:idx_exp) + etha = binary%ethaij(1:binary%kexpij) + eps = binary%epsij(1:binary%kexpij) + beta = binary%betaij(1:binary%kexpij) + gama = binary%gammaij(1:binary%kexpij) + temp = tau**t_pol + temp0 = delta**d_pol + mask = delta .LE. 0.0 .AND. (d_pol .EQ. 0.0 .OR. d_pol .NE. INT(& + & d_pol)) + WHERE (mask) + tempd = 0.0_pr + ELSEWHERE + tempd = d_pol*delta**(d_pol-1)*deltad + END WHERE + mask0 = tau .LE. 0.0 .AND. (t_pol .EQ. 0.0 .OR. t_pol .NE. INT(t_pol& + & )) + WHERE (mask0) + tempd0 = 0.0_pr + ELSEWHERE + tempd0 = t_pol*tau**(t_pol-1)*taud + END WHERE + arg1d(:) = n_pol*(temp*tempd+temp0*tempd0) + arg1(:) = n_pol*(temp0*temp) + arg2d(:) = -((etha*2*(delta-eps)+beta)*deltad) + arg2(:) = -(etha*(delta-eps)**2) - beta*(delta-gama) + temp1 = EXP(arg2(:)) + temp2 = tau**t_exp + temp3 = delta**d_exp + temp4 = temp3*temp2 + mask1 = delta .LE. 0.0 .AND. (d_exp .EQ. 0.0 .OR. d_exp .NE. INT(& + & d_exp)) + WHERE (mask1) + tempd1 = 0.0_pr + ELSEWHERE + tempd1 = d_exp*delta**(d_exp-1)*deltad + END WHERE + mask2 = tau .LE. 0.0 .AND. (t_exp .EQ. 0.0 .OR. t_exp .NE. INT(t_exp& + & )) + WHERE (mask2) + tempd2 = 0.0_pr + ELSEWHERE + tempd2 = t_exp*tau**(t_exp-1)*taud + END WHERE + arg3d(:) = n_exp*(temp1*(temp2*tempd1+temp3*tempd2)+temp4*EXP(arg2(:& + & ))*arg2d(:)) + arg3(:) = n_exp*(temp4*temp1) + aijd = SUM(arg1d(:)) + SUM(arg3d(:)) + aij = SUM(arg1(:)) + SUM(arg3(:)) + end subroutine AR_IJ_D + +! Differentiation of ar_ij in reverse (adjoint) mode (with options noISIZE): +! gradient of useful results: tau delta aij +! with respect to varying inputs: tau delta + SUBROUTINE AR_IJ_B(model, delta, deltab, tau, taub, binary, aij, aijb) + IMPLICIT NONE + class(GERG2008), INTENT(IN) :: model + REAL(pr), INTENT(IN) :: delta + REAL(pr) :: deltab + REAL(pr), INTENT(IN) :: tau + REAL(pr) :: taub + class(GERG2008BINARY), INTENT(IN) :: binary + REAL(pr) :: aij + REAL(pr) :: aijb + INTEGER :: idx_poly, idx_exp + INTEGER :: k + REAL(pr) :: n_pol(binary%kpolij), d_pol(binary%kpolij), t_pol(binary%& + & kpolij) + REAL(pr) :: n_exp(binary%kexpij), d_exp(binary%kexpij), t_exp(binary%& + & kexpij) + REAL(pr) :: etha(binary%kexpij), eps(binary%kexpij), beta(binary%& + & kexpij), gama(binary%kexpij) + INTRINSIC SUM + INTRINSIC EXP + REAL(pr), DIMENSION(binary%kpolij) :: arg1 + REAL(pr), DIMENSION(binary%kpolij) :: arg1b + REAL(pr), DIMENSION(binary%kexpij) :: arg2 + REAL(pr), DIMENSION(binary%kexpij) :: arg2b + REAL(pr), DIMENSION(binary%kexpij) :: arg3 + REAL(pr), DIMENSION(binary%kexpij) :: arg3b + REAL(pr), DIMENSION(binary%kexpij) :: tempb + REAL(pr), DIMENSION(binary%kexpij) :: temp + REAL(pr), DIMENSION(binary%kexpij) :: temp0 + idx_poly = binary%kpolij + idx_exp = binary%kexpij + idx_poly + n_pol = binary%nij(1:idx_poly) + d_pol = binary%dij(1:idx_poly) + t_pol = binary%tij(1:idx_poly) + n_exp = binary%nij(idx_poly+1:idx_exp) + d_exp = binary%dij(idx_poly+1:idx_exp) + t_exp = binary%tij(idx_poly+1:idx_exp) + etha = binary%ethaij(1:binary%kexpij) + eps = binary%epsij(1:binary%kexpij) + beta = binary%betaij(1:binary%kexpij) + gama = binary%gammaij(1:binary%kexpij) + arg1(:) = n_pol*delta**d_pol*tau**t_pol + arg2(:) = -(etha*(delta-eps)**2) - beta*(delta-gama) + arg3(:) = n_exp*delta**d_exp*tau**t_exp*EXP(arg2(:)) + arg1b = 0.0_pr + arg3b = 0.0_pr + arg1b = aijb + arg3b = aijb + arg2b = 0.0_pr + temp = tau**t_exp + temp0 = delta**d_exp + tempb = EXP(arg2)*n_exp*arg3b + arg2b = EXP(arg2)*temp0*temp*n_exp*arg3b + deltab = deltab + SUM(d_exp*delta**(d_exp-1)*temp*tempb, MASK=.NOT.(& + & delta.LE.0.0.AND.(d_exp.EQ.0.0.OR.d_exp.NE.INT(d_exp)))) + SUM(& + & d_pol*delta**(d_pol-1)*tau**t_pol*n_pol*arg1b, MASK=.NOT.(delta& + & .LE.0.0.AND.(d_pol.EQ.0.0.OR.d_pol.NE.INT(d_pol)))) - 2*SUM((delta& + & -eps)*etha*arg2b) - SUM(beta*arg2b) + taub = taub + SUM(t_exp*tau**(t_exp-1)*temp0*tempb, MASK=.NOT.(tau& + & .LE.0.0.AND.(t_exp.EQ.0.0.OR.t_exp.NE.INT(t_exp)))) + SUM(t_pol*& + & tau**(t_pol-1)*delta**d_pol*n_pol*arg1b, MASK=.NOT.(tau.LE.0.0& + & .AND.(t_pol.EQ.0.0.OR.t_pol.NE.INT(t_pol)))) + end subroutine AR_IJ_B + + SUBROUTINE AR_IJ(model, delta, tau, binary, aij) + IMPLICIT NONE + class(GERG2008), INTENT(IN) :: model + REAL(pr), INTENT(IN) :: delta + REAL(pr), INTENT(IN) :: tau + class(GERG2008BINARY), INTENT(IN) :: binary + REAL(pr), INTENT(OUT) :: aij + INTEGER :: idx_poly, idx_exp + INTEGER :: k + REAL(pr) :: n_pol(binary%kpolij), d_pol(binary%kpolij), t_pol(binary%& + & kpolij) + REAL(pr) :: n_exp(binary%kexpij), d_exp(binary%kexpij), t_exp(binary%& + & kexpij) + REAL(pr) :: etha(binary%kexpij), eps(binary%kexpij), beta(binary%& + & kexpij), gama(binary%kexpij) + INTRINSIC SUM + INTRINSIC EXP + REAL(pr), DIMENSION(binary%kpolij) :: arg1 + REAL(pr), DIMENSION(binary%kexpij) :: arg2 + REAL(pr), DIMENSION(binary%kexpij) :: arg3 + idx_poly = binary%kpolij + idx_exp = binary%kexpij + idx_poly + n_pol = binary%nij(1:idx_poly) + d_pol = binary%dij(1:idx_poly) + t_pol = binary%tij(1:idx_poly) + n_exp = binary%nij(idx_poly+1:idx_exp) + d_exp = binary%dij(idx_poly+1:idx_exp) + t_exp = binary%tij(idx_poly+1:idx_exp) + etha = binary%ethaij(1:binary%kexpij) + eps = binary%epsij(1:binary%kexpij) + beta = binary%betaij(1:binary%kexpij) + gama = binary%gammaij(1:binary%kexpij) + arg1(:) = n_pol*delta**d_pol*tau**t_pol + arg2(:) = -(etha*(delta-eps)**2) - beta*(delta-gama) + arg3(:) = n_exp*delta**d_exp*tau**t_exp*EXP(arg2(:)) + aij = SUM(arg1(:)) + SUM(arg3(:)) + end subroutine AR_IJ + +! Differentiation of ar_d_d in forward (tangent) mode (with options noISIZE): +! variations of useful results: arval arvaldd arvald arvald0 +! with respect to varying inputs: t v +! RW status of diff variables: t:in v:in arval:out arvaldd:out +! arvald:out arvald0:out +! Differentiation of ar_d in forward (tangent) mode (with options noISIZE): +! variations of useful results: arval arvald +! with respect to varying inputs: t v +! RW status of diff variables: t:in v:in arval:out arvald:out +! Differentiation of ar in forward (tangent) mode (with options noISIZE): +! variations of useful results: arval +! with respect to varying inputs: n t v +! RW status of diff variables: n:in t:in v:in arval:out + SUBROUTINE AR_D_D_D(model, n, nd, v, vd1, vd0, vd, t, td1, td0, td, & + & arval, arvald1, arvald0, arvald0d, arvald, arvaldd0, arvaldd, & + & arvalddd) + IMPLICIT NONE + class(GERG2008), INTENT(IN) :: model + REAL(pr), INTENT(IN) :: n(:), v, t + REAL(pr), INTENT(IN) :: vd1, td1 + REAL(pr), INTENT(IN) :: vd0, td0 + REAL(pr), INTENT(IN) :: nd(:), vd, td + REAL(pr), INTENT(OUT) :: arval + REAL(pr), INTENT(OUT) :: arvald1 + REAL(pr), INTENT(OUT) :: arvald0 + REAL(pr), INTENT(OUT) :: arvald0d + REAL(pr), INTENT(OUT) :: arvald + REAL(pr), INTENT(OUT) :: arvaldd0 + REAL(pr), INTENT(OUT) :: arvaldd + REAL(pr), INTENT(OUT) :: arvalddd + REAL(pr) :: vr, tr, x(SIZE(n)), rho_c(SIZE(n)), rho_r + REAL(pr) :: vrd, trd, xd(SIZE(n)), rho_rd + REAL(pr) :: delta, tau + REAL(pr) :: deltad1, taud1 + REAL(pr) :: deltad0, taud0 + REAL(pr) :: deltad0d, taud0d + REAL(pr) :: deltad, taud + REAL(pr) :: deltadd0, taudd0 + REAL(pr) :: deltadd, taudd + REAL(pr) :: deltaddd, tauddd + TYPE(GERG2008PURE) :: pures(SIZE(n)) + TYPE(GERG2008BINARY) :: binary + REAL(pr) :: fij(SIZE(n), SIZE(n)), aij + REAL(pr) :: aijd1 + REAL(pr) :: aijd0 + REAL(pr) :: aijd0d + REAL(pr) :: aijd + REAL(pr) :: aijdd0 + REAL(pr) :: aijdd + REAL(pr) :: aijddd + REAL(pr) :: ar_pures(SIZE(n)) + REAL(pr) :: ar_puresd1(SIZE(n)) + REAL(pr) :: ar_puresd0(SIZE(n)) + REAL(pr) :: ar_puresd0d(SIZE(n)) + REAL(pr) :: ar_puresd(SIZE(n)) + REAL(pr) :: ar_puresdd0(SIZE(n)) + REAL(pr) :: ar_puresdd(SIZE(n)) + REAL(pr) :: ar_puresddd(SIZE(n)) + INTEGER :: i, j, k, nc + INTRINSIC SUM + REAL(pr) :: temp + REAL(pr) :: tempd0 + REAL(pr) :: tempd + REAL(pr) :: tempdd + INTRINSIC SIZE + REAL(pr) :: temp0 + REAL(pr) :: temp0d + REAL(pr) :: temp1 + REAL(pr) :: temp1d + REAL(pr) :: temp2 + REAL(pr) :: temp3 + fij = model%binaries%fij + pures = model%pures + nc = SIZE(n) + temp = SUM(n) + xd = (nd-n*SUM(nd)/temp)/temp + x = n/temp + CALL REDUCING_FUNCTIONS_D(model, n, nd, vr, vrd, tr, trd) + rho_rd = -(vrd/vr**2) + rho_r = 1/vr + temp2 = 1.0/(rho_r*v) + temp0d = -(temp2*vd1/v) + temp0 = temp2 + tempdd = -(vd0*(temp0d-temp0*vd1/v)/v) + tempd = -(temp0*vd0/v) + tempd0 = temp0d + temp = temp0 + temp2 = temp/(rho_r*v) + temp0d = (tempd0-temp2*rho_r*vd1)/(rho_r*v) + temp0 = temp2 + temp1d = rho_rd*vd1 + temp1 = rho_r*vd + rho_rd*v + temp2 = temp1/(rho_r*v) + temp3 = tempd - rho_r*vd0*temp0 + deltaddd = -(rho_rd*vd0*temp0d) - temp2*(tempdd-rho_r*vd0*temp0d) - & + & temp3*(temp1d-temp2*rho_r*vd1)/(rho_r*v) + deltadd = -(rho_rd*vd0*temp0) - temp3*temp2 + deltadd0 = -(temp0*temp1d+temp1*temp0d) + deltad = -(temp1*temp0) + deltad0d = tempdd + deltad0 = tempd + deltad1 = tempd0 + delta = temp + temp3 = tr*td/t + temp1d = -(temp3*td1/t) + temp1 = temp3 + temp3 = (trd-temp1)/t + temp0d = (-temp1d-temp3*td1)/t + temp0 = temp3 + temp3 = (temp1/t-temp0)/t + tauddd = td0*((temp1d-temp1*td1/t)/t-temp0d-temp3*td1)/t + taudd = td0*temp3 + taudd0 = temp0d + taud = temp0 + temp3 = tr*td0/(t*t) + taud0d = temp3*2*td1/t + taud0 = -temp3 + taud1 = -(tr*td1/t**2) + tau = tr/t + ar_puresd = 0.0_pr + ar_puresd0 = 0.0_pr + ar_puresdd = 0.0_pr + ar_puresd1 = 0.0_pr + ar_puresddd = 0.0_pr + ar_puresdd0 = 0.0_pr + ar_puresd0d = 0.0_pr + DO i=1,nc + CALL AR_PURE_D_D_D(pures(i), delta, deltad1, deltad0, deltad0d, & + & deltad, deltadd0, deltadd, deltaddd, tau, taud1, & + & taud0, taud0d, taud, taudd0, taudd, tauddd, ar_pures(& + & i), ar_puresd1(i), ar_puresd0(i), ar_puresd0d(i), & + & ar_puresd(i), ar_puresdd0(i), ar_puresdd(i), & + & ar_puresddd(i)) + END DO + arvalddd = SUM(xd*ar_puresd0d + x*ar_puresddd) + arvaldd = SUM(xd*ar_puresd0 + x*ar_puresdd) + arvaldd0 = SUM(xd*ar_puresd1 + x*ar_puresdd0) + arvald = SUM(ar_pures*xd + x*ar_puresd) + arvald0d = SUM(x*ar_puresd0d) + arvald0 = SUM(x*ar_puresd0) + arvald1 = SUM(x*ar_puresd1) + arval = SUM(x*ar_pures) + DO i=1,nc + DO j=i+1,nc + binary = model%binaries(i, j) + CALL AR_IJ_D_D_D(model, delta, deltad1, deltad0, deltad0d, & + & deltad, deltadd0, deltadd, deltaddd, tau, taud1, & + & taud0, taud0d, taud, taudd0, taudd, tauddd, binary, & + & aij, aijd1, aijd0, aijd0d, aijd, aijdd0, aijdd, & + & aijddd) + arvalddd = arvalddd + fij(i, j)*(x(j)*(xd(i)*aijd0d+x(i)*aijddd)& + & +x(i)*xd(j)*aijd0d) + arvaldd = arvaldd + fij(i, j)*(x(j)*(xd(i)*aijd0+x(i)*aijdd)+xd(& + & j)*x(i)*aijd0) + arvaldd0 = arvaldd0 + fij(i, j)*(x(j)*(xd(i)*aijd1+x(i)*aijdd0)+& + & xd(j)*x(i)*aijd1) + arvald = arvald + fij(i, j)*(x(j)*(aij*xd(i)+x(i)*aijd)+x(i)*aij& + & *xd(j)) + temp1 = x(j)*fij(i, j) + arvald0d = arvald0d + x(i)*temp1*aijd0d + arvald0 = arvald0 + temp1*x(i)*aijd0 + arvald1 = arvald1 + x(i)*temp1*aijd1 + arval = arval + x(i)*aij*temp1 + END DO + END DO + temp = SUM(n) + temp1 = SUM(nd) + arvalddd = ryaeos*(temp1*(arvald0*td1+t*arvald0d+td0*arvald1)+temp*(& + & td0*arvaldd0+arvaldd*td1+t*arvalddd+td*arvald0d)) + arvaldd = ryaeos*(temp1*(t*arvald0+arval*td0)+temp*(arvald*td0+t*& + & arvaldd+td*arvald0)) + arvaldd0 = ryaeos*(temp1*(t*arvald1+arval*td1)+temp*(arvald*td1+t*& + & arvaldd0+td*arvald1)) + arvald = ryaeos*(temp1*(arval*t)+temp*(t*arvald+td*arval)) + arvald0d = ryaeos*temp*(arvald0*td1+t*arvald0d+td0*arvald1) + arvald0 = ryaeos*temp*(t*arvald0+arval*td0) + arvald1 = ryaeos*temp*(t*arvald1+arval*td1) + arval = ryaeos*(temp*(arval*t)) + end subroutine AR_D_D_D + +! Differentiation of ar_d in forward (tangent) mode (with options noISIZE): +! variations of useful results: arval arvald +! with respect to varying inputs: t v +! RW status of diff variables: t:in v:in arval:out arvald:out +! Differentiation of ar in forward (tangent) mode (with options noISIZE): +! variations of useful results: arval +! with respect to varying inputs: n t v +! RW status of diff variables: n:in t:in v:in arval:out + SUBROUTINE AR_D_D(model, n, nd, v, vd0, vd, t, td0, td, arval, arvald0& + & , arvald, arvaldd) + IMPLICIT NONE + class(GERG2008), INTENT(IN) :: model + REAL(pr), INTENT(IN) :: n(:), v, t + REAL(pr), INTENT(IN) :: vd0, td0 + REAL(pr), INTENT(IN) :: nd(:), vd, td + REAL(pr), INTENT(OUT) :: arval + REAL(pr), INTENT(OUT) :: arvald0 + REAL(pr), INTENT(OUT) :: arvald + REAL(pr), INTENT(OUT) :: arvaldd + REAL(pr) :: vr, tr, x(SIZE(n)), rho_c(SIZE(n)), rho_r + REAL(pr) :: vrd, trd, xd(SIZE(n)), rho_rd + REAL(pr) :: delta, tau + REAL(pr) :: deltad0, taud0 + REAL(pr) :: deltad, taud + REAL(pr) :: deltadd, taudd + TYPE(GERG2008PURE) :: pures(SIZE(n)) + TYPE(GERG2008BINARY) :: binary + REAL(pr) :: fij(SIZE(n), SIZE(n)), aij + REAL(pr) :: aijd0 + REAL(pr) :: aijd + REAL(pr) :: aijdd + REAL(pr) :: ar_pures(SIZE(n)) + REAL(pr) :: ar_puresd0(SIZE(n)) + REAL(pr) :: ar_puresd(SIZE(n)) + REAL(pr) :: ar_puresdd(SIZE(n)) + INTEGER :: i, j, k, nc + INTRINSIC SUM + REAL(pr) :: temp + REAL(pr) :: tempd + INTRINSIC SIZE + REAL(pr) :: temp0 + REAL(pr) :: temp1 + fij = model%binaries%fij + pures = model%pures + nc = SIZE(n) + temp = SUM(n) + xd = (nd-n*SUM(nd)/temp)/temp + x = n/temp + CALL REDUCING_FUNCTIONS_D(model, n, nd, vr, vrd, tr, trd) + rho_rd = -(vrd/vr**2) + rho_r = 1/vr + temp0 = 1.0/(rho_r*v) + tempd = -(temp0*vd0/v) + temp = temp0 + temp0 = temp/(rho_r*v) + temp1 = rho_r*vd + rho_rd*v + deltadd = -(temp0*rho_rd*vd0+temp1*(tempd-temp0*rho_r*vd0)/(rho_r*v)& + & ) + deltad = -(temp1*temp0) + deltad0 = tempd + delta = temp + temp1 = tr*td/t + temp0 = (trd-temp1)/t + taudd = (temp1/t-temp0)*td0/t + taud = temp0 + taud0 = -(tr*td0/t**2) + tau = tr/t + ar_puresd = 0.0_pr + ar_puresd0 = 0.0_pr + ar_puresdd = 0.0_pr + DO i=1,nc + CALL AR_PURE_D_D(pures(i), delta, deltad0, deltad, deltadd, tau, & + & taud0, taud, taudd, ar_pures(i), ar_puresd0(i), & + & ar_puresd(i), ar_puresdd(i)) + END DO + arvaldd = SUM(xd*ar_puresd0 + x*ar_puresdd) + arvald = SUM(ar_pures*xd + x*ar_puresd) + arvald0 = SUM(x*ar_puresd0) + arval = SUM(x*ar_pures) + DO i=1,nc + DO j=i+1,nc + binary = model%binaries(i, j) + CALL AR_IJ_D_D(model, delta, deltad0, deltad, deltadd, tau, & + & taud0, taud, taudd, binary, aij, aijd0, aijd, aijdd) + arvaldd = arvaldd + fij(i, j)*(x(j)*(xd(i)*aijd0+x(i)*aijdd)+xd(& + & j)*x(i)*aijd0) + arvald = arvald + fij(i, j)*(x(j)*(aij*xd(i)+x(i)*aijd)+x(i)*aij& + & *xd(j)) + temp1 = x(j)*fij(i, j) + arvald0 = arvald0 + temp1*x(i)*aijd0 + arval = arval + x(i)*aij*temp1 + END DO + END DO + temp = SUM(n) + temp1 = SUM(nd) + arvaldd = ryaeos*(temp1*(t*arvald0+arval*td0)+temp*(arvald*td0+t*& + & arvaldd+td*arvald0)) + arvald = ryaeos*(temp1*(arval*t)+temp*(t*arvald+td*arval)) + arvald0 = ryaeos*temp*(t*arvald0+arval*td0) + arval = ryaeos*(temp*(arval*t)) + end subroutine AR_D_D + +! Differentiation of ar_d in reverse (adjoint) mode (with options noISIZE): +! gradient of useful results: nd n t v arval arvald vd td +! with respect to varying inputs: nd n t v arval arvald vd td +! RW status of diff variables: nd:incr n:incr t:incr v:incr arval:in-zero +! arvald:in-zero vd:incr td:incr +! Differentiation of ar in forward (tangent) mode (with options noISIZE): +! variations of useful results: arval +! with respect to varying inputs: n t v +! RW status of diff variables: n:in t:in v:in arval:out + SUBROUTINE AR_D_B(model, n, nb, nd, ndb, v, vb, vd, vdb, t, tb, td, & + & tdb, arval, arvalb, arvald, arvaldb) + USE ISO_C_BINDING + USE ADMM_TAPENADE_INTERFACE + IMPLICIT NONE + class(GERG2008), INTENT(IN) :: model + REAL(pr), INTENT(IN) :: n(:), v, t + REAL(pr) :: nb(:), vb, tb + REAL(pr), INTENT(IN) :: nd(:), vd, td + REAL(pr) :: ndb(:), vdb, tdb + REAL(pr) :: arval + REAL(pr) :: arvalb + REAL(pr) :: arvald + REAL(pr) :: arvaldb + REAL(pr) :: vr, tr, x(SIZE(n)), rho_c(SIZE(n)), rho_r + REAL(pr) :: vrb, trb, xb(SIZE(n)), rho_rb + REAL(pr) :: vrd, trd, xd(SIZE(n)), rho_rd + REAL(pr) :: vrdb, trdb, xdb(SIZE(n)), rho_rdb + REAL(pr) :: delta, tau + REAL(pr) :: deltab, taub + REAL(pr) :: deltad, taud + REAL(pr) :: deltadb, taudb + TYPE(GERG2008PURE) :: pures(SIZE(n)) + TYPE(GERG2008BINARY) :: binary + REAL(pr) :: fij(SIZE(n), SIZE(n)), aij + REAL(pr) :: aijb + REAL(pr) :: aijd + REAL(pr) :: aijdb + REAL(pr) :: ar_pures(SIZE(n)) + REAL(pr) :: ar_puresb(SIZE(n)) + REAL(pr) :: ar_puresd(SIZE(n)) + REAL(pr) :: ar_puresdb(SIZE(n)) + INTEGER :: i, j, k, nc + INTRINSIC SUM + REAL(pr) :: temp + REAL(pr) :: tempb + INTRINSIC SIZE + REAL(pr), DIMENSION(SIZE(n, 1)) :: tempb0 + REAL(pr), DIMENSION(SIZE(n, 1)) :: temp0 + REAL(pr) :: temp1 + REAL(pr), DIMENSION(SIZE(n, 1)) :: tempb1 + REAL(pr) :: tempb2 + REAL(pr) :: temp2 + REAL(pr) :: tempb3 + REAL(pr) :: tempb4 + INTEGER :: ad_from + REAL(pr) :: result1 + fij = model%binaries%fij + pures = model%pures + nc = SIZE(n) + temp = SUM(n) + xd = (nd-n*SUM(nd)/temp)/temp + x = n/temp + CALL REDUCING_FUNCTIONS_D(model, n, nd, vr, vrd, tr, trd) + rho_rd = -(vrd/vr**2) + rho_r = 1/vr + CALL PUSHREAL8(temp) + temp = 1.0/(v*rho_r) + deltad = -(temp*(rho_r*vd+v*rho_rd)/(v*rho_r)) + delta = temp + taud = (trd-tr*td/t)/t + tau = tr/t + ar_puresd = 0.0_pr + DO i=1,nc + CALL AR_PURE_D(pures(i), delta, deltad, tau, taud, ar_pures(i), & + & ar_puresd(i)) + END DO + arvald = SUM(ar_pures*xd + x*ar_puresd) + arval = SUM(x*ar_pures) + DO i=1,nc + ad_from = i + 1 + DO j=ad_from,nc + CALL PUSHREAL8(binary%bv) + CALL PUSHREAL8(binary%gv) + CALL PUSHREAL8(binary%bt) + CALL PUSHREAL8(binary%gt) + CALL PUSHINTEGER4(binary%kpolij) + CALL PUSHINTEGER4(binary%kexpij) + CALL PUSHREAL8(binary%fij) + binary = model%binaries(i, j) + CALL PUSHREAL8(aijd) + CALL PUSHREAL8(aij) + CALL AR_IJ_D(model, delta, deltad, tau, taud, binary, aij, aijd) + arvald = arvald + fij(i, j)*(x(j)*(aij*xd(i)+x(i)*aijd)+x(i)*aij& + & *xd(j)) + arval = arval + x(i)*x(j)*fij(i, j)*aij + END DO + CALL PUSHINTEGER4(ad_from) + END DO + temp = SUM(n) + tempb4 = ryaeos*arvalb + arvalb = temp*t*tempb4 + tempb = arval*t*tempb4 + tb = tb + temp*arval*tempb4 + tempb4 = ryaeos*arvaldb + tempb3 = SUM(nd)*tempb4 + ndb = ndb + arval*t*tempb4 + tempb = tempb + (t*arvald+arval*td)*tempb4 + tempb2 = temp*tempb4 + arvaldb = t*tempb2 + tb = tb + arvald*tempb2 + arval*tempb3 + arvalb = arvalb + td*tempb2 + t*tempb3 + tdb = tdb + arval*tempb2 + nb = nb + tempb + temp = 1.0/(v*rho_r) + taudb = 0.0_pr + taub = 0.0_pr + xdb = 0.0_pr + xb = 0.0_pr + deltadb = 0.0_pr + deltab = 0.0_pr + DO i=nc,1,-1 + CALL POPINTEGER4(ad_from) + DO j=nc,ad_from,-1 + tempb4 = fij(i, j)*arvalb + xb(i) = xb(i) + aij*x(j)*tempb4 + aijb = x(i)*x(j)*tempb4 + xb(j) = xb(j) + x(i)*aij*tempb4 + tempb4 = fij(i, j)*arvaldb + xb(j) = xb(j) + (aij*xd(i)+x(i)*aijd)*tempb4 + tempb3 = x(j)*tempb4 + xb(i) = xb(i) + aij*xd(j)*tempb4 + aijd*tempb3 + aijb = aijb + x(i)*xd(j)*tempb4 + xd(i)*tempb3 + xdb(j) = xdb(j) + x(i)*aij*tempb4 + xdb(i) = xdb(i) + aij*tempb3 + aijdb = x(i)*tempb3 + CALL POPREAL8(aij) + CALL POPREAL8(aijd) + CALL AR_IJ_D_B(model, delta, deltab, deltad, deltadb, tau, taub& + & , taud, taudb, binary, aij, aijb, aijd, aijdb) + CALL POPREAL8(binary%fij) + CALL POPINTEGER4(binary%kexpij) + CALL POPINTEGER4(binary%kpolij) + CALL POPREAL8(binary%gt) + CALL POPREAL8(binary%bt) + CALL POPREAL8(binary%gv) + CALL POPREAL8(binary%bv) + END DO + END DO + ar_puresb = 0.0_pr + xb = xb + ar_pures*arvalb + ar_puresd*arvaldb + ar_puresb = x*arvalb + xd*arvaldb + ar_puresdb = 0.0_pr + xdb = xdb + ar_pures*arvaldb + ar_puresdb = x*arvaldb + DO i=nc,1,-1 + CALL AR_PURE_D_B(pures(i), delta, deltab, deltad, deltadb, tau, & + & taub, taud, taudb, ar_pures(i), ar_puresb(i), ar_puresd& + & (i), ar_puresdb(i)) + ar_puresb(i) = 0.0_pr + ar_puresdb(i) = 0.0_pr + END DO + tempb2 = -((rho_r*vd+v*rho_rd)*deltadb/(v*rho_r)) + tempb4 = taudb/t + tempb3 = -(tempb4/t) + temp2 = tr*td/t + trb = taub/t + td*tempb3 + tb = tb - tr*taub/t**2 - (trd-temp2)*tempb4/t - temp2*tempb3 + trdb = tempb4 + tdb = tdb + tr*tempb3 + tempb = deltab + tempb2 + temp1 = temp/(v*rho_r) + tempb3 = -(temp1*deltadb) + tempb4 = -(temp1*tempb2) + vdb = vdb + rho_r*tempb3 + rho_rdb = v*tempb3 + CALL POPREAL8(temp) + tempb2 = -(tempb/(v**2*rho_r**2)) + vb = vb + rho_r*tempb4 + rho_rd*tempb3 + rho_r*tempb2 + rho_rb = v*tempb4 + vd*tempb3 + v*tempb2 + tempb2 = -(rho_rdb/vr**2) + vrb = -(rho_rb/vr**2) - 2*vrd*tempb2/vr + vrdb = tempb2 + CALL REDUCING_FUNCTIONS_D_B(model, n, nb, nd, ndb, vr, vrb, vrd, & + & vrdb, tr, trb, trd, trdb) + temp0 = n/temp + temp1 = SUM(nd) + tempb0 = xdb/temp + ndb = ndb + tempb0 - SUM(temp0*tempb0) + tempb1 = -(temp1*tempb0/temp) + result1 = SUM((nd-temp1*temp0)*tempb0) + tempb = -(SUM(n*xb)/temp**2) - result1/temp - SUM(temp0*tempb1) + nb = nb + xb/temp + tempb1 + tempb + arvalb = 0.0_pr + arvaldb = 0.0_pr + end subroutine AR_D_B + +! Differentiation of ar in forward (tangent) mode (with options noISIZE): +! variations of useful results: arval +! with respect to varying inputs: n t v +! RW status of diff variables: n:in t:in v:in arval:out + SUBROUTINE AR_D(model, n, nd, v, vd, t, td, arval, arvald) + IMPLICIT NONE + class(GERG2008), INTENT(IN) :: model + REAL(pr), INTENT(IN) :: n(:), v, t + REAL(pr), INTENT(IN) :: nd(:), vd, td + REAL(pr), INTENT(OUT) :: arval + REAL(pr), INTENT(OUT) :: arvald + REAL(pr) :: vr, tr, x(SIZE(n)), rho_c(SIZE(n)), rho_r + REAL(pr) :: vrd, trd, xd(SIZE(n)), rho_rd + REAL(pr) :: delta, tau + REAL(pr) :: deltad, taud + TYPE(GERG2008PURE) :: pures(SIZE(n)) + TYPE(GERG2008BINARY) :: binary + REAL(pr) :: fij(SIZE(n), SIZE(n)), aij + REAL(pr) :: aijd + REAL(pr) :: ar_pures(SIZE(n)) + REAL(pr) :: ar_puresd(SIZE(n)) + INTEGER :: i, j, k, nc + INTRINSIC SUM + REAL(pr) :: temp + INTRINSIC SIZE + fij = model%binaries%fij + pures = model%pures + nc = SIZE(n) + temp = SUM(n) + xd = (nd-n*SUM(nd)/temp)/temp + x = n/temp + CALL REDUCING_FUNCTIONS_D(model, n, nd, vr, vrd, tr, trd) + rho_rd = -(vrd/vr**2) + rho_r = 1/vr + temp = 1.0/(v*rho_r) + deltad = -(temp*(rho_r*vd+v*rho_rd)/(v*rho_r)) + delta = temp + taud = (trd-tr*td/t)/t + tau = tr/t + ar_puresd = 0.0_pr + DO i=1,nc + CALL AR_PURE_D(pures(i), delta, deltad, tau, taud, ar_pures(i), & + & ar_puresd(i)) + END DO + arvald = SUM(ar_pures*xd + x*ar_puresd) + arval = SUM(x*ar_pures) + DO i=1,nc + DO j=i+1,nc + binary = model%binaries(i, j) + CALL AR_IJ_D(model, delta, deltad, tau, taud, binary, aij, aijd) + arvald = arvald + fij(i, j)*(x(j)*(aij*xd(i)+x(i)*aijd)+x(i)*aij& + & *xd(j)) + arval = arval + x(i)*x(j)*fij(i, j)*aij + END DO + END DO + temp = SUM(n) + arvald = ryaeos*(arval*t*SUM(nd)+temp*(t*arvald+arval*td)) + arval = ryaeos*(temp*(arval*t)) + end subroutine AR_D + +! Differentiation of ar in reverse (adjoint) mode (with options noISIZE): +! gradient of useful results: arval +! with respect to varying inputs: n t v arval +! RW status of diff variables: n:out t:out v:out arval:in-zero + SUBROUTINE AR_B(model, n, nb, v, vb, t, tb, arval, arvalb) + USE ISO_C_BINDING + USE ADMM_TAPENADE_INTERFACE + IMPLICIT NONE + class(GERG2008), INTENT(IN) :: model + REAL(pr), INTENT(IN) :: n(:), v, t + REAL(pr) :: nb(:), vb, tb + REAL(pr) :: arval + REAL(pr) :: arvalb + REAL(pr) :: vr, tr, x(SIZE(n)), rho_c(SIZE(n)), rho_r + REAL(pr) :: vrb, trb, xb(SIZE(n)), rho_rb + REAL(pr) :: delta, tau + REAL(pr) :: deltab, taub + TYPE(GERG2008PURE) :: pures(SIZE(n)) + TYPE(GERG2008BINARY) :: binary + REAL(pr) :: fij(SIZE(n), SIZE(n)), aij + REAL(pr) :: aijb + REAL(pr) :: ar_pures(SIZE(n)) + REAL(pr) :: ar_puresb(SIZE(n)) + INTEGER :: i, j, k, nc + INTRINSIC SUM + INTRINSIC SIZE + REAL(pr) :: temp + REAL(pr) :: tempb + INTEGER :: ad_from + fij = model%binaries%fij + pures = model%pures + nc = SIZE(n) + x = n/SUM(n) + CALL REDUCING_FUNCTIONS(model, n, vr, tr) + rho_r = 1/vr + delta = 1/v/rho_r + tau = tr/t + DO i=1,nc + CALL AR_PURE(pures(i), delta, tau, ar_pures(i)) + END DO + arval = SUM(x*ar_pures) + DO i=1,nc + ad_from = i + 1 + DO j=ad_from,nc + CALL PUSHREAL8(binary%bv) + CALL PUSHREAL8(binary%gv) + CALL PUSHREAL8(binary%bt) + CALL PUSHREAL8(binary%gt) + CALL PUSHINTEGER4(binary%kpolij) + CALL PUSHINTEGER4(binary%kexpij) + CALL PUSHREAL8(binary%fij) + binary = model%binaries(i, j) + CALL PUSHREAL8(aij) + CALL AR_IJ(model, delta, tau, binary, aij) + arval = arval + x(i)*x(j)*fij(i, j)*aij + END DO + CALL PUSHINTEGER4(ad_from) + END DO + nb = 0.0_pr + nb = arval*t*ryaeos*arvalb + tempb = SUM(n)*ryaeos*arvalb + arvalb = t*tempb + tb = arval*tempb + taub = 0.0_pr + xb = 0.0_pr + deltab = 0.0_pr + DO i=nc,1,-1 + CALL POPINTEGER4(ad_from) + DO j=nc,ad_from,-1 + tempb = fij(i, j)*arvalb + xb(i) = xb(i) + aij*x(j)*tempb + aijb = x(i)*x(j)*tempb + xb(j) = xb(j) + x(i)*aij*tempb + CALL POPREAL8(aij) + CALL AR_IJ_B(model, delta, deltab, tau, taub, binary, aij, aijb) + CALL POPREAL8(binary%fij) + CALL POPINTEGER4(binary%kexpij) + CALL POPINTEGER4(binary%kpolij) + CALL POPREAL8(binary%gt) + CALL POPREAL8(binary%bt) + CALL POPREAL8(binary%gv) + CALL POPREAL8(binary%bv) + END DO + END DO + ar_puresb = 0.0_pr + xb = xb + ar_pures*arvalb + ar_puresb = x*arvalb + DO i=nc,1,-1 + CALL AR_PURE_B(pures(i), delta, deltab, tau, taub, ar_pures(i), & + & ar_puresb(i)) + ar_puresb(i) = 0.0_pr + END DO + trb = taub/t + tb = tb - tr*taub/t**2 + tempb = -(deltab/(v**2*rho_r**2)) + vb = rho_r*tempb + rho_rb = v*tempb + vrb = -(rho_rb/vr**2) + CALL REDUCING_FUNCTIONS_B(model, n, nb, vr, vrb, tr, trb) + temp = SUM(n) + nb = nb + xb/temp - SUM(n*xb)/temp**2 + arvalb = 0.0_pr + end subroutine AR_B + + SUBROUTINE AR(model, n, v, t, arval) + IMPLICIT NONE + class(GERG2008), INTENT(IN) :: model + REAL(pr), INTENT(IN) :: n(:), v, t + REAL(pr), INTENT(OUT) :: arval + REAL(pr) :: vr, tr, x(SIZE(n)), rho_c(SIZE(n)), rho_r + REAL(pr) :: delta, tau + TYPE(GERG2008PURE) :: pures(SIZE(n)) + TYPE(GERG2008BINARY) :: binary + REAL(pr) :: fij(SIZE(n), SIZE(n)), aij + REAL(pr) :: ar_pures(SIZE(n)) + INTEGER :: i, j, k, nc + INTRINSIC SUM + INTRINSIC SIZE + fij = model%binaries%fij + pures = model%pures + nc = SIZE(n) + x = n/SUM(n) + CALL REDUCING_FUNCTIONS(model, n, vr, tr) + rho_r = 1/vr + delta = 1/v/rho_r + tau = tr/t + DO i=1,nc + CALL AR_PURE(pures(i), delta, tau, ar_pures(i)) + END DO + arval = SUM(x*ar_pures) + DO i=1,nc + DO j=i+1,nc + binary = model%binaries(i, j) + CALL AR_IJ(model, delta, tau, binary, aij) + arval = arval + x(i)*x(j)*fij(i, j)*aij + END DO + END DO + arval = arval*(SUM(n)*ryaeos*t) + end subroutine AR + + FUNCTION VOLUME_INITALIZER(self, n, p, t) RESULT (v0) + IMPLICIT NONE + class(GERG2008), INTENT(IN) :: self + REAL(pr), INTENT(IN) :: n(:) + REAL(pr), INTENT(IN) :: p + REAL(pr), INTENT(IN) :: t + REAL(pr) :: v0 + + call self%srk%volume(n, P, T, V0, root_type="liquid") + end function VOLUME_INITALIZER + +end module YAEOS__MODELS_AR_GERG2008 + diff --git a/src/models/substance.f90 b/src/models/substance.f90 index cd0991fcb..db2fae3c5 100644 --- a/src/models/substance.f90 +++ b/src/models/substance.f90 @@ -7,6 +7,7 @@ module yaeos__substance type :: Substances !! Set of pure components character(len=50), allocatable :: names(:) !! Composition names. + real(pr), allocatable :: vc(:) !! Critical Volume [L/mol] real(pr), allocatable :: tc(:) !! Critical Temperature [K] real(pr), allocatable :: pc(:) !! Critical Pressure [bar] real(pr), allocatable :: w(:) !! Acentric factor diff --git a/test/fixtures/taperobinson.f90 b/test/fixtures/taperobinson.f90 index 936b3ec35..3f83282a3 100644 --- a/test/fixtures/taperobinson.f90 +++ b/test/fixtures/taperobinson.f90 @@ -30,7 +30,7 @@ MODULE autodiff_tapenade_pr76 procedure :: ar_b procedure :: ar_d_b procedure :: ar_d_d - procedure :: v0 => VOLUME_INITALIZER + procedure :: get_v0 => VOLUME_INITALIZER end type TPR76 CONTAINS @@ -1352,15 +1352,15 @@ SUBROUTINE AR(model, n, v, t, arval) & arg11))*(r*t) end subroutine AR - PURE FUNCTION VOLUME_INITALIZER(model, n, p, t) RESULT (v0) + PURE FUNCTION VOLUME_INITALIZER(self, n, p, t) RESULT (v0) IMPLICIT NONE - class(TPR76), INTENT(IN) :: model + class(TPR76), INTENT(IN) :: self REAL(pr), INTENT(IN) :: n(:) REAL(pr), INTENT(IN) :: p REAL(pr), INTENT(IN) :: t REAL(pr) :: v0 INTRINSIC SUM - v0 = SUM(n*model%b)/SUM(model%b) + v0 = SUM(n*self%b)/SUM(self%b) end function VOLUME_INITALIZER end module autodiff_tapenade_pr76 diff --git a/test/test_tapenade.f90 b/test/test_tapenade.f90 new file mode 100644 index 000000000..dd7d1668d --- /dev/null +++ b/test/test_tapenade.f90 @@ -0,0 +1,1821 @@ +Module parameters + integer :: max_residual_terms = 24, generalized_departure(8, 2) + integer, parameter :: N = 21 + real(8), dimension(21, 21, 4) :: red_params + real(8), dimension(21, 21) :: Bv=0, Gv=0, Bt=0, Gt=0 + real(8), dimension(21, 24) :: noik=0, toik=0 + integer, dimension(21, 24) :: doik=0, coik=0 + integer, dimension(21) :: Kpol=0, Kexp=0 + real(8), dimension(21, 21) :: Fij=0 + real(8), dimension(21, 21, 12) :: tij=0, nij=0, ethaij=0, epsij=0, betaij=0, gammaij=0 + integer, dimension(21, 21, 12) :: dij=0 + integer, dimension(21, 21) :: Kpolij=0, Kexpij=0 + real(8), dimension(21) :: T_c=0, rho_c=0, M=0, P_c=0, acentric_factor=0 + integer :: tmp1(3)=0, tmp2(14)=0 ! This variables are used to define indexes for repeated terms + real(8), dimension(21, 7) :: n0i=0, th0i=0 + real(8) :: R=0, eps = 1d-10 + +contains + + Subroutine get_params() + integer :: i, j, k + R = 8.314472d0 + + P_c(1) = 46.0 * 1d5 + P_c(2) = 33.9 * 1d5 + P_c(3) = 73.8 * 1d5 + P_c(4) = 48.8 * 1d5 + P_c(5) = 42.5 * 1d5 + P_c(6) = 38.0 * 1d5 + P_c(7) = 36.5 * 1d5 + P_c(8) = 33.7 * 1d5 + P_c(9) = 33.9 * 1d5 + P_c(10) = 30.1 * 1d5 + P_c(11) = 27.4 * 1d5 + P_c(12) = 24.9 * 1d5 + P_c(13) = 2281000.0d0 + P_c(14) = 2103000.0d0 + P_c(15) = 1296400.0d0 + P_c(16) = 5043000.0d0 + P_c(17) = 3494000.0d0 + P_c(18) = 22064000.0d0 + P_c(19) = 9000000.0d0 + P_c(20) = 227600.0d0 + P_c(21) = 4863000.0d0 + + acentric_factor(1) = 0.011 + acentric_factor(2) = 0.039 + acentric_factor(3) = 0.239 + acentric_factor(4) = 0.099 + acentric_factor(5) = 0.153 + acentric_factor(6) = 0.199 + acentric_factor(7) = 0.183 + acentric_factor(8) = 0.251 + acentric_factor(9) = 0.227 + acentric_factor(10) = 0.299 + acentric_factor(11) = 0.349 + acentric_factor(12) = 0.398 + acentric_factor(13) = 0.4433 + acentric_factor(14) = 0.4884 + acentric_factor(15) = - 0.219 + acentric_factor(16) = 0.0222 + acentric_factor(17) = 0.0497 + acentric_factor(18) = 0.3442920843 + acentric_factor(19) = 0.1005 + acentric_factor(20) = - 0.3836 + acentric_factor(21) = - 0.00219 + + T_c(1) = 190.564d0 + T_c(2) = 126.192d0 + T_c(3) = 304.1282d0 + T_c(4) = 305.322d0 + T_c(5) = 369.825d0 + T_c(6) = 425.125d0 + T_c(7) = 407.817d0 + T_c(8) = 469.7d0 + T_c(9) = 460.35d0 + T_c(10) = 507.82d0 + T_c(11) = 540.13d0 + T_c(12) = 569.32d0 + T_c(13) = 594.55d0 + T_c(14) = 617.7d0 + T_c(15) = 33.19d0 + T_c(16) = 154.595d0 + T_c(17) = 132.86d0 + T_c(18) = 647.096d0 + T_c(19) = 373.1d0 + T_c(20) = 5.1953d0 + T_c(21) = 150.687d0 + + rho_c(1) = 10.139342719d0 + rho_c(2) = 11.1839d0 + rho_c(3) = 10.624978698d0 + rho_c(4) = 6.870854540d0 + rho_c(5) = 5.000043088d0 + rho_c(6) = 3.920016792d0 + rho_c(7) = 3.860142940d0 + rho_c(8) = 3.215577588d0 + rho_c(9) = 3.271d0 + rho_c(10) = 2.705877875d0 + rho_c(11) = 2.315324434d0 + rho_c(12) = 2.056404127d0 + rho_c(13) = 1.81d0 + rho_c(14) = 1.64d0 + rho_c(15) = 14.94d0 + rho_c(16) = 13.63d0 + rho_c(17) = 10.85d0 + rho_c(18) = 17.873716090d0 + rho_c(19) = 10.19d0 + rho_c(20) = 17.399d0 + rho_c(21) = 13.407429659d0 + + M(1) = 16.04246d0 + M(2) = 28.0134d0 + M(3) = 44.0095d0 + M(4) = 30.06904d0 + M(5) = 44.09562d0 + M(6) = 58.1222d0 + M(7) = 58.1222d0 + M(8) = 72.14878d0 + M(9) = 72.14878d0 + M(10) = 86.17536d0 + M(11) = 100.20194d0 + M(12) = 114.22852d0 + M(13) = 128.2551d0 + M(14) = 142.28168d0 + M(15) = 2.01588d0 + M(16) = 31.9988d0 + M(17) = 28.0101d0 + M(18) = 18.01528d0 + M(19) = 34.08088d0 + M(20) = 4.002602d0 + M(21) = 39.948d0 + + Fij(1, 2) = 1.0d0 + Fij(1, 3) = 1.0d0 + Fij(1, 4) = 1.0d0 + Fij(1, 5) = 1.0d0 + Fij(1, 6) = 1.0d0 + Fij(1, 7) = 0.771035405688d0 + Fij(1, 15) = 1.0d0 + Fij(2, 3) = 1.0d0 + Fij(2, 4) = 1.0d0 + Fij(4, 5) = 0.130424765150d0 + Fij(4, 6) = 0.281570073085d0 + Fij(4, 7) = 0.260632376098d0 + Fij(5, 6) = 0.312572600489d-1 + Fij(5, 7) = - 0.551609771024d-1 + Fij(6, 7) = - 0.551240293009d-1 + + Fij(2, 1) = 1.0d0 + Fij(3, 1) = 1.0d0 + Fij(3, 2) = 1.0d0 + Fij(4, 1) = 1.0d0 + Fij(4, 2) = 1.0d0 + Fij(5, 1) = 1.0d0 + Fij(5, 4) = 0.130424765150d0 + Fij(6, 1) = 1.0d0 + Fij(6, 4) = 0.281570073085d0 + Fij(6, 5) = 0.312572600489d-1 + Fij(7, 1) = 0.771035405688d0 + Fij(7, 4) = 0.260632376098d0 + Fij(7, 5) = - 0.551609771024d-1 + Fij(7, 6) = - 0.551240293009d-1 + Fij(15, 1) = 1.0d0 + + red_params(1, 2, :) = (/ 0.998721377d0, 1.013950311d0, 0.998098830d0, 0.979273013d0 /) + red_params(1, 3, :) = (/ 0.999518072d0, 1.002806594d0, 1.022624490d0, 0.975665369d0 /) + red_params(1, 4, :) = (/ 0.997547866d0, 1.006617867d0, 0.996336508d0, 1.049707697d0 /) + red_params(1, 5, :) = (/ 1.004827070d0, 1.038470657d0, 0.989680305d0, 1.098655531d0 /) + red_params(1, 6, :) = (/ 0.979105972d0, 1.045375122d0, 0.994174910d0, 1.171607691d0 /) + red_params(1, 7, :) = (/ 1.011240388d0, 1.054319053d0, 0.980315756d0, 1.161117729d0 /) + red_params(1, 8, :) = (/ 0.948330120d0, 1.124508039d0, 0.992127525d0, 1.249173968d0 /) + red_params(1, 9, :) = (/ 1.0d0, 1.343685343d0, 1.0d0, 1.188899743d0 /) + red_params(1, 10, :) = (/ 0.958015294d0, 1.052643846d0, 0.981844797d0, 1.330570181d0 /) + red_params(1, 11, :) = (/ 0.962050831d0, 1.156655935d0, 0.977431529d0, 1.379850328d0 /) + red_params(1, 12, :) = (/ 0.994740603d0, 1.116549372d0, 0.957473785d0, 1.449245409d0 /) + red_params(1, 13, :) = (/ 1.002852287d0, 1.141895355d0, 0.947716769d0, 1.528532478d0 /) + red_params(1, 14, :) = (/ 1.033086292d0, 1.146089637d0, 0.937777823d0, 1.568231489d0 /) + red_params(1, 15, :) = (/ 1.0d0, 1.018702573d0, 1.0d0, 1.352643115d0 /) + red_params(1, 16, :) = (/ 1.0d0, 1.0d0, 1.0d0, 0.950000000d0 /) + red_params(1, 17, :) = (/ 0.997340772d0, 1.006102927d0, 0.987411732d0, 0.987473033d0 /) + red_params(1, 18, :) = (/ 1.012783169d0, 1.585018334d0, 1.063333913d0, 0.775810513d0 /) + red_params(1, 19, :) = (/ 1.012599087d0, 1.040161207d0, 1.011090031d0, 0.961155729d0 /) + red_params(1, 20, :) = (/ 1.0d0, 0.881405683d0, 1.0d0, 3.159776855d0 /) + red_params(1, 21, :) = (/ 1.034630259d0, 1.014678542d0, 0.990954281d0, 0.989843388d0 /) + red_params(2, 3, :) = (/ 0.977794634d0, 1.047578256d0, 1.005894529d0, 1.107654104d0 /) + red_params(2, 4, :) = (/ 0.978880168d0, 1.042352891d0, 1.007671428d0, 1.098650964d0 /) + red_params(2, 5, :) = (/ 0.974424681d0, 1.081025408d0, 1.002677329d0, 1.201264026d0 /) + red_params(2, 6, :) = (/ 0.996082610d0, 1.146949309d0, 0.994515234d0, 1.304886838d0 /) + red_params(2, 7, :) = (/ 0.986415830d0, 1.100576129d0, 0.992868130d0, 1.284462634d0 /) + red_params(2, 8, :) = (/ 1.0d0, 1.078877166d0, 1.0d0, 1.419029041d0 /) + red_params(2, 9, :) = (/ 1.0d0, 1.154135439d0, 1.0d0, 1.381770770d0 /) + red_params(2, 10, :) = (/ 1.0d0, 1.195952177d0, 1.0d0, 1.472607971d0 /) + red_params(2, 11, :) = (/ 1.0d0, 1.404554090d0, 1.0d0, 1.520975334d0 /) + red_params(2, 12, :) = (/ 1.0d0, 1.186067025d0, 1.0d0, 1.733280051d0 /) + red_params(2, 13, :) = (/ 1.0d0, 1.100405929d0, 0.956379450d0, 1.749119996d0 /) + red_params(2, 14, :) = (/ 1.0d0, 1.0d0, 0.957934447d0, 1.822157123d0 /) + red_params(2, 15, :) = (/ 0.972532065d0, 0.970115357d0, 0.946134337d0, 1.175696583d0 /) + red_params(2, 17, :) = (/ 1.0d0, 1.008690943d0, 1.0d0, 0.993425388d0 /) + red_params(2, 18, :) = (/ 1.0d0, 1.094749685d0, 1.0d0, 0.968808467d0 /) + red_params(2, 16, :) = (/ 0.999521770d0, 0.997082328d0, 0.997190589d0, 0.995157044d0 /) + red_params(2, 19, :) = (/ 0.910394249d0, 1.256844157d0, 1.004692366d0, 0.960174200d0 /) + red_params(2, 20, :) = (/ 0.969501055d0, 0.932629867d0, 0.692868765d0, 1.471831580d0 /) + red_params(2, 21, :) = (/ 1.004166412d0, 1.002212182d0, 0.999069843d0, 0.990034831d0 /) + red_params(3, 4, :) = (/ 1.002525718d0, 1.032876701d0, 1.013871147d0, 0.900949530d0 /) + red_params(3, 5, :) = (/ 0.996898004d0, 1.047596298d0, 1.033620538d0, 0.908772477d0 /) + red_params(3, 6, :) = (/ 1.174760923d0, 1.222437324d0, 1.018171004d0, 0.911498231d0 /) + red_params(3, 7, :) = (/ 1.076551882d0, 1.081909003d0, 1.023339824d0, 0.929982936d0 /) + red_params(3, 8, :) = (/ 1.024311498d0, 1.068406078d0, 1.027000795d0, 0.979217302d0 /) + red_params(3, 9, :) = (/ 1.060793104d0, 1.116793198d0, 1.019180957d0, 0.961218039d0 /) + red_params(3, 10, :) = (/ 1.0d0, 0.851343711d0, 1.0d0, 1.038675574d0 /) + red_params(3, 11, :) = (/ 1.205469976d0, 1.164585914d0, 1.011806317d0, 1.046169823d0 /) + red_params(3, 12, :) = (/ 1.026169373d0, 1.104043935d0, 1.029690780d0, 1.074455386d0 /) + red_params(3, 13, :) = (/ 1.0d0, 0.973386152d0, 1.007688620d0, 1.140671202d0 /) + red_params(3, 14, :) = (/ 1.000151132d0, 1.183394668d0, 1.020028790d0, 1.145512213d0 /) + red_params(3, 15, :) = (/ 0.904142159d0, 1.152792550d0, 0.942320195d0, 1.782924792d0 /) + red_params(3, 16, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(3, 17, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(3, 18, :) = (/ 0.949055959d0, 1.542328793d0, 0.997372205d0, 0.775453996d0 /) + red_params(3, 19, :) = (/ 0.906630564d0, 1.024085837d0, 1.016034583d0, 0.926018880d0 /) + red_params(3, 20, :) = (/ 0.846647561d0, 0.864141549d0, 0.768377630d0, 3.207456948d0 /) + red_params(3, 21, :) = (/ 1.008392428d0, 1.029205465d0, 0.996512863d0, 1.050971635d0 /) + red_params(4, 5, :) = (/ 0.997607277d0, 1.003034720d0, 0.996199694d0, 1.014730190d0 /) + red_params(4, 6, :) = (/ 0.999157205d0, 1.006179146d0, 0.999130554d0, 1.034832749d0 /) + red_params(4, 7, :) = (/ 1.0d0, 1.006616886d0, 1.0d0, 1.033283811d0 /) + red_params(4, 8, :) = (/ 0.993851009d0, 1.026085655d0, 0.998688946d0, 1.066665676d0 /) + red_params(4, 9, :) = (/ 1.0d0, 1.045439935d0, 1.0d0, 1.021150247d0 /) + red_params(4, 10, :) = (/ 1.0d0, 1.169701102d0, 1.0d0, 1.092177796d0 /) + red_params(4, 11, :) = (/ 1.0d0, 1.057666085d0, 1.0d0, 1.134532014d0 /) + red_params(4, 12, :) = (/ 1.007469726d0, 1.071917985d0, 0.984068272d0, 1.168636194d0 /) + red_params(4, 13, :) = (/ 1.0d0, 1.143534730d0, 1.0d0, 1.056033030d0 /) + red_params(4, 14, :) = (/ 0.995676258d0, 1.098361281d0, 0.970918061d0, 1.237191558d0 /) + red_params(4, 15, :) = (/ 0.925367171d0, 1.106072040d0, 0.932969831d0, 1.902008495d0 /) + red_params(4, 16, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(4, 17, :) = (/ 1.0d0, 1.201417898d0, 1.0d0, 1.069224728d0 /) + red_params(4, 18, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(4, 19, :) = (/ 1.010817909d0, 1.030988277d0, 0.990197354d0, 0.902736660d0 /) + red_params(4, 20, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(4, 21, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(5, 6, :) = (/ 0.999795868d0, 1.003264179d0, 1.000310289d0, 1.007392782d0 /) + red_params(5, 7, :) = (/ 0.999243146d0, 1.001156119d0, 0.998012298d0, 1.005250774d0 /) + red_params(5, 8, :) = (/ 1.044919431d0, 1.019921513d0, 0.996484021d0, 1.008344412d0 /) + red_params(5, 9, :) = (/ 1.040459289d0, 0.999432118d0, 0.994364425d0, 1.003269500d0 /) + red_params(5, 10, :) = (/ 1.0d0, 1.057872566d0, 1.0d0, 1.025657518d0 /) + red_params(5, 11, :) = (/ 1.0d0, 1.079648053d0, 1.0d0, 1.050044169d0 /) + red_params(5, 12, :) = (/ 1.0d0, 1.102764612d0, 1.0d0, 1.063694129d0 /) + red_params(5, 13, :) = (/ 1.0d0, 1.199769134d0, 1.0d0, 1.109973833d0 /) + red_params(5, 14, :) = (/ 0.984104227d0, 1.053040574d0, 0.985331233d0, 1.140905252d0 /) + red_params(5, 15, :) = (/ 1.0d0, 1.074006110d0, 1.0d0, 2.308215191d0 /) + red_params(5, 16, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(5, 17, :) = (/ 1.0d0, 1.108143673d0, 1.0d0, 1.197564208d0 /) + red_params(5, 18, :) = (/ 1.0d0, 1.011759763d0, 1.0d0, 0.600340961d0 /) + red_params(5, 19, :) = (/ 0.936811219d0, 1.010593999d0, 0.992573556d0, 0.905829247d0 /) + red_params(5, 20, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(5, 21, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(6, 7, :) = (/ 1.000880464d0, 1.000414440d0, 1.000077547d0, 1.001432824d0 /) + red_params(6, 8, :) = (/ 1.0d0, 1.018159650d0, 1.0d0, 1.002143640d0 /) + red_params(6, 9, :) = (/ 1.0d0, 1.002728434d0, 1.0d0, 1.000792201d0 /) + red_params(6, 10, :) = (/ 1.0d0, 1.034995284d0, 1.0d0, 1.009157060d0 /) + red_params(6, 11, :) = (/ 1.0d0, 1.019174227d0, 1.0d0, 1.021283378d0 /) + red_params(6, 12, :) = (/ 1.0d0, 1.046905515d0, 1.0d0, 1.033180106d0 /) + red_params(6, 13, :) = (/ 1.0d0, 1.049219137d0, 1.0d0, 1.014096448d0 /) + red_params(6, 14, :) = (/ 0.976951968d0, 1.027845529d0, 0.993688386d0, 1.076466918d0 /) + red_params(6, 15, :) = (/ 1.0d0, 1.232939523d0, 1.0d0, 2.509259945d0 /) + red_params(6, 16, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(6, 17, :) = (/ 1.0d0, 1.084740904d0, 1.0d0, 1.173916162d0 /) + red_params(6, 18, :) = (/ 1.0d0, 1.223638763d0, 1.0d0, 0.615512682d0 /) + red_params(6, 19, :) = (/ 0.908113163d0, 1.033366041d0, 0.985962886d0, 0.926156602d0 /) + red_params(6, 20, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(6, 21, :) = (/ 1.0d0, 1.214638734d0, 1.0d0, 1.245039498d0 /) + red_params(7, 8, :) = (/ 1.0d0, 1.002779804d0, 1.0d0, 1.002495889d0 /) + red_params(7, 9, :) = (/ 1.0d0, 1.002284353d0, 1.0d0, 1.001835788d0 /) + red_params(7, 10, :) = (/ 1.0d0, 1.010493989d0, 1.0d0, 1.006018054d0 /) + red_params(7, 11, :) = (/ 1.0d0, 1.021668316d0, 1.0d0, 1.009885760d0 /) + red_params(7, 12, :) = (/ 1.0d0, 1.032807063d0, 1.0d0, 1.013945424d0 /) + red_params(7, 13, :) = (/ 1.0d0, 1.047298475d0, 1.0d0, 1.017817492d0 /) + red_params(7, 14, :) = (/ 1.0d0, 1.060243344d0, 1.0d0, 1.021624748d0 /) + red_params(7, 15, :) = (/ 1.0d0, 1.147595688d0, 1.0d0, 1.895305393d0 /) + red_params(7, 16, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(7, 17, :) = (/ 1.0d0, 1.087272232d0, 1.0d0, 1.161390082d0 /) + red_params(7, 18, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(7, 19, :) = (/ 1.012994431d0, 0.988591117d0, 0.974550548d0, 0.937130844d0 /) + red_params(7, 20, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(7, 21, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(8, 9, :) = (/ 1.0d0, 1.000024335d0, 1.0d0, 1.000050537d0 /) + red_params(8, 10, :) = (/ 1.0d0, 1.002480637d0, 1.0d0, 1.000761237d0 /) + red_params(8, 11, :) = (/ 1.0d0, 1.008972412d0, 1.0d0, 1.002441051d0 /) + red_params(8, 12, :) = (/ 1.0d0, 1.069223964d0, 1.0d0, 1.016422347d0 /) + red_params(8, 13, :) = (/ 1.0d0, 1.034910633d0, 1.0d0, 1.103421755d0 /) + red_params(8, 14, :) = (/ 1.0d0, 1.016370338d0, 1.0d0, 1.049035838d0 /) + red_params(8, 15, :) = (/ 1.0d0, 1.188334783d0, 1.0d0, 2.013859174d0 /) + red_params(8, 16, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(8, 17, :) = (/ 1.0d0, 1.119954454d0, 1.0d0, 1.206043295d0 /) + red_params(8, 18, :) = (/ 1.0d0, 0.956677310d0, 1.0d0, 0.447666011d0 /) + red_params(8, 19, :) = (/ 0.984613203d0, 1.076539234d0, 0.962006651d0, 0.959065662d0 /) + red_params(8, 20, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(8, 21, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(9, 10, :) = (/ 1.0d0, 1.002995876d0, 1.0d0, 1.001204174d0 /) + red_params(9, 11, :) = (/ 1.0d0, 1.009928206d0, 1.0d0, 1.003194615d0 /) + red_params(9, 12, :) = (/ 1.0d0, 1.017880545d0, 1.0d0, 1.005647480d0 /) + red_params(9, 13, :) = (/ 1.0d0, 1.028994325d0, 1.0d0, 1.008191499d0 /) + red_params(9, 14, :) = (/ 1.0d0, 1.039372957d0, 1.0d0, 1.010825138d0 /) + red_params(9, 15, :) = (/ 1.0d0, 1.184340443d0, 1.0d0, 1.996386669d0 /) + red_params(9, 16, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(9, 17, :) = (/ 1.0d0, 1.116694577d0, 1.0d0, 1.199326059d0 /) + red_params(9, 18, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(9, 19, :) = (/ 1.0d0, 0.835763343d0, 1.0d0, 0.982651529d0 /) + red_params(9, 20, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(9, 21, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(10, 11, :) = (/ 1.0d0, 1.001508227d0, 1.0d0, 0.999762786d0 /) + red_params(10, 12, :) = (/ 1.0d0, 1.006268954d0, 1.0d0, 1.001633952d0 /) + red_params(10, 13, :) = (/ 1.0d0, 1.020761680d0, 1.0d0, 1.055369591d0 /) + red_params(10, 14, :) = (/ 1.001516371d0, 1.013511439d0, 0.997641010d0, 1.028939539d0 /) + red_params(10, 15, :) = (/ 1.0d0, 1.243461678d0, 1.0d0, 3.021197546d0 /) + red_params(10, 16, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(10, 17, :) = (/ 1.0d0, 1.155145836d0, 1.0d0, 1.233272781d0 /) + red_params(10, 18, :) = (/ 1.0d0, 1.170217596d0, 1.0d0, 0.569681333d0 /) + red_params(10, 19, :) = (/ 0.754473958d0, 1.339283552d0, 0.985891113d0, 0.956075596d0 /) + red_params(10, 20, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(10, 21, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(11, 12, :) = (/ 1.0d0, 1.006767176d0, 1.0d0, 0.998793111d0 /) + red_params(11, 13, :) = (/ 1.0d0, 1.001370076d0, 1.0d0, 1.001150096d0 /) + red_params(11, 14, :) = (/ 1.0d0, 1.002972346d0, 1.0d0, 1.002229938d0 /) + red_params(11, 15, :) = (/ 1.0d0, 1.159131722d0, 1.0d0, 3.169143057d0 /) + red_params(11, 16, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(11, 17, :) = (/ 1.0d0, 1.190354273d0, 1.0d0, 1.256123503d0 /) + red_params(11, 18, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(11, 19, :) = (/ 0.828967164d0, 1.087956749d0, 0.988937417d0, 1.013453092d0 /) + red_params(11, 20, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(11, 21, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(12, 13, :) = (/ 1.0d0, 1.001357085d0, 1.0d0, 1.000235044d0 /) + red_params(12, 14, :) = (/ 1.0d0, 1.002553544d0, 1.0d0, 1.007186267d0 /) + red_params(12, 15, :) = (/ 1.0d0, 1.305249405d0, 1.0d0, 2.191555216d0 /) + red_params(12, 16, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(12, 17, :) = (/ 1.0d0, 1.219206702d0, 1.0d0, 1.276565536d0 /) + red_params(12, 18, :) = (/ 1.0d0, 0.599484191d0, 1.0d0, 0.662072469d0 /) + red_params(12, 19, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(12, 20, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(12, 21, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(13, 14, :) = (/ 1.0d0, 1.000810520d0, 1.0d0, 1.000182392d0 /) + red_params(13, 15, :) = (/ 1.0d0, 1.342647661d0, 1.0d0, 2.234354040d0 /) + red_params(13, 16, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(13, 17, :) = (/ 1.0d0, 1.252151449d0, 1.0d0, 1.294070556d0 /) + red_params(13, 18, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(13, 19, :) = (/ 1.0d0, 1.082905109d0, 1.0d0, 1.086557826d0 /) + red_params(13, 20, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(13, 21, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(14, 15, :) = (/ 1.695358382d0, 1.120233729d0, 1.064818089d0, 3.786003724d0 /) + red_params(14, 16, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(14, 17, :) = (/ 1.0d0, 0.870184960d0, 1.049594632d0, 1.803567587d0 /) + red_params(14, 18, :) = (/ 1.0d0, 0.551405318d0, 0.897162268d0, 0.740416402d0 /) + red_params(14, 19, :) = (/ 0.975187766d0, 1.171714677d0, 0.973091413d0, 1.103693489d0 /) + red_params(14, 20, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(14, 21, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(15, 16, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(15, 17, :) = (/ 1.0d0, 1.121416201d0, 1.0d0, 1.377504607d0 /) + red_params(15, 18, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(15, 19, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(15, 20, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(15, 21, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(16, 17, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(16, 18, :) = (/ 1.0d0, 1.143174289d0, 1.0d0, 0.964767932d0 /) + red_params(16, 19, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(16, 20, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(16, 21, :) = (/ 0.999746847d0, 0.993907223d0, 1.000023103d0, 0.990430423d0 /) + red_params(17, 18, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(17, 19, :) = (/ 0.795660392d0, 1.101731308d0, 1.025536736d0, 1.022749748d0 /) + red_params(17, 20, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(17, 21, :) = (/ 1.0d0, 1.159720623d0, 1.0d0, 0.954215746d0 /) + red_params(18, 19, :) = (/ 1.0d0, 1.014832832d0, 1.0d0, 0.940587083d0 /) + red_params(18, 20, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(18, 21, :) = (/ 1.0d0, 1.038993495d0, 1.0d0, 1.070941866d0 /) + red_params(19, 20, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(19, 21, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + red_params(20, 21, :) = (/ 1.0d0, 1.0d0, 1.0d0, 1.0d0 /) + + do i = 1, N - 1 + do j = i + 1, N + Bv(i, j) = red_params(i, j, 1) + Gv(i, j) = red_params(i, j, 2) + Bt(i, j) = red_params(i, j, 3) + Gt(i, j) = red_params(i, j, 4) + + Bv(j, i) = 1.d0 / Bv(i, j) + Gv(j, i) = Gv(i, j) + Bt(j, i) = 1.d0 / Bt(i, j) + Gt(j, i) = Gt(i, j) + end do + end do + + noik(1, 1) = 0.57335704239162d0 + noik(1, 2) = - 0.16760687523730d1 + noik(1, 3) = 0.23405291834916d0 + noik(1, 4) = - 0.21947376343441d0 + noik(1, 5) = 0.16369201404128d-1 + noik(1, 6) = 0.15004406389280d-1 + noik(1, 7) = 0.98990489492918d-1 + noik(1, 8) = 0.58382770929055d0 + noik(1, 9) = - 0.74786867560390d0 + noik(1, 10) = 0.30033302857974d0 + noik(1, 11) = 0.20985543806568d0 + noik(1, 12) = - 0.18590151133061d-1 + noik(1, 13) = - 0.15782558339049d0 + noik(1, 14) = 0.12716735220791d0 + noik(1, 15) = - 0.32019743894346d-1 + noik(1, 16) = - 0.68049729364536d-1 + noik(1, 17) = 0.24291412853736d-1 + noik(1, 18) = 0.51440451639444d-2 + noik(1, 19) = - 0.19084949733532d-1 + noik(1, 20) = 0.55229677241291d-2 + noik(1, 21) = - 0.44197392976085d-2 + noik(1, 22) = 0.40061416708429d-1 + noik(1, 23) = - 0.33752085907575d-1 + noik(1, 24) = - 0.25127658213357d-2 + + noik(2, 1) = 0.59889711801201d0 + noik(2, 2) = - 0.16941557480731d1 + noik(2, 3) = 0.24579736191718d0 + noik(2, 4) = - 0.23722456755175d0 + noik(2, 5) = 0.17954918715141d-1 + noik(2, 6) = 0.14592875720215d-1 + noik(2, 7) = 0.10008065936206d0 + noik(2, 8) = 0.73157115385532d0 + noik(2, 9) = - 0.88372272336366d0 + noik(2, 10) = 0.31887660246708d0 + noik(2, 11) = 0.20766491728799d0 + noik(2, 12) = - 0.19379315454158d-1 + noik(2, 13) = - 0.16936641554983d0 + noik(2, 14) = 0.13546846041701d0 + noik(2, 15) = - 0.33066712095307d-1 + noik(2, 16) = - 0.60690817018557d-1 + noik(2, 17) = 0.12797548292871d-1 + noik(2, 18) = 0.58743664107299d-2 + noik(2, 19) = - 0.18451951971969d-1 + noik(2, 20) = 0.47226622042472d-2 + noik(2, 21) = - 0.52024079680599d-2 + noik(2, 22) = 0.43563505956635d-1 + noik(2, 23) = - 0.36251690750939d-1 + noik(2, 24) = - 0.28974026866543d-2 + + noik(3, 1) = 0.52646564804653d0 + noik(3, 2) = - 0.14995725042592d1 + noik(3, 3) = 0.27329786733782d0 + noik(3, 4) = 0.12949500022786d0 + noik(3, 5) = 0.15404088341841d0 + noik(3, 6) = - 0.58186950946814d0 + noik(3, 7) = - 0.18022494838296d0 + noik(3, 8) = - 0.95389904072812d-1 + noik(3, 9) = - 0.80486819317679d-2 + noik(3, 10) = - 0.35547751273090d-1 + noik(3, 11) = - 0.28079014882405d0 + noik(3, 12) = - 0.82435890081677d-1 + noik(3, 13) = 0.10832427979006d-1 + noik(3, 14) = - 0.67073993161097d-2 + noik(3, 15) = - 0.46827907600524d-2 + noik(3, 16) = - 0.28359911832177d-1 + noik(3, 17) = 0.19500174744098d-1 + noik(3, 18) = - 0.21609137507166d0 + noik(3, 19) = 0.43772794926972d0 + noik(3, 20) = - 0.22130790113593d0 + noik(3, 21) = 0.15190189957331d-1 + noik(3, 22) = - 0.15380948953300d-1 + + noik(4, 1) = 0.63596780450714d0 + noik(4, 2) = - 0.17377981785459d1 + noik(4, 3) = 0.28914060926272d0 + noik(4, 4) = - 0.33714276845694d0 + noik(4, 5) = 0.22405964699561d-1 + noik(4, 6) = 0.15715424886913d-1 + noik(4, 7) = 0.11450634253745 + noik(4, 8) = 0.10612049379745d1 + noik(4, 9) = - 0.12855224439423d1 + noik(4, 10) = 0.39414630777652d0 + noik(4, 11) = 0.31390924682041d0 + noik(4, 12) = - 0.21592277117247d-1 + noik(4, 13) = - 0.21723666564905d0 + noik(4, 14) = - 0.28999574439489d0 + noik(4, 15) = 0.42321173025732d0 + noik(4, 16) = 0.46434100259260d-1 + noik(4, 17) = - 0.13138398329741d0 + noik(4, 18) = 0.11492850364368d-1 + noik(4, 19) = - 0.33387688429909d-1 + noik(4, 20) = 0.15183171583644d-1 + noik(4, 21) = - 0.47610805647657d-2 + noik(4, 22) = 0.46917166277885d-1 + noik(4, 23) = - 0.39401755804649d-1 + noik(4, 24) = - 0.32569956247611d-2 + + noik(5, 1) = 0.10403973107358d1 + noik(5, 2) = - 0.28318404081403d1 + noik(5, 3) = 0.84393809606294d0 + noik(5, 4) = - 0.76559591850023d-1 + noik(5, 5) = 0.94697373057280d-1 + noik(5, 6) = 0.24796475497006d-3 + noik(5, 7) = 0.27743760422870d0 + noik(5, 8) = - 0.43846000648377d-1 + noik(5, 9) = - 0.26991064784350d0 + noik(5, 10) = - 0.69313413089860d-1 + noik(5, 11) = - 0.29632145981653d-1 + noik(5, 12) = 0.14040126751380d-1 + + noik(6, 1) = 0.10626277411455d1 + noik(6, 2) = - 0.28620951828350d1 + noik(6, 3) = 0.88738233403777d0 + noik(6, 4) = - 0.12570581155345d0 + noik(6, 5) = 0.10286308708106d0 + noik(6, 6) = 0.25358040602654d-3 + noik(6, 7) = 0.32325200233982d0 + noik(6, 8) = - 0.37950761057432d-1 + noik(6, 9) = - 0.32534802014452d0 + noik(6, 10) = - 0.79050969051011d-1 + noik(6, 11) = - 0.20636720547775d-1 + noik(6, 12) = 0.57053809334750d-2 + + noik(7, 1) = 0.10429331589100d1 + noik(7, 2) = - 0.28184272548892d1 + noik(7, 3) = 0.86176232397850d0 + noik(7, 4) = - 0.10613619452487d0 + noik(7, 5) = 0.98615749302134d-1 + noik(7, 6) = 0.23948208682322d-3 + noik(7, 7) = 0.30330004856950d0 + noik(7, 8) = - 0.41598156135099d-1 + noik(7, 9) = - 0.29991937470058d0 + noik(7, 10) = - 0.80369342764109d-1 + noik(7, 11) = - 0.29761373251151d-1 + noik(7, 12) = 0.13059630303140d-1 + + noik(8, 1) = 0.10968643098001d1 + noik(8, 2) = - 0.29988888298061d1 + noik(8, 3) = 0.99516886799212d0 + noik(8, 4) = - 0.16170708558539d0 + noik(8, 5) = 0.11334460072775d0 + noik(8, 6) = 0.26760595150748d-3 + noik(8, 7) = 0.40979881986931d0 + noik(8, 8) = - 0.40876423083075d-1 + noik(8, 9) = - 0.38169482469447d0 + noik(8, 10) = - 0.10931956843993d0 + noik(8, 11) = - 0.32073223327990d-1 + noik(8, 12) = 0.16877016216975d-1 + + noik(9, 1) = 0.10963d1 + noik(9, 2) = - 0.30402d1 + noik(9, 3) = 0.10317d1 + noik(9, 4) = - 0.15410d0 + noik(9, 5) = 0.11535d0 + noik(9, 6) = 0.29809d-3 + noik(9, 7) = 0.39571d0 + noik(9, 8) = - 0.45881d-1 + noik(9, 9) = - 0.35804d0 + noik(9, 10) = - 0.10107d0 + noik(9, 11) = - 0.35484d-1 + noik(9, 12) = 0.18156d-1 + + noik(10, 1) = 0.10553238013661d1 + noik(10, 2) = - 0.26120615890629d1 + noik(10, 3) = 0.76613882967260d0 + noik(10, 4) = - 0.29770320622459d0 + noik(10, 5) = 0.11879907733358d0 + noik(10, 6) = 0.27922861062617d-3 + noik(10, 7) = 0.46347589844105d0 + noik(10, 8) = 0.11433196980297d-1 + noik(10, 9) = - 0.48256968738131d0 + noik(10, 10) = - 0.93750558924659d-1 + noik(10, 11) = - 0.67273247155994d-2 + noik(10, 12) = - 0.51141583585428d-2 + + noik(11, 1) = 0.10543747645262d1 + noik(11, 2) = - 0.26500681506144d1 + noik(11, 3) = 0.81730047827543d0 + noik(11, 4) = - 0.30451391253428d0 + noik(11, 5) = 0.12253868710800d0 + noik(11, 6) = 0.27266472743928d-3 + noik(11, 7) = 0.49865825681670d0 + noik(11, 8) = - 0.71432815084176d-3 + noik(11, 9) = - 0.54236895525450d0 + noik(11, 10) = - 0.13801821610756d0 + noik(11, 11) = - 0.61595287380011d-2 + noik(11, 12) = 0.48602510393022d-3 + + noik(12, 1) = 0.10722544875633d1 + noik(12, 2) = - 0.24632951172003d1 + noik(12, 3) = 0.65386674054928d0 + noik(12, 4) = - 0.36324974085628d0 + noik(12, 5) = 0.12713269626764d0 + noik(12, 6) = 0.30713572777930d-3 + noik(12, 7) = 0.52656856987540d0 + noik(12, 8) = 0.19362862857653d-1 + noik(12, 9) = - 0.58939426849155d0 + noik(12, 10) = - 0.14069963991934d0 + noik(12, 11) = - 0.78966330500036d-2 + noik(12, 12) = 0.33036597968109d-2 + + noik(13, 1) = 0.11151d1 + noik(13, 2) = - 0.27020d1 + noik(13, 3) = 0.83416d0 + noik(13, 4) = - 0.38828d0 + noik(13, 5) = 0.13760d0 + noik(13, 6) = 0.28185d-3 + noik(13, 7) = 0.62037d0 + noik(13, 8) = 0.15847d-1 + noik(13, 9) = - 0.61726d0 + noik(13, 10) = - 0.15043d0 + noik(13, 11) = - 0.12982d-1 + noik(13, 12) = 0.44325d-2 + + noik(14, 1) = 0.10461d1 + noik(14, 2) = - 0.24807d1 + noik(14, 3) = 0.74372d0 + noik(14, 4) = - 0.52579d0 + noik(14, 5) = 0.15315d0 + noik(14, 6) = 0.32865d-3 + noik(14, 7) = 0.84178d0 + noik(14, 8) = 0.55424d-1 + noik(14, 9) = - 0.73555d0 + noik(14, 10) = - 0.18507d0 + noik(14, 11) = - 0.20775d-1 + noik(14, 12) = 0.12335d-1 + + noik(15, 1) = 0.53579928451252d1 + noik(15, 2) = - 0.62050252530595d1 + noik(15, 3) = 0.13830241327086d0 + noik(15, 4) = - 0.71397954896129d-1 + noik(15, 5) = 0.15474053959733d-1 + noik(15, 6) = - 0.14976806405771d0 + noik(15, 7) = - 0.26368723988451d-1 + noik(15, 8) = 0.56681303156066d-1 + noik(15, 9) = - 0.60063958030436d-1 + noik(15, 10) = - 0.45043942027132d0 + noik(15, 11) = 0.42478840244500d0 + noik(15, 12) = - 0.21997640827139d-1 + noik(15, 13) = - 0.10499521374530d-1 + noik(15, 14) = - 0.28955902866816d-2 + + noik(16, 1) = 0.88878286369701d0 + noik(16, 2) = - 0.24879433312148d1 + noik(16, 3) = 0.59750190775886d0 + noik(16, 4) = 0.96501817061881d-2 + noik(16, 5) = 0.71970428712770d-1 + noik(16, 6) = 0.22337443000195d-3 + noik(16, 7) = 0.18558686391474d0 + noik(16, 8) = - 0.38129368035760d-1 + noik(16, 9) = - 0.15352245383006d0 + noik(16, 10) = - 0.26726814910919d-1 + noik(16, 11) = - 0.25675298677127d-1 + noik(16, 12) = 0.95714302123668d-2 + + noik(17, 1) = 0.90554d0 + noik(17, 2) = - 0.24515d1 + noik(17, 3) = 0.53149d0 + noik(17, 4) = 0.24173d-1 + noik(17, 5) = 0.72156d-1 + noik(17, 6) = 0.18818d-3 + noik(17, 7) = 0.19405d0 + noik(17, 8) = - 0.43268d-1 + noik(17, 9) = - 0.12778d0 + noik(17, 10) = - 0.27896d-1 + noik(17, 11) = - 0.34154d-1 + noik(17, 12) = 0.16329d-1 + + noik(18, 1) = 0.82728408749586d0 + noik(18, 2) = - 0.18602220416584d1 + noik(18, 3) = - 0.11199009613744d1 + noik(18, 4) = 0.15635753976056d0 + noik(18, 5) = 0.87375844859025d0 + noik(18, 6) = - 0.36674403715731d0 + noik(18, 7) = 0.53987893432436d-1 + noik(18, 8) = 0.10957690214499d1 + noik(18, 9) = 0.53213037828563d-1 + noik(18, 10) = 0.13050533930825d-1 + noik(18, 11) = - 0.41079520434476d0 + noik(18, 12) = 0.14637443344120d0 + noik(18, 13) = - 0.55726838623719d-1 + noik(18, 14) = - 0.11201774143800d-1 + noik(18, 15) = - 0.66062758068099d-2 + noik(18, 16) = 0.46918522004538d-2 + + noik(19, 1) = 0.87641d0 + noik(19, 2) = - 0.20367d1 + noik(19, 3) = 0.21634d0 + noik(19, 4) = - 0.50199d-1 + noik(19, 5) = 0.66994d-1 + noik(19, 6) = 0.19076d-3 + noik(19, 7) = 0.20227d0 + noik(19, 8) = - 0.45348d-2 + noik(19, 9) = - 0.22230d0 + noik(19, 10) = - 0.34714d-1 + noik(19, 11) = - 0.14885d-1 + noik(19, 12) = 0.74154d-2 + + noik(20, 1) = - 0.45579024006737d0 + noik(20, 2) = 0.12516390754925d1 + noik(20, 3) = - 0.15438231650621d1 + noik(20, 4) = 0.20467489707221d-1 + noik(20, 5) = - 0.34476212380781d0 + noik(20, 6) = - 0.20858459512787d-1 + noik(20, 7) = 0.16227414711778d-1 + noik(20, 8) = - 0.57471818200892d-1 + noik(20, 9) = 0.19462416430715d-1 + noik(20, 10) = - 0.33295680123020d-1 + noik(20, 11) = - 0.10863577372367d-1 + noik(20, 12) = - 0.22173365245954d-1 + + noik(21, 1) = 0.85095714803969d0 + noik(21, 2) = - 0.24003222943480d1 + noik(21, 3) = 0.54127841476466d0 + noik(21, 4) = 0.16919770692538d-1 + noik(21, 5) = 0.68825965019035d-1 + noik(21, 6) = 0.21428032815338d-3 + noik(21, 7) = 0.17429895321992d0 + noik(21, 8) = - 0.33654495604194d-1 + noik(21, 9) = - 0.13526799857691d0 + noik(21, 10) = - 0.16387350791552d-1 + noik(21, 11) = - 0.24987666851475d-1 + noik(21, 12) = 0.88769204815709d-2 + + coik(3, 5) = 1 + coik(3, 6) = 1 + coik(3, 7) = 1 + coik(3, 8) = 1 + coik(3, 9) = 1 + coik(3, 10) = 1 + coik(3, 11) = 2 + coik(3, 12) = 2 + coik(3, 13) = 3 + coik(3, 14) = 3 + coik(3, 15) = 3 + coik(3, 16) = 3 + coik(3, 17) = 3 + coik(3, 18) = 5 + coik(3, 19) = 5 + coik(3, 20) = 5 + coik(3, 21) = 6 + coik(3, 22) = 6 + + coik(15, 6) = 1 + coik(15, 7) = 1 + coik(15, 8) = 1 + coik(15, 9) = 1 + coik(15, 10) = 2 + coik(15, 11) = 2 + coik(15, 12) = 3 + coik(15, 13) = 3 + coik(15, 14) = 5 + + coik(18, 8) = 1 + coik(18, 9) = 1 + coik(18, 10) = 1 + coik(18, 11) = 2 + coik(18, 12) = 2 + coik(18, 13) = 2 + coik(18, 14) = 3 + coik(18, 15) = 5 + coik(18, 16) = 5 + + coik(20, 5) = 1 + coik(20, 6) = 1 + coik(20, 7) = 1 + coik(20, 8) = 1 + coik(20, 9) = 1 + coik(20, 10) = 2 + coik(20, 11) = 3 + coik(20, 12) = 3 + + tmp1 = (/ 1, 2, 4 /) + + do i = 1, size(tmp1) + k = tmp1(i) + doik(k, 1) = 1 + doik(k, 2) = 1 + doik(k, 3) = 2 + doik(k, 4) = 2 + doik(k, 5) = 4 + doik(k, 6) = 4 + doik(k, 7) = 1 + doik(k, 8) = 1 + doik(k, 9) = 1 + doik(k, 10) = 2 + doik(k, 11) = 3 + doik(k, 12) = 6 + doik(k, 13) = 2 + doik(k, 14) = 3 + doik(k, 15) = 3 + doik(k, 16) = 4 + doik(k, 17) = 4 + doik(k, 18) = 2 + doik(k, 19) = 3 + doik(k, 20) = 4 + doik(k, 21) = 5 + doik(k, 22) = 6 + doik(k, 23) = 6 + doik(k, 24) = 7 + + toik(k, 1) = 0.125d0 + toik(k, 2) = 1.125d0 + toik(k, 3) = 0.375d0 + toik(k, 4) = 1.125d0 + toik(k, 5) = 0.625d0 + toik(k, 6) = 1.500d0 + toik(k, 7) = 0.625d0 + toik(k, 8) = 2.625d0 + toik(k, 9) = 2.750d0 + toik(k, 10) = 2.125d0 + toik(k, 11) = 2.000d0 + toik(k, 12) = 1.750d0 + toik(k, 13) = 4.500d0 + toik(k, 14) = 4.750d0 + toik(k, 15) = 5.000d0 + toik(k, 16) = 4.000d0 + toik(k, 17) = 4.500d0 + toik(k, 18) = 7.500d0 + toik(k, 19) = 14.000d0 + toik(k, 20) = 11.500d0 + toik(k, 21) = 26.000d0 + toik(k, 22) = 28.000d0 + toik(k, 23) = 30.000d0 + toik(k, 24) = 16.000d0 + + coik(k, 7) = 1 + coik(k, 8) = 1 + coik(k, 9) = 1 + coik(k, 10) = 1 + coik(k, 11) = 1 + coik(k, 12) = 1 + coik(k, 13) = 2 + coik(k, 14) = 2 + coik(k, 15) = 2 + coik(k, 16) = 2 + coik(k, 17) = 2 + coik(k, 18) = 3 + coik(k, 19) = 3 + coik(k, 20) = 3 + coik(k, 21) = 6 + coik(k, 22) = 6 + coik(k, 23) = 6 + coik(k, 24) = 6 + + Kpol(k) = 6 + Kexp(k) = 18 + + end do + + tmp2 = (/ 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 19, 21 /) + + do i = 1, size(tmp2) + k = tmp2(i) + + coik(k, 7) = 1 + coik(k, 8) = 1 + coik(k, 9) = 2 + coik(k, 10) = 2 + coik(k, 11) = 3 + coik(k, 12) = 3 + + doik(k, 1) = 1 + doik(k, 2) = 1 + doik(k, 3) = 1 + doik(k, 4) = 2 + doik(k, 5) = 3 + doik(k, 6) = 7 + doik(k, 7) = 2 + doik(k, 8) = 5 + doik(k, 9) = 1 + doik(k, 10) = 4 + doik(k, 11) = 3 + doik(k, 12) = 4 + + toik(k, 1) = 0.250d0 + toik(k, 2) = 1.125d0 + toik(k, 3) = 1.500d0 + toik(k, 4) = 1.375d0 + toik(k, 5) = 0.250d0 + toik(k, 6) = 0.875d0 + toik(k, 7) = 0.625d0 + toik(k, 8) = 1.750d0 + toik(k, 9) = 3.625d0 + toik(k, 10) = 3.625d0 + toik(k, 11) = 14.500d0 + toik(k, 12) = 12.000d0 + + Kpol(k) = 6 + Kexp(k) = 6 + + end do + + Kpol(3) = 4 + Kexp(3) = 18 + + Kpol(15) = 5 + Kexp(15) = 9 + + Kpol(18) = 7 + Kexp(18) = 9 + + Kpol(20) = 4 + Kexp(20) = 8 + + doik(20, 1) = 1 + doik(20, 2) = 1 + doik(20, 3) = 1 + doik(20, 4) = 4 + doik(20, 5) = 1 + doik(20, 6) = 3 + doik(20, 7) = 5 + doik(20, 8) = 5 + doik(20, 9) = 5 + doik(20, 10) = 2 + doik(20, 11) = 1 + doik(20, 12) = 2 + + toik(20, 1) = 0.000d0 + toik(20, 2) = 0.125d0 + toik(20, 3) = 0.750d0 + toik(20, 4) = 1.000d0 + toik(20, 5) = 0.750d0 + toik(20, 6) = 2.625d0 + toik(20, 7) = 0.125d0 + toik(20, 8) = 1.250d0 + toik(20, 9) = 2.000d0 + toik(20, 10) = 1.000d0 + toik(20, 11) = 4.500d0 + toik(20, 12) = 5.000d0 + + doik(18, 1) = 1 + doik(18, 2) = 1 + doik(18, 3) = 1 + doik(18, 4) = 2 + doik(18, 5) = 2 + doik(18, 6) = 3 + doik(18, 7) = 4 + doik(18, 8) = 1 + doik(18, 9) = 5 + doik(18, 10) = 5 + doik(18, 11) = 1 + doik(18, 12) = 2 + doik(18, 13) = 4 + doik(18, 14) = 4 + doik(18, 15) = 1 + doik(18, 16) = 1 + + toik(18, 1) = 0.500d0 + toik(18, 2) = 1.250d0 + toik(18, 3) = 1.875d0 + toik(18, 4) = 0.125d0 + toik(18, 5) = 1.500d0 + toik(18, 6) = 1.000d0 + toik(18, 7) = 0.750d0 + toik(18, 8) = 1.500d0 + toik(18, 9) = 0.625d0 + toik(18, 10) = 2.625d0 + toik(18, 11) = 5.000d0 + toik(18, 12) = 4.000d0 + toik(18, 13) = 4.500d0 + toik(18, 14) = 3.000d0 + toik(18, 15) = 4.000d0 + toik(18, 16) = 6.000d0 + + doik(15, 1) = 1 + doik(15, 2) = 1 + doik(15, 3) = 2 + doik(15, 4) = 2 + doik(15, 5) = 4 + doik(15, 6) = 1 + doik(15, 7) = 5 + doik(15, 8) = 5 + doik(15, 9) = 5 + doik(15, 10) = 1 + doik(15, 11) = 1 + doik(15, 12) = 2 + doik(15, 13) = 5 + doik(15, 14) = 1 + + toik(15, 1) = 0.500d0 + toik(15, 2) = 0.625d0 + toik(15, 3) = 0.375d0 + toik(15, 4) = 0.625d0 + toik(15, 5) = 1.125d0 + toik(15, 6) = 2.625d0 + toik(15, 7) = 0.000d0 + toik(15, 8) = 0.250d0 + toik(15, 9) = 1.375d0 + toik(15, 10) = 4.000d0 + toik(15, 11) = 4.250d0 + toik(15, 12) = 5.000d0 + toik(15, 13) = 8.000d0 + toik(15, 14) = 8.000d0 + + doik(3, 1) = 1 + doik(3, 2) = 1 + doik(3, 3) = 2 + doik(3, 4) = 3 + doik(3, 5) = 3 + doik(3, 6) = 3 + doik(3, 7) = 4 + doik(3, 8) = 5 + doik(3, 9) = 6 + doik(3, 10) = 6 + doik(3, 11) = 1 + doik(3, 12) = 4 + doik(3, 13) = 1 + doik(3, 14) = 1 + doik(3, 15) = 3 + doik(3, 16) = 3 + doik(3, 17) = 4 + doik(3, 18) = 5 + doik(3, 19) = 5 + doik(3, 20) = 5 + doik(3, 21) = 5 + doik(3, 22) = 5 + + toik(3, 1) = 0.000d0 + toik(3, 2) = 1.250d0 + toik(3, 3) = 1.625d0 + toik(3, 4) = 0.375d0 + toik(3, 5) = 0.375d0 + toik(3, 6) = 1.375d0 + toik(3, 7) = 1.125d0 + toik(3, 8) = 1.375d0 + toik(3, 9) = 0.125d0 + toik(3, 10) = 1.625d0 + toik(3, 11) = 3.750d0 + toik(3, 12) = 3.500d0 + toik(3, 13) = 7.500d0 + toik(3, 14) = 8.000d0 + toik(3, 15) = 6.000d0 + toik(3, 16) = 16.000d0 + toik(3, 17) = 11.000d0 + toik(3, 18) = 24.000d0 + toik(3, 19) = 26.000d0 + toik(3, 20) = 28.000d0 + toik(3, 21) = 24.000d0 + toik(3, 22) = 26.000d0 + + ! Departure function parameters + + dij(1, 2, 1) = 1 + dij(1, 2, 2) = 4 + dij(1, 2, 3) = 1 + dij(1, 2, 4) = 2 + dij(1, 2, 5) = 2 + dij(1, 2, 6) = 2 + dij(1, 2, 7) = 2 + dij(1, 2, 8) = 2 + dij(1, 2, 9) = 3 + + tij(1, 2, 1) = 0.000d0 + tij(1, 2, 2) = 1.850d0 + tij(1, 2, 3) = 7.850d0 + tij(1, 2, 4) = 5.400d0 + tij(1, 2, 5) = 0.000d0 + tij(1, 2, 6) = 0.750d0 + tij(1, 2, 7) = 2.800d0 + tij(1, 2, 8) = 4.450d0 + tij(1, 2, 9) = 4.250d0 + + nij(1, 2, 1) = - 0.98038985517335d-2 + nij(1, 2, 2) = 0.42487270143005d-3 + nij(1, 2, 3) = - 0.34800214576142d-1 + nij(1, 2, 4) = - 0.13333813013896d0 + nij(1, 2, 5) = - 0.11993694974627d-1 + nij(1, 2, 6) = 0.69243379775168d-1 + nij(1, 2, 7) = - 0.31022508148249d0 + nij(1, 2, 8) = 0.24495491753226d0 + nij(1, 2, 9) = 0.22369816716981d0 + + ethaij(1, 2, 3) = 1.000d0 + ethaij(1, 2, 4) = 1.000d0 + ethaij(1, 2, 5) = 0.250d0 + ethaij(1, 2, 6) = 0.000d0 + ethaij(1, 2, 7) = 0.000d0 + ethaij(1, 2, 8) = 0.000d0 + ethaij(1, 2, 9) = 0.000d0 + + epsij(1, 2, 3) = 0.5d0 + epsij(1, 2, 4) = 0.5d0 + epsij(1, 2, 5) = 0.5d0 + epsij(1, 2, 6) = 0.5d0 + epsij(1, 2, 7) = 0.5d0 + epsij(1, 2, 8) = 0.5d0 + epsij(1, 2, 9) = 0.5d0 + + betaij(1, 2, 3) = 1.000d0 + betaij(1, 2, 4) = 1.000d0 + betaij(1, 2, 5) = 2.500d0 + betaij(1, 2, 6) = 3.000d0 + betaij(1, 2, 7) = 3.000d0 + betaij(1, 2, 8) = 3.000d0 + betaij(1, 2, 9) = 3.000d0 + + gammaij(1, 2, 3) = 0.5d0 + gammaij(1, 2, 4) = 0.5d0 + gammaij(1, 2, 5) = 0.5d0 + gammaij(1, 2, 6) = 0.5d0 + gammaij(1, 2, 7) = 0.5d0 + gammaij(1, 2, 8) = 0.5d0 + gammaij(1, 2, 9) = 0.5d0 + + dij(1, 3, 1) = 1 + dij(1, 3, 2) = 2 + dij(1, 3, 3) = 3 + dij(1, 3, 4) = 1 + dij(1, 3, 5) = 2 + dij(1, 3, 6) = 3 + + tij(1, 3, 1) = 2.600d0 + tij(1, 3, 2) = 1.950d0 + tij(1, 3, 3) = 0.000d0 + tij(1, 3, 4) = 3.950d0 + tij(1, 3, 5) = 7.950d0 + tij(1, 3, 6) = 8.000d0 + + nij(1, 3, 1) = - 0.10859387354942d0 + nij(1, 3, 2) = 0.80228576727389d-1 + nij(1, 3, 3) = - 0.93303985115717d-2 + nij(1, 3, 4) = 0.40989274005848d-1 + nij(1, 3, 5) = - 0.24338019772494d0 + nij(1, 3, 6) = 0.23855347281124d0 + + ethaij(1, 3, 4) = 1.000d0 + ethaij(1, 3, 5) = 0.500d0 + ethaij(1, 3, 6) = 0.000d0 + + epsij(1, 3, 4) = 0.5d0 + epsij(1, 3, 5) = 0.5d0 + epsij(1, 3, 6) = 0.5d0 + + betaij(1, 3, 4) = 1.000d0 + betaij(1, 3, 5) = 2.000d0 + betaij(1, 3, 6) = 3.000d0 + + gammaij(1, 3, 4) = 0.5d0 + gammaij(1, 3, 5) = 0.5d0 + gammaij(1, 3, 6) = 0.5d0 + + dij(1, 4, 1) = 3 + dij(1, 4, 2) = 4 + dij(1, 4, 3) = 1 + dij(1, 4, 4) = 2 + dij(1, 4, 5) = 2 + dij(1, 4, 6) = 2 + dij(1, 4, 7) = 2 + dij(1, 4, 8) = 2 + dij(1, 4, 9) = 2 + dij(1, 4, 10) = 3 + dij(1, 4, 11) = 3 + dij(1, 4, 12) = 3 + + tij(1, 4, 1) = 0.650d0 + tij(1, 4, 2) = 1.550d0 + tij(1, 4, 3) = 3.100d0 + tij(1, 4, 4) = 5.900d0 + tij(1, 4, 5) = 7.050d0 + tij(1, 4, 6) = 3.350d0 + tij(1, 4, 7) = 1.200d0 + tij(1, 4, 8) = 5.800d0 + tij(1, 4, 9) = 2.700d0 + tij(1, 4, 10) = 0.450d0 + tij(1, 4, 11) = 0.550d0 + tij(1, 4, 12) = 1.950d0 + + nij(1, 4, 1) = - 0.80926050298746d-3 + nij(1, 4, 2) = - 0.75381925080059d-3 + nij(1, 4, 3) = - 0.41618768891219d-1 + nij(1, 4, 4) = - 0.23452173681569d0 + nij(1, 4, 5) = 0.14003840584586d0 + nij(1, 4, 6) = 0.63281744807738d-1 + nij(1, 4, 7) = - 0.34660425848809d-1 + nij(1, 4, 8) = - 0.23918747334251d0 + nij(1, 4, 9) = 0.19855255066891d-2 + nij(1, 4, 10) = 0.61777746171555d1 + nij(1, 4, 11) = - 0.69575358271105d1 + nij(1, 4, 12) = 0.10630185306388d1 + + ethaij(1, 4, 3) = 1.000d0 + ethaij(1, 4, 4) = 1.000d0 + ethaij(1, 4, 5) = 1.000d0 + ethaij(1, 4, 6) = 0.875d0 + ethaij(1, 4, 7) = 0.750d0 + ethaij(1, 4, 8) = 0.500d0 + ethaij(1, 4, 9) = 0.000d0 + ethaij(1, 4, 10) = 0.000d0 + ethaij(1, 4, 11) = 0.000d0 + ethaij(1, 4, 12) = 0.000d0 + + epsij(1, 4, 3) = 0.5d0 + epsij(1, 4, 4) = 0.5d0 + epsij(1, 4, 5) = 0.5d0 + epsij(1, 4, 6) = 0.5d0 + epsij(1, 4, 7) = 0.5d0 + epsij(1, 4, 8) = 0.5d0 + epsij(1, 4, 9) = 0.5d0 + epsij(1, 4, 10) = 0.5d0 + epsij(1, 4, 11) = 0.5d0 + epsij(1, 4, 12) = 0.5d0 + + betaij(1, 4, 3) = 1.000d0 + betaij(1, 4, 4) = 1.000d0 + betaij(1, 4, 5) = 1.000d0 + betaij(1, 4, 6) = 1.250d0 + betaij(1, 4, 7) = 1.500d0 + betaij(1, 4, 8) = 2.000d0 + betaij(1, 4, 9) = 3.000d0 + betaij(1, 4, 10) = 3.000d0 + betaij(1, 4, 11) = 3.000d0 + betaij(1, 4, 12) = 3.000d0 + + gammaij(1, 4, 3) = 0.5d0 + gammaij(1, 4, 4) = 0.5d0 + gammaij(1, 4, 5) = 0.5d0 + gammaij(1, 4, 6) = 0.5d0 + gammaij(1, 4, 7) = 0.5d0 + gammaij(1, 4, 8) = 0.5d0 + gammaij(1, 4, 9) = 0.5d0 + gammaij(1, 4, 10) = 0.5d0 + gammaij(1, 4, 11) = 0.5d0 + gammaij(1, 4, 12) = 0.5d0 + + dij(1, 5, 1) = 3 + dij(1, 5, 2) = 3 + dij(1, 5, 3) = 4 + dij(1, 5, 4) = 4 + dij(1, 5, 5) = 4 + dij(1, 5, 6) = 1 + dij(1, 5, 7) = 1 + dij(1, 5, 8) = 1 + dij(1, 5, 9) = 2 + + tij(1, 5, 1) = 1.850d0 + tij(1, 5, 2) = 3.950d0 + tij(1, 5, 3) = 0.000d0 + tij(1, 5, 4) = 1.850d0 + tij(1, 5, 5) = 3.850d0 + tij(1, 5, 6) = 5.250d0 + tij(1, 5, 7) = 3.850d0 + tij(1, 5, 8) = 0.200d0 + tij(1, 5, 9) = 6.500d0 + + nij(1, 5, 1) = 0.13746429958576d-1 + nij(1, 5, 2) = - 0.74425012129552d-2 + nij(1, 5, 3) = - 0.45516600213685d-2 + nij(1, 5, 4) = - 0.54546603350237d-2 + nij(1, 5, 5) = 0.23682016824471d-2 + nij(1, 5, 6) = 0.18007763721438d0 + nij(1, 5, 7) = - 0.44773942932486d0 + nij(1, 5, 8) = 0.19327374888200d-1 + nij(1, 5, 9) = - 0.30632197804624d0 + + ethaij(1, 5, 6) = 0.250d0 + ethaij(1, 5, 7) = 0.250d0 + ethaij(1, 5, 8) = 0.000d0 + ethaij(1, 5, 9) = 0.000d0 + + epsij(1, 5, 6) = 0.5d0 + epsij(1, 5, 7) = 0.5d0 + epsij(1, 5, 8) = 0.5d0 + epsij(1, 5, 9) = 0.5d0 + + betaij(1, 5, 6) = 0.750d0 + betaij(1, 5, 7) = 1.000d0 + betaij(1, 5, 8) = 2.000d0 + betaij(1, 5, 9) = 3.000d0 + + gammaij(1, 5, 6) = 0.5d0 + gammaij(1, 5, 7) = 0.5d0 + gammaij(1, 5, 8) = 0.5d0 + gammaij(1, 5, 9) = 0.5d0 + + dij(2, 3, 1) = 2 + dij(2, 3, 2) = 3 + dij(2, 3, 3) = 1 + dij(2, 3, 4) = 1 + dij(2, 3, 5) = 1 + dij(2, 3, 6) = 2 + + tij(2, 3, 1) = 1.850d0 + tij(2, 3, 2) = 1.400d0 + tij(2, 3, 3) = 3.200d0 + tij(2, 3, 4) = 2.500d0 + tij(2, 3, 5) = 8.000d0 + tij(2, 3, 6) = 3.750d0 + + nij(2, 3, 1) = 0.28661625028399d0 + nij(2, 3, 2) = - 0.10919833861247d0 + nij(2, 3, 3) = - 0.11374032082270d1 + nij(2, 3, 4) = 0.76580544237358d0 + nij(2, 3, 5) = 0.42638000926819d-2 + nij(2, 3, 6) = 0.17673538204534d0 + + ethaij(2, 3, 3) = 0.250d0 + ethaij(2, 3, 4) = 0.250d0 + ethaij(2, 3, 5) = 0.000d0 + ethaij(2, 3, 6) = 0.000d0 + + epsij(2, 3, 3) = 0.5d0 + epsij(2, 3, 4) = 0.5d0 + epsij(2, 3, 5) = 0.5d0 + epsij(2, 3, 6) = 0.5d0 + + betaij(2, 3, 3) = 0.750d0 + betaij(2, 3, 4) = 1.000d0 + betaij(2, 3, 5) = 2.000d0 + betaij(2, 3, 6) = 3.000d0 + + gammaij(2, 3, 3) = 0.5d0 + gammaij(2, 3, 4) = 0.5d0 + gammaij(2, 3, 5) = 0.5d0 + gammaij(2, 3, 6) = 0.5d0 + + dij(2, 4, 1) = 2 + dij(2, 4, 2) = 2 + dij(2, 4, 3) = 3 + dij(2, 4, 4) = 1 + dij(2, 4, 5) = 2 + dij(2, 4, 6) = 2 + + tij(2, 4, 1) = 0.000d0 + tij(2, 4, 2) = 0.050d0 + tij(2, 4, 3) = 0.000d0 + tij(2, 4, 4) = 3.650d0 + tij(2, 4, 5) = 4.900d0 + tij(2, 4, 6) = 4.450d0 + + nij(2, 4, 1) = - 0.47376518126608d0 + nij(2, 4, 2) = 0.48961193461001d0 + nij(2, 4, 3) = - 0.57011062090535d-2 + nij(2, 4, 4) = - 0.19966820041320d0 + nij(2, 4, 5) = - 0.69411103101723d0 + nij(2, 4, 6) = 0.69226192739021d0 + + ethaij(2, 4, 4) = 1.000d0 + ethaij(2, 4, 5) = 1.000d0 + ethaij(2, 4, 6) = 0.875d0 + + epsij(2, 4, 4) = 0.5d0 + epsij(2, 4, 5) = 0.5d0 + epsij(2, 4, 6) = 0.5d0 + + betaij(2, 4, 4) = 1.000d0 + betaij(2, 4, 5) = 1.000d0 + betaij(2, 4, 6) = 1.250d0 + + gammaij(2, 4, 4) = 0.5d0 + gammaij(2, 4, 5) = 0.5d0 + gammaij(2, 4, 6) = 0.5d0 + + dij(1, 15, 1) = 1 + dij(1, 15, 2) = 3 + dij(1, 15, 3) = 3 + dij(1, 15, 4) = 4 + + tij(1, 15, 1) = 2.000d0 + tij(1, 15, 2) = - 1.000d0 + tij(1, 15, 3) = 1.750d0 + tij(1, 15, 4) = 1.400d0 + + nij(1, 15, 1) = - 0.25157134971934d0 + nij(1, 15, 2) = - 0.62203841111983d-2 + nij(1, 15, 3) = 0.88850315184396d-1 + nij(1, 15, 4) = - 0.35592212573239d-1 + + generalized_departure(1, :) = (/ 1, 6 /) + generalized_departure(2, :) = (/ 1, 7 /) + generalized_departure(3, :) = (/ 4, 5 /) + generalized_departure(4, :) = (/ 4, 6 /) + generalized_departure(5, :) = (/ 4, 7 /) + generalized_departure(6, :) = (/ 5, 6 /) + generalized_departure(7, :) = (/ 5, 7 /) + generalized_departure(8, :) = (/ 6, 7 /) + + do k = 1, 8 + i = generalized_departure(k, 1) + j = generalized_departure(k, 2) + + dij(i, j, 1) = 1 + dij(i, j, 2) = 1 + dij(i, j, 3) = 1 + dij(i, j, 4) = 2 + dij(i, j, 5) = 2 + dij(i, j, 6) = 3 + dij(i, j, 7) = 3 + dij(i, j, 8) = 4 + dij(i, j, 9) = 4 + dij(i, j, 10) = 4 + + tij(i, j, 1) = 1.000d0 + tij(i, j, 2) = 1.550d0 + tij(i, j, 3) = 1.700d0 + tij(i, j, 4) = 0.250d0 + tij(i, j, 5) = 1.350d0 + tij(i, j, 6) = 0.000d0 + tij(i, j, 7) = 1.250d0 + tij(i, j, 8) = 0.000d0 + tij(i, j, 9) = 0.700d0 + tij(i, j, 10) = 5.400d0 + + nij(i, j, 1) = 0.25574776844118d1 + nij(i, j, 2) = - 0.79846357136353d1 + nij(i, j, 3) = 0.47859131465806d1 + nij(i, j, 4) = - 0.73265392369587 + nij(i, j, 5) = 0.13805471345312d1 + nij(i, j, 6) = 0.28349603476365d0 + nij(i, j, 7) = - 0.49087385940425d0 + nij(i, j, 8) = - 0.10291888921447d0 + nij(i, j, 9) = 0.11836314681968d0 + nij(i, j, 10) = 0.55527385721943d-4 + + Kpolij(i, j) = 10 + Kexpij(i, j) = 0 + + end do + + KPolij(1, 2) = 2 + KExpij(1, 2) = 7 + + KPolij(1, 3) = 3 + KExpij(1, 3) = 3 + + KPolij(1, 4) = 2 + KExpij(1, 4) = 10 + + KPolij(1, 5) = 5 + KExpij(1, 5) = 4 + + KPolij(2, 3) = 2 + KExpij(2, 3) = 4 + + KPolij(2, 4) = 3 + KExpij(2, 4) = 3 + + KPolij(1, 15) = 4 + KExpij(1, 15) = 0 + + n0i(1, 1) = 19.597508817d0 + n0i(1, 2) = - 83.959667892d0 + n0i(1, 3) = 3.00088d0 + n0i(1, 4) = 0.76315d0 + n0i(1, 5) = 0.00460d0 + n0i(1, 6) = 8.74432d0 + n0i(1, 7) = - 4.46921d0 + + n0i(2, 1) = 11.083407489d0 + n0i(2, 2) = - 22.202102428d0 + n0i(2, 3) = 2.50031d0 + n0i(2, 4) = 0.13732d0 + n0i(2, 5) = - 0.14660d0 + n0i(2, 6) = 0.90066d0 + n0i(2, 7) = 0.0d0 + + n0i(3, 1) = 11.925152758d0 + n0i(3, 2) = - 16.118762264d0 + n0i(3, 3) = 2.50002d0 + n0i(3, 4) = 2.04452d0 + n0i(3, 5) = - 1.06044d0 + n0i(3, 6) = 2.03366d0 + n0i(3, 7) = 0.01393d0 + + n0i(4, 1) = 24.675437527d0 + n0i(4, 2) = - 77.425313760d0 + n0i(4, 3) = 3.00263d0 + n0i(4, 4) = 4.33939d0 + n0i(4, 5) = 1.23722d0 + n0i(4, 6) = 13.19740d0 + n0i(4, 7) = - 6.01989d0 + + n0i(5, 1) = 31.602908195d0 + n0i(5, 2) = - 84.463284382d0 + n0i(5, 3) = 3.02939d0 + n0i(5, 4) = 6.60569d0 + n0i(5, 5) = 3.19700d0 + n0i(5, 6) = 19.19210d0 + n0i(5, 7) = - 8.37267d0 + + n0i(6, 1) = 20.884143364d0 + n0i(6, 2) = - 91.638478026d0 + n0i(6, 3) = 3.33944d0 + n0i(6, 4) = 9.44893d0 + n0i(6, 5) = 6.89406d0 + n0i(6, 6) = 24.46180d0 + n0i(6, 7) = 14.78240d0 + + n0i(7, 1) = 20.413726078d0 + n0i(7, 2) = - 94.467620036d0 + n0i(7, 3) = 3.06714d0 + n0i(7, 4) = 8.97575d0 + n0i(7, 5) = 5.25156d0 + n0i(7, 6) = 25.14230d0 + n0i(7, 7) = 16.13880d0 + + n0i(8, 1) = 14.536611217d0 + n0i(8, 2) = - 89.919548319d0 + n0i(8, 3) = 3.00000d0 + n0i(8, 4) = 8.95043d0 + n0i(8, 5) = 21.83600d0 + n0i(8, 6) = 33.40320d0 + n0i(8, 7) = 0.0d0 + + n0i(9, 1) = 15.449907693d0 + n0i(9, 2) = - 101.298172792d0 + n0i(9, 3) = 3.00000d0 + n0i(9, 4) = 11.76180d0 + n0i(9, 5) = 20.11010d0 + n0i(9, 6) = 33.16880d0 + n0i(9, 7) = 0.0d0 + + n0i(10, 1) = 14.345969349d0 + n0i(10, 2) = - 96.165722367d0 + n0i(10, 3) = 3.00000d0 + n0i(10, 4) = 11.69770d0 + n0i(10, 5) = 26.81420d0 + n0i(10, 6) = 38.61640d0 + n0i(10, 7) = 0.0d0 + + n0i(11, 1) = 15.063786601d0 + n0i(11, 2) = - 97.345252349d0 + n0i(11, 3) = 3.00000d0 + n0i(11, 4) = 13.72660d0 + n0i(11, 5) = 30.47070d0 + n0i(11, 6) = 43.55610d0 + n0i(11, 7) = 0.0d0 + + n0i(12, 1) = 15.864687161d0 + n0i(12, 2) = - 97.370667555d0 + n0i(12, 3) = 3.00000d0 + n0i(12, 4) = 15.68650d0 + n0i(12, 5) = 33.80290d0 + n0i(12, 6) = 48.17310d0 + n0i(12, 7) = 0.0d0 + + n0i(13, 1) = 16.313913248d0 + n0i(13, 2) = - 102.160247463d0 + n0i(13, 3) = 3.00000d0 + n0i(13, 4) = 18.02410d0 + n0i(13, 5) = 38.12350d0 + n0i(13, 6) = 53.34150d0 + n0i(13, 7) = 0.0d0 + + n0i(14, 1) = 15.870791919d0 + n0i(14, 2) = - 108.858547525d0 + n0i(14, 3) = 3.00000d0 + n0i(14, 4) = 21.00690d0 + n0i(14, 5) = 43.49310d0 + n0i(14, 6) = 58.36570d0 + n0i(14, 7) = 0.0d0 + + n0i(15, 1) = 13.796443393d0 + n0i(15, 2) = - 175.864487294d0 + n0i(15, 3) = 1.47906d0 + n0i(15, 4) = 0.95806d0 + n0i(15, 5) = 0.45444d0 + n0i(15, 6) = 1.56039d0 + n0i(15, 7) = 1.37560d0 + + n0i(16, 1) = 10.001843586d0 + n0i(16, 2) = - 14.996095135d0 + n0i(16, 3) = 2.50146d0 + n0i(16, 4) = 1.07558d0 + n0i(16, 5) = 1.01334d0 + n0i(16, 6) = 0.0d0 + n0i(16, 7) = 0.0d0 + + n0i(17, 1) = 10.813340744d0 + n0i(17, 2) = - 19.834733959d0 + n0i(17, 3) = 2.50055d0 + n0i(17, 4) = 1.02865d0 + n0i(17, 5) = 0.00493d0 + n0i(17, 6) = 0.0d0 + n0i(17, 7) = 0.0d0 + + n0i(18, 1) = 8.203520690d0 + n0i(18, 2) = - 11.996306443d0 + n0i(18, 3) = 3.00392d0 + n0i(18, 4) = 0.01059d0 + n0i(18, 5) = 0.98763d0 + n0i(18, 6) = 3.06904d0 + n0i(18, 7) = 0.0d0 + + n0i(19, 1) = 9.336197742d0 + n0i(19, 2) = - 16.266508995d0 + n0i(19, 3) = 3.00000d0 + n0i(19, 4) = 3.11942d0 + n0i(19, 5) = 1.00243d0 + n0i(19, 6) = 0.0d0 + n0i(19, 7) = 0.0d0 + + n0i(20, 1) = 13.628409737d0 + n0i(20, 2) = - 143.470759602d0 + n0i(20, 3) = 1.50000d0 + n0i(20, 4) = 0.0d0 + n0i(20, 5) = 0.0d0 + n0i(20, 6) = 0.0d0 + n0i(20, 7) = 0.0d0 + + n0i(21, 1) = 8.316631500d0 + n0i(21, 2) = - 4.946502600d0 + n0i(21, 3) = 1.50000d0 + n0i(21, 4) = 0.0d0 + n0i(21, 5) = 0.0d0 + n0i(21, 6) = 0.0d0 + n0i(21, 7) = 0.0d0 + + th0i(1, 4) = 4.306474465d0 + th0i(1, 5) = 0.936220902d0 + th0i(1, 6) = 5.577233895d0 + th0i(1, 7) = 5.722644361d0 + th0i(2, 4) = 5.251822620d0 + th0i(2, 5) = - 5.393067706d0 + th0i(2, 6) = 13.788988208d0 + th0i(2, 7) = 0.0d0 + th0i(3, 4) = 3.022758166d0 + th0i(3, 5) = - 2.844425476d0 + th0i(3, 6) = 1.589964364d0 + th0i(3, 7) = 1.121596090d0 + th0i(4, 4) = 1.831882406d0 + th0i(4, 5) = 0.731306621d0 + th0i(4, 6) = 3.378007481d0 + th0i(4, 7) = 3.508721939d0 + th0i(5, 4) = 1.297521801d0 + th0i(5, 5) = 0.543210978d0 + th0i(5, 6) = 2.583146083d0 + th0i(5, 7) = 2.777773271d0 + th0i(6, 4) = 1.101487798d0 + th0i(6, 5) = 0.431957660d0 + th0i(6, 6) = 4.502440459d0 + th0i(6, 7) = 2.124516319d0 + th0i(7, 4) = 1.074673199d0 + th0i(7, 5) = 0.485556021d0 + th0i(7, 6) = 4.671261865d0 + th0i(7, 7) = 2.191583480d0 + th0i(8, 4) = 0.380391739d0 + th0i(8, 5) = 1.789520971d0 + th0i(8, 6) = 3.777411113d0 + th0i(8, 7) = 0.0d0 + th0i(9, 4) = 0.635392636d0 + th0i(9, 5) = 1.977271641d0 + th0i(9, 6) = 4.169371131d0 + th0i(9, 7) = 0.0d0 + th0i(10, 4) = 0.359036667d0 + th0i(10, 5) = 1.691951873d0 + th0i(10, 6) = 3.596924107d0 + th0i(10, 7) = 0.0d0 + th0i(11, 4) = 0.314348398d0 + th0i(11, 5) = 1.548136560d0 + th0i(11, 6) = 3.259326458d0 + th0i(11, 7) = 0.0d0 + th0i(12, 4) = 0.279143540d0 + th0i(12, 5) = 1.431644769d0 + th0i(12, 6) = 2.973845992d0 + th0i(12, 7) = 0.0d0 + th0i(13, 4) = 0.263819696d0 + th0i(13, 5) = 1.370586158d0 + th0i(13, 6) = 2.848860483d0 + th0i(13, 7) = 0.0d0 + th0i(14, 4) = 0.267034159d0 + th0i(14, 5) = 1.353835195d0 + th0i(14, 6) = 2.833479035d0 + th0i(14, 7) = 0.0d0 + th0i(15, 4) = 6.891654113d0 + th0i(15, 5) = 9.847634830d0 + th0i(15, 6) = 49.765290750d0 + th0i(15, 7) = 50.367279301d0 + th0i(16, 4) = 14.461722565d0 + th0i(16, 5) = 7.223325463d0 + th0i(16, 6) = 0.0d0 + th0i(16, 7) = 0.0d0 + th0i(17, 4) = 11.669802800d0 + th0i(17, 5) = 5.302762306d0 + th0i(17, 6) = 0.0d0 + th0i(17, 7) = 0.0d0 + th0i(18, 4) = 0.415386589d0 + th0i(18, 5) = 1.763895929d0 + th0i(18, 6) = 3.874803739d0 + th0i(18, 7) = 0.0d0 + th0i(19, 4) = 4.914580541d0 + th0i(19, 5) = 2.270653980d0 + th0i(19, 6) = 0.0d0 + th0i(19, 7) = 0.0d0 + th0i(20, 4) = 0.0d0 + th0i(20, 5) = 0.0d0 + th0i(20, 6) = 0.0d0 + th0i(20, 7) = 0.0d0 + th0i(21, 4) = 0.0d0 + th0i(21, 5) = 0.0d0 + th0i(21, 6) = 0.0d0 + th0i(21, 7) = 0.0d0 + end subroutine get_params +end module parameters + +program main + use yaeos, only: pr, CubicEoS, SoaveRedlichKwong, CriticalLine, critical_line, EquilibriumState, critical_point + use YAEOS__MODELS_AR_GERG2008, only: Gerg2008, GERG2008PURE + use parameters, only: noik, doik, toik, coik, kpol, kexp, T_c, P_c, acentric_factor, rho_c, & + Bv, Gv, Bt, Gt, & + Kpolij, Kexpij, nij, dij, tij, ethaij, epsij, betaij, gammaij, fij, & + get_params + + implicit none + type(GERG2008PURE) :: pures(2) + type(Gerg2008) :: model + type(CubicEoS) :: cubic + type(CriticalLine) :: cl + type(EquilibriumState) :: cp + + real(pr) :: Tc(2), Pc(2), w(2) + real(pr) :: n(2), v, t, n0(2) + real(pr) :: ar, arv, arv2 + real(pr) :: art, art2, artv + real(pr) :: arvn(2), artn(2), arn(2), arn2(2,2) + real(pr) :: f1, f2, f3, f4, dx + real(pr) :: z0(2) = [1, 0] + real(pr) :: zi(2) = [0, 1] + integer :: i, j, ikpol, ikexp + integer :: comps(2) = [1, 4] + + call get_params() + Tc = [T_c(comps(1)), T_c(comps(2))] + Pc = [P_c(comps(1)), P_c(comps(2))]/1e5 + w = [acentric_factor(comps(1)), acentric_factor(comps(2))] + + cubic = SoaveRedlichKwong(Tc, Pc, w) + + model%components%Tc = Tc + model%components%Pc = Pc + model%components%w = w + model%components%vc = 1./[rho_c(comps(1)), rho_c(comps(2))] + model%srk = cubic + + do i=1,2 + pures(i)%kpol = kpol(comps(i)) + pures(i)%kexp = kexp(comps(i)) + pures(i)%n = noik(comps(i), :) + pures(i)%d = doik(comps(i), :) + pures(i)%t = toik(comps(i), :) + pures(i)%c = coik(comps(i), kpol(comps(i))+1:kexp(comps(i))+kpol(comps(i))) + end do + + allocate(model%binaries(2,2)) + + do i=1,2 + do j=i+1,2 + model%binaries(i, j)%Bt = Bt(comps(i), comps(j)) + model%binaries(i, j)%Gt = Gt(comps(i), comps(j)) + model%binaries(i, j)%Bv = Bv(comps(i), comps(j)) + model%binaries(i, j)%Gv = Gv(comps(i), comps(j)) + + ikpol = Kpolij(comps(i), comps(j)) + ikexp = Kexpij(comps(i), comps(j)) + + model%binaries(i, j)%Kpolij = Kpolij(comps(i), comps(j)) + model%binaries(i, j)%Kexpij = Kexpij(comps(i), comps(j)) + + model%binaries(i, j)%nij = nij(comps(i), comps(j), :ikexp+ikpol) + model%binaries(i, j)%dij = dij(comps(i), comps(j), :ikexp+ikpol) + model%binaries(i, j)%tij = tij(comps(i), comps(j), :ikexp+ikpol) + model%binaries(i, j)%ethaij = ethaij(comps(i), comps(j), ikpol+1:ikexp+ikpol) + model%binaries(i, j)%epsij = epsij(comps(i), comps(j), ikpol+1:ikexp+ikpol) + model%binaries(i, j)%betaij = betaij(comps(i), comps(j), ikpol+1:ikexp+ikpol) + model%binaries(i, j)%gammaij = gammaij(comps(i), comps(j), ikpol+1:ikexp+ikpol) + model%binaries%Fij = Fij(comps(i), comps(j)) + + model%binaries(j, i) = model%binaries(i, j) + end do + end do + + + model%pures = pures + + n = [0.5, 0.5] + + v = 1 + T = 250 + + call cubic%residual_helmholtz(n, v, t, ar=ar, arv=arv, art=art, artv=artv, arv2=arv2, art2=art2, arn=arn, arvn=arvn, artn=artn, arn2=arn2) + print *, "srk: ", ar, arv, arv2, arn + + call model%residual_helmholtz(n, v, t, ar=ar, arv=arv, art=art, artv=artv, arv2=arv2, art2=art2, arn=arn, arvn=arvn, artn=artn, arn2=arn2) + print *, "greg: ", ar, arv, arv2, arn, arn2 + + dx = 0.01 + + n = [0.5, 0.5] + [dx, 0._pr] + call model%residual_helmholtz(n, v, t, ar=f2, arv=arv, art=art, artv=artv, arv2=arv2, art2=art2, arn=arn, arvn=arvn, artn=artn, arn2=arn2) + + n = [0.5, 0.5] - [dx, 0._pr] + call model%residual_helmholtz(n, v, t, ar=f1, arv=arv, art=art, artv=artv, arv2=arv2, art2=art2, arn=arn, arvn=arvn, artn=artn, arn2=arn2) + print *, (f2 - f1)/(2*dx), (f2 - 2*ar + f1)/(dx**2) + + n = [0.5, 0.5] + [0._pr, dx] + call model%residual_helmholtz(n, v, t, ar=f2, arv=arv, art=art, artv=artv, arv2=arv2, art2=art2, arn=arn, arvn=arvn, artn=artn, arn2=arn2) + + n = [0.5, 0.5] - [0._pr, dx] + call model%residual_helmholtz(n, v, t, ar=f1, arv=arv, art=art, artv=artv, arv2=arv2, art2=art2, arn=arn, arvn=arvn, artn=artn, arn2=arn2) + print *, (f2 - f1)/(2*dx) + + ! ============================================================== + ! second order + ! -------------------------------------------------------------- + dx = 0.00001 + n0 = [0.9, 0.5] + n = n0 + call model%residual_helmholtz(n, v, t, ar=ar, arv=arv, art=art, artv=artv, arv2=arv2, art2=art2, arn=arn, arvn=arvn, artn=artn, arn2=arn2) + n = n0 + [dx, dx] + call model%residual_helmholtz(n, v, t, ar=f1, arv=arv, art=art, artv=artv, arv2=arv2, art2=art2, arn=arn, arvn=arvn, artn=artn, arn2=arn2) + n = n0 + [dx, -dx] + call model%residual_helmholtz(n, v, t, ar=f2, arv=arv, art=art, artv=artv, arv2=arv2, art2=art2, arn=arn, arvn=arvn, artn=artn, arn2=arn2) + n = n0 + [-dx, dx] + call model%residual_helmholtz(n, v, t, ar=f3, arv=arv, art=art, artv=artv, arv2=arv2, art2=art2, arn=arn, arvn=arvn, artn=artn, arn2=arn2) + n = n0 + [-dx, -dx] + call model%residual_helmholtz(n, v, t, ar=f4, arv=arv, art=art, artv=artv, arv2=arv2, art2=art2, arn=arn, arvn=arvn, artn=artn, arn2=arn2) + print *, (f1 - f2 - f3 + f4)/(4*dx**2), arn2(1, 2) + + + call model%volume(n, 1.0_pr, T, f1, root_type="stable") + call cubic%volume(n, 1.0_pr, T, f2, root_type="stable") + + cp = critical_point(model, z0, zi, 1, 0.01_pr, 1000) + print *, cp%iters + ! cl = critical_line(model, a0=0.999_pr, z0=z0, zi=zi, ns=1, S=0.9_pr, dS0=-0.01_pr) + + ! do i=1,size(cl%a) + ! print *, cl%a(i), cl%T(i), cl%P(i) + ! end do +end program main