fix ps/es gr-ri

DassHydro · Sep 27, 2024 · 88962c2 · 88962c2
1 parent 4989cae
commit 88962c2
Show file tree

Hide file tree

Showing 5 changed files with 148 additions and 130 deletions.
diff --git a/smash/fcore/forward/forward_db.f90 b/smash/fcore/forward/forward_db.f90
@@ -15666,7 +15666,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
@@ -15764,7 +15765,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
@@ -15903,7 +15905,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&
@@ -17479,7 +17482,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
@@ -17578,7 +17582,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
@@ -17719,7 +17724,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&

diff --git a/smash/fcore/forward/forward_openmp_db.f90 b/smash/fcore/forward/forward_openmp_db.f90
@@ -15852,7 +15852,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
@@ -15871,9 +15872,9 @@ SUBROUTINE GR4_RI_TIME_STEP_D(setup, mesh, input_data, options, &
 !$OMP&returns, ac_prcp, ac_pet, ac_ci, ac_cp, beta, ac_ct, ac_kexc, &
 !$OMP&ac_hi, ac_hp, ac_ht, ac_qt), SHARED(ac_prcp_d, ac_ci_d, ac_cp_d, &
 !$OMP&ac_ct_d, ac_kexc_d, ac_hi_d, ac_hp_d, ac_ht_d, ac_qt_d), PRIVATE(&
-!$OMP&row, col, k, time_step_returns, pn, en, pr, perc, l, prr, prd, qr&
-!$OMP&, qd, split), PRIVATE(pn_d, en_d, pr_d, perc_d, l_d, prr_d, prd_d&
-!$OMP&, qr_d, qd_d, split_d), PRIVATE(temp), SCHEDULE(static)
+!$OMP&row, col, k, time_step_returns, pn, en, pr, perc, ps, es, l, prr, &
+!$OMP&prd, qr, qd, split), PRIVATE(pn_d, en_d, pr_d, perc_d, l_d, prr_d&
+!$OMP&, prd_d, qr_d, qd_d, split_d), PRIVATE(temp), SCHEDULE(static)
     DO col=1,mesh%ncol
       DO row=1,mesh%nrow
         IF (.NOT.(mesh%active_cell(row, col) .EQ. 0 .OR. mesh%&
@@ -15957,7 +15958,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
@@ -15977,8 +15979,8 @@ SUBROUTINE GR4_RI_TIME_STEP_B(setup, mesh, input_data, options, &
 !$OMP PARALLEL NUM_THREADS(options%comm%ncpu), SHARED(setup, mesh, &
 !$OMP&returns, ac_prcp, ac_pet, ac_ci, ac_cp, beta, ac_ct, ac_kexc, &
 !$OMP&ac_hi, ac_hp, ac_ht, ac_qt), PRIVATE(row, col, k, &
-!$OMP&time_step_returns, pn, en, pr, perc, l, prr, prd, qr, qd, split), &
-!$OMP&PRIVATE(chunk_start, chunk_end)
+!$OMP&time_step_returns, pn, en, pr, perc, ps, es, l, prr, prd, qr, qd, &
+!$OMP&split), PRIVATE(chunk_start, chunk_end)
     CALL GETSTATICSCHEDULE(1, mesh%ncol, 1, chunk_start, chunk_end)
     DO col=chunk_start,chunk_end
       DO row=1,mesh%nrow
@@ -16038,10 +16040,10 @@ SUBROUTINE GR4_RI_TIME_STEP_B(setup, mesh, input_data, options, &
 !$OMP&returns, ac_prcp, ac_pet, ac_ci, ac_cp, beta, ac_ct, ac_kexc, &
 !$OMP&ac_hi, ac_hp, ac_ht, ac_qt), SHARED(ac_prcp_b, ac_ci_b, ac_cp_b, &
 !$OMP&ac_ct_b, ac_kexc_b, ac_hi_b, ac_hp_b, ac_ht_b, ac_qt_b), PRIVATE(&
-!$OMP&row, col, k, time_step_returns, pn, en, pr, perc, l, prr, prd, qr&
-!$OMP&, qd, split), PRIVATE(pn_b, en_b, pr_b, perc_b, l_b, prr_b, prd_b&
-!$OMP&, qr_b, qd_b, split_b), PRIVATE(branch, chunk_end, chunk_start), &
-!$OMP&PRIVATE(temp_b)
+!$OMP&row, col, k, time_step_returns, pn, en, pr, perc, ps, es, l, prr, &
+!$OMP&prd, qr, qd, split), PRIVATE(pn_b, en_b, pr_b, perc_b, l_b, prr_b&
+!$OMP&, prd_b, qr_b, qd_b, split_b), PRIVATE(branch, chunk_end, &
+!$OMP&chunk_start), PRIVATE(temp_b)
     CALL POPREAL4(en)
     CALL POPREAL4(split)
     CALL POPREAL4(prr)
@@ -16139,7 +16141,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&
@@ -16152,8 +16155,8 @@ SUBROUTINE GR4_RI_TIME_STEP(setup, mesh, input_data, options, returns&
 !$OMP PARALLEL DO NUM_THREADS(options%comm%ncpu), SHARED(setup, mesh, &
 !$OMP&returns, ac_prcp, ac_pet, ac_ci, ac_cp, beta, ac_ct, ac_kexc, &
 !$OMP&ac_hi, ac_hp, ac_ht, ac_qt), PRIVATE(row, col, k, &
-!$OMP&time_step_returns, pn, en, pr, perc, l, prr, prd, qr, qd, split), &
-!$OMP&                                                  SCHEDULE(static)
+!$OMP&time_step_returns, pn, en, pr, perc, ps, es, l, prr, prd, qr, qd, &
+!$OMP&split), SCHEDULE(static)
     DO col=1,mesh%ncol
       DO row=1,mesh%nrow
         IF (.NOT.(mesh%active_cell(row, col) .EQ. 0 .OR. mesh%&
@@ -17903,7 +17906,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
@@ -17923,9 +17927,9 @@ SUBROUTINE GR5_RI_TIME_STEP_D(setup, mesh, input_data, options, &
 !$OMP&, ac_ct, ac_kexc, ac_aexc, ac_hi, ac_hp, ac_ht, ac_qt), SHARED(&
 !$OMP&ac_prcp_d, ac_ci_d, ac_cp_d, ac_alpha1_d, ac_alpha2_d, ac_ct_d, &
 !$OMP&ac_kexc_d, ac_aexc_d, ac_hi_d, ac_hp_d, ac_ht_d, ac_qt_d), PRIVATE&
-!$OMP&(row, col, k, time_step_returns, pn, en, pr, perc, l, prr, prd, qr&
-!$OMP&, qd, split), PRIVATE(pn_d, en_d, pr_d, perc_d, l_d, prr_d, prd_d&
-!$OMP&, qr_d, qd_d, split_d), PRIVATE(temp), SCHEDULE(static)
+!$OMP&(row, col, k, time_step_returns, pn, en, pr, perc, ps, es, l, prr&
+!$OMP&, prd, qr, qd, split), PRIVATE(pn_d, en_d, pr_d, perc_d, l_d, &
+!$OMP&prr_d, prd_d, qr_d, qd_d, split_d), PRIVATE(temp), SCHEDULE(static)
     DO col=1,mesh%ncol
       DO row=1,mesh%nrow
         IF (.NOT.(mesh%active_cell(row, col) .EQ. 0 .OR. mesh%&
@@ -18010,7 +18014,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
@@ -18030,8 +18035,8 @@ SUBROUTINE GR5_RI_TIME_STEP_B(setup, mesh, input_data, options, &
 !$OMP PARALLEL NUM_THREADS(options%comm%ncpu), SHARED(setup, mesh, &
 !$OMP&returns, ac_prcp, ac_pet, ac_ci, ac_cp, beta, ac_alpha1, ac_alpha2&
 !$OMP&, ac_ct, ac_kexc, ac_aexc, ac_hi, ac_hp, ac_ht, ac_qt), PRIVATE(&
-!$OMP&row, col, k, time_step_returns, pn, en, pr, perc, l, prr, prd, qr&
-!$OMP&, qd, split), PRIVATE(chunk_start, chunk_end)
+!$OMP&row, col, k, time_step_returns, pn, en, pr, perc, ps, es, l, prr, &
+!$OMP&prd, qr, qd, split), PRIVATE(chunk_start, chunk_end)
     CALL GETSTATICSCHEDULE(1, mesh%ncol, 1, chunk_start, chunk_end)
     DO col=chunk_start,chunk_end
       DO row=1,mesh%nrow
@@ -18093,10 +18098,10 @@ SUBROUTINE GR5_RI_TIME_STEP_B(setup, mesh, input_data, options, &
 !$OMP&, ac_ct, ac_kexc, ac_aexc, ac_hi, ac_hp, ac_ht, ac_qt), SHARED(&
 !$OMP&ac_prcp_b, ac_ci_b, ac_cp_b, ac_alpha1_b, ac_alpha2_b, ac_ct_b, &
 !$OMP&ac_kexc_b, ac_aexc_b, ac_hi_b, ac_hp_b, ac_ht_b, ac_qt_b), PRIVATE&
-!$OMP&(row, col, k, time_step_returns, pn, en, pr, perc, l, prr, prd, qr&
-!$OMP&, qd, split), PRIVATE(pn_b, en_b, pr_b, perc_b, l_b, prr_b, prd_b&
-!$OMP&, qr_b, qd_b, split_b), PRIVATE(branch, chunk_end, chunk_start), &
-!$OMP&PRIVATE(temp_b)
+!$OMP&(row, col, k, time_step_returns, pn, en, pr, perc, ps, es, l, prr&
+!$OMP&, prd, qr, qd, split), PRIVATE(pn_b, en_b, pr_b, perc_b, l_b, &
+!$OMP&prr_b, prd_b, qr_b, qd_b, split_b), PRIVATE(branch, chunk_end, &
+!$OMP&chunk_start), PRIVATE(temp_b)
     CALL POPREAL4(en)
     CALL POPREAL4(split)
     CALL POPREAL4(prr)
@@ -18195,7 +18200,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&
@@ -18208,8 +18214,8 @@ SUBROUTINE GR5_RI_TIME_STEP(setup, mesh, input_data, options, returns&
 !$OMP PARALLEL DO NUM_THREADS(options%comm%ncpu), SHARED(setup, mesh, &
 !$OMP&returns, ac_prcp, ac_pet, ac_ci, ac_cp, beta, ac_alpha1, ac_alpha2&
 !$OMP&, ac_ct, ac_kexc, ac_aexc, ac_hi, ac_hp, ac_ht, ac_qt), PRIVATE(&
-!$OMP&row, col, k, time_step_returns, pn, en, pr, perc, l, prr, prd, qr&
-!$OMP&, qd, split), SCHEDULE(static)
+!$OMP&row, col, k, time_step_returns, pn, en, pr, perc, ps, es, l, prr, &
+!$OMP&prd, qr, qd, split), SCHEDULE(static)
     DO col=1,mesh%ncol
       DO row=1,mesh%nrow
         IF (.NOT.(mesh%active_cell(row, col) .EQ. 0 .OR. mesh%&

diff --git a/smash/fcore/operator/md_gr_operator.f90 b/smash/fcore/operator/md_gr_operator.f90
@@ -602,7 +602,7 @@ subroutine gr4_ri_time_step(setup, mesh, input_data, options, returns, time_step
 
         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
 
         call get_ac_atmos_data_time_step(setup, mesh, input_data, time_step, "prcp", ac_prcp)
         call get_ac_atmos_data_time_step(setup, mesh, input_data, time_step, "pet", ac_pet)
@@ -615,7 +615,7 @@ subroutine gr4_ri_time_step(setup, mesh, input_data, options, returns, time_step
         !$OMP parallel do schedule(static) num_threads(options%comm%ncpu) &
         !$OMP& shared(setup, mesh, returns, ac_prcp, ac_pet, ac_ci, ac_cp, beta, &
         !$OMP&  ac_ct, ac_kexc, ac_hi, ac_hp, ac_ht, ac_qt) &
-        !$OMP& private(row, col, k, time_step_returns, pn, en, pr, perc, l, prr, prd, qr, qd, split)
+        !$OMP& private(row, col, k, time_step_returns, pn, en, pr, perc, ps, es, l, prr, prd, qr, qd, split)
 #endif
         do col = 1, mesh%ncol
             do row = 1, mesh%nrow
@@ -668,7 +668,7 @@ subroutine gr4_ri_time_step(setup, mesh, input_data, options, returns, time_step
                                 col, &
                                 time_step_returns, &
                                 setup%n_snow_fluxes + 1:setup%n_snow_fluxes + setup%n_hydro_fluxes &
-                                ) = (/pn, en, pr, perc, l, prr, prd, qr, qd, ac_qt(k)/)
+                                ) = (/pn, en, pr, perc, ps, es, l, prr, prd, qr, qd, ac_qt(k)/)
                         end if
                     end if
                 end if
@@ -1178,7 +1178,7 @@ subroutine gr5_ri_time_step(setup, mesh, input_data, options, returns, time_step
 
         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
 
         call get_ac_atmos_data_time_step(setup, mesh, input_data, time_step, "prcp", ac_prcp)
         call get_ac_atmos_data_time_step(setup, mesh, input_data, time_step, "pet", ac_pet)
@@ -1192,7 +1192,7 @@ subroutine gr5_ri_time_step(setup, mesh, input_data, options, returns, time_step
         !$OMP parallel do schedule(static) num_threads(options%comm%ncpu) &
         !$OMP& shared(setup, mesh, returns, ac_prcp, ac_pet, ac_ci, ac_cp, beta, &
         !$OMP& ac_alpha1, ac_alpha2, ac_ct, ac_kexc, ac_aexc, ac_hi, ac_hp, ac_ht, ac_qt) &
-        !$OMP& private(row, col, k, time_step_returns, pn, en, pr, perc, l, prr, prd, qr, qd, split)
+        !$OMP& private(row, col, k, time_step_returns, pn, en, pr, perc, ps, es, l, prr, prd, qr, qd, split)
 #endif
         do col = 1, mesh%ncol
             do row = 1, mesh%nrow
@@ -1246,7 +1246,7 @@ subroutine gr5_ri_time_step(setup, mesh, input_data, options, returns, time_step
                                 col, &
                                 time_step_returns, &
                                 setup%n_snow_fluxes + 1:setup%n_snow_fluxes + setup%n_hydro_fluxes &
-                                ) = (/pn, en, pr, perc, l, prr, prd, qr, qd, ac_qt(k)/)
+                                ) = (/pn, en, pr, perc, ps, es, l, prr, prd, qr, qd, ac_qt(k)/)
                         end if
                     end if
                 end if

diff --git a/smash/tests/baseline.hdf5 b/smash/tests/baseline.hdf5