Skip to content

Commit

Permalink
MAINT/FIX: add ps/es returns for gr4_ri and gr5_ri (#335)
Browse files Browse the repository at this point in the history 
* fix ps/es gr-ri

* modification of ri-production signature

* Update the diff baseline from the main baseline

---------

Co-authored-by: Apolline Elbaz <[email protected]>
Co-authored-by: Francois Colleoni <[email protected]>
  • Loading branch information
@asjeb @inoelloc
3 people authored Oct 1, 2024
1 parent 4989cae commit 27c8dae
Show file tree
Hide file tree
Showing 5 changed files with 194 additions and 176 deletions.
62 changes: 36 additions & 26 deletions smash/fcore/forward/forward_db.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13492,17 +13492,17 @@ END SUBROUTINE GR_PRODUCTION
! variations of useful results: hp perc pr
! with respect to varying inputs: alpha1 hp en cp pn
SUBROUTINE GR_RI_PRODUCTION_D(pn, pn_d, en, en_d, cp, cp_d, beta, &
& alpha1, alpha1_d, hp, hp_d, pr, pr_d, perc, perc_d, dt)
& alpha1, alpha1_d, hp, hp_d, pr, pr_d, perc, perc_d, ps, es, dt)
IMPLICIT NONE
REAL(sp), INTENT(IN) :: pn, en, cp, beta, alpha1
REAL(sp), INTENT(IN) :: pn_d, en_d, cp_d, alpha1_d
REAL(sp), INTENT(IN) :: dt
REAL(sp), INTENT(INOUT) :: hp
REAL(sp), INTENT(INOUT) :: hp_d
REAL(sp), INTENT(OUT) :: pr, perc
REAL(sp), INTENT(OUT) :: pr, perc, ps, es
REAL(sp), INTENT(OUT) :: pr_d, perc_d
REAL(sp) :: inv_cp, ps, es, hp_imd
REAL(sp) :: inv_cp_d, ps_d, es_d, hp_imd_d
REAL(sp) :: inv_cp, hp_imd
REAL(sp) :: inv_cp_d, hp_imd_d
REAL(sp) :: lambda, gam, inv_lambda
REAL(sp) :: lambda_d, gam_d, inv_lambda_d
INTRINSIC EXP
Expand All @@ -13522,6 +13522,8 @@ SUBROUTINE GR_RI_PRODUCTION_D(pn, pn_d, en, en_d, cp, cp_d, beta, &
REAL(sp) :: temp2
REAL(sp) :: temp3
REAL(sp) :: temp4
REAL(sp) :: ps_d
REAL(sp) :: es_d
inv_cp_d = -(cp_d/cp**2)
inv_cp = 1._sp/cp
pr = 0._sp
Expand Down Expand Up @@ -13582,17 +13584,17 @@ END SUBROUTINE GR_RI_PRODUCTION_D
! gradient of useful results: alpha1 hp cp pn perc pr
! with respect to varying inputs: alpha1 hp en cp pn
SUBROUTINE GR_RI_PRODUCTION_B(pn, pn_b, en, en_b, cp, cp_b, beta, &
& alpha1, alpha1_b, hp, hp_b, pr, pr_b, perc, perc_b, dt)
& alpha1, alpha1_b, hp, hp_b, pr, pr_b, perc, perc_b, ps, es, dt)
IMPLICIT NONE
REAL(sp), INTENT(IN) :: pn, en, cp, beta, alpha1
REAL(sp) :: pn_b, en_b, cp_b, alpha1_b
REAL(sp), INTENT(IN) :: dt
REAL(sp), INTENT(INOUT) :: hp
REAL(sp), INTENT(INOUT) :: hp_b
REAL(sp) :: pr, perc
REAL(sp) :: pr, perc, ps, es
REAL(sp) :: pr_b, perc_b
REAL(sp) :: inv_cp, ps, es, hp_imd
REAL(sp) :: inv_cp_b, ps_b, es_b, hp_imd_b
REAL(sp) :: inv_cp, hp_imd
REAL(sp) :: inv_cp_b, hp_imd_b
REAL(sp) :: lambda, gam, inv_lambda
REAL(sp) :: lambda_b, gam_b, inv_lambda_b
INTRINSIC EXP
Expand Down Expand Up @@ -13620,6 +13622,8 @@ SUBROUTINE GR_RI_PRODUCTION_B(pn, pn_b, en, en_b, cp, cp_b, beta, &
REAL(sp) :: temp_b4
REAL(sp) :: temp_b5
INTEGER :: branch
REAL(sp) :: ps_b
REAL(sp) :: es_b
inv_cp = 1._sp/cp
gam = 1._sp - EXP(-(pn*alpha1))
lambda = SQRT(1._sp - gam)
Expand Down Expand Up @@ -13707,14 +13711,14 @@ SUBROUTINE GR_RI_PRODUCTION_B(pn, pn_b, en, en_b, cp, cp_b, beta, &
alpha1_b = alpha1_b - pn*temp_b
END SUBROUTINE GR_RI_PRODUCTION_B

SUBROUTINE GR_RI_PRODUCTION(pn, en, cp, beta, alpha1, hp, pr, perc, dt&
& )
SUBROUTINE GR_RI_PRODUCTION(pn, en, cp, beta, alpha1, hp, pr, perc, ps&
& , es, dt)
IMPLICIT NONE
REAL(sp), INTENT(IN) :: pn, en, cp, beta, alpha1
REAL(sp), INTENT(IN) :: dt
REAL(sp), INTENT(INOUT) :: hp
REAL(sp), INTENT(OUT) :: pr, perc
REAL(sp) :: inv_cp, ps, es, hp_imd
REAL(sp), INTENT(OUT) :: pr, perc, ps, es
REAL(sp) :: inv_cp, hp_imd
REAL(sp) :: lambda, gam, inv_lambda
INTRINSIC EXP
INTRINSIC SQRT
Expand Down Expand Up @@ -15666,7 +15670,8 @@ SUBROUTINE GR4_RI_TIME_STEP_D(setup, mesh, input_data, options, &
REAL(sp), DIMENSION(mesh%nac) :: ac_prcp, ac_pet
REAL(sp), DIMENSION(mesh%nac) :: ac_prcp_d
INTEGER :: row, col, k, time_step_returns
REAL(sp) :: beta, pn, en, pr, perc, l, prr, prd, qr, qd, split
REAL(sp) :: beta, pn, en, pr, perc, ps, es, l, prr, prd, qr, qd, &
& split
REAL(sp) :: pn_d, en_d, pr_d, perc_d, l_d, prr_d, prd_d, qr_d, qd_d&
& , split_d
INTRINSIC TANH
Expand All @@ -15693,7 +15698,7 @@ SUBROUTINE GR4_RI_TIME_STEP_D(setup, mesh, input_data, options, &
CALL GR_RI_PRODUCTION_D(pn, pn_d, en, en_d, ac_cp(k), &
& ac_cp_d(k), beta, ac_alpha1(k), &
& ac_alpha1_d(k), ac_hp(k), ac_hp_d(k), pr, &
& pr_d, perc, perc_d, setup%dt)
& pr_d, perc, perc_d, ps, es, setup%dt)
CALL GR_EXCHANGE_D(0._sp, 0.0_4, ac_kexc(k), ac_kexc_d(k), &
& ac_ht(k), ac_ht_d(k), l, l_d)
ELSE
Expand Down Expand Up @@ -15764,7 +15769,8 @@ SUBROUTINE GR4_RI_TIME_STEP_B(setup, mesh, input_data, options, &
REAL(sp), DIMENSION(mesh%nac) :: ac_prcp, ac_pet
REAL(sp), DIMENSION(mesh%nac) :: ac_prcp_b
INTEGER :: row, col, k, time_step_returns
REAL(sp) :: beta, pn, en, pr, perc, l, prr, prd, qr, qd, split
REAL(sp) :: beta, pn, en, pr, perc, ps, es, l, prr, prd, qr, qd, &
& split
REAL(sp) :: pn_b, en_b, pr_b, perc_b, l_b, prr_b, prd_b, qr_b, qd_b&
& , split_b
INTRINSIC TANH
Expand Down Expand Up @@ -15796,7 +15802,7 @@ SUBROUTINE GR4_RI_TIME_STEP_B(setup, mesh, input_data, options, &
CALL PUSHREAL4(pr)
CALL PUSHREAL4(ac_hp(k))
CALL GR_RI_PRODUCTION(pn, en, ac_cp(k), beta, ac_alpha1(k), &
& ac_hp(k), pr, perc, setup%dt)
& ac_hp(k), pr, perc, ps, es, setup%dt)
CALL GR_EXCHANGE(0._sp, ac_kexc(k), ac_ht(k), l)
CALL PUSHCONTROL1B(1)
ELSE
Expand Down Expand Up @@ -15870,7 +15876,7 @@ SUBROUTINE GR4_RI_TIME_STEP_B(setup, mesh, input_data, options, &
CALL GR_RI_PRODUCTION_B(pn, pn_b, en, en_b, ac_cp(k), &
& ac_cp_b(k), beta, ac_alpha1(k), &
& ac_alpha1_b(k), ac_hp(k), ac_hp_b(k), pr, &
& pr_b, perc, perc_b, setup%dt)
& pr_b, perc, perc_b, ps, es, setup%dt)
CALL POPREAL4(ac_hi(k))
CALL POPREAL4(pn)
CALL POPREAL4(en)
Expand Down Expand Up @@ -15903,7 +15909,8 @@ SUBROUTINE GR4_RI_TIME_STEP(setup, mesh, input_data, options, returns&
REAL(sp), DIMENSION(mesh%nac), INTENT(INOUT) :: ac_qt
REAL(sp), DIMENSION(mesh%nac) :: ac_prcp, ac_pet
INTEGER :: row, col, k, time_step_returns
REAL(sp) :: beta, pn, en, pr, perc, l, prr, prd, qr, qd, split
REAL(sp) :: beta, pn, en, pr, perc, ps, es, l, prr, prd, qr, qd, &
& split
INTRINSIC TANH
INTRINSIC MAX
CALL GET_AC_ATMOS_DATA_TIME_STEP(setup, mesh, input_data, time_step&
Expand All @@ -15922,7 +15929,7 @@ SUBROUTINE GR4_RI_TIME_STEP(setup, mesh, input_data, options, returns&
CALL GR_INTERCEPTION(ac_prcp(k), ac_pet(k), ac_ci(k), ac_hi(&
& k), pn, en)
CALL GR_RI_PRODUCTION(pn, en, ac_cp(k), beta, ac_alpha1(k), &
& ac_hp(k), pr, perc, setup%dt)
& ac_hp(k), pr, perc, ps, es, setup%dt)
CALL GR_EXCHANGE(0._sp, ac_kexc(k), ac_ht(k), l)
ELSE
pr = 0._sp
Expand Down Expand Up @@ -17479,7 +17486,8 @@ SUBROUTINE GR5_RI_TIME_STEP_D(setup, mesh, input_data, options, &
REAL(sp), DIMENSION(mesh%nac) :: ac_prcp, ac_pet
REAL(sp), DIMENSION(mesh%nac) :: ac_prcp_d
INTEGER :: row, col, k, time_step_returns
REAL(sp) :: beta, pn, en, pr, perc, l, prr, prd, qr, qd, split
REAL(sp) :: beta, pn, en, pr, perc, ps, es, l, prr, prd, qr, qd, &
& split
REAL(sp) :: pn_d, en_d, pr_d, perc_d, l_d, prr_d, prd_d, qr_d, qd_d&
& , split_d
INTRINSIC TANH
Expand All @@ -17506,7 +17514,7 @@ SUBROUTINE GR5_RI_TIME_STEP_D(setup, mesh, input_data, options, &
CALL GR_RI_PRODUCTION_D(pn, pn_d, en, en_d, ac_cp(k), &
& ac_cp_d(k), beta, ac_alpha1(k), &
& ac_alpha1_d(k), ac_hp(k), ac_hp_d(k), pr, &
& pr_d, perc, perc_d, setup%dt)
& pr_d, perc, perc_d, ps, es, setup%dt)
CALL GR_THRESHOLD_EXCHANGE_D(0._sp, 0.0_4, ac_kexc(k), &
& ac_kexc_d(k), ac_aexc(k), ac_aexc_d(k&
& ), ac_ht(k), ac_ht_d(k), l, l_d)
Expand Down Expand Up @@ -17578,7 +17586,8 @@ SUBROUTINE GR5_RI_TIME_STEP_B(setup, mesh, input_data, options, &
REAL(sp), DIMENSION(mesh%nac) :: ac_prcp, ac_pet
REAL(sp), DIMENSION(mesh%nac) :: ac_prcp_b
INTEGER :: row, col, k, time_step_returns
REAL(sp) :: beta, pn, en, pr, perc, l, prr, prd, qr, qd, split
REAL(sp) :: beta, pn, en, pr, perc, ps, es, l, prr, prd, qr, qd, &
& split
REAL(sp) :: pn_b, en_b, pr_b, perc_b, l_b, prr_b, prd_b, qr_b, qd_b&
& , split_b
INTRINSIC TANH
Expand Down Expand Up @@ -17610,7 +17619,7 @@ SUBROUTINE GR5_RI_TIME_STEP_B(setup, mesh, input_data, options, &
CALL PUSHREAL4(pr)
CALL PUSHREAL4(ac_hp(k))
CALL GR_RI_PRODUCTION(pn, en, ac_cp(k), beta, ac_alpha1(k), &
& ac_hp(k), pr, perc, setup%dt)
& ac_hp(k), pr, perc, ps, es, setup%dt)
CALL GR_THRESHOLD_EXCHANGE(0._sp, ac_kexc(k), ac_aexc(k), &
& ac_ht(k), l)
CALL PUSHCONTROL1B(1)
Expand Down Expand Up @@ -17686,7 +17695,7 @@ SUBROUTINE GR5_RI_TIME_STEP_B(setup, mesh, input_data, options, &
CALL GR_RI_PRODUCTION_B(pn, pn_b, en, en_b, ac_cp(k), &
& ac_cp_b(k), beta, ac_alpha1(k), &
& ac_alpha1_b(k), ac_hp(k), ac_hp_b(k), pr, &
& pr_b, perc, perc_b, setup%dt)
& pr_b, perc, perc_b, ps, es, setup%dt)
CALL POPREAL4(ac_hi(k))
CALL POPREAL4(pn)
CALL POPREAL4(en)
Expand Down Expand Up @@ -17719,7 +17728,8 @@ SUBROUTINE GR5_RI_TIME_STEP(setup, mesh, input_data, options, returns&
REAL(sp), DIMENSION(mesh%nac), INTENT(INOUT) :: ac_qt
REAL(sp), DIMENSION(mesh%nac) :: ac_prcp, ac_pet
INTEGER :: row, col, k, time_step_returns
REAL(sp) :: beta, pn, en, pr, perc, l, prr, prd, qr, qd, split
REAL(sp) :: beta, pn, en, pr, perc, ps, es, l, prr, prd, qr, qd, &
& split
INTRINSIC TANH
INTRINSIC MAX
CALL GET_AC_ATMOS_DATA_TIME_STEP(setup, mesh, input_data, time_step&
Expand All @@ -17738,7 +17748,7 @@ SUBROUTINE GR5_RI_TIME_STEP(setup, mesh, input_data, options, returns&
CALL GR_INTERCEPTION(ac_prcp(k), ac_pet(k), ac_ci(k), ac_hi(&
& k), pn, en)
CALL GR_RI_PRODUCTION(pn, en, ac_cp(k), beta, ac_alpha1(k), &
& ac_hp(k), pr, perc, setup%dt)
& ac_hp(k), pr, perc, ps, es, setup%dt)
CALL GR_THRESHOLD_EXCHANGE(0._sp, ac_kexc(k), ac_aexc(k), &
& ac_ht(k), l)
ELSE
Expand Down
Loading

0 comments on commit 27c8dae

Please sign in to comment.