diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index 50ca66db0..d1b3c6bd2 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -7,4 +7,5 @@ | mo-marqh | mark Hedley | Met Office | 2025-12-11 | | yaswant | Yaswant Pradhan | Met Office | 2025-12-16 | | oakleybrunt | Oakley Brunt | Met Office | 2025-12-19 | -| harry-shepherd | Harry Shepherd | Met Office | 2026-01-08 | \ No newline at end of file +| harry-shepherd | Harry Shepherd | Met Office | 2026-01-08 | +| tommbendall | Thomas Bendall | Met Office | 2026-01-13 | diff --git a/applications/gungho_model/example/configuration.nml b/applications/gungho_model/example/configuration.nml index ea60b8aa1..c0cae93d9 100644 --- a/applications/gungho_model/example/configuration.nml +++ b/applications/gungho_model/example/configuration.nml @@ -175,7 +175,7 @@ write_fluxes=.false., write_minmax_tseries=.false., / &logging -run_log_level='info', +run_log_level='debug', / &mixed_solver eliminate_variables='discrete', @@ -276,7 +276,7 @@ timestep_start='1', alpha=0.55, dt=3600, inner_iterations=2, -method='semi_implicit', +method='tr_bdf2', outer_iterations=2, runge_kutta_method='forward_euler', spinup_alpha=.false., @@ -284,6 +284,12 @@ tau_r=1.0, tau_t=1.0, tau_u=0.55, / +&tr_bdf2 +bdf2_inner_iterations=2, +bdf2_outer_iterations=2, +tr_inner_iterations=2, +tr_outer_iterations=2, +/ &transport adjust_theta=.false., adjust_vhv_wind=.true., diff --git a/rose-stem/app/gungho_model/opt/rose-app-agnesi_hyd_cart.conf b/rose-stem/app/gungho_model/opt/rose-app-agnesi_hyd_cart.conf index 910eb4fba..039ee06f0 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-agnesi_hyd_cart.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-agnesi_hyd_cart.conf @@ -27,7 +27,7 @@ smp_init_wind=.true. u0=20.0 [namelist:io] -diagnostic_frequency=750 +diagnostic_frequency=375 [namelist:orography] orog_init_option='analytic' diff --git a/rose-stem/app/gungho_model/opt/rose-app-agnesi_nhyd_cart.conf b/rose-stem/app/gungho_model/opt/rose-app-agnesi_nhyd_cart.conf index e5e155e81..5308a7513 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-agnesi_nhyd_cart.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-agnesi_nhyd_cart.conf @@ -24,7 +24,7 @@ smp_init_wind=.true. u0=10.0 [namelist:io] -diagnostic_frequency=1800 +diagnostic_frequency=900 [namelist:orography] orog_init_option='analytic' diff --git a/rose-stem/app/gungho_model/opt/rose-app-baroclinic.conf b/rose-stem/app/gungho_model/opt/rose-app-baroclinic.conf index e48530b54..e7df5b7d4 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-baroclinic.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-baroclinic.conf @@ -13,4 +13,4 @@ test='deep_baroclinic_wave' profile='deep_baroclinic_perturbed' [namelist:io] -diagnostic_frequency=240 +diagnostic_frequency=120 diff --git a/rose-stem/app/gungho_model/opt/rose-app-bell_3d_cart.conf b/rose-stem/app/gungho_model/opt/rose-app-bell_3d_cart.conf index add07c759..79fc7b9fb 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-bell_3d_cart.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-bell_3d_cart.conf @@ -27,7 +27,7 @@ smp_init_wind=.true. u0=10.0 [namelist:io] -diagnostic_frequency=900 +diagnostic_frequency=450 [namelist:orography] orog_init_option='analytic' diff --git a/rose-stem/app/gungho_model/opt/rose-app-bryan_fritsch-dry.conf b/rose-stem/app/gungho_model/opt/rose-app-bryan_fritsch-dry.conf index d1cd6a8b2..4ae1a0646 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-bryan_fritsch-dry.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-bryan_fritsch-dry.conf @@ -13,7 +13,7 @@ rotating=.false. test='bryan_fritsch' [namelist:io] -diagnostic_frequency=100 +diagnostic_frequency=50 [namelist:partitioning] panel_decomposition='row' diff --git a/rose-stem/app/gungho_model/opt/rose-app-bryan_fritsch-moist.conf b/rose-stem/app/gungho_model/opt/rose-app-bryan_fritsch-moist.conf index 93339cdb9..70419b85d 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-bryan_fritsch-moist.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-bryan_fritsch-moist.conf @@ -16,7 +16,7 @@ use_physics=.true. test='bryan_fritsch' [namelist:io] -diagnostic_frequency=100 +diagnostic_frequency=50 [namelist:partitioning] partitioner='planar' diff --git a/rose-stem/app/gungho_model/opt/rose-app-dcmip200.conf b/rose-stem/app/gungho_model/opt/rose-app-dcmip200.conf index 3df481314..38b41e50c 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-dcmip200.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-dcmip200.conf @@ -13,7 +13,7 @@ test='const_lapse_rate' profile='constant_uv' [namelist:io] -diagnostic_frequency=144 +diagnostic_frequency=72 [namelist:orography] orog_init_option='analytic' diff --git a/rose-stem/app/gungho_model/opt/rose-app-dcmip200_realorog.conf b/rose-stem/app/gungho_model/opt/rose-app-dcmip200_realorog.conf index 41124ed11..2fd327aac 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-dcmip200_realorog.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-dcmip200_realorog.conf @@ -16,7 +16,7 @@ test='const_lapse_rate' profile='constant_uv' [namelist:io] -diagnostic_frequency=72 +diagnostic_frequency=36 [namelist:orography] orog_init_option='ancil' diff --git a/rose-stem/app/gungho_model/opt/rose-app-dcmip301.conf b/rose-stem/app/gungho_model/opt/rose-app-dcmip301.conf index 9750053f1..e39f6c693 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-dcmip301.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-dcmip301.conf @@ -9,7 +9,7 @@ profile='dcmip301' u0=20.0 [namelist:io] -diagnostic_frequency=36 +diagnostic_frequency=18 [namelist:planet] scaling_factor=125.0 diff --git a/rose-stem/app/gungho_model/opt/rose-app-deep-hot-jupiter.conf b/rose-stem/app/gungho_model/opt/rose-app-deep-hot-jupiter.conf index d78d37de9..cdb68d200 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-deep-hot-jupiter.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-deep-hot-jupiter.conf @@ -67,7 +67,7 @@ profile_heights=0.0 profile_size=1 [namelist:io] -diagnostic_frequency=360 +diagnostic_frequency=180 write_conservation_diag=.true. [namelist:physics] diff --git a/rose-stem/app/gungho_model/opt/rose-app-force_profile.conf b/rose-stem/app/gungho_model/opt/rose-app-force_profile.conf index c2e93352e..1b9e55a2b 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-force_profile.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-force_profile.conf @@ -46,7 +46,7 @@ profile='constant_uv' smp_init_wind=.true. [namelist:io] -diagnostic_frequency=10 +diagnostic_frequency=5 [!!namelist:multigrid] diff --git a/rose-stem/app/gungho_model/opt/rose-app-geostrophic.conf b/rose-stem/app/gungho_model/opt/rose-app-geostrophic.conf index 4b478825e..bbe810d38 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-geostrophic.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-geostrophic.conf @@ -50,7 +50,7 @@ profile='constant_uv' smp_init_wind=.true. [namelist:io] -diagnostic_frequency=144 +diagnostic_frequency=72 [!!namelist:multigrid] diff --git a/rose-stem/app/gungho_model/opt/rose-app-grabowski-clark.conf b/rose-stem/app/gungho_model/opt/rose-app-grabowski-clark.conf index 0194ec96f..ede628add 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-grabowski-clark.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-grabowski-clark.conf @@ -23,7 +23,7 @@ surface_pressure=850.0e2 theta_surf=296.446 [namelist:io] -diagnostic_frequency=50 +diagnostic_frequency=25 [namelist:mixed_solver] fail_on_non_converged=.false. diff --git a/rose-stem/app/gungho_model/opt/rose-app-io_nwp.conf b/rose-stem/app/gungho_model/opt/rose-app-io_nwp.conf index fc38d90a9..3f58bab97 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-io_nwp.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-io_nwp.conf @@ -1,2 +1,2 @@ [namelist:io] -diagnostic_frequency=240 +diagnostic_frequency=120 diff --git a/rose-stem/app/gungho_model/opt/rose-app-lfric-real-domain.conf b/rose-stem/app/gungho_model/opt/rose-app-lfric-real-domain.conf index 207ecdc1d..8169dd33c 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-lfric-real-domain.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-lfric-real-domain.conf @@ -26,7 +26,7 @@ profile='deep_baroclinic_perturbed' zero_w2v_wind=.true. [namelist:io] -diagnostic_frequency=24 +diagnostic_frequency=12 [namelist:orography] orog_init_option='ancil' diff --git a/rose-stem/app/gungho_model/opt/rose-app-moist_baroclinic_orog.conf b/rose-stem/app/gungho_model/opt/rose-app-moist_baroclinic_orog.conf index 9acb1a675..b24495817 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-moist_baroclinic_orog.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-moist_baroclinic_orog.conf @@ -20,7 +20,7 @@ profile='deep_baroclinic_steady' zero_w2v_wind=.true. [namelist:io] -diagnostic_frequency=24 +diagnostic_frequency=12 [namelist:orography] orog_init_option='analytic' diff --git a/rose-stem/app/gungho_model/opt/rose-app-relax_theta.conf b/rose-stem/app/gungho_model/opt/rose-app-relax_theta.conf index 72c0ce7f6..b2e46ce41 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-relax_theta.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-relax_theta.conf @@ -43,7 +43,7 @@ profile='constant_uv' smp_init_wind=.true. [namelist:io] -diagnostic_frequency=10 +diagnostic_frequency=5 [!!namelist:multigrid] diff --git a/rose-stem/app/gungho_model/opt/rose-app-robert-moist-lam.conf b/rose-stem/app/gungho_model/opt/rose-app-robert-moist-lam.conf index 436275a25..761c7f4df 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-robert-moist-lam.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-robert-moist-lam.conf @@ -40,7 +40,7 @@ theta_surf=303.05 lbc_option='analytic' [namelist:io] -diagnostic_frequency=216 +diagnostic_frequency=108 [namelist:mixed_solver] # The test is initially out of balance, so the solver may not converge to the diff --git a/rose-stem/app/gungho_model/opt/rose-app-robert-moist-smag-l300.conf b/rose-stem/app/gungho_model/opt/rose-app-robert-moist-smag-l300.conf index d950a0730..3a48c692a 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-robert-moist-smag-l300.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-robert-moist-smag-l300.conf @@ -20,7 +20,7 @@ test='warm_bubble' theta_surf=303.05 [namelist:io] -diagnostic_frequency=432 +diagnostic_frequency=216 [namelist:mixed_solver] # The test is initially out of balance, so the solver may not converge to the diff --git a/rose-stem/app/gungho_model/opt/rose-app-robert-moist-smag.conf b/rose-stem/app/gungho_model/opt/rose-app-robert-moist-smag.conf index 0ea5ca86b..a06450a98 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-robert-moist-smag.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-robert-moist-smag.conf @@ -20,7 +20,7 @@ test='warm_bubble' theta_surf=303.05 [namelist:io] -diagnostic_frequency=216 +diagnostic_frequency=108 [namelist:mixed_solver] # The test is initially out of balance, so the solver may not converge to the diff --git a/rose-stem/app/gungho_model/opt/rose-app-sbr.conf b/rose-stem/app/gungho_model/opt/rose-app-sbr.conf index aabd517d7..4bf73295f 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-sbr.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-sbr.conf @@ -14,4 +14,4 @@ profile='solid_body_rotation_alt' u0=40.0 [namelist:io] -diagnostic_frequency=120 +diagnostic_frequency=60 diff --git a/rose-stem/app/gungho_model/opt/rose-app-sbr_lam.conf b/rose-stem/app/gungho_model/opt/rose-app-sbr_lam.conf index 52f764c4c..1297a7e73 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-sbr_lam.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-sbr_lam.conf @@ -35,7 +35,7 @@ u0=40. lbc_option='analytic' [namelist:io] -diagnostic_frequency=24 +diagnostic_frequency=12 [namelist:mixed_solver] si_method='prec_only' diff --git a/rose-stem/app/gungho_model/opt/rose-app-schar3d_cart.conf b/rose-stem/app/gungho_model/opt/rose-app-schar3d_cart.conf index 734b66817..83f555a5a 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-schar3d_cart.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-schar3d_cart.conf @@ -27,7 +27,7 @@ smp_init_wind=.true. u0=10.0 [namelist:io] -diagnostic_frequency=2250 +diagnostic_frequency=1125 [namelist:orography] orog_init_option='analytic' diff --git a/rose-stem/app/gungho_model/opt/rose-app-schar_cart.conf b/rose-stem/app/gungho_model/opt/rose-app-schar_cart.conf index c5f027b99..23ecc6654 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-schar_cart.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-schar_cart.conf @@ -27,7 +27,7 @@ smp_init_wind=.true. u0=10.0 [namelist:io] -diagnostic_frequency=900 +diagnostic_frequency=450 [namelist:orography] orog_init_option='analytic' diff --git a/rose-stem/app/gungho_model/opt/rose-app-schar_cart_8s.conf b/rose-stem/app/gungho_model/opt/rose-app-schar_cart_8s.conf index bf8322559..c25415338 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-schar_cart_8s.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-schar_cart_8s.conf @@ -27,7 +27,7 @@ smp_init_wind=.true. u0=10.0 [namelist:io] -diagnostic_frequency=2250 +diagnostic_frequency=1125 [namelist:orography] orog_init_option='analytic' diff --git a/rose-stem/app/gungho_model/opt/rose-app-shallow-hot-jupiter.conf b/rose-stem/app/gungho_model/opt/rose-app-shallow-hot-jupiter.conf index b0caab4a7..4d1777718 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-shallow-hot-jupiter.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-shallow-hot-jupiter.conf @@ -17,7 +17,7 @@ test='isot_atm' theta_surf=1800.0 [namelist:io] -diagnostic_frequency=240 +diagnostic_frequency=120 write_conservation_diag=.true. [namelist:mixed_solver] diff --git a/rose-stem/app/gungho_model/opt/rose-app-skamarock_klemp_gw_p0.conf b/rose-stem/app/gungho_model/opt/rose-app-skamarock_klemp_gw_p0.conf index f3b1c3d13..9c14f0928 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-skamarock_klemp_gw_p0.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-skamarock_klemp_gw_p0.conf @@ -14,7 +14,7 @@ profile='constant_uv' u0=20.0 [namelist:io] -diagnostic_frequency=100 +diagnostic_frequency=50 [namelist:partitioning] partitioner='planar' diff --git a/rose-stem/app/gungho_model/opt/rose-app-straka_100m.conf b/rose-stem/app/gungho_model/opt/rose-app-straka_100m.conf index 81d571540..9c213154b 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-straka_100m.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-straka_100m.conf @@ -14,7 +14,7 @@ rotating=.false. test='cold_bubble_x' [namelist:io] -diagnostic_frequency=900 +diagnostic_frequency=450 [namelist:mixing] viscosity=.true. diff --git a/rose-stem/app/gungho_model/opt/rose-app-straka_25m.conf b/rose-stem/app/gungho_model/opt/rose-app-straka_25m.conf index 344e11d8b..efbc2cc2b 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-straka_25m.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-straka_25m.conf @@ -14,7 +14,7 @@ rotating=.false. test='cold_bubble_x' [namelist:io] -diagnostic_frequency=720 +diagnostic_frequency=360 [namelist:mixing] viscosity=.true. diff --git a/rose-stem/app/gungho_model/opt/rose-app-straka_50m.conf b/rose-stem/app/gungho_model/opt/rose-app-straka_50m.conf index 4d79f2308..133447f75 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-straka_50m.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-straka_50m.conf @@ -14,7 +14,7 @@ rotating=.false. test='cold_bubble_x' [namelist:io] -diagnostic_frequency=360 +diagnostic_frequency=180 [namelist:mixing] viscosity=.true. diff --git a/rose-stem/app/gungho_model/opt/rose-app-tidally-locked-earth.conf b/rose-stem/app/gungho_model/opt/rose-app-tidally-locked-earth.conf index 1b2969f88..1c66c879f 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-tidally-locked-earth.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-tidally-locked-earth.conf @@ -19,7 +19,7 @@ use_physics=.true. test='isot_atm' [namelist:io] -diagnostic_frequency=240 +diagnostic_frequency=120 [namelist:physics] limit_drag_incs=.false. diff --git a/rose-stem/app/gungho_model/opt/rose-app-warm3dbubble.conf b/rose-stem/app/gungho_model/opt/rose-app-warm3dbubble.conf index 06edb2d91..5b8d776f8 100644 --- a/rose-stem/app/gungho_model/opt/rose-app-warm3dbubble.conf +++ b/rose-stem/app/gungho_model/opt/rose-app-warm3dbubble.conf @@ -14,7 +14,7 @@ rotating=.false. test='warm_bubble_3d' [namelist:io] -diagnostic_frequency=80 +diagnostic_frequency=40 [namelist:partitioning] partitioner='planar' diff --git a/rose-stem/app/gungho_model/rose-app.conf b/rose-stem/app/gungho_model/rose-app.conf index d4bc76fa1..818a8d400 100644 --- a/rose-stem/app/gungho_model/rose-app.conf +++ b/rose-stem/app/gungho_model/rose-app.conf @@ -79,6 +79,7 @@ source=namelist:base_mesh = namelist:time = namelist:timestepping = namelist:transport + = (namelist:tr_bdf2) = (namelist:vapour_forcing) = (namelist:vertadvect) = (namelist:wind_forcing) @@ -1302,7 +1303,7 @@ timestep_start='$RESTART_START' alpha=0.55 dt=$DT inner_iterations=2 -method='semi_implicit' +method='tr_bdf2' outer_iterations=2 runge_kutta_method='forward_euler' spinup_alpha=.false. @@ -1311,6 +1312,13 @@ tau_r=1.0 tau_t=1.0 tau_u=0.55 +[namelist:tr_bdf2] +bdf2_inner_iterations=1,1 +bdf2_outer_iterations=2 +tr_inner_iterations_even=2,1 +tr_inner_iterations_odd=1,1 +tr_outer_iterations=2 + [namelist:transport] adjust_theta=.false. !!adjust_theta_above=30000.0 diff --git a/rose-stem/app/lfric_atm/opt/rose-app-C224_MG.conf b/rose-stem/app/lfric_atm/opt/rose-app-C224_MG.conf index 526043b24..7393a96ea 100644 --- a/rose-stem/app/lfric_atm/opt/rose-app-C224_MG.conf +++ b/rose-stem/app/lfric_atm/opt/rose-app-C224_MG.conf @@ -8,4 +8,4 @@ file_prefix='mesh_C224_MG' !!fplane= [namelist:radiation] -n_radstep=5 +n_radstep=3 diff --git a/rose-stem/app/lfric_atm/opt/rose-app-C896_MG.conf b/rose-stem/app/lfric_atm/opt/rose-app-C896_MG.conf index a1849b095..5e08643c0 100644 --- a/rose-stem/app/lfric_atm/opt/rose-app-C896_MG.conf +++ b/rose-stem/app/lfric_atm/opt/rose-app-C896_MG.conf @@ -29,4 +29,4 @@ orography_mesh_name='dynamics' physics_mesh_name='dynamics' [namelist:radiation] -n_radstep=15 +n_radstep=6 diff --git a/rose-stem/app/lfric_atm/opt/rose-app-ral3.conf b/rose-stem/app/lfric_atm/opt/rose-app-ral3.conf index ba59a8370..d8869857c 100644 --- a/rose-stem/app/lfric_atm/opt/rose-app-ral3.conf +++ b/rose-stem/app/lfric_atm/opt/rose-app-ral3.conf @@ -136,7 +136,7 @@ liu_bparam=-0.14 n_horiz_ang=16 n_horiz_layer=1 n_inc_radstep=5 -n_radstep=15 +n_radstep=5 scatter_method_lwinc='approx' spectral_file_lwinc='spec/sp_lw_cloud9' spectral_file_swinc='spec/sp_sw_cloud9' diff --git a/rose-stem/app/lfric_atm/rose-app.conf b/rose-stem/app/lfric_atm/rose-app.conf index d7f7988a5..32963dafc 100644 --- a/rose-stem/app/lfric_atm/rose-app.conf +++ b/rose-stem/app/lfric_atm/rose-app.conf @@ -91,6 +91,7 @@ source=(namelist:aerosol) = (namelist:theta_relax) = namelist:time = namelist:timestepping + = (namelist:tr_bdf2) = namelist:transport = (namelist:vapour_forcing) = (namelist:vertadvect) @@ -1333,7 +1334,7 @@ timestep_start='$RESTART_START' alpha=0.55 dt=$DT inner_iterations=2 -method='semi_implicit' +method='tr_bdf2' outer_iterations=2 runge_kutta_method='forward_euler' spinup_alpha=.false. @@ -1342,6 +1343,13 @@ tau_r=1.0 tau_t=1.0 tau_u=0.55 +[namelist:tr_bdf2] +bdf2_inner_iterations=1,1 +bdf2_outer_iterations=2 +tr_inner_iterations_even=2,1 +tr_inner_iterations_odd=2,1 +tr_outer_iterations=2 + [namelist:transport] adjust_theta=.true. adjust_theta_above=30000.0 @@ -1355,7 +1363,7 @@ cfl_mol_2d_stab=1.0 cfl_mol_3d_stab=1.0 cheap_update=.false. consistent_metric=.false. -dep_pt_stencil_extent=7 +dep_pt_stencil_extent=12 dry_field_name='density' enforce_min_value=.false.,.false.,.false.,.true.,.true.,.true. equation_form=1,3,2,3,3,3 diff --git a/rose-stem/app/plot/bin/baroclinic.py b/rose-stem/app/plot/bin/baroclinic.py index 305454901..92237a945 100755 --- a/rose-stem/app/plot/bin/baroclinic.py +++ b/rose-stem/app/plot/bin/baroclinic.py @@ -88,7 +88,8 @@ def make_figures(filein, plotpath, fields, vertical_spacing, formulation): else: combined_fields = [field] - interp_fig = plt.figure(figsize=(20, 10)) + interp_fig, ax = plt.subplots(figsize=(20, 10)) + for cfield in combined_fields: cube = read_ugrid_data(filein, cfield) @@ -166,63 +167,55 @@ def make_figures(filein, plotpath, fields, vertical_spacing, formulation): kappa = rd/1005.0 plot_data[:, :, level] = 0.01*fi**(1.0/kappa) * p0 - nplots = 1 - nxplots = 1 - nyplots = 1 - - for iplot in range(nplots): - ax = interp_fig.add_subplot(nxplots, nyplots, iplot+1) - level = iplot - if (cfield == 'm_v' or cfield == 'm_cl'): - # Plot level 10 for mositure fields - level = 10 - cmap = magma.reversed() + if (cfield == 'm_v' or cfield == 'm_cl'): + # Plot level 10 for moisture fields + level = 10 + cmap = magma.reversed() + else: + level = 0 + cmap = magma + + if direction == 'xz': + lon, height = np.meshgrid(xi, zi) + CS = ax.contourf(lon, height, + plot_data[:, plot_lat, :].T, + levels=levels, cmap=cmap) + plt.colorbar(cmap=cmap) + CL = ax.contour(lat, height, + plot_data[:, plot_lat, :].T, + levels=levels, linewidths=0.5, + colors='k') + ax.title(['lat = ', yi[plot_lat]*360./np.real(nx)]) + if direction == 'yz': + lat, height = np.meshgrid(yi, zi) + CS = ax.contourf(lat, height, + plot_data[:, plot_long, :].T, + levels=levels, cmap=cmap) + ax.colorbar(cmap=cmap) + CL = ax.contour(lat, height, + plot_data[:, plot_long, :].T, + levels=levels, linewidths=0.5, + colors='k') + ax.title(['long = ', xi[plot_long]*360./np.real(nx)]) + if direction == 'xy': + lat, lon = np.meshgrid(yi, xi) + if cfield == 'exner': + # Extrapolate data to the surface + dz = plot_data[:, :, 0] + (zi_f[0] - zi_h[0]) * \ + (plot_data[:, :, 0] - plot_data[:, :, level]) \ + / (zi_h[0] - zi_h[1]) else: - cmap = magma - ys = np.tile(yi, (n_levs, 1)) - - - if direction == 'xz': - lon, height = np.meshgrid(xi, zi) - CS = plt.contourf(lon, height, - plot_data[:, plot_lat, :].T, - levels=levels, cmap=cmap) - plt.colorbar(cmap=cmap) - CL = plt.contour(lat, height, - plot_data[:, plot_lat, :].T, - levels=levels, linewidths=0.5, - colors='k') - plt.title(['lat = ', yi[plot_lat]*360./np.real(nx)]) - if direction == 'yz': - lat, height = np.meshgrid(yi, zi) - CS = plt.contourf(lat, height, - plot_data[:, plot_long, :].T, - levels=levels, cmap=cmap) - plt.colorbar(cmap=cmap) - CL = plt.contour(lat, height, - plot_data[:, plot_long, :].T, - levels=levels, linewidths=0.5, - colors='k') - plt.title(['long = ', xi[plot_long]*360./np.real(nx)]) - if direction == 'xy': - lat, lon = np.meshgrid(yi, xi) - if cfield == 'exner' and iplot == 0: - # Extrapolate data to the surface - dz = plot_data[:, :, 0] + (zi_f[0] - zi_h[0]) * \ - (plot_data[:, :, 0] - plot_data[:, :, level]) \ - / (zi_h[0] - zi_h[1]) - else: - dz = plot_data[:, :, level] - if cfield != 'exner': - CS = plt.contourf(lon, lat, - plot_data[:, :, level].T, - levels=levels, cmap=cmap) - plt.colorbar(cmap=cmap) - if cfield != 'theta': - CL = plt.contour(lon, lat, dz.T, levels=levels, - linewidths=1.0, colors='k') - plt.clabel(CL, CL.levels[1::2], fontsize=15, - inline=1, fmt='%3.1f') + dz = plot_data[:, :, level] + if cfield != 'exner': + CS = ax.contourf(lon, lat, + plot_data[:, :, level].T, + levels=levels, cmap=cmap) + _ = interp_fig.colorbar(CS, ax=ax) + if cfield != 'theta': + CL = ax.contour(lon, lat, dz.T, levels=levels, + linewidths=1.0, colors='k') + ax.clabel(CL, CL.levels[1::2], fontsize=15, + inline=1, fmt='%3.1f') pngfile = '%s/baroclinic_plot-%s-time%s-%s.png' % \ (plotpath, cfield, time[t], direction) diff --git a/rose-stem/app/plot/bin/straka_plot_x.py b/rose-stem/app/plot/bin/straka_plot_x.py index a50fafc3d..d6f355aa5 100755 --- a/rose-stem/app/plot/bin/straka_plot_x.py +++ b/rose-stem/app/plot/bin/straka_plot_x.py @@ -54,7 +54,7 @@ def make_figure(plotpath, nx, ny, field, component, timestep): val_col = 'c' + str(component) - slice_fig = plt.figure(figsize=(15, 10)) + slice_fig, ax = plt.subplots(figsize=(12, 5)) # get min and max of x,y data for plot axes min_lev = min(levels) @@ -99,18 +99,22 @@ def make_figure(plotpath, nx, ny, field, component, timestep): for i in range(nx): dz[i, :] = zi[0, i, :] - back - matplotlib.rcParams['contour.negative_linestyle'] = 'solid' - cf = plt.contourf(x_i * r2d, y_i * r2d, np.round(dz, 10), - cc, cmap=c_map, extend='min') - plt.axes().set_aspect(.8) - plt.axis([0, 16, 0, 5]) - plt.xlabel("x (km)", fontsize=28) - plt.ylabel("z (km)", fontsize=28) - cb = plt.colorbar(cf, cmap=c_map, fraction=0.011, pad=0.04) + cf = ax.contourf(x_i * r2d, y_i * r2d, np.round(dz, 10), + cc, cmap=c_map, extend='min') + # Add contour lines -- solid for negative + _ = ax.contour(x_i * r2d, y_i * r2d, np.round(dz, 10), cc, + colors='k', linewidths=0.5, linestyles='solid') + + ax.set_xlabel("x (km)", fontsize=28) + ax.set_ylabel("z (km)", fontsize=28) + ax.set_xlim([0.0, 16.0]) + ax.set_ylim([0.0, 5.0]) + ax.set_xticks(np.arange(0, 18, 2)) + ax.set_yticks(np.arange(0, 6, 1)) + # Set tick label size + ax.tick_params(axis='both', which='major', labelsize=24) + cb = plt.colorbar(cf, cmap=c_map, pad=0.04) cb.ax.tick_params(labelsize=24) - plt.xticks(np.arange(0, 18, 2)) - plt.yticks(np.arange(0, 6, 1)) - plt.tick_params(axis='both', labelsize=28) # Front position is symmetrized print(nx, np.min(dz), np.max(dz)) diff --git a/rose-stem/site/common/gungho_model/tasks_gungho_model.cylc b/rose-stem/site/common/gungho_model/tasks_gungho_model.cylc index 17c6843c5..3afbe2a53 100644 --- a/rose-stem/site/common/gungho_model/tasks_gungho_model.cylc +++ b/rose-stem/site/common/gungho_model/tasks_gungho_model.cylc @@ -14,12 +14,12 @@ {% do task_dict.update({ "opt_confs": ["agnesi_hyd_cart"], "resolution": "BiP120x8-2000x2000", - "DT": 20, + "DT": 40, "mpi_parts": 10, - "tsteps": 750, + "tsteps": 375, "panel_decomp": "row", "use_xios": false, - "plot_str": "cartesian_mountain_plot.py diagGungho $NODAL_DATA_DIR u 3 T000750 2 2 8 hmw zoom_1 lines $PLOT_DIR", + "plot_str": "cartesian_mountain_plot.py diagGungho $NODAL_DATA_DIR u 3 T000375 2 2 8 hmw zoom_1 lines $PLOT_DIR", }) %} {% elif task_ns.conf_name == "baroclinic-C24_MG" %} @@ -27,10 +27,10 @@ {% do task_dict.update({ "opt_confs": ["baroclinic"], "resolution": "C24_MG", - "DT": 3600, + "DT": 7200, "threads": 4, "mpi_parts": 6, - "tsteps": 240, + "tsteps": 120, "plot_str": "baroclinic.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR dcmip dry surface_pressure_temperature", }) %} @@ -39,7 +39,7 @@ {% do task_dict.update({ "opt_confs": ["baroclinic","io1", "perturb"], "resolution": "C24_MG", - "DT": 3600, + "DT": 7200, "threads": 1, "mpi_parts": 6, "tsteps": 10, @@ -54,10 +54,10 @@ {% do task_dict.update({ "opt_confs": ["baroclinic", "gungho-alt1-spherical"], "resolution": "C24s_MG", - "DT": 3600, + "DT": 7200, "threads": 4, "mpi_parts": 6, - "tsteps": 240, + "tsteps": 120, "plot_str": "baroclinic.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR dcmip dry surface_pressure_temperature", }) %} @@ -66,10 +66,10 @@ {% do task_dict.update({ "opt_confs": ["baroclinic", "gungho-alt2-spherical"], "resolution": "C24_MG_op", - "DT": 3600, + "DT": 7200, "threads": 4, "mpi_parts": 6, - "tsteps": 240, + "tsteps": 120, "wallclock": 30, "plot_str": "baroclinic.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR dcmip dry surface_pressure_temperature", }) %} @@ -79,10 +79,10 @@ {% do task_dict.update({ "opt_confs": ["baroclinic", "gungho-alt3"], "resolution": "C24_MG", - "DT": 3600, + "DT": 7200, "threads": 4, "mpi_parts": 6, - "tsteps": 240, + "tsteps": 120, "plot_str": "baroclinic.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR dcmip dry surface_pressure_temperature", }) %} @@ -91,10 +91,10 @@ {% do task_dict.update({ "opt_confs": ["baroclinic", "no_io"], "resolution": "C24_MG", - "DT": 3600, + "DT": 7200, "threads": 4, "mpi_parts": 6, - "tsteps": 24, + "tsteps": 12, "use_xios": false, "kgo_checks": [], }) %} @@ -104,10 +104,10 @@ {% do task_dict.update({ "opt_confs": ["baroclinic", "no_io"], "resolution": "C24_MG", - "DT": 3600, + "DT": 7200, "threads": 4, "mpi_parts": 6, - "tsteps": 24, + "tsteps": 12, "use_xios": false, "kgo_checks": [], }) %} @@ -117,9 +117,9 @@ {% do task_dict.update({ "opt_confs": ["bryan_fritsch-dry"], "resolution": "BiP200x10-100x100", - "DT": 2, + "DT": 4, "mpi_parts": 10, - "tsteps": 500, + "tsteps": 250, "panel_decomp": "row", "plot_str": "spherical_and_vertical_slice_ugrid_plot.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR theta xz -1 linear bryan_fritsch", }) %} @@ -129,12 +129,12 @@ {% do task_dict.update({ "opt_confs": ["dcmip200"], "resolution": "C24_MG", - "DT": 600, + "DT": 1200, "mpi_parts": 6, "threads": 3, - "tsteps": 864, + "tsteps": 432, "use_xios": false, - "plot_str": "slices_orography.py diagGungho $NODAL_DATA_DIR u T000864 0 0 0 $PLOT_DIR 2-0-0" + "plot_str": "slices_orography.py diagGungho $NODAL_DATA_DIR u T000432 0 0 0 $PLOT_DIR 2-0-0" }) %} {% elif task_ns.conf_name == "dcmip200_realorog-C48_MG" %} @@ -142,9 +142,9 @@ {% do task_dict.update({ "opt_confs": ["dcmip200_realorog"], "resolution": "C48_MG", - "DT": 600, + "DT": 1200, "mpi_parts": 24, - "tsteps": 144, + "tsteps": 72, }) %} {% elif task_ns.conf_name == "dcmip301-C24_MG" %} @@ -152,11 +152,11 @@ {% do task_dict.update({ "opt_confs": ["dcmip301"], "resolution": "C24_MG", - "DT": 10, + "DT": 20, "mpi_parts": 6, - "tsteps": 360, + "tsteps": 180, "use_xios": false, - "plot_str": "dcmip301.py diagGungho $NODAL_DATA_DIR theta T000180:T000252:T000324:T000360 36 $PLOT_DIR" + "plot_str": "dcmip301.py diagGungho $NODAL_DATA_DIR theta T000090:T000126:T000162:T000180 18 $PLOT_DIR" }) %} {% elif task_ns.conf_name == "deep-hot-jupiter-C24_MG" %} @@ -164,9 +164,9 @@ {% do task_dict.update({ "opt_confs": ["deep-hot-jupiter"], "resolution": "C24_MG", - "DT": 120, + "DT": 240, "mpi_parts": 6, - "tsteps": 360, + "tsteps": 180, "wallclock": 30, "plot_str": "plot_zonal.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR deep-hot-jupiter deep-hot-jupiter uniform 66 67" }) %} @@ -176,9 +176,9 @@ {% do task_dict.update({ "opt_confs": ["earth-like", "io_nwp"], "resolution": "C24_MG", - "DT": 3600, + "DT": 7200, "mpi_parts": 6, - "tsteps": 480, + "tsteps": 240, "crun": 2, "plot_str": "plot_zonal.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR earth-like earth uniform 32 33" }) %} @@ -188,9 +188,9 @@ {% do task_dict.update({ "opt_confs": ["held-suarez", "io_nwp"], "resolution": "C24_MG", - "DT": 3600, + "DT": 7200, "mpi_parts": 6, - "tsteps": 480, + "tsteps": 240, "plot_str": "plot_zonal.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR held-suarez earth dcmip 30 31" }) %} @@ -199,10 +199,10 @@ {% do task_dict.update({ "opt_confs": ["lfric-real-domain"], "resolution": "C48_MG", - "DT": 1800, + "DT": 3600, "mpi_parts": 6, "threads": 4, - "tsteps": 240, + "tsteps": 120, "wallclock": 20, "plot_str": "sbr.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR um70 30 71 lfric" }) %} @@ -248,14 +248,14 @@ {% do task_dict.update({ "opt_confs": ["robert-moist-lam"], "resolution": "BiP100x8-10x10", - "DT": 1.25, + "DT": 2.5, "threads": 2, "mpi_parts": 5, - "tsteps": 648, + "tsteps": 324, "panel_decomp": "row", "wallclock": 25, "use_xios": false, - "plot_str": "robert_plot.py diagGungho $NODAL_DATA_DIR 100 8 theta:m_v T000432:T000648 $PLOT_DIR", + "plot_str": "robert_plot.py diagGungho $NODAL_DATA_DIR 100 8 theta:m_v T000216:T000324 $PLOT_DIR", }) %} {% elif task_ns.conf_name == "robert-moist-smag-BiP100x8-10x10" %} @@ -263,14 +263,14 @@ {% do task_dict.update({ "opt_confs": ["robert-moist-smag"], "resolution": "BiP100x8-10x10", - "DT": 1.25, + "DT": 2.5, "threads": 2, "mpi_parts": 5, - "tsteps": 648, + "tsteps": 324, "panel_decomp": "row", "wallclock": 25, "use_xios": false, - "plot_str": "robert_plot.py diagGungho $NODAL_DATA_DIR 100 8 theta:m_v T000432:T000648 $PLOT_DIR", + "plot_str": "robert_plot.py diagGungho $NODAL_DATA_DIR 100 8 theta:m_v T000216:T000324 $PLOT_DIR", }) %} {% elif task_ns.conf_name == "runge-kutta-for-linear-C12" %} @@ -287,9 +287,9 @@ {% do task_dict.update({ "opt_confs": ["sbr"], "resolution": "C24_MG", - "DT": 3600, + "DT": 7200, "mpi_parts": 6, - "tsteps": 240, + "tsteps": 120, "threads": 4, "plot_str": "sbr.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR um70 80 71 sbr", }) %} @@ -299,9 +299,9 @@ {% do task_dict.update({ "opt_confs": ["sbr", "gungho-alt2-spherical"], "resolution": "C24_MG_op", - "DT": 3600, + "DT": 7200, "mpi_parts": 6, - "tsteps": 240, + "tsteps": 120, "threads": 4, "wallclock": 30, "plot_str": "sbr.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR um70 80 71 sbr-alt2", @@ -312,9 +312,9 @@ {% do task_dict.update({ "opt_confs": ["sbr", "gungho-alt3"], "resolution": "C24_MG", - "DT": 3600, + "DT": 7200, "mpi_parts": 6, - "tsteps": 240, + "tsteps": 120, "threads": 4, "plot_str": "sbr.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR um70 80 71 sbr", }) %} @@ -324,9 +324,9 @@ {% do task_dict.update({ "opt_confs": ["sbr_lam"], "resolution": "n96_MG_lam", - "DT": 3600, + "DT": 7200, "mpi_parts": 4, - "tsteps": 240, + "tsteps": 120, "threads": 6, "plot_str": "sbr.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR dcmip 30 31 sbr-lam", }) %} @@ -336,9 +336,9 @@ {% do task_dict.update({ "opt_confs": ["sbr_lam"], "resolution": "n96_MG_lam_rotate", - "DT": 3600, + "DT": 7200, "mpi_parts": 4, - "tsteps": 240, + "tsteps": 120, "threads": 6, "plot_str": "sbr.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR dcmip 30 31 sbr-lam", }) %} @@ -348,14 +348,14 @@ {% do task_dict.update({ "opt_confs": ["schar_cart"], "resolution": "BiP200x8-500x500", - "DT": 20, + "DT": 40, "mpi_parts": 5, - "tsteps": 900, + "tsteps": 450, "threads": 3, "panel_decomp": "row", "wallclock": 30, "use_xios": false, - "plot_str": "cartesian_mountain_plot.py diagGungho $NODAL_DATA_DIR u 3 T000900 2 2 8 schar zoom_1 lines $PLOT_DIR", + "plot_str": "cartesian_mountain_plot.py diagGungho $NODAL_DATA_DIR u 3 T000450 2 2 8 schar zoom_1 lines $PLOT_DIR", }) %} {% elif task_ns.conf_name == "schar_cart-alt2-BiP100x4-1000x1000" %} @@ -363,14 +363,14 @@ {% do task_dict.update({ "opt_confs": ["schar_cart", "gungho-alt2-planar"], "resolution": "BiP100x4-1000x1000", - "DT": 20, + "DT": 40, "mpi_parts": 5, - "tsteps": 900, + "tsteps": 450, "threads": 3, "panel_decomp": "row", "wallclock": 30, "use_xios": false, - "plot_str": "cartesian_mountain_plot.py diagGungho $NODAL_DATA_DIR u 3 T000900 2 2 4 schar zoom_1 lines $PLOT_DIR", + "plot_str": "cartesian_mountain_plot.py diagGungho $NODAL_DATA_DIR u 3 T000450 2 2 4 schar zoom_1 lines $PLOT_DIR", }) %} {% elif task_ns.conf_name == "semi-implicit-for-linear-C12" %} @@ -388,9 +388,9 @@ {% do task_dict.update({ "opt_confs": ["shallow-hot-jupiter"], "resolution": "C24_MG", - "DT": 2400, + "DT": 4800, "mpi_parts": 6, - "tsteps": 480, + "tsteps": 240, "crun": 2, "crun_compare": false, "wallclock": 20, @@ -402,10 +402,10 @@ {% do task_dict.update({ "opt_confs": ["skamarock_klemp_gw_p0"], "resolution": "BiP300x8-1000x2000", - "DT": 10, - "tsteps": 300, + "DT": 20, + "tsteps": 150, "use_xios": false, - "plot_str": "gw_cart_plot.py diagGungho $NODAL_DATA_DIR 300 8 theta T000000:T000100:T000200:T000300 $PLOT_DIR", + "plot_str": "gw_cart_plot.py diagGungho $NODAL_DATA_DIR 300 8 theta T000000:T000050:T000100:T000150 $PLOT_DIR", }) %} {% elif task_ns.conf_name == "skamarock_klemp_gw_p1-BiP75x4-4000x2000" %} @@ -456,12 +456,12 @@ {% do task_dict.update({ "opt_confs": ["straka_200m"], "resolution": "BiP256x8-200x200", - "DT": 5, + "DT": 10, "mpi_parts": 8, - "tsteps": 180, + "tsteps": 90, "panel_decomp": "row", "use_xios": false, - "plot_str": "straka_plot_x.py diagGungho $NODAL_DATA_DIR 256 8 theta T000180 $PLOT_DIR", + "plot_str": "straka_plot_x.py diagGungho $NODAL_DATA_DIR 256 8 theta T000090 $PLOT_DIR", }) %} {% elif task_ns.conf_name == "straka_200m-alt1-BiP256x4-200x200" %} @@ -469,13 +469,13 @@ {% do task_dict.update({ "opt_confs": ["straka_200m", "gungho-alt1-planar"], "resolution": "BiP256x4-200x200", - "DT": 5, + "DT": 10, "mpi_parts": 8, - "tsteps": 180, + "tsteps": 90, "panel_decomp": "row", "wallclock": 30, "use_xios": false, - "plot_str": "straka_plot_x.py diagGungho $NODAL_DATA_DIR 256 4 theta T000180 $PLOT_DIR", + "plot_str": "straka_plot_x.py diagGungho $NODAL_DATA_DIR 256 4 theta T000090 $PLOT_DIR", }) %} {% elif task_ns.conf_name == "straka_200m-alt2-BiP256x16-200x50_op" %} @@ -483,13 +483,13 @@ {% do task_dict.update({ "opt_confs": ["straka_200m", "gungho-alt2-planar"], "resolution": "BiP256x16-200x50_op", - "DT": 5, + "DT": 10, "mpi_parts": 8, - "tsteps": 180, + "tsteps": 90, "panel_decomp": "row", "wallclock": 30, "use_xios": false, - "plot_str": "straka_plot_x.py diagGungho $NODAL_DATA_DIR 256 16 theta T000180 $PLOT_DIR", + "plot_str": "straka_plot_x.py diagGungho $NODAL_DATA_DIR 256 16 theta T000090 $PLOT_DIR", }) %} {% elif task_ns.conf_name == "straka_200m-alt3-BiP256x8-200x200" %} @@ -497,12 +497,12 @@ {% do task_dict.update({ "opt_confs": ["straka_200m", "gungho-alt3"], "resolution": "BiP256x8-200x200", - "DT": 5, + "DT": 10, "mpi_parts": 8, - "tsteps": 180, + "tsteps": 90, "panel_decomp": "row", "use_xios": false, - "plot_str": "straka_plot_x.py diagGungho $NODAL_DATA_DIR 256 8 theta T000180 $PLOT_DIR", + "plot_str": "straka_plot_x.py diagGungho $NODAL_DATA_DIR 256 8 theta T000090 $PLOT_DIR", }) %} {% elif task_ns.conf_name == "tidally-locked-earth-C24s_rot_MG" %} @@ -510,9 +510,9 @@ {% do task_dict.update({ "opt_confs": ["tidally-locked-earth"], "resolution": "C24s_rot_MG", - "DT": 3600, + "DT": 7200, "mpi_parts": 6, - "tsteps": 480, + "tsteps": 240, "crun": 2, "crun_compare": false, "plot_str": "plot_zonal.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR earth-like earth uniform 32 33" @@ -523,9 +523,9 @@ {% do task_dict.update({ "opt_confs": ["tidally-locked-earth"], "resolution": "C24_MG", - "DT": 3600, + "DT": 7200, "mpi_parts": 6, - "tsteps": 480, + "tsteps": 240, "crun": 2, "crun_compare": false, "plot_str": "plot_zonal.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR earth-like earth uniform 32 33" diff --git a/rose-stem/site/common/gungho_model/tasks_gungho_model_weekly.cylc b/rose-stem/site/common/gungho_model/tasks_gungho_model_weekly.cylc index 5f8ee5d23..ad37e154a 100644 --- a/rose-stem/site/common/gungho_model/tasks_gungho_model_weekly.cylc +++ b/rose-stem/site/common/gungho_model/tasks_gungho_model_weekly.cylc @@ -14,14 +14,14 @@ {% do task_dict.update({ "opt_confs": ["agnesi_nhyd_cart"], "resolution": "BiP360x8-400x400", - "DT": 5, + "DT": 10, "mpi_parts": 10, - "tsteps": 1800, + "tsteps": 900, "panel_decomp": "row", "use_xios": false, "wallclock": 60, "kgo_checks": [], - "plot_str": "cartesian_mountain_plot.py diagGungho $NODAL_DATA_DIR u 3 T001800 2 2 8 nhmw zoom_1 lines $PLOT_DIR", + "plot_str": "cartesian_mountain_plot.py diagGungho $NODAL_DATA_DIR u 3 T000900 2 2 8 nhmw zoom_1 lines $PLOT_DIR", }) %} {% elif task_ns.conf_name == "baroclinic-C48_MG" %} @@ -29,9 +29,9 @@ {% do task_dict.update({ "opt_confs": ["baroclinic"], "resolution": "C48_MG", - "DT": 3600, + "DT": 7200, "mpi_parts": 24, - "tsteps": 240, + "tsteps": 120, "wallclock": 30, "kgo_checks": [], "plot_str": "baroclinic.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR dcmip dry surface_pressure_temperature", @@ -42,9 +42,9 @@ {% do task_dict.update({ "opt_confs": ["baroclinic"], "resolution": "C96_MG", - "DT": 1800, + "DT": 3600, "mpi_parts": 96, - "tsteps": 480, + "tsteps": 240, "wallclock": 30, "kgo_checks": [], "plot_str": "baroclinic.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR dcmip dry surface_pressure_temperature", @@ -55,9 +55,9 @@ {% do task_dict.update({ "opt_confs": ["baroclinic"], "resolution": "C192_MG", - "DT": 900, + "DT": 1800, "mpi_parts": 384, - "tsteps": 960, + "tsteps": 480, "wallclock": 30, "kgo_checks": [], "plot_str": "baroclinic.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR dcmip dry surface_pressure_temperature", @@ -68,9 +68,9 @@ {% do task_dict.update({ "opt_confs": ["baroclinic", "no_io"], "resolution": "C192_MG", - "DT": 900, + "DT": 1800, "mpi_parts": 384, - "tsteps": 960, + "tsteps": 480, "wallclock": 30, "kgo_checks": [], "plot_str": "baroclinic.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR dcmip dry surface_pressure_temperature", @@ -81,14 +81,14 @@ {% do task_dict.update({ "opt_confs": ["bell_3d_cart"], "resolution": "BiP300x200-200x200", - "DT": 4, + "DT": 8, "mpi_parts": 25, "threads": 6, - "tsteps": 900, + "tsteps": 450, "use_xios": false, "wallclock": 60, "kgo_checks": [], - "plot_str": "cartesian_mountain_plot.py diagGungho $NODAL_DATA_DIR u 3 T000900 159 99 200 bell zoom_2 lines $PLOT_DIR" + "plot_str": "cartesian_mountain_plot.py diagGungho $NODAL_DATA_DIR u 3 T000450 159 99 200 bell zoom_2 lines $PLOT_DIR" }) %} {% elif task_ns.conf_name == "bryan_fritsch-moist-BiP200x10-100x100" %} @@ -96,9 +96,9 @@ {% do task_dict.update({ "opt_confs": ["bryan_fritsch-moist"], "resolution": "BiP200x10-100x100", - "DT": 2, + "DT": 4, "mpi_parts": 10, - "tsteps": 400, + "tsteps": 200, "panel_decomp": "row", "wallclock": 15, "kgo_checks": [], @@ -110,9 +110,9 @@ {% do task_dict.update({ "opt_confs": ["earth-like", "io_clim"], "resolution": "C48_MG", - "DT": 1800, + "DT": 3600, "mpi_parts": 216, - "tsteps": 14400, + "tsteps": 7200, "crun": 1, "crun_compare": false, "wallclock": 180, @@ -125,10 +125,10 @@ {% do task_dict.update({ "opt_confs": ["grabowski-clark"], "resolution": "BiP200x10-18x20", - "DT": 2, + "DT": 4, "mpi_parts": 10, "threads": 6, - "tsteps": 200, + "tsteps": 100, "panel_decomp": "row", "wallclock": 15, "kgo_checks": [], @@ -140,9 +140,9 @@ {% do task_dict.update({ "opt_confs": ["held-suarez", "io_clim"], "resolution": "C48_MG", - "DT": 1800, + "DT": 3600, "mpi_parts": 216, - "tsteps": 14400, + "tsteps": 7200, "crun": 1, "crun_compare": false, "kgo_checks": [], @@ -155,9 +155,9 @@ {% do task_dict.update({ "opt_confs": ["moist_baroclinic_orog"], "resolution": "C48_MG", - "DT": 900, + "DT": 1800, "mpi_parts": 24, - "tsteps": 960, + "tsteps": 480, "crun": 4, "crun_compare": false, "wallclock": 60, @@ -170,14 +170,14 @@ {% do task_dict.update({ "opt_confs": ["robert-moist-smag-l300"], "resolution": "BiP200x8-5x5", - "DT": 0.625, + "DT": 1.25, "mpi_parts": 50, "panel_decomp": "row", - "tsteps": 1296, + "tsteps": 648, "use_xios": false, "wallclock": 90, "kgo_checks": [], - "plot_str": "robert_plot.py diagGungho $NODAL_DATA_DIR 200 8 theta:m_v T000864:T001296 $PLOT_DIR", + "plot_str": "robert_plot.py diagGungho $NODAL_DATA_DIR 200 8 theta:m_v T000432:T000648 $PLOT_DIR", }) %} {% elif task_ns.conf_name == "sbr-C48_MG" %} @@ -185,10 +185,10 @@ {% do task_dict.update({ "opt_confs": ["sbr"], "resolution": "C48_MG", - "DT": 3600, + "DT": 7200, "mpi_parts": 6, "threads": 4, - "tsteps": 720, + "tsteps": 360, "wallclock": 45, "kgo_checks": [], "plot_str": "sbr.py $NODAL_DATA_DIR/lfric_diag.nc $PLOT_DIR um70 80 71 sbr", @@ -199,10 +199,10 @@ {% do task_dict.update({ "opt_confs": ["sbr"], "resolution": "C96_MG", - "DT": 1800, + "DT": 3600, "mpi_parts": 96, "threads": 2, - "tsteps": 1440, + "tsteps": 720, "wallclock": 45, "memory": [72, "GB"], "kgo_checks": [], @@ -214,14 +214,14 @@ {% do task_dict.update({ "opt_confs": ["schar3d_cart"], "resolution": "BiP200x200-500x500", - "DT": 8, + "DT": 16, "mpi_parts": 25, "threads": 6, - "tsteps": 2250, + "tsteps": 1125, "use_xios": false, "wallclock": 90, "kgo_checks": [], - "plot_str": "cartesian_mountain_plot.py diagGungho $NODAL_DATA_DIR u 3 T002250 100 100 200 schar3d zoom_1 lines $PLOT_DIR", + "plot_str": "cartesian_mountain_plot.py diagGungho $NODAL_DATA_DIR u 3 T001125 100 100 200 schar3d zoom_1 lines $PLOT_DIR", }) %} {% elif task_ns.conf_name == "straka_50m-BiP1024x8-50x50" %} @@ -229,14 +229,14 @@ {% do task_dict.update({ "opt_confs": ["straka_50m"], "resolution": "BiP1024x8-50x50", - "DT": 1.25, + "DT": 2.5, "mpi_parts": 32, - "tsteps": 720, + "tsteps": 360, "panel_decomp": "row", "use_xios": false, "wallclock": 30, "kgo_checks": [], - "plot_str": "straka_plot_x.py diagGungho $NODAL_DATA_DIR 1024 8 theta T000720 $PLOT_DIR", + "plot_str": "straka_plot_x.py diagGungho $NODAL_DATA_DIR 1024 8 theta T000360 $PLOT_DIR", }) %} {% elif task_ns.conf_name == "straka_25m-BiP2048x8-25x25" %} @@ -244,14 +244,14 @@ {% do task_dict.update({ "opt_confs": ["straka_25m"], "resolution": "BiP2048x8-25x25", - "DT": 0.625, + "DT": 1.25, "mpi_parts": 128, - "tsteps": 1440, + "tsteps": 720, "panel_decomp": "row", "use_xios": false, "wallclock": 180, "kgo_checks": [], - "plot_str": "straka_plot_x.py diagGungho $NODAL_DATA_DIR 2048 8 theta T001440 $PLOT_DIR", + "plot_str": "straka_plot_x.py diagGungho $NODAL_DATA_DIR 2048 8 theta T000720 $PLOT_DIR", }) %} {% elif task_ns.conf_name == "warm3dbubble-BiP100x100-10x10" %} @@ -259,15 +259,15 @@ {% do task_dict.update({ "opt_confs": ["warm3dbubble"], "resolution": "BiP100x100-10x10", - "DT": 1.25, + "DT": 2.5, "panel_decomp": "row", "use_xios": false, "mpi_parts": 5, "threads": 3, - "tsteps": 360, + "tsteps": 180, "wallclock": 60, "kgo_checks": [], - "plot_str": "warm3dbubble.py diagGungho $NODAL_DATA_DIR 100 100 theta T000000:T000160:T000320 $PLOT_DIR" + "plot_str": "warm3dbubble.py diagGungho $NODAL_DATA_DIR 100 100 theta T000000:T000080:T000160 $PLOT_DIR" }) %} {% endif %} diff --git a/rose-stem/site/common/lfric_atm/tasks_lfric_atm.cylc b/rose-stem/site/common/lfric_atm/tasks_lfric_atm.cylc index b7e58ca4d..db63d2ad3 100644 --- a/rose-stem/site/common/lfric_atm/tasks_lfric_atm.cylc +++ b/rose-stem/site/common/lfric_atm/tasks_lfric_atm.cylc @@ -208,8 +208,8 @@ {% do task_dict.update({ "opt_confs": ["um_dump","june_case"], "resolution": "C224_MG", - "DT": 720, - "tsteps": 120, + "DT": 1200, + "tsteps": 72, "mpi_parts": 588, "xios_nodes": 1, "mpi_parts_xios" : 64, @@ -223,8 +223,8 @@ {% do task_dict.update({ "opt_confs": ["um_dump","june_case","oper_diags"], "resolution": "C224_MG", - "DT": 720, - "tsteps": 60, + "DT": 1200, + "tsteps": 36, "mpi_parts": 588, "xios_nodes": 1, "mpi_parts_xios" : 64, @@ -237,8 +237,8 @@ {% do task_dict.update({ "opt_confs": ["um_dump","june_case","no_diags"], "resolution": "C224_MG", - "DT": 720, - "tsteps": 6, + "DT": 1200, + "tsteps": 3, "mpi_parts": 588, "xios_nodes": 1, "mpi_parts_xios" : 64, @@ -250,8 +250,8 @@ {% do task_dict.update({ "opt_confs": ["um_dump"], "resolution": "C896_MG", - "DT": 240, - "tsteps": 120, + "DT": 600, + "tsteps": 48, "mpi_parts": 4704, "xios_nodes": 4, "mpi_parts_xios" : 32, @@ -638,8 +638,8 @@ {% do task_dict.update({ "opt_confs": ["l70_40km","ral3","ral_opts","murk","hh_solve"], "resolution": "uk_MG", - "DT": 60, - "tsteps": 360, + "DT": 120, + "tsteps": 180, "crun": 2, "crun_compare": false, "mpi_parts": 729, @@ -655,8 +655,8 @@ {% do task_dict.update({ "opt_confs": ["l70_40km","ral3","ral_opts","hh_solve"], "resolution": "uk_672x672_MG", - "DT": 60, - "tsteps": 180, + "DT": 120, + "tsteps": 90, "crun": 1, "crun_compare": false, "mpi_parts": 784, @@ -671,8 +671,8 @@ {% do task_dict.update({ "opt_confs": ["l70_40km","ral3","ral_opts","hh_solve"], "resolution": "ukv_MG", - "DT": 60, - "tsteps": 360, + "DT": 120, + "tsteps": 180, "mpi_parts": 2560, "xios_nodes": 4, "mpi_parts_xios" : 128, @@ -686,8 +686,8 @@ {% do task_dict.update({ "opt_confs": ["l70_40km","ral3","ral_opts","hh_solve"], "resolution": "melbourne_MG", - "DT": 60, - "tsteps": 360, + "DT": 120, + "tsteps": 180, "crun": 2, "crun_compare": false, "mpi_parts": 256, diff --git a/science/gungho/rose-meta/lfric-gungho/HEAD/rose-meta.conf b/science/gungho/rose-meta/lfric-gungho/HEAD/rose-meta.conf index 15f3d9684..ff10847ad 100644 --- a/science/gungho/rose-meta/lfric-gungho/HEAD/rose-meta.conf +++ b/science/gungho/rose-meta/lfric-gungho/HEAD/rose-meta.conf @@ -5694,8 +5694,8 @@ trigger=namelist:timestepping=tau_t: 'semi_implicit' ; =semi-implicit: 'semi_implicit' ; =namelist:timestepping=outer_iterations: 'semi_implicit', 'jules' ; =namelist:timestepping=inner_iterations: 'semi_implicit' ; -value-titles=Semi-implicit, Runge-Kutta, No-timestepping, JULES -values='semi_implicit', 'rk', 'no_timestepping', 'jules' +value-titles=Semi-implicit, Runge-Kutta, No-timestepping, JULES, TR-BDF2 +values='semi_implicit', 'rk', 'no_timestepping', 'jules', 'tr_bdf2' [namelist:timestepping=outer_iterations] compulsory=true @@ -5765,6 +5765,61 @@ range=0.0: sort-key=Panel-A04 type=real +#============================================================================== +# TR-BDF2 +#============================================================================== +[namelist:tr_bdf2] +compulsory=true +description=Options for the TR-BDF2 timestepping scheme/ +ns=namelist/Science/Dynamics +sort-key=Section-A10 + +[namelist:tr_bdf2=bdf2_inner_iterations] +compulsory=true +description=Number of inner iterations to perform in TR step. +fail-if=this < 1 ; +!kind=default +length=: +sort-key=Panel-A03 +type=integer + +[namelist:tr_bdf2=bdf2_outer_iterations] +compulsory=true +description=Number of outer iterations to perform in TR step. +fail-if=this < 1 ; +!kind=default +range=1: +sort-key=Panel-A03 +type=integer + + +[namelist:tr_bdf2=tr_inner_iterations_even] +compulsory=true +description=Number of inner iterations to perform in TR step on even timestep. +fail-if=this < 1 ; +!kind=default +length=: +sort-key=Panel-A03 +type=integer + +[namelist:tr_bdf2=tr_inner_iterations_odd] +compulsory=true +description=Number of inner iterations to perform in TR step on odd timestep. +fail-if=this < 1 ; +!kind=default +length=: +sort-key=Panel-A03 +type=integer + +[namelist:tr_bdf2=tr_outer_iterations] +compulsory=true +description=Number of outer iterations to perform in TR step. +fail-if=this < 1 ; +!kind=default +range=1: +sort-key=Panel-A03 +type=integer + #============================================================================== # TRANSPORT #============================================================================== diff --git a/science/gungho/source/algorithm/core_dynamics/rhs_alg_mod.x90 b/science/gungho/source/algorithm/core_dynamics/rhs_alg_mod.x90 index f78729ba9..c63dc1760 100644 --- a/science/gungho/source/algorithm/core_dynamics/rhs_alg_mod.x90 +++ b/science/gungho/source/algorithm/core_dynamics/rhs_alg_mod.x90 @@ -91,9 +91,10 @@ contains !> @param[in] dlayer_rhs Use damping layer in rhs yes/no !> @param[in] compute_rhs_t_d Compute rhs for the potential temperature !! and density + !> @param[in] stepper_name Enumerator for timestepper !> @param[in] model_clock Time in the model subroutine rhs_alg( rhs, alpha_dt, base_state, state, moist_dyn, compute_eos, & - compute_rhs_t_d, dlayer_rhs, model_clock ) + compute_rhs_t_d, dlayer_rhs, stepper_name, model_clock ) implicit none @@ -107,6 +108,7 @@ contains type(field_type), intent(inout) :: rhs(bundle_size) logical(kind=l_def), intent(in) :: compute_eos logical(kind=l_def), intent(in) :: compute_rhs_t_d + integer(kind=i_def), intent(in) :: stepper_name class(model_clock_type), intent(in) :: model_clock if ( (rhs(igh_u)%get_element_order_h() == 0) & @@ -114,10 +116,10 @@ contains .and. (.not. si_momentum_equation) & .and. (eos_method == eos_method_sampled) ) then call rhs_default_alg( rhs, alpha_dt, base_state, state, moist_dyn, compute_eos, & - compute_rhs_t_d, dlayer_rhs, model_clock ) + compute_rhs_t_d, dlayer_rhs, stepper_name, model_clock ) else call rhs_general_alg( rhs, alpha_dt, base_state, state, moist_dyn, compute_eos, & - compute_rhs_t_d, dlayer_rhs, model_clock ) + compute_rhs_t_d, dlayer_rhs, stepper_name, model_clock ) end if end subroutine rhs_alg @@ -125,7 +127,7 @@ contains !> @brief rhs algorithm for the default setup ( lowest order elements, !! explicit momentum advection, global and sampled eos) subroutine rhs_default_alg( rhs, alpha_dt, base_state, state, moist_dyn, compute_eos, & - compute_rhs_t_d, dlayer_rhs, model_clock ) + compute_rhs_t_d, dlayer_rhs, stepper_name, model_clock ) implicit none @@ -139,6 +141,7 @@ contains type(field_type), intent(inout) :: rhs(bundle_size) logical(kind=l_def), intent(in) :: compute_eos logical(kind=l_def), intent(in) :: compute_rhs_t_d + integer(kind=i_def), intent(in) :: stepper_name class(model_clock_type), intent(in) :: model_clock type(operator_type), pointer :: mm_vel => null(), & @@ -172,7 +175,9 @@ contains ! Using modified velocity mass matrix if needing damping layer if (dlayer_rhs) then - mm_vel => get_w2_mass_matrix(w2_damping_layer_matrix, mesh_id, model_clock) + mm_vel => get_w2_mass_matrix( & + w2_damping_layer_matrix, stepper_name, mesh_id, model_clock & + ) else mm_vel => get_mass_matrix_fv(W2, mesh_id) end if @@ -239,7 +244,7 @@ contains !> @brief rhs algorithm for any generic setup subroutine rhs_general_alg( rhs, alpha_dt, base_state, state, moist_dyn, compute_eos, & - compute_rhs_t_d, dlayer_rhs, model_clock ) + compute_rhs_t_d, dlayer_rhs, stepper_name, model_clock ) implicit none @@ -253,6 +258,7 @@ contains type(field_type), intent(inout) :: rhs(bundle_size) logical(kind=l_def), intent(in) :: compute_eos logical(kind=l_def), intent(in) :: compute_rhs_t_d + integer(kind=i_def), intent(in) :: stepper_name class(model_clock_type), intent(in) :: model_clock type(operator_type), pointer :: mm_vel => null(), & @@ -302,7 +308,9 @@ contains ! Using modified velocity mass matrix if needing damping layer if (dlayer_rhs) then - mm_vel => get_w2_mass_matrix(w2_damping_layer_matrix, mesh_id, model_clock) + mm_vel => get_w2_mass_matrix( & + w2_damping_layer_matrix, stepper_name, mesh_id, model_clock & + ) else mm_vel => get_mass_matrix_fe(W2, mesh_id) end if diff --git a/science/gungho/source/algorithm/runtime_constants/dycore_constants_mod.x90 b/science/gungho/source/algorithm/runtime_constants/dycore_constants_mod.x90 index 9421aba5b..0dbe1cdf6 100644 --- a/science/gungho/source/algorithm/runtime_constants/dycore_constants_mod.x90 +++ b/science/gungho/source/algorithm/runtime_constants/dycore_constants_mod.x90 @@ -54,9 +54,15 @@ module dycore_constants_mod type(inventory_by_mesh_type) :: geopotential_inventory type(inventory_by_mesh_type) :: coriolis_inventory type(inventory_by_mesh_type) :: vert_coriolis_inventory - type(inventory_by_mesh_type), target :: mm_w2_dl_inventory - type(inventory_by_mesh_type), target :: mm_w2_si_inventory - type(inventory_by_mesh_type), target :: mm_w2_dl_lagged_inventory + type(inventory_by_mesh_type), target :: mm_w2_dl_siqn_inventory + type(inventory_by_mesh_type), target :: mm_w2_si_siqn_inventory + type(inventory_by_mesh_type), target :: mm_w2_dl_lagged_siqn_inventory + type(inventory_by_mesh_type), target :: mm_w2_dl_tr_inventory + type(inventory_by_mesh_type), target :: mm_w2_si_tr_inventory + type(inventory_by_mesh_type), target :: mm_w2_dl_lagged_tr_inventory + type(inventory_by_mesh_type), target :: mm_w2_dl_bdf2_inventory + type(inventory_by_mesh_type), target :: mm_w2_si_bdf2_inventory + type(inventory_by_mesh_type), target :: mm_w2_dl_lagged_bdf2_inventory ! ========================================================================== ! ! Public enumerated types for selecting W2 mass matrices @@ -66,6 +72,11 @@ module dycore_constants_mod integer(kind=i_def), parameter, public :: w2_lagged_damping_layer_matrix = 4374 integer(kind=i_def), parameter, public :: w2_si_matrix = 891 + ! Timestepping enumerators + integer(kind=i_def), parameter, public :: stepper_tr = -46 + integer(kind=i_def), parameter, public :: stepper_bdf2 = 657 + integer(kind=i_def), parameter, public :: stepper_siqn = 222 + ! ========================================================================== ! ! Public functions for accessing the module contents ! ========================================================================== ! @@ -249,6 +260,8 @@ contains end function get_geopotential !> @brief Returns a pointer to a generalised W2 mass matrix operator + !> @param[in] w2_op_name The enumerated name of the W2 mass matrix operator + !> @param[in] stepper_name The name of the time stepper being used !> @param[in] mesh_id The ID of the mesh to get the object for !> @param[in] model_clock The model clock object !! @TODO #490: @@ -256,7 +269,8 @@ contains !! to pass it from all parts of the model (in particular from the !! apply method in the mixed operator) !> @return A generalised W2 mass matrix operator for the dynamical core - function get_w2_mass_matrix(w2_op_name, mesh_id, model_clock) result(dynamics_mm_w2) + function get_w2_mass_matrix(w2_op_name, stepper_name, mesh_id, model_clock) & + result(dynamics_mm_w2) use compute_dl_matrix_kernel_mod, only: compute_dl_matrix_kernel_type use damping_layer_config_mod, only: dl_base, dl_str @@ -274,12 +288,16 @@ contains implicit none integer(kind=i_def), intent(in) :: w2_op_name + integer(kind=i_def), intent(in) :: stepper_name integer(kind=i_def), intent(in) :: mesh_id class(model_clock_type), optional, intent(in) :: model_clock type(mesh_type), pointer :: mesh logical(kind=l_def) :: constant_exists type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory + type(inventory_by_mesh_type), pointer :: dl_inventory + type(inventory_by_mesh_type), pointer :: dl_lagged_inventory + type(inventory_by_mesh_type), pointer :: si_inventory type(operator_type), pointer :: dynamics_mm_w2 type(operator_type), target :: mm_w2_tmp type(operator_type), target :: mm_w2_tmp2 @@ -292,18 +310,38 @@ contains type(quadrature_xyoz_type), pointer :: qr real(kind=r_def) :: const real(kind=r_second) :: dt + real(kind=r_second) :: dt_to_use + real(kind=r_def) :: gamma, gamma2 type(operator_type), pointer :: coriolis ! Check inventories are initialised - if (.not. mm_w2_si_inventory%is_initialised()) then - ! Initialise all inventories together - call mm_w2_si_inventory%initialise(name='mm_w2_si') - call mm_w2_dl_inventory%initialise(name='mm_w2_dl') - call mm_w2_dl_lagged_inventory%initialise(name='mm_w2_dl_lagged') - if (present(model_clock)) then - dt_stored = model_clock%get_seconds_per_step() + select case (stepper_name) + case (stepper_siqn) + if (.not. mm_w2_si_siqn_inventory%is_initialised()) then + ! Initialise all inventories together + call mm_w2_si_siqn_inventory%initialise(name='mm_w2_si') + call mm_w2_dl_siqn_inventory%initialise(name='mm_w2_dl') + call mm_w2_dl_lagged_siqn_inventory%initialise(name='mm_w2_dl_lagged') + if (present(model_clock)) then + dt_stored = model_clock%get_seconds_per_step() + end if end if - end if + + case (stepper_tr, stepper_bdf2) + if (.not. mm_w2_si_tr_inventory%is_initialised()) then + ! Initialise all inventories together + call mm_w2_si_tr_inventory%initialise(name='mm_w2_si_tr') + call mm_w2_dl_tr_inventory%initialise(name='mm_w2_dl_tr') + call mm_w2_dl_lagged_tr_inventory%initialise(name='mm_w2_dl_lagged_tr') + call mm_w2_si_bdf2_inventory%initialise(name='mm_w2_si_bdf2') + call mm_w2_dl_bdf2_inventory%initialise(name='mm_w2_dl_bdf2') + call mm_w2_dl_lagged_bdf2_inventory%initialise(name='mm_w2_dl_lagged_bdf2') + if (present(model_clock)) then + dt_stored = model_clock%get_seconds_per_step() + end if + end if + + end select ! Check this constant is still valid -- is the model time step the same? ! Can only do this if model_clock is present @@ -319,16 +357,73 @@ contains end if ! Determine which inventory to point to + select case (stepper_name) + case (stepper_siqn) + dl_inventory => mm_w2_dl_siqn_inventory + dl_lagged_inventory => mm_w2_dl_lagged_siqn_inventory + si_inventory => mm_w2_si_siqn_inventory + case (stepper_tr) + dl_inventory => mm_w2_dl_tr_inventory + dl_lagged_inventory => mm_w2_dl_lagged_tr_inventory + si_inventory => mm_w2_si_tr_inventory + case (stepper_bdf2) + dl_inventory => mm_w2_dl_bdf2_inventory + dl_lagged_inventory => mm_w2_dl_lagged_bdf2_inventory + si_inventory => mm_w2_si_bdf2_inventory + end select + select case (w2_op_name) - case(w2_damping_layer_matrix) - inventory => mm_w2_dl_inventory - case(w2_lagged_damping_layer_matrix) - ! @TODO #416: this should be an inventory of r_solver operators - ! as the r_def operators are not used anywhere - inventory => mm_w2_dl_lagged_inventory - case(w2_si_matrix) - inventory => mm_w2_si_inventory + case (w2_damping_layer_matrix) + select case (stepper_name) + case (stepper_siqn) + inventory => mm_w2_dl_siqn_inventory + case (stepper_tr) + inventory => mm_w2_dl_tr_inventory + case (stepper_bdf2) + inventory => mm_w2_dl_bdf2_inventory case default + dynamics_mm_w2 => null() + call log_event( & + 'Dynamics W2 mass matrix does not exist', LOG_LEVEL_ERROR & + ) + stop + end select + + case (w2_lagged_damping_layer_matrix) + ! @TODO #416: this should be an inventory of r_solver operators + ! as the r_def operators are not used anywhere + select case (stepper_name) + case (stepper_siqn) + inventory => mm_w2_dl_lagged_siqn_inventory + case (stepper_tr) + inventory => mm_w2_dl_lagged_tr_inventory + case (stepper_bdf2) + inventory => mm_w2_dl_lagged_bdf2_inventory + case default + dynamics_mm_w2 => null() + call log_event( & + 'Dynamics W2 mass matrix does not exist', LOG_LEVEL_ERROR & + ) + stop + end select + + case (w2_si_matrix) + select case (stepper_name) + case (stepper_siqn) + inventory => mm_w2_si_siqn_inventory + case (stepper_tr) + inventory => mm_w2_si_tr_inventory + case (stepper_bdf2) + inventory => mm_w2_si_bdf2_inventory + case default + dynamics_mm_w2 => null() + call log_event( & + 'Dynamics W2 mass matrix does not exist', LOG_LEVEL_ERROR & + ) + stop + end select + + case default dynamics_mm_w2 => null() call log_event('Dynamics W2 mass matrix does not exist', LOG_LEVEL_ERROR) stop @@ -339,8 +434,17 @@ contains if (.not. constant_exists) then ! Create the relevant W2 mass matrices - fs => function_space_collection%get_fs(mesh, element_order_h, & - element_order_v, W2) + fs => function_space_collection%get_fs( & + mesh, element_order_h, element_order_v, W2 & + ) + + select case (stepper_name) + case (stepper_siqn, stepper_bdf2) + dt_to_use = dt_stored + case (stepper_tr) + gamma = 1.0_r_def - 0.5_r_def*SQRT(2.0_r_def) + dt_to_use = 2.0_r_second*REAL(gamma, r_second)*dt_stored + end select ! Each matrix is built on a previous matrix. Generally either all three ! matrices are needed, or only the S.I. matrix (the final in the chain) @@ -350,14 +454,14 @@ contains ! ====================================================================== ! ! DAMPING LAYER MATRIX ! ====================================================================== ! - if (mm_w2_dl_inventory%paired_object_exists(mesh_id)) then + if (dl_inventory%paired_object_exists(mesh_id)) then ! Get existing matrix - call mm_w2_dl_inventory%get_operator(mesh, mm_w2_dl) + call dl_inventory%get_operator(mesh, mm_w2_dl) else ! We are going to need to create this matrix if (w2_op_name == w2_damping_layer_matrix) then ! This is our target matrix, so store it - call mm_w2_dl_inventory%add_operator(mm_w2_dl, fs, fs, mesh) + call dl_inventory%add_operator(mm_w2_dl, fs, fs, mesh) else ! Assume that this matrix is only used to create another, so ! make a temporary matrix @@ -379,7 +483,7 @@ contains planet_radius, & element_order_h, & element_order_v, & - dt_stored, & + dt_to_use, & qr) ) if ( subroutine_timers ) call timer('runtime_constants.dycore') else @@ -394,16 +498,16 @@ contains ! ====================================================================== ! ! @TODO: logic here is probably not optimal if (w2_op_name /= w2_damping_layer_matrix) then - if (mm_w2_dl_lagged_inventory%paired_object_exists(mesh_id)) then + if (dl_lagged_inventory%paired_object_exists(mesh_id)) then ! Get existing matrix - call mm_w2_dl_lagged_inventory%get_operator(mesh, mm_w2_dl_lagged) + call dl_lagged_inventory%get_operator(mesh, mm_w2_dl_lagged) else ! We are going to need to create this matrix if ( subroutine_timers ) call timer('runtime_constants.dycore') if (w2_op_name == w2_lagged_damping_layer_matrix) then ! This is our target matrix, so store it - call mm_w2_dl_lagged_inventory%add_operator(mm_w2_dl_lagged, fs, fs, mesh) + call dl_lagged_inventory%add_operator(mm_w2_dl_lagged, fs, fs, mesh) else ! Assume that this matrix is only used to create another, so ! make a temporary matrix @@ -432,10 +536,22 @@ contains ! ====================================================================== ! if (w2_op_name == w2_si_matrix) then if ( subroutine_timers ) call timer('runtime_constants.dycore') - call mm_w2_si_inventory%add_operator(mm_w2_si, fs, fs, mesh) + call si_inventory%add_operator(mm_w2_si, fs, fs, mesh) if ( rotating ) then - const = tau_u * real(dt_stored, r_def) + select case (stepper_name) + case (stepper_siqn) + const = tau_u * real(dt_stored, r_def) + case (stepper_tr) + ! tau_u = gamma + gamma = 1.0_r_def - 0.5_r_def*SQRT(2.0_r_def) + const = gamma * real(dt_stored, r_def) + case (stepper_bdf2) + ! tau_u = gamma2 + gamma = 1.0_r_def - 0.5_r_def*SQRT(2.0_r_def) + gamma2 = 0.5_r_def*(1.0_r_def - 2.0_r_def*gamma)/(1.0_r_def - gamma) + const = gamma2 * real(dt_stored, r_def) + end select else const = 0.0_r_def end if @@ -470,9 +586,15 @@ contains call geopotential_inventory%clear() call vert_coriolis_inventory%clear() call coriolis_inventory%clear() - call mm_w2_dl_inventory%clear() - call mm_w2_dl_lagged_inventory%clear() - call mm_w2_si_inventory%clear() + call mm_w2_dl_siqn_inventory%clear() + call mm_w2_si_siqn_inventory%clear() + call mm_w2_dl_lagged_siqn_inventory%clear() + call mm_w2_dl_tr_inventory%clear() + call mm_w2_si_tr_inventory%clear() + call mm_w2_dl_lagged_tr_inventory%clear() + call mm_w2_dl_bdf2_inventory%clear() + call mm_w2_si_bdf2_inventory%clear() + call mm_w2_dl_lagged_bdf2_inventory%clear() dt_stored = 0.0_r_second end subroutine final_dycore_constants diff --git a/science/gungho/source/algorithm/runtime_constants/solver_constants_mod.x90 b/science/gungho/source/algorithm/runtime_constants/solver_constants_mod.x90 index 2070e1038..32f28edef 100644 --- a/science/gungho/source/algorithm/runtime_constants/solver_constants_mod.x90 +++ b/science/gungho/source/algorithm/runtime_constants/solver_constants_mod.x90 @@ -64,7 +64,9 @@ module solver_constants_mod type(inventory_by_mesh_type), target :: im3_div_r_solver_inventory ! Special dynamical core r_solver matrices - type(inventory_by_mesh_type), target :: mm_w2_si_r_solver_inventory + type(inventory_by_mesh_type), target :: mm_w2_si_siqn_r_solver_inventory + type(inventory_by_mesh_type), target :: mm_w2_si_tr_r_solver_inventory + type(inventory_by_mesh_type), target :: mm_w2_si_bdf2_r_solver_inventory ! Normalisations type(inventory_by_mesh_type) :: w2_normalisation_inventory @@ -268,15 +270,20 @@ contains ! ========================================================================== ! !> @brief Returns a pointer to a generalised W2 mass matrix operator + !> @param[in] w2_op_name The type of W2 mass matrix operator to get + !> @param[in] stepper_name The time stepper being used !> @param[in] mesh_id The ID of the mesh to get the object for !> @return The semi-implicit W2 mass matrix operator - function get_w2_mass_matrix_r_solver(w2_op_name, mesh_id) result(mm_r_solver) + function get_w2_mass_matrix_r_solver(w2_op_name, stepper_name, mesh_id) & + result(mm_r_solver) - use dycore_constants_mod, only: get_w2_mass_matrix, w2_si_matrix + use dycore_constants_mod, only: get_w2_mass_matrix, w2_si_matrix, & + stepper_siqn, stepper_tr, stepper_bdf2 implicit none integer(kind=i_def), intent(in) :: w2_op_name + integer(kind=i_def), intent(in) :: stepper_name integer(kind=i_def), intent(in) :: mesh_id type(mesh_type), pointer :: mesh logical(kind=l_def) :: constant_exists @@ -284,20 +291,40 @@ contains type(operator_type), pointer :: mm_r_def type(r_solver_operator_type), pointer :: mm_r_solver type(inventory_by_mesh_type), pointer :: inventory + character(len=str_def) :: name ! Determine which inventory to point to select case (w2_op_name) - case(w2_si_matrix) - inventory => mm_w2_si_r_solver_inventory + case (w2_si_matrix) + select case (stepper_name) + case (stepper_siqn) + name = 'mm_w2_si_siqn_r_solver' + inventory => mm_w2_si_siqn_r_solver_inventory + case (stepper_tr) + name = 'mm_w2_si_tr_r_solver' + inventory => mm_w2_si_tr_r_solver_inventory + case (stepper_bdf2) + name = 'mm_w2_si_bdf2_r_solver' + inventory => mm_w2_si_bdf2_r_solver_inventory case default mm_r_solver => null() - call log_event('r_solver dynamics W2 mass matrix does not exist', LOG_LEVEL_ERROR) + call log_event( & + 'r_solver dynamics W2 mass matrix does not exist', LOG_LEVEL_ERROR & + ) stop + end select + + case default + mm_r_solver => null() + call log_event( & + 'r_solver dynamics W2 mass matrix does not exist', LOG_LEVEL_ERROR & + ) + stop end select ! Initialise inventory if this is the first time getting this constant - if (.not. mm_w2_si_r_solver_inventory%is_initialised()) then - call mm_w2_si_r_solver_inventory%initialise(name='mm_w2_si_r_solver') + if (.not. inventory%is_initialised()) then + call inventory%initialise(name=name) end if mesh => mesh_collection%get_mesh(mesh_id) @@ -305,7 +332,7 @@ contains if (.not. constant_exists) then ! Create constant if it doesn't already exist - mm_r_def => get_w2_mass_matrix(w2_op_name, mesh_id) + mm_r_def => get_w2_mass_matrix(w2_op_name, stepper_name, mesh_id) if ( subroutine_timers ) call timer('runtime_constants.solver') @@ -526,7 +553,9 @@ contains call w2_normalisation_inventory%clear() call mm_w2_r_solver_inventory%clear() - call mm_w2_si_r_solver_inventory%clear() + call mm_w2_si_siqn_r_solver_inventory%clear() + call mm_w2_si_tr_r_solver_inventory%clear() + call mm_w2_si_bdf2_r_solver_inventory%clear() call mm_wtheta_r_solver_inventory%clear() call mm_w3_inv_r_solver_inventory%clear() call detj_at_w3_r_solver_inventory%clear() diff --git a/science/gungho/source/algorithm/solver/lam_rhs_alg_mod.x90 b/science/gungho/source/algorithm/solver/lam_rhs_alg_mod.x90 index 17342e738..ff23b6bc6 100644 --- a/science/gungho/source/algorithm/solver/lam_rhs_alg_mod.x90 +++ b/science/gungho/source/algorithm/solver/lam_rhs_alg_mod.x90 @@ -19,8 +19,11 @@ module lam_rhs_alg_mod use derived_config_mod, only: bundle_size use si_operators_alg_mod, only: get_rho_at_u use sci_fem_constants_mod, only: get_im3_div_fe - use dycore_constants_mod, only: get_w2_mass_matrix, & - w2_si_matrix + use dycore_constants_mod, only: get_w2_mass_matrix, & + w2_si_matrix, & + stepper_siqn, & + stepper_tr, & + stepper_bdf2 use limited_area_constants_mod, only: get_mask_fe use fs_continuity_mod, only: W2, W3, Wtheta use field_mod, only: field_type @@ -88,9 +91,10 @@ contains !> @param[in] model_clock Time in the model !> @param[in] finest_mesh_name Name of the finest mesh !> @param[in] tau_r Relaxation parameter for density in semi-implicit method + !> @param[in] stepper_name Enumerator for timestepper !> @param[in] subroutine_timers Enable output of subroutine runtimes subroutine calc_rhs_lbc( rhs, lbc_fields, model_clock, finest_mesh_name, & - tau_r, subroutine_timers ) + tau_r, stepper_name, subroutine_timers ) implicit none @@ -99,6 +103,7 @@ contains class(model_clock_type), intent(in) :: model_clock character(len=str_def), intent(in) :: finest_mesh_name real(r_def), intent(in) :: tau_r + integer(i_def), intent(in) :: stepper_name logical(l_def), intent(in) :: subroutine_timers type(field_type), pointer :: boundary_u => null() @@ -115,6 +120,7 @@ contains w3_mask => null(), & wtheta_mask => null() real(r_def) :: dt + real(r_def) :: gamma real(r_def) :: tau_r_dt integer(i_def) :: mesh_id @@ -126,7 +132,16 @@ contains mesh_id = rhs(igh_u)%get_mesh_id() dt = real(model_clock%get_seconds_per_step(), r_def) - tau_r_dt = tau_r*dt + + select case (stepper_name) + case (stepper_siqn) + tau_r_dt = tau_r*dt + case (stepper_tr) + gamma = 1.0_r_def - 0.5_r_def * SQRT(2.0_r_def) + tau_r_dt = 2.0_r_def*gamma*dt + case (stepper_bdf2) + tau_r_dt = dt + end select ! Get the LBC data call lbc_fields%get_field('boundary_u_diff', boundary_u) @@ -140,7 +155,7 @@ contains div => get_im3_div_fe(mesh_id) ! m2 (or dl) + tau_u*dt*coriolis (lagged if required) - mm_vel => get_w2_mass_matrix(w2_si_matrix, mesh_id, model_clock) + mm_vel => get_w2_mass_matrix(w2_si_matrix, stepper_name, mesh_id, model_clock) ! Obtain operators from SI operators r_solver_rho_at_u => get_rho_at_u() diff --git a/science/gungho/source/algorithm/solver/mixed_operator_alg_mod.x90 b/science/gungho/source/algorithm/solver/mixed_operator_alg_mod.x90 index 72454b170..e3e6a17b2 100644 --- a/science/gungho/source/algorithm/solver/mixed_operator_alg_mod.x90 +++ b/science/gungho/source/algorithm/solver/mixed_operator_alg_mod.x90 @@ -63,7 +63,6 @@ module mixed_operator_alg_mod use split_w2_field_kernel_mod, only: split_w2_field_kernel_type use vector_mod, only: abstract_vector_type use formulation_config_mod, only: p2theta_vert - use model_clock_mod, only: model_clock_type implicit none @@ -73,6 +72,9 @@ module mixed_operator_alg_mod mixed_operator_type private + ! Enumerator for timestepping scheme + integer(kind=i_def) :: stepper_name + contains !> Over-ride the abstract interface @@ -86,8 +88,25 @@ module mixed_operator_alg_mod final :: destroy_mixed_operator end type mixed_operator_type + interface mixed_operator_type + module procedure mixed_operator_constructor + end interface + contains + !> @brief Constructor for the mixed operator + !> @param[in] stepper_name Enumerator for the timestepping scheme + function mixed_operator_constructor(stepper_name) result(self) + + implicit none + + integer(kind=i_def), intent(in) :: stepper_name + type(mixed_operator_type) :: self + + self%stepper_name = stepper_name + + end function mixed_operator_constructor + !> @brief Applies the mixed operator to the vector, \f$ y = M x \f$. !> !> @param[in,out] self Instance of the mixed operator @@ -97,7 +116,6 @@ contains use boundaries_config_mod, only: limited_area use io_config_mod, only: subroutine_timers - use timestepping_config_mod, only: dt, tau_r use timer_mod, only: timer use field_indices_mod, only: isol_u, isol_p, & isol_w, isol_uv @@ -200,14 +218,16 @@ contains mt_lumped_inv => get_normalisation_r_solver(Wtheta, mesh%get_id()) m2_diag => get_normalisation_r_solver(W2, mesh%get_id()) ! mm_vel = m2 (or dl) + tau_u*dt*coriolis - mm_vel => get_w2_mass_matrix_r_solver(w2_si_matrix, mesh%get_id()) + mm_vel => get_w2_mass_matrix_r_solver( & + w2_si_matrix, self%stepper_name, mesh%get_id() & + ) ! Obtain operators from SI operators - p2theta => get_p2theta() - div_star => get_div_star() - ptheta2 => get_ptheta2() - m3_exner_star => get_m3_exner_star() - p3theta => get_p3theta() + p2theta => get_p2theta(self%stepper_name) + div_star => get_div_star(self%stepper_name) + ptheta2 => get_ptheta2(self%stepper_name) + m3_exner_star => get_m3_exner_star(self%stepper_name) + p3theta => get_p3theta(self%stepper_name) select type (x) type is (r_solver_field_vector_type) @@ -254,7 +274,7 @@ contains select case ( eliminate_variables ) case ( eliminate_variables_discrete ) - q32_op => get_eliminated_q32() + q32_op => get_eliminated_q32(self%stepper_name) if ( optimised_operator ) then call invoke( name="apply_mixed_operator_new", & setval_c( yvec_uv, 0.0_r_solver ), & @@ -296,8 +316,8 @@ contains ! For analytic elimination: ! Q32 = tau*dt*M3^rho * D * rho^ref + ! and x_t = 0 - q32_op => get_eliminated_q32() - q22_op => get_eliminated_q22() + q32_op => get_eliminated_q32(self%stepper_name) + q22_op => get_eliminated_q22(self%stepper_name) call q22u%initialise( vector_space = u_fs ) call invoke( name="analytic_elim_mixed_lhs", & setval_c( x_t, 0.0_r_solver ), & diff --git a/science/gungho/source/algorithm/solver/mixed_schur_preconditioner_alg_mod.x90 b/science/gungho/source/algorithm/solver/mixed_schur_preconditioner_alg_mod.x90 index e9f613b8c..4432c823e 100644 --- a/science/gungho/source/algorithm/solver/mixed_schur_preconditioner_alg_mod.x90 +++ b/science/gungho/source/algorithm/solver/mixed_schur_preconditioner_alg_mod.x90 @@ -133,33 +133,35 @@ module mixed_schur_preconditioner_alg_mod type, public, extends(abstract_preconditioner_type) :: & mixed_schur_preconditioner_type - private - - !> modified right-hand \f$\textbf{R}_u^*\f$ - type(r_solver_field_type) :: rhs_u - !> 1-component field vector for right hand side in pressure system - type(r_solver_field_vector_type) :: pressure_b - !> 1-component field vector for solution of pressure system - type(r_solver_field_vector_type) :: pressure_x - !> Pressure (Helmholtz) solver object - class(abstract_iterative_solver_type), pointer :: & - pressure_solver - - contains - ! Override the (abstract interface) for application of - ! a preconditioner \f$y = P.x\f$ - procedure, public :: apply => apply_mixed_schur_preconditioner - procedure, private :: apply_mixed_schur_preconditioner - - !> Private methods - !> Build the right-hand-side for the Helmholtz equation - procedure, private :: build_pressure_rhs - !> Reconstruct the velocity and buoyancy from the solution of the - !> Helmholtz equation - procedure, private :: back_substitute - - !> Destructor - final :: destroy_mixed_schur_preconditioner + private + + !> modified right-hand \f$\textbf{R}_u^*\f$ + type(r_solver_field_type) :: rhs_u + !> 1-component field vector for right hand side in pressure system + type(r_solver_field_vector_type) :: pressure_b + !> 1-component field vector for solution of pressure system + type(r_solver_field_vector_type) :: pressure_x + !> Pressure (Helmholtz) solver object + class(abstract_iterative_solver_type), pointer :: & + pressure_solver + + integer(kind=i_def) :: stepper_name + + contains + ! Override the (abstract interface) for application of + ! a preconditioner \f$y = P.x\f$ + procedure, public :: apply => apply_mixed_schur_preconditioner + procedure, private :: apply_mixed_schur_preconditioner + + !> Private methods + !> Build the right-hand-side for the Helmholtz equation + procedure, private :: build_pressure_rhs + !> Reconstruct the velocity and buoyancy from the solution of the + !> Helmholtz equation + procedure, private :: back_substitute + + !> Destructor + final :: destroy_mixed_schur_preconditioner end type mixed_schur_preconditioner_type ! Overload the default structure constructor @@ -182,10 +184,12 @@ contains !> @param [in] mesh Mesh to create function spaces on !> @param [in] element_order_h Horizontal element order for function spaces !> @param [in] element_order_v Vertical element order for function spaces + !> @param [in] stepper_name Enumerator for timestepper !> @param [in] pressure_solver Solver object for Helmholtz system !> @return self the constructed preconditioner object function mixed_schur_preconditioner_constructor(mesh, element_order_h, & element_order_v, & + stepper_name, & pressure_solver) & result(self) @@ -197,6 +201,7 @@ contains integer(i_def), intent(in) :: element_order_h integer(i_def), intent(in) :: element_order_v + integer(i_def), intent(in) :: stepper_name type(mesh_type), target, intent(in) :: mesh class(abstract_iterative_solver_type), target, intent(in) :: pressure_solver @@ -226,6 +231,8 @@ contains ! Set pressure solver self%pressure_solver => pressure_solver + self%stepper_name = stepper_name + call log_event( 'done', LOG_LEVEL_DEBUG ) end function mixed_schur_preconditioner_constructor @@ -362,11 +369,11 @@ contains call invoke( setval_X( rhs_uvw, rhs_uv ) ) end if - ptheta2 => get_ptheta2v() - p3theta => get_p3theta() - m3_rho_star => get_m3_rho_star() - compound_div => get_compound_div() - Hb_lumped_inv => get_Hb_lumped_inv() + ptheta2 => get_ptheta2v(self%stepper_name) + p3theta => get_p3theta(self%stepper_name) + m3_rho_star => get_m3_rho_star(self%stepper_name) + compound_div => get_compound_div(self%stepper_name) + Hb_lumped_inv => get_Hb_lumped_inv(self%stepper_name) ! Compute rhs_u terms call invoke( name = "compute_elim_helmholtz_ru", & @@ -379,7 +386,7 @@ contains ! Compute H(rhs_u) if ( eliminate_variables == eliminate_variables_analytic ) then ! r_pi = rhs_pi - Q32*rhs_u - q32_op => get_eliminated_q32() + q32_op => get_eliminated_q32(self%stepper_name) call r_p%initialise( rhs%get_function_space() ) call invoke( dg_matrix_vector_kernel_type(r_p, self%rhs_u, q32_op), & X_minus_Y(rhs, rhs_p, r_p ) ) @@ -410,7 +417,7 @@ contains end if if ( normalise ) then - h_diag => get_helm_diag() + h_diag => get_helm_diag(self%stepper_name) call invoke( inc_X_times_Y(rhs, h_diag) ) end if @@ -463,8 +470,8 @@ contains ! u increment u_normalisation => get_normalisation_r_solver(W2, mesh_id) - div_star => get_div_star() - Hb_lumped_inv => get_Hb_lumped_inv() + div_star => get_div_star(self%stepper_name) + Hb_lumped_inv => get_Hb_lumped_inv(self%stepper_name) ! u' = ru + BC[HB * unorm * D * p'] if ( split_w ) then state_uv => state%get_field_from_position( isol_uv ) diff --git a/science/gungho/source/algorithm/solver/multigrid_preconditioner_alg_mod.x90 b/science/gungho/source/algorithm/solver/multigrid_preconditioner_alg_mod.x90 index deff82faa..1cff2fb16 100644 --- a/science/gungho/source/algorithm/solver/multigrid_preconditioner_alg_mod.x90 +++ b/science/gungho/source/algorithm/solver/multigrid_preconditioner_alg_mod.x90 @@ -62,6 +62,8 @@ module multigrid_preconditioner_alg_mod type(r_solver_field_vector_type), dimension(:), allocatable :: r_mg !> Mask on all levels type(r_solver_field_vector_type), dimension(:), allocatable :: mask_mg + !> Stepper name + integer(kind=i_def) :: stepper_name !> Jacobi smoothing parameter, before integer(kind=i_def) :: n_presmooth @@ -100,15 +102,17 @@ contains !> @param[in] H_op Pressure operator on finest level !> @param[in] Hz_prec Pressure preconditioner on finest level !> @return self The constructed multigrid_preconditioner type - function multigrid_preconditioner_constructor(p_fs, & - H_op, & - Hz_prec) result(self) + function multigrid_preconditioner_constructor(stepper_name, p_fs, & + H_op, Hz_prec) result(self) + use multigrid_config_mod, only : smooth_relaxation, & n_presmooth, & n_postsmooth, & n_coarsesmooth, & multigrid_chain_nitems implicit none + + integer(kind=i_def), intent(in) :: stepper_name type(function_space_type), intent(in) :: p_fs class(abstract_hierarchical_linear_operator_type) :: H_op class(abstract_hierarchical_preconditioner_type) :: Hz_prec @@ -119,6 +123,7 @@ contains self%n_postsmooth = n_postsmooth self%n_coarsesmooth = n_coarsesmooth self%n_level = multigrid_chain_nitems + self%stepper_name = stepper_name write(log_scratch_space,'(A,I0,A,":",F3.1,3(":",I0))') & "Multigrid_preconditioner_constructor[",self%n_level,"]: setting smoothing parameters", & diff --git a/science/gungho/source/algorithm/solver/pressure_operator_alg_mod.x90 b/science/gungho/source/algorithm/solver/pressure_operator_alg_mod.x90 index cbc33df07..fa1bd02bf 100644 --- a/science/gungho/source/algorithm/solver/pressure_operator_alg_mod.x90 +++ b/science/gungho/source/algorithm/solver/pressure_operator_alg_mod.x90 @@ -56,6 +56,7 @@ module pressure_operator_alg_mod private !> Level of the operator (used for multigrid) integer(kind=i_def) :: level + integer(kind=i_def) :: stepper_name contains !> Over-ride the abstract interface !> param[in] self A linear operator @@ -89,18 +90,21 @@ contains !! inverse \f$ \tilde{H}_b^{-1} \f$ as well as other operators !! such as div and grad for the Helmholtz operator application. !> - !> @param[in] level The mesh level the space is on + !> @param[in] level The mesh level the space is on + !> @param[in] stepper_name The name of the time stepper !> @return Instance of the Helmholtz operator - function pressure_operator_constructor(level) result(self) + function pressure_operator_constructor(level, stepper_name) result(self) implicit none type(pressure_operator_type) :: self integer(kind=i_def), intent(in) :: level + integer(kind=i_def), intent(in) :: stepper_name call log_event( 'Constructing pressure operator...', LOG_LEVEL_INFO ) ! Temporaries required in operator application self%level = level + self%stepper_name = stepper_name call log_event( 'done', LOG_LEVEL_INFO ) @@ -119,6 +123,7 @@ contains ! Deep copy of the contents of the pressure_operator_type dest%level = source%level + dest%stepper_name = source%stepper_name end subroutine pressure_operator_assign !> @brief Apply Helmholtz operator to a pressure field to obtain \f$y=Hx\f$. @@ -179,7 +184,7 @@ contains y_vec => y%get_field_from_position(1) if ( x_vec%get_element_order_h() == 0 .and. & x_vec%get_element_order_v() == 0 ) then - Helmholtz_operator => get_helmholtz_operator(self%level) + Helmholtz_operator => get_helmholtz_operator(self%stepper_name, self%level) lam_mesh=.false. if (limited_area .and. topology==topology_non_periodic) lam_mesh=.true. @@ -192,14 +197,14 @@ contains lam_mesh) ) nullify( Helmholtz_operator ) else - m3_exner_star => get_m3_exner_star(self%level) - div_star => get_div_star(self%level) - compound_div => get_compound_div(self%level) - ptheta2 => get_ptheta2v(self%level) + m3_exner_star => get_m3_exner_star(self%stepper_name, self%level) + div_star => get_div_star(self%stepper_name, self%level) + compound_div => get_compound_div(self%stepper_name, self%level) + ptheta2 => get_ptheta2v(self%stepper_name, self%level) mt_lumped_inv => get_normalisation_r_solver(Wtheta, mesh_id) - p3theta => get_p3theta(self%level) + p3theta => get_p3theta(self%stepper_name, self%level) u_normalisation => get_normalisation_r_solver(W2, mesh_id) - hb_lumped_inv => get_hb_lumped_inv(self%level) + hb_lumped_inv => get_hb_lumped_inv(self%stepper_name, self%level) call grad_p%initialise( hb_lumped_inv%get_function_space() ) if ( limited_area ) then w2_mask => get_mask_r_solver(W2, mesh_id, prime_mesh_name) @@ -227,7 +232,7 @@ contains m3_exner_star, one) ) end if if ( normalise ) then - h_diag => get_helm_diag(self%level) + h_diag => get_helm_diag(self%stepper_name, self%level) call invoke( inc_X_times_Y(y_vec, h_diag) ) end if @@ -272,7 +277,7 @@ contains class(abstract_hierarchical_linear_operator_type), allocatable, intent(inout) :: coarse_operator allocate(coarse_operator, & - source=pressure_operator_type(self%level+1)) + source=pressure_operator_type(self%level+1, self%stepper_name)) end subroutine coarsen_pressure_operator !> @brief Finalizer for the Helmholtz operator. diff --git a/science/gungho/source/algorithm/solver/pressure_precon_alg_mod.x90 b/science/gungho/source/algorithm/solver/pressure_precon_alg_mod.x90 index f5d1260e6..3f2550a86 100644 --- a/science/gungho/source/algorithm/solver/pressure_precon_alg_mod.x90 +++ b/science/gungho/source/algorithm/solver/pressure_precon_alg_mod.x90 @@ -36,7 +36,8 @@ module pressure_precon_alg_mod type, public, extends(abstract_hierarchical_preconditioner_type) :: pressure_preconditioner_type - integer(kind=i_def) :: level + integer(kind=i_def) :: level + integer(kind=i_def) :: stepper_name contains procedure, public :: apply => apply_pressure_preconditioner @@ -61,19 +62,23 @@ contains !> @brief Construct a pressure_preconditioner_type object. !> - !> @param[in] level Multigrid level + !> @param[in] level Multigrid level + !> @param[in] stepper_name Enumerator for timestepper !> @return self The constructed preconditioner object - function pressure_preconditioner_constructor(level) result(self) + function pressure_preconditioner_constructor(level, stepper_name) result(self) use log_mod, only: log_event, LOG_LEVEL_INFO implicit none integer(kind=i_def), intent(in) :: level + integer(kind=i_def), intent(in) :: stepper_name type(pressure_preconditioner_type) :: self call log_event( 'Constructing pressure preconditioner...', & LOG_LEVEL_INFO ) self%level = level + self%stepper_name = stepper_name + call log_event( 'done', LOG_LEVEL_INFO ) end function pressure_preconditioner_constructor @@ -91,6 +96,7 @@ contains ! Deep copy of the contents of the pressure_preconditioner_type dest%level = source%level + dest%stepper_name = source%stepper_name end subroutine pressure_preconditioner_assign !> @brief Apply the preconditioner to calculate \f$y = P.x = x\f$. @@ -117,7 +123,7 @@ contains select type(y) type is(r_solver_field_vector_type) ! Multiply by inverse of vertical operator \f$ H_z \f$ - tri => get_tri_precon(self%level) + tri => get_tri_precon(self%stepper_name, self%level) x_vec => x%get_field_from_position(1) y_vec => y%get_field_from_position(1) call invoke( tri_solve_kernel_type(y_vec, x_vec, tri) ) @@ -146,7 +152,7 @@ contains class(pressure_preconditioner_type), intent(inout) :: self class(abstract_hierarchical_preconditioner_type), allocatable, intent(inout) :: other allocate(other, & - source = pressure_preconditioner_type(self%level+1) ) + source = pressure_preconditioner_type(self%level+1, self%stepper_name) ) end subroutine coarsen_pressure_preconditioner !> @brief Destructor diff --git a/science/gungho/source/algorithm/solver/semi_implicit_solver_alg_mod.x90 b/science/gungho/source/algorithm/solver/semi_implicit_solver_alg_mod.x90 index 893deb5b1..5441b4ab3 100644 --- a/science/gungho/source/algorithm/solver/semi_implicit_solver_alg_mod.x90 +++ b/science/gungho/source/algorithm/solver/semi_implicit_solver_alg_mod.x90 @@ -13,19 +13,19 @@ module semi_implicit_solver_alg_mod use constants_mod, only: i_def, r_def, l_def, r_solver, & PRECISION_R_SOLVER - use log_mod, only: log_event, & - log_level, & - log_scratch_space, & - LOG_LEVEL_DEBUG, & - LOG_LEVEL_INFO, & - LOG_LEVEL_ERROR, & - LOG_LEVEL_TRACE, & + use log_mod, only: log_event, & + log_level, & + log_scratch_space, & + LOG_LEVEL_DEBUG, & + LOG_LEVEL_INFO, & + LOG_LEVEL_ERROR, & + LOG_LEVEL_TRACE, & LOG_LEVEL_ALWAYS ! Config - use mixed_solver_config_mod, only: split_w, & - mixed_solver_a_tol, & - eliminate_variables, & + use mixed_solver_config_mod, only: split_w, & + mixed_solver_a_tol, & + eliminate_variables, & eliminate_variables_analytic ! Derived Types @@ -35,14 +35,16 @@ module semi_implicit_solver_alg_mod use sci_r_solver_field_vector_mod, only: r_solver_field_vector_type use mesh_mod, only: mesh_type use derived_config_mod, only: bundle_size - use field_indices_mod, only: isol_p, isol_u, isol_w, isol_uv, & - igh_p, igh_t, igh_d, & + use field_indices_mod, only: isol_p, isol_u, isol_w, & + isol_uv, igh_p, igh_t, igh_d, & igh_u, igh_w, igh_uv use copy_field_alg_mod, only: copy_field ! Pointers - use sci_geometric_constants_mod, only: get_face_selector_ew, & + use sci_geometric_constants_mod, only: get_face_selector_ew, & get_face_selector_ns + use dycore_constants_mod, only: stepper_siqn, stepper_tr, & + stepper_bdf2 ! Algorithms use mixed_operator_alg_mod, only: mixed_operator_type @@ -55,15 +57,15 @@ module semi_implicit_solver_alg_mod ! preconditioner and solver use sci_preconditioner_mod, only: abstract_preconditioner_type - use sci_iterative_solver_mod, only: abstract_iterative_solver_type, & - bicgstab_type, & - gmres_type, & - fgmres_type, & - gcr_type, & - block_gcr_type, & - conjugate_gradient_type, & - precondition_only_type, & - jacobi_type + use sci_iterative_solver_mod, only: bicgstab_type, & + gmres_type, & + fgmres_type, & + gcr_type, & + block_gcr_type, & + conjugate_gradient_type, & + precondition_only_type, & + jacobi_type, & + abstract_iterative_solver_type ! Kernels use split_w2_field_kernel_mod, only: split_w2_field_kernel_type @@ -78,15 +80,26 @@ module semi_implicit_solver_alg_mod private ! Operator, preconditioner and iterative solver for mixed problem - type( mixed_operator_type ) :: mixed_operator - class( abstract_preconditioner_type ), allocatable :: mixed_preconditioner - class( abstract_iterative_solver_type ), allocatable :: mixed_solver - - !> Operator, preconditioner and iterative solver for - !> Helmholtz (pressure) problem - type( pressure_operator_type ) :: pressure_operator - class( abstract_preconditioner_type ), allocatable :: pressure_preconditioner - class( abstract_iterative_solver_type ), allocatable :: pressure_solver + type(mixed_operator_type) :: mixed_operator_siqn + type(mixed_operator_type) :: mixed_operator_tr + type(mixed_operator_type) :: mixed_operator_bdf2 + class(abstract_preconditioner_type), allocatable :: mixed_preconditioner_siqn + class(abstract_preconditioner_type), allocatable :: mixed_preconditioner_tr + class(abstract_preconditioner_type), allocatable :: mixed_preconditioner_bdf2 + class(abstract_iterative_solver_type), allocatable :: mixed_solver_siqn + class(abstract_iterative_solver_type), allocatable :: mixed_solver_tr + class(abstract_iterative_solver_type), allocatable :: mixed_solver_bdf2 + + ! Operator, preconditioner and iterative solver for Helmholtz problem + type(pressure_operator_type) :: pressure_operator_siqn + type(pressure_operator_type) :: pressure_operator_tr + type(pressure_operator_type) :: pressure_operator_bdf2 + class(abstract_preconditioner_type), allocatable :: pressure_preconditioner_siqn + class(abstract_preconditioner_type), allocatable :: pressure_preconditioner_tr + class(abstract_preconditioner_type), allocatable :: pressure_preconditioner_bdf2 + class(abstract_iterative_solver_type), allocatable :: pressure_solver_siqn + class(abstract_iterative_solver_type), allocatable :: pressure_solver_tr + class(abstract_iterative_solver_type), allocatable :: pressure_solver_bdf2 public :: create_pressure_preconditioner public :: create_pressure_solver @@ -96,21 +109,28 @@ module semi_implicit_solver_alg_mod public :: semi_implicit_solver_alg_final public :: semi_implicit_solver_alg_step private :: construct_solver_state + contains -!=============================================================================! + ! ========================================================================== ! !> @brief Create operator and preconditioner for (Helmholtz) pressure problem - !> @details Called by init method of this module, but also by adj_semi_implicit_solver_alg_mod, - !! adjt_mixed_schur_preconditioner_alg_mod and adjt_mixed_solver_alg_mod + !> @details Called by init method of this module, but also by: + !! - adj_semi_implicit_solver_alg_mod + !! - adjt_mixed_schur_preconditioner_alg_mod + !! - adjt_mixed_solver_alg_mod + !> @param[in] stepper_name Enumerator for timestepper !> @param[in] state Prognostic state for the solver - !> @param[out] pressure_operator_out Output (Helmholtz) pressure operator - !> @param[out] pressure_preconditioner_out Output (Helmholtz) pressure preconditioner - subroutine create_pressure_preconditioner( state, pressure_operator_out, pressure_preconditioner_out ) - - use helmholtz_solver_config_mod, only: helmholtz_preconditioner => preconditioner, & - preconditioner_none, & - preconditioner_diagonal, & - preconditioner_tridiagonal, & - preconditioner_multigrid + !> @param[out] pressure_operator_out Helmholtz pressure operator + !> @param[out] pressure_preconditioner_out Helmholtz pressure preconditioner + subroutine create_pressure_preconditioner(stepper_name, state, & + pressure_operator_out, & + pressure_preconditioner_out) + + use helmholtz_solver_config_mod, only: helmholtz_preconditioner => & + preconditioner, & + preconditioner_none, & + preconditioner_diagonal, & + preconditioner_tridiagonal, & + preconditioner_multigrid implicit none @@ -121,65 +141,85 @@ contains type(pressure_operator_type), intent(out) :: pressure_operator_out class(abstract_preconditioner_type), allocatable, intent(out) :: pressure_preconditioner_out + integer(kind=i_def), intent(in) :: stepper_name + ! Vertical pressure preconditioner type(pressure_preconditioner_type) :: Hz_preconditioner - pressure_operator_out = pressure_operator_type(level=1_i_def) + pressure_operator_out = pressure_operator_type( & + level=1_i_def, stepper_name=stepper_name & + ) - call log_event( "create_pressure_preconditioner: starting", LOG_LEVEL_INFO ) + call log_event("create_pressure_preconditioner: starting", LOG_LEVEL_INFO) ! Allocate pressure preconditioner of correct type select case(helmholtz_preconditioner) case(PRECONDITIONER_NONE) - allocate( pressure_preconditioner_out, & - source = null_preconditioner_type() ) + allocate(pressure_preconditioner_out, source=null_preconditioner_type()) case(PRECONDITIONER_DIAGONAL) - allocate( pressure_preconditioner_out, & - source = pressure_diag_preconditioner_type() ) + allocate( & + pressure_preconditioner_out, & + source=pressure_diag_preconditioner_type() & + ) case(PRECONDITIONER_TRIDIAGONAL) - allocate( pressure_preconditioner_out, & - source = pressure_preconditioner_type(level=1_i_def) ) + allocate( & + pressure_preconditioner_out, & + source=pressure_preconditioner_type( & + level=1_i_def, stepper_name=stepper_name & + ) & + ) case(PRECONDITIONER_MULTIGRID) - Hz_preconditioner = pressure_preconditioner_type(level=1_i_def) - allocate( pressure_preconditioner_out, & - source = multigrid_preconditioner_type( state(igh_p)%get_function_space(), & - pressure_operator_out, & - Hz_preconditioner ) ) + Hz_preconditioner = pressure_preconditioner_type( & + level=1_i_def, stepper_name=stepper_name & + ) + allocate( & + pressure_preconditioner_out, & + source=multigrid_preconditioner_type( & + stepper_name, state(igh_p)%get_function_space(), & + pressure_operator_out, Hz_preconditioner & + ) & + ) case default - call log_event( "Unknown pressure preconditioner specified", LOG_LEVEL_ERROR) + call log_event( & + "Unknown pressure preconditioner specified", LOG_LEVEL_ERROR & + ) end select - call log_event( "create_pressure_preconditioner: done", LOG_LEVEL_INFO ) + call log_event("create_pressure_preconditioner: done", LOG_LEVEL_INFO) end subroutine create_pressure_preconditioner -!=============================================================================! + ! ========================================================================== ! !> @brief Create iterative solver for (Helmholtz) pressure problem - !> @details Called by init method of this module, but also by - !! adjt_mixed_schur_preconditioner_alg_mod and adjt_mixed_solver_alg_mod - !> @param[in] pressure_operator_in Input (Helmholtz) pressure operator - !> @param[in] pressure_preconditioner_in Input (Helmholtz) pressure preconditioner - !> @param[out] pressure_solver_out Output (Helmholtz) pressure solver - subroutine create_pressure_solver( pressure_operator_in, pressure_preconditioner_in, pressure_solver_out ) - - use helmholtz_solver_config_mod, only: si_pressure_maximum_iterations, & - helmholtz_gcrk => gcrk, & - si_pressure_tolerance, & - si_pressure_a_tol, & - helmholtz_method => method, & - method_cg, & - method_bicgstab, & - method_gmres, & - method_fgmres, & - method_gcr, & - method_prec_only, & - method_jacobi, & - si_pressure_monitor_convergence => & - monitor_convergence, & - si_pressure_fail_on_non_converged => & - fail_on_non_converged, & - si_pressure_jacobi_relaxation => & - jacobi_relaxation + !> @details Called by init method of this module, but also by: + !! - adjt_mixed_schur_preconditioner_alg_mod + !! - adjt_mixed_solver_alg_mod + !> @param[in] stepper_name Enumerator for timestepper + !> @param[in] pressure_operator_in Helmholtz pressure operator + !> @param[in] pressure_preconditioner_in Helmholtz pressure preconditioner + !> @param[out] pressure_solver_out Helmholtz pressure solver + subroutine create_pressure_solver(stepper_name, pressure_operator_in, & + pressure_preconditioner_in, & + pressure_solver_out) + + use helmholtz_solver_config_mod, only: si_pressure_maximum_iterations, & + helmholtz_gcrk => gcrk, & + si_pressure_tolerance, & + si_pressure_a_tol, & + helmholtz_method => method, & + method_cg, & + method_bicgstab, & + method_gmres, & + method_fgmres, & + method_gcr, & + method_prec_only, & + method_jacobi, & + si_pressure_monitor_convergence & + => monitor_convergence, & + si_pressure_fail_on_non_converged & + => fail_on_non_converged, & + si_pressure_jacobi_relaxation & + => jacobi_relaxation implicit none @@ -190,92 +230,96 @@ contains ! Output iterative solver for (Helmholtz) pressure problem class(abstract_iterative_solver_type), allocatable, intent(out) :: pressure_solver_out - call log_event( "create_pressure_solver: starting", LOG_LEVEL_INFO ) + integer(kind=i_def), intent(in) :: stepper_name + + call log_event("create_pressure_solver: starting", LOG_LEVEL_INFO) ! Allocate pressure solver of correct type - select case( helmholtz_method ) + select case(helmholtz_method) case (METHOD_BICGSTAB) - allocate( pressure_solver_out, & - source = bicgstab_type( pressure_operator_in, & - pressure_preconditioner_in, & - si_pressure_tolerance, & - si_pressure_a_tol, & - si_pressure_maximum_iterations, & - si_pressure_monitor_convergence, & - si_pressure_fail_on_non_converged ) ) - case(METHOD_CG) - allocate( pressure_solver_out, & - source = conjugate_gradient_type( pressure_operator_in, & - pressure_preconditioner_in, & - si_pressure_tolerance, & - si_pressure_a_tol, & - si_pressure_maximum_iterations, & - si_pressure_monitor_convergence, & - si_pressure_fail_on_non_converged ) ) - case(METHOD_GMRES) - allocate( pressure_solver_out, & - source = gmres_type( pressure_operator_in, & - pressure_preconditioner_in, & - helmholtz_gcrk, & - si_pressure_tolerance, & - si_pressure_a_tol, & - si_pressure_maximum_iterations, & - si_pressure_monitor_convergence, & - si_pressure_fail_on_non_converged ) ) - case(METHOD_FGMRES) - allocate( pressure_solver_out, & - source = fgmres_type( pressure_operator_in, & - pressure_preconditioner_in, & - helmholtz_gcrk, & - si_pressure_tolerance, & - si_pressure_a_tol, & - si_pressure_maximum_iterations, & - si_pressure_monitor_convergence, & - si_pressure_fail_on_non_converged ) ) - case(METHOD_GCR) - allocate( pressure_solver_out, & - source = gcr_type( pressure_operator_in, & - pressure_preconditioner_in, & - helmholtz_gcrk, & - si_pressure_tolerance, & - si_pressure_a_tol, & - si_pressure_maximum_iterations, & - si_pressure_monitor_convergence, & - si_pressure_fail_on_non_converged ) ) - case(METHOD_PREC_ONLY) - allocate( pressure_solver_out, & - source = precondition_only_type( pressure_operator_in, & - pressure_preconditioner_in, & - si_pressure_monitor_convergence) ) - case(METHOD_JACOBI) - allocate( pressure_solver_out, & - source = jacobi_type( pressure_operator_in, & - pressure_preconditioner_in, & - si_pressure_tolerance, & - si_pressure_a_tol, & - si_pressure_maximum_iterations, & - si_pressure_monitor_convergence, & - si_pressure_fail_on_non_converged, & - si_pressure_jacobi_relaxation ) ) + allocate( & + pressure_solver_out, source=bicgstab_type( & + pressure_operator_in, pressure_preconditioner_in, & + si_pressure_tolerance, si_pressure_a_tol, & + si_pressure_maximum_iterations, si_pressure_monitor_convergence, & + si_pressure_fail_on_non_converged & + ) & + ) + case (METHOD_CG) + allocate( & + pressure_solver_out, source=conjugate_gradient_type( & + pressure_operator_in, pressure_preconditioner_in, & + si_pressure_tolerance, si_pressure_a_tol, & + si_pressure_maximum_iterations, si_pressure_monitor_convergence, & + si_pressure_fail_on_non_converged & + ) & + ) + case (METHOD_GMRES) + allocate( & + pressure_solver_out, source=gmres_type( & + pressure_operator_in, pressure_preconditioner_in, & + helmholtz_gcrk, si_pressure_tolerance, si_pressure_a_tol, & + si_pressure_maximum_iterations, si_pressure_monitor_convergence, & + si_pressure_fail_on_non_converged & + ) & + ) + case (METHOD_FGMRES) + allocate( & + pressure_solver_out, source=fgmres_type( & + pressure_operator_in, pressure_preconditioner_in, & + helmholtz_gcrk, si_pressure_tolerance, si_pressure_a_tol, & + si_pressure_maximum_iterations, si_pressure_monitor_convergence, & + si_pressure_fail_on_non_converged & + ) & + ) + case (METHOD_GCR) + allocate( & + pressure_solver_out, source=gcr_type( & + pressure_operator_in, pressure_preconditioner_in, & + helmholtz_gcrk, si_pressure_tolerance, si_pressure_a_tol, & + si_pressure_maximum_iterations, si_pressure_monitor_convergence, & + si_pressure_fail_on_non_converged & + ) & + ) + case (METHOD_PREC_ONLY) + allocate( & + pressure_solver_out, source=precondition_only_type( & + pressure_operator_in, pressure_preconditioner_in, & + si_pressure_monitor_convergence & + ) & + ) + case (METHOD_JACOBI) + allocate( & + pressure_solver_out, source=jacobi_type( & + pressure_operator_in, pressure_preconditioner_in, & + si_pressure_tolerance, si_pressure_a_tol, & + si_pressure_maximum_iterations, si_pressure_monitor_convergence, & + si_pressure_fail_on_non_converged, si_pressure_jacobi_relaxation & + ) & + ) case default - call log_event("Unknown pressure solver specified",LOG_LEVEL_ERROR) + call log_event("Unknown pressure solver specified", LOG_LEVEL_ERROR) end select - call log_event( "create_pressure_solver: done", LOG_LEVEL_INFO ) + call log_event("create_pressure_solver: done", LOG_LEVEL_INFO) end subroutine create_pressure_solver -!=============================================================================! + ! ========================================================================== ! !> @brief Create preconditioner for mixed problem !> @details Called by init method of this module, but also by - !! adjt_mixed_schur_preconditioner_alg_mod and adjt_mixed_solver_alg_mod + !! - adjt_mixed_schur_preconditioner_alg_mod + !! - adjt_mixed_solver_alg_mod + !> @param[in] stepper_name Enumerator for timestepper !> @param[in] state Prognostic state for the solver !> @param[in] pressure_solver_in Input (Helmholtz) pressure solver !> @param[out] mixed_preconditioner_out Output mixed preconditioner - subroutine create_mixed_preconditioner( state, pressure_solver_in, mixed_preconditioner_out ) + subroutine create_mixed_preconditioner(stepper_name, state, & + pressure_solver_in, & + mixed_preconditioner_out) - use mixed_solver_config_mod, only: si_preconditioner, & - si_preconditioner_pressure, & + use mixed_solver_config_mod, only: si_preconditioner, & + si_preconditioner_pressure, & si_preconditioner_none implicit none @@ -289,55 +333,60 @@ contains ! Output preconditioner for mixed problem class(abstract_preconditioner_type), allocatable, intent(out) :: mixed_preconditioner_out - call log_event( "create_mixed_preconditioner: starting", LOG_LEVEL_INFO ) + integer(kind=i_def), intent(in) :: stepper_name + + call log_event("create_mixed_preconditioner: starting", LOG_LEVEL_INFO) ! Allocate mixed preconditioner of correct type select case(si_preconditioner) case(SI_PRECONDITIONER_PRESSURE) - allocate( mixed_preconditioner_out, & - source = mixed_schur_preconditioner_type( & - state(igh_u)%get_mesh(), & - state(igh_u)%get_element_order_h(), & - state(igh_u)%get_element_order_v(), & - pressure_solver_in ) ) - + allocate( & + mixed_preconditioner_out, source=mixed_schur_preconditioner_type( & + state(igh_u)%get_mesh(), state(igh_u)%get_element_order_h(), & + state(igh_u)%get_element_order_v(), stepper_name, & + pressure_solver_in & + ) & + ) case(SI_PRECONDITIONER_NONE) - allocate( mixed_preconditioner_out, & - source = null_preconditioner_type() ) + allocate(mixed_preconditioner_out, source=null_preconditioner_type()) case default - call log_event( "Unknown mixed preconditioner specified", LOG_LEVEL_ERROR ) + call log_event("Unknown mixed preconditioner specified", LOG_LEVEL_ERROR) end select - call log_event( "create_mixed_preconditioner: done", LOG_LEVEL_INFO ) + call log_event("create_mixed_preconditioner: done", LOG_LEVEL_INFO) end subroutine create_mixed_preconditioner -!=============================================================================! + ! ========================================================================== ! !> @brief Create operator and iterative solver for mixed problem - !> @details Called by init method of this module, but also by adjt_mixed_solver_alg_mod + !> @details Called by init method of this module, but also by + !! adjt_mixed_solver_alg_mod + !> @param[in] stepper_name Enumerator for timestepper !> @param[in] mixed_preconditioner_in Input mixed preconditioner - !> @param[in,out] mixed_operator_out Output mixed operator (not explicitly set, so must be inout) + !> @param[in,out] mixed_operator_out Output mixed operator (not + !! explicitly set, so must be inout) !> @param[out] mixed_solver_out Output mixed solver - subroutine create_mixed_solver( mixed_preconditioner_in, mixed_operator_out, mixed_solver_out ) - - use mixed_solver_config_mod, only: si_maximum_iterations, & - si_tolerance, & - si_method, & - mixed_gcrk => gcrk, & - si_method_cg, & - si_method_bicgstab, & - si_method_gmres, & - si_method_fgmres, & - si_method_gcr, & - si_method_block_gcr, & - si_method_prec_only, & - si_method_jacobi, & - si_monitor_convergence => & - monitor_convergence, & - si_fail_on_non_converged => & - fail_on_non_converged, & - mixed_jacobi_relaxation => & - jacobi_relaxation + subroutine create_mixed_solver(stepper_name, mixed_preconditioner_in, & + mixed_operator_out, mixed_solver_out) + + use mixed_solver_config_mod, only: si_maximum_iterations, & + si_tolerance, & + si_method, & + mixed_gcrk => gcrk, & + si_method_cg, & + si_method_bicgstab, & + si_method_gmres, & + si_method_fgmres, & + si_method_gcr, & + si_method_block_gcr, & + si_method_prec_only, & + si_method_jacobi, & + si_monitor_convergence => & + monitor_convergence, & + si_fail_on_non_converged => & + fail_on_non_converged, & + mixed_jacobi_relaxation => & + jacobi_relaxation implicit none @@ -348,173 +397,251 @@ contains type(mixed_operator_type), intent(inout) :: mixed_operator_out class(abstract_iterative_solver_type), allocatable, intent(out) :: mixed_solver_out + integer(kind=i_def), intent(in) :: stepper_name + call log_event( "create_mixed_solver: starting", LOG_LEVEL_INFO ) + ! Set mixed operator, depending on timestepper + mixed_operator_out = mixed_operator_type(stepper_name) + ! Allocate mixed solver of correct type select case(si_method) case(SI_METHOD_BICGSTAB) - allocate( mixed_solver_out, & - source = bicgstab_type( mixed_operator_out, & - mixed_preconditioner_in, & - si_tolerance, & - mixed_solver_a_tol, & - si_maximum_iterations, & - si_monitor_convergence, & - si_fail_on_non_converged ) ) + allocate( & + mixed_solver_out, source=bicgstab_type( & + mixed_operator_out, mixed_preconditioner_in, & + si_tolerance, mixed_solver_a_tol, si_maximum_iterations, & + si_monitor_convergence, si_fail_on_non_converged & + ) & + ) case(SI_METHOD_CG) - allocate( mixed_solver_out, & - source = conjugate_gradient_type( mixed_operator_out, & - mixed_preconditioner_in, & - si_tolerance, & - mixed_solver_a_tol, & - si_maximum_iterations, & - si_monitor_convergence, & - si_fail_on_non_converged ) ) + allocate( & + mixed_solver_out, source=conjugate_gradient_type( & + mixed_operator_out, mixed_preconditioner_in, & + si_tolerance, mixed_solver_a_tol, si_maximum_iterations, & + si_monitor_convergence, si_fail_on_non_converged & + ) & + ) case(SI_METHOD_GMRES) - allocate( mixed_solver_out, & - source = gmres_type( mixed_operator_out, & - mixed_preconditioner_in, & - mixed_gcrk, & - si_tolerance, & - mixed_solver_a_tol, & - si_maximum_iterations, & - si_monitor_convergence, & - si_fail_on_non_converged ) ) + allocate( & + mixed_solver_out, source=gmres_type( & + mixed_operator_out, mixed_preconditioner_in, & + mixed_gcrk, si_tolerance, mixed_solver_a_tol, & + si_maximum_iterations, si_monitor_convergence, & + si_fail_on_non_converged & + ) & + ) case(SI_METHOD_FGMRES) - allocate( mixed_solver_out, & - source = fgmres_type( mixed_operator_out, & - mixed_preconditioner_in, & - mixed_gcrk, & - si_tolerance, & - mixed_solver_a_tol, & - si_maximum_iterations, & - si_monitor_convergence, & - si_fail_on_non_converged ) ) + allocate( & + mixed_solver_out, source=fgmres_type( & + mixed_operator_out, mixed_preconditioner_in, & + mixed_gcrk, si_tolerance, mixed_solver_a_tol, & + si_maximum_iterations, si_monitor_convergence, & + si_fail_on_non_converged & + ) & + ) case(SI_METHOD_BLOCK_GCR) - allocate( mixed_solver_out, & - source = block_gcr_type( mixed_operator_out, & - mixed_preconditioner_in, & - mixed_gcrk, & - si_tolerance, & - mixed_solver_a_tol, & - si_maximum_iterations, & - si_monitor_convergence, & - si_fail_on_non_converged ) ) + allocate( & + mixed_solver_out, source=block_gcr_type( & + mixed_operator_out, mixed_preconditioner_in, & + mixed_gcrk, si_tolerance, mixed_solver_a_tol, & + si_maximum_iterations, si_monitor_convergence, & + si_fail_on_non_converged & + ) & + ) case(SI_METHOD_GCR) - allocate( mixed_solver_out, & - source = gcr_type( mixed_operator_out, & - mixed_preconditioner_in, & - mixed_gcrk, & - si_tolerance, & - mixed_solver_a_tol, & - si_maximum_iterations, & - si_monitor_convergence, & - si_fail_on_non_converged ) ) + allocate( & + mixed_solver_out, source=gcr_type( & + mixed_operator_out, mixed_preconditioner_in, & + mixed_gcrk, si_tolerance, mixed_solver_a_tol, & + si_maximum_iterations, si_monitor_convergence, & + si_fail_on_non_converged & + ) & + ) case(SI_METHOD_PREC_ONLY) - allocate( mixed_solver_out, & - source = precondition_only_type( mixed_operator_out, & - mixed_preconditioner_in, & - si_monitor_convergence ) ) + allocate( & + mixed_solver_out, source=precondition_only_type( & + mixed_operator_out, mixed_preconditioner_in, & + si_monitor_convergence & + ) & + ) case(SI_METHOD_JACOBI) - allocate( mixed_solver_out, & - source = jacobi_type( mixed_operator_out, & - mixed_preconditioner_in, & - si_tolerance, & - mixed_solver_a_tol, & - si_maximum_iterations, & - si_monitor_convergence, & - si_fail_on_non_converged, & - mixed_jacobi_relaxation ) ) + allocate( & + mixed_solver_out, source=jacobi_type( & + mixed_operator_out, mixed_preconditioner_in, & + si_tolerance, mixed_solver_a_tol, si_maximum_iterations, & + si_monitor_convergence, si_fail_on_non_converged, & + mixed_jacobi_relaxation & + ) & + ) case default - call log_event( "Unknown mixed solver specified", LOG_LEVEL_ERROR ) + call log_event("Unknown mixed solver specified", LOG_LEVEL_ERROR) end select - call log_event( "create_mixed_solver: done", LOG_LEVEL_INFO ) + call log_event("create_mixed_solver: done", LOG_LEVEL_INFO) end subroutine create_mixed_solver !=============================================================================! !> @brief Initialisation procedure for the semi-implicit solver - !> @param[in] state Prognostic state for the solver - subroutine semi_implicit_solver_alg_init(state) + !> @param[in] state Prognostic state for the solver + !> @param[in] stepper_name Enumerator for timestepper + subroutine semi_implicit_solver_alg_init(state, stepper_name) implicit none ! Prognostic fields - type( field_type ), dimension(bundle_size), intent( in ) :: state + type(field_type), dimension(bundle_size), intent(in) :: state + integer(kind=i_def), intent(in) :: stepper_name - write(log_scratch_space,'(A)') & - 'SI solver built with '//trim(PRECISION_R_SOLVER)// & - '-bit real numbers' - call log_event( log_scratch_space, LOG_LEVEL_ALWAYS ) + write(log_scratch_space,'(A)') & + 'SI solver built with ' // trim(PRECISION_R_SOLVER) // '-bit real numbers' + call log_event(log_scratch_space, LOG_LEVEL_ALWAYS) - call create_pressure_preconditioner( state, pressure_operator, pressure_preconditioner ) - call create_pressure_solver( pressure_operator, pressure_preconditioner, pressure_solver ) - call create_mixed_preconditioner( state, pressure_solver, mixed_preconditioner ) - call create_mixed_solver( mixed_preconditioner, mixed_operator, mixed_solver ) + select case (stepper_name) + case (stepper_siqn) + call create_pressure_preconditioner( & + stepper_name, state, pressure_operator_siqn, & + pressure_preconditioner_siqn & + ) + call create_pressure_solver( & + stepper_name, pressure_operator_siqn, & + pressure_preconditioner_siqn, pressure_solver_siqn & + ) + call create_mixed_preconditioner( & + stepper_name, state, pressure_solver_siqn, & + mixed_preconditioner_siqn & + ) + call create_mixed_solver( & + stepper_name, mixed_preconditioner_siqn, mixed_operator_siqn, & + mixed_solver_siqn & + ) - call log_event( "semi_implicit_solver_alg_init: Initialised semi-implicit solver", LOG_LEVEL_INFO ) + case (stepper_tr, stepper_bdf2) + call create_pressure_preconditioner( & + stepper_name, state, pressure_operator_tr, & + pressure_preconditioner_tr & + ) + call create_pressure_preconditioner( & + stepper_name, state, pressure_operator_bdf2, & + pressure_preconditioner_bdf2 & + ) + call create_pressure_solver( & + stepper_name, pressure_operator_tr, & + pressure_preconditioner_tr, pressure_solver_tr & + ) + call create_pressure_solver( & + stepper_name, pressure_operator_bdf2, & + pressure_preconditioner_bdf2, pressure_solver_bdf2 & + ) + call create_mixed_preconditioner( & + stepper_name, state, pressure_solver_tr, & + mixed_preconditioner_tr & + ) + call create_mixed_preconditioner( & + stepper_name, state, pressure_solver_bdf2, & + mixed_preconditioner_bdf2 & + ) + call create_mixed_solver( & + stepper_name, mixed_preconditioner_tr, mixed_operator_tr, & + mixed_solver_tr & + ) + call create_mixed_solver( & + stepper_name, mixed_preconditioner_bdf2, mixed_operator_bdf2, & + mixed_solver_bdf2 & + ) + + case default + call log_event( & + "semi_implicit_solver_alg_init: Unknown timestepper specified", & + LOG_LEVEL_ERROR & + ) + end select + + call log_event( & + "semi_implicit_solver_alg_init: Initialised semi-implicit solver", & + LOG_LEVEL_INFO & + ) end subroutine semi_implicit_solver_alg_init -!=============================================================================! - !@brief Tidy up semi-implicit solver algorithm module - !> - !@details Deallocate memory + ! ========================================================================== ! + !> @brief Tidy up semi-implicit solver algorithm module + !> @details Deallocate memory subroutine semi_implicit_solver_alg_final() implicit none - ! Deallocate mixed preconditioner object - if (allocated(mixed_preconditioner)) then - deallocate(mixed_preconditioner) + if (allocated(mixed_preconditioner_siqn)) then + deallocate(mixed_preconditioner_siqn) + end if + if (allocated(mixed_preconditioner_tr)) then + deallocate(mixed_preconditioner_tr) + end if + if (allocated(mixed_preconditioner_bdf2)) then + deallocate(mixed_preconditioner_bdf2) + end if + if (allocated(mixed_solver_siqn)) then + deallocate(mixed_solver_siqn) + end if + if (allocated(mixed_solver_tr)) then + deallocate(mixed_solver_tr) + end if + if (allocated(mixed_solver_bdf2)) then + deallocate(mixed_solver_bdf2) + end if + if (allocated(pressure_preconditioner_siqn)) then + deallocate(pressure_preconditioner_siqn) + end if + if (allocated(pressure_preconditioner_tr)) then + deallocate(pressure_preconditioner_tr) + end if + if (allocated(pressure_preconditioner_bdf2)) then + deallocate(pressure_preconditioner_bdf2) end if - ! Deallocate mixed solver object - if (allocated(mixed_solver)) then - deallocate(mixed_solver) + if (allocated(pressure_solver_siqn)) then + deallocate(pressure_solver_siqn) end if - ! Deallocate pressure preconditioner object - if (allocated(pressure_preconditioner)) then - deallocate(pressure_preconditioner) + if (allocated(pressure_solver_tr)) then + deallocate(pressure_solver_tr) end if - ! Deallocate pressure solver object - if (allocated(pressure_solver)) then - deallocate(pressure_solver) + if (allocated(pressure_solver_bdf2)) then + deallocate(pressure_solver_bdf2) end if end subroutine semi_implicit_solver_alg_final -!=============================================================================! - + ! ========================================================================== ! !> @brief An algorithm for timestepping the semi-implicit equations. - !> !> @param[in,out] state Prognostic model state !> @param[in,out] rhs Residuals - !> @param[in] moist_dyn_gas_law Gas law component of moist dynamics factors + !> @param[in] moist_dyn_gas_law Gas law component of moist dynamics + !! factors !> @param[in] mr Mixing ratio array !> @param[in] write_moisture_diag Flag to control output of moisture !! conservation diagnostics !> @param[in] first_iteration Flag for first inner iteration - subroutine semi_implicit_solver_alg_step(state, rhs, & - moist_dyn_gas_law, & - mr, write_moisture_diag, & - first_iteration) - - use solver_constants_mod, only: get_normalisation_r_solver, & - get_im3_div_r_solver, & + !> @param[in] stepper_name Enumerator for timestepper + subroutine semi_implicit_solver_alg_step(state, rhs, & + moist_dyn_gas_law, & + mr, write_moisture_diag, & + first_iteration, stepper_name) + + use solver_constants_mod, only: get_normalisation_r_solver, & + get_im3_div_r_solver, & get_normalisation use fs_continuity_mod, only: W2, Wtheta use mr_indices_mod, only: nummr use moisture_conservation_alg_mod, only: moisture_conservation_alg - use si_operators_alg_mod, only: get_m3_rho_star, & - get_rho_at_u, & - get_p2theta, & - get_p3theta, & - get_ptheta2, & - get_eliminated_q2t, & + use si_operators_alg_mod, only: get_m3_rho_star, & + get_rho_at_u, & + get_p2theta, & + get_p3theta, & + get_ptheta2, & + get_eliminated_q2t, & get_eliminated_q3t use matrix_vector_kernel_mod, only: matrix_vector_kernel_type use dg_matrix_vector_kernel_mod, only: dg_matrix_vector_kernel_type - use dg_inc_matrix_vector_kernel_mod, & + use dg_inc_matrix_vector_kernel_mod, & only: dg_inc_matrix_vector_kernel_type use operator_mod, only: operator_type, & r_solver_operator_type @@ -522,7 +649,7 @@ contains use r_solver_field_mod, only: r_solver_field_type use timestepping_config_mod, only: dt, tau_r use sci_enforce_bc_kernel_mod, only: enforce_bc_kernel_type - use sci_mass_matrix_solver_alg_mod, & + use sci_mass_matrix_solver_alg_mod, & only: mass_matrix_solver_alg use sci_psykal_light_mod, only: invoke_inc_rdefX_plus_rsolverY use sci_field_minmax_alg_mod, only: log_field_minmax @@ -530,286 +657,359 @@ contains implicit none ! Prognostic fields - type( field_type ), dimension(bundle_size), intent( inout ) :: state - type( field_type ), dimension(bundle_size), intent( inout ) :: rhs - type( field_type ), intent( in ) :: moist_dyn_gas_law - type( field_type ), dimension(nummr), intent( in ) :: mr - logical( kind=l_def ), intent( in ) :: write_moisture_diag - logical( kind=l_def), intent( in ) :: first_iteration - - real( kind=r_def ) :: si_err(bundle_size) - type( field_type ), pointer :: t_normalisation, & - u_normalisation - type( r_solver_field_vector_type ) :: vector_inc, vector_rhs + type(field_type), intent(inout) :: state(bundle_size) + type(field_type), intent(inout) :: rhs(bundle_size) + type(field_type), intent(in) :: moist_dyn_gas_law + type(field_type), intent(in) :: mr(nummr) + logical(kind=l_def), intent(in) :: write_moisture_diag + logical(kind=l_def), intent(in) :: first_iteration + integer(kind=i_def), intent(in) :: stepper_name + + real(kind=r_def) :: si_err(bundle_size) + type(field_type), pointer :: t_normalisation + type(field_type), pointer :: u_normalisation + type(r_solver_field_vector_type) :: vector_inc, vector_rhs ! For analytic elimination of rho and theta - type( field_type ) :: rhs_rdef, & - inc_theta - - type( field_type ) :: rho_guess - - type( r_solver_field_type ), dimension(bundle_size) :: rhs_rsol - type( r_solver_field_type ) :: div_u, & - rhs_tmp, & - f_star, & - inc_uvw_rsol, & - inc_theta_rsol, & - inc_rho_rsol - - type( r_solver_field_type ), pointer :: rho_at_u, & - m2_diag, & - mt_lumped_inv, & - inc_uv_rsol, & - inc_w_rsol, & - inc_exner_rsol - type( r_solver_operator_type ), pointer :: div, & - m3_rho_star, & - p3theta, & - p2theta, & - ptheta2, & - q2t_op, & - q3t_op - real( kind=r_solver ) :: tau_r_dt - integer( kind=i_def ) :: mesh_id - type(integer_field_type), pointer :: face_selector_ew - type(integer_field_type), pointer :: face_selector_ns + type(field_type) :: rhs_rdef, inc_theta + type(field_type) :: rho_guess + + type(r_solver_field_type) :: rhs_rsol(bundle_size) + type(r_solver_field_type) :: div_u + type(r_solver_field_type) :: rhs_tmp + type(r_solver_field_type) :: f_star + type(r_solver_field_type) :: inc_uvw_rsol + type(r_solver_field_type) :: inc_theta_rsol + type(r_solver_field_type) :: inc_rho_rsol + type(r_solver_field_type), pointer :: rho_at_u + type(r_solver_field_type), pointer :: m2_diag + type(r_solver_field_type), pointer :: mt_lumped_inv + type(r_solver_field_type), pointer :: inc_uv_rsol + type(r_solver_field_type), pointer :: inc_w_rsol + type(r_solver_field_type), pointer :: inc_exner_rsol + type(r_solver_operator_type), pointer :: div + type(r_solver_operator_type), pointer :: m3_rho_star + type(r_solver_operator_type), pointer :: p3theta + type(r_solver_operator_type), pointer :: p2theta + type(r_solver_operator_type), pointer :: ptheta2 + type(r_solver_operator_type), pointer :: q2t_op + type(r_solver_operator_type), pointer :: q3t_op + real(kind=r_solver) :: tau_r_dt + real(kind=r_solver) :: gamma + integer(kind=i_def) :: mesh_id + type(integer_field_type), pointer :: face_selector_ew + type(integer_field_type), pointer :: face_selector_ns if ( subroutine_timers ) call timer('semi_implicit_solver_alg') ! Input fields are r_def fields so preliminary work uses field_types mesh_id = state(igh_p)%get_mesh_id() - if ( write_moisture_diag ) then + if (write_moisture_diag) then ! Best guess for the prognostic fields state can be calculated as ! state_best_guess = rhs_n - rhs_np1 + state + rhs_adv + rhs_phys ! where fortunately all of the above except "state" is already in "rhs_np1" - call rho_guess%initialise( state(igh_d)%get_function_space() ) + call rho_guess%initialise(state(igh_d)%get_function_space()) call invoke(X_plus_Y(rho_guess, state(igh_d), rhs(igh_d))) - call moisture_conservation_alg( rho_guess, mr, 'Before solve' ) + call moisture_conservation_alg(rho_guess, mr, 'Before solve') end if + ! ------------------------------------------------------------------------ ! ! Normalise theta & u residual + ! ------------------------------------------------------------------------ ! ! @TODO #416: can these be at r_solver precision? t_normalisation => get_normalisation(Wtheta, mesh_id) u_normalisation => get_normalisation(W2, mesh_id) call invoke( inc_X_times_Y(rhs(igh_u), u_normalisation) ) - if ( eliminate_variables == eliminate_variables_analytic ) then - call rhs_rdef%initialise( vector_space = rhs(igh_t)%get_function_space() ) - call invoke( setval_x( rhs_rdef, rhs(igh_t) ) ) - call mass_matrix_solver_alg( rhs(igh_t), rhs_rdef ) + if (eliminate_variables == eliminate_variables_analytic) then + call rhs_rdef%initialise(rhs(igh_t)%get_function_space()) + call invoke( setval_X(rhs_rdef, rhs(igh_t)) ) + call mass_matrix_solver_alg(rhs(igh_t), rhs_rdef) else call invoke( inc_X_times_Y(rhs(igh_t), t_normalisation) ) end if + ! ------------------------------------------------------------------------ ! ! Write out si residuals + ! ------------------------------------------------------------------------ ! if (log_level() == LOG_LEVEL_DEBUG) then - call invoke( name = "compute_si_residuals", & - X_innerproduct_X(si_err(igh_u), rhs(igh_u)), & - X_innerproduct_X(si_err(igh_t), rhs(igh_t)), & - X_innerproduct_X(si_err(igh_d), rhs(igh_d)), & - X_innerproduct_X(si_err(igh_p), rhs(igh_p)) & - ) - write( log_scratch_space, '(A,E16.8)' ) & - 'Residual in momentum equation: ',sqrt(si_err(igh_u)) - call log_event( log_scratch_space, LOG_LEVEL_DEBUG ) - write( log_scratch_space, '(A,E16.8)' ) & - 'Residual in energy equation: ',sqrt(si_err(igh_t)) - call log_event( log_scratch_space, LOG_LEVEL_DEBUG ) - write( log_scratch_space, '(A,E16.8)' ) & - 'Residual in continuity equation:',sqrt(si_err(igh_d)) - call log_event( log_scratch_space, LOG_LEVEL_DEBUG ) - write( log_scratch_space, '(A,E16.8)' ) & - 'Residual in equation of state: ',sqrt(si_err(igh_p)) - call log_event( log_scratch_space, LOG_LEVEL_DEBUG ) + call invoke( & + name="compute_si_residuals", & + X_innerproduct_X(si_err(igh_u), rhs(igh_u)), & + X_innerproduct_X(si_err(igh_t), rhs(igh_t)), & + X_innerproduct_X(si_err(igh_d), rhs(igh_d)), & + X_innerproduct_X(si_err(igh_p), rhs(igh_p)) & + ) + write( log_scratch_space, '(A,E16.8)' ) & + 'Residual in momentum equation: ', sqrt(si_err(igh_u)) + call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + write( log_scratch_space, '(A,E16.8)' ) & + 'Residual in energy equation: ', sqrt(si_err(igh_t)) + call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + write( log_scratch_space, '(A,E16.8)' ) & + 'Residual in continuity equation:', sqrt(si_err(igh_d)) + call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + write( log_scratch_space, '(A,E16.8)' ) & + 'Residual in equation of state: ', sqrt(si_err(igh_p)) + call log_event(log_scratch_space, LOG_LEVEL_DEBUG) end if + ! ------------------------------------------------------------------------ ! + ! Copy to r_solver fields + ! ------------------------------------------------------------------------ ! ! Now we copy data to r_solver fields and proceed with everything ! of kind r_solver - call rhs_rsol(igh_u)%initialise( rhs(igh_u)%get_function_space() ) - call rhs_rsol(igh_t)%initialise( rhs(igh_t)%get_function_space() ) - call rhs_rsol(igh_d)%initialise( rhs(igh_d)%get_function_space() ) - call rhs_rsol(igh_p)%initialise( rhs(igh_p)%get_function_space() ) + call rhs_rsol(igh_u)%initialise(rhs(igh_u)%get_function_space()) + call rhs_rsol(igh_t)%initialise(rhs(igh_t)%get_function_space()) + call rhs_rsol(igh_d)%initialise(rhs(igh_d)%get_function_space()) + call rhs_rsol(igh_p)%initialise(rhs(igh_p)%get_function_space()) ! This is required to put sensible data in the halo so there is something ! for enforce_bc_kernel to work with - call invoke(setval_c(rhs_rsol(igh_u), 0.0_r_solver) ) + call invoke( setval_c(rhs_rsol(igh_u), 0.0_r_solver) ) call copy_field(rhs(igh_u), rhs_rsol(igh_u)) call copy_field(rhs(igh_t), rhs_rsol(igh_t)) call copy_field(rhs(igh_d), rhs_rsol(igh_d)) call copy_field(rhs(igh_p), rhs_rsol(igh_p)) - if ( first_iteration ) then - ! Modify RHS due to elimination of rho and theta only for inner iteration 1 - ! (for other values rhs_rho = rhs_theta = 0 and so nothing needs to be done) - m3_rho_star => get_m3_rho_star() + ! ------------------------------------------------------------------------ ! + ! Modify RHS (first inner iteration only) + ! ------------------------------------------------------------------------ ! + if (first_iteration) then + ! Modify RHS due to elimination of rho & theta only for inner iteration 1 + ! (for other values rhs_rho = rhs_theta = 0, so nothing needs to be done) + m3_rho_star => get_m3_rho_star(stepper_name) ! Elimination of rho ! Set rhs_p = rhs_p + M_{3,rho} * rhs_rho - call invoke( dg_inc_matrix_vector_kernel_type( rhs_rsol(igh_p), rhs_rsol(igh_d), m3_rho_star ) ) + call invoke( & + dg_inc_matrix_vector_kernel_type( & + rhs_rsol(igh_p), rhs_rsol(igh_d), m3_rho_star & + ) & + ) ! Elimination of theta if ( eliminate_variables == eliminate_variables_analytic ) then - q2t_op => get_eliminated_q2t() - q3t_op => get_eliminated_q3t() - call invoke( dg_inc_matrix_vector_kernel_type( rhs_rsol(igh_p), rhs_rsol(igh_t), q3t_op ), & - matrix_vector_kernel_type( rhs_rsol(igh_u), rhs_rsol(igh_t), q2t_op ), & - enforce_bc_kernel_type( rhs_rsol(igh_u) ) ) + q2t_op => get_eliminated_q2t(stepper_name) + q3t_op => get_eliminated_q3t(stepper_name) + call invoke( & + dg_inc_matrix_vector_kernel_type( & + rhs_rsol(igh_p), rhs_rsol(igh_t), q3t_op & + ), & + matrix_vector_kernel_type( & + rhs_rsol(igh_u), rhs_rsol(igh_t), q2t_op & + ), & + enforce_bc_kernel_type(rhs_rsol(igh_u)) & + ) else - p3theta => get_p3theta() - m2_diag => get_normalisation_r_solver(W2, mesh_id) + p3theta => get_p3theta(stepper_name) + m2_diag => get_normalisation_r_solver(W2, mesh_id) ! Set rhs_p = rhs_p + P_{3,theta} * rhs_theta - call invoke( dg_inc_matrix_vector_kernel_type( rhs_rsol(igh_p), rhs_rsol(igh_t), p3theta ) ) + call invoke( & + dg_inc_matrix_vector_kernel_type( & + rhs_rsol(igh_p), rhs_rsol(igh_t), p3theta & + ) & + ) ! Set rhs_u = rhs_u + M_2^{diag} * P_{2,theta} * rhs_theta - call rhs_tmp%initialise( vector_space = rhs_rsol(igh_u)%get_function_space() ) - p2theta => get_p2theta() - call invoke( setval_c(rhs_tmp, 0.0_r_def), & - matrix_vector_kernel_type( rhs_tmp, rhs_rsol(igh_t), p2theta ), & - inc_X_times_Y(rhs_tmp, m2_diag), & - inc_X_plus_Y(rhs_rsol(igh_u), rhs_tmp), & - enforce_bc_kernel_type( rhs_rsol(igh_u) ) ) + call rhs_tmp%initialise(rhs_rsol(igh_u)%get_function_space()) + p2theta => get_p2theta(stepper_name) + call invoke( & + setval_c(rhs_tmp, 0.0_r_def), & + matrix_vector_kernel_type(rhs_tmp, rhs_rsol(igh_t), p2theta), & + inc_X_times_Y(rhs_tmp, m2_diag), & + inc_X_plus_Y(rhs_rsol(igh_u), rhs_tmp), & + enforce_bc_kernel_type(rhs_rsol(igh_u)) & + ) end if end if + ! ------------------------------------------------------------------------ ! ! Solve the semi-implicit operator + ! ------------------------------------------------------------------------ ! if ( subroutine_timers ) call timer('mixed_solver') - call log_event( "Gungho: mixed solve:", LOG_LEVEL_DEBUG ) + call log_event("Gungho: mixed solve:", LOG_LEVEL_DEBUG) ! Create field vectors out of field arrays - call construct_solver_state(vector_inc, rhs_rsol, import_fields = .false.) - call construct_solver_state(vector_rhs, rhs_rsol, import_fields = .true.) + call construct_solver_state(vector_inc, rhs_rsol, import_fields=.false.) + call construct_solver_state(vector_rhs, rhs_rsol, import_fields=.true.) call vector_inc%set_scalar(0.0_r_def) - call mixed_solver%apply(vector_inc, vector_rhs) + + ! Call the appropriate solver + select case (stepper_name) + case (stepper_siqn) + call mixed_solver_siqn%apply(vector_inc, vector_rhs) + case (stepper_tr) + call mixed_solver_tr%apply(vector_inc, vector_rhs) + case (stepper_bdf2) + call mixed_solver_bdf2%apply(vector_inc, vector_rhs) + case default + call log_event( & + "semi_implicit_solver_alg_step: Unknown timestepper specified", & + LOG_LEVEL_ERROR & + ) + end select + if ( subroutine_timers ) call timer('mixed_solver') + ! ------------------------------------------------------------------------ ! + ! Get increments + ! ------------------------------------------------------------------------ ! ! Get the pressure increment inc_exner_rsol => vector_inc%get_field_from_position(isol_p) - call log_field_minmax( LOG_LEVEL_DEBUG, 'exner_inc', inc_exner_rsol ) + call log_field_minmax(LOG_LEVEL_DEBUG, 'exner_inc', inc_exner_rsol) ! Get the velocity increments and if necessary combine them - call inc_uvw_rsol%initialise( vector_space = rhs_rsol(igh_u)%get_function_space() ) - if ( split_w ) then + call inc_uvw_rsol%initialise(rhs_rsol(igh_u)%get_function_space()) + if (split_w) then inc_uv_rsol => vector_inc%get_field_from_position(isol_uv) inc_w_rsol => vector_inc%get_field_from_position(isol_w) - face_selector_ew => get_face_selector_ew( mesh_id ) - face_selector_ns => get_face_selector_ns( mesh_id ) - call invoke( & - combine_w2_field_kernel_type( inc_uvw_rsol, inc_uv_rsol, inc_w_rsol, & - face_selector_ew, face_selector_ns ) & - ) - call log_field_minmax( LOG_LEVEL_DEBUG, 'uv_inc', inc_uv_rsol ) - call log_field_minmax( LOG_LEVEL_DEBUG, 'w_inc', inc_w_rsol ) + face_selector_ew => get_face_selector_ew(mesh_id) + face_selector_ns => get_face_selector_ns(mesh_id) + call invoke( & + combine_w2_field_kernel_type( & + inc_uvw_rsol, inc_uv_rsol, inc_w_rsol, & + face_selector_ew, face_selector_ns & + ) & + ) + call log_field_minmax(LOG_LEVEL_DEBUG, 'uv_inc', inc_uv_rsol ) + call log_field_minmax(LOG_LEVEL_DEBUG, 'w_inc', inc_w_rsol) else call vector_inc%vector(isol_u)%copy_field_properties(inc_uvw_rsol) call invoke( setval_X(inc_uvw_rsol, vector_inc%vector(isol_u)) ) - call log_field_minmax( LOG_LEVEL_DEBUG, 'uvw_inc', inc_uvw_rsol ) + call log_field_minmax(LOG_LEVEL_DEBUG, 'uvw_inc', inc_uvw_rsol) end if ! Get the theta and rho increments - call inc_theta_rsol%initialise( vector_space = rhs_rsol(igh_t)%get_function_space() ) - call inc_rho_rsol%initialise( vector_space = rhs_rsol(igh_d)%get_function_space() ) + call inc_theta_rsol%initialise(rhs_rsol(igh_t)%get_function_space()) + call inc_rho_rsol%initialise(rhs_rsol(igh_d)%get_function_space()) + ! Compute rho increment since solver does not provide one - div => get_im3_div_r_solver(mesh_id) + select case (stepper_name) + case (stepper_siqn) + tau_r_dt = real(-tau_r*dt, kind=r_solver) + case (stepper_tr) + gamma = 1.0_r_solver - 0.5_r_solver * SQRT(2.0_r_solver) + tau_r_dt = -2.0_r_solver*gamma*real(dt, kind=r_solver) + case (stepper_bdf2) + tau_r_dt = real(-dt, kind=r_solver) + end select + + div => get_im3_div_r_solver(mesh_id) rho_at_u => get_rho_at_u() - tau_r_dt = real(-tau_r*dt, kind=r_solver) - call div_u%initialise( vector_space = rhs_rsol(igh_p)%get_function_space() ) - call f_star%initialise( vector_space = rhs_rsol(igh_u)%get_function_space() ) + call div_u%initialise(rhs_rsol(igh_p)%get_function_space()) + call f_star%initialise(rhs_rsol(igh_u)%get_function_space()) - call invoke( X_times_Y( f_star, rho_at_u, inc_uvw_rsol ), & - dg_matrix_vector_kernel_type( div_u, f_star, div ), & - aX_plus_Y(inc_rho_rsol, tau_r_dt, div_u, rhs_rsol(igh_d)) & - ) + call invoke( & + X_times_Y(f_star, rho_at_u, inc_uvw_rsol), & + dg_matrix_vector_kernel_type(div_u, f_star, div), & + aX_plus_Y(inc_rho_rsol, tau_r_dt, div_u, rhs_rsol(igh_d)) & + ) ! Compute theta increment since solver does not provide one - ptheta2 => get_ptheta2() + ptheta2 => get_ptheta2(stepper_name) mt_lumped_inv => get_normalisation_r_solver(Wtheta, mesh_id) - call rhs_tmp%initialise( vector_space = rhs_rsol(igh_t)%get_function_space() ) - call invoke( setval_c(rhs_tmp, 0.0_r_def), & - dg_inc_matrix_vector_kernel_type(rhs_tmp, inc_uvw_rsol, ptheta2)) + call rhs_tmp%initialise(rhs_rsol(igh_t)%get_function_space()) + call invoke( & + setval_c(rhs_tmp, 0.0_r_def), & + dg_inc_matrix_vector_kernel_type(rhs_tmp, inc_uvw_rsol, ptheta2) & + ) - if ( eliminate_variables == eliminate_variables_analytic ) then + if (eliminate_variables == eliminate_variables_analytic) then call copy_field(rhs_tmp, rhs_rdef) - call inc_theta%initialise( state(igh_t)%get_function_space() ) - call mass_matrix_solver_alg( inc_theta, rhs_rdef ) + call inc_theta%initialise(state(igh_t)%get_function_space()) + call mass_matrix_solver_alg(inc_theta, rhs_rdef) call copy_field(inc_theta, rhs_tmp) else call invoke( inc_X_times_Y(rhs_tmp, mt_lumped_inv) ) end if - call invoke( X_minus_Y( inc_theta_rsol, rhs_rsol(igh_t), rhs_tmp) ) + call invoke( X_minus_Y(inc_theta_rsol, rhs_rsol(igh_t), rhs_tmp) ) ! Finally we need to add r_solver increments to the r_def state field - call invoke_inc_rdefX_plus_rsolverY( state(igh_u), inc_uvw_rsol ) - call invoke_inc_rdefX_plus_rsolverY( state(igh_p), inc_exner_rsol ) - call invoke_inc_rdefX_plus_rsolverY( state(igh_t), inc_theta_rsol ) - call invoke_inc_rdefX_plus_rsolverY( state(igh_d), inc_rho_rsol ) + call invoke_inc_rdefX_plus_rsolverY(state(igh_u), inc_uvw_rsol) + call invoke_inc_rdefX_plus_rsolverY(state(igh_p), inc_exner_rsol) + call invoke_inc_rdefX_plus_rsolverY(state(igh_t), inc_theta_rsol) + call invoke_inc_rdefX_plus_rsolverY(state(igh_d), inc_rho_rsol) - if ( write_moisture_diag ) & - call moisture_conservation_alg( state(igh_d), mr, 'After solve' ) + if (write_moisture_diag) then + call moisture_conservation_alg(state(igh_d), mr, 'After solve') + end if if ( subroutine_timers ) call timer('semi_implicit_solver_alg') end subroutine semi_implicit_solver_alg_step !> @brief Construct a field vector state out of a field bundle, expanding to - !> inlcude the split wind fields if necessary - !>@param[in,out] vector_state Field vector to create - !>@param[in] bundle_state Field bundle to copy - !>@param[in] import fields Import (copy) data from field_bundle + !! include the split wind fields if necessary + !> @param[in,out] vector_state Field vector to create + !> @param[in] bundle_state Field bundle to copy + !> @param[in] import fields Import (copy) data from field_bundle subroutine construct_solver_state(vector_state, bundle_state, import_fields) + use function_space_collection_mod, only: function_space_collection use fs_continuity_mod, only: W2v, W2h implicit none - type( r_solver_field_vector_type ), intent(inout) :: vector_state - type( r_solver_field_type ), dimension(bundle_size), intent(in) :: bundle_state - logical( kind=l_def ), intent(in) :: import_fields + type(r_solver_field_vector_type), intent(inout) :: vector_state + type(r_solver_field_type), intent(in) :: bundle_state(bundle_size) + logical(kind=l_def), intent(in) :: import_fields - type( r_solver_field_type ) :: uv, w - type( mesh_type ), pointer :: mesh + type(r_solver_field_type) :: uv, w + type(mesh_type), pointer :: mesh type(integer_field_type), pointer :: face_selector_ew type(integer_field_type), pointer :: face_selector_ns - integer( kind=i_def ) :: element_order_h, element_order_v, state_size + integer(kind=i_def) :: element_order_h, element_order_v + integer(kind=i_def) :: state_size state_size = 2 ! Default UV + P fields - if ( split_w ) & - state_size = state_size + 1 ! Additional W field + if (split_w) state_size = state_size + 1 ! Additional W field - vector_state = r_solver_field_vector_type( state_size ) + vector_state = r_solver_field_vector_type(state_size) ! Wind fields - if ( split_w ) then - element_order_h = bundle_state(igh_u)%get_element_order_h() - element_order_v = bundle_state(igh_u)%get_element_order_v() + if (split_w) then + element_order_h = bundle_state(igh_u)%get_element_order_h() + element_order_v = bundle_state(igh_u)%get_element_order_v() mesh => bundle_state(igh_u)%get_mesh() face_selector_ew => get_face_selector_ew( mesh%get_id() ) face_selector_ns => get_face_selector_ns( mesh%get_id() ) - call uv%initialise( function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W2h ) ) - call w%initialise( function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W2v ) ) - if ( import_fields ) then - call invoke( setval_c( uv, 0.0_r_def ), & - setval_c( w, 0.0_r_def ), & - split_w2_field_kernel_type( uv, w, bundle_state(igh_u), & - face_selector_ew, & - face_selector_ns ) ) - call vector_state%import_field( uv, isol_uv ) - call vector_state%import_field( w, isol_w ) + call uv%initialise( function_space_collection%get_fs( & + mesh, element_order_h, element_order_v, W2h & + ) ) + call w%initialise( function_space_collection%get_fs( & + mesh, element_order_h, element_order_v, W2v & + ) ) + if (import_fields) then + call invoke( & + setval_c(uv, 0.0_r_def), & + setval_c(w, 0.0_r_def), & + split_w2_field_kernel_type( & + uv, w, bundle_state(igh_u), & + face_selector_ew, face_selector_ns & + ) & + ) + call vector_state%import_field(uv, isol_uv) + call vector_state%import_field(w, isol_w) else - call vector_state%initialise_field( isol_uv, uv%get_function_space() ) - call vector_state%initialise_field( isol_w, w%get_function_space() ) + call vector_state%initialise_field(isol_uv, uv%get_function_space()) + call vector_state%initialise_field(isol_w, w%get_function_space()) end if + else - if ( import_fields ) then - call vector_state%import_field( bundle_state(igh_u), isol_u ) + if (import_fields) then + call vector_state%import_field(bundle_state(igh_u), isol_u) else - call vector_state%initialise_field( isol_u, bundle_state(igh_u)%get_function_space() ) + call vector_state%initialise_field( & + isol_u, bundle_state(igh_u)%get_function_space() & + ) end if end if ! Pressure fields - if ( import_fields ) then - call vector_state%import_field( bundle_state(igh_p), isol_p ) + if (import_fields) then + call vector_state%import_field(bundle_state(igh_p), isol_p) else - call vector_state%initialise_field( isol_p, bundle_state(igh_p)%get_function_space() ) + call vector_state%initialise_field( & + isol_p, bundle_state(igh_p)%get_function_space() & + ) end if end subroutine construct_solver_state diff --git a/science/gungho/source/algorithm/solver/si_operators_alg_mod.x90 b/science/gungho/source/algorithm/solver/si_operators_alg_mod.x90 index 0b116dad8..70fcc1e67 100644 --- a/science/gungho/source/algorithm/solver/si_operators_alg_mod.x90 +++ b/science/gungho/source/algorithm/solver/si_operators_alg_mod.x90 @@ -10,72 +10,108 @@ !! More details of the solver forumulation can be found in the solver section of: !! https://code.metoffice.gov.uk/trac/lfric/wiki/GhaspSupport/Documentation module si_operators_alg_mod - use base_mesh_config_mod, only: prime_mesh_name + + ! Infrastructure use constants_mod, only: i_def, r_def, r_solver - use model_clock_mod, only: model_clock_type - use operator_mod, only: operator_type, r_solver_operator_type + use copy_field_alg_mod, only: copy_field use field_mod, only: field_type + use fs_continuity_mod, only: W2, W3, Wtheta use function_space_mod, only: function_space_type - use finite_element_config_mod, only: element_order_h, & - element_order_v, & - nqp_h_exact, & - nqp_v_exact - use function_space_collection_mod, & + use function_space_chain_mod, only: multigrid_function_space_chain, & + w2_multigrid_function_space_chain, & + wtheta_multigrid_function_space_chain + use function_space_collection_mod, & only: function_space_collection - use r_solver_field_mod, only: r_solver_field_type - use fs_continuity_mod, only: W2, W3 - use copy_field_alg_mod, only: copy_field - use log_mod, only: log_event, & - LOG_LEVEL_DEBUG, & - LOG_LEVEL_ERROR, & + use log_mod, only: log_event, & + LOG_LEVEL_DEBUG, & + LOG_LEVEL_ERROR, & log_scratch_space use mesh_mod, only: mesh_type - use helmholtz_solver_config_mod, & - only: preconditioner, & - preconditioner_tridiagonal, & - preconditioner_multigrid, & - normalise - use io_config_mod, only: subroutine_timers + use model_clock_mod, only: model_clock_type + use operator_mod, only: operator_type, r_solver_operator_type + use r_solver_field_mod, only: r_solver_field_type use timer_mod, only: timer - use function_space_chain_mod, only: multigrid_function_space_chain, & - w2_multigrid_function_space_chain, & - wtheta_multigrid_function_space_chain - use formulation_config_mod, only: l_multigrid, & - eos_method, & - eos_method_sampled, & - eos_method_projected, & - p2theta_vert, & + ! Configuration + use base_mesh_config_mod, only: prime_mesh_name + use finite_element_config_mod, only: element_order_h, & + element_order_v, & + nqp_h_exact, & + nqp_v_exact + use formulation_config_mod, only: l_multigrid, & + eos_method, & + eos_method_sampled, & + eos_method_projected, & + p2theta_vert, & moisture_in_solver + use helmholtz_solver_config_mod, & + only: preconditioner, & + preconditioner_tridiagonal, & + preconditioner_multigrid, & + normalise + use io_config_mod, only: subroutine_timers use multigrid_config_mod, only: multigrid_chain_nitems - use mixed_solver_config_mod, only: eliminate_variables, & + use mixed_solver_config_mod, only: eliminate_variables, & eliminate_variables_analytic - use moist_dyn_mod, only: num_moist_factors, gas_law, total_mass + + ! Stepper enumerators + use dycore_constants_mod, only: stepper_siqn, stepper_tr, stepper_bdf2 implicit none private ! Variables private to this module that can only be accessed by public ! functions returning pointers to them - type(r_solver_operator_type), allocatable, dimension(:), target :: m3_rho_star - type(r_solver_operator_type), allocatable, dimension(:), target :: m3_exner_star - type(r_solver_operator_type), allocatable, dimension(:), target :: div_star - type(r_solver_operator_type), allocatable, dimension(:), target :: p2theta - type(r_solver_operator_type), allocatable, dimension(:), target :: ptheta2 - type(r_solver_operator_type), allocatable, dimension(:), target :: ptheta2v - type(r_solver_operator_type), allocatable, dimension(:), target :: p3theta - type(r_solver_operator_type), allocatable, dimension(:), target :: compound_div - type(r_solver_operator_type), allocatable, dimension(:), target :: eliminated_q22 - type(r_solver_operator_type), allocatable, dimension(:), target :: eliminated_q32 - type(r_solver_operator_type), target :: eliminated_q2t - - type(r_solver_field_type), allocatable, dimension(:), target :: rho_at_u - type(r_solver_field_type), allocatable, dimension(:,:), target :: tri_precon - type(r_solver_field_type), allocatable, dimension(:,:), target :: Helmholtz_operator - type(r_solver_field_type), allocatable, dimension(:), target :: Helm_diag - type(r_solver_field_type), allocatable, dimension(:), target :: Hb_lumped_inv integer(kind=i_def) :: multigrid_levels + type(r_solver_operator_type), allocatable, target :: m3_rho_star_siqn(:) + type(r_solver_operator_type), allocatable, target :: m3_rho_star_tr(:) + type(r_solver_operator_type), allocatable, target :: m3_rho_star_bdf2(:) + type(r_solver_operator_type), allocatable, target :: m3_exner_star_siqn(:) + type(r_solver_operator_type), allocatable, target :: m3_exner_star_tr(:) + type(r_solver_operator_type), allocatable, target :: m3_exner_star_bdf2(:) + type(r_solver_operator_type), allocatable, target :: div_star_siqn(:) + type(r_solver_operator_type), allocatable, target :: div_star_tr(:) + type(r_solver_operator_type), allocatable, target :: div_star_bdf2(:) + type(r_solver_operator_type), allocatable, target :: p2theta_siqn(:) + type(r_solver_operator_type), allocatable, target :: p2theta_tr(:) + type(r_solver_operator_type), allocatable, target :: p2theta_bdf2(:) + type(r_solver_operator_type), allocatable, target :: ptheta2_siqn(:) + type(r_solver_operator_type), allocatable, target :: ptheta2_tr(:) + type(r_solver_operator_type), allocatable, target :: ptheta2_bdf2(:) + type(r_solver_operator_type), allocatable, target :: ptheta2v_siqn(:) + type(r_solver_operator_type), allocatable, target :: ptheta2v_tr(:) + type(r_solver_operator_type), allocatable, target :: ptheta2v_bdf2(:) + type(r_solver_operator_type), allocatable, target :: p3theta_siqn(:) + type(r_solver_operator_type), allocatable, target :: p3theta_tr(:) + type(r_solver_operator_type), allocatable, target :: p3theta_bdf2(:) + type(r_solver_operator_type), allocatable, target :: compound_div_siqn(:) + type(r_solver_operator_type), allocatable, target :: compound_div_tr(:) + type(r_solver_operator_type), allocatable, target :: compound_div_bdf2(:) + type(r_solver_operator_type), allocatable, target :: eliminated_q22_siqn(:) + type(r_solver_operator_type), allocatable, target :: eliminated_q22_tr(:) + type(r_solver_operator_type), allocatable, target :: eliminated_q22_bdf2(:) + type(r_solver_operator_type), allocatable, target :: eliminated_q32_siqn(:) + type(r_solver_operator_type), allocatable, target :: eliminated_q32_tr(:) + type(r_solver_operator_type), allocatable, target :: eliminated_q32_bdf2(:) + type(r_solver_operator_type), target :: eliminated_q2t_siqn + type(r_solver_operator_type), target :: eliminated_q2t_tr + type(r_solver_operator_type), target :: eliminated_q2t_bdf2 + + type(r_solver_field_type), allocatable, target :: rho_at_u(:) + type(r_solver_field_type), allocatable, target :: tri_precon_siqn(:,:) + type(r_solver_field_type), allocatable, target :: tri_precon_tr(:,:) + type(r_solver_field_type), allocatable, target :: tri_precon_bdf2(:,:) + type(r_solver_field_type), allocatable, target :: Helmholtz_operator_siqn(:,:) + type(r_solver_field_type), allocatable, target :: Helmholtz_operator_tr(:,:) + type(r_solver_field_type), allocatable, target :: Helmholtz_operator_bdf2(:,:) + type(r_solver_field_type), allocatable, target :: Helm_diag_siqn(:) + type(r_solver_field_type), allocatable, target :: Helm_diag_tr(:) + type(r_solver_field_type), allocatable, target :: Helm_diag_bdf2(:) + type(r_solver_field_type), allocatable, target :: Hb_lumped_inv_siqn(:) + type(r_solver_field_type), allocatable, target :: Hb_lumped_inv_tr(:) + type(r_solver_field_type), allocatable, target :: Hb_lumped_inv_bdf2(:) + ! Size of the Helmholtz stencil: 1 Central cell, 4 horizontal neighbours, 2 ! cells above (k+1,k+2) and 2 cells below (k-1,k-2) integer(kind=i_def), parameter :: helmholtz_stencil_size = 9 @@ -115,7 +151,7 @@ module si_operators_alg_mod public :: get_eliminated_q2t public :: get_eliminated_q3t - !F90 function overloading + ! F90 function overloading interface get_m3_rho_star module procedure get_m3_rho_star_fine, get_m3_rho_star_mg end interface get_m3_rho_star @@ -178,109 +214,228 @@ module si_operators_alg_mod contains - !>@brief Subroutine to create the si operators - !>@param[in] mesh The mesh - subroutine create_si_operators( mesh ) + !> @brief Subroutine to create the si operators + !> @param[in] mesh The mesh + !> @param[in] stepper_name Enumerator for timestepper + subroutine create_si_operators(mesh, stepper_name) use fs_continuity_mod, only: W0, Wtheta implicit none type(mesh_type), pointer, intent(in) :: mesh - - integer(kind=i_def) :: i, j - type(function_space_type), pointer :: w2_fs => null() - type(function_space_type), pointer :: w3_fs => null() - type(function_space_type), pointer :: wt_fs => null() + integer(kind=i_def), intent(in) :: stepper_name + + integer(kind=i_def) :: i, j + type(function_space_type), pointer :: w2_fs + type(function_space_type), pointer :: w3_fs + type(function_space_type), pointer :: wt_fs + + type(r_solver_operator_type), pointer :: m3_rho_star(:) + type(r_solver_operator_type), pointer :: m3_exner_star(:) + type(r_solver_operator_type), pointer :: div_star(:) + type(r_solver_operator_type), pointer :: p2theta(:) + type(r_solver_operator_type), pointer :: ptheta2(:) + type(r_solver_operator_type), pointer :: ptheta2v(:) + type(r_solver_operator_type), pointer :: p3theta(:) + type(r_solver_operator_type), pointer :: compound_div(:) + type(r_solver_operator_type), pointer :: eliminated_q22(:) + type(r_solver_operator_type), pointer :: eliminated_q32(:) + type(r_solver_operator_type), pointer :: eliminated_q2t + type(r_solver_field_type), pointer :: tri_precon(:,:) + type(r_solver_field_type), pointer :: Helmholtz_operator(:,:) + type(r_solver_field_type), pointer :: helm_diag(:) + type(r_solver_field_type), pointer :: Hb_lumped_inv(:) if ( subroutine_timers ) call timer('si_operators_alg:create') - call log_event( "Gungho: creating si_operators", LOG_LEVEL_DEBUG ) + call log_event("Gungho: creating si_operators", LOG_LEVEL_DEBUG) - if(l_multigrid) then - multigrid_levels=multigrid_chain_nitems + if (l_multigrid) then + multigrid_levels = multigrid_chain_nitems else - multigrid_levels=1 + multigrid_levels = 1 end if - w2_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W2 ) - w3_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W3 ) - wt_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, Wtheta ) - - allocate(m3_rho_star(multigrid_levels)) - allocate(m3_exner_star(multigrid_levels)) - allocate(div_star(multigrid_levels)) - allocate(p2theta(multigrid_levels)) - allocate(ptheta2(multigrid_levels)) - allocate(ptheta2v(multigrid_levels)) - allocate(p3theta(multigrid_levels)) - allocate(compound_div(multigrid_levels)) - allocate(eliminated_q22(multigrid_levels)) - allocate(eliminated_q32(multigrid_levels)) - - !fields - allocate(rho_at_u(multigrid_levels)) - if ( preconditioner == preconditioner_tridiagonal .or. & - preconditioner == preconditioner_multigrid) then - if ( element_order_h /= 0 .or. element_order_v /= 0 ) then - call log_event( "tridiagonal precon only valid for order 0", & - LOG_LEVEL_ERROR ) - end if - allocate(tri_precon(3, multigrid_levels)) - end if - if ( element_order_h == 0 .and. element_order_v == 0 ) then - allocate( Helmholtz_operator(helmholtz_stencil_size, multigrid_levels) ) - end if - allocate(helm_diag(multigrid_levels)) - allocate(Hb_lumped_inv(multigrid_levels)) - - if (l_multigrid) then + w2_fs => function_space_collection%get_fs( & + mesh, element_order_h, element_order_v, W2 & + ) + w3_fs => function_space_collection%get_fs( & + mesh, element_order_h, element_order_v, W3 & + ) + wt_fs => function_space_collection%get_fs( & + mesh, element_order_h, element_order_v, Wtheta & + ) + + ! ======================================================================== ! + ! Allocate arrays of operators / fields + ! ======================================================================== ! + + if (.not. allocated(rho_at_u)) allocate(rho_at_u(multigrid_levels)) + + select case (stepper_name) + case (stepper_siqn ) + allocate(m3_rho_star_siqn(multigrid_levels)) + allocate(m3_exner_star_siqn(multigrid_levels)) + allocate(div_star_siqn(multigrid_levels)) + allocate(p2theta_siqn(multigrid_levels)) + allocate(ptheta2_siqn(multigrid_levels)) + allocate(ptheta2v_siqn(multigrid_levels)) + allocate(p3theta_siqn(multigrid_levels)) + allocate(compound_div_siqn(multigrid_levels)) + allocate(eliminated_q22_siqn(multigrid_levels)) + allocate(eliminated_q32_siqn(multigrid_levels)) + allocate(tri_precon_siqn(3, multigrid_levels)) + allocate( & + Helmholtz_operator_siqn(helmholtz_stencil_size, multigrid_levels) & + ) + allocate(helm_diag_siqn(multigrid_levels)) + allocate(Hb_lumped_inv_siqn(multigrid_levels)) + + case (stepper_tr) + allocate(m3_rho_star_tr(multigrid_levels)) + allocate(m3_exner_star_tr(multigrid_levels)) + allocate(div_star_tr(multigrid_levels)) + allocate(p2theta_tr(multigrid_levels)) + allocate(ptheta2_tr(multigrid_levels)) + allocate(ptheta2v_tr(multigrid_levels)) + allocate(p3theta_tr(multigrid_levels)) + allocate(compound_div_tr(multigrid_levels)) + allocate(eliminated_q22_tr(multigrid_levels)) + allocate(eliminated_q32_tr(multigrid_levels)) + allocate(tri_precon_tr(3, multigrid_levels)) + allocate(Helmholtz_operator_tr(helmholtz_stencil_size, multigrid_levels)) + allocate(helm_diag_tr(multigrid_levels)) + allocate(Hb_lumped_inv_tr(multigrid_levels)) + + case (stepper_bdf2) + allocate(m3_rho_star_bdf2(multigrid_levels)) + allocate(m3_exner_star_bdf2(multigrid_levels)) + allocate(div_star_bdf2(multigrid_levels)) + allocate(p2theta_bdf2(multigrid_levels)) + allocate(ptheta2_bdf2(multigrid_levels)) + allocate(ptheta2v_bdf2(multigrid_levels)) + allocate(p3theta_bdf2(multigrid_levels)) + allocate(compound_div_bdf2(multigrid_levels)) + allocate(eliminated_q22_bdf2(multigrid_levels)) + allocate(eliminated_q32_bdf2(multigrid_levels)) + allocate(tri_precon_bdf2(3, multigrid_levels)) + allocate( & + Helmholtz_operator_bdf2(helmholtz_stencil_size, multigrid_levels) & + ) + allocate(helm_diag_bdf2(multigrid_levels)) + allocate(Hb_lumped_inv_bdf2(multigrid_levels)) + + end select + + ! ======================================================================== ! + ! Set pointers + ! ======================================================================== ! + + select case (stepper_name) + case (stepper_siqn) + m3_rho_star => m3_rho_star_siqn + m3_exner_star => m3_exner_star_siqn + div_star => div_star_siqn + p2theta => p2theta_siqn + ptheta2 => ptheta2_siqn + ptheta2v => ptheta2v_siqn + p3theta => p3theta_siqn + compound_div => compound_div_siqn + eliminated_q22 => eliminated_q22_siqn + eliminated_q32 => eliminated_q32_siqn + eliminated_q2t => eliminated_q2t_siqn + tri_precon => tri_precon_siqn + Helmholtz_operator => Helmholtz_operator_siqn + helm_diag => helm_diag_siqn + Hb_lumped_inv => Hb_lumped_inv_siqn + + case (stepper_tr) + m3_rho_star => m3_rho_star_tr + m3_exner_star => m3_exner_star_tr + div_star => div_star_tr + p2theta => p2theta_tr + ptheta2 => ptheta2_tr + ptheta2v => ptheta2v_tr + p3theta => p3theta_tr + compound_div => compound_div_tr + eliminated_q22 => eliminated_q22_tr + eliminated_q32 => eliminated_q32_tr + eliminated_q2t => eliminated_q2t_tr + tri_precon => tri_precon_tr + Helmholtz_operator => Helmholtz_operator_tr + helm_diag => helm_diag_tr + Hb_lumped_inv => Hb_lumped_inv_tr + + case (stepper_bdf2) + m3_rho_star => m3_rho_star_bdf2 + m3_exner_star => m3_exner_star_bdf2 + div_star => div_star_bdf2 + p2theta => p2theta_bdf2 + ptheta2 => ptheta2_bdf2 + ptheta2v => ptheta2v_bdf2 + p3theta => p3theta_bdf2 + compound_div => compound_div_bdf2 + eliminated_q22 => eliminated_q22_bdf2 + eliminated_q32 => eliminated_q32_bdf2 + eliminated_q2t => eliminated_q2t_bdf2 + tri_precon => tri_precon_bdf2 + Helmholtz_operator => Helmholtz_operator_bdf2 + helm_diag => helm_diag_bdf2 + Hb_lumped_inv => Hb_lumped_inv_bdf2 + + end select + + ! ======================================================================== ! + ! Initialise fields + ! ======================================================================== ! + + if (l_multigrid) then call multigrid_function_space_chain%set_current(w3_fs%get_id()) call w2_multigrid_function_space_chain%set_current(w2_fs%get_id()) call wtheta_multigrid_function_space_chain%set_current(wt_fs%get_id()) - end if - - call eliminated_q2t%initialise( w2_fs, wt_fs ) - - do i = 1, multigrid_levels - - write(log_scratch_space,'(A,I0,A)') "si_ops[",i,"]:creating ops" - call log_event(log_scratch_space,LOG_LEVEL_DEBUG) - - call m3_rho_star(i)%initialise( w3_fs, w3_fs ) - call m3_exner_star(i)%initialise( w3_fs, w3_fs ) - call div_star(i)%initialise( w2_fs, w3_fs ) - call p2theta(i)%initialise( w2_fs, wt_fs ) - call ptheta2(i)%initialise( wt_fs, w2_fs ) - call ptheta2v(i)%initialise( wt_fs, w2_fs ) - call p3theta(i)%initialise( w3_fs, wt_fs ) - call compound_div(i)%initialise( w3_fs, w2_fs ) - call eliminated_q22(i)%initialise( w2_fs, w2_fs ) - call eliminated_q32(i)%initialise( w3_fs, w2_fs ) - - call rho_at_u(i)%initialise(vector_space = w2_fs) - if ( preconditioner == preconditioner_tridiagonal .or. & - preconditioner == preconditioner_multigrid ) then - call tri_precon(1,i)%initialise(vector_space = w3_fs) - call tri_precon(2,i)%initialise(vector_space = w3_fs) - call tri_precon(3,i)%initialise(vector_space = w3_fs) - end if - if ( element_order_h == 0 .and. element_order_v == 0 ) then - do j = 1,helmholtz_stencil_size - call Helmholtz_operator(j,i)%initialise(vector_space = w3_fs) - end do - end if - call helm_diag(i)%initialise(vector_space = w3_fs) - call Hb_lumped_inv(i)%initialise(vector_space = w2_fs) - if(l_multigrid) then - w3_fs=>multigrid_function_space_chain%get_next() - w2_fs=>w2_multigrid_function_space_chain%get_next() - wt_fs=>wtheta_multigrid_function_space_chain%get_next() - end if + end if + + call eliminated_q2t%initialise( w2_fs, wt_fs ) + + do i = 1, multigrid_levels + + write(log_scratch_space,'(A,I0,A)') "si_ops[",i,"]:creating ops" + call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + + call m3_rho_star(i)%initialise( w3_fs, w3_fs ) + call m3_exner_star(i)%initialise( w3_fs, w3_fs ) + call div_star(i)%initialise( w2_fs, w3_fs ) + call p2theta(i)%initialise( w2_fs, wt_fs ) + call ptheta2(i)%initialise( wt_fs, w2_fs ) + call ptheta2v(i)%initialise( wt_fs, w2_fs ) + call p3theta(i)%initialise( w3_fs, wt_fs ) + call compound_div(i)%initialise( w3_fs, w2_fs ) + call eliminated_q22(i)%initialise( w2_fs, w2_fs ) + call eliminated_q32(i)%initialise( w3_fs, w2_fs ) + + call rho_at_u(i)%initialise(vector_space = w2_fs) + if ( preconditioner == preconditioner_tridiagonal .or. & + preconditioner == preconditioner_multigrid ) then + call tri_precon(1,i)%initialise(vector_space = w3_fs) + call tri_precon(2,i)%initialise(vector_space = w3_fs) + call tri_precon(3,i)%initialise(vector_space = w3_fs) + end if + + if ( element_order_h == 0 .and. element_order_v == 0 ) then + do j = 1, helmholtz_stencil_size + call Helmholtz_operator(j,i)%initialise(vector_space = w3_fs) + end do + end if + + call helm_diag(i)%initialise(vector_space = w3_fs) + call Hb_lumped_inv(i)%initialise(vector_space = w2_fs) + + if (l_multigrid) then + w3_fs => multigrid_function_space_chain%get_next() + w2_fs => w2_multigrid_function_space_chain%get_next() + wt_fs => wtheta_multigrid_function_space_chain%get_next() + end if end do - nullify( w2_fs, w3_fs, wt_fs ) if ( subroutine_timers ) call timer('si_operators_alg:create') @@ -292,64 +447,134 @@ contains implicit none ! deallocate everything! - if(allocated(m3_rho_star)) then - deallocate(m3_rho_star) + if (allocated(m3_rho_star_siqn)) then + deallocate(m3_rho_star_siqn) end if - - if(allocated(m3_exner_star)) then - deallocate(m3_exner_star) + if (allocated(m3_rho_star_tr)) then + deallocate(m3_rho_star_tr) end if - - if(allocated(div_star)) then - deallocate(div_star) + if (allocated(m3_rho_star_bdf2)) then + deallocate(m3_rho_star_bdf2) end if - - if(allocated(p2theta)) then - deallocate( p2theta ) + if (allocated(m3_exner_star_siqn)) then + deallocate(m3_exner_star_siqn) end if - - if(allocated(ptheta2)) then - deallocate(ptheta2) + if (allocated(m3_exner_star_tr)) then + deallocate(m3_exner_star_tr) end if - - if(allocated(ptheta2v)) then - deallocate(ptheta2v) + if (allocated(m3_exner_star_bdf2)) then + deallocate(m3_exner_star_bdf2) end if - - if(allocated(p3theta)) then - deallocate(p3theta) + if (allocated(div_star_siqn)) then + deallocate(div_star_siqn) end if - - if(allocated(compound_div)) then - deallocate(compound_div) + if (allocated(div_star_tr)) then + deallocate(div_star_tr) end if - - if(allocated(rho_at_u)) then - deallocate(rho_at_u) + if (allocated(div_star_bdf2)) then + deallocate(div_star_bdf2) end if - - if(allocated(Helm_diag)) then - deallocate(Helm_diag) + if (allocated(p2theta_siqn)) then + deallocate(p2theta_siqn) end if - - if(allocated(tri_precon)) then - deallocate(tri_precon) + if (allocated(p2theta_tr)) then + deallocate(p2theta_tr) end if - - if(allocated(hb_lumped_inv)) then - deallocate(hb_lumped_inv) + if (allocated(p2theta_bdf2)) then + deallocate(p2theta_bdf2) end if - - if(allocated(Helmholtz_operator)) then - deallocate(Helmholtz_operator) + if (allocated(ptheta2_siqn)) then + deallocate(ptheta2_siqn) end if - - if(allocated(eliminated_q22)) then - deallocate(eliminated_q22) + if (allocated(ptheta2_tr)) then + deallocate(ptheta2_tr) end if - - if(allocated(eliminated_q32)) then - deallocate(eliminated_q32) + if (allocated(ptheta2_bdf2)) then + deallocate(ptheta2_bdf2) + end if + if (allocated(ptheta2v_siqn)) then + deallocate(ptheta2v_siqn) + end if + if (allocated(ptheta2v_tr)) then + deallocate(ptheta2v_tr) + end if + if (allocated(ptheta2v_bdf2)) then + deallocate(ptheta2v_bdf2) + end if + if (allocated(p3theta_siqn)) then + deallocate(p3theta_siqn) + end if + if (allocated(p3theta_tr)) then + deallocate(p3theta_tr) + end if + if (allocated(p3theta_bdf2)) then + deallocate(p3theta_bdf2) + end if + if (allocated(compound_div_siqn)) then + deallocate(compound_div_siqn) + end if + if (allocated(compound_div_tr)) then + deallocate(compound_div_tr) + end if + if (allocated(compound_div_bdf2)) then + deallocate(compound_div_bdf2) + end if + if (allocated(eliminated_q22_siqn)) then + deallocate(eliminated_q22_siqn) + end if + if (allocated(eliminated_q22_tr)) then + deallocate(eliminated_q22_tr) + end if + if (allocated(eliminated_q22_bdf2)) then + deallocate(eliminated_q22_bdf2) + end if + if (allocated(eliminated_q32_siqn)) then + deallocate(eliminated_q32_siqn) + end if + if (allocated(eliminated_q32_tr)) then + deallocate(eliminated_q32_tr) + end if + if (allocated(eliminated_q32_bdf2)) then + deallocate(eliminated_q32_bdf2) + end if + if (allocated(rho_at_u)) then + deallocate(rho_at_u) + end if + if (allocated(Helm_diag_siqn)) then + deallocate(Helm_diag_siqn) + end if + if (allocated(Helm_diag_tr)) then + deallocate(Helm_diag_tr) + end if + if (allocated(Helm_diag_bdf2)) then + deallocate(Helm_diag_bdf2) + end if + if (allocated(tri_precon_siqn)) then + deallocate(tri_precon_siqn) + end if + if (allocated(tri_precon_tr)) then + deallocate(tri_precon_tr) + end if + if (allocated(tri_precon_bdf2)) then + deallocate(tri_precon_bdf2) + end if + if (allocated(hb_lumped_inv_siqn)) then + deallocate(hb_lumped_inv_siqn) + end if + if (allocated(hb_lumped_inv_tr)) then + deallocate(hb_lumped_inv_tr) + end if + if (allocated(hb_lumped_inv_bdf2)) then + deallocate(hb_lumped_inv_bdf2) + end if + if (allocated(Helmholtz_operator_siqn)) then + deallocate(Helmholtz_operator_siqn) + end if + if (allocated(Helmholtz_operator_tr)) then + deallocate(Helmholtz_operator_tr) + end if + if (allocated(Helmholtz_operator_bdf2)) then + deallocate(Helmholtz_operator_bdf2) end if end subroutine final_si_operators @@ -360,109 +585,149 @@ contains !> @param[in] exner_ref Reference Exner pressure !> @param[in] model_clock Time in the model !> @param[in] moist_dyn_ref Bundle of reference moist dynamics factors - subroutine compute_si_operators(theta_ref, rho_ref, exner_ref, model_clock, moist_dyn_ref) - - use quadrature_xyoz_mod, only: quadrature_xyoz_type - use quadrature_face_mod, only: quadrature_face_type - use quadrature_rule_gaussian_mod, only: quadrature_rule_gaussian_type - use project_eos_operators_kernel_mod, only: project_eos_operators_kernel_type - use sample_eos_operators_kernel_mod, only: sample_eos_operators_kernel_type - use weighted_div_kernel_mod, only: weighted_div_kernel_type - use weighted_proj_2theta_kernel_mod, only: weighted_proj_2theta_kernel_type - use weighted_proj_theta2_kernel_mod, only: weighted_proj_theta2_kernel_type - use weighted_proj_2thetav_kernel_mod, only: weighted_proj_2thetav_kernel_type - use weighted_proj_theta2v_kernel_mod, only: weighted_proj_theta2v_kernel_type - use weighted_proj_theta2_vert_kernel_mod, only: weighted_proj_theta2_vert_kernel_type - use weighted_div_bd_kernel_mod, only: weighted_div_bd_kernel_type - use weighted_proj_2theta_bd_kernel_mod, only: weighted_proj_2theta_bd_kernel_type - use weighted_proj_theta2_bd_kernel_mod, only: weighted_proj_theta2_bd_kernel_type - use sci_compound_operator_kernel_mod, only: compound_operator_kernel_type - use mg_flux_kernel_mod, only: mg_flux_kernel_type - use sample_flux_kernel_mod, only: sample_flux_kernel_type - use fs_continuity_mod, only: W2 - use sci_geometric_constants_mod, only: get_coordinates, & - get_panel_id, & - get_height_fv - use sci_fem_constants_mod, only: get_rmultiplicity_fe - use dycore_constants_mod, only: get_w2_mass_matrix, & - w2_lagged_damping_layer_matrix - use solver_constants_mod, only: get_detj_at_w3_r_solver, & - get_im3_div_r_solver, & - get_normalisation_r_solver, & - get_inverse_mass_matrix_r_solver - use limited_area_constants_mod, only: get_mask_fv - use sci_invert_local_operator_kernel_mod, only: invert_local_operator_kernel_type - use field_indices_mod, only: igh_u, igh_t, igh_d, igh_p - use planet_config_mod, only: kappa, cp, rd, p_zero - use timestepping_config_mod, only: tau_r, tau_t, tau_u - use reference_element_mod, only: reference_element_type - use mesh_mod, only: mesh_type - use matrix_vector_kernel_mod, only: matrix_vector_kernel_type - use dg_inc_matrix_vector_kernel_mod, only: dg_inc_matrix_vector_kernel_type - use formulation_config_mod, only: dlayer_on, & - lagged_orog, & - dry_static_adjust - use sci_sort_ref_kernel_mod, only: sort_ref_kernel_type - use psykal_lite_mod, only: invoke_helmholtz_operator_kernel_type, & - invoke_elim_helmholtz_operator_kernel_type - use boundaries_config_mod, only: limited_area - use sample_eliminated_theta_q32_kernel_mod, & - only: sample_eliminated_theta_q32_kernel_type - use project_eliminated_theta_q32_kernel_mod, & - only: project_eliminated_theta_q32_kernel_type - use eliminated_theta_q22_kernel_mod, & - only: eliminated_theta_q22_kernel_type - use sci_sample_w3_to_wtheta_kernel_mod, & - only: sample_w3_to_wtheta_kernel_type - use fs_continuity_mod, only: W3, Wtheta - use sci_multiplicity_kernel_mod, only: multiplicity_kernel_type - use sample_field_kernel_mod, only: sample_field_kernel_type - use eliminated_theta_q2t_kernel_mod, only: eliminated_theta_q2t_kernel_type - use sci_restrict_scalar_unweighted_kernel_mod, & - only: restrict_scalar_unweighted_kernel_type - use sci_operator_algebra_kernel_mod, only: operator_setval_x_kernel_type - use model_clock_mod, only: model_clock_type + !> @param[in] stepper_name Enumerator for timestepper + subroutine compute_si_operators(theta_ref, rho_ref, exner_ref, model_clock, & + moist_dyn_ref, stepper_name) + + ! Infrastructure + use quadrature_xyoz_mod, only: quadrature_xyoz_type + use quadrature_face_mod, only: quadrature_face_type + use quadrature_rule_gaussian_mod, only: quadrature_rule_gaussian_type + use reference_element_mod, only: reference_element_type + + ! Config + use boundaries_config_mod, only: limited_area + use formulation_config_mod, only: dlayer_on, & + lagged_orog, & + dry_static_adjust + use planet_config_mod, only: kappa, cp, rd, p_zero + use timestepping_config_mod, only: tau_r, tau_t, tau_u + + ! Pointers to existing objects + use sci_geometric_constants_mod, only: get_coordinates, & + get_panel_id, & + get_height_fv + use sci_fem_constants_mod, only: get_rmultiplicity_fe + use dycore_constants_mod, only: get_w2_mass_matrix, & + w2_lagged_damping_layer_matrix + use limited_area_constants_mod, only: get_mask_fv + use solver_constants_mod, only: get_detj_at_w3_r_solver, & + get_im3_div_r_solver, & + get_normalisation_r_solver, & + get_inverse_mass_matrix_r_solver + + ! Core kernels + use matrix_vector_kernel_mod, only: matrix_vector_kernel_type + use dg_inc_matrix_vector_kernel_mod, only: dg_inc_matrix_vector_kernel_type + use sci_compound_operator_kernel_mod, only: compound_operator_kernel_type + use sci_invert_local_operator_kernel_mod, & + only: invert_local_operator_kernel_type + use sci_multiplicity_kernel_mod, only: multiplicity_kernel_type + use sci_operator_algebra_kernel_mod, only: operator_setval_x_kernel_type + use sci_restrict_scalar_unweighted_kernel_mod, & + only: restrict_scalar_unweighted_kernel_type + use sci_sample_w3_to_wtheta_kernel_mod, & + only: sample_w3_to_wtheta_kernel_type + use sci_sort_ref_kernel_mod, only: sort_ref_kernel_type + + ! Kernels + use eliminated_theta_q22_kernel_mod, only: eliminated_theta_q22_kernel_type + use eliminated_theta_q2t_kernel_mod, only: eliminated_theta_q2t_kernel_type + use mg_flux_kernel_mod, only: mg_flux_kernel_type + use project_eliminated_theta_q32_kernel_mod, & + only: project_eliminated_theta_q32_kernel_type + use project_eos_operators_kernel_mod, only: project_eos_operators_kernel_type + use sample_eliminated_theta_q32_kernel_mod, & + only: sample_eliminated_theta_q32_kernel_type + use sample_eos_operators_kernel_mod, only: sample_eos_operators_kernel_type + use sample_field_kernel_mod, only: sample_field_kernel_type + use sample_flux_kernel_mod, only: sample_flux_kernel_type + use weighted_div_bd_kernel_mod, only: weighted_div_bd_kernel_type + use weighted_div_kernel_mod, only: weighted_div_kernel_type + + use weighted_proj_2thetav_kernel_mod, only: weighted_proj_2thetav_kernel_type + use weighted_proj_2theta_kernel_mod, only: weighted_proj_2theta_kernel_type + use weighted_proj_2theta_bd_kernel_mod, & + only: weighted_proj_2theta_bd_kernel_type + use weighted_proj_theta2v_kernel_mod, only: weighted_proj_theta2v_kernel_type + use weighted_proj_theta2_kernel_mod, only: weighted_proj_theta2_kernel_type + use weighted_proj_theta2_vert_kernel_mod, & + only: weighted_proj_theta2_vert_kernel_type + use weighted_proj_theta2_bd_kernel_mod, & + only: weighted_proj_theta2_bd_kernel_type + + ! Apps Infrastructure + use field_indices_mod, only: igh_u, igh_t, igh_d, igh_p + use moist_dyn_mod, only: num_moist_factors, gas_law, & + total_mass + + ! Psykal-lite + use psykal_lite_mod, only: invoke_helmholtz_operator_kernel_type, & + invoke_elim_helmholtz_operator_kernel_type implicit none - type(field_type), intent(in) :: theta_ref, rho_ref, exner_ref - type(field_type), intent(in) :: moist_dyn_ref(num_moist_factors) - class(model_clock_type), intent(in) :: model_clock + ! Arguments + type(field_type), intent(in) :: theta_ref, rho_ref, exner_ref + type(field_type), intent(in) :: moist_dyn_ref(num_moist_factors) + class(model_clock_type), intent(in) :: model_clock + integer(kind=i_def), intent(in) :: stepper_name + + ! Local variables + ! Pointers to SI operators to compute + type(r_solver_operator_type), pointer :: m3_rho_star(:) + type(r_solver_operator_type), pointer :: m3_exner_star(:) + type(r_solver_operator_type), pointer :: div_star(:) + type(r_solver_operator_type), pointer :: p2theta(:) + type(r_solver_operator_type), pointer :: ptheta2(:) + type(r_solver_operator_type), pointer :: ptheta2v(:) + type(r_solver_operator_type), pointer :: p3theta(:) + type(r_solver_operator_type), pointer :: compound_div(:) + type(r_solver_operator_type), pointer :: eliminated_q22(:) + type(r_solver_operator_type), pointer :: eliminated_q32(:) + type(r_solver_operator_type), pointer :: eliminated_q2t + type(r_solver_field_type), pointer :: tri_precon(:,:) + type(r_solver_field_type), pointer :: Helmholtz_operator(:,:) + type(r_solver_field_type), pointer :: helm_diag(:) + type(r_solver_field_type), pointer :: Hb_lumped_inv(:) + ! Pointers to existing objects + type(r_solver_operator_type), pointer :: m3_inv + type(r_solver_operator_type), pointer :: div + type(field_type), pointer :: chi(:) + type(field_type), pointer :: panel_id + type(field_type), pointer :: w2_rmultiplicity + type(operator_type), pointer :: m2 + type(r_solver_field_type), pointer :: u_normalisation + type(r_solver_field_type), pointer :: t_normalisation + type(r_solver_field_type), pointer :: detj_at_w3 + type(field_type), pointer :: height_w3 + type(field_type), pointer :: height_wt + type(field_type), pointer :: w2_mask + ! Other local variables + type(function_space_type), pointer :: w3_fs + type(function_space_type), pointer :: w2_fs + type(function_space_type), pointer :: wt_fs + class(reference_element_type), pointer :: reference_element + type(mesh_type), pointer :: mesh real(kind=r_def) :: dt type(quadrature_xyoz_type) :: qr type(quadrature_face_type) :: qrf type(quadrature_rule_gaussian_type) :: quadrature_rule - type(field_type), pointer :: chi(:) => null() - type(field_type), pointer :: panel_id => null() - type(r_solver_operator_type), pointer :: m3_inv => null(), div => null() type(r_solver_field_type) :: ones - type(field_type), pointer :: w2_rmultiplicity => null() - type(function_space_type), pointer :: w3_fs => null() - type(function_space_type), pointer :: w2_fs => null() - type(function_space_type), pointer :: wt_fs => null() real(kind=r_solver) :: const1, const2, const3 + real(kind=r_solver) :: gamma, gamma2 integer(kind=i_def), parameter :: imone = -1_i_def - class(reference_element_type), pointer :: reference_element =>null() - type(mesh_type), pointer :: mesh => null() - type(operator_type), pointer :: m2 => null() - type(r_solver_field_type), pointer :: u_normalisation => null(), & - t_normalisation => null() type(r_solver_field_type) :: m2_u, theta_adv_term - integer(kind=i_def) :: level, i + integer(kind=i_def) :: level, i, mesh_id type(r_solver_field_type) :: rsol_w2_mask - type(field_type), pointer :: w2_mask => null() - type(field_type), pointer :: height_w3 => null() - type(field_type), pointer :: height_wt => null() type(r_solver_field_type) :: multiplicity - - type(r_solver_field_type) :: exner, & - exner_in_wth, & - rho, & - theta, & - coarse_field + type(r_solver_field_type) :: exner + type(r_solver_field_type) :: exner_in_wth + type(r_solver_field_type) :: rho + type(r_solver_field_type) :: theta + type(r_solver_field_type) :: coarse_field type(r_solver_field_type) :: rsol_w2_rmultiplicity type(r_solver_operator_type) :: m2_r_solver - type(r_solver_field_type), pointer :: detj_at_w3 => null() type(field_type) :: moist_dyn_factor_rdef type(r_solver_field_type) :: moist_dyn_factor, theta_v @@ -478,514 +743,938 @@ contains dt = real(model_clock%get_seconds_per_step(), r_def) mesh => exner_ref%get_mesh() - w3_fs => exner_ref%get_function_space() - w2_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W2 ) wt_fs => theta_ref%get_function_space() - + w2_fs => function_space_collection%get_fs( & + mesh, element_order_h, element_order_v, W2 & + ) + reference_element => mesh%get_reference_element() + qrf = quadrature_face_type( & + element_order_h+2, element_order_v+2, .true., .false., & + reference_element, quadrature_rule & + ) + qr = quadrature_xyoz_type( & + nqp_h_exact, nqp_h_exact, nqp_v_exact, quadrature_rule & + ) + + ! ------------------------------------------------------------------------ ! + ! Set pointers to SI operators to compute + ! ------------------------------------------------------------------------ ! + select case ( stepper_name ) + case ( stepper_siqn ) + m3_rho_star => m3_rho_star_siqn + m3_exner_star => m3_exner_star_siqn + div_star => div_star_siqn + p2theta => p2theta_siqn + ptheta2 => ptheta2_siqn + ptheta2v => ptheta2v_siqn + p3theta => p3theta_siqn + compound_div => compound_div_siqn + eliminated_q22 => eliminated_q22_siqn + eliminated_q32 => eliminated_q32_siqn + eliminated_q2t => eliminated_q2t_siqn + tri_precon => tri_precon_siqn + Helmholtz_operator => Helmholtz_operator_siqn + helm_diag => helm_diag_siqn + Hb_lumped_inv => Hb_lumped_inv_siqn + + case ( stepper_tr ) + m3_rho_star => m3_rho_star_tr + m3_exner_star => m3_exner_star_tr + div_star => div_star_tr + p2theta => p2theta_tr + ptheta2 => ptheta2_tr + ptheta2v => ptheta2v_tr + p3theta => p3theta_tr + compound_div => compound_div_tr + eliminated_q22 => eliminated_q22_tr + eliminated_q32 => eliminated_q32_tr + eliminated_q2t => eliminated_q2t_tr + tri_precon => tri_precon_tr + Helmholtz_operator => Helmholtz_operator_tr + helm_diag => helm_diag_tr + Hb_lumped_inv => Hb_lumped_inv_tr + + case ( stepper_bdf2 ) + m3_rho_star => m3_rho_star_bdf2 + m3_exner_star => m3_exner_star_bdf2 + div_star => div_star_bdf2 + p2theta => p2theta_bdf2 + ptheta2 => ptheta2_bdf2 + ptheta2v => ptheta2v_bdf2 + p3theta => p3theta_bdf2 + compound_div => compound_div_bdf2 + eliminated_q22 => eliminated_q22_bdf2 + eliminated_q32 => eliminated_q32_bdf2 + eliminated_q2t => eliminated_q2t_bdf2 + tri_precon => tri_precon_bdf2 + Helmholtz_operator => Helmholtz_operator_bdf2 + helm_diag => helm_diag_bdf2 + Hb_lumped_inv => Hb_lumped_inv_bdf2 + end select + + ! ------------------------------------------------------------------------ ! ! Create reference state (as r_solver fields) - call exner%initialise( w3_fs, halo_depth = req_halo_depth ) - call rho%initialise( w3_fs, halo_depth = req_halo_depth ) - call theta%initialise( wt_fs, halo_depth = req_halo_depth ) + ! ------------------------------------------------------------------------ ! + call exner%initialise( w3_fs, halo_depth=req_halo_depth) + call rho%initialise(w3_fs, halo_depth=req_halo_depth) + call theta%initialise(wt_fs, halo_depth=req_halo_depth) call copy_field(exner_ref, exner) call copy_field(rho_ref, rho) call copy_field(theta_ref, theta) - if (dry_static_adjust) & + + if (dry_static_adjust) then call invoke( sort_ref_kernel_type(theta) ) + end if + ! ------------------------------------------------------------------------ ! ! Compute moist dynamics factor + ! ------------------------------------------------------------------------ ! ! For momentum equation, need theta_v = theta * (1 + mv/eps) / (1 + sum{mr}) - call moist_dyn_factor%initialise( wt_fs ) + call moist_dyn_factor%initialise(wt_fs) if (moisture_in_solver) then - call moist_dyn_factor_rdef%initialise( wt_fs ) - call invoke( X_divideby_Y(moist_dyn_factor_rdef, moist_dyn_ref(gas_law), moist_dyn_ref(total_mass)) ) + call moist_dyn_factor_rdef%initialise(wt_fs) + call invoke( & + X_divideby_Y( & + moist_dyn_factor_rdef, moist_dyn_ref(gas_law), & + moist_dyn_ref(total_mass) & + ) & + ) call copy_field(moist_dyn_factor_rdef, moist_dyn_factor) else ! Set factor to 1 and everything else will be unchanged call invoke( setval_c(moist_dyn_factor, 1.0_r_solver) ) end if + ! ------------------------------------------------------------------------ ! + ! Loop through multigrid levels to compute operators + ! ------------------------------------------------------------------------ ! + ! Set the function space chains to the finest levels. if (l_multigrid) then - call multigrid_function_space_chain%set_current(w3_fs%get_id()) - call w2_multigrid_function_space_chain%set_current(w2_fs%get_id()) - call wtheta_multigrid_function_space_chain%set_current(wt_fs%get_id()) + call multigrid_function_space_chain%set_current(w3_fs%get_id()) + call w2_multigrid_function_space_chain%set_current(w2_fs%get_id()) + call wtheta_multigrid_function_space_chain%set_current(wt_fs%get_id()) end if - ! quadrature rules set once outside MG loop - reference_element => mesh%get_reference_element() - qrf = quadrature_face_type(element_order_h+2, element_order_v+2, & - .true., .false., & - reference_element, quadrature_rule) - qr = quadrature_xyoz_type(nqp_h_exact, nqp_h_exact, nqp_v_exact, & - quadrature_rule) - do level = 1, multigrid_levels - write(log_scratch_space,'(A,I0)') "si_ops: mg level=",level - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) - - mesh => rho_at_u(level)%get_mesh() - chi => get_coordinates( mesh%get_id() ) - panel_id => get_panel_id( mesh%get_id() ) - - u_normalisation => get_normalisation_r_solver(W2, mesh%get_id()) - - ! Set reference theta_v, by multiply theta by moisture factor - call theta_v%initialise( vector_space = theta%get_function_space(), & - halo_depth = req_halo_depth ) - call invoke( X_times_Y(theta_v, theta, moist_dyn_factor) ) - - ! Non-topological operators - call exner_in_wth%initialise( vector_space = theta%get_function_space() ) - if ( element_order_h == 0 .and. element_order_v == 0) then - height_w3 => get_height_fv(W3, mesh%get_id()) - height_wt => get_height_fv(Wtheta, mesh%get_id()) - call invoke( sample_w3_to_wtheta_kernel_type(exner_in_wth, exner, & - height_wt, height_w3 ) ) - nullify(height_w3, height_wt) - else - call multiplicity%initialise( vector_space = theta%get_function_space() ) - call invoke( setval_c(multiplicity, 0.0_r_solver), & - multiplicity_kernel_type(multiplicity), & - setval_c(exner_in_wth, 0.0_r_solver), & - sample_field_kernel_type(exner_in_wth, multiplicity, exner) ) - end if - - m3_inv => get_inverse_mass_matrix_r_solver( W3, mesh%get_id() ) - const1 = real(tau_t*tau_u*dt**2*cp, r_solver) - select case(eos_method) - case(eos_method_sampled) - call invoke( sample_eos_operators_kernel_type(m3_exner_star(level), m3_rho_star(level), & - p3theta(level), exner, rho, theta, kappa, rd, p_zero) ) - case(eos_method_projected) - call invoke( project_eos_operators_kernel_type(m3_exner_star(level), m3_rho_star(level), & - p3theta(level), m3_inv, & - exner, rho, theta, chi, panel_id, kappa, rd, p_zero, qr) ) - case default - call log_event( "Gungho: Unrecognised method used for equation of state", LOG_LEVEL_ERROR ) - end select - - if ( eliminate_variables == eliminate_variables_analytic ) then - call invoke( eliminated_theta_q22_kernel_type(eliminated_q22(level), theta, & - exner_in_wth, u_normalisation, & - chi, panel_id, const1, qr) ) - end if - - ! Compute rho^ref at u nodal points - if (l_multigrid) then - ! rmultiplicity is a half at lowest order, at higher order, MG has to do - ! something different anyway - call invoke(setval_c(rho_at_u(level), 0.0_r_solver), & - mg_flux_kernel_type(rho_at_u(level), rho) ) - else - ! for non MG, at higher order, need computed rmultiplicity - call ones%initialise( vector_space = w2_fs ) - w2_rmultiplicity => get_rmultiplicity_fe( W2, mesh%get_id() ) - call rsol_w2_rmultiplicity%initialise( w2_fs ) - call copy_field(w2_rmultiplicity, rsol_w2_rmultiplicity) - call invoke( setval_c(ones, 1.0_r_solver), & - setval_c(rho_at_u(level), 0.0_r_solver), & - sample_flux_kernel_type(rho_at_u(level), ones, & - rsol_w2_rmultiplicity, & - rho) ) - end if - - ! The rest of the operators are topological and so do not need as high - ! quadrature order - qr = quadrature_xyoz_type(element_order_h+2, element_order_h+2, & - element_order_v+2, quadrature_rule) - - ! Cell kernels - const1 = real(tau_u*dt*cp, r_solver) - const2 = real(tau_t*dt, r_solver) - const3 = real(tau_r*dt, r_solver) - div => get_im3_div_r_solver(mesh%get_id()) - - if ( p2theta_vert ) then - ! The projection operators are restricted to use the vertical only - call invoke( weighted_proj_2thetav_kernel_type(p2theta(level), exner, & - moist_dyn_factor, & - const1, & - element_order_h, & - element_order_v, qr), & - weighted_proj_theta2v_kernel_type(ptheta2(level), theta, & - const2, & - element_order_h, & - element_order_v, qr) ) - else - ! The projection operators use horizonal and vertical - call invoke( weighted_proj_2theta_kernel_type(p2theta(level), exner, & - moist_dyn_factor, const1, qr), & - weighted_proj_theta2_kernel_type(ptheta2(level), theta, const2, qr), & - weighted_proj_theta2_bd_kernel_type(ptheta2(level), theta, & - req_stencil_depth, const2, qrf), & - weighted_proj_2theta_bd_kernel_type(p2theta(level), exner, & - req_stencil_depth, & - moist_dyn_factor, const1, qrf) ) - end if - call invoke( name = "cell_and_boundary_kernels_vert", & - weighted_div_kernel_type(div_star(level), theta_v, const1, qr), & - weighted_proj_theta2_vert_kernel_type(ptheta2v(level), theta, & - const2, element_order_h, & - element_order_v, qr), & + write(log_scratch_space,'(A,I0)') "si_ops: mg level=", level + call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + + mesh => rho_at_u(level)%get_mesh() + mesh_id = mesh%get_id() + chi => get_coordinates(mesh_id) + panel_id => get_panel_id(mesh_id) + + u_normalisation => get_normalisation_r_solver(W2, mesh_id) + + ! Set reference theta_v, by multiply theta by moisture factor + call theta_v%initialise(wt_fs, halo_depth=req_halo_depth) + call invoke( X_times_Y(theta_v, theta, moist_dyn_factor) ) + + ! Compute exner at theta points ------------------------------------------ + call exner_in_wth%initialise(wt_fs) + if (element_order_h == 0 .and. element_order_v == 0) then + height_w3 => get_height_fv(W3, mesh_id) + height_wt => get_height_fv(Wtheta, mesh_id) + call invoke( & + sample_w3_to_wtheta_kernel_type( & + exner_in_wth, exner, height_wt, height_w3 & + ) & + ) + else + call multiplicity%initialise(wt_fs) + call invoke( & + setval_c(multiplicity, 0.0_r_solver), & + multiplicity_kernel_type(multiplicity), & + setval_c(exner_in_wth, 0.0_r_solver), & + sample_field_kernel_type(exner_in_wth, multiplicity, exner) & + ) + end if + + ! Compute M3 Exner star operator ----------------------------------------- + select case (stepper_name) + case (stepper_siqn) + const1 = real(tau_t*tau_u*dt**2*cp, r_solver) + case (stepper_tr) + ! tau_u = gamma, tau_t = 2*gamma + gamma = 1.0_r_solver - 0.5_r_solver*SQRT(2.0_r_solver) + const1 = 2.0_r_solver*gamma**2*real(dt**2*cp, r_solver) + case (stepper_bdf2) + ! tau_u = gamma2, tau_t = 1 + gamma = 1.0_r_solver - 0.5_r_solver*SQRT(2.0_r_solver) + gamma2 = 0.5_r_solver*(1.0_r_solver - 2.0_r_solver*gamma)/(1.0_r_solver - gamma) + const1 = gamma2*real(dt**2*cp, r_solver) + end select + + m3_inv => get_inverse_mass_matrix_r_solver(W3, mesh_id) + + select case(eos_method) + case (eos_method_sampled) + call invoke( & + sample_eos_operators_kernel_type( & + m3_exner_star(level), m3_rho_star(level), p3theta(level), & + exner, rho, theta, kappa, rd, p_zero & + ) & + ) + case (eos_method_projected) + call invoke( & + project_eos_operators_kernel_type( & + m3_exner_star(level), m3_rho_star(level), p3theta(level), & + m3_inv, exner, rho, theta, chi, panel_id, kappa, rd, p_zero, & + qr & + ) & + ) + case default + call log_event( & + "Gungho: Unrecognised method used for equation of state", & + LOG_LEVEL_ERROR & + ) + end select + + ! Compute eliminated_theta_q22 operator (if needed) ---------------------- + if (eliminate_variables == eliminate_variables_analytic) then + call invoke( & + eliminated_theta_q22_kernel_type( & + eliminated_q22(level), theta, exner_in_wth, u_normalisation, & + chi, panel_id, const1, qr & + ) & + ) + end if + + ! Compute rho^ref at u nodal points -------------------------------------- + if (l_multigrid) then + ! rmultiplicity is a half at lowest order, at higher order, MG has to do + ! something different anyway + call invoke( & + setval_c(rho_at_u(level), 0.0_r_solver), & + mg_flux_kernel_type(rho_at_u(level), rho) & + ) + else + ! for non MG, at higher order, need computed rmultiplicity + call ones%initialise(w2_fs) + w2_rmultiplicity => get_rmultiplicity_fe( W2, mesh_id ) + call rsol_w2_rmultiplicity%initialise(w2_fs) + call copy_field(w2_rmultiplicity, rsol_w2_rmultiplicity) + call invoke( & + setval_c(ones, 1.0_r_solver), & + setval_c(rho_at_u(level), 0.0_r_solver), & + sample_flux_kernel_type( & + rho_at_u(level), ones, rsol_w2_rmultiplicity, rho & + ) & + ) + end if + + ! The rest of the operators are topological and so do not need as high + ! quadrature order + qr = quadrature_xyoz_type( & + element_order_h+2, element_order_h+2, element_order_v+2, & + quadrature_rule & + ) + + select case (stepper_name) + case (stepper_siqn) + const1 = real(tau_u*dt*cp, r_solver) + const2 = real(tau_t*dt, r_solver) + const3 = real(tau_r*dt, r_solver) + case (stepper_tr) + ! tau_u = gamma, tau_t = tau_r = 2*gamma + const1 = gamma*real(dt*cp, r_solver) + const2 = 2.0_r_solver*gamma*real(dt, r_solver) + const3 = 2.0_r_solver*gamma*real(dt, r_solver) + case (stepper_bdf2) + ! tau_u = gamma2, tau_t = tau_r = 1 + const1 = gamma2*real(dt*cp, r_solver) + const2 = real(dt, r_solver) + const3 = real(dt, r_solver) + end select + + ! Cell kernels + div => get_im3_div_r_solver(mesh_id) + + ! Projection operators between W2 and Wtheta ----------------------------- + if (p2theta_vert) then + ! The projection operators are restricted to use the vertical only + call invoke( & + weighted_proj_2thetav_kernel_type( & + p2theta(level), exner, moist_dyn_factor, const1, & + element_order_h, element_order_v, qr & + ), & + weighted_proj_theta2v_kernel_type( & + ptheta2(level), theta, const2, element_order_h, & + element_order_v, qr & + ) & + ) + else + ! The projection operators use horizonal and vertical + call invoke( & + weighted_proj_2theta_kernel_type( & + p2theta(level), exner, moist_dyn_factor, const1, qr & + ), & + weighted_proj_theta2_kernel_type( & + ptheta2(level), theta, const2, qr & + ), & + weighted_proj_theta2_bd_kernel_type( & + ptheta2(level), theta, req_stencil_depth, const2, qrf & + ), & + weighted_proj_2theta_bd_kernel_type( & + p2theta(level), exner, req_stencil_depth, moist_dyn_factor, & + const1, qrf & + ) & + ) + end if + + ! Boundary kernels ------------------------------------------------------- + ! div_star, ptheta2v, compound_div, eliminated_q32 operators + call invoke( & + name = "cell_and_boundary_kernels_vert", & + weighted_div_kernel_type(div_star(level), theta_v, const1, qr), & + weighted_proj_theta2_vert_kernel_type( & + ptheta2v(level), theta, const2, element_order_h, & + element_order_v, qr & + ), & ! Boundary kernels - weighted_div_bd_kernel_type(div_star(level), theta_v, req_stencil_depth, & - const1, qrf), & + weighted_div_bd_kernel_type( & + div_star(level), theta_v, req_stencil_depth, const1, qrf & + ), & ! Compound operators - compound_operator_kernel_type( compound_div(level), m3_rho_star(level), & - div, rho_at_u(level), const3), & - operator_setval_x_kernel_type( eliminated_q32(level), compound_div(level) ) ) - - if ( level == 1 .and. eliminate_variables == eliminate_variables_analytic ) then - call invoke( eliminated_theta_q2t_kernel_type(eliminated_q2t, u_normalisation, & - exner_in_wth, const1, qr) ) - end if - - if ( eliminate_variables == eliminate_variables_analytic ) then - ! Add on contribution to q32 from eliminating theta - select case(eos_method) - case(eos_method_sampled) - detj_at_w3 => get_detj_at_w3_r_solver( mesh%get_id() ) - call invoke( sample_eliminated_theta_q32_kernel_type(eliminated_q32(level), theta, detj_at_w3 , & - const2) ) - case(eos_method_projected) - call invoke( project_eliminated_theta_q32_kernel_type(eliminated_q32(level), theta, & - m3_inv, const2, qr ) ) - case default - call log_event( "Gungho: Unrecognised method used for equation of state", LOG_LEVEL_ERROR ) - end select - end if - - ! Compute Hb_lumped_inv field - ! mass matrix should include damping layer and lagged-orography terms - ! if these options are not true, this matrix won't contain the terms - m2 => get_w2_mass_matrix( & - w2_lagged_damping_layer_matrix, mesh%get_id(), model_clock & + compound_operator_kernel_type( & + compound_div(level), m3_rho_star(level), div, rho_at_u(level), & + const3 & + ), & + operator_setval_x_kernel_type( & + eliminated_q32(level), compound_div(level) & + ) & ) - call m2_r_solver%initialise( w2_fs, w2_fs ) - call invoke( operator_setval_x_kernel_type( m2_r_solver, m2 ) ) - u_normalisation => get_normalisation_r_solver(W2, mesh%get_id()) - t_normalisation => get_normalisation_r_solver(Wtheta, mesh%get_id()) - - call m2_u%initialise( vector_space = w2_fs ) - call ones%initialise( vector_space = w2_fs ) - if ( eliminate_variables == eliminate_variables_analytic ) then - ! H_B = (Nu * Mu - Q22) * ones - call invoke( name = "compute_analytic_lumped_inverse_h_b_operator", & - setval_c(ones, 1.0_r_solver), & - setval_c(Hb_lumped_inv(level), 0.0_r_solver), & - setval_c(m2_u, 0.0_r_solver), & - matrix_vector_kernel_type(Hb_lumped_inv(level), ones, m2_r_solver), & - inc_X_times_Y(Hb_lumped_inv(level), u_normalisation), & - matrix_vector_kernel_type(m2_u, ones, eliminated_q22(level)), & - inc_X_minus_Y(Hb_lumped_inv(level), m2_u), & - inc_X_powint_n(Hb_lumped_inv(level), imone) ) - - else - ! H_B = Nu * ( Mu + P2t * Mt^-1 * Pt2v ) * ones - call theta_adv_term%initialise( vector_space = wt_fs ) - call invoke( name = "compute_lumped_inverse_h_b_operator", & - setval_c(ones, 1.0_r_solver), & - setval_c(Hb_lumped_inv(level), 0.0_r_solver), & - setval_c(theta_adv_term, 0.0_r_solver), & - dg_inc_matrix_vector_kernel_type( & - theta_adv_term, ones, ptheta2v(level)), & - inc_X_times_Y(theta_adv_term, t_normalisation), & - matrix_vector_kernel_type( & - Hb_lumped_inv(level), theta_adv_term, & - p2theta(level) ), & - matrix_vector_kernel_type(Hb_lumped_inv(level), ones, & - m2_r_solver), & - inc_X_times_Y(Hb_lumped_inv(level), u_normalisation), & - inc_X_powint_n(Hb_lumped_inv(level), imone) ) - end if - - ! Compute the Helmholtz operator - if ( element_order_h == 0 .and. element_order_v == 0 ) then - call rsol_w2_mask%initialise( vector_space = w2_fs ) - if ( limited_area ) then - w2_mask => get_mask_fv(W2, mesh%get_id(), prime_mesh_name) - call copy_field(w2_mask, rsol_w2_mask) - else - ! Create dummy mask arrays with 1 in every entry - call invoke( setval_c(rsol_w2_mask, 1.0_r_solver) ) - end if - if ( eliminate_variables == eliminate_variables_analytic ) then - call invoke_elim_helmholtz_operator_kernel_type( & - Helmholtz_operator(:,level), & - Hb_lumped_inv(level), & - req_stencil_depth, & - u_normalisation, & - div_star(level), & - m3_exner_star(level), & - eliminated_q32(level), & - rsol_w2_mask) - - else - call invoke_helmholtz_operator_kernel_type( Helmholtz_operator(:,level), & - Hb_lumped_inv(level), & - req_stencil_depth, & - u_normalisation, & - div_star(level), & - t_normalisation, & - ptheta2v(level), & - compound_div(level), & - m3_exner_star(level), & - p3theta(level), & - rsol_w2_mask) - end if - end if - - ! Compute terms for tridiagonal preconditioner - if ( preconditioner == preconditioner_tridiagonal .or. & - preconditioner == preconditioner_multigrid ) then - ! Build using the FEM helmholtz operator, only valid for lowest order - if ( element_order_h == 0 .and. element_order_v == 0 ) then - call invoke(setval_X( tri_precon(tridiagonal_k,level), & - Helmholtz_operator(helmholtz_k,level)), & - X_plus_Y( tri_precon(tridiagonal_kp1,level), & - Helmholtz_operator(helmholtz_kp1,level), & - Helmholtz_operator(helmholtz_kp2,level)), & - X_plus_Y( tri_precon(tridiagonal_km1,level), & - Helmholtz_operator(helmholtz_km1,level), & - Helmholtz_operator(helmholtz_km2,level)) ) - else - call log_event( "Gungho: tridiagonal preconditioner invalid for element orders > 0", LOG_LEVEL_ERROR ) - end if - end if - if ( normalise .and. & - preconditioner == preconditioner_tridiagonal ) then - call Helmholtz_operator(helmholtz_k,level)%copy_field_properties(Helm_diag(level)) - call invoke( setval_X( Helm_diag(level), Helmholtz_operator(helmholtz_k,level)), & - inc_X_powint_n(Helm_diag(level), imone) ) - do i = 1,helmholtz_stencil_size - call invoke(inc_X_times_Y(Helmholtz_operator(i,level), Helm_diag(level)) ) - end do - do i = 1,3 - call invoke(inc_X_times_Y(tri_precon(i,level), Helm_diag(level)) ) - end do - else - call invoke( setval_c(Helm_diag(level), 1.0_r_solver) ) - end if - - ! Restrict the fields for the next level, provided not last time round - ! the loop - if (level < multigrid_levels) then - ! should not get here if no multigrid, but just in case - if (l_multigrid) then - - write(log_scratch_space,'(A,I0,A,I0)') & - "si_ops:MG restrict L",level," to L",level+1 - call log_event(log_scratch_space,LOG_LEVEL_DEBUG) - - ! copy current field to coarse field - call theta%copy_field_properties(coarse_field) - call invoke( setval_X(coarse_field, theta) ) - ! set the fs to the next (fine) - wt_fs=>wtheta_multigrid_function_space_chain%get_next() - call theta%initialise(vector_space = wt_fs, halo_depth=req_halo_depth ) - ! call restrict - call invoke( restrict_scalar_unweighted_kernel_type(theta, coarse_field) ) - - ! copy current field to coarse field - call moist_dyn_factor%copy_field_properties(coarse_field) - call invoke( setval_X(coarse_field, moist_dyn_factor) ) - call moist_dyn_factor%initialise(vector_space = wt_fs) - ! call restrict - call invoke( restrict_scalar_unweighted_kernel_type(moist_dyn_factor, coarse_field) ) - - ! copy current field to coarse field - call rho%copy_field_properties(coarse_field) - call invoke( setval_X(coarse_field, rho) ) - ! set the fs to the next (fine) - w3_fs=>multigrid_function_space_chain%get_next() - call rho%initialise(vector_space = w3_fs, halo_depth=req_halo_depth ) - ! call restrict - call invoke( restrict_scalar_unweighted_kernel_type(rho, coarse_field) ) - - ! copy current field to coarse field - call exner%copy_field_properties(coarse_field) - call invoke( setval_X(coarse_field, exner) ) - ! fs already set fine - call exner%initialise(vector_space = w3_fs , halo_depth=req_halo_depth) - ! call restrict - call invoke( restrict_scalar_unweighted_kernel_type(exner, coarse_field) ) - ! set w2_fs to next in chain - w2_fs=>w2_multigrid_function_space_chain%get_next() - end if - end if + ! Compute eliminated_theta_q2t operator (if needed) ---------------------- + if (level == 1 .and. eliminate_variables == eliminate_variables_analytic) then + call invoke( & + eliminated_theta_q2t_kernel_type( & + eliminated_q2t, u_normalisation, exner_in_wth, const1, qr & + ) & + ) + end if - end do ! end of multigrid levels loop + ! Compute eliminated_q32 operator (if needed) ---------------------------- + if (eliminate_variables == eliminate_variables_analytic) then + ! Add on contribution to q32 from eliminating theta + select case(eos_method) + case(eos_method_sampled) + detj_at_w3 => get_detj_at_w3_r_solver(mesh_id) + call invoke( & + sample_eliminated_theta_q32_kernel_type( & + eliminated_q32(level), theta, detj_at_w3, const2 & + ) & + ) + case(eos_method_projected) + call invoke( & + project_eliminated_theta_q32_kernel_type( & + eliminated_q32(level), theta, m3_inv, const2, qr & + ) & + ) + case default + call log_event( & + "Gungho: Unrecognised method used for equation of state", & + LOG_LEVEL_ERROR & + ) + end select + end if + + ! Compute Hb_lumped_inv field -------------------------------------------- + ! mass matrix should include damping layer and lagged-orography terms + ! if these options are not true, this matrix won't contain the terms + m2 => get_w2_mass_matrix( & + w2_lagged_damping_layer_matrix, stepper_name, mesh_id, model_clock & + ) + + call m2_r_solver%initialise(w2_fs, w2_fs) + call invoke( operator_setval_x_kernel_type(m2_r_solver, m2) ) + u_normalisation => get_normalisation_r_solver(W2, mesh_id) + t_normalisation => get_normalisation_r_solver(Wtheta, mesh_id) + + call m2_u%initialise(w2_fs) + call ones%initialise(w2_fs) + if (eliminate_variables == eliminate_variables_analytic) then + ! H_B = (Nu * Mu - Q22) * ones + call invoke( & + name="compute_analytic_lumped_inverse_h_b_operator", & + setval_c(ones, 1.0_r_solver), & + setval_c(Hb_lumped_inv(level), 0.0_r_solver), & + setval_c(m2_u, 0.0_r_solver), & + matrix_vector_kernel_type( & + Hb_lumped_inv(level), ones, m2_r_solver & + ), & + inc_X_times_Y(Hb_lumped_inv(level), u_normalisation), & + matrix_vector_kernel_type(m2_u, ones, eliminated_q22(level)), & + inc_X_minus_Y(Hb_lumped_inv(level), m2_u), & + inc_X_powint_n(Hb_lumped_inv(level), imone) & + ) + else + ! H_B = Nu * ( Mu + P2t * Mt^-1 * Pt2v ) * ones + call theta_adv_term%initialise(wt_fs) + call invoke( & + name="compute_lumped_inverse_h_b_operator", & + setval_c(ones, 1.0_r_solver), & + setval_c(Hb_lumped_inv(level), 0.0_r_solver), & + setval_c(theta_adv_term, 0.0_r_solver), & + dg_inc_matrix_vector_kernel_type( & + theta_adv_term, ones, ptheta2v(level) & + ), & + inc_X_times_Y(theta_adv_term, t_normalisation), & + matrix_vector_kernel_type( & + Hb_lumped_inv(level), theta_adv_term, p2theta(level) & + ), & + matrix_vector_kernel_type( & + Hb_lumped_inv(level), ones, m2_r_solver & + ), & + inc_X_times_Y(Hb_lumped_inv(level), u_normalisation), & + inc_X_powint_n(Hb_lumped_inv(level), imone) & + ) + end if + + ! Compute the Helmholtz operator ----------------------------------------- + if (element_order_h == 0 .and. element_order_v == 0) then + ! Set mask for limited or non-limited area + call rsol_w2_mask%initialise(w2_fs) + if (limited_area) then + w2_mask => get_mask_fv(W2, mesh_id, prime_mesh_name) + call copy_field(w2_mask, rsol_w2_mask) + else + ! Create dummy mask arrays with 1 in every entry + call invoke( setval_c(rsol_w2_mask, 1.0_r_solver) ) + end if + + if ( eliminate_variables == eliminate_variables_analytic ) then + call invoke_elim_helmholtz_operator_kernel_type( & + Helmholtz_operator(:,level), Hb_lumped_inv(level), & + req_stencil_depth, u_normalisation, div_star(level), & + m3_exner_star(level), eliminated_q32(level), rsol_w2_mask & + ) + else + call invoke_helmholtz_operator_kernel_type( & + Helmholtz_operator(:,level), Hb_lumped_inv(level), & + req_stencil_depth, u_normalisation, div_star(level), & + t_normalisation, ptheta2v(level), compound_div(level), & + m3_exner_star(level), p3theta(level), rsol_w2_mask & + ) + end if + end if + + ! Compute terms for tridiagonal preconditioner --------------------------- + if (preconditioner == preconditioner_tridiagonal .or. & + preconditioner == preconditioner_multigrid) then + ! Build using the FEM helmholtz operator, only valid for lowest order + if (element_order_h == 0 .and. element_order_v == 0) then + call invoke( & + setval_X( & + tri_precon(tridiagonal_k,level), & + Helmholtz_operator(helmholtz_k,level) & + ), & + X_plus_Y( & + tri_precon(tridiagonal_kp1,level), & + Helmholtz_operator(helmholtz_kp1,level), & + Helmholtz_operator(helmholtz_kp2,level) & + ), & + X_plus_Y( & + tri_precon(tridiagonal_km1,level), & + Helmholtz_operator(helmholtz_km1,level), & + Helmholtz_operator(helmholtz_km2,level) & + ) & + ) + else + call log_event( & + "Gungho: tridiagonal preconditioner invalid for element " // & + "orders > 0", LOG_LEVEL_ERROR & + ) + end if + end if - nullify( chi, panel_id, m3_inv, div, w2_rmultiplicity, & - mesh, reference_element, m2, u_normalisation, t_normalisation, & - w2_mask, mesh ) + ! Normalise -------------------------------------------------------------- + if (normalise .and. preconditioner == preconditioner_tridiagonal) then + call Helmholtz_operator(helmholtz_k,level)%copy_field_properties(Helm_diag(level)) + call invoke( & + setval_X( & + Helm_diag(level), Helmholtz_operator(helmholtz_k,level) & + ), & + inc_X_powint_n(Helm_diag(level), imone) & + ) + + do i = 1, helmholtz_stencil_size + call invoke( & + inc_X_times_Y(Helmholtz_operator(i,level), Helm_diag(level)) & + ) + end do + do i = 1,3 + call invoke( inc_X_times_Y(tri_precon(i,level), Helm_diag(level)) ) + end do + else + call invoke( setval_c(Helm_diag(level), 1.0_r_solver) ) + end if + + ! ====================================================================== ! + ! Restrict the fields for the next level + ! ====================================================================== ! + if (level < multigrid_levels) then + ! should not get here if no multigrid, but just in case + if (l_multigrid) then + + write(log_scratch_space,'(A,I0,A,I0)') & + "si_ops:MG restrict L",level," to L",level+1 + call log_event(log_scratch_space,LOG_LEVEL_DEBUG) + + ! copy current field to coarse field + call theta%copy_field_properties(coarse_field) + call invoke( setval_X(coarse_field, theta) ) + ! set the fs to the next (fine) + wt_fs => wtheta_multigrid_function_space_chain%get_next() + call theta%initialise(wt_fs, halo_depth=req_halo_depth) + ! call restrict + call invoke( & + restrict_scalar_unweighted_kernel_type(theta, coarse_field) & + ) + + ! copy current field to coarse field + call moist_dyn_factor%copy_field_properties(coarse_field) + call invoke( setval_X(coarse_field, moist_dyn_factor) ) + call moist_dyn_factor%initialise(wt_fs) + ! call restrict + call invoke( & + restrict_scalar_unweighted_kernel_type( & + moist_dyn_factor, coarse_field & + ) & + ) + + ! copy current field to coarse field + call rho%copy_field_properties(coarse_field) + call invoke( setval_X(coarse_field, rho) ) + ! set the fs to the next (fine) + w3_fs => multigrid_function_space_chain%get_next() + call rho%initialise(w3_fs, halo_depth=req_halo_depth) + ! call restrict + call invoke( & + restrict_scalar_unweighted_kernel_type(rho, coarse_field) & + ) + + ! copy current field to coarse field + call exner%copy_field_properties(coarse_field) + call invoke( setval_X(coarse_field, exner) ) + ! fs already set fine + call exner%initialise(w3_fs, halo_depth=req_halo_depth) + ! call restrict + call invoke( & + restrict_scalar_unweighted_kernel_type(exner, coarse_field) & + ) + ! set w2_fs to next in chain + w2_fs => w2_multigrid_function_space_chain%get_next() + end if + end if + + end do ! end of multigrid levels loop if ( subroutine_timers ) call timer('si_operators_alg:compute') end subroutine compute_si_operators !> @brief Function to return a pointer to the m3_rho_star - !! on the finest multigrid level. + !! on the finest multigrid level + !> @param[in] stepper_name Enumerator for timestepper !> @return The operator - function get_m3_rho_star_fine() result(op) + function get_m3_rho_star_fine(stepper_name) result(op) implicit none - type(r_solver_operator_type), pointer ::op - op => m3_rho_star(1) + integer(kind=i_def), intent(in) :: stepper_name + type(r_solver_operator_type), pointer :: op + + select case (stepper_name) + case (stepper_siqn) + op => m3_rho_star_siqn(1) + case (stepper_tr) + op => m3_rho_star_tr(1) + case (stepper_bdf2) + op => m3_rho_star_bdf2(1) + case default + call log_event( & + 'get_m3_rho_star_fine: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_m3_rho_star_fine !> @brief Function to return a pointer to the m3_rho_star !! on the specified multigrid level. - !> @param[in] level The multigrid level + !> @param[in] stepper_name Enumerator for timestepper + !> @param[in] level The multigrid level !> @return The operator - function get_m3_rho_star_mg(level) result(op) + function get_m3_rho_star_mg(stepper_name, level) result(op) implicit none - integer(kind=i_def), intent(in) :: level - type(r_solver_operator_type), pointer ::op - op => m3_rho_star(level) + integer(kind=i_def), intent(in) :: stepper_name + integer(kind=i_def), intent(in) :: level + type(r_solver_operator_type), pointer :: op + + select case (stepper_name) + case (stepper_siqn) + op => m3_rho_star_siqn(level) + case (stepper_tr) + op => m3_rho_star_tr(level) + case (stepper_bdf2) + op => m3_rho_star_bdf2(level) + case default + call log_event( & + 'get_m3_rho_star_mg: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_m3_rho_star_mg !> @brief Function to return a pointer to the m3_exner_star !! on the finest multigrid level. + !> @param[in] stepper_name Enumerator for timestepper !> @return The operator - function get_m3_exner_star_fine() result(op) + function get_m3_exner_star_fine(stepper_name) result(op) implicit none - type(r_solver_operator_type), pointer ::op - op => m3_exner_star(1) + integer(kind=i_def), intent(in) :: stepper_name + type(r_solver_operator_type), pointer :: op + + select case (stepper_name) + case (stepper_siqn) + op => m3_exner_star_siqn(1) + case (stepper_tr) + op => m3_exner_star_tr(1) + case (stepper_bdf2) + op => m3_exner_star_bdf2(1) + case default + call log_event( & + 'get_m3_exner_star_fine: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_m3_exner_star_fine !> @brief Function to return a pointer to the m3_exner_star !! on the specified multigrid level. - !> @param[in] level The multigrid level + !> @param[in] stepper_name Enumerator for timestepper + !> @param[in] level The multigrid level !> @return The operator - function get_m3_exner_star_mg(level) result(op) + function get_m3_exner_star_mg(stepper_name, level) result(op) implicit none - integer(kind=i_def), intent(in) :: level - type(r_solver_operator_type), pointer ::op - op => m3_exner_star(level) + integer(kind=i_def), intent(in) :: stepper_name + integer(kind=i_def), intent(in) :: level + type(r_solver_operator_type), pointer :: op + + select case (stepper_name) + case (stepper_siqn) + op => m3_exner_star_siqn(level) + case (stepper_tr) + op => m3_exner_star_tr(level) + case (stepper_bdf2) + op => m3_exner_star_bdf2(level) + case default + call log_event( & + 'get_m3_exner_star_mg: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_m3_exner_star_mg !> @brief Function to return a pointer to the div_star !! on the finest multigrid level, + !> @param[in] stepper_name Enumerator for timestepper !> @return The operator - function get_div_star_fine() result(op) + function get_div_star_fine(stepper_name) result(op) implicit none - type(r_solver_operator_type), pointer ::op - op => div_star(1) + integer(kind=i_def), intent(in) :: stepper_name + type(r_solver_operator_type), pointer :: op + + select case (stepper_name) + case (stepper_siqn) + op => div_star_siqn(1) + case (stepper_tr) + op => div_star_tr(1) + case (stepper_bdf2) + op => div_star_bdf2(1) + case default + call log_event( & + 'get_div_star_fine: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_div_star_fine !> @brief Function to return a pointer to the div_star !! on the specified multigrid level. - !> @param[in] level The multigrid level + !> @param[in] stepper_name Enumerator for timestepper + !> @param[in] level The multigrid level !> @return The operator - function get_div_star_mg(level) result(op) + function get_div_star_mg(stepper_name, level) result(op) implicit none - integer(kind=i_def), intent(in) :: level - type(r_solver_operator_type), pointer ::op - op => div_star(level) + integer(kind=i_def), intent(in) :: stepper_name + integer(kind=i_def), intent(in) :: level + type(r_solver_operator_type), pointer :: op + + select case (stepper_name) + case (stepper_siqn) + op => div_star_siqn(level) + case (stepper_tr) + op => div_star_tr(level) + case (stepper_bdf2) + op => div_star_bdf2(level) + case default + call log_event( & + 'get_div_star_mg: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_div_star_mg !> @brief Function to return a pointer to the p2theta !! on the finest multigrid level. + !> @param[in] stepper_name Enumerator for timestepper !> @return The operator - function get_p2theta_fine() result(op) + function get_p2theta_fine(stepper_name) result(op) implicit none - type(r_solver_operator_type), pointer ::op - op => p2theta(1) + integer(kind=i_def), intent(in) :: stepper_name + type(r_solver_operator_type), pointer :: op + + select case (stepper_name) + case (stepper_siqn) + op => p2theta_siqn(1) + case (stepper_tr) + op => p2theta_tr(1) + case (stepper_bdf2) + op => p2theta_bdf2(1) + case default + call log_event( & + 'get_p2theta_fine: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_p2theta_fine !> @brief Function to return a pointer to the p2theta !! on the specified multigrid level. - !> @param[in] level The multigrid level + !> @param[in] stepper_name Enumerator for timestepper + !> @param[in] level The multigrid level !> @return The operator - function get_p2theta_mg(level) result(op) + function get_p2theta_mg(stepper_name, level) result(op) implicit none - integer(kind=i_def), intent(in) :: level - type(r_solver_operator_type), pointer ::op - op => p2theta(level) + integer(kind=i_def), intent(in) :: stepper_name + integer(kind=i_def), intent(in) :: level + type(r_solver_operator_type), pointer :: op + + select case (stepper_name) + case (stepper_siqn) + op => p2theta_siqn(level) + case (stepper_tr) + op => p2theta_tr(level) + case (stepper_bdf2) + op => p2theta_bdf2(level) + case default + call log_event( & + 'get_p2theta_mg: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_p2theta_mg !> @brief Function to return a pointer to the ptheta2 !! on the finest multigrid level. + !> @param[in] stepper_name Enumerator for timestepper !> @return The operator - function get_ptheta2_fine() result(op) + function get_ptheta2_fine(stepper_name) result(op) implicit none - type(r_solver_operator_type), pointer ::op - op => ptheta2(1) + integer(kind=i_def), intent(in) :: stepper_name + type(r_solver_operator_type), pointer :: op + + select case (stepper_name) + case (stepper_siqn) + op => ptheta2_siqn(1) + case (stepper_tr) + op => ptheta2_tr(1) + case (stepper_bdf2) + op => ptheta2_bdf2(1) + case default + call log_event( & + 'get_ptheta2_fine: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_ptheta2_fine !> @brief Function to return a pointer to the ptheta2 !! on the specified multigrid level. - !> @param[in] level The multigrid level + !> @param[in] stepper_name Enumerator for timestepper + !> @param[in] level The multigrid level !> @return The operator - function get_ptheta2_mg(level) result(op) + function get_ptheta2_mg(stepper_name, level) result(op) implicit none - integer(kind=i_def), intent(in) :: level - type(r_solver_operator_type), pointer ::op - op => ptheta2(level) + integer(kind=i_def), intent(in) :: stepper_name + integer(kind=i_def), intent(in) :: level + type(r_solver_operator_type), pointer :: op + + select case (stepper_name) + case (stepper_siqn) + op => ptheta2_siqn(level) + case (stepper_tr) + op => ptheta2_tr(level) + case (stepper_bdf2) + op => ptheta2_bdf2(level) + case default + call log_event( & + 'get_ptheta2_mg: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_ptheta2_mg !> @brief Function to return a pointer to the ptheta2v !! on the finest multigrid level. + !> @param[in] stepper_name Enumerator for timestepper !> @return The operator - function get_ptheta2v_fine() result(op) + function get_ptheta2v_fine(stepper_name) result(op) implicit none - type(r_solver_operator_type), pointer ::op - op => ptheta2v(1) + integer(kind=i_def), intent(in) :: stepper_name + type(r_solver_operator_type), pointer :: op + + select case (stepper_name) + case (stepper_siqn) + op => ptheta2v_siqn(1) + case (stepper_tr) + op => ptheta2v_tr(1) + case (stepper_bdf2) + op => ptheta2v_bdf2(1) + case default + call log_event( & + 'get_ptheta2v_fine: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_ptheta2v_fine !> @brief Function to return a pointer to the ptheta2v !! on the specified multigrid level. - !> @param[in] level The multigrid level + !> @param[in] stepper_name Enumerator for timestepper + !> @param[in] level The multigrid level !> @return The operator - function get_ptheta2v_mg(level) result(op) + function get_ptheta2v_mg(stepper_name, level) result(op) implicit none - integer(kind=i_def), intent(in) :: level - type(r_solver_operator_type), pointer ::op - op => ptheta2v(level) + integer(kind=i_def), intent(in) :: stepper_name + integer(kind=i_def), intent(in) :: level + type(r_solver_operator_type), pointer :: op + + select case (stepper_name) + case (stepper_siqn) + op => ptheta2v_siqn(level) + case (stepper_tr) + op => ptheta2v_tr(level) + case (stepper_bdf2) + op => ptheta2v_bdf2(level) + case default + call log_event( & + 'get_ptheta2v_mg: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_ptheta2v_mg !> @brief Function to return a pointer to the p3theta !! on the finest multigrid level. + !> @param[in] stepper_name Enumerator for timestepper !> @return The operator - function get_p3theta_fine() result(op) + function get_p3theta_fine(stepper_name) result(op) implicit none - type(r_solver_operator_type), pointer ::op - op => p3theta(1) + integer(kind=i_def), intent(in) :: stepper_name + type(r_solver_operator_type), pointer :: op + + select case (stepper_name) + case (stepper_siqn) + op => p3theta_siqn(1) + case (stepper_tr) + op => p3theta_tr(1) + case (stepper_bdf2) + op => p3theta_bdf2(1) + case default + call log_event( & + 'get_p3theta_fine: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_p3theta_fine !> @brief Function to return a pointer to the p3theta !! on the specified multigrid level. - !> @param[in] level The multigrid level + !> @param[in] stepper_name Enumerator for timestepper + !> @param[in] level The multigrid level !> @return The operator - function get_p3theta_mg(level) result(op) + function get_p3theta_mg(stepper_name, level) result(op) implicit none - integer(kind=i_def), intent(in) :: level - type(r_solver_operator_type), pointer ::op - op => p3theta(level) + integer(kind=i_def), intent(in) :: stepper_name + integer(kind=i_def), intent(in) :: level + type(r_solver_operator_type), pointer :: op + + select case (stepper_name) + case (stepper_siqn) + op => p3theta_siqn(level) + case (stepper_tr) + op => p3theta_tr(level) + case (stepper_bdf2) + op => p3theta_bdf2(level) + case default + call log_event( & + 'get_p3theta_mg: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_p3theta_mg !> @brief Function to return a pointer to the compound div !! on the finest multigrid level. + !> @param[in] stepper_name Enumerator for timestepper !> @return The operator - function get_compound_div_fine() result(op) + function get_compound_div_fine(stepper_name) result(op) implicit none - type(r_solver_operator_type), pointer ::op - op => compound_div(1) + integer(kind=i_def), intent(in) :: stepper_name + type(r_solver_operator_type), pointer :: op + + select case (stepper_name) + case (stepper_siqn) + op => compound_div_siqn(1) + case (stepper_tr) + op => compound_div_tr(1) + case (stepper_bdf2) + op => compound_div_bdf2(1) + case default + call log_event( & + 'get_compound_div_fine: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_compound_div_fine !> @brief Function to return a pointer to the compound div !! on the specified multigrid level. - !> @param[in] level The multigrid level + !> @param[in] stepper_name Enumerator for timestepper + !> @param[in] level The multigrid level !> @return The operator - function get_compound_div_mg(level) result(op) + function get_compound_div_mg(stepper_name, level) result(op) implicit none - integer(kind=i_def), intent(in) :: level - type(r_solver_operator_type), pointer ::op - op => compound_div(level) + integer(kind=i_def), intent(in) :: stepper_name + integer(kind=i_def), intent(in) :: level + type(r_solver_operator_type), pointer :: op + + select case (stepper_name) + case (stepper_siqn) + op => compound_div_siqn(level) + case (stepper_tr) + op => compound_div_tr(level) + case (stepper_bdf2) + op => compound_div_bdf2(level) + case default + call log_event( & + 'get_compound_div_mg: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_compound_div_mg !> @brief Function to return a pointer to the rho_at_u @@ -1003,145 +1692,353 @@ contains !> @return The field function get_rho_at_u_mg(level) result(field) implicit none - integer(kind=i_def), intent(in) :: level + integer(kind=i_def), intent(in) :: level type(r_solver_field_type), pointer :: field field => rho_at_u(level) end function get_rho_at_u_mg !> @brief Function to return a pointer to the tri_precon !! on the finest multigrid level. + !> @param[in] stepper_name Enumerator for timestepper !> @return The field - function get_tri_precon_fine() result(sol_field) + function get_tri_precon_fine(stepper_name) result(sol_field) implicit none + integer(kind=i_def), intent(in) :: stepper_name type(r_solver_field_type), pointer :: sol_field(:) - sol_field => tri_precon(:,1) + + select case (stepper_name) + case (stepper_siqn) + sol_field => tri_precon_siqn(:,1) + case (stepper_tr) + sol_field => tri_precon_tr(:,1) + case (stepper_bdf2) + sol_field => tri_precon_bdf2(:,1) + case default + call log_event( & + 'get_tri_precon_fine: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_tri_precon_fine !> @brief Function to return a pointer to the tri_precon !! on the specified multigrid level. - !> @param[in] level The multigrid level + !> @param[in] stepper_name Enumerator for timestepper + !> @param[in] level The multigrid level !> @return The field - function get_tri_precon_mg(level) result(sol_field) + function get_tri_precon_mg(stepper_name, level) result(sol_field) implicit none - integer(kind=i_def), intent(in) :: level + integer(kind=i_def), intent(in) :: stepper_name + integer(kind=i_def), intent(in) :: level type(r_solver_field_type), pointer :: sol_field(:) - sol_field => tri_precon(:,level) + + select case (stepper_name) + case (stepper_siqn) + sol_field => tri_precon_siqn(:,level) + case (stepper_tr) + sol_field => tri_precon_tr(:,level) + case (stepper_bdf2) + sol_field => tri_precon_bdf2(:,level) + case default + call log_event( & + 'get_tri_precon_mg: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_tri_precon_mg !> @brief Function to return a pointer to the helmholtz_operator !! on the finest multigrid level. + !> @param[in] stepper_name Enumerator for timestepper !> @return The field - function get_helmholtz_operator_fine() result(sol_field) + function get_helmholtz_operator_fine(stepper_name) result(sol_field) implicit none + integer(kind=i_def), intent(in) :: stepper_name type(r_solver_field_type), pointer :: sol_field(:) - sol_field => helmholtz_operator(:,1) + + select case (stepper_name) + case (stepper_siqn) + sol_field => helmholtz_operator_siqn(:,1) + case (stepper_tr) + sol_field => helmholtz_operator_tr(:,1) + case (stepper_bdf2) + sol_field => helmholtz_operator_bdf2(:,1) + case default + call log_event( & + 'get_helmholtz_operator_fine: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_helmholtz_operator_fine !> @brief Function to return a pointer to the helmholtz_operator !! on the specified multigrid level. - !> @param[in] level The multigrid level + !> @param[in] stepper_name Enumerator for timestepper + !> @param[in] level The multigrid level !> @return The field - function get_helmholtz_operator_mg(level) result(sol_field) + function get_helmholtz_operator_mg(stepper_name, level) result(sol_field) implicit none - integer(kind=i_def), intent(in) :: level + integer(kind=i_def), intent(in) :: stepper_name + integer(kind=i_def), intent(in) :: level type(r_solver_field_type), pointer :: sol_field(:) - sol_field => helmholtz_operator(:,level) + + select case (stepper_name) + case (stepper_siqn) + sol_field => helmholtz_operator_siqn(:,level) + case (stepper_tr) + sol_field => helmholtz_operator_tr(:,level) + case (stepper_bdf2) + sol_field => helmholtz_operator_bdf2(:,level) + case default + call log_event( & + 'get_helmholtz_operator_mg: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_helmholtz_operator_mg !> @brief Function to return a pointer to the Helm diagonal !! on the finest multigrid level. + !> @param[in] stepper_name Enumerator for timestepper !> @return The field - function get_helm_diag_fine() result(sol_field) + function get_helm_diag_fine(stepper_name) result(sol_field) implicit none + integer(kind=i_def), intent(in) :: stepper_name type(r_solver_field_type), pointer :: sol_field - sol_field => helm_diag(1) + + select case (stepper_name) + case (stepper_siqn) + sol_field => helm_diag_siqn(1) + case (stepper_tr) + sol_field => helm_diag_tr(1) + case (stepper_bdf2) + sol_field => helm_diag_bdf2(1) + case default + call log_event( & + 'get_helm_diag_fine: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_helm_diag_fine !> @brief Function to return a pointer to the Helm diagonal - !! on the specified multigrid level, + !! on the specified multigrid level. !> @param[in] level The multigrid level !> @return The field - function get_helm_diag_mg(level) result(sol_field) + function get_helm_diag_mg(stepper_name, level) result(sol_field) implicit none - integer(kind=i_def), intent(in) :: level + integer(kind=i_def), intent(in) :: stepper_name + integer(kind=i_def), intent(in) :: level type(r_solver_field_type), pointer :: sol_field - sol_field => helm_diag(level) + + select case (stepper_name) + case (stepper_siqn) + sol_field => helm_diag_siqn(level) + case (stepper_tr) + sol_field => helm_diag_tr(level) + case (stepper_bdf2) + sol_field => helm_diag_bdf2(level) + case default + call log_event( & + 'get_helm_diag_mg: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_helm_diag_mg !> @brief Function to return a pointer to the lumped inverse Hb operator !! on the finest multigrid level, + !> @param[in] stepper_name Enumerator for timestepper !> @return The field - function get_hb_lumped_inv_fine() result(field) + function get_hb_lumped_inv_fine(stepper_name) result(field) implicit none + integer(kind=i_def), intent(in) :: stepper_name type(r_solver_field_type), pointer :: field - field => hb_lumped_inv(1) + + select case (stepper_name) + case (stepper_siqn) + field => hb_lumped_inv_siqn(1) + case (stepper_tr) + field => hb_lumped_inv_tr(1) + case (stepper_bdf2) + field => hb_lumped_inv_bdf2(1) + case default + call log_event( & + 'get_hb_lumped_inv_fine: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_hb_lumped_inv_fine !> @brief Function to return a pointer to the lumped inverse Hb operator !! on the specified multigrid level, - !> @param[in] level The multigrid level + !> @param[in] stepper_name Enumerator for timestepper + !> @param[in] level The multigrid level !> @return The field - function get_hb_lumped_inv_mg(level) result(field) + function get_hb_lumped_inv_mg(stepper_name, level) result(field) implicit none - integer(kind=i_def), intent(in) :: level + integer(kind=i_def), intent(in) :: stepper_name + integer(kind=i_def), intent(in) :: level type(r_solver_field_type), pointer :: field - field => hb_lumped_inv(level) + + select case (stepper_name) + case (stepper_siqn) + field => hb_lumped_inv_siqn(level) + case (stepper_tr) + field => hb_lumped_inv_tr(level) + case (stepper_bdf2) + field => hb_lumped_inv_bdf2(level) + case default + call log_event( & + 'get_hb_lumped_inv_mg: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_hb_lumped_inv_mg !> @brief Function to return a pointer to the q22 operator !! on the finest multigrid level. + !> @param[in] stepper_name Enumerator for timestepper !> @return The operator - function get_eliminated_q22_fine() result(op) + function get_eliminated_q22_fine(stepper_name) result(op) implicit none + integer(kind=i_def), intent(in) :: stepper_name type(r_solver_operator_type), pointer :: op - op => eliminated_q22(1) + + select case (stepper_name) + case (stepper_siqn) + op => eliminated_q22_siqn(1) + case (stepper_tr) + op => eliminated_q22_tr(1) + case (stepper_bdf2) + op => eliminated_q22_bdf2(1) + case default + call log_event( & + 'get_eliminated_q22_fine: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_eliminated_q22_fine !> @brief Function to return a pointer to the q22 operator !! on the specified multigrid level. - !> @param[in] level The multigrid level + !> @param[in] stepper_name Enumerator for timestepper + !> @param[in] level The multigrid level !> @return The operator - function get_eliminated_q22_mg(level) result(op) + function get_eliminated_q22_mg(stepper_name, level) result(op) implicit none - integer(kind=i_def), intent(in) :: level + integer(kind=i_def), intent(in) :: stepper_name + integer(kind=i_def), intent(in) :: level type(r_solver_operator_type), pointer :: op - op => eliminated_q22(level) + + select case (stepper_name) + case (stepper_siqn) + op => eliminated_q22_siqn(level) + case (stepper_tr) + op => eliminated_q22_tr(level) + case (stepper_bdf2) + op => eliminated_q22_bdf2(level) + case default + call log_event( & + 'get_eliminated_q22_mg: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_eliminated_q22_mg !> @brief Function to return a pointer to the q32 operator !! on the finest multigrid level. !> @return The operator - function get_eliminated_q32_fine() result(op) + function get_eliminated_q32_fine(stepper_name) result(op) implicit none + integer(kind=i_def), intent(in) :: stepper_name type(r_solver_operator_type), pointer :: op - op => eliminated_q32(1) + + select case (stepper_name) + case (stepper_siqn) + op => eliminated_q32_siqn(1) + case (stepper_tr) + op => eliminated_q32_tr(1) + case (stepper_bdf2) + op => eliminated_q32_bdf2(1) + case default + call log_event( & + 'get_eliminated_q32_fine: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_eliminated_q32_fine !> @brief Function to return a pointer to the q32 operator !! on the specified multigrid level. - !> @param[in] level The multigrid level + !> @param[in] stepper_name Enumerator for timestepper + !> @param[in] level The multigrid level !> @return The operator - function get_eliminated_q32_mg(level) result(op) + function get_eliminated_q32_mg(stepper_name, level) result(op) implicit none - integer(kind=i_def), intent(in) :: level + integer(kind=i_def), intent(in) :: stepper_name + integer(kind=i_def), intent(in) :: level type(r_solver_operator_type), pointer :: op - op => eliminated_q32(level) + + select case (stepper_name) + case (stepper_siqn) + op => eliminated_q32_siqn(level) + case (stepper_tr) + op => eliminated_q32_tr(level) + case (stepper_bdf2) + op => eliminated_q32_bdf2(level) + case default + call log_event( & + 'get_eliminated_q32_mg: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_eliminated_q32_mg !> @brief Function to return a pointer to the q2t operator. + !> @param[in] stepper_name Enumerator for timestepper !> @return The operator - function get_eliminated_q2t() result(op) + function get_eliminated_q2t(stepper_name) result(op) implicit none + integer(kind=i_def), intent(in) :: stepper_name type(r_solver_operator_type), pointer :: op - op => eliminated_q2t + + select case (stepper_name) + case (stepper_siqn) + op => eliminated_q2t_siqn + case (stepper_tr) + op => eliminated_q2t_tr + case (stepper_bdf2) + op => eliminated_q2t_bdf2 + case default + call log_event( & + 'get_eliminated_q2t: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_eliminated_q2t !> @brief Function to return a pointer to the q3t operator. + !> @param[in] stepper_name Enumerator for timestepper !> @return The operator - function get_eliminated_q3t() result(op) + function get_eliminated_q3t(stepper_name) result(op) implicit none + integer(kind=i_def), intent(in) :: stepper_name type(r_solver_operator_type), pointer :: op - op => p3theta(1) + + select case (stepper_name) + case (stepper_siqn) + op => p3theta_siqn(1) + case (stepper_tr) + op => p3theta_tr(1) + case (stepper_bdf2) + op => p3theta_bdf2(1) + case default + call log_event( & + 'get_eliminated_q3t: Unrecognised stepper', LOG_LEVEL_ERROR & + ) + end select + end function get_eliminated_q3t end module si_operators_alg_mod diff --git a/science/gungho/source/algorithm/timestepping/conditional_collection_copy_mod.x90 b/science/gungho/source/algorithm/timestepping/conditional_collection_copy_mod.x90 new file mode 100644 index 000000000..76ace9287 --- /dev/null +++ b/science/gungho/source/algorithm/timestepping/conditional_collection_copy_mod.x90 @@ -0,0 +1,88 @@ +!------------------------------------------------------------------------------- +! (c) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!------------------------------------------------------------------------------- + +module conditional_collection_copy_mod + + use constants_mod, only: l_def + use field_parent_mod, only: field_parent_type + use field_mod, only: field_type + use field_collection_mod, only: field_collection_type + use field_collection_iterator_mod, only: field_collection_iterator_type + + implicit none + private + + public :: conditional_collection_copy + +contains + + !> @brief Make a deep copy of a subset of a field collection, based on a + !! list of fields provided by another collection + !> @param[out] generic_fields_copied New collection written with fields + !! saved at some point in time + !> @param[in] generic_fields_to_copy collection we want to save fields from + !> @param[in] field_list list of fields to be saved + subroutine conditional_collection_copy(generic_fields_copied, & + generic_fields_to_copy, & + field_list) + + + implicit none + + type(field_collection_type), intent(out) :: generic_fields_copied + type(field_collection_type), intent(in) :: generic_fields_to_copy + type(field_collection_type), intent(in) :: field_list + + ! Iterator for field collection + type(field_collection_iterator_type) :: iterator + + ! One of the single fields out of the generic_fields_to_copy collection + class(field_parent_type), pointer :: abstract_field_ptr + type(field_type), pointer :: single_generic_field + + ! The saved version of single_generic_field + type(field_type) :: copied_generic_field + + logical(kind=l_def) :: l_copy + + nullify(abstract_field_ptr) + nullify(single_generic_field) + + call generic_fields_copied%initialise(name='fields_copied') + + if ( generic_fields_to_copy%get_length() > 0 ) then + + call iterator%initialise(generic_fields_to_copy) + + do + if ( .not.iterator%has_next() ) exit + + abstract_field_ptr => iterator%next() + select type(abstract_field_ptr) + type is (field_type) + single_generic_field => abstract_field_ptr + end select + + l_copy = field_list%field_exists(single_generic_field%get_name()) + + if ( l_copy ) then + + ! We copy the field we want to save into a new field + call single_generic_field%copy_field_properties(copied_generic_field) + call invoke( setval_X(copied_generic_field, single_generic_field) ) + + ! We add it to the field collection passed in + call generic_fields_copied%add_field(copied_generic_field) + + end if ! ( l_copy ) + + end do + + end if + + end subroutine conditional_collection_copy + +end module conditional_collection_copy_mod \ No newline at end of file diff --git a/science/gungho/source/algorithm/timestepping/rk_alg_timestep_mod.x90 b/science/gungho/source/algorithm/timestepping/rk_alg_timestep_mod.x90 index 45605e512..91bc98287 100644 --- a/science/gungho/source/algorithm/timestepping/rk_alg_timestep_mod.x90 +++ b/science/gungho/source/algorithm/timestepping/rk_alg_timestep_mod.x90 @@ -44,7 +44,8 @@ module rk_alg_timestep_mod copy_bundle, & set_bundle_scalar use dycore_constants_mod, only: get_geopotential, & - get_coriolis + get_coriolis, & + stepper_siqn ! PsyKAl PSYClone kernels use sci_enforce_bc_kernel_mod, only: enforce_bc_kernel_type @@ -372,7 +373,8 @@ contains ! Compute advection terms call gungho_transport_control_alg( self%rhs_prediction(:,stage), self%state, & self%state(igh_u), self%state(igh_u), & - mr, mr, model_clock, outer, cheap_update ) + mr, mr, model_clock, outer, & + stepper_siqn, cheap_update ) ! Compute new rhs if ( rotating ) then coriolis => get_coriolis(mesh_id) diff --git a/science/gungho/source/algorithm/timestepping/semi_implicit_timestep_alg_mod.X90 b/science/gungho/source/algorithm/timestepping/semi_implicit_timestep_alg_mod.X90 index 7aa360475..d264828b3 100644 --- a/science/gungho/source/algorithm/timestepping/semi_implicit_timestep_alg_mod.X90 +++ b/science/gungho/source/algorithm/timestepping/semi_implicit_timestep_alg_mod.X90 @@ -24,6 +24,11 @@ module semi_implicit_timestep_alg_mod copy_bundle, & set_bundle_scalar + use sci_field_minmax_alg_mod, only: log_field_minmax + + use conditional_collection_copy_mod, & + only: conditional_collection_copy + ! Parent of this module's semi-implicit timestep type use timestep_method_mod, only: timestep_method_type @@ -117,6 +122,7 @@ module semi_implicit_timestep_alg_mod use mixing_alg_mod, only: mixing_alg use si_diagnostics_mod, only: output_diags_for_si use predictors_alg_mod, only: predictors_alg + use dycore_constants_mod, only: stepper_siqn ! LAM use limited_area_lbc_alg_mod, only: lam_solver_lbc, & @@ -183,7 +189,6 @@ module semi_implicit_timestep_alg_mod procedure, public :: finalise => semi_implicit_alg_final procedure, nopass :: run_init procedure, nopass :: run_step - procedure, nopass :: conditional_collection_copy end type semi_implicit_timestep_type @@ -481,7 +486,7 @@ contains !-------------------------------------------------------------------- ! Operators for si solves !-------------------------------------------------------------------- - call create_si_operators( mesh ) + call create_si_operators( mesh, stepper_siqn ) ! If using checkpointed reference state, then calculate semi-implicit ! operators using the checkpointed reference state @@ -493,7 +498,10 @@ contains call prognostic_fields%get_field('theta_ref', theta_ref) call prognostic_fields%get_field('rho_ref', rho_ref) call prognostic_fields%get_field('exner_ref', exner_ref) - call compute_si_operators(theta_ref, rho_ref, exner_ref, model_clock, moist_dyn_ref) + call compute_si_operators( & + theta_ref, rho_ref, exner_ref, model_clock, moist_dyn_ref, & + stepper_siqn & + ) nullify(theta_ref, rho_ref, exner_ref, moist_dyn_ref, moist_dyn_ref_array) end if @@ -501,7 +509,7 @@ contains call gungho_transport_control_alg_init( mesh ) ! Construct semi-implicit solver - call semi_implicit_solver_alg_init( self%state ) + call semi_implicit_solver_alg_init( self%state, stepper_siqn ) end if nullify(mesh) @@ -717,7 +725,10 @@ contains if ( mod(model_clock%get_step() - 1_i_def, reference_reset_freq) == 0_i_def ) then ! Compute semi-implicit operators with current model state - call compute_si_operators(self%state(igh_t), self%state(igh_d), self%state(igh_p), model_clock, moist_dyn) + call compute_si_operators( & + self%state(igh_t), self%state(igh_d), self%state(igh_p), & + model_clock, moist_dyn, stepper_siqn & + ) checkpoint_reference_fields = & mod(model_clock%get_first_step()-1, reference_reset_freq) /= 0 .or. & @@ -770,6 +781,12 @@ contains call copy_bundle(self%state, self%state_n, bundle_size) call copy_bundle(self%state, self%state_after_slow, bundle_size) + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_INFO, 'state_n u', self%state_n(igh_u)) + call log_field_minmax(LOG_LEVEL_INFO, 'state_n rho', self%state_n(igh_d)) + call log_field_minmax(LOG_LEVEL_INFO, 'state_n theta', self%state_n(igh_t)) + call log_field_minmax(LOG_LEVEL_INFO, 'state_n exner', self%state_n(igh_p)) + !-------------------------------------------------------------------- ! Compute slow physic updates !-------------------------------------------------------------------- @@ -801,13 +818,20 @@ contains end if end if !use_physics + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_INFO, 'state_after_slow u', self%state_after_slow(igh_u)) + call log_field_minmax(LOG_LEVEL_INFO, 'state_after_slow rho', self%state_after_slow(igh_d)) + call log_field_minmax(LOG_LEVEL_INFO, 'state_after_slow theta', self%state_after_slow(igh_t)) + call log_field_minmax(LOG_LEVEL_INFO, 'state_after_slow exner', self%state_after_slow(igh_p)) + !-------------------------------------------------------------------- ! Compute the time-level n dynamics terms !-------------------------------------------------------------------- call rhs_alg( self%rhs_n, varbeta*cast_dt, & self%state_after_slow, self%state_n, moist_dyn, & compute_eos=.false., compute_rhs_t_d=.true., & - dlayer_rhs=.false., model_clock=model_clock ) + dlayer_rhs=.false., stepper_name=stepper_siqn, & + model_clock=model_clock ) call copy_bundle(self%state_after_slow, self%advected_state, bundle_size) ! Set the moisture to be transported to point to the moisture after slow physics @@ -816,6 +840,12 @@ contains call predictors_alg(self%advected_state, self%state_n(igh_u), & self%rhs_n(igh_u),varbeta,model_clock) + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: rhs_n u', self%rhs_n(igh_u)) + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: rhs_n rho', self%rhs_n(igh_d)) + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: rhs_n theta', self%rhs_n(igh_t)) + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: rhs_n exner', self%rhs_n(igh_p)) + !========================================================================== ! Start the Outer (advection) loop !========================================================================== @@ -833,14 +863,21 @@ contains field_list=con_tracer_last_outer) call invoke( setval_X(self%wind_prev, self%state(igh_u)) ) + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: advected_state u', self%advected_state(igh_u)) + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: advected_state rho', self%advected_state(igh_d)) + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: advected_state theta', self%advected_state(igh_t)) + outer_dynamics_loop: do outer = 1,outer_iterations if (use_wavedynamics) then call gungho_transport_control_alg( & self%rhs_adv, self%advected_state, self%state(igh_u), & self%state_n(igh_u), mr, mr_to_adv, model_clock, & - outer, cheap_update, self%adv_inc_prev, self%wind_prev, & - self%state_after_slow(igh_d), self%total_dry_flux, & + outer, stepper_siqn, & + cheap_update, self%adv_inc_prev, self%wind_prev, & + self%state_after_slow(igh_d), self%state_after_slow(igh_d), & + self%total_dry_flux, & adv_tracer_all_outer, adv_tracer_all_outer_after_slow, & adv_tracer_last_outer, adv_tracer_last_outer_after_slow, & con_tracer_all_outer, con_tracer_all_outer_after_slow, & @@ -881,11 +918,19 @@ contains dg_inc_matrix_vector_kernel_type(self%rhs_adv(igh_t), & self%dtheta, mm_wt) ) + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: rhs_adv u', self%rhs_adv(igh_u)) + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: rhs_adv rho', self%rhs_adv(igh_d)) + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: rhs_adv theta', self%rhs_adv(igh_t)) + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: rhs_adv exner', self%rhs_adv(igh_p)) + ! Compute the time-level n+1 dynamics terms call rhs_alg( self%rhs_np1, -varalpha*cast_dt, & self%state, self%state, moist_dyn, & compute_eos=.true., compute_rhs_t_d=.true., & - dlayer_rhs=dlayer_on, model_clock=model_clock ) + dlayer_rhs=dlayer_on, & + stepper_name=stepper_siqn, & + model_clock=model_clock ) else if (self%use_moisture) call copy_bundle(self%mr_after_slow, mr, nummr) end if @@ -971,7 +1016,9 @@ contains if (inner > 1) call rhs_alg( self%rhs_np1, -varalpha*cast_dt, & self%state, self%state, moist_dyn, & compute_eos=.true., compute_rhs_t_d=.false., & - dlayer_rhs=dlayer_on, model_clock=model_clock ) + dlayer_rhs=dlayer_on, & + stepper_name=stepper_siqn, & + model_clock=model_clock ) !-------------------------------------------------------------------- ! Compute the LAM LBCs and RHS @@ -979,9 +1026,15 @@ contains if ( limited_area .and. inner == 1 .and. outer == 1 ) then call lam_solver_lbc(self%state(igh_u), lbc_fields, prime_mesh_name) call calc_rhs_lbc(self%rhs_lbc, lbc_fields, model_clock, prime_mesh_name, & - tau_r, subroutine_timers) + tau_r, stepper_siqn, subroutine_timers) end if + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: rhs_np1 u', self%rhs_np1(igh_u)) + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: rhs_np1 rho', self%rhs_np1(igh_d)) + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: rhs_np1 theta', self%rhs_np1(igh_t)) + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: rhs_np1 exner', self%rhs_np1(igh_p)) + !-------------------------------------------------------------------- ! Compute the residuals ! @@ -1007,6 +1060,11 @@ contains setval_c(self%rhs_np1(igh_t), 0.0_r_def) ) end if + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: rhs_np1 u', self%rhs_np1(igh_u)) + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: rhs_np1 rho', self%rhs_np1(igh_d)) + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: rhs_np1 theta', self%rhs_np1(igh_t)) + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: rhs_np1 exner', self%rhs_np1(igh_p)) write_moisture_diag = write_conservation_diag .and. & outer == outer_iterations .and. & @@ -1015,11 +1073,12 @@ contains !-------------------------------------------------------------------- ! Solve semi-implicit system: A*inc = rhs, and incement state by inc !-------------------------------------------------------------------- - call semi_implicit_solver_alg_step( self%state, self%rhs_np1, & - moist_dyn(gas_law), & - mr, & - write_moisture_diag, & - first_iteration=(inner==1) ) + call semi_implicit_solver_alg_step( self%state, self%rhs_np1, & + moist_dyn(gas_law), & + mr, & + write_moisture_diag, & + first_iteration=(inner==1), & + stepper_name=stepper_siqn ) ! If not already done update factors for moist dynamics if ( .not. guess_np1 .and. self%use_moisture ) & @@ -1030,6 +1089,12 @@ contains moist_dyn(gas_law) ) end if + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: state_np1 u', self%state(igh_u)) + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: state_np1 rho', self%state(igh_d)) + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: state_np1 theta', self%state(igh_t)) + call log_field_minmax(LOG_LEVEL_INFO, 'SIQN: state_np1 exner', self%state(igh_p)) + !-------------------------------------------------------------------- ! LAM Overwrite and Blend LBCs !-------------------------------------------------------------------- @@ -1194,72 +1259,4 @@ contains return end subroutine semi_implicit_alg_final - !============================================================================! - !> @brief Make a deep copy of a subset of a field collection, based on a - !> list of fields provided by another collection - !> @param[out] generic_fields_copied New collection written with fields - !> saved at some point in time - !> @param[in] generic_fields_to_copy collection we want to save fields from - !> @param[in] field_list list of fields to be saved - subroutine conditional_collection_copy(generic_fields_copied, & - generic_fields_to_copy, & - field_list) - - use field_collection_mod, only: field_collection_type - use field_collection_iterator_mod, only: field_collection_iterator_type - - implicit none - - type(field_collection_type), intent(out) :: generic_fields_copied - type(field_collection_type), intent(in) :: generic_fields_to_copy - type(field_collection_type), intent(in) :: field_list - - ! Iterator for field collection - type(field_collection_iterator_type) :: iterator - - ! One of the single fields out of the generic_fields_to_copy collection - class( field_parent_type ), pointer :: abstract_field_ptr - type(field_type), pointer :: single_generic_field - - ! The saved version of single_generic_field - type(field_type) :: copied_generic_field - - logical(kind=l_def) :: l_copy - - nullify(abstract_field_ptr) - nullify(single_generic_field) - - call generic_fields_copied%initialise(name='fields_copied') - - if ( generic_fields_to_copy%get_length() > 0 ) then - - call iterator%initialise(generic_fields_to_copy) - - do - if ( .not.iterator%has_next() ) exit - - abstract_field_ptr => iterator%next() - select type(abstract_field_ptr) - type is (field_type) - single_generic_field => abstract_field_ptr - end select - - l_copy = field_list%field_exists(single_generic_field%get_name()) - - if ( l_copy ) then - - ! We copy the field we want to save into a new field - call single_generic_field%copy_field_properties(copied_generic_field) - call invoke( setval_X(copied_generic_field, single_generic_field) ) - - ! We add it to the field collection passed in - call generic_fields_copied%add_field(copied_generic_field) - - end if ! ( l_copy ) - - end do - - end if - - end subroutine conditional_collection_copy end module semi_implicit_timestep_alg_mod diff --git a/science/gungho/source/algorithm/timestepping/tr_bdf2_timestep_alg_mod.X90 b/science/gungho/source/algorithm/timestepping/tr_bdf2_timestep_alg_mod.X90 new file mode 100644 index 000000000..5b2d4f472 --- /dev/null +++ b/science/gungho/source/algorithm/timestepping/tr_bdf2_timestep_alg_mod.X90 @@ -0,0 +1,1555 @@ +!------------------------------------------------------------------------------- +! (c) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!------------------------------------------------------------------------------- + +!> @brief A three time-level iterative timestepper for the 3D nonlinear +!! compressible Euler equations, using a Quasi-Newton method with a +!! Trapezoidal Backward-Difference (TR-BDF2) time discretisation. +module tr_bdf2_timestep_alg_mod + + use constants_mod, only: i_def, r_def, l_def, str_def + use fs_continuity_mod, only: Wtheta, W2 + use log_mod, only: log_event, & + log_scratch_space, & + LOG_LEVEL_INFO, & + LOG_LEVEL_DEBUG + use extrusion_mod, only: TWOD + use namelist_mod, only: namelist_type + use sci_fem_constants_mod, only: get_mass_matrix_fe, & + get_mass_matrix_fv + use sci_field_bundle_builtins_mod, & + only: clone_bundle, & + bundle_axpy, & + bundle_axpby, & + add_bundle, & + copy_bundle, & + set_bundle_scalar + use conditional_collection_copy_mod, & + only: conditional_collection_copy + + ! Parent of this module's semi-implicit timestep type + use timestep_method_mod, only: timestep_method_type + + ! Configuration options + use section_choice_config_mod, only: cloud, cloud_um, & + aerosol, aerosol_um + use physics_config_mod, only: blayer_placement, & + blayer_placement_fast, & + convection_placement, & + convection_placement_fast, & + stochastic_physics_placement, & + stochastic_physics_placement_fast, & + smagorinsky_placement, & + smagorinsky_placement_outer + + use aerosol_config_mod, only: glomap_mode, & + glomap_mode_dust_and_clim, & + glomap_mode_ukca + + use formulation_config_mod, only: use_physics, dlayer_on, & + use_wavedynamics, & + moisture_formulation, & + moisture_formulation_dry, & + exner_from_eos + use io_config_mod, only: subroutine_timers, & + write_conservation_diag, write_diag, & + use_xios_io, diagnostic_frequency, & + checkpoint_read + use initialization_config_mod, only: init_option, & + init_option_checkpoint_dump, & + lbc_option_um2lfric_file + use mixed_solver_config_mod, only: guess_np1, reference_reset_time + use tr_bdf2_config_mod, only: tr_outer_iterations, & + tr_inner_iterations_even, & + tr_inner_iterations_odd, & + bdf2_outer_iterations, & + bdf2_inner_iterations + use transport_config_mod, only: cheap_update, & + transport_ageofair + use derived_config_mod, only: bundle_size + use boundaries_config_mod, only: limited_area, blend_frequency, & + blend_frequency_inner, & + blend_frequency_outer, & + blend_frequency_final + use finite_element_config_mod, only: element_order_h, & + element_order_v + + ! PSyKAl PSyclone kernels + use matrix_vector_kernel_mod, only: matrix_vector_kernel_type + use dg_matrix_vector_kernel_mod, & + only: dg_matrix_vector_kernel_type + use dg_inc_matrix_vector_kernel_mod, & + only: dg_inc_matrix_vector_kernel_type + use sci_enforce_bc_kernel_mod, only: enforce_bc_kernel_type + + ! Derived Types + use field_array_mod, only: field_array_type + use field_mod, only: field_type + use field_parent_mod, only: field_parent_type + use field_collection_mod, only: field_collection_type + use r_tran_field_mod, only: r_tran_field_type + use io_value_mod, only: io_value_type, & + get_io_value + use driver_modeldb_mod, only: modeldb_type + use mesh_mod, only: mesh_type + use mesh_collection_mod, only: mesh_collection + use model_clock_mod, only: model_clock_type + use operator_mod, only: operator_type + + ! Algorithms + use rhs_alg_mod, only: rhs_alg + use gungho_transport_control_alg_mod, & + only: gungho_transport_control_alg_init, & + gungho_transport_control_alg + + use si_operators_alg_mod, only: create_si_operators, & + compute_si_operators, & + final_si_operators + use fast_physics_alg_mod, only: fast_physics + use slow_physics_alg_mod, only: slow_physics + use checks_and_balances_alg_mod, & + only: check_fields + + use semi_implicit_solver_alg_mod, & + only: semi_implicit_solver_alg_init, & + semi_implicit_solver_alg_step, & + semi_implicit_solver_alg_final + use derive_exner_from_eos_alg_mod, & + only: derive_exner_from_eos + use sci_mass_matrix_solver_alg_mod, & + only: mass_matrix_solver_alg + use moist_dyn_factors_alg_mod, only: moist_dyn_factors_alg + use update_prognostic_scalars_alg_mod, & + only: update_prognostic_scalars_alg + use mixing_alg_mod, only: mixing_alg + use si_diagnostics_mod, only: output_diags_for_si + use predictors_alg_mod, only: predictors_alg + use dycore_constants_mod, only: stepper_tr, stepper_bdf2 + use sci_field_minmax_alg_mod, only: log_field_minmax + + ! LAM + use limited_area_lbc_alg_mod, only: lam_solver_lbc, & + lam_blend_lbc + use lam_rhs_alg_mod, only: calc_rhs_lbc, & + apply_mask_rhs + + ! Field mappings + use calc_phys_predictors_alg_mod, & + only: calc_phys_predictors_alg + use map_physics_fields_alg_mod, only: map_physics_fields_alg + + ! Moisture species + use mr_indices_mod, only: nummr + use moist_dyn_mod, only: num_moist_factors, gas_law + + ! Field indices + use field_indices_mod, only: igh_u, igh_t, igh_d, igh_p + + ! Mixing settings + use mixing_config_mod, only: smagorinsky + use smagorinsky_alg_mod, only: smagorinsky_alg + ! Physics routines called +#ifdef UM_PHYSICS + use cld_alg_mod, only: cld_alg + use aerosol_ukca_alg_mod, only: aerosol_ukca_alg + use casim_activate_alg_mod, only: casim_activate_alg +#endif + use cld_incs_mod, only: cld_incs_init, cld_incs_output + + use timer_mod, only: timer + use ageofair_alg_mod, only: ageofair_update + + implicit none + + private + + real(kind=r_def), parameter :: gamma = 1.0_r_def - 0.5_r_def*SQRT(2.0_r_def) + real(kind=r_def), parameter :: gamma2 = ( & + 0.5_r_def*(1.0_r_def - 2.0_r_def*gamma)/(1.0_r_def - gamma) & + ) + real(kind=r_def), parameter :: gamma3 = 0.5_r_def*(1.0_r_def - gamma)/gamma + + ! State object for the semi-implicit time-stepping method + type, extends(timestep_method_type), public :: tr_bdf2_timestep_type + private + logical(kind=l_def) :: use_moisture + logical(kind=l_def) :: output_cld_incs + ! holds the latest estimate of the prognostic fields through the timestep + type(field_type), allocatable :: state(:) + ! prognostic fields at the start of timestep + type(field_type), allocatable :: state_n(:) + type(field_type), allocatable :: state_m(:) + type(field_type), allocatable :: state_q(:) + type(field_type), allocatable :: state_bdf(:) + + ! prognostic fields after slow physics, i.e. state_n + slow incs + type( field_type ), allocatable :: state_dag(:) + type( field_type ), allocatable :: state_to_adv(:) + type( field_type ), allocatable :: state_aft_adv(:) + type( field_type ), allocatable :: mr_n(:), mr_aft_adv(:) + type( field_type ), allocatable :: mr_dag(:), mr_bdf(:) + type( field_type ), allocatable :: rhs_n(:), rhs_np1(:), rhs_adv(:) + type( field_type ), allocatable :: rhs_bdf(:), rhs_m(:) + type( field_type ), allocatable :: adv_inc_prev(:) + type( field_type ), allocatable :: rhs_phys(:), rhs_lbc(:) + type( field_type ) :: dtheta, dtheta_cld ! increment to theta + type( field_type ) :: du ! increment to u + type( field_type ) :: wind_prev ! u from previous iteration used for cheap transport update + type( r_tran_field_type ) :: total_dry_flux + + contains + private + + procedure, public :: step => tr_bdf2_alg_step + procedure, public :: finalise => tr_bdf2_alg_final + procedure, nopass :: run_init + procedure, nopass :: run_step + + end type tr_bdf2_timestep_type + + ! Constructor for type + interface tr_bdf2_timestep_type + module procedure tr_bdf2_alg_init + end interface tr_bdf2_timestep_type + +contains + + !> Extracts data from modeldb to prepare for initialising object + !> @param[in] modeldb Holds the model state + function tr_bdf2_alg_init(modeldb) result(self) + implicit none + + type(tr_bdf2_timestep_type) :: self + type(modeldb_type), target, intent(in) :: modeldb + + + type(field_collection_type), pointer :: prognostic_fields + type(field_collection_type), pointer :: moisture_fields + + type(field_type), pointer :: u + type(field_type), pointer :: rho + type(field_type), pointer :: theta + type(field_type), pointer :: exner + type(field_array_type), pointer :: mr_array + type(field_type), pointer :: mr(:) + class(model_clock_type), pointer :: model_clock + + ! Get pointer to clock to use downstream + model_clock => modeldb%clock + + ! Get pointers to field collections for use downstream + prognostic_fields => modeldb%fields%get_field_collection("prognostic_fields") + + ! Get pointers to fields in the prognostic/diagnostic field collections + ! for use downstream + call prognostic_fields%get_field('theta', theta) + call prognostic_fields%get_field('u', u) + call prognostic_fields%get_field('rho', rho) + call prognostic_fields%get_field('exner', exner) + + moisture_fields => modeldb%fields%get_field_collection("moisture_fields") + call moisture_fields%get_field("mr", mr_array) + mr => mr_array%bundle + + ! Run the initialisation process + call run_init( & + self, u, rho, theta, exner, mr, prognostic_fields, & + moisture_fields, model_clock & + ) + + end function tr_bdf2_alg_init + + !> Extracts data from input objects to prepare for running timestep + !> @param[in] modeldb The gungho model data object + subroutine tr_bdf2_alg_step(self, modeldb) + + implicit none + + class(tr_bdf2_timestep_type), intent(inout) :: self + type(modeldb_type), target, intent(in) :: modeldb + + type(mesh_type), pointer :: mesh + type(mesh_type), pointer :: twod_mesh + + class(model_clock_type), pointer :: model_clock + type(io_value_type), pointer :: temp_corr_io_value + + type(field_collection_type), pointer :: prognostic_fields + type(field_collection_type), pointer :: moisture_fields + type(field_type), pointer :: u + type(field_type), pointer :: rho + type(field_type), pointer :: theta + type(field_type), pointer :: exner + type(field_array_type), pointer :: mr_array + type(field_type), pointer :: mr(:) + type(field_array_type), pointer :: moist_dyn_array + type(field_type), pointer :: moist_dyn(:) + + type(field_collection_type), pointer :: adv_tracer_all_outer + type(field_collection_type), pointer :: adv_tracer_last_outer + type(field_collection_type), pointer :: con_tracer_all_outer + type(field_collection_type), pointer :: con_tracer_last_outer + type(field_collection_type), pointer :: derived_fields + type(field_collection_type), pointer :: radiation_fields + type(field_collection_type), pointer :: microphysics_fields + type(field_collection_type), pointer :: electric_fields + type(field_collection_type), pointer :: orography_fields + type(field_collection_type), pointer :: turbulence_fields + type(field_collection_type), pointer :: convection_fields + type(field_collection_type), pointer :: cloud_fields + type(field_collection_type), pointer :: surface_fields + type(field_collection_type), pointer :: soil_fields + type(field_collection_type), pointer :: snow_fields + type(field_collection_type), pointer :: chemistry_fields + type(field_collection_type), pointer :: aerosol_fields + type(field_collection_type), pointer :: stph_fields + type(field_collection_type), pointer :: lbc_fields + + real(r_def) :: dt + real(r_def) :: dtemp_encorr + + ! Get pointers to field collections for use downstream + prognostic_fields => modeldb%fields%get_field_collection("prognostic_fields") + model_clock => modeldb%clock + + ! Get pointers to fields for use downstream + call prognostic_fields%get_field('theta', theta) + call prognostic_fields%get_field('u', u) + call prognostic_fields%get_field('rho', rho) + call prognostic_fields%get_field('exner', exner) + + ! Get timestep parameters from clock + dt = real(model_clock%get_seconds_per_step(), r_def) + + moisture_fields => modeldb%fields%get_field_collection("moisture_fields") + lbc_fields => modeldb%fields%get_field_collection("lbc_fields") + radiation_fields => modeldb%fields%get_field_collection("radiation_fields") + call moisture_fields%get_field("mr", mr_array) + mr => mr_array%bundle + call moisture_fields%get_field("moist_dyn", moist_dyn_array) + moist_dyn => moist_dyn_array%bundle + + ! Get the mesh from one of the fields + mesh => theta%get_mesh() + twod_mesh => mesh_collection%get_mesh(mesh, TWOD) + + adv_tracer_all_outer => modeldb%fields%get_field_collection("adv_tracer_all_outer") + adv_tracer_last_outer => modeldb%fields%get_field_collection("adv_tracer_last_outer") + con_tracer_all_outer => modeldb%fields%get_field_collection("con_tracer_all_outer") + con_tracer_last_outer => modeldb%fields%get_field_collection("con_tracer_last_outer") + derived_fields => modeldb%fields%get_field_collection("derived_fields") + microphysics_fields => modeldb%fields%get_field_collection("microphysics_fields") + turbulence_fields => modeldb%fields%get_field_collection("turbulence_fields") + convection_fields => modeldb%fields%get_field_collection("convection_fields") + cloud_fields => modeldb%fields%get_field_collection("cloud_fields") + surface_fields => modeldb%fields%get_field_collection("surface_fields") + soil_fields => modeldb%fields%get_field_collection("soil_fields") + snow_fields => modeldb%fields%get_field_collection("snow_fields") + chemistry_fields => modeldb%fields%get_field_collection("chemistry_fields") + aerosol_fields => modeldb%fields%get_field_collection("aerosol_fields") + stph_fields => modeldb%fields%get_field_collection("stph_fields") + electric_fields => modeldb%fields%get_field_collection("electric_fields") + orography_fields => modeldb%fields%get_field_collection("orography_fields") + + temp_corr_io_value => get_io_value( modeldb%values, 'temperature_correction_io_value') + ! Get temperature increment for energy correction + dtemp_encorr = dt * temp_corr_io_value%data(1) + + ! Run the timestep + call run_step( & + self, modeldb, u, rho, theta, exner, mr, moist_dyn, & + adv_tracer_all_outer, adv_tracer_last_outer, & + con_tracer_all_outer, con_tracer_last_outer, & + prognostic_fields, moisture_fields, & + derived_fields, radiation_fields, microphysics_fields, & + electric_fields, orography_fields, turbulence_fields, & + convection_fields, cloud_fields, surface_fields, soil_fields, & + snow_fields, chemistry_fields, aerosol_fields, stph_fields, & + lbc_fields, & + model_clock, dtemp_encorr, mesh, twod_mesh & + ) + + end subroutine tr_bdf2_alg_step + + !> @details Initialisation procedure for the timestepping algorithm + !> Initialises various internal fields + !> @param[in,out] u 3D wind field + !> @param[in,out] rho Density + !> @param[in,out] theta Potential temperature + !> @param[in,out] exner Exner pressure + !> @param[in,out] mr Mixing ratios + !> @param[in,out] prognostic_fields Prognostic field collection + !> @param[in,out] moisture_fields Moisture field collection + !> @param[in] model_clock Time in the model. + subroutine run_init(self, u, rho, theta, exner, mr, prognostic_fields, moisture_fields, model_clock) + + implicit none + + type(tr_bdf2_timestep_type), intent(inout) :: self + + ! Prognostic fields + type( field_type ), intent( in ) :: u, rho, theta, exner + type( field_type ), intent( in ), optional :: mr(:) + + ! field groups + type( field_collection_type ), intent( inout ) :: prognostic_fields + type( field_collection_type ), intent( inout ) :: moisture_fields + + ! Clock + class(model_clock_type), intent(in) :: model_clock + + ! Mesh + type(mesh_type), pointer :: mesh + + ! Reference fields + type( field_type ), pointer :: rho_ref, theta_ref, exner_ref + + ! Reference moist dynamics factors + type( field_array_type ), pointer :: moist_dyn_ref_array + type( field_type ), pointer :: moist_dyn_ref(:) + + + ! Timestep + real(kind=r_def) :: dt + + ! Reset frequency of semi-implicit operators + integer(kind=i_def) :: reference_reset_freq + + ! Get the mesh from one of the fields + mesh => theta%get_mesh() + + !-------------------------------------------------------------------- + ! Allocate internal state field arrays + !-------------------------------------------------------------------- + allocate(self%state(bundle_size)) + allocate(self%state_n(bundle_size)) + allocate(self%state_m(bundle_size)) + allocate(self%state_q(bundle_size)) + allocate(self%state_bdf(bundle_size)) + allocate(self%state_dag(bundle_size)) + allocate(self%state_to_adv(bundle_size)) + allocate(self%state_aft_adv(bundle_size)) + allocate(self%rhs_n(bundle_size)) + allocate(self%rhs_m(bundle_size)) + allocate(self%rhs_bdf(bundle_size)) + allocate(self%rhs_np1(bundle_size)) + allocate(self%rhs_adv(bundle_size)) + allocate(self%adv_inc_prev(bundle_size)) + allocate(self%rhs_phys(bundle_size)) + allocate(self%rhs_lbc(bundle_size)) + allocate(self%mr_n(nummr)) + allocate(self%mr_bdf(nummr)) + allocate(self%mr_dag(nummr)) + allocate(self%mr_aft_adv(nummr)) + + self%use_moisture = ( moisture_formulation /= moisture_formulation_dry ) + self%output_cld_incs = ( & + self%use_moisture .and. write_diag .and. use_xios_io & + ) + + !-------------------------------------------------------------------------- + ! Initialise internal state field objects + !--------------------------------------------------------------------------- + + call u%copy_field_properties(self%state(igh_u) ) + call theta%copy_field_properties(self%state(igh_t) ) + call rho%copy_field_properties(self%state(igh_d) ) + call exner%copy_field_properties(self%state(igh_p) ) + + call clone_bundle(self%state, self%state_n, bundle_size) + call clone_bundle(self%state, self%state_m, bundle_size) + call clone_bundle(self%state, self%state_q, bundle_size) + call clone_bundle(self%state, self%state_dag, bundle_size) + call clone_bundle(self%state, self%state_bdf, bundle_size) + call clone_bundle(self%state, self%state_to_adv, bundle_size) + call clone_bundle(self%state, self%state_aft_adv, bundle_size) + call clone_bundle(self%state, self%rhs_n, bundle_size) + call clone_bundle(self%state, self%rhs_m, bundle_size) + call clone_bundle(self%state, self%rhs_bdf, bundle_size) + call clone_bundle(self%state, self%rhs_np1, bundle_size) + call clone_bundle(self%state, self%rhs_adv, bundle_size) + call clone_bundle(self%state, self%rhs_phys, bundle_size) + call clone_bundle(self%state, self%rhs_lbc, bundle_size) + call clone_bundle(self%state, self%adv_inc_prev, bundle_size) + + call theta%copy_field_properties(self%dtheta) + call theta%copy_field_properties(self%dtheta_cld) + call invoke(setval_c(self%dtheta_cld, 0.0_r_def)) + call u%copy_field_properties(self%du) + call u%copy_field_properties(self%wind_prev) + + call self%total_dry_flux%initialise( u%get_function_space() ) + + call clone_bundle(mr, self%mr_n, nummr) + call clone_bundle(mr, self%mr_dag, nummr) + call clone_bundle(mr, self%mr_bdf, nummr) + if (self%use_moisture) then + call clone_bundle(mr, self%mr_aft_adv, nummr) + else + call set_bundle_scalar(0.0_r_def, self%mr_n, nummr) + call set_bundle_scalar(0.0_r_def, self%mr_dag, nummr) + call set_bundle_scalar(0.0_r_def, self%mr_bdf, nummr) + end if + + ! ------------------------------------------------------------------------ ! + ! Initialise the physics increments to 0 + ! ------------------------------------------------------------------------ ! + call set_bundle_scalar(0.0_r_def, self%rhs_phys, bundle_size) + + ! ------------------------------------------------------------------------ ! + ! Operators for si solves + ! ------------------------------------------------------------------------ ! + call create_si_operators(mesh, stepper_tr) + call create_si_operators(mesh, stepper_bdf2) + + ! If using checkpointed reference state, then calculate semi-implicit + ! operators using the checkpointed reference state + dt = real(model_clock%get_seconds_per_step(), r_def) + reference_reset_freq = nint(reference_reset_time / dt, i_def) + if (mod(model_clock%get_first_step()-1, reference_reset_freq) /= 0) then + call moisture_fields%get_field("moist_dyn_ref", moist_dyn_ref_array) + moist_dyn_ref => moist_dyn_ref_array%bundle + call prognostic_fields%get_field('theta_ref', theta_ref) + call prognostic_fields%get_field('rho_ref', rho_ref) + call prognostic_fields%get_field('exner_ref', exner_ref) + + ! Compute TR and BDF2 operators (only one call needed) + call compute_si_operators( & + theta_ref, rho_ref, exner_ref, model_clock, moist_dyn_ref, & + stepper_tr & + ) + call compute_si_operators( & + theta_ref, rho_ref, exner_ref, model_clock, moist_dyn_ref, & + stepper_bdf2 & + ) + nullify(theta_ref, rho_ref, exner_ref, moist_dyn_ref, moist_dyn_ref_array) + end if + + if (use_wavedynamics) then + call gungho_transport_control_alg_init( mesh ) + + ! Construct semi-implicit solver + call semi_implicit_solver_alg_init(self%state, stepper_tr) + call semi_implicit_solver_alg_init(self%state, stepper_bdf2) + end if + + nullify(mesh) + + call log_event( "tr_bdf2_timestep: initialised timestepping algorithm", LOG_LEVEL_INFO ) + + end subroutine run_init + + !> @details The control algorithm for the TR-BDF2 timestepper. This is a three + !! time-level scheme that consists of two phases: the Trapezoidal + !! (TR) step and the Backward-Difference (BDF2) step, each of which + !! involves an implicit method that is solved with a Quasi-Newton + !! method. + !> @param[in] modeldb Holds the model state + !> @param[in,out] u 3D wind field + !> @param[in,out] rho Density + !> @param[in,out] theta Potential temperature + !> @param[in,out] exner Exner pressure + !> @param[in,out] mr Mixing ratios + !> @param[in,out] moist_dyn Factors for moist dynamics + !> @param[in,out] adv_tracer_all_outer Group of fields to be advected + !> @param[in,out] adv_tracer_last_outer Group of fields to be advected + !> @param[in,out] con_tracer_all_outer Second group of fields to be advected + !> @param[in,out] con_tracer_last_outer Second group of fields to be advected + !> @param[in,out] prognostic_fields Prognostic field collection + !> @param[in,out] moisture_fields Moisture field collection + !> @param[in,out] derived_fields Group of derived fields + !> @param[in,out] radiation_fields Fields for radiation scheme + !> @param[in,out] microphysics_fields Fields for mphys scheme + !> @param[in,out] electric_fields Fields for electric (lighting) scheme + !> @param[in] orography_fields Fields for orog drag scheme + !> @param[in,out] turbulence_fields Fields for turbulence scheme + !> @param[in,out] convection_fields Fields for convection scheme + !> @param[in,out] cloud_fields Fields for cloud scheme + !> @param[in,out] surface_fields Fields for surface scheme + !> @param[in,out] soil_fields Fields for soil hydrology scheme + !> @param[in,out] snow_fields Fields for snow scheme + !> @param[in,out] chemistry_fields Fields for chemistry scheme + !> @param[in,out] aerosol_fields Fields for aerosol scheme + !> @param[in,out] stph_fields Fields for stohcastic physics schemes + !> @param[in,out] lbc_fields Fields for lateral boundaries + !> @param[in] model_clock Time in the model. + !> @param[in] dtemp_encorr Temperature increment for energy + !> correction + !> @param[in] mesh The current mesh + !> @param[in] twod_mesh The current 2d mesh + subroutine run_step( & + self, modeldb, u, rho, theta, exner, mr, moist_dyn, & + adv_tracer_all_outer, adv_tracer_last_outer, & + con_tracer_all_outer, con_tracer_last_outer, & + prognostic_fields, moisture_fields, derived_fields, & + radiation_fields, microphysics_fields, electric_fields, & + orography_fields, turbulence_fields, convection_fields, & + cloud_fields, surface_fields, soil_fields, snow_fields, & + chemistry_fields, aerosol_fields, stph_fields, lbc_fields, & + model_clock, dtemp_encorr, mesh, twod_mesh & + ) + + implicit none + + ! Arguments + type(tr_bdf2_timestep_type), target, intent(inout) :: self + type(modeldb_type), target, intent(in) :: modeldb + + type(field_type), intent(inout) :: u, rho, theta, exner + type(field_type), intent(inout) :: mr(nummr) + type(field_type), intent(inout) :: moist_dyn(num_moist_factors) + + type(field_collection_type), intent(inout) :: adv_tracer_all_outer + type(field_collection_type), intent(inout) :: adv_tracer_last_outer + type(field_collection_type), intent(inout) :: con_tracer_all_outer + type(field_collection_type), intent(inout) :: con_tracer_last_outer + type(field_collection_type), intent(inout) :: prognostic_fields + type(field_collection_type), intent(inout) :: moisture_fields + type(field_collection_type), intent(inout) :: derived_fields + type(field_collection_type), intent(inout) :: radiation_fields + type(field_collection_type), intent(inout) :: microphysics_fields + type(field_collection_type), intent(inout) :: electric_fields + type(field_collection_type), intent(in) :: orography_fields + type(field_collection_type), intent(inout) :: turbulence_fields + type(field_collection_type), intent(inout) :: convection_fields + type(field_collection_type), intent(inout) :: cloud_fields + type(field_collection_type), intent(inout) :: surface_fields + type(field_collection_type), intent(inout) :: soil_fields + type(field_collection_type), intent(inout) :: snow_fields + type(field_collection_type), intent(inout) :: chemistry_fields + type(field_collection_type), intent(inout) :: aerosol_fields + type(field_collection_type), intent(inout) :: stph_fields + type(field_collection_type), intent(inout) :: lbc_fields + + class(model_clock_type), intent(in) :: model_clock + real(kind=r_def), intent(in) :: dtemp_encorr + type(mesh_type), pointer, intent(in) :: mesh + type(mesh_type), pointer, intent(in) :: twod_mesh + + ! Internal variables + ! Reference fields + type(field_type), pointer :: rho_ref + type(field_type), pointer :: theta_ref + type(field_type), pointer :: exner_ref + type(field_type), pointer :: moist_dyn_ref(:) + type(field_array_type), pointer :: moist_dyn_ref_array + + ! Moisture field to transport + type(field_type), pointer :: mr_to_adv(:) + + type(field_type) :: dcfl_tot, dcff_tot, dbcf_tot + type(field_type) :: dcfl_adv, dcff_adv, dbcf_adv + character(str_def), parameter :: sec_tot='processed' + character(str_def), parameter :: suffix_tot='tot' + character(str_def), parameter :: sec_adv='advection' + character(str_def), parameter :: suffix_adv='adv' + + type(field_type), pointer :: ageofair + type(operator_type), pointer :: mm_wt + type(operator_type), pointer :: mm_vel + + integer(kind=i_def) :: outer, inner, reference_reset_freq + + ! Density field used for moisture conservation diagnostics and predictor + logical(kind=l_def) :: write_moisture_diag + + ! Fields after slow physics to be advected (i.e. field_n + slow phys inc) + type(field_collection_type) :: adv_tracer_all_outer_dag + type(field_collection_type) :: adv_tracer_last_outer_dag + type(field_collection_type) :: con_tracer_all_outer_dag + type(field_collection_type) :: con_tracer_last_outer_dag + + ! Reference fields are checkpointed + logical(kind=l_def) :: checkpoint_reference_fields + + ! Namelist parameters + type(namelist_type), pointer :: base_mesh_nml + type(namelist_type), pointer :: initialization_nml + type(namelist_type), pointer :: microphysics_nml + type(namelist_type), pointer :: aerosol_nml + type(namelist_type), pointer :: timestepping_nml + + character(len=str_def) :: prime_mesh_name + integer(kind=i_def) :: lbc_option + logical(kind=l_def) :: microphysics_casim + logical(kind=l_def) :: murk_lbc + logical(kind=l_def) :: fast_smagorinsky + logical(kind=l_def) :: to_blend_lbc + logical(kind=l_def) :: calc_phys_predictors + real(kind=r_def) :: tau_r + real(kind=r_def) :: dt + + integer(kind=i_def), allocatable :: tr_inner_iterations(:) + + if ( subroutine_timers ) call timer('tr_bdf2_timestep_alg') + + allocate(tr_inner_iterations(tr_outer_iterations)) + + if (MOD(model_clock%get_step(), 2) == 0) then + tr_inner_iterations = tr_inner_iterations_even + else + tr_inner_iterations = tr_inner_iterations_odd + end if + + ! Set timestep variables + dt = real(model_clock%get_seconds_per_step(), r_def) + + if (limited_area .and. use_wavedynamics) then + base_mesh_nml => modeldb%configuration%get_namelist('base_mesh') + initialization_nml => modeldb%configuration%get_namelist('initialization') + timestepping_nml => modeldb%configuration%get_namelist('timestepping') + + call base_mesh_nml%get_value( 'prime_mesh_name', prime_mesh_name ) + call initialization_nml%get_value( 'lbc_option', lbc_option ) + call timestepping_nml%get_value( 'tau_r', tau_r ) + + if (lbc_option == lbc_option_um2lfric_file) then + aerosol_nml => modeldb%configuration%get_namelist('aerosol') + call aerosol_nml%get_value( 'murk_lbc', murk_lbc ) + end if + end if + if (lbc_option == lbc_option_um2lfric_file .or. & + (use_physics .and. cloud == cloud_um)) then + microphysics_nml => modeldb%configuration%get_namelist('microphysics') + call microphysics_nml%get_value('microphysics_casim', microphysics_casim) + end if + + if (element_order_h == 0 .and. element_order_v == 0) then + ! Lowest order so use finite volume constants + mm_wt => get_mass_matrix_fv(Wtheta, mesh%get_id()) + mm_vel => get_mass_matrix_fv(W2, mesh%get_id()) + else + mm_wt => get_mass_matrix_fe(Wtheta, mesh%get_id()) + mm_vel => get_mass_matrix_fe(W2, mesh%get_id()) + end if + + !--------------------------------------------------------------------------- + ! Copy prognostic field data to state arrays + !--------------------------------------------------------------------------- + call invoke( & + name="copy_init_fields_to_state", & + setval_X(self%state(igh_u), u ), & + setval_X(self%state(igh_t), theta), & + setval_X(self%state(igh_d), rho), & + setval_X(self%state(igh_p), exner), & + setval_c(self%total_dry_flux, 0.0_r_tran) & + ) + + call copy_bundle(self%state, self%state_n, bundle_size) + call copy_bundle(self%state, self%state_m, bundle_size) + call copy_bundle(self%state, self%state_dag, bundle_size) + if (self%use_moisture) then + call copy_bundle(mr, self%mr_n, nummr) + call copy_bundle(mr, self%mr_dag, nummr) + end if + + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_DEBUG, 'state_n u', self%state_n(igh_u)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'state_n rho', self%state_n(igh_d)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'state_n theta', self%state_n(igh_t)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'state_n exner', self%state_n(igh_p)) + + ! ======================================================================== ! + ! SLOW PHYSICS + ! ======================================================================== ! + + if (use_physics) then + if (self%output_cld_incs) then + call cld_incs_init( & + cloud_fields, dcfl_tot, dcff_tot, dbcf_tot, sec_tot, suffix_tot & + ) + end if + + call slow_physics( & + modeldb, self%du, self%dtheta, self%mr_dag, & + self%state_n(igh_t), self%state_n(igh_u), self%state_n(igh_d), & + self%state_n(igh_p), moist_dyn, self%mr_n, & + derived_fields, radiation_fields, microphysics_fields, & + electric_fields, orography_fields, turbulence_fields, & + convection_fields, cloud_fields, surface_fields, soil_fields, & + snow_fields, chemistry_fields, aerosol_fields, model_clock, & + dt, dtemp_encorr, mesh, twod_mesh & + ) + + call invoke( & + name="update_from_slow_physics", & + inc_X_plus_Y(self%state_dag(igh_t), self%dtheta), & + inc_X_plus_Y(self%state_dag(igh_u), self%du) & + ) + ! mr_dag is already updated in slow_physics + + if (self%output_cld_incs) then + call cld_incs_init( & + cloud_fields, dcfl_adv, dcff_adv, dbcf_adv, sec_adv, suffix_adv & + ) + end if + end if ! use_physics + + call conditional_collection_copy( & + adv_tracer_all_outer_dag, generic_fields_to_copy=adv_tracer_all_outer, & + field_list=adv_tracer_all_outer & + ) + call conditional_collection_copy( & + adv_tracer_last_outer_dag, & + generic_fields_to_copy=adv_tracer_last_outer, & + field_list=adv_tracer_last_outer & + ) + call conditional_collection_copy( & + con_tracer_all_outer_dag, generic_fields_to_copy=con_tracer_all_outer, & + field_list=con_tracer_all_outer & + ) + call conditional_collection_copy( & + con_tracer_last_outer_dag, & + generic_fields_to_copy=con_tracer_last_outer, & + field_list=con_tracer_last_outer & + ) + + ! ======================================================================== ! + ! DYNAMICS -- TRAPEZOIDAL STEP + ! ======================================================================== ! + + ! X^m + gamma*dt*F[X^m] = T[X^dag - gamma*dt*F[X^n]] + + ! ------------------------------------------------------------------------ ! + ! Compute the semi-implicit operators + ! ------------------------------------------------------------------------ ! + ! Reset the reference state in the semi-implicit operators using the latest + ! value of the state. This occurs every n timesteps, where n is calculated + ! as reference_reset_time divided by dt. + ! The reference_reset_time is specified in the configuration namelist. + ! Note that this reset can only occur at most once per timestep. + reference_reset_freq = nint(reference_reset_time / dt, i_def) + + if (mod(model_clock%get_step()-1, reference_reset_freq) == 0) then + ! Compute semi-implicit operators with current model state + call compute_si_operators( & + self%state(igh_t), self%state(igh_d), self%state(igh_p), & + model_clock, moist_dyn, stepper_tr & + ) + call compute_si_operators( & + self%state(igh_t), self%state(igh_d), self%state(igh_p), & + model_clock, moist_dyn, stepper_bdf2 & + ) + + checkpoint_reference_fields = ( & + mod(model_clock%get_first_step()-1, reference_reset_freq) /= 0 .or. & + mod(model_clock%get_last_step(), reference_reset_freq) /= 0 & + ) + + if (checkpoint_read .or. init_option == init_option_checkpoint_dump) then + ! If the first timestep of this run IS an operator calc timestep, but + ! the first timestep of the next run IS NOT, then checkpoint_flag + ! must be false to allow model to start running, as the operator + ! prognostics will not be in the initial dump + if (mod(model_clock%get_first_step()-1, reference_reset_freq) == 0 & + .and. mod(model_clock%get_last_step(), reference_reset_freq) /= 0) then + checkpoint_reference_fields = .false. + end if + end if + + ! Copy over model state for checkpointing if required + if (checkpoint_reference_fields) then + call prognostic_fields%get_field('theta_ref', theta_ref) + call prognostic_fields%get_field('rho_ref', rho_ref) + call prognostic_fields%get_field('exner_ref', exner_ref) + call moisture_fields%get_field("moist_dyn_ref", moist_dyn_ref_array) + moist_dyn_ref => moist_dyn_ref_array%bundle + call copy_bundle(moist_dyn, moist_dyn_ref, num_moist_factors) + call invoke( & + setval_X(theta_ref, self%state(igh_t)), & + setval_X(rho_ref, self%state(igh_d)), & + setval_X(exner_ref, self%state(igh_p)) & + ) + end if + end if + + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_DEBUG, 'state_dag u', self%state_dag(igh_u)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'state_dag rho', self%state_dag(igh_d)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'state_dag theta', self%state_dag(igh_t)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'state_dag exner', self%state_dag(igh_p)) + + ! ------------------------------------------------------------------------ ! + ! Forcings: time-level n + ! ------------------------------------------------------------------------ ! + + ! rhs_n = M[X^dag - gamma*dt*F[X^n]] + call rhs_alg( & + self%rhs_n, gamma*dt, self%state_dag, self%state_n, moist_dyn, & + compute_eos=.false., compute_rhs_t_d=.true., dlayer_rhs=.false., & + stepper_name=stepper_tr, model_clock=model_clock & + ) + + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: rhs_n u', self%rhs_n(igh_u)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: rhs_n rho', self%rhs_n(igh_d)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: rhs_n theta', self%rhs_n(igh_t)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: rhs_n exner', self%rhs_n(igh_p)) + + ! ======================================================================== ! + ! Outer dynamics loop + ! ======================================================================== ! + + ! Transported variables are set to those after slow physics + call copy_bundle(self%state_dag, self%state_to_adv, bundle_size) + mr_to_adv => self%mr_dag + + ! Set predictors for transport + call predictors_alg( & + self%state_to_adv, self%state_n(igh_u), self%rhs_n(igh_u), & + gamma, model_clock & + ) + + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: state_to_adv u', self%state_to_adv(igh_u)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: state_to_adv rho', self%state_to_adv(igh_d)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: state_to_adv theta', self%state_to_adv(igh_t)) + + outer_tr_loop: do outer = 1, tr_outer_iterations + + if (use_wavedynamics) then + + ! -------------------------------------------------------------------- ! + ! Transport + ! -------------------------------------------------------------------- ! + ! Transport state_dag & mr_dag: put results in rhs_adv & mr + ! Transporting wind is 0.5*(u^n + u^m) + call gungho_transport_control_alg( & + self%rhs_adv, self%state_to_adv, self%state_m(igh_u), & + self%state_n(igh_u), mr, mr_to_adv, model_clock, & + outer, stepper_tr, cheap_update=.false., & + rho_d_n=self%state_dag(igh_d), & + rho_d_n_start=self%state_dag(igh_d), & + total_dry_flux=self%total_dry_flux & + ) + + if (outer == tr_outer_iterations) then + ! Store the transported state for the BDF2 step + ! Need mass matrix solve on u: + call mass_matrix_solver_alg(self%du, self%rhs_adv(igh_u)) + call invoke( & + X_plus_Y( & + self%state_aft_adv(igh_u), self%du, self%state_to_adv(igh_u) & + ), & + X_plus_Y( & + self%state_aft_adv(igh_t), self%rhs_adv(igh_t), & + self%state_to_adv(igh_t) & + ), & + X_plus_Y( & + self%state_aft_adv(igh_d), self%rhs_adv(igh_d), & + self%state_to_adv(igh_d) & + ), & + X_plus_Y( & + self%state_aft_adv(igh_p), self%rhs_adv(igh_p), & + self%state_to_adv(igh_p) & + ) & + ) + + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: state_aft_adv u', self%state_aft_adv(igh_u)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: state_aft_adv rho', self%state_aft_adv(igh_d)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: state_aft_adv theta', self%state_aft_adv(igh_t)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: state_aft_adv exner', self%state_aft_adv(igh_p)) + end if + + ! Convert theta increment to weak form + call invoke( & + setval_X(self%dtheta, self%rhs_adv(igh_t)), & + setval_c(self%rhs_adv(igh_t), 0.0_r_def), & + dg_inc_matrix_vector_kernel_type( & + self%rhs_adv(igh_t), self%dtheta, mm_wt & + ) & + ) + + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: rhs_adv u', self%rhs_adv(igh_u)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: rhs_adv rho', self%rhs_adv(igh_d)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: rhs_adv theta', self%rhs_adv(igh_t)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: rhs_adv exner', self%rhs_adv(igh_p)) + + else ! No wavedynamics + if (self%use_moisture) call copy_bundle(self%mr_dag, mr, nummr) + call set_bundle_scalar(0.0_r_def, self%rhs_adv, bundle_size) + call copy_bundle(self%state_dag, self%state_aft_adv, bundle_size) + end if + + ! Update the moisture after transport (mr_aft_adv) + if (self%use_moisture) call copy_bundle(mr, self%mr_aft_adv, nummr) + + ! ====================================================================== ! + ! Inner dynamics loop + ! ====================================================================== ! + if (use_wavedynamics) then + + inner_tr_loop: do inner = 1, tr_inner_iterations(outer) + write( log_scratch_space, '(A,2I3)' ) & + 'TR loop indices (o, i): ', outer, inner + call log_event( log_scratch_space, LOG_LEVEL_INFO ) + + ! -------------------------------------------------------------------- + ! Forcings: time-level m + ! -------------------------------------------------------------------- + call rhs_alg( & + self%rhs_m, -gamma*dt, self%state_m, self%state_m, moist_dyn, & + compute_eos=.true., compute_rhs_t_d=(inner==1), & + dlayer_rhs=dlayer_on, stepper_name=stepper_tr, & + model_clock=model_clock & + ) + + !--------------------------------------------------------------------- + ! LAM LBCs and RHS + !--------------------------------------------------------------------- + if (limited_area .and. inner == 1 .and. outer == 1) then + call lam_solver_lbc( & + self%state_m(igh_u), lbc_fields, prime_mesh_name & + ) + call calc_rhs_lbc( & + self%rhs_lbc, lbc_fields, model_clock, prime_mesh_name, & + tau_r, stepper_tr, subroutine_timers & + ) + end if + + !--------------------------------------------------------------------- + ! Compute the residuals + !--------------------------------------------------------------------- + ! Add on advective terms: rhs = rhs_n - rhs_m + rhs_adv + ! (reuse rhs_m for rhs) + call bundle_axpy( & + -1.0_r_def, self%rhs_m, self%rhs_n, self%rhs_m, bundle_size & + ) + call add_bundle(self%rhs_m, self%rhs_adv, self%rhs_m, bundle_size) + + if (limited_area) then + if (inner == 1 .and. outer == 1) then + ! Add on the RHS for LBCs + call add_bundle(self%rhs_m, self%rhs_lbc, self%rhs_m, bundle_size) + end if + ! Apply masks to RHS + call apply_mask_rhs(self%rhs_m, prime_mesh_name) + end if + + ! Accelerators for inner loop convergence + if (inner > 1) then + call invoke( setval_c(self%rhs_m(igh_d), 0.0_r_def), & + setval_c(self%rhs_m(igh_t), 0.0_r_def) ) + end if + + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: rhs_m u', self%rhs_m(igh_u)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: rhs_m rho', self%rhs_m(igh_d)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: rhs_m theta', self%rhs_m(igh_t)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: rhs_m exner', self%rhs_m(igh_p)) + + write_moisture_diag = ( & + self%use_moisture .and. write_conservation_diag & + .and. outer == tr_outer_iterations & + .and. inner == tr_outer_iterations & + ) + + !--------------------------------------------------------------------- + ! Solve system: A*inc = rhs_m, and increment state by inc + !--------------------------------------------------------------------- + call semi_implicit_solver_alg_step( & + self%state_m, self%rhs_m, moist_dyn(gas_law), mr, & + write_moisture_diag, first_iteration=(inner==1), & + stepper_name=stepper_tr & + ) + + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: state_m u', self%state_m(igh_u)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: state_m rho', self%state_m(igh_d)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: state_m theta', self%state_m(igh_t)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'TR: state_m exner', self%state_m(igh_p)) + + ! If not already done update factors for moist dynamics + if (self%use_moisture) then + call moist_dyn_factors_alg(moist_dyn, mr) + end if + + if (exner_from_eos) then + call derive_exner_from_eos(self%state_m, moist_dyn(gas_law)) + end if + + ! TODO: should there be any LAM blending here? + end do inner_tr_loop + end if ! use_wavedynamics + end do outer_tr_loop + + ! ======================================================================== ! + ! DYNAMICS -- BACKWARD-DIFFERENCE STEP + ! ======================================================================== ! + + ! X^{n+1} + gamma2*dt*F[X^{n+1}] = T[(1-gamma3)*X^q + gamma3*X^m] + ! where X^q = X_dag + X_aft_adv - X_to_adv + + ! First guess of X^{n+1} is X^m + call bundle_axpby( & + (1.0_r_def - 0.5_r_def/gamma), self%state_n, & + 0.5_r_def/gamma, self%state_m, & + self%state, bundle_size & + ) + + ! ------------------------------------------------------------------------ ! + ! Compute initial BDF state + ! ------------------------------------------------------------------------ ! + + ! X^q = X_dag + X_aft_adv - X_to_adv + call bundle_axpy( & + -1.0_r_def, self%state_to_adv, self%state_aft_adv, self%state_q, & + bundle_size & + ) + call add_bundle(self%state_q, self%state_dag, self%state_q, bundle_size) + + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: state_q u', self%state_q(igh_u)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: state_q rho', self%state_q(igh_d)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: state_q theta', self%state_q(igh_t)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: state_q exner', self%state_q(igh_p)) + + ! X_bdf = (1-gamma3)*X^q + gamma3*X^m + call bundle_axpby( & + (1.0_r_def - gamma3), self%state_q, gamma3, self%state_m, & + self%state_bdf, bundle_size & + ) + + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: state_bdf u', self%state_bdf(igh_u)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: state_bdf rho', self%state_bdf(igh_d)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: state_bdf theta', self%state_bdf(igh_t)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: state_bdf exner', self%state_bdf(igh_p)) + + ! Note that for mr, the value at the m-level is equal to that at the q-level + ! so we can just use mr as mr_bdf + call copy_bundle(mr, self%mr_bdf, nummr) + mr_to_adv => self%mr_bdf + + ! Compute BDF2 RHS, by multiplying by mass matrices + ! The pressure contribution is set to zero + call invoke( & + name="compute_rhs_bdf_from_state_bdf", & + setval_c(self%rhs_bdf(igh_u), 0.0_r_def), & + matrix_vector_kernel_type( & + self%rhs_bdf(igh_u), self%state_bdf(igh_u), mm_vel & + ), & + enforce_bc_kernel_type(self%rhs_bdf(igh_u)), & + dg_matrix_vector_kernel_type( & + self%rhs_bdf(igh_t), self%state_bdf(igh_t), mm_wt & + ), & + setval_X(self%rhs_bdf(igh_d), self%state_bdf(igh_d)), & + setval_c(self%rhs_bdf(igh_p), 0.0_r_def) & + ) + + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: rhs_bdf u', self%rhs_bdf(igh_u)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: rhs_bdf rho', self%rhs_bdf(igh_d)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: rhs_bdf theta', self%rhs_bdf(igh_t)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: rhs_bdf exner', self%rhs_bdf(igh_p)) + + ! ======================================================================== ! + ! Outer transport loop + ! ======================================================================== ! + + outer_bdf_loop: do outer = 1, bdf2_outer_iterations + + if (use_wavedynamics) then + + ! -------------------------------------------------------------------- ! + ! Transport + ! -------------------------------------------------------------------- ! + ! Transport state_bdf & mr_bdf: put results in rhs_adv & mr + ! Transporting wind is u^{n+1} + ! Here we also transport other fields using 0.5*(u^n + u^{n+1}) + call gungho_transport_control_alg( & + self%rhs_adv, self%state_bdf, self%state(igh_u), & + self%state_n(igh_u), mr, mr_to_adv, model_clock, & + outer, stepper_bdf2, & + cheap_update, self%adv_inc_prev, self%wind_prev, & + self%state_bdf(igh_d), self%state_dag(igh_d), & + self%total_dry_flux, & + adv_tracer_all_outer, adv_tracer_all_outer_dag, & + adv_tracer_last_outer, adv_tracer_last_outer_dag, & + con_tracer_all_outer, con_tracer_all_outer_dag, & + con_tracer_last_outer, con_tracer_last_outer_dag & + ) + + ! Convert theta increment to weak form + call invoke( & + setval_X(self%dtheta, self%rhs_adv(igh_t)), & + setval_c(self%rhs_adv(igh_t), 0.0_r_def), & + dg_inc_matrix_vector_kernel_type( & + self%rhs_adv(igh_t), self%dtheta, mm_wt & + ) & + ) + + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: rhs_adv u', self%rhs_adv(igh_u)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: rhs_adv rho', self%rhs_adv(igh_d)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: rhs_adv theta', self%rhs_adv(igh_t)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: rhs_adv exner', self%rhs_adv(igh_p)) + + ! ---------------------------------------------------------------------- + ! Forcings: time-level n+1 + ! ---------------------------------------------------------------------- + ! Used for fast physics predictors, so calculated here + call rhs_alg( & + self%rhs_np1, -gamma2*dt, self%state, self%state, moist_dyn, & + compute_eos=.true., compute_rhs_t_d=.true., dlayer_rhs=dlayer_on, & + stepper_name=stepper_bdf2, model_clock=model_clock & + ) + else ! No wavedynamics + call set_bundle_scalar(0.0_r_def, self%rhs_adv, bundle_size) + if (self%use_moisture) call copy_bundle(self%mr_dag, mr, nummr) + end if + + ! Update the moisture after transport (mr_aft_adv) + if (self%use_moisture) call copy_bundle(mr, self%mr_aft_adv, nummr) + + ! ====================================================================== ! + ! FAST PHYSICS + ! ====================================================================== ! + + if (use_physics) then + !----------------------------------------------------------------------- + ! Predictors + !----------------------------------------------------------------------- + calc_phys_predictors = ( & + blayer_placement == blayer_placement_fast .or. & + convection_placement == convection_placement_fast .or. & + stochastic_physics_placement == stochastic_physics_placement_fast & + ) + if (calc_phys_predictors) then + call calc_phys_predictors_alg( & + derived_fields, self%rhs_np1, self%rhs_adv, self%rhs_bdf, & + self%state, self%state_dag, lbc_fields, model_clock & + ) + end if + + if (outer == bdf2_outer_iterations .and. self%output_cld_incs) then + call cld_incs_output( & + cloud_fields, dcfl_adv, dcff_adv, dbcf_adv, sec_adv, suffix_adv & + ) + end if + + call fast_physics( & + self%du, self%dtheta, mr, self%state_n(igh_t), & + self%state_n(igh_d), self%state_n(igh_u), self%state_n(igh_p), & + self%mr_n, derived_fields, radiation_fields, microphysics_fields, & + orography_fields, turbulence_fields, convection_fields, & + cloud_fields, surface_fields, soil_fields, snow_fields, & + chemistry_fields, aerosol_fields, stph_fields, outer, & + model_clock, dt & + ) + + fast_smagorinsky = ( & + smagorinsky .and. & + smagorinsky_placement == smagorinsky_placement_outer & + ) + if (fast_smagorinsky) then + call smagorinsky_alg( & + self%dtheta, self%du, mr, self%state(igh_t), self%state(igh_u), & + derived_fields, self%state(igh_d), dt & + ) + end if + + if (use_wavedynamics) then + ! copy incs into rhs_phys, including multiplication by mass matrix + ! need to reset rhs_phys to 0 because matrix_vector_kernel_type + ! increments the field rather than over-writing it + call set_bundle_scalar(0.0_r_def, self%rhs_phys, bundle_size) + call invoke( & + name="update_rhs_phys_from_fast_physics", & + dg_inc_matrix_vector_kernel_type( & + self%rhs_phys(igh_t), self%dtheta, mm_wt & + ), & + matrix_vector_kernel_type( & + self%rhs_phys(igh_u), self%du, mm_vel), & + enforce_bc_kernel_type(self%rhs_phys(igh_u)) & + ) + end if + end if ! use_physics + + ! ====================================================================== ! + ! Inner dynamics loop + ! ====================================================================== ! + if (use_wavedynamics) then + + inner_bdf_loop: do inner = 1, bdf2_inner_iterations(outer) + write( log_scratch_space, '(A,2I3)' ) & + 'BDF loop indices (o, i): ', outer, inner + call log_event( log_scratch_space, LOG_LEVEL_INFO ) + + ! -------------------------------------------------------------------- + ! Forcings: time-level n+1 + ! -------------------------------------------------------------------- + if (inner > 1) then + call rhs_alg( & + self%rhs_np1, -gamma2*dt, self%state, self%state, moist_dyn, & + compute_eos=.true., compute_rhs_t_d=.false., & + dlayer_rhs=dlayer_on, stepper_name=stepper_bdf2, & + model_clock=model_clock & + ) + end if + + !--------------------------------------------------------------------- + ! LAM LBCs and RHS + !--------------------------------------------------------------------- + if (limited_area .and. inner == 1 .and. outer == 1) then + call lam_solver_lbc( & + self%state(igh_u), lbc_fields, prime_mesh_name & + ) + call calc_rhs_lbc( & + self%rhs_lbc, lbc_fields, model_clock, prime_mesh_name, & + tau_r, stepper_bdf2, subroutine_timers & + ) + end if + + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: rhs_np1 u', self%rhs_np1(igh_u)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: rhs_np1 rho', self%rhs_np1(igh_d)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: rhs_np1 theta', self%rhs_np1(igh_t)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: rhs_np1 exner', self%rhs_np1(igh_p)) + + !--------------------------------------------------------------------- + ! Compute the residuals + !--------------------------------------------------------------------- + ! Add on advective terms: rhs = rhs_bdf - rhs_np1 + rhs_adv + rhs_phys + ! (reuse rhs_np1 for rhs) + call bundle_axpy( & + -1.0_r_def, self%rhs_np1, self%rhs_bdf, self%rhs_np1, & + bundle_size & + ) + call add_bundle(self%rhs_np1, self%rhs_adv, self%rhs_np1, bundle_size) + call add_bundle(self%rhs_np1, self%rhs_phys, self%rhs_np1, bundle_size) + + if (limited_area) then + if (inner == 1 .and. outer == 1) then + ! Add on the RHS for LBCs + call add_bundle( & + self%rhs_np1, self%rhs_lbc, self%rhs_np1, bundle_size & + ) + end if + ! Apply masks to RHS + call apply_mask_rhs(self%rhs_np1, prime_mesh_name) + end if + + ! Accelerators for inner loop convergence + if (inner > 1) then + call invoke( setval_c(self%rhs_np1(igh_d), 0.0_r_def), & + setval_c(self%rhs_np1(igh_t), 0.0_r_def) ) + end if + + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: rhs_np1 u', self%rhs_np1(igh_u)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: rhs_np1 rho', self%rhs_np1(igh_d)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: rhs_np1 theta', self%rhs_np1(igh_t)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: rhs_np1 exner', self%rhs_np1(igh_p)) + + write_moisture_diag = ( & + self%use_moisture .and. write_conservation_diag & + .and. outer == bdf2_outer_iterations & + .and. inner == bdf2_outer_iterations & + ) + + !--------------------------------------------------------------------- + ! Solve system: A*inc = rhs_m, and increment state by inc + !--------------------------------------------------------------------- + call semi_implicit_solver_alg_step( & + self%state, self%rhs_np1, moist_dyn(gas_law), mr, & + write_moisture_diag, first_iteration=(inner==1), & + stepper_name=stepper_bdf2 & + ) + + ! If not already done update factors for moist dynamics + if (self%use_moisture) then + call moist_dyn_factors_alg(moist_dyn, mr) + end if + + if (exner_from_eos) then + call derive_exner_from_eos(self%state, moist_dyn(gas_law)) + end if + + ! TODO: to remove + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: state_np1 u', self%state(igh_u)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: state_np1 rho', self%state(igh_d)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: state_np1 theta', self%state(igh_t)) + call log_field_minmax(LOG_LEVEL_DEBUG, 'BDF: state_np1 exner', self%state(igh_p)) + + !--------------------------------------------------------------------- + ! LAM Overwrite and Blend LBCs + !--------------------------------------------------------------------- + if (limited_area) then + to_blend_lbc = ( & + blend_frequency == blend_frequency_inner .or. ( & + blend_frequency == blend_frequency_outer & + .and. inner == bdf2_inner_iterations(bdf2_outer_iterations) & + ) .or. ( & + blend_frequency == blend_frequency_final & + .and. inner == bdf2_inner_iterations(bdf2_outer_iterations) & + .and. outer == bdf2_outer_iterations & + ) & + ) + if (to_blend_lbc) then + call lam_blend_lbc( & + self%state(igh_u), self%state(igh_p), self%state(igh_d), & + self%state(igh_t), mr, lbc_fields, microphysics_fields, & + aerosol_fields, lbc_option, microphysics_casim, murk_lbc, & + moisture_formulation, prime_mesh_name & + ) + end if + end if + end do inner_bdf_loop + + else ! when use_wavedynamics=false, just add physics increments here + + call invoke( & + X_plus_Y(self%state(igh_t), self%state_dag(igh_t), self%dtheta), & + X_plus_Y(self%state(igh_u), self%state_dag(igh_u), self%du) & + ) + end if ! use_wavedynamics + end do outer_bdf_loop + + ! ======================================================================== ! + ! END-OF-STEP PHYSICS + ! ======================================================================== ! + + call adv_tracer_all_outer_dag%clear() + call adv_tracer_last_outer_dag%clear() + call con_tracer_all_outer_dag%clear() + call con_tracer_last_outer_dag%clear() + + if (transport_ageofair) then + call con_tracer_last_outer%get_field('ageofair', ageofair) + call ageofair_update(ageofair, model_clock) + end if + + !--------------------------------------------------------------------------- + ! Apply mixing + !--------------------------------------------------------------------------- + call mixing_alg( & + mr, self%state(igh_t), self%state(igh_u), derived_fields, & + self%state(igh_d), dt & + ) + + ! -------------------------------------------------------------------------- + ! Call cloud scheme to generate cloud and latent heating after pressure + ! changes are applied from the solver. + ! -------------------------------------------------------------------------- +#ifdef UM_PHYSICS + if (use_physics .and. cloud == cloud_um) then + call cld_alg( & + self%dtheta_cld, mr, self%state(igh_t), self%state(igh_p), & + self%state(igh_d), derived_fields, turbulence_fields, cloud_fields, & + convection_fields, self%state_n(igh_t), self%mr_n, & + model_clock%get_step(), dt, .false. & + ) + call invoke(inc_X_plus_Y(self%state(igh_t), self%dtheta_cld)) + if (microphysics_casim) then + call casim_activate_alg( & + self%state(igh_t), mr, derived_fields, cloud_fields, & + microphysics_fields, convection_fields, initialise=.false. & + ) + end if ! microphysics_casim + end if +#endif + + ! Update derived variables for time level n+1 + if (self%use_moisture) then + call moist_dyn_factors_alg(moist_dyn, mr) + end if + if (use_physics) then + call map_physics_fields_alg( & + self%state(igh_u), self%state(igh_p), self%state(igh_d), & + self%state(igh_t), moist_dyn, derived_fields & + ) + end if + + !---------------------------------------------------------------------------- + ! Call UKCA for GLOMAP-mode prognostic aerosol updates + !--------------------------------------------------------------------------- +#ifdef UM_PHYSICS + if (aerosol == aerosol_um .and. & + (glomap_mode == glomap_mode_ukca .or. & + glomap_mode == glomap_mode_dust_and_clim)) then + call aerosol_ukca_alg( & + chemistry_fields, aerosol_fields, radiation_fields, derived_fields, & + microphysics_fields, turbulence_fields, convection_fields, & + cloud_fields, surface_fields, soil_fields, self%state, mr, & + model_clock & + ) + end if +#endif + + ! Write diagnostic output + if (use_physics .and. self%output_cld_incs) then + call cld_incs_output( & + cloud_fields, dcfl_tot, dcff_tot, dbcf_tot, sec_tot, suffix_tot & + ) + end if + if (write_diag .and. use_xios_io .and. & + mod(model_clock%get_step(), diagnostic_frequency) == 0) then + ! TODO: these are very unlikely to be right + call output_diags_for_si( & + self%state, self%state_n, self%state_dag, mr, self%mr_n, & + self%mr_dag, self%mr_aft_adv, derived_fields, & + self%du, self%dtheta, self%dtheta_cld & + ) + end if + + !--------------------------------------------------------------------------- + ! Update fields held in the driver layer + !--------------------------------------------------------------------------- + call invoke( setval_X(u, self%state(igh_u)), & + setval_X(theta, self%state(igh_t)), & + setval_X(rho, self%state(igh_d)), & + setval_X(exner, self%state(igh_p)) ) + + deallocate(tr_inner_iterations) + + if ( subroutine_timers ) call timer('tr_bdf2_timestep_alg') + + end subroutine run_step + + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Release all claimed resources once completed. + !> + subroutine tr_bdf2_alg_final(self) + + implicit none + + class(tr_bdf2_timestep_type), intent(inout) :: self + + call semi_implicit_solver_alg_final() + call final_si_operators() + + if (allocated(self%state)) deallocate(self%state) + if (allocated(self%state_n)) deallocate(self%state_n) + if (allocated(self%state_m)) deallocate(self%state_m) + if (allocated(self%state_bdf)) deallocate(self%state_bdf) + if (allocated(self%state_q)) deallocate(self%state_q) + if (allocated(self%state_aft_adv)) deallocate(self%state_aft_adv) + if (allocated(self%state_dag)) deallocate(self%state_dag) + if (allocated(self%state_to_adv)) deallocate(self%state_to_adv) + if (allocated(self%rhs_n)) deallocate(self%rhs_n) + if (allocated(self%rhs_m)) deallocate(self%rhs_m) + if (allocated(self%rhs_bdf)) deallocate(self%rhs_bdf) + if (allocated(self%rhs_np1)) deallocate(self%rhs_np1) + if (allocated(self%rhs_adv)) deallocate(self%rhs_adv) + if (allocated(self%rhs_phys)) deallocate(self%rhs_phys) + if (allocated(self%rhs_lbc)) deallocate(self%rhs_lbc) + if (allocated(self%adv_inc_prev)) deallocate(self%adv_inc_prev) + if (allocated(self%mr_n)) deallocate(self%mr_n) + if (allocated(self%mr_dag)) deallocate(self%mr_dag) + if (allocated(self%mr_bdf)) deallocate(self%mr_bdf) + if (allocated(self%mr_aft_adv)) deallocate(self%mr_aft_adv) + + call self%dtheta%field_final() + call self%du%field_final() + call self%total_dry_flux%field_final() + + return + end subroutine tr_bdf2_alg_final + +end module tr_bdf2_timestep_alg_mod diff --git a/science/gungho/source/algorithm/transport/control/gungho_transport_control_alg_mod.X90 b/science/gungho/source/algorithm/transport/control/gungho_transport_control_alg_mod.X90 index 7ebe3d4eb..dc5ecdf66 100644 --- a/science/gungho/source/algorithm/transport/control/gungho_transport_control_alg_mod.X90 +++ b/science/gungho/source/algorithm/transport/control/gungho_transport_control_alg_mod.X90 @@ -145,6 +145,7 @@ contains !> @param[in] mr_in Moisture fields before transport !> @param[in] model_clock Time within the model !> @param[in] outer Outer (advection) iteration number + !> @param[in] stepper_name Enumerator for timestepper !> @param[in] cheap_update Logical flag for cheap transport update !> @param[in] prev_inc (Optional) Advective increment after 1st outer !! iteration transport used for cheap transport update @@ -152,6 +153,8 @@ contains !! previous outer iteration !> @param[in] rho_d_n (Optional) dry density to be transported, !! without the predictor factor + !> @param[in] rho_d_n_start (Optional) dry density at start of timestep, + !! for use with TR-BDF2 timestepper !> @param[in] total_dry_flux (Optional) the mass flux used to transport !! the dry density !> @param[in,out] adv_tracer_all_outer @@ -173,9 +176,9 @@ contains subroutine gungho_transport_control_alg(advection_inc, advected_fields, & wind_np1, wind_n, mr_out, mr_in, & - model_clock, outer, & + model_clock, outer, stepper_name, & cheap_update, prev_inc, wind_prev, & - rho_d_n, & + rho_d_n, rho_d_n_start, & total_dry_flux, & adv_tracer_all_outer, & adv_tracer_all_outer_after_slow, & @@ -188,6 +191,9 @@ contains ) use derived_config_mod, only: bundle_size + use dycore_constants_mod, only: stepper_siqn, & + stepper_bdf2, & + stepper_tr use sci_field_bundle_builtins_mod, only: bundle_inc_axpby, & clone_bundle, & set_bundle_scalar @@ -205,6 +211,8 @@ contains use mr_indices_mod, only: nummr, nummr_to_transport use theta_transport_alg_mod, only: theta_transport_alg use timestepping_config_mod, only: outer_iterations + use tr_bdf2_config_mod, only: bdf2_outer_iterations, & + tr_outer_iterations use tracer_collection_transport_mod, only: tracer_collection_transport_alg, & coarse_collection_transport_alg use transport_field_mod, only: transport_field @@ -223,10 +231,12 @@ contains type(field_type), intent(in) :: mr_in(nummr) class(model_clock_type), intent(in) :: model_clock integer(kind=i_def), intent(in) :: outer + integer(kind=i_def), intent(in) :: stepper_name logical(kind=l_def), intent(in) :: cheap_update type(field_type), intent(in), optional :: prev_inc(bundle_size) type(field_type), intent(in), optional :: wind_prev type(field_type), target, intent(in), optional :: rho_d_n + type(field_type), intent(in), optional :: rho_d_n_start type(r_tran_field_type), intent(in), optional :: total_dry_flux type(field_collection_type), intent(inout), optional :: adv_tracer_all_outer type(field_collection_type), intent(in), optional :: adv_tracer_all_outer_after_slow @@ -240,6 +250,7 @@ contains ! Internal variables logical(kind=l_def) :: do_moisture_diagnostics logical(kind=l_def) :: cheap_update_step + integer(kind=i_def) :: max_outer ! Temporary fields or pointers type(field_type) :: fields_np1(bundle_size) @@ -282,14 +293,29 @@ contains end if ! Are we going to write out moisture conservation diagnostics? ------------- + select case (stepper_name) + case (stepper_siqn) + max_outer = outer_iterations + case (stepper_tr) + max_outer = tr_outer_iterations + case (stepper_bdf2) + max_outer = bdf2_outer_iterations + end select + do_moisture_diagnostics = ( & - write_conservation_diag .and. outer == outer_iterations & + write_conservation_diag .and. outer == max_outer & .and. present(rho_d_n) & ) ! Determine aspects relating to cheap update steps ------------------------- ! Check whether it is a cheap update step cheap_update_step = (cheap_update .and. outer > 1) + if (cheap_update .and. .not. stepper_name == stepper_siqn) then + call log_event( & + 'Cheap transport update not implemented for TR-BDF2 stepper', & + LOG_LEVEL_ERROR & + ) + end if call wind_for_adv%initialise( wind_n%get_function_space() ) if (cheap_update .AND. outer > 2 .AND. present(wind_prev) ) then @@ -312,7 +338,7 @@ contains ! Initialise the main transport controller --------------------------------- call transport_controller%initialise( & model_clock, rho_d_latest_ptr, wind_for_adv, wind_np1, outer, & - cheap_update_step & + cheap_update_step, stepper_name & ) ! ======================================================================== ! @@ -334,10 +360,17 @@ contains ! Increment the whole time step's dry flux, which is to be used in the ! transport of tracers in the final outer step, if using the cheap update - if (cheap_update) then + if (cheap_update .or. ( & + stepper_name == stepper_bdf2 .and. outer == bdf2_outer_iterations) & + ) then flux_precomputations => transport_controller%get_flux_precomputations() flux_this_outer => flux_precomputations%get_total_ref_flux() call invoke( inc_X_plus_Y(total_dry_flux, flux_this_outer) ) + + else if (stepper_name == stepper_tr .and. outer == tr_outer_iterations) then + flux_precomputations => transport_controller%get_flux_precomputations() + flux_this_outer => flux_precomputations%get_total_ref_flux() + call invoke( setval_X(total_dry_flux, flux_this_outer) ) end if ! Check negative reference fields at this point @@ -380,10 +413,39 @@ contains mr_out, mr_in, nummr_to_transport, & transport_controller, transport_metadata & ) + end if + + ! ------------------------------------------------------------------------ ! + ! Transport potential temperature + ! (must be after moisture but before last_outer tracers due to cheap update) + ! Note: the theta increment is pointwise + call log_event( "Transporting potential temperature...", LOG_LEVEL_DEBUG) + transport_metadata => & + transport_metadata_collection%get_transport_metadata('potential_temperature') + + call theta_transport_alg( & + fields_np1(igh_t), advection_inc(igh_t), advected_fields(igh_t), & + mr_out, mr_in, transport_controller, transport_metadata & + ) + + ! ------------------------------------------------------------------------ ! + ! Transport tracers which are active in fast physics, and therefore need + ! transporting on every outer iteration + ! Not transported in TR step of TR-BDF2 + if ( moisture_formulation /= moisture_formulation_dry ) then + if (stepper_name == stepper_bdf2) then + ! Reset transport controller -- transport is done over whole timestep + ! Set stepper to SIQN to use time-averaged wind + call transport_controller%finalise() + call transport_controller%initialise( & + model_clock, rho_d_n_start, wind_n, wind_np1, & + outer=outer, cheap_update_step=.false., & + stepper_name=stepper_siqn & + ) + ! Copy dry density flux for the whole timestep into flux precomputations + call transport_controller%initialise_flux_precomputations(total_dry_flux) + end if - ! ---------------------------------------------------------------------- ! - ! Transport tracers which are active in fast physics, and therefore need - ! transporting on every outer iteration if (present(adv_tracer_all_outer) & .and. check_transport_name('adv_tracer') ) then @@ -414,19 +476,6 @@ contains end if end if - ! ------------------------------------------------------------------------ ! - ! Transport potential temperature - ! (must be after moisture but before last_outer tracers due to cheap update) - ! Note: the theta increment is pointwise - call log_event( "Transporting potential temperature...", LOG_LEVEL_DEBUG) - transport_metadata => & - transport_metadata_collection%get_transport_metadata('potential_temperature') - - call theta_transport_alg( & - fields_np1(igh_t), advection_inc(igh_t), advected_fields(igh_t), & - mr_out, mr_in, transport_controller, transport_metadata & - ) - ! ======================================================================== ! ! TRANSPORT OF PROGNOSTICS: LAST OUTER LOOP ! ======================================================================== ! @@ -445,7 +494,8 @@ contains call transport_controller%finalise() call transport_controller%initialise( & model_clock, rho_d_n_ptr, wind_n, wind_np1, & - outer=outer, cheap_update_step=.false. & + outer=outer, cheap_update_step=.false., & + stepper_name=stepper_siqn & ) ! Copy dry density flux for the whole timestep into flux precomputations call transport_controller%initialise_flux_precomputations(total_dry_flux) @@ -468,7 +518,8 @@ contains ! Set up new transport controller for coarser mesh call aerosol_transport_controller%initialise( & model_clock, aerosol_reference_rho, aerosol_wind_n, & - aerosol_wind_np1, outer, cheap_update_step=.false. & + aerosol_wind_np1, outer, cheap_update_step=.false., & + stepper_name=stepper_siqn & ) ! Copy dry density flux for the whole timestep into flux precomputations ! It does not need restricting (that will happen in the object) diff --git a/science/gungho/source/algorithm/transport/control/transport_controller_mod.x90 b/science/gungho/source/algorithm/transport/control/transport_controller_mod.x90 index c6e678f8f..1dc113730 100644 --- a/science/gungho/source/algorithm/transport/control/transport_controller_mod.x90 +++ b/science/gungho/source/algorithm/transport/control/transport_controller_mod.x90 @@ -40,6 +40,9 @@ module transport_controller_mod ! Pointers to other objects use sci_geometric_constants_mod, only: get_face_selector_ew, & get_face_selector_ns + use dycore_constants_mod, only: stepper_siqn, & + stepper_tr, & + stepper_bdf2 use transport_constants_mod, only: get_detj_at_w3_r_tran ! Transport objects @@ -151,8 +154,10 @@ contains !! the transporting wind is the *difference* !! in wind from the previous step, rather than !! the full transport wind. + !> @param[in] stepper_name Optional, enumerator for timestepper, used to + !! determine the transporting wind subroutine initialise(self, model_clock, ref_field_rdef, wind_n_rdef, & - wind_np1_rdef, outer, cheap_update_step) + wind_np1_rdef, outer, cheap_update_step, stepper_name) use split_transport_utils_mod, only: get_dry_config, & get_splitting_name @@ -174,6 +179,7 @@ contains type(field_type), optional, intent(in) :: wind_np1_rdef integer(kind=i_def), optional, intent(in) :: outer logical(kind=l_def), optional, intent(in) :: cheap_update_step + integer(kind=i_def), optional, intent(in) :: stepper_name ! Internal variables type(r_tran_field_type) :: wind_flux @@ -197,9 +203,11 @@ contains type(function_space_type), pointer :: w3_2d_fs real(kind=r_tran) :: dt_rtran, dt_one + real(kind=r_tran) :: gamma real(kind=r_tran) :: min_lipschitz, max_lipschitz_3d real(kind=r_tran) :: max_lipschitz, max_lipschitz_alt integer(kind=i_def) :: mesh_id + integer(kind=i_def) :: stepper integer(kind=i_def) :: watkins_fail, watkins_min integer(kind=i_def) :: splitting_alt logical(kind=l_def) :: perform_watkins @@ -217,8 +225,24 @@ contains if (present(cheap_update_step)) then self%cheap_update_step = cheap_update_step end if + if (present(stepper_name)) then + stepper = stepper_name + else + stepper = stepper_siqn + end if - dt_rtran = real(model_clock%get_seconds_per_step(), r_tran) + select case (stepper) + case (stepper_siqn) + dt_rtran = real(model_clock%get_seconds_per_step(), r_tran) + case (stepper_tr) + gamma = 1.0_r_tran - 0.5_r_tran * SQRT(2.0_r_tran) + dt_rtran = real(model_clock%get_seconds_per_step(), r_tran) + dt_rtran = 2.0_r_tran * gamma * dt_rtran + case (stepper_bdf2) + gamma = 1.0_r_tran - 0.5_r_tran * SQRT(2.0_r_tran) + dt_rtran = real(model_clock%get_seconds_per_step(), r_tran) + dt_rtran = (1.0_r_tran - 2.0_r_tran * gamma) * dt_rtran + end select self%reference_splitting = splitting(get_dry_config()) @@ -263,9 +287,14 @@ contains ! standard semi-implicit transport wind: average of wind_n and wind_np1 else if (present(wind_np1_rdef)) then - call invoke( X_plus_Y(self%transporting_wind, self%wind_np1_rtran, & - self%wind_n_rtran), & - inc_a_times_X(0.5_r_tran, self%transporting_wind) ) + select case (stepper) + case (stepper_siqn, stepper_tr) + call invoke( X_plus_Y(self%transporting_wind, self%wind_np1_rtran, & + self%wind_n_rtran), & + inc_a_times_X(0.5_r_tran, self%transporting_wind) ) + case (stepper_bdf2) + call invoke( setval_X(self%transporting_wind, self%wind_np1_rtran) ) + end select else call invoke( setval_X(self%transporting_wind, self%wind_n_rtran) ) diff --git a/science/gungho/source/driver/gungho_model_mod.F90 b/science/gungho/source/driver/gungho_model_mod.F90 index e91f0fbd6..1ac1a5781 100644 --- a/science/gungho/source/driver/gungho_model_mod.F90 +++ b/science/gungho/source/driver/gungho_model_mod.F90 @@ -85,6 +85,7 @@ module gungho_model_mod use rk_alg_timestep_mod, only : rk_timestep_type use semi_implicit_timestep_alg_mod, & only : semi_implicit_timestep_type + use tr_bdf2_timestep_alg_mod, only : tr_bdf2_timestep_type use setup_orography_alg_mod, only : setup_orography_alg use idealised_config_mod, only : perturb_init, perturb_seed use initial_temperature_config_mod, only : perturb, perturb_random @@ -929,44 +930,43 @@ end subroutine initialise_infrastructure !--------------------------------------------------------------------------- !> @brief Initialises the gungho application - !> - !> @param[in] mesh The primary mesh + !> @param[in] mesh The primary mesh !> @param[in,out] modeldb The working data set for the model run - !> subroutine initialise_model( mesh, modeldb ) - use timestepping_config_mod, only: method, & - method_semi_implicit, & - method_rk, & - method_no_timestepping, & + use timestepping_config_mod, only: method, & + method_semi_implicit, & + method_tr_bdf2, & + method_rk, & + method_no_timestepping, & method_jules - use io_config_mod, only: write_conservation_diag, & - write_minmax_tseries - use formulation_config_mod, only: moisture_formulation, & - moisture_formulation_dry + use io_config_mod, only: write_conservation_diag, & + write_minmax_tseries + use formulation_config_mod, only: moisture_formulation, & + moisture_formulation_dry implicit none - type( mesh_type ), intent(in), pointer :: mesh - type( modeldb_type ), intent(inout), target :: modeldb + type(mesh_type), intent(in), pointer :: mesh + type(modeldb_type), intent(inout), target :: modeldb - type( field_collection_type ), pointer :: prognostic_fields => null() - type( field_collection_type ), pointer :: moisture_fields => null() - type( field_array_type ), pointer :: mr_array - type( field_type ), pointer :: mr(:) => null() + type(field_collection_type), pointer :: prognostic_fields + type(field_collection_type), pointer :: moisture_fields + type(field_array_type), pointer :: mr_array + type(field_type), pointer :: mr(:) - type( field_type), pointer :: theta => null() - type( field_type), pointer :: u => null() - type( field_type), pointer :: rho => null() - type( field_type), pointer :: exner => null() + type(field_type), pointer :: theta + type(field_type), pointer :: u + type(field_type), pointer :: rho + type(field_type), pointer :: exner - class(timestep_method_type), pointer :: timestep_method => null() + class(timestep_method_type), pointer :: timestep_method use_moisture = ( moisture_formulation /= moisture_formulation_dry ) ! Get pointers to field collections for use downstream - prognostic_fields => modeldb%fields%get_field_collection( & - "prognostic_fields") + prognostic_fields => & + modeldb%fields%get_field_collection("prognostic_fields") moisture_fields => modeldb%fields%get_field_collection("moisture_fields") call moisture_fields%get_field("mr", mr_array) @@ -984,61 +984,50 @@ subroutine initialise_model( mesh, modeldb ) call minmax_tseries(u, 'u', mesh) end if - select case( method ) - case( method_semi_implicit ) ! Semi-Implicit - ! Initialise the semi-implicit timestep method - allocate( timestep_method, source=semi_implicit_timestep_type(modeldb) ) - ! Add to the model database - call modeldb%values%add_key_value('timestep_method', & - timestep_method) - ! Output initial conditions - if ( write_conservation_diag ) then - call conservation_algorithm( rho, & - u, & - theta, & - mr, & - exner ) - if ( use_moisture ) & - call moisture_conservation_alg( rho, & - mr, & - 'Before timestep' ) + select case ( method ) + case ( method_semi_implicit, method_tr_bdf2, method_rk ) + ! Initialise the timestep method + if (method == method_semi_implicit) then + allocate(timestep_method, source=semi_implicit_timestep_type(modeldb)) + else if (method == method_tr_bdf2) then + allocate(timestep_method, source=tr_bdf2_timestep_type(modeldb)) + else if (method == method_rk) then + allocate(timestep_method, source=rk_timestep_type(modeldb)) end if - case( method_rk ) ! RK - ! Initialise the Runge-Kutta timestep method - allocate( timestep_method, source=rk_timestep_type(modeldb) ) + ! Add to the model database - call modeldb%values%add_key_value('timestep_method', & - timestep_method) + call modeldb%values%add_key_value( & + 'timestep_method', timestep_method & + ) ! Output initial conditions if ( write_conservation_diag ) then - call conservation_algorithm( rho, & - u, & - theta, & - mr, & - exner ) - if ( use_moisture ) & - call moisture_conservation_alg( rho, & - mr, & - 'Before timestep' ) + call conservation_algorithm(rho, u, theta, mr, exner) + if ( use_moisture ) then + call moisture_conservation_alg(rho, mr, 'Before timestep') + end if end if - case( method_no_timestepping ) + + case ( method_no_timestepping ) ! Initialise a null-timestep method allocate( timestep_method, source=no_timestep_type() ) ! Add to the model database - call modeldb%values%add_key_value('timestep_method', & - timestep_method) - write( log_scratch_space, & - '(A, A)' ) 'CAUTION: Running with no timestepping. ' // & - ' Prognostic fields not evolved' + call modeldb%values%add_key_value( & + 'timestep_method', timestep_method & + ) + write( log_scratch_space, '(A, A)' ) & + 'CAUTION: Running with no timestepping. ' // & + ' Prognostic fields not evolved' call log_event( log_scratch_space, LOG_LEVEL_WARNING ) + #ifdef UM_PHYSICS - case( method_jules ) ! jules + case ( method_jules ) ! jules ! Initialise the jules timestep method allocate( timestep_method, source=jules_timestep_type(modeldb) ) ! Add to the model database - call modeldb%values%add_key_value('timestep_method', & - timestep_method) + call modeldb%values%add_key_value( & + 'timestep_method', timestep_method & + ) #endif case default call log_event("Gungho: Incorrect time stepping option chosen, "// & diff --git a/science/gungho/source/driver/gungho_step_mod.x90 b/science/gungho/source/driver/gungho_step_mod.x90 index da004ab84..6af43cca5 100644 --- a/science/gungho/source/driver/gungho_step_mod.x90 +++ b/science/gungho/source/driver/gungho_step_mod.x90 @@ -45,13 +45,6 @@ module gungho_step_mod use moisture_fluxes_alg_mod, only : moisture_fluxes_alg use timestep_method_mod, only : timestep_method_type, & get_timestep_method_from_collection - use rk_alg_timestep_mod, only : rk_timestep_type - use semi_implicit_timestep_alg_mod, & - only : semi_implicit_timestep_type - use timestepping_config_mod, only : method, & - method_semi_implicit, & - method_rk, & - method_no_timestepping use update_energy_correction_alg_mod, & only : update_energy_correction_alg use compute_total_energy_alg_mod, only : compute_total_energy_alg