From 0964792bfcefb0f85097ad46ecc88aff92355dec Mon Sep 17 00:00:00 2001 From: Micael Oliveira Date: Thu, 18 May 2023 15:50:48 +1000 Subject: [PATCH 01/11] Sync all git submodules to match the versions found in the CESM version used for tests. --- .gitmodules | 2 +- CDEPS/CDEPS | 2 +- CMEPS/CMEPS | 2 +- MOM6/MOM6 | 2 +- MOM6/mom6_files.cmake | 154 ++++++++++++++++++++---------------------- WW3/CMakeLists.txt | 1 - WW3/WW3 | 2 +- WW3/ww3_files.cmake | 3 - share/CESM_share | 2 +- 9 files changed, 79 insertions(+), 91 deletions(-) diff --git a/.gitmodules b/.gitmodules index 8778ccd..3043e98 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +1,6 @@ [submodule "MOM6/MOM6"] path = MOM6/MOM6 - url = https://github.com/mom-ocean/MOM6 + url = https://github.com/NCAR/MOM6.git [submodule "CICE6/CICE6"] path = CICE/CICE url = https://github.com/ESCOMP/CICE diff --git a/CDEPS/CDEPS b/CDEPS/CDEPS index f027aa6..f285d23 160000 --- a/CDEPS/CDEPS +++ b/CDEPS/CDEPS @@ -1 +1 @@ -Subproject commit f027aa64285fb9ddad9be5c5837a6e6e279e6051 +Subproject commit f285d236a0b08380923199eb3084d94a67f30696 diff --git a/CMEPS/CMEPS b/CMEPS/CMEPS index 606eb39..ff8726f 160000 --- a/CMEPS/CMEPS +++ b/CMEPS/CMEPS @@ -1 +1 @@ -Subproject commit 606eb397d4e66f8fa3417e7e8fd2b2b4b3c222b4 +Subproject commit ff8726f437994c444b364a27e024e70f67c29421 diff --git a/MOM6/MOM6 b/MOM6/MOM6 index 7467a63..9e27b52 160000 --- a/MOM6/MOM6 +++ b/MOM6/MOM6 @@ -1 +1 @@ -Subproject commit 7467a63efea7025ceb9118448d593709dc1cdf47 +Subproject commit 9e27b52b1dd36a69645b22661af7a4e4581e09bd diff --git a/MOM6/mom6_files.cmake b/MOM6/mom6_files.cmake index 16560a5..e5b0957 100644 --- a/MOM6/mom6_files.cmake +++ b/MOM6/mom6_files.cmake @@ -1,71 +1,71 @@ list(APPEND mom6_src_files - MOM6/src/ALE/MOM_ALE.F90 - MOM6/src/ALE/MOM_regridding.F90 - MOM6/src/ALE/MOM_remapping.F90 - MOM6/src/ALE/P1M_functions.F90 - MOM6/src/ALE/P3M_functions.F90 - MOM6/src/ALE/PCM_functions.F90 - MOM6/src/ALE/PLM_functions.F90 - MOM6/src/ALE/PPM_functions.F90 - MOM6/src/ALE/PQM_functions.F90 MOM6/src/ALE/coord_adapt.F90 MOM6/src/ALE/coord_hycom.F90 MOM6/src/ALE/coord_rho.F90 MOM6/src/ALE/coord_sigma.F90 MOM6/src/ALE/coord_slight.F90 MOM6/src/ALE/coord_zlike.F90 + MOM6/src/ALE/MOM_ALE.F90 MOM6/src/ALE/MOM_hybgen_regrid.F90 MOM6/src/ALE/MOM_hybgen_remap.F90 MOM6/src/ALE/MOM_hybgen_unmix.F90 + MOM6/src/ALE/MOM_regridding.F90 + MOM6/src/ALE/MOM_remapping.F90 + MOM6/src/ALE/P1M_functions.F90 + MOM6/src/ALE/P3M_functions.F90 + MOM6/src/ALE/PCM_functions.F90 + MOM6/src/ALE/PLM_functions.F90 MOM6/src/ALE/polynomial_functions.F90 + MOM6/src/ALE/PPM_functions.F90 + MOM6/src/ALE/PQM_functions.F90 MOM6/src/ALE/regrid_consts.F90 MOM6/src/ALE/regrid_edge_values.F90 MOM6/src/ALE/regrid_interp.F90 MOM6/src/ALE/regrid_solvers.F90 - MOM6/src/core/MOM.F90 - MOM6/src/core/MOM_CoriolisAdv.F90 - MOM6/src/core/MOM_PressureForce.F90 - MOM6/src/core/MOM_PressureForce_Montgomery.F90 - MOM6/src/core/MOM_PressureForce_FV.F90 MOM6/src/core/MOM_barotropic.F90 MOM6/src/core/MOM_boundary_update.F90 - MOM6/src/core/MOM_checksum_packages.F90 MOM6/src/core/MOM_check_scaling.F90 + MOM6/src/core/MOM_checksum_packages.F90 MOM6/src/core/MOM_continuity.F90 MOM6/src/core/MOM_continuity_PPM.F90 + MOM6/src/core/MOM_CoriolisAdv.F90 MOM6/src/core/MOM_density_integrals.F90 MOM6/src/core/MOM_dynamics_split_RK2.F90 MOM6/src/core/MOM_dynamics_unsplit.F90 MOM6/src/core/MOM_dynamics_unsplit_RK2.F90 + MOM6/src/core/MOM.F90 MOM6/src/core/MOM_forcing_type.F90 MOM6/src/core/MOM_grid.F90 MOM6/src/core/MOM_interface_heights.F90 MOM6/src/core/MOM_isopycnal_slopes.F90 MOM6/src/core/MOM_open_boundary.F90 MOM6/src/core/MOM_porous_barriers.F90 + MOM6/src/core/MOM_PressureForce.F90 + MOM6/src/core/MOM_PressureForce_FV.F90 + MOM6/src/core/MOM_PressureForce_Montgomery.F90 MOM6/src/core/MOM_stoch_eos.F90 MOM6/src/core/MOM_transcribe_grid.F90 MOM6/src/core/MOM_unit_tests.F90 MOM6/src/core/MOM_variables.F90 MOM6/src/core/MOM_verticalGrid.F90 - MOM6/src/diagnostics/MOM_PointAccel.F90 MOM6/src/diagnostics/MOM_debugging.F90 - MOM6/src/diagnostics/MOM_spatial_means.F90 MOM6/src/diagnostics/MOM_diagnostics.F90 MOM6/src/diagnostics/MOM_obsolete_diagnostics.F90 MOM6/src/diagnostics/MOM_obsolete_params.F90 + MOM6/src/diagnostics/MOM_PointAccel.F90 + MOM6/src/diagnostics/MOM_spatial_means.F90 MOM6/src/diagnostics/MOM_sum_output.F90 MOM6/src/diagnostics/MOM_wave_speed.F90 MOM6/src/diagnostics/MOM_wave_structure.F90 MOM6/src/equation_of_state/MOM_EOS.F90 + MOM6/src/equation_of_state/MOM_EOS_linear.F90 MOM6/src/equation_of_state/MOM_EOS_NEMO.F90 MOM6/src/equation_of_state/MOM_EOS_TEOS10.F90 MOM6/src/equation_of_state/MOM_EOS_UNESCO.F90 MOM6/src/equation_of_state/MOM_EOS_Wright.F90 - MOM6/src/equation_of_state/MOM_EOS_linear.F90 MOM6/src/equation_of_state/MOM_TFreeze.F90 MOM6/src/equation_of_state/TEOS10/gsw_chem_potential_water_t_exact.f90 @@ -92,10 +92,10 @@ list(APPEND mom6_src_files MOM6/src/equation_of_state/TEOS10/gsw_rho_first_derivatives.f90 MOM6/src/equation_of_state/TEOS10/gsw_rho_second_derivatives.f90 MOM6/src/equation_of_state/TEOS10/gsw_sp_from_sr.f90 + MOM6/src/equation_of_state/TEOS10/gsw_sr_from_sp.f90 MOM6/src/equation_of_state/TEOS10/gsw_specvol.f90 MOM6/src/equation_of_state/TEOS10/gsw_specvol_first_derivatives.f90 MOM6/src/equation_of_state/TEOS10/gsw_specvol_second_derivatives.f90 - MOM6/src/equation_of_state/TEOS10/gsw_sr_from_sp.f90 MOM6/src/equation_of_state/TEOS10/gsw_t_deriv_chem_potential_water_t_exact.f90 MOM6/src/equation_of_state/TEOS10/gsw_t_freezing_exact.f90 MOM6/src/equation_of_state/TEOS10/gsw_t_freezing_poly.f90 @@ -122,20 +122,19 @@ list(APPEND mom6_src_files MOM6/src/framework/MOM_interpolate.F90 MOM6/src/framework/MOM_intrinsic_functions.F90 MOM6/src/framework/MOM_io.F90 - MOM6/src/framework/posix.F90 + MOM6/src/framework/MOM_memory_macros.h MOM6/src/framework/MOM_random.F90 MOM6/src/framework/MOM_restart.F90 MOM6/src/framework/MOM_safe_alloc.F90 MOM6/src/framework/MOM_string_functions.F90 - MOM6/src/framework/MOM_unit_scaling.F90 MOM6/src/framework/MOM_unique_scales.F90 - MOM6/src/framework/MOM_unit_testing.F90 + MOM6/src/framework/MOM_unit_scaling.F90 MOM6/src/framework/MOM_write_cputime.F90 - MOM6/src/framework/testing/MOM_file_parser_tests.F90 + MOM6/src/framework/posix.F90 - MOM6/src/ice_shelf/MOM_ice_shelf.F90 MOM6/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 MOM6/src/ice_shelf/MOM_ice_shelf_dynamics.F90 + MOM6/src/ice_shelf/MOM_ice_shelf.F90 MOM6/src/ice_shelf/MOM_ice_shelf_initialize.F90 MOM6/src/ice_shelf/MOM_ice_shelf_state.F90 MOM6/src/ice_shelf/MOM_marine_ice.F90 @@ -148,25 +147,38 @@ list(APPEND mom6_src_files MOM6/src/initialization/MOM_state_initialization.F90 MOM6/src/initialization/MOM_tracer_initialization_from_Z.F90 - MOM6/src/parameterizations/lateral/MOM_MEKE.F90 - MOM6/src/parameterizations/lateral/MOM_MEKE_types.F90 + MOM6/src/ocean_data_assim/MOM_oda_driver.F90 + MOM6/src/ocean_data_assim/MOM_oda_incupd.F90 + + MOM6/src/parameterizations/CVmix/cvmix_background.F90 + MOM6/src/parameterizations/CVmix/cvmix_convection.F90 + MOM6/src/parameterizations/CVmix/cvmix_ddiff.F90 + MOM6/src/parameterizations/CVmix/cvmix_kinds_and_types.F90 + MOM6/src/parameterizations/CVmix/cvmix_kpp.F90 + MOM6/src/parameterizations/CVmix/cvmix_math.F90 + MOM6/src/parameterizations/CVmix/cvmix_put_get.F90 + MOM6/src/parameterizations/CVmix/cvmix_shear.F90 + MOM6/src/parameterizations/CVmix/cvmix_tidal.F90 + MOM6/src/parameterizations/CVmix/cvmix_utils.F90 + MOM6/src/parameterizations/lateral/MOM_hor_visc.F90 - MOM6/src/parameterizations/lateral/MOM_interface_filter.F90 MOM6/src/parameterizations/lateral/MOM_internal_tides.F90 - MOM6/src/parameterizations/lateral/MOM_load_love_numbers.F90 MOM6/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 + MOM6/src/parameterizations/lateral/MOM_MEKE.F90 + MOM6/src/parameterizations/lateral/MOM_MEKE_types.F90 MOM6/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 - MOM6/src/parameterizations/lateral/MOM_spherical_harmonics.F90 MOM6/src/parameterizations/lateral/MOM_thickness_diffuse.F90 MOM6/src/parameterizations/lateral/MOM_tidal_forcing.F90 + MOM6/src/parameterizations/stochastic/MOM_stochastics.F90 + MOM6/src/parameterizations/vertical/MOM_ALE_sponge.F90 - MOM6/src/parameterizations/vertical/MOM_CVMix_KPP.F90 + MOM6/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 + MOM6/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 MOM6/src/parameterizations/vertical/MOM_CVMix_conv.F90 MOM6/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 + MOM6/src/parameterizations/vertical/MOM_CVMix_KPP.F90 MOM6/src/parameterizations/vertical/MOM_CVMix_shear.F90 - MOM6/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 - MOM6/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 MOM6/src/parameterizations/vertical/MOM_diabatic_aux.F90 MOM6/src/parameterizations/vertical/MOM_diabatic_driver.F90 MOM6/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -184,55 +196,52 @@ list(APPEND mom6_src_files MOM6/src/parameterizations/vertical/MOM_tidal_mixing.F90 MOM6/src/parameterizations/vertical/MOM_vert_friction.F90 - MOM6/src/parameterizations/CVmix/cvmix_background.F90 - MOM6/src/parameterizations/CVmix/cvmix_convection.F90 - MOM6/src/parameterizations/CVmix/cvmix_ddiff.F90 - MOM6/src/parameterizations/CVmix/cvmix_kinds_and_types.F90 - MOM6/src/parameterizations/CVmix/cvmix_kpp.F90 - MOM6/src/parameterizations/CVmix/cvmix_math.F90 - MOM6/src/parameterizations/CVmix/cvmix_put_get.F90 - MOM6/src/parameterizations/CVmix/cvmix_shear.F90 - MOM6/src/parameterizations/CVmix/cvmix_tidal.F90 - MOM6/src/parameterizations/CVmix/cvmix_utils.F90 - - MOM6/src/parameterizations/stochastic/MOM_stochastics.F90 - + MOM6/src/tracer/advection_test_tracer.F90 + MOM6/src/tracer/boundary_impulse_tracer.F90 MOM6/src/tracer/DOME_tracer.F90 - + MOM6/src/tracer/dyed_obc_tracer.F90 + MOM6/src/tracer/dye_example.F90 + MOM6/src/tracer/ideal_age_example.F90 MOM6/src/tracer/ISOMIP_tracer.F90 - - MOM6/src/tracer/MOM_OCMIP2_CFC.F90 + MOM6/src/tracer/MOM_CFC_cap.F90 MOM6/src/tracer/MOM_generic_tracer.F90 MOM6/src/tracer/MOM_lateral_boundary_diffusion.F90 MOM6/src/tracer/MOM_neutral_diffusion.F90 - MOM6/src/tracer/nw2_tracers.F90 + MOM6/src/tracer/MOM_OCMIP2_CFC.F90 MOM6/src/tracer/MOM_offline_aux.F90 MOM6/src/tracer/MOM_offline_main.F90 - MOM6/src/tracer/MOM_tracer_Z_init.F90 MOM6/src/tracer/MOM_tracer_advect.F90 MOM6/src/tracer/MOM_tracer_diabatic.F90 MOM6/src/tracer/MOM_tracer_flow_control.F90 MOM6/src/tracer/MOM_tracer_hor_diff.F90 MOM6/src/tracer/MOM_tracer_registry.F90 MOM6/src/tracer/MOM_tracer_types.F90 - MOM6/src/tracer/RGC_tracer.F90 - MOM6/src/tracer/advection_test_tracer.F90 - MOM6/src/tracer/boundary_impulse_tracer.F90 - MOM6/src/tracer/dye_example.F90 - MOM6/src/tracer/dyed_obc_tracer.F90 - MOM6/src/tracer/ideal_age_example.F90 + MOM6/src/tracer/MOM_tracer_Z_init.F90 + MOM6/src/tracer/nw2_tracers.F90 MOM6/src/tracer/oil_tracer.F90 MOM6/src/tracer/pseudo_salt_tracer.F90 + MOM6/src/tracer/RGC_tracer.F90 MOM6/src/tracer/tracer_example.F90 - MOM6/src/tracer/MOM_CFC_cap.F90 + MOM6/src/user/adjustment_initialization.F90 + MOM6/src/user/baroclinic_zone_initialization.F90 + MOM6/src/user/basin_builder.F90 + MOM6/src/user/benchmark_initialization.F90 MOM6/src/user/BFB_initialization.F90 MOM6/src/user/BFB_surface_forcing.F90 + MOM6/src/user/circle_obcs_initialization.F90 + MOM6/src/user/dense_water_initialization.F90 MOM6/src/user/DOME2d_initialization.F90 MOM6/src/user/DOME_initialization.F90 - MOM6/src/user/ISOMIP_initialization.F90 + MOM6/src/user/dumbbell_initialization.F90 + MOM6/src/user/dumbbell_surface_forcing.F90 + MOM6/src/user/dyed_channel_initialization.F90 + MOM6/src/user/dyed_obcs_initialization.F90 + MOM6/src/user/external_gwave_initialization.F90 MOM6/src/user/Idealized_Hurricane.F90 + MOM6/src/user/ISOMIP_initialization.F90 MOM6/src/user/Kelvin_initialization.F90 + MOM6/src/user/lock_exchange_initialization.F90 MOM6/src/user/MOM_controlled_forcing.F90 MOM6/src/user/MOM_wave_interface.F90 MOM6/src/user/Neverworld_initialization.F90 @@ -240,18 +249,6 @@ list(APPEND mom6_src_files MOM6/src/user/RGC_initialization.F90 MOM6/src/user/Rossby_front_2d_initialization.F90 MOM6/src/user/SCM_CVMix_tests.F90 - MOM6/src/user/adjustment_initialization.F90 - MOM6/src/user/basin_builder.F90 - MOM6/src/user/baroclinic_zone_initialization.F90 - MOM6/src/user/benchmark_initialization.F90 - MOM6/src/user/circle_obcs_initialization.F90 - MOM6/src/user/dense_water_initialization.F90 - MOM6/src/user/dumbbell_initialization.F90 - MOM6/src/user/dumbbell_surface_forcing.F90 - MOM6/src/user/dyed_channel_initialization.F90 - MOM6/src/user/dyed_obcs_initialization.F90 - MOM6/src/user/external_gwave_initialization.F90 - MOM6/src/user/lock_exchange_initialization.F90 MOM6/src/user/seamount_initialization.F90 MOM6/src/user/shelfwave_initialization.F90 MOM6/src/user/sloshing_initialization.F90 @@ -262,9 +259,8 @@ list(APPEND mom6_src_files MOM6/src/user/user_initialization.F90 MOM6/src/user/user_revise_forcing.F90 - MOM6/src/ocean_data_assim/MOM_oda_driver.F90 - MOM6/src/ocean_data_assim/MOM_oda_incupd.F90 - + MOM6/config_src/external/drifters/MOM_particles.F90 + MOM6/config_src/external/drifters/MOM_particles_types.F90 MOM6/config_src/external/GFDL_ocean_BGC/FMS_coupler_util.F90 MOM6/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 MOM6/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 @@ -272,12 +268,9 @@ list(APPEND mom6_src_files MOM6/config_src/external/ODA_hooks/ocean_da_core.F90 MOM6/config_src/external/ODA_hooks/ocean_da_types.F90 MOM6/config_src/external/ODA_hooks/write_ocean_obs.F90 - MOM6/config_src/external/drifters/MOM_particles.F90 - MOM6/config_src/external/drifters/MOM_particles_types.F90 - MOM6/config_src/external/database_comms/MOM_database_comms.F90 - MOM6/config_src/external/database_comms/database_client_interface.F90 - MOM6/config_src/external/stochastic_physics/stochastic_physics.F90 + MOM6/config_src/external/stochastic_physics/get_stochy_pattern.F90 + MOM6/config_src/external/stochastic_physics/stochastic_physics.F90 MOM6/config_src/infra/FMS1/MOM_coms_infra.F90 MOM6/config_src/infra/FMS1/MOM_constants.F90 @@ -293,13 +286,12 @@ list(APPEND mom6_src_files MOM6/config_src/infra/FMS1/MOM_time_manager.F90 MOM6/config_src/drivers/nuopc_cap/mom_cap.F90 - MOM6/config_src/drivers/nuopc_cap/ocn_comp_NUOPC.F90 - MOM6/config_src/drivers/nuopc_cap/time_utils.F90 MOM6/config_src/drivers/nuopc_cap/mom_cap_methods.F90 MOM6/config_src/drivers/nuopc_cap/mom_cap_time.F90 MOM6/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 MOM6/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 - MOM6/config_src/drivers/unit_tests/MOM_unit_test_driver.F90 + MOM6/config_src/drivers/nuopc_cap/ocn_comp_NUOPC.F90 + MOM6/config_src/drivers/nuopc_cap/time_utils.F90 ) list(APPEND mom6_solo_src_files diff --git a/WW3/CMakeLists.txt b/WW3/CMakeLists.txt index d23f997..0c89c3e 100644 --- a/WW3/CMakeLists.txt +++ b/WW3/CMakeLists.txt @@ -52,7 +52,6 @@ add_compile_definitions(W3_O15) add_compile_definitions(W3_IC4) add_compile_definitions(W3_IS0) add_compile_definitions(W3_REF0) -add_compile_definitions(ENDIANNESS="big_endian") set_property(SOURCE WW3/model/src/w3initmd.F90 APPEND diff --git a/WW3/WW3 b/WW3/WW3 index b9b48de..20174e1 160000 --- a/WW3/WW3 +++ b/WW3/WW3 @@ -1 +1 @@ -Subproject commit b9b48de3e8f31a208e9821ae08c64c88e5af9645 +Subproject commit 20174e10acf83dd09c8c3339b8228e5dba682623 diff --git a/WW3/ww3_files.cmake b/WW3/ww3_files.cmake index 894b7ed..3b8104f 100644 --- a/WW3/ww3_files.cmake +++ b/WW3/ww3_files.cmake @@ -22,7 +22,6 @@ list(APPEND ww3_src_files WW3/model/src/w3iosfmd.F90 WW3/model/src/w3iotrmd.F90 WW3/model/src/w3meminfo.F90 - WW3/model/src/w3nmlshelmd.F90 WW3/model/src/w3odatmd.F90 WW3/model/src/w3parall.F90 WW3/model/src/w3partmd.F90 @@ -47,12 +46,10 @@ list(APPEND ww3_src_files WW3/model/src/w3wavemd.F90 WW3/model/src/w3wdasmd.F90 WW3/model/src/w3wdatmd.F90 - WW3/model/src/wmmdatmd.F90 WW3/model/src/wav_comp_nuopc.F90 WW3/model/src/wav_grdout.F90 WW3/model/src/wav_import_export.F90 WW3/model/src/wav_kind_mod.F90 WW3/model/src/wav_shel_inp.F90 - WW3/model/src/wav_shr_flags.F90 WW3/model/src/wav_shr_mod.F90 ) diff --git a/share/CESM_share b/share/CESM_share index 5bda2f4..7c0c445 160000 --- a/share/CESM_share +++ b/share/CESM_share @@ -1 +1 @@ -Subproject commit 5bda2f404b9204ec4f9db8059250b38c2862b8fc +Subproject commit 7c0c4456d181ab237309a6dc6cf128f6cb717c4f From 0a48dde339eab58b3284409035d523ce5b54093b Mon Sep 17 00:00:00 2001 From: Micael Oliveira Date: Tue, 25 Jul 2023 14:47:30 +1000 Subject: [PATCH 02/11] Use the same compiler flags as CESM. --- CDEPS/CMakeLists.txt | 19 ------------------- CICE/CMakeLists.txt | 25 ------------------------- CMEPS/CMakeLists.txt | 18 ------------------ CMakeLists.txt | 29 +++++++++++++++-------------- MOM6/CMakeLists.txt | 9 ++------- WW3/CMakeLists.txt | 21 +-------------------- share/CMakeLists.txt | 17 ++++------------- 7 files changed, 22 insertions(+), 116 deletions(-) diff --git a/CDEPS/CMakeLists.txt b/CDEPS/CMakeLists.txt index 5caf036..0236114 100644 --- a/CDEPS/CMakeLists.txt +++ b/CDEPS/CMakeLists.txt @@ -1,16 +1,3 @@ -# CDEPS compiler flags -if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") - set(fortran_compile_flags -ffree-line-length-none) - if(${CMAKE_Fortran_COMPILER_VERSION} VERSION_GREATER_EQUAL 10) - list(APPEND fortran_compile_flags -fallow-argument-mismatch -fallow-invalid-boz) - endif() - set(fortran_compile_flags_debug -fcheck=bounds -ffpe-trap=invalid,zero,overflow,underflow) -elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") - set(fortran_compile_flags -O -assume realloc_lhs) - set(fortran_compile_flags_release -fp-model precise) - set(fortran_compile_flags_debug -check "SHELL:-check noarg_temp_created" "SHELL:-check nopointer" -fpe0 -ftrapuv -init=snan,arrays) -endif() - add_subdirectory(fox) list(APPEND cdeps_common_src_files @@ -57,16 +44,10 @@ list(APPEND cdeps_dwav_src_files add_fortran_library(cdeps_common mod STATIC ${cdeps_common_src_files}) target_include_directories(cdeps_common PUBLIC $) -target_compile_options(cdeps_common PRIVATE "$<$:${fortran_compile_flags}>") -target_compile_options(cdeps_common PRIVATE "$<$,$>:${fortran_compile_flags_debug}>") -target_compile_options(cdeps_common PRIVATE "$<$,$>:${fortran_compile_flags_release}>") target_link_libraries(cdeps_common PUBLIC share cmeps esmf PIO::PIO_Fortran FoX_dom) foreach(LIB cdeps_docn cdeps_dice cdeps_dwav) add_fortran_library(${LIB} ${LIB}/mod STATIC ${${LIB}_src_files}) target_include_directories(${LIB} PUBLIC $) - target_compile_options(${LIB} PRIVATE "$<$:${fortran_compile_flags}>") - target_compile_options(${LIB} PRIVATE "$<$,$>:${fortran_compile_flags_debug}>") - target_compile_options(${LIB} PRIVATE "$<$,$>:${fortran_compile_flags_release}>") target_link_libraries(${LIB} PUBLIC share cmeps esmf PIO::PIO_Fortran FoX_dom cdeps_common) endforeach() diff --git a/CICE/CMakeLists.txt b/CICE/CMakeLists.txt index e6c9e75..74443dd 100644 --- a/CICE/CMakeLists.txt +++ b/CICE/CMakeLists.txt @@ -1,23 +1,3 @@ -### CICE Fortran compiler flags -if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") - set(fortran_compile_flags -fconvert=big-endian -ffree-line-length-none) - set(fortran_compile_flags_debug -Wall -Wextra -fcheck=bounds -ffpe-trap=invalid,zero,overflow,underflow) -elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") - set(fortran_compile_flags -FR -convert big_endian -assume byterecl -ftz -align array64byte -xHOST) - set(fortran_compile_flags_release -fp-model precise) - set(fortran_compile_flags_debug "SHELL:-check uninit" "SHELL:-check bounds" "SHELL:-check nopointer" -fpe0 "SHELL:-check noarg_temp_created" -init=snan,arrays) -endif() - -### CICE C compiler flags -if(CMAKE_C_COMPILER_ID MATCHES "GNU") - set(c_compile_flags_release -O3) -elseif(CMAKE_C_COMPILER_ID MATCHES "Intel") - set(c_compile_flags -xHOST) - set(c_compile_flags_release -O2 -fp-model precise) -elseif(CMAKE_C_COMPILER_ID MATCHES "Clang") - set(c_compile_flags_release -O3) -endif() - # Configuration Options set(CICE_IO "NetCDF" CACHE STRING "CICE OPTIONS: Choose IO options.") set_property(CACHE CICE_IO PROPERTY STRINGS "NetCDF" "PIO" "Binary") @@ -50,11 +30,6 @@ endif() ### Create target library and set PUBLIC interfaces on the library add_fortran_library(cice mod STATIC ${lib_src_files}) target_compile_definitions(cice PUBLIC "${_cice_defs}") -target_compile_options(cice PRIVATE "$<$:${fortran_compile_flags}>") -target_compile_options(cice PRIVATE "$<$,$>:${fortran_compile_flags_debug}>") -target_compile_options(cice PRIVATE "$<$,$>:${fortran_compile_flags_release}>") -target_compile_options(cice PRIVATE "$<$:${c_compile_flags}>") -target_compile_options(cice PRIVATE "$<$,$>:${c_compile_flags_release}>") target_link_libraries(cice PUBLIC share cdeps_common esmf) if(CICE_IO MATCHES "^(NetCDF|PIO)$") diff --git a/CMEPS/CMakeLists.txt b/CMEPS/CMakeLists.txt index 730cfca..762c42e 100644 --- a/CMEPS/CMakeLists.txt +++ b/CMEPS/CMakeLists.txt @@ -1,18 +1,3 @@ -############################################################################### -### CMEPS compiler flags -############################################################################### -if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") - set(fortran_compile_flags -ffree-line-length-none) - if(${CMAKE_Fortran_COMPILER_VERSION} VERSION_GREATER_EQUAL 10) - list(APPEND fortran_compile_flags -fallow-argument-mismatch -fallow-invalid-boz) - endif() - set(fortran_compile_flags_debug -fcheck=bounds -ffpe-trap=invalid,zero,overflow,underflow) -elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") - set(fortran_compile_flags -O -assume realloc_lhs) - set(fortran_compile_flags_release -fp-model precise) - set(fortran_compile_flags_debug -check "SHELL:-check noarg_temp_created" "SHELL:-check nopointer" -fpe0 -ftrapuv -init=snan,arrays) -endif() - ############################################################################### ### Source files ############################################################################### @@ -68,9 +53,6 @@ list(APPEND _nuopc_cap_share_files ### Create target library add_fortran_library(cmeps mod STATIC ${_mediator_files} ${_nuopc_cap_share_files}) -target_compile_options(cmeps PRIVATE "$<$:${fortran_compile_flags}>") -target_compile_options(cmeps PRIVATE "$<$,$>:${fortran_compile_flags_debug}>") -target_compile_options(cmeps PRIVATE "$<$,$>:${fortran_compile_flags_release}>") target_link_libraries(cmeps PUBLIC share FMS::fms_r8 esmf diff --git a/CMakeLists.txt b/CMakeLists.txt index bb531c9..070379a 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -56,27 +56,28 @@ add_compile_definitions( ) if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fbacktrace -ffree-line-length-none") - set(CMAKE_Fortran_FLAGS_RELEASE "-O2") - set(CMAKE_Fortran_FLAGS_DEBUG "-g -O0") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fbacktrace -fconvert=big-endian -ffree-line-length-none -ffixed-line-length-none") + if(${CMAKE_Fortran_COMPILER_VERSION} VERSION_GREATER_EQUAL 10) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fallow-argument-mismatch") + endif() + set(CMAKE_Fortran_FLAGS_RELEASE "-O") + set(CMAKE_Fortran_FLAGS_DEBUG "-g -Wall -Og -ffpe-trap=zero,overflow -fcheck=bounds") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -traceback") - set(CMAKE_Fortran_FLAGS_RELEASE "-O2") - set(CMAKE_Fortran_FLAGS_DEBUG "-g -O0") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source") + set(CMAKE_Fortran_FLAGS_RELEASE "-O2 -debug minimal") + set(CMAKE_Fortran_FLAGS_DEBUG "-O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created") else() message(WARNING "Fortran compiler with ID ${CMAKE_Fortran_COMPILER_ID} will be used with CMake default options") endif() if(CMAKE_C_COMPILER_ID MATCHES "GNU") - set(CMAKE_C_FLAGS_RELEASE "") - set(CMAKE_C_FLAGS_DEBUG "-g -O0") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -std=gnu99") + set(CMAKE_C_FLAGS_RELEASE "-O") + set(CMAKE_C_FLAGS_DEBUG "-g -Wall -Og -fbacktrace -ffpe-trap=invalid,zero,overflow -fcheck=bounds") elseif(CMAKE_C_COMPILER_ID MATCHES "Intel") - set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -traceback") - set(CMAKE_C_FLAGS_RELEASE "") - set(CMAKE_C_FLAGS_DEBUG "-g -O0 -ftrapuv") -elseif(CMAKE_C_COMPILER_ID MATCHES "Clang") - set(CMAKE_C_FLAGS_RELEASE "") - set(CMAKE_C_FLAGS_DEBUG "-g -O0") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -traceback -qno-opt-dynamic-align -fp-model precise -std=gnu99") + set(CMAKE_C_FLAGS_RELEASE "-O2 -debug minimal") + set(CMAKE_C_FLAGS_DEBUG "-O0 -g") else() message(WARNING "C compiler with ID ${CMAKE_C_COMPILER_ID} will be used with CMake default options") endif() diff --git a/MOM6/CMakeLists.txt b/MOM6/CMakeLists.txt index b93a3ea..0c5a2d2 100644 --- a/MOM6/CMakeLists.txt +++ b/MOM6/CMakeLists.txt @@ -1,11 +1,8 @@ ### MOM6 Fortran compiler flags if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") - set(fortran_compile_flags -fdefault-real-8 -fdefault-double-8 -Waliasing -fcray-pointer -fconvert=big-endian -ffree-line-length-none -fno-range-check) - set(fortran_compile_flags_debug -fcheck=bounds -ffpe-trap=invalid,zero,overflow,underflow) + set(fortran_compile_flags -fdefault-real-8 -fdefault-double-8) elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") - set(fortran_compile_flags -i4 -r8 -fno-alias -auto -safe-cray-ptr -ftz -assume byterecl -sox) - set(fortran_compile_flags_release -debug minimal -fp-model source) - set(fortran_compile_flags_debug -check "SHELL:-check noarg_temp_created" "SHELL:-check nopointer" -fpe0 -ftrapuv -init=snan,arrays) + set(fortran_compile_flags -r8) endif() option(SYMMETRIC "Use symmetric memory" ON) @@ -22,8 +19,6 @@ add_fortran_library(mom6 mod STATIC ${mom6_src_files}) target_include_directories(mom6 PUBLIC $ $) target_compile_options(mom6 PRIVATE "$<$:${fortran_compile_flags}>") -target_compile_options(mom6 PRIVATE "$<$,$>:${fortran_compile_flags_debug}>") -target_compile_options(mom6 PRIVATE "$<$,$>:${fortran_compile_flags_release}>") target_link_libraries(mom6 PUBLIC share FMS::fms_r8 esmf diff --git a/WW3/CMakeLists.txt b/WW3/CMakeLists.txt index 0c89c3e..57bd446 100644 --- a/WW3/CMakeLists.txt +++ b/WW3/CMakeLists.txt @@ -1,25 +1,9 @@ -### WW3 Fortran compiler flags -if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") - set(fortran_compile_flags -fno-second-underscore) - if(${CMAKE_Fortran_COMPILER_VERSION} VERSION_GREATER_EQUAL 10) - set(fortran_compile_flags -fallow-argument-mismatch) - endif() - set(fortran_compile_flags_release -O3) - set(fortran_compile_flags_debug -Wall -Wno-unused-label -fcheck=all -ffpe-trap=invalid,zero,overflow -frecursive) -elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") - set(fortran_compile_flags -no-fma -ip -i4 -real-size 32 -fp-model precise -assume byterecl -fno-alias -fno-fnalias -sox) - set(fortran_compile_flags_release -O3) - set(fortran_compile_flags_debug "SHELL:-debug all" "SHELL:-warn all" "SHELL:-check all" -check noarg_temp_created -fp-stack-check -heap-arrays -fpe0) -endif() - # Switch definitions (taken from CESM) add_compile_definitions(W3_CESMCOUPLED) add_compile_definitions(W3_NCO) add_compile_definitions(W3_DIST) add_compile_definitions(W3_MPI) -if (OPENMP) - add_compile_definitions(W3_OMPG) -endif() +add_compile_definitions(W3_OMPG) add_compile_definitions(W3_OMPH) add_compile_definitions(W3_PR3) add_compile_definitions(W3_UQ) @@ -64,8 +48,5 @@ include("ww3_files.cmake") ### Create target library and set PUBLIC interfaces on the library add_fortran_library(ww3 mod STATIC ${ww3_src_files}) -target_compile_options(ww3 PRIVATE "$<$:${fortran_compile_flags}>") -target_compile_options(ww3 PRIVATE "$<$,$>:${fortran_compile_flags_debug}>") -target_compile_options(ww3 PRIVATE "$<$,$>:${fortran_compile_flags_release}>") target_link_libraries(ww3 PUBLIC esmf NetCDF::NetCDF_Fortran) diff --git a/share/CMakeLists.txt b/share/CMakeLists.txt index f758e3d..890edf7 100644 --- a/share/CMakeLists.txt +++ b/share/CMakeLists.txt @@ -1,18 +1,12 @@ ### Fortran compiler flags if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") - add_compile_definitions(CPRGNU + add_compile_definitions( + CPRGNU NAMING=_ADD_UNDERSCORE) - set(fortran_compile_flags -ffree-line-length-none) - if(${CMAKE_Fortran_COMPILER_VERSION} VERSION_GREATER_EQUAL 10) - list(APPEND fortran_compile_flags -fallow-argument-mismatch -fallow-invalid-boz) - endif() - set(fortran_compile_flags_debug -fcheck=bounds -ffpe-trap=invalid,zero,overflow,underflow) elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") - add_compile_definitions(CPRINTEL + add_compile_definitions( + CPRINTEL NAMING=_ADD_UNDERSCORE) - set(fortran_compile_flags -O -assume realloc_lhs) - set(fortran_compile_flags_release -fp-model precise) - set(fortran_compile_flags_debug -check "SHELL:-check noarg_temp_created" "SHELL:-check nopointer" -fpe0 -ftrapuv -init=snan,arrays) endif() # The following files are generated with a script acting on templates @@ -69,7 +63,4 @@ target_include_directories(share PUBLIC $ CESM_share/include ) -target_compile_options(share PRIVATE "$<$:${fortran_compile_flags}>") -target_compile_options(share PRIVATE "$<$,$>:${fortran_compile_flags_debug}>") -target_compile_options(share PRIVATE "$<$,$>:${fortran_compile_flags_release}>") target_link_libraries(share PUBLIC esmf PIO::PIO_Fortran) From e82505734969dbee71cf956b31f1f7d2d49c99d0 Mon Sep 17 00:00:00 2001 From: Micael Oliveira Date: Tue, 25 Jul 2023 14:48:56 +1000 Subject: [PATCH 03/11] Use new Spack environment. This environment tries to use the same package versions as CESM and with similar flags. --- CMakeLists.txt | 2 +- build.sh | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 070379a..b057f9b 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -88,7 +88,7 @@ find_package(MPI REQUIRED) if(OPENMP) find_package(OpenMP REQUIRED) endif() -find_package(NetCDF 4.7.4 REQUIRED Fortran) +find_package(NetCDF 4.7.3 REQUIRED Fortran) find_package(ESMF 8.3.0 MODULE REQUIRED) find_package(fms COMPONENTS R8 REQUIRED) find_package(PIO 2.5.3 REQUIRED COMPONENTS C Fortran) diff --git a/build.sh b/build.sh index 821005d..0d80f3d 100755 --- a/build.sh +++ b/build.sh @@ -20,8 +20,8 @@ OPENMPI_VERSION=4.1.4 module purge module load cmake/3.24.2 -module use /g/data/ik11/spack/0.20.1/share/modules/linux-rocky8-cascadelake # requires membership of "ik11" group -module load esmf/8.3.1-intel-${COMPILER_VERSION} fms/2023.01-intel-${COMPILER_VERSION} parallelio/2.5.10-intel-${COMPILER_VERSION} +module use /g/data/ik11/spack/0.20.1/modules/access-om3/0.1.0/linux-rocky8-x86_64 # requires membership of "ik11" group +module load esmf/8.3.0b09 fms/git.2020.04.03=0.04.03 parallelio/2.5.9 module load intel-compiler/${COMPILER_VERSION} openmpi/${OPENMPI_VERSION} cd ${SCRIPT_DIR} From b2eeca3b4279144fe441678fad2ee785faa30833 Mon Sep 17 00:00:00 2001 From: Micael Oliveira Date: Mon, 31 Jul 2023 09:46:10 +1000 Subject: [PATCH 04/11] Set PIO as the default for CICE IO. --- CICE/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CICE/CMakeLists.txt b/CICE/CMakeLists.txt index 74443dd..b92a767 100644 --- a/CICE/CMakeLists.txt +++ b/CICE/CMakeLists.txt @@ -1,5 +1,5 @@ # Configuration Options -set(CICE_IO "NetCDF" CACHE STRING "CICE OPTIONS: Choose IO options.") +set(CICE_IO "PIO" CACHE STRING "CICE OPTIONS: Choose IO options.") set_property(CACHE CICE_IO PROPERTY STRINGS "NetCDF" "PIO" "Binary") # Too many files to list, so include them via this file From 753efbfe6be46ebbbc6d310ff44e6560c9719521 Mon Sep 17 00:00:00 2001 From: Micael Oliveira Date: Thu, 10 Aug 2023 09:26:51 +1000 Subject: [PATCH 05/11] Do not compile the CDEPS land data model, as we never use it. Reorganize the CDEPS libraries to have atm and rof separate. --- CDEPS/CMakeLists.txt | 13 ++++++++----- CMakeLists.txt | 3 +-- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/CDEPS/CMakeLists.txt b/CDEPS/CMakeLists.txt index 0236114..3be30ea 100644 --- a/CDEPS/CMakeLists.txt +++ b/CDEPS/CMakeLists.txt @@ -9,7 +9,13 @@ list(APPEND cdeps_common_src_files CDEPS/dshr/dshr_dfield_mod.F90 CDEPS/dshr/dshr_fldlist_mod.F90 CDEPS/dshr/dshr_mod.F90 +) +list(APPEND cdeps_drof_src_files + CDEPS/drof/rof_comp_nuopc.F90 +) + +list(APPEND cdeps_datm_src_files CDEPS/datm/atm_comp_nuopc.F90 CDEPS/datm/datm_datamode_cfsr_mod.F90 CDEPS/datm/datm_datamode_clmncep_mod.F90 @@ -18,12 +24,9 @@ list(APPEND cdeps_common_src_files CDEPS/datm/datm_datamode_era5_mod.F90 CDEPS/datm/datm_datamode_gefs_mod.F90 CDEPS/datm/datm_datamode_jra_mod.F90 - - CDEPS/dlnd/lnd_comp_nuopc.F90 - - CDEPS/drof/rof_comp_nuopc.F90 ) + list(APPEND cdeps_docn_src_files CDEPS/docn/docn_datamode_aquaplanet_mod.F90 CDEPS/docn/docn_datamode_copyall_mod.F90 @@ -46,7 +49,7 @@ add_fortran_library(cdeps_common mod STATIC ${cdeps_common_src_files}) target_include_directories(cdeps_common PUBLIC $) target_link_libraries(cdeps_common PUBLIC share cmeps esmf PIO::PIO_Fortran FoX_dom) -foreach(LIB cdeps_docn cdeps_dice cdeps_dwav) +foreach(LIB cdeps_docn cdeps_dice cdeps_dwav cdeps_drof cdeps_datm) add_fortran_library(${LIB} ${LIB}/mod STATIC ${${LIB}_src_files}) target_include_directories(${LIB} PUBLIC $) target_link_libraries(${LIB} PUBLIC share cmeps esmf PIO::PIO_Fortran FoX_dom cdeps_common) diff --git a/CMakeLists.txt b/CMakeLists.txt index b057f9b..f6d5281 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -148,11 +148,10 @@ foreach(CONF IN LISTS KNOWN_CONFIGURATIONS) CMEPS/CMEPS/cesm/driver/ensemble_driver.F90 CMEPS/CMEPS/cesm/driver/esm_time_mod.F90 ) - target_link_libraries(cesm_driver_${CONF} PUBLIC share ${COMPONENTS_TARGETS} cmeps cdeps_common esmf PIO::PIO_Fortran) + target_link_libraries(cesm_driver_${CONF} PUBLIC share ${COMPONENTS_TARGETS} cmeps cdeps_common cdeps_drof cdeps_datm esmf PIO::PIO_Fortran) target_compile_definitions(cesm_driver_${CONF} PRIVATE MED_PRESENT ATM_PRESENT ICE_PRESENT - LND_PRESENT OCN_PRESENT WAV_PRESENT ROF_PRESENT From cd5002ded74d9636e2d99271183a992121926579 Mon Sep 17 00:00:00 2001 From: Micael Oliveira Date: Thu, 10 Aug 2023 10:08:46 +1000 Subject: [PATCH 06/11] Removed unused sources in CDEPS/share folder. This is now replaced by share/src. --- CDEPS/share/dtypes.h | 6 - CDEPS/share/shr_assert_mod.F90 | 8604 -------------------------------- CDEPS/share/shr_frz_mod.F90 | 215 - CDEPS/share/shr_infnan_mod.F90 | 1909 ------- 4 files changed, 10734 deletions(-) delete mode 100644 CDEPS/share/dtypes.h delete mode 100644 CDEPS/share/shr_assert_mod.F90 delete mode 100644 CDEPS/share/shr_frz_mod.F90 delete mode 100644 CDEPS/share/shr_infnan_mod.F90 diff --git a/CDEPS/share/dtypes.h b/CDEPS/share/dtypes.h deleted file mode 100644 index f2e5b00..0000000 --- a/CDEPS/share/dtypes.h +++ /dev/null @@ -1,6 +0,0 @@ -#define TYPETEXT 100 -#define TYPEREAL 101 -#define TYPEDOUBLE 102 -#define TYPEINT 103 -#define TYPELONG 104 -#define TYPELOGICAL 105 diff --git a/CDEPS/share/shr_assert_mod.F90 b/CDEPS/share/shr_assert_mod.F90 deleted file mode 100644 index 89c529c..0000000 --- a/CDEPS/share/shr_assert_mod.F90 +++ /dev/null @@ -1,8604 +0,0 @@ -#include "dtypes.h" -!=================================================== -! DO NOT EDIT THIS FILE, it was generated using /home/micael/genf90.pl -! Any changes you make to this file may be lost -!=================================================== -module shr_assert_mod - -! Assert subroutines for common debugging operations. - -use shr_kind_mod, only: & - r4 => shr_kind_r4, & - r8 => shr_kind_r8, & - i4 => shr_kind_i4, & - i8 => shr_kind_i8, & - CL => shr_kind_CL - -use shr_sys_mod, only: & - shr_sys_abort - -use shr_log_mod, only: & - shr_log_Unit - -use shr_infnan_mod, only: shr_infnan_isnan - -use shr_strconvert_mod, only: toString - -implicit none -private -save - -! Assert that a logical is true. -public :: shr_assert -public :: shr_assert_all -public :: shr_assert_any - -! Assert that a numerical value satisfies certain constraints. -public :: shr_assert_in_domain - -# 34 "CDEPS/share/shr_assert_mod.F90.in" -interface shr_assert_all - module procedure shr_assert - ! DIMS 1,2,3,4,5,6,7 - module procedure shr_assert_all_1d - ! DIMS 1,2,3,4,5,6,7 - module procedure shr_assert_all_2d - ! DIMS 1,2,3,4,5,6,7 - module procedure shr_assert_all_3d - ! DIMS 1,2,3,4,5,6,7 - module procedure shr_assert_all_4d - ! DIMS 1,2,3,4,5,6,7 - module procedure shr_assert_all_5d - ! DIMS 1,2,3,4,5,6,7 - module procedure shr_assert_all_6d - ! DIMS 1,2,3,4,5,6,7 - module procedure shr_assert_all_7d -end interface - -# 40 "CDEPS/share/shr_assert_mod.F90.in" -interface shr_assert_any - module procedure shr_assert - ! DIMS 1,2,3,4,5,6,7 - module procedure shr_assert_any_1d - ! DIMS 1,2,3,4,5,6,7 - module procedure shr_assert_any_2d - ! DIMS 1,2,3,4,5,6,7 - module procedure shr_assert_any_3d - ! DIMS 1,2,3,4,5,6,7 - module procedure shr_assert_any_4d - ! DIMS 1,2,3,4,5,6,7 - module procedure shr_assert_any_5d - ! DIMS 1,2,3,4,5,6,7 - module procedure shr_assert_any_6d - ! DIMS 1,2,3,4,5,6,7 - module procedure shr_assert_any_7d -end interface - -# 46 "CDEPS/share/shr_assert_mod.F90.in" -interface shr_assert_in_domain - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_0d_double - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_1d_double - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_2d_double - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_3d_double - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_4d_double - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_5d_double - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_6d_double - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_7d_double - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_0d_real - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_1d_real - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_2d_real - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_3d_real - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_4d_real - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_5d_real - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_6d_real - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_7d_real - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_0d_int - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_1d_int - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_2d_int - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_3d_int - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_4d_int - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_5d_int - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_6d_int - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_7d_int - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_0d_long - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_1d_long - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_2d_long - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_3d_long - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_4d_long - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_5d_long - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_6d_long - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure shr_assert_in_domain_7d_long -end interface - -! Private utilities. - -# 54 "CDEPS/share/shr_assert_mod.F90.in" -interface print_bad_loc - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_0d_double - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_1d_double - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_2d_double - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_3d_double - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_4d_double - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_5d_double - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_6d_double - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_7d_double - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_0d_real - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_1d_real - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_2d_real - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_3d_real - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_4d_real - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_5d_real - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_6d_real - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_7d_real - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_0d_int - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_1d_int - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_2d_int - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_3d_int - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_4d_int - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_5d_int - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_6d_int - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_7d_int - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_0d_long - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_1d_long - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_2d_long - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_3d_long - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_4d_long - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_5d_long - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_6d_long - ! TYPE double,real,int,long - ! DIMS 0,1,2,3,4,5,6,7 - module procedure print_bad_loc_7d_long -end interface - -# 60 "CDEPS/share/shr_assert_mod.F90.in" -interface find_first_loc - ! DIMS 0,1,2,3,4,5,6,7 - module procedure find_first_loc_0d - ! DIMS 0,1,2,3,4,5,6,7 - module procedure find_first_loc_1d - ! DIMS 0,1,2,3,4,5,6,7 - module procedure find_first_loc_2d - ! DIMS 0,1,2,3,4,5,6,7 - module procedure find_first_loc_3d - ! DIMS 0,1,2,3,4,5,6,7 - module procedure find_first_loc_4d - ! DIMS 0,1,2,3,4,5,6,7 - module procedure find_first_loc_5d - ! DIMS 0,1,2,3,4,5,6,7 - module procedure find_first_loc_6d - ! DIMS 0,1,2,3,4,5,6,7 - module procedure find_first_loc_7d -end interface - -# 65 "CDEPS/share/shr_assert_mod.F90.in" -interface within_tolerance - ! TYPE double,real,int,long - module procedure within_tolerance_double - ! TYPE double,real,int,long - module procedure within_tolerance_real - ! TYPE double,real,int,long - module procedure within_tolerance_int - ! TYPE double,real,int,long - module procedure within_tolerance_long -end interface - -# 70 "CDEPS/share/shr_assert_mod.F90.in" -contains - -# 72 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert(var, msg, file, line) - - ! Logical being asserted - logical, intent(in) :: var - ! Optional error message if assert fails - character(len=*), intent(in), optional :: msg - ! Optional file and line of the caller, written out if given - ! (line is ignored if file is absent) - character(len=*), intent(in), optional :: file - integer , intent(in), optional :: line - - character(len=CL) :: full_msg - - full_msg = '' - if (.not. var) then - full_msg = 'ERROR' - if (present(file)) then - full_msg = full_msg // ' in ' // trim(file) - if (present(line)) then - full_msg = full_msg // ' at line ' // toString(line) - end if - end if - if (present(msg)) then - full_msg = full_msg // ': ' // msg - end if - call shr_sys_abort(full_msg) - end if - -# 100 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert - -! DIMS 1,2,3,4,5,6,7 -# 103 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_all_1d(var, msg, file, line) - - ! Logical being asserted - logical, intent(in) :: var(:) - ! Optional error message if assert fails - character(len=*), intent(in), optional :: msg - ! Optional file and line of the caller, written out if given - ! (line is ignored if file is absent) - character(len=*), intent(in), optional :: file - integer , intent(in), optional :: line - - call shr_assert(all(var), msg=msg, file=file, line=line) - -# 116 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_all_1d -! DIMS 1,2,3,4,5,6,7 -# 103 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_all_2d(var, msg, file, line) - - ! Logical being asserted - logical, intent(in) :: var(:,:) - ! Optional error message if assert fails - character(len=*), intent(in), optional :: msg - ! Optional file and line of the caller, written out if given - ! (line is ignored if file is absent) - character(len=*), intent(in), optional :: file - integer , intent(in), optional :: line - - call shr_assert(all(var), msg=msg, file=file, line=line) - -# 116 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_all_2d -! DIMS 1,2,3,4,5,6,7 -# 103 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_all_3d(var, msg, file, line) - - ! Logical being asserted - logical, intent(in) :: var(:,:,:) - ! Optional error message if assert fails - character(len=*), intent(in), optional :: msg - ! Optional file and line of the caller, written out if given - ! (line is ignored if file is absent) - character(len=*), intent(in), optional :: file - integer , intent(in), optional :: line - - call shr_assert(all(var), msg=msg, file=file, line=line) - -# 116 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_all_3d -! DIMS 1,2,3,4,5,6,7 -# 103 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_all_4d(var, msg, file, line) - - ! Logical being asserted - logical, intent(in) :: var(:,:,:,:) - ! Optional error message if assert fails - character(len=*), intent(in), optional :: msg - ! Optional file and line of the caller, written out if given - ! (line is ignored if file is absent) - character(len=*), intent(in), optional :: file - integer , intent(in), optional :: line - - call shr_assert(all(var), msg=msg, file=file, line=line) - -# 116 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_all_4d -! DIMS 1,2,3,4,5,6,7 -# 103 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_all_5d(var, msg, file, line) - - ! Logical being asserted - logical, intent(in) :: var(:,:,:,:,:) - ! Optional error message if assert fails - character(len=*), intent(in), optional :: msg - ! Optional file and line of the caller, written out if given - ! (line is ignored if file is absent) - character(len=*), intent(in), optional :: file - integer , intent(in), optional :: line - - call shr_assert(all(var), msg=msg, file=file, line=line) - -# 116 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_all_5d -! DIMS 1,2,3,4,5,6,7 -# 103 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_all_6d(var, msg, file, line) - - ! Logical being asserted - logical, intent(in) :: var(:,:,:,:,:,:) - ! Optional error message if assert fails - character(len=*), intent(in), optional :: msg - ! Optional file and line of the caller, written out if given - ! (line is ignored if file is absent) - character(len=*), intent(in), optional :: file - integer , intent(in), optional :: line - - call shr_assert(all(var), msg=msg, file=file, line=line) - -# 116 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_all_6d -! DIMS 1,2,3,4,5,6,7 -# 103 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_all_7d(var, msg, file, line) - - ! Logical being asserted - logical, intent(in) :: var(:,:,:,:,:,:,:) - ! Optional error message if assert fails - character(len=*), intent(in), optional :: msg - ! Optional file and line of the caller, written out if given - ! (line is ignored if file is absent) - character(len=*), intent(in), optional :: file - integer , intent(in), optional :: line - - call shr_assert(all(var), msg=msg, file=file, line=line) - -# 116 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_all_7d - -! DIMS 1,2,3,4,5,6,7 -# 119 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_any_1d(var, msg, file, line) - - ! Logical being asserted - logical, intent(in) :: var(:) - ! Optional error message if assert fails - character(len=*), intent(in), optional :: msg - ! Optional file and line of the caller, written out if given - ! (line is ignored if file is absent) - character(len=*), intent(in), optional :: file - integer , intent(in), optional :: line - - call shr_assert(any(var), msg=msg, file=file, line=line) - -# 132 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_any_1d -! DIMS 1,2,3,4,5,6,7 -# 119 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_any_2d(var, msg, file, line) - - ! Logical being asserted - logical, intent(in) :: var(:,:) - ! Optional error message if assert fails - character(len=*), intent(in), optional :: msg - ! Optional file and line of the caller, written out if given - ! (line is ignored if file is absent) - character(len=*), intent(in), optional :: file - integer , intent(in), optional :: line - - call shr_assert(any(var), msg=msg, file=file, line=line) - -# 132 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_any_2d -! DIMS 1,2,3,4,5,6,7 -# 119 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_any_3d(var, msg, file, line) - - ! Logical being asserted - logical, intent(in) :: var(:,:,:) - ! Optional error message if assert fails - character(len=*), intent(in), optional :: msg - ! Optional file and line of the caller, written out if given - ! (line is ignored if file is absent) - character(len=*), intent(in), optional :: file - integer , intent(in), optional :: line - - call shr_assert(any(var), msg=msg, file=file, line=line) - -# 132 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_any_3d -! DIMS 1,2,3,4,5,6,7 -# 119 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_any_4d(var, msg, file, line) - - ! Logical being asserted - logical, intent(in) :: var(:,:,:,:) - ! Optional error message if assert fails - character(len=*), intent(in), optional :: msg - ! Optional file and line of the caller, written out if given - ! (line is ignored if file is absent) - character(len=*), intent(in), optional :: file - integer , intent(in), optional :: line - - call shr_assert(any(var), msg=msg, file=file, line=line) - -# 132 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_any_4d -! DIMS 1,2,3,4,5,6,7 -# 119 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_any_5d(var, msg, file, line) - - ! Logical being asserted - logical, intent(in) :: var(:,:,:,:,:) - ! Optional error message if assert fails - character(len=*), intent(in), optional :: msg - ! Optional file and line of the caller, written out if given - ! (line is ignored if file is absent) - character(len=*), intent(in), optional :: file - integer , intent(in), optional :: line - - call shr_assert(any(var), msg=msg, file=file, line=line) - -# 132 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_any_5d -! DIMS 1,2,3,4,5,6,7 -# 119 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_any_6d(var, msg, file, line) - - ! Logical being asserted - logical, intent(in) :: var(:,:,:,:,:,:) - ! Optional error message if assert fails - character(len=*), intent(in), optional :: msg - ! Optional file and line of the caller, written out if given - ! (line is ignored if file is absent) - character(len=*), intent(in), optional :: file - integer , intent(in), optional :: line - - call shr_assert(any(var), msg=msg, file=file, line=line) - -# 132 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_any_6d -! DIMS 1,2,3,4,5,6,7 -# 119 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_any_7d(var, msg, file, line) - - ! Logical being asserted - logical, intent(in) :: var(:,:,:,:,:,:,:) - ! Optional error message if assert fails - character(len=*), intent(in), optional :: msg - ! Optional file and line of the caller, written out if given - ! (line is ignored if file is absent) - character(len=*), intent(in), optional :: file - integer , intent(in), optional :: line - - call shr_assert(any(var), msg=msg, file=file, line=line) - -# 132 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_any_7d - -!-------------------------------------------------------------------------- -!-------------------------------------------------------------------------- - -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_0d_double(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (102 == TYPEREAL) || (102 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (0 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - real(r8), intent(in) :: var - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - real(r8), intent(in), optional :: lt - real(r8), intent(in), optional :: gt - real(r8), intent(in), optional :: le - real(r8), intent(in), optional :: ge - real(r8), intent(in), optional :: eq - real(r8), intent(in), optional :: ne - real(r8), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(0) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - real(r8) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,0) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_0d_double -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_1d_double(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (102 == TYPEREAL) || (102 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (1 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - real(r8), intent(in) :: var(:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - real(r8), intent(in), optional :: lt - real(r8), intent(in), optional :: gt - real(r8), intent(in), optional :: le - real(r8), intent(in), optional :: ge - real(r8), intent(in), optional :: eq - real(r8), intent(in), optional :: ne - real(r8), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(1) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - real(r8) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,1) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_1d_double -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_2d_double(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (102 == TYPEREAL) || (102 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (2 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - real(r8), intent(in) :: var(:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - real(r8), intent(in), optional :: lt - real(r8), intent(in), optional :: gt - real(r8), intent(in), optional :: le - real(r8), intent(in), optional :: ge - real(r8), intent(in), optional :: eq - real(r8), intent(in), optional :: ne - real(r8), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(2) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - real(r8) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,2) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_2d_double -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_3d_double(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (102 == TYPEREAL) || (102 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (3 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - real(r8), intent(in) :: var(:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - real(r8), intent(in), optional :: lt - real(r8), intent(in), optional :: gt - real(r8), intent(in), optional :: le - real(r8), intent(in), optional :: ge - real(r8), intent(in), optional :: eq - real(r8), intent(in), optional :: ne - real(r8), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(3) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - real(r8) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,3) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_3d_double -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_4d_double(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (102 == TYPEREAL) || (102 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (4 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - real(r8), intent(in) :: var(:,:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - real(r8), intent(in), optional :: lt - real(r8), intent(in), optional :: gt - real(r8), intent(in), optional :: le - real(r8), intent(in), optional :: ge - real(r8), intent(in), optional :: eq - real(r8), intent(in), optional :: ne - real(r8), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(4) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - real(r8) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,4) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_4d_double -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_5d_double(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (102 == TYPEREAL) || (102 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (5 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - real(r8), intent(in) :: var(:,:,:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - real(r8), intent(in), optional :: lt - real(r8), intent(in), optional :: gt - real(r8), intent(in), optional :: le - real(r8), intent(in), optional :: ge - real(r8), intent(in), optional :: eq - real(r8), intent(in), optional :: ne - real(r8), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(5) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - real(r8) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,5) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_5d_double -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_6d_double(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (102 == TYPEREAL) || (102 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (6 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - real(r8), intent(in) :: var(:,:,:,:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - real(r8), intent(in), optional :: lt - real(r8), intent(in), optional :: gt - real(r8), intent(in), optional :: le - real(r8), intent(in), optional :: ge - real(r8), intent(in), optional :: eq - real(r8), intent(in), optional :: ne - real(r8), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(6) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - real(r8) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,6) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_6d_double -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_7d_double(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (102 == TYPEREAL) || (102 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (7 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - real(r8), intent(in) :: var(:,:,:,:,:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - real(r8), intent(in), optional :: lt - real(r8), intent(in), optional :: gt - real(r8), intent(in), optional :: le - real(r8), intent(in), optional :: ge - real(r8), intent(in), optional :: eq - real(r8), intent(in), optional :: ne - real(r8), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(7) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - real(r8) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,7) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_7d_double -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_0d_real(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (101 == TYPEREAL) || (101 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (0 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - real(r4), intent(in) :: var - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - real(r4), intent(in), optional :: lt - real(r4), intent(in), optional :: gt - real(r4), intent(in), optional :: le - real(r4), intent(in), optional :: ge - real(r4), intent(in), optional :: eq - real(r4), intent(in), optional :: ne - real(r4), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(0) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - real(r4) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,0) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_0d_real -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_1d_real(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (101 == TYPEREAL) || (101 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (1 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - real(r4), intent(in) :: var(:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - real(r4), intent(in), optional :: lt - real(r4), intent(in), optional :: gt - real(r4), intent(in), optional :: le - real(r4), intent(in), optional :: ge - real(r4), intent(in), optional :: eq - real(r4), intent(in), optional :: ne - real(r4), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(1) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - real(r4) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,1) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_1d_real -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_2d_real(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (101 == TYPEREAL) || (101 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (2 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - real(r4), intent(in) :: var(:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - real(r4), intent(in), optional :: lt - real(r4), intent(in), optional :: gt - real(r4), intent(in), optional :: le - real(r4), intent(in), optional :: ge - real(r4), intent(in), optional :: eq - real(r4), intent(in), optional :: ne - real(r4), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(2) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - real(r4) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,2) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_2d_real -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_3d_real(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (101 == TYPEREAL) || (101 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (3 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - real(r4), intent(in) :: var(:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - real(r4), intent(in), optional :: lt - real(r4), intent(in), optional :: gt - real(r4), intent(in), optional :: le - real(r4), intent(in), optional :: ge - real(r4), intent(in), optional :: eq - real(r4), intent(in), optional :: ne - real(r4), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(3) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - real(r4) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,3) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_3d_real -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_4d_real(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (101 == TYPEREAL) || (101 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (4 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - real(r4), intent(in) :: var(:,:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - real(r4), intent(in), optional :: lt - real(r4), intent(in), optional :: gt - real(r4), intent(in), optional :: le - real(r4), intent(in), optional :: ge - real(r4), intent(in), optional :: eq - real(r4), intent(in), optional :: ne - real(r4), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(4) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - real(r4) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,4) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_4d_real -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_5d_real(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (101 == TYPEREAL) || (101 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (5 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - real(r4), intent(in) :: var(:,:,:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - real(r4), intent(in), optional :: lt - real(r4), intent(in), optional :: gt - real(r4), intent(in), optional :: le - real(r4), intent(in), optional :: ge - real(r4), intent(in), optional :: eq - real(r4), intent(in), optional :: ne - real(r4), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(5) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - real(r4) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,5) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_5d_real -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_6d_real(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (101 == TYPEREAL) || (101 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (6 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - real(r4), intent(in) :: var(:,:,:,:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - real(r4), intent(in), optional :: lt - real(r4), intent(in), optional :: gt - real(r4), intent(in), optional :: le - real(r4), intent(in), optional :: ge - real(r4), intent(in), optional :: eq - real(r4), intent(in), optional :: ne - real(r4), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(6) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - real(r4) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,6) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_6d_real -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_7d_real(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (101 == TYPEREAL) || (101 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (7 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - real(r4), intent(in) :: var(:,:,:,:,:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - real(r4), intent(in), optional :: lt - real(r4), intent(in), optional :: gt - real(r4), intent(in), optional :: le - real(r4), intent(in), optional :: ge - real(r4), intent(in), optional :: eq - real(r4), intent(in), optional :: ne - real(r4), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(7) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - real(r4) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,7) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_7d_real -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_0d_int(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (103 == TYPEREAL) || (103 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (0 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - integer(i4), intent(in) :: var - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - integer(i4), intent(in), optional :: lt - integer(i4), intent(in), optional :: gt - integer(i4), intent(in), optional :: le - integer(i4), intent(in), optional :: ge - integer(i4), intent(in), optional :: eq - integer(i4), intent(in), optional :: ne - integer(i4), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(0) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - integer(i4) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,0) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_0d_int -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_1d_int(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (103 == TYPEREAL) || (103 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (1 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - integer(i4), intent(in) :: var(:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - integer(i4), intent(in), optional :: lt - integer(i4), intent(in), optional :: gt - integer(i4), intent(in), optional :: le - integer(i4), intent(in), optional :: ge - integer(i4), intent(in), optional :: eq - integer(i4), intent(in), optional :: ne - integer(i4), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(1) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - integer(i4) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,1) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_1d_int -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_2d_int(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (103 == TYPEREAL) || (103 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (2 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - integer(i4), intent(in) :: var(:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - integer(i4), intent(in), optional :: lt - integer(i4), intent(in), optional :: gt - integer(i4), intent(in), optional :: le - integer(i4), intent(in), optional :: ge - integer(i4), intent(in), optional :: eq - integer(i4), intent(in), optional :: ne - integer(i4), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(2) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - integer(i4) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,2) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_2d_int -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_3d_int(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (103 == TYPEREAL) || (103 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (3 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - integer(i4), intent(in) :: var(:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - integer(i4), intent(in), optional :: lt - integer(i4), intent(in), optional :: gt - integer(i4), intent(in), optional :: le - integer(i4), intent(in), optional :: ge - integer(i4), intent(in), optional :: eq - integer(i4), intent(in), optional :: ne - integer(i4), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(3) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - integer(i4) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,3) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_3d_int -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_4d_int(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (103 == TYPEREAL) || (103 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (4 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - integer(i4), intent(in) :: var(:,:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - integer(i4), intent(in), optional :: lt - integer(i4), intent(in), optional :: gt - integer(i4), intent(in), optional :: le - integer(i4), intent(in), optional :: ge - integer(i4), intent(in), optional :: eq - integer(i4), intent(in), optional :: ne - integer(i4), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(4) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - integer(i4) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,4) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_4d_int -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_5d_int(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (103 == TYPEREAL) || (103 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (5 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - integer(i4), intent(in) :: var(:,:,:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - integer(i4), intent(in), optional :: lt - integer(i4), intent(in), optional :: gt - integer(i4), intent(in), optional :: le - integer(i4), intent(in), optional :: ge - integer(i4), intent(in), optional :: eq - integer(i4), intent(in), optional :: ne - integer(i4), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(5) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - integer(i4) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,5) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_5d_int -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_6d_int(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (103 == TYPEREAL) || (103 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (6 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - integer(i4), intent(in) :: var(:,:,:,:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - integer(i4), intent(in), optional :: lt - integer(i4), intent(in), optional :: gt - integer(i4), intent(in), optional :: le - integer(i4), intent(in), optional :: ge - integer(i4), intent(in), optional :: eq - integer(i4), intent(in), optional :: ne - integer(i4), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(6) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - integer(i4) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,6) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_6d_int -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_7d_int(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (103 == TYPEREAL) || (103 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (7 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - integer(i4), intent(in) :: var(:,:,:,:,:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - integer(i4), intent(in), optional :: lt - integer(i4), intent(in), optional :: gt - integer(i4), intent(in), optional :: le - integer(i4), intent(in), optional :: ge - integer(i4), intent(in), optional :: eq - integer(i4), intent(in), optional :: ne - integer(i4), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(7) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - integer(i4) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,7) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_7d_int -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_0d_long(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (104 == TYPEREAL) || (104 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (0 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - integer(i8), intent(in) :: var - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - integer(i8), intent(in), optional :: lt - integer(i8), intent(in), optional :: gt - integer(i8), intent(in), optional :: le - integer(i8), intent(in), optional :: ge - integer(i8), intent(in), optional :: eq - integer(i8), intent(in), optional :: ne - integer(i8), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(0) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - integer(i8) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,0) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_0d_long -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_1d_long(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (104 == TYPEREAL) || (104 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (1 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - integer(i8), intent(in) :: var(:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - integer(i8), intent(in), optional :: lt - integer(i8), intent(in), optional :: gt - integer(i8), intent(in), optional :: le - integer(i8), intent(in), optional :: ge - integer(i8), intent(in), optional :: eq - integer(i8), intent(in), optional :: ne - integer(i8), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(1) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - integer(i8) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,1) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_1d_long -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_2d_long(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (104 == TYPEREAL) || (104 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (2 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - integer(i8), intent(in) :: var(:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - integer(i8), intent(in), optional :: lt - integer(i8), intent(in), optional :: gt - integer(i8), intent(in), optional :: le - integer(i8), intent(in), optional :: ge - integer(i8), intent(in), optional :: eq - integer(i8), intent(in), optional :: ne - integer(i8), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(2) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - integer(i8) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,2) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_2d_long -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_3d_long(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (104 == TYPEREAL) || (104 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (3 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - integer(i8), intent(in) :: var(:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - integer(i8), intent(in), optional :: lt - integer(i8), intent(in), optional :: gt - integer(i8), intent(in), optional :: le - integer(i8), intent(in), optional :: ge - integer(i8), intent(in), optional :: eq - integer(i8), intent(in), optional :: ne - integer(i8), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(3) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - integer(i8) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,3) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_3d_long -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_4d_long(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (104 == TYPEREAL) || (104 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (4 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - integer(i8), intent(in) :: var(:,:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - integer(i8), intent(in), optional :: lt - integer(i8), intent(in), optional :: gt - integer(i8), intent(in), optional :: le - integer(i8), intent(in), optional :: ge - integer(i8), intent(in), optional :: eq - integer(i8), intent(in), optional :: ne - integer(i8), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(4) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - integer(i8) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,4) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_4d_long -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_5d_long(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (104 == TYPEREAL) || (104 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (5 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - integer(i8), intent(in) :: var(:,:,:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - integer(i8), intent(in), optional :: lt - integer(i8), intent(in), optional :: gt - integer(i8), intent(in), optional :: le - integer(i8), intent(in), optional :: ge - integer(i8), intent(in), optional :: eq - integer(i8), intent(in), optional :: ne - integer(i8), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(5) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - integer(i8) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,5) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_5d_long -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_6d_long(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (104 == TYPEREAL) || (104 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (6 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - integer(i8), intent(in) :: var(:,:,:,:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - integer(i8), intent(in), optional :: lt - integer(i8), intent(in), optional :: gt - integer(i8), intent(in), optional :: le - integer(i8), intent(in), optional :: ge - integer(i8), intent(in), optional :: eq - integer(i8), intent(in), optional :: ne - integer(i8), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(6) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - integer(i8) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,6) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_6d_long -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" -subroutine shr_assert_in_domain_7d_long(var, varname, msg, & - is_nan, lt, gt, le, ge, eq, ne, abs_tol) - -!----------------------------- -! BEGIN defining local macros -!----------------------------- - -! Flag for floating point types. - -#if (104 == TYPEREAL) || (104 == TYPEDOUBLE) -#define TYPEFP -#else -#undef TYPEFP -#endif - -! "Generalized" macro functions allow transformational intrinsic functions -! to handle both scalars and arrays. - -#if (7 != 0) -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif - -!----------------------------- -! END macro section -!----------------------------- - - ! Variable being checked. - integer(i8), intent(in) :: var(:,:,:,:,:,:,:) - ! Variable name to be used in error messages. - character(len=*), intent(in), optional :: varname - ! Optional error message if assert fails. - character(len=*), intent(in), optional :: msg - ! Assert that the variable is not (or is) NaN. - logical, intent(in), optional :: is_nan - ! Limits for (in)equalities. - integer(i8), intent(in), optional :: lt - integer(i8), intent(in), optional :: gt - integer(i8), intent(in), optional :: le - integer(i8), intent(in), optional :: ge - integer(i8), intent(in), optional :: eq - integer(i8), intent(in), optional :: ne - integer(i8), intent(in), optional :: abs_tol - - ! Note that the following array is size 0 for scalars. - integer :: loc_vec(7) - - logical :: is_nan_passed - logical :: lt_passed - logical :: gt_passed - logical :: le_passed - logical :: ge_passed - logical :: eq_passed - logical :: ne_passed - - integer(i8) :: abs_tol_loc - - ! Handling of abs_tol makes a couple of fairly safe assumptions. - ! 1. It is not the most negative integer. - ! 2. It is finite (not a floating point infinity or NaN). - if (present(abs_tol)) then - abs_tol_loc = abs(abs_tol) - else - abs_tol_loc = 0_i4 - end if - - is_nan_passed = .true. - lt_passed = .true. - gt_passed = .true. - le_passed = .true. - ge_passed = .true. - eq_passed = .true. - ne_passed = .true. - - ! Do one pass just to find out if we can return with no problem. - -#ifdef TYPEFP - ! Only floating-point values can actually be Inf/NaN. - if (present(is_nan)) & - is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) -#else - if (present(is_nan)) & - is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 -#endif - - if (present(lt)) & - lt_passed = GEN_ALL(var < lt) - - if (present(gt)) & - gt_passed = GEN_ALL(var > gt) - - if (present(le)) & - le_passed = GEN_ALL(var <= le) - - if (present(ge)) & - ge_passed = GEN_ALL(var >= ge) - - if (present(eq)) then - eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) - end if - - if (present(ne)) then - ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) - end if - - if ( is_nan_passed .and. & - lt_passed .and. & - gt_passed .and. & - le_passed .and. & - ge_passed .and. & - eq_passed .and. & - ne_passed) & - return - - ! If we got here, assert will fail, so find out where so that we - ! can try to print something useful. - - if (.not. is_nan_passed) then -#ifdef TYPEFP - loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) "Expected value to be NaN." - else - write(shr_log_Unit,*) "Expected value to be a number." - end if -#else - loc_vec = spread(1,1,7) - call print_bad_loc(var, loc_vec, varname) - if (is_nan) then - write(shr_log_Unit,*) & - "Asserted NaN, but the variable is not floating-point!" - end if -#endif - end if - - if (.not. lt_passed) then - loc_vec = find_first_loc(var >= lt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than ",lt - end if - - if (.not. gt_passed) then - loc_vec = find_first_loc(var <= gt) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than ",gt - end if - - if (.not. le_passed) then - loc_vec = find_first_loc(var > le) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be less than or & - &equal to ",le - end if - - if (.not. ge_passed) then - loc_vec = find_first_loc(var < ge) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be greater than or & - &equal to ",ge - end if - - if (.not. eq_passed) then - loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to be equal to ",eq - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - if (.not. ne_passed) then - loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) - call print_bad_loc(var, loc_vec, varname) - write(shr_log_Unit,*) "Expected value to never be equal to ",ne - if (abs_tol_loc > 0) & - write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc - end if - - call shr_sys_abort(msg) - -! Undefine local macros. -#undef TYPEFP -#undef GEN_SIZE -#undef GEN_ALL - -# 334 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine shr_assert_in_domain_7d_long - -!-------------------------------------------------------------------------- -!-------------------------------------------------------------------------- - -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_0d_double(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - real(r8), intent(in) :: var - integer, intent(in) :: loc_vec(0) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (0 != 0) - var(), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_0d_double -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_1d_double(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - real(r8), intent(in) :: var(:) - integer, intent(in) :: loc_vec(1) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (1 != 0) - var(loc_vec(1)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_1d_double -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_2d_double(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - real(r8), intent(in) :: var(:,:) - integer, intent(in) :: loc_vec(2) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (2 != 0) - var(loc_vec(1),& -loc_vec(2)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_2d_double -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_3d_double(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - real(r8), intent(in) :: var(:,:,:) - integer, intent(in) :: loc_vec(3) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (3 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_3d_double -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_4d_double(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - real(r8), intent(in) :: var(:,:,:,:) - integer, intent(in) :: loc_vec(4) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (4 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3),& -loc_vec(4)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_4d_double -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_5d_double(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - real(r8), intent(in) :: var(:,:,:,:,:) - integer, intent(in) :: loc_vec(5) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (5 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3),& -loc_vec(4),& -loc_vec(5)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_5d_double -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_6d_double(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - real(r8), intent(in) :: var(:,:,:,:,:,:) - integer, intent(in) :: loc_vec(6) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (6 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3),& -loc_vec(4),& -loc_vec(5),& -loc_vec(6)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_6d_double -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_7d_double(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - real(r8), intent(in) :: var(:,:,:,:,:,:,:) - integer, intent(in) :: loc_vec(7) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (7 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3),& -loc_vec(4),& -loc_vec(5),& -loc_vec(6),& -loc_vec(7)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_7d_double -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_0d_real(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - real(r4), intent(in) :: var - integer, intent(in) :: loc_vec(0) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (0 != 0) - var(), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_0d_real -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_1d_real(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - real(r4), intent(in) :: var(:) - integer, intent(in) :: loc_vec(1) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (1 != 0) - var(loc_vec(1)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_1d_real -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_2d_real(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - real(r4), intent(in) :: var(:,:) - integer, intent(in) :: loc_vec(2) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (2 != 0) - var(loc_vec(1),& -loc_vec(2)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_2d_real -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_3d_real(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - real(r4), intent(in) :: var(:,:,:) - integer, intent(in) :: loc_vec(3) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (3 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_3d_real -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_4d_real(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - real(r4), intent(in) :: var(:,:,:,:) - integer, intent(in) :: loc_vec(4) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (4 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3),& -loc_vec(4)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_4d_real -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_5d_real(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - real(r4), intent(in) :: var(:,:,:,:,:) - integer, intent(in) :: loc_vec(5) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (5 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3),& -loc_vec(4),& -loc_vec(5)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_5d_real -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_6d_real(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - real(r4), intent(in) :: var(:,:,:,:,:,:) - integer, intent(in) :: loc_vec(6) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (6 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3),& -loc_vec(4),& -loc_vec(5),& -loc_vec(6)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_6d_real -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_7d_real(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - real(r4), intent(in) :: var(:,:,:,:,:,:,:) - integer, intent(in) :: loc_vec(7) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (7 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3),& -loc_vec(4),& -loc_vec(5),& -loc_vec(6),& -loc_vec(7)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_7d_real -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_0d_int(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - integer(i4), intent(in) :: var - integer, intent(in) :: loc_vec(0) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (0 != 0) - var(), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_0d_int -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_1d_int(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - integer(i4), intent(in) :: var(:) - integer, intent(in) :: loc_vec(1) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (1 != 0) - var(loc_vec(1)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_1d_int -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_2d_int(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - integer(i4), intent(in) :: var(:,:) - integer, intent(in) :: loc_vec(2) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (2 != 0) - var(loc_vec(1),& -loc_vec(2)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_2d_int -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_3d_int(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - integer(i4), intent(in) :: var(:,:,:) - integer, intent(in) :: loc_vec(3) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (3 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_3d_int -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_4d_int(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - integer(i4), intent(in) :: var(:,:,:,:) - integer, intent(in) :: loc_vec(4) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (4 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3),& -loc_vec(4)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_4d_int -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_5d_int(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - integer(i4), intent(in) :: var(:,:,:,:,:) - integer, intent(in) :: loc_vec(5) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (5 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3),& -loc_vec(4),& -loc_vec(5)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_5d_int -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_6d_int(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - integer(i4), intent(in) :: var(:,:,:,:,:,:) - integer, intent(in) :: loc_vec(6) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (6 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3),& -loc_vec(4),& -loc_vec(5),& -loc_vec(6)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_6d_int -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_7d_int(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - integer(i4), intent(in) :: var(:,:,:,:,:,:,:) - integer, intent(in) :: loc_vec(7) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (7 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3),& -loc_vec(4),& -loc_vec(5),& -loc_vec(6),& -loc_vec(7)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_7d_int -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_0d_long(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - integer(i8), intent(in) :: var - integer, intent(in) :: loc_vec(0) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (0 != 0) - var(), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_0d_long -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_1d_long(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - integer(i8), intent(in) :: var(:) - integer, intent(in) :: loc_vec(1) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (1 != 0) - var(loc_vec(1)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_1d_long -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_2d_long(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - integer(i8), intent(in) :: var(:,:) - integer, intent(in) :: loc_vec(2) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (2 != 0) - var(loc_vec(1),& -loc_vec(2)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_2d_long -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_3d_long(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - integer(i8), intent(in) :: var(:,:,:) - integer, intent(in) :: loc_vec(3) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (3 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_3d_long -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_4d_long(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - integer(i8), intent(in) :: var(:,:,:,:) - integer, intent(in) :: loc_vec(4) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (4 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3),& -loc_vec(4)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_4d_long -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_5d_long(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - integer(i8), intent(in) :: var(:,:,:,:,:) - integer, intent(in) :: loc_vec(5) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (5 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3),& -loc_vec(4),& -loc_vec(5)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_5d_long -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_6d_long(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - integer(i8), intent(in) :: var(:,:,:,:,:,:) - integer, intent(in) :: loc_vec(6) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (6 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3),& -loc_vec(4),& -loc_vec(5),& -loc_vec(6)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_6d_long -! TYPE double,real,int,long -! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" -subroutine print_bad_loc_7d_long(var, loc_vec, varname) - ! Print information about a bad location in an variable. - ! For scalars, just print value. - - integer(i8), intent(in) :: var(:,:,:,:,:,:,:) - integer, intent(in) :: loc_vec(7) - - character(len=*), intent(in), optional :: varname - - character(len=:), allocatable :: varname_to_write - - if (present(varname)) then - allocate(varname_to_write, source=varname) - else - allocate(varname_to_write, source="input variable") - end if - - write(shr_log_Unit,*) & - "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & - " has invalid value ", & -#if (7 != 0) - var(loc_vec(1),& -loc_vec(2),& -loc_vec(3),& -loc_vec(4),& -loc_vec(5),& -loc_vec(6),& -loc_vec(7)), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif - -# 371 "CDEPS/share/shr_assert_mod.F90.in" -end subroutine print_bad_loc_7d_long - -!-------------------------------------------------------------------------- -!-------------------------------------------------------------------------- - -! DIMS 0,1,2,3,4,5,6,7 -# 377 "CDEPS/share/shr_assert_mod.F90.in" -pure function find_first_loc_0d(mask) result (loc_vec) - ! Inefficient but simple subroutine for finding the location of - ! the first .true. value in an array. - ! If no true values, returns first value. - - logical, intent(in) :: mask - integer :: loc_vec(0) - -#if (0 != 0) - integer :: flags() - - where (mask) - flags = 1 - elsewhere - flags = 0 - end where - - loc_vec = maxloc(flags) -#else - -! Remove compiler warnings (statement will be optimized out). - -#if (! defined CPRPGI && ! defined CPRCRAY) - if (.false. .and. mask) loc_vec = loc_vec -#endif - -#endif - -# 405 "CDEPS/share/shr_assert_mod.F90.in" -end function find_first_loc_0d -! DIMS 0,1,2,3,4,5,6,7 -# 377 "CDEPS/share/shr_assert_mod.F90.in" -pure function find_first_loc_1d(mask) result (loc_vec) - ! Inefficient but simple subroutine for finding the location of - ! the first .true. value in an array. - ! If no true values, returns first value. - - logical, intent(in) :: mask(:) - integer :: loc_vec(1) - -#if (1 != 0) - integer :: flags(size(mask,1)) - - where (mask) - flags = 1 - elsewhere - flags = 0 - end where - - loc_vec = maxloc(flags) -#else - -! Remove compiler warnings (statement will be optimized out). - -#if (! defined CPRPGI && ! defined CPRCRAY) - if (.false. .and. mask) loc_vec = loc_vec -#endif - -#endif - -# 405 "CDEPS/share/shr_assert_mod.F90.in" -end function find_first_loc_1d -! DIMS 0,1,2,3,4,5,6,7 -# 377 "CDEPS/share/shr_assert_mod.F90.in" -pure function find_first_loc_2d(mask) result (loc_vec) - ! Inefficient but simple subroutine for finding the location of - ! the first .true. value in an array. - ! If no true values, returns first value. - - logical, intent(in) :: mask(:,:) - integer :: loc_vec(2) - -#if (2 != 0) - integer :: flags(size(mask,1),& -size(mask,2)) - - where (mask) - flags = 1 - elsewhere - flags = 0 - end where - - loc_vec = maxloc(flags) -#else - -! Remove compiler warnings (statement will be optimized out). - -#if (! defined CPRPGI && ! defined CPRCRAY) - if (.false. .and. mask) loc_vec = loc_vec -#endif - -#endif - -# 405 "CDEPS/share/shr_assert_mod.F90.in" -end function find_first_loc_2d -! DIMS 0,1,2,3,4,5,6,7 -# 377 "CDEPS/share/shr_assert_mod.F90.in" -pure function find_first_loc_3d(mask) result (loc_vec) - ! Inefficient but simple subroutine for finding the location of - ! the first .true. value in an array. - ! If no true values, returns first value. - - logical, intent(in) :: mask(:,:,:) - integer :: loc_vec(3) - -#if (3 != 0) - integer :: flags(size(mask,1),& -size(mask,2),& -size(mask,3)) - - where (mask) - flags = 1 - elsewhere - flags = 0 - end where - - loc_vec = maxloc(flags) -#else - -! Remove compiler warnings (statement will be optimized out). - -#if (! defined CPRPGI && ! defined CPRCRAY) - if (.false. .and. mask) loc_vec = loc_vec -#endif - -#endif - -# 405 "CDEPS/share/shr_assert_mod.F90.in" -end function find_first_loc_3d -! DIMS 0,1,2,3,4,5,6,7 -# 377 "CDEPS/share/shr_assert_mod.F90.in" -pure function find_first_loc_4d(mask) result (loc_vec) - ! Inefficient but simple subroutine for finding the location of - ! the first .true. value in an array. - ! If no true values, returns first value. - - logical, intent(in) :: mask(:,:,:,:) - integer :: loc_vec(4) - -#if (4 != 0) - integer :: flags(size(mask,1),& -size(mask,2),& -size(mask,3),& -size(mask,4)) - - where (mask) - flags = 1 - elsewhere - flags = 0 - end where - - loc_vec = maxloc(flags) -#else - -! Remove compiler warnings (statement will be optimized out). - -#if (! defined CPRPGI && ! defined CPRCRAY) - if (.false. .and. mask) loc_vec = loc_vec -#endif - -#endif - -# 405 "CDEPS/share/shr_assert_mod.F90.in" -end function find_first_loc_4d -! DIMS 0,1,2,3,4,5,6,7 -# 377 "CDEPS/share/shr_assert_mod.F90.in" -pure function find_first_loc_5d(mask) result (loc_vec) - ! Inefficient but simple subroutine for finding the location of - ! the first .true. value in an array. - ! If no true values, returns first value. - - logical, intent(in) :: mask(:,:,:,:,:) - integer :: loc_vec(5) - -#if (5 != 0) - integer :: flags(size(mask,1),& -size(mask,2),& -size(mask,3),& -size(mask,4),& -size(mask,5)) - - where (mask) - flags = 1 - elsewhere - flags = 0 - end where - - loc_vec = maxloc(flags) -#else - -! Remove compiler warnings (statement will be optimized out). - -#if (! defined CPRPGI && ! defined CPRCRAY) - if (.false. .and. mask) loc_vec = loc_vec -#endif - -#endif - -# 405 "CDEPS/share/shr_assert_mod.F90.in" -end function find_first_loc_5d -! DIMS 0,1,2,3,4,5,6,7 -# 377 "CDEPS/share/shr_assert_mod.F90.in" -pure function find_first_loc_6d(mask) result (loc_vec) - ! Inefficient but simple subroutine for finding the location of - ! the first .true. value in an array. - ! If no true values, returns first value. - - logical, intent(in) :: mask(:,:,:,:,:,:) - integer :: loc_vec(6) - -#if (6 != 0) - integer :: flags(size(mask,1),& -size(mask,2),& -size(mask,3),& -size(mask,4),& -size(mask,5),& -size(mask,6)) - - where (mask) - flags = 1 - elsewhere - flags = 0 - end where - - loc_vec = maxloc(flags) -#else - -! Remove compiler warnings (statement will be optimized out). - -#if (! defined CPRPGI && ! defined CPRCRAY) - if (.false. .and. mask) loc_vec = loc_vec -#endif - -#endif - -# 405 "CDEPS/share/shr_assert_mod.F90.in" -end function find_first_loc_6d -! DIMS 0,1,2,3,4,5,6,7 -# 377 "CDEPS/share/shr_assert_mod.F90.in" -pure function find_first_loc_7d(mask) result (loc_vec) - ! Inefficient but simple subroutine for finding the location of - ! the first .true. value in an array. - ! If no true values, returns first value. - - logical, intent(in) :: mask(:,:,:,:,:,:,:) - integer :: loc_vec(7) - -#if (7 != 0) - integer :: flags(size(mask,1),& -size(mask,2),& -size(mask,3),& -size(mask,4),& -size(mask,5),& -size(mask,6),& -size(mask,7)) - - where (mask) - flags = 1 - elsewhere - flags = 0 - end where - - loc_vec = maxloc(flags) -#else - -! Remove compiler warnings (statement will be optimized out). - -#if (! defined CPRPGI && ! defined CPRCRAY) - if (.false. .and. mask) loc_vec = loc_vec -#endif - -#endif - -# 405 "CDEPS/share/shr_assert_mod.F90.in" -end function find_first_loc_7d - -! TYPE double,real,int,long -# 408 "CDEPS/share/shr_assert_mod.F90.in" -elemental function within_tolerance_double(expected, actual, tolerance) & - result(is_in_tol) - ! Precondition: tolerance must be >= 0. - real(r8), intent(in) :: expected - real(r8), intent(in) :: actual - real(r8), intent(in) :: tolerance - logical :: is_in_tol - - ! The following conditionals are to ensure that we don't overflow. - - ! This takes care of two identical infinities. - if (actual == expected) then - is_in_tol = .true. - else if (actual > expected) then - if (expected >= 0) then - is_in_tol = (actual - expected) <= tolerance - else - is_in_tol = actual <= (expected + tolerance) - end if - else - if (expected < 0) then - is_in_tol = (expected - actual) <= tolerance - else - is_in_tol = actual >= (expected - tolerance) - end if - end if - -# 435 "CDEPS/share/shr_assert_mod.F90.in" -end function within_tolerance_double -! TYPE double,real,int,long -# 408 "CDEPS/share/shr_assert_mod.F90.in" -elemental function within_tolerance_real(expected, actual, tolerance) & - result(is_in_tol) - ! Precondition: tolerance must be >= 0. - real(r4), intent(in) :: expected - real(r4), intent(in) :: actual - real(r4), intent(in) :: tolerance - logical :: is_in_tol - - ! The following conditionals are to ensure that we don't overflow. - - ! This takes care of two identical infinities. - if (actual == expected) then - is_in_tol = .true. - else if (actual > expected) then - if (expected >= 0) then - is_in_tol = (actual - expected) <= tolerance - else - is_in_tol = actual <= (expected + tolerance) - end if - else - if (expected < 0) then - is_in_tol = (expected - actual) <= tolerance - else - is_in_tol = actual >= (expected - tolerance) - end if - end if - -# 435 "CDEPS/share/shr_assert_mod.F90.in" -end function within_tolerance_real -! TYPE double,real,int,long -# 408 "CDEPS/share/shr_assert_mod.F90.in" -elemental function within_tolerance_int(expected, actual, tolerance) & - result(is_in_tol) - ! Precondition: tolerance must be >= 0. - integer(i4), intent(in) :: expected - integer(i4), intent(in) :: actual - integer(i4), intent(in) :: tolerance - logical :: is_in_tol - - ! The following conditionals are to ensure that we don't overflow. - - ! This takes care of two identical infinities. - if (actual == expected) then - is_in_tol = .true. - else if (actual > expected) then - if (expected >= 0) then - is_in_tol = (actual - expected) <= tolerance - else - is_in_tol = actual <= (expected + tolerance) - end if - else - if (expected < 0) then - is_in_tol = (expected - actual) <= tolerance - else - is_in_tol = actual >= (expected - tolerance) - end if - end if - -# 435 "CDEPS/share/shr_assert_mod.F90.in" -end function within_tolerance_int -! TYPE double,real,int,long -# 408 "CDEPS/share/shr_assert_mod.F90.in" -elemental function within_tolerance_long(expected, actual, tolerance) & - result(is_in_tol) - ! Precondition: tolerance must be >= 0. - integer(i8), intent(in) :: expected - integer(i8), intent(in) :: actual - integer(i8), intent(in) :: tolerance - logical :: is_in_tol - - ! The following conditionals are to ensure that we don't overflow. - - ! This takes care of two identical infinities. - if (actual == expected) then - is_in_tol = .true. - else if (actual > expected) then - if (expected >= 0) then - is_in_tol = (actual - expected) <= tolerance - else - is_in_tol = actual <= (expected + tolerance) - end if - else - if (expected < 0) then - is_in_tol = (expected - actual) <= tolerance - else - is_in_tol = actual >= (expected - tolerance) - end if - end if - -# 435 "CDEPS/share/shr_assert_mod.F90.in" -end function within_tolerance_long - -end module shr_assert_mod diff --git a/CDEPS/share/shr_frz_mod.F90 b/CDEPS/share/shr_frz_mod.F90 deleted file mode 100644 index 82f6502..0000000 --- a/CDEPS/share/shr_frz_mod.F90 +++ /dev/null @@ -1,215 +0,0 @@ -!=================================================== -! DO NOT EDIT THIS FILE, it was generated using /home/micael/genf90.pl -! Any changes you make to this file may be lost -!=================================================== -module shr_frz_mod - - !=============================================================================== - ! This is a module used for the freezing point of salt water - !=============================================================================== - - use shr_kind_mod, only: R8=>SHR_KIND_R8, CS=>SHR_KIND_CS - use shr_log_mod, only: s_logunit => shr_log_Unit, shr_log_level - use shr_sys_mod, only: shr_sys_abort - - implicit none - - !---------------------------------------------------------------------------- - ! PUBLIC: Interfaces and global data - !---------------------------------------------------------------------------- - public :: shr_frz_freezetemp, shr_frz_freezetemp_init - -# 18 "CDEPS/share/shr_frz_mod.F90.in" - interface shr_frz_freezetemp - module procedure shr_frz_freezetemp_0d - module procedure shr_frz_freezetemp_1d - module procedure shr_frz_freezetemp_2d - end interface shr_frz_freezetemp - - integer, public, parameter :: TFREEZE_OPTION_MINUS1P8 = 1 - integer, public, parameter :: TFREEZE_OPTION_LINEAR_SALT = 2 - integer, public, parameter :: TFREEZE_OPTION_MUSHY = 3 - integer, public, parameter :: TFREEZE_OPTION_UNINITIALIZED = -999 - - private - - integer :: tfrz_option = TFREEZE_OPTION_UNINITIALIZED - - !=============================================================================== -# 34 "CDEPS/share/shr_frz_mod.F90.in" -contains - !=============================================================================== - -# 37 "CDEPS/share/shr_frz_mod.F90.in" - subroutine shr_frz_freezetemp_init(tfreeze_option, maintask) - - implicit none - - character(len=*),parameter :: subname = "(shr_frz_freezetemp_init) " - character(CS),intent(in) :: tfreeze_option ! option for computing freezing point - logical, intent(in) :: maintask ! for io - ! minus1p8 is constant -1.8C - ! linear_salt is linear equation - ! mushy for CICE mushy-layer nonlinear equation - - !--------------------------------------------------------------- - ! Check tfreeze_option - !--------------------------------------------------------------- - if (trim(tfreeze_option) == 'minus1p8') then - if (maintask .and. shr_log_level>0) write(s_logunit,*) ' tfreeze_option is minus1p8' - tfrz_option = TFREEZE_OPTION_MINUS1P8 - elseif (trim(tfreeze_option) == 'linear_salt') then - if (maintask .and. shr_log_level>0) write(s_logunit,*) ' tfreeze_option is linear_salt' - tfrz_option = TFREEZE_OPTION_LINEAR_SALT - elseif (trim(tfreeze_option) == 'mushy') then - if (maintask .and. shr_log_level>0) write(s_logunit,*) ' tfreeze_option is mushy' - tfrz_option = TFREEZE_OPTION_MUSHY - else - call shr_sys_abort(subname//' ERROR: not a valid tfreeze_option '//trim(tfreeze_option)) - endif - -# 64 "CDEPS/share/shr_frz_mod.F90.in" - end subroutine shr_frz_freezetemp_init - - ! DIMS 0,1,2 -# 67 "CDEPS/share/shr_frz_mod.F90.in" - function shr_frz_freezetemp_0d(s) result(shr_frz_freezetemp) - - !---------------------------------------------------------------------------- - ! - ! FUNCTION to return the freezing point of salt water in degrees Celsus - ! - !--------------- Code History ----------------------------------------------- - ! - ! Original Author: David Bailey - ! Date: Feb, 2016 - !---------------------------------------------------------------------------- - - implicit none - - character(len=*),parameter :: subname = "(shr_frz_freezetemp_0d) " - - real (R8),intent(in) :: s ! Salinity in psu -#if (0==0) - real (R8) :: shr_frz_freezetemp -#elif (0==1) - real (R8) :: shr_frz_freezetemp(size(s)) -#elif (0==2) - real (R8) :: shr_frz_freezetemp(size(s,1),size(s,2)) -#endif - - !---------------------------------------------------------------------------- - shr_frz_freezetemp = -274.0_R8 - if (tfrz_option == TFREEZE_OPTION_MINUS1P8) then - shr_frz_freezetemp = -1.8_R8 - elseif (tfrz_option == TFREEZE_OPTION_LINEAR_SALT) then - shr_frz_freezetemp = -0.0544_R8*max(s,0.0_R8) - elseif (tfrz_option == TFREEZE_OPTION_MUSHY) then - ! This form is the high temperature part of the liquidus relation (Assur 1958) - shr_frz_freezetemp = max(s,0.0_R8) & - / (-18.48_R8 + (0.01848_R8*max(s,0.0_R8))) - else - call shr_sys_abort(subname//' ERROR: not intialized correctly with a valid tfreeze_option - & - &call shr_frz_freezetemp_init first with a valid tfreeze_option') - endif - - shr_frz_freezetemp = max(shr_frz_freezetemp,-2.0_R8) - -# 109 "CDEPS/share/shr_frz_mod.F90.in" - end function shr_frz_freezetemp_0d - ! DIMS 0,1,2 -# 67 "CDEPS/share/shr_frz_mod.F90.in" - function shr_frz_freezetemp_1d(s) result(shr_frz_freezetemp) - - !---------------------------------------------------------------------------- - ! - ! FUNCTION to return the freezing point of salt water in degrees Celsus - ! - !--------------- Code History ----------------------------------------------- - ! - ! Original Author: David Bailey - ! Date: Feb, 2016 - !---------------------------------------------------------------------------- - - implicit none - - character(len=*),parameter :: subname = "(shr_frz_freezetemp_1d) " - - real (R8),intent(in) :: s(:) ! Salinity in psu -#if (1==0) - real (R8) :: shr_frz_freezetemp -#elif (1==1) - real (R8) :: shr_frz_freezetemp(size(s)) -#elif (1==2) - real (R8) :: shr_frz_freezetemp(size(s,1),size(s,2)) -#endif - - !---------------------------------------------------------------------------- - shr_frz_freezetemp = -274.0_R8 - if (tfrz_option == TFREEZE_OPTION_MINUS1P8) then - shr_frz_freezetemp = -1.8_R8 - elseif (tfrz_option == TFREEZE_OPTION_LINEAR_SALT) then - shr_frz_freezetemp = -0.0544_R8*max(s,0.0_R8) - elseif (tfrz_option == TFREEZE_OPTION_MUSHY) then - ! This form is the high temperature part of the liquidus relation (Assur 1958) - shr_frz_freezetemp = max(s,0.0_R8) & - / (-18.48_R8 + (0.01848_R8*max(s,0.0_R8))) - else - call shr_sys_abort(subname//' ERROR: not intialized correctly with a valid tfreeze_option - & - &call shr_frz_freezetemp_init first with a valid tfreeze_option') - endif - - shr_frz_freezetemp = max(shr_frz_freezetemp,-2.0_R8) - -# 109 "CDEPS/share/shr_frz_mod.F90.in" - end function shr_frz_freezetemp_1d - ! DIMS 0,1,2 -# 67 "CDEPS/share/shr_frz_mod.F90.in" - function shr_frz_freezetemp_2d(s) result(shr_frz_freezetemp) - - !---------------------------------------------------------------------------- - ! - ! FUNCTION to return the freezing point of salt water in degrees Celsus - ! - !--------------- Code History ----------------------------------------------- - ! - ! Original Author: David Bailey - ! Date: Feb, 2016 - !---------------------------------------------------------------------------- - - implicit none - - character(len=*),parameter :: subname = "(shr_frz_freezetemp_2d) " - - real (R8),intent(in) :: s(:,:) ! Salinity in psu -#if (2==0) - real (R8) :: shr_frz_freezetemp -#elif (2==1) - real (R8) :: shr_frz_freezetemp(size(s)) -#elif (2==2) - real (R8) :: shr_frz_freezetemp(size(s,1),size(s,2)) -#endif - - !---------------------------------------------------------------------------- - shr_frz_freezetemp = -274.0_R8 - if (tfrz_option == TFREEZE_OPTION_MINUS1P8) then - shr_frz_freezetemp = -1.8_R8 - elseif (tfrz_option == TFREEZE_OPTION_LINEAR_SALT) then - shr_frz_freezetemp = -0.0544_R8*max(s,0.0_R8) - elseif (tfrz_option == TFREEZE_OPTION_MUSHY) then - ! This form is the high temperature part of the liquidus relation (Assur 1958) - shr_frz_freezetemp = max(s,0.0_R8) & - / (-18.48_R8 + (0.01848_R8*max(s,0.0_R8))) - else - call shr_sys_abort(subname//' ERROR: not intialized correctly with a valid tfreeze_option - & - &call shr_frz_freezetemp_init first with a valid tfreeze_option') - endif - - shr_frz_freezetemp = max(shr_frz_freezetemp,-2.0_R8) - -# 109 "CDEPS/share/shr_frz_mod.F90.in" - end function shr_frz_freezetemp_2d - - !=============================================================================== - -end module shr_frz_mod diff --git a/CDEPS/share/shr_infnan_mod.F90 b/CDEPS/share/shr_infnan_mod.F90 deleted file mode 100644 index 2ba6eb9..0000000 --- a/CDEPS/share/shr_infnan_mod.F90 +++ /dev/null @@ -1,1909 +0,0 @@ -#include "dtypes.h" -!=================================================== -! DO NOT EDIT THIS FILE, it was generated using /home/micael/genf90.pl -! Any changes you make to this file may be lost -!=================================================== -! Flag representing compiler support of Fortran 2003's -! ieee_arithmetic intrinsic module. -#if defined CPRIBM || defined CPRPGI || defined CPRINTEL || defined CPRCRAY || defined CPRNAG -#define HAVE_IEEE_ARITHMETIC -#endif - -module shr_infnan_mod -!--------------------------------------------------------------------- -! Module to test for IEEE Inf and NaN values, which also provides a -! method of setting +/-Inf and signaling or quiet NaN. -! -! All functions are elemental, and thus work on arrays. -!--------------------------------------------------------------------- -! To test for these values, just call the corresponding function, e.g: -! -! var_is_nan = shr_infnan_isnan(x) -! -! You can also use it on arrays: -! -! array_contains_nan = any(shr_infnan_isnan(my_array)) -! -!--------------------------------------------------------------------- -! To generate these values, assign one of the provided derived-type -! variables to a real: -! -! use shr_infnan_mod, only: nan => shr_infnan_nan, & -! inf => shr_infnan_inf, & -! assignment(=) -! real(r4) :: my_nan -! real(r8) :: my_inf_array(2,2) -! my_nan = nan -! my_inf_array = inf -! -! Keep in mind that "shr_infnan_nan" and "shr_infnan_inf" cannot be -! passed to functions that expect real arguments. To pass a real -! NaN, you will have to use shr_infnan_nan to set a local real of -! the correct kind. -!--------------------------------------------------------------------- - -use shr_kind_mod, only: & - r4 => SHR_KIND_R4, & - r8 => SHR_KIND_R8 - -#ifdef HAVE_IEEE_ARITHMETIC - -! If we have IEEE_ARITHMETIC, the NaN test is provided for us. -use, intrinsic :: ieee_arithmetic, only: & - shr_infnan_isnan => ieee_is_nan - -#else - -! Integers of correct size for bit patterns below. -use shr_kind_mod, only: i4 => shr_kind_i4, i8 => shr_kind_i8 - -#endif - -implicit none -private -save - -! Test functions for NaN/Inf values. -public :: shr_infnan_isnan -public :: shr_infnan_isinf -public :: shr_infnan_isposinf -public :: shr_infnan_isneginf - -! Locally defined isnan. -#ifndef HAVE_IEEE_ARITHMETIC -# 69 "CDEPS/share/shr_infnan_mod.F90.in" -interface shr_infnan_isnan - ! TYPE double,real - module procedure shr_infnan_isnan_double - ! TYPE double,real - module procedure shr_infnan_isnan_real -end interface -#endif - -# 75 "CDEPS/share/shr_infnan_mod.F90.in" -interface shr_infnan_isinf - ! TYPE double,real - module procedure shr_infnan_isinf_double - ! TYPE double,real - module procedure shr_infnan_isinf_real -end interface - -# 80 "CDEPS/share/shr_infnan_mod.F90.in" -interface shr_infnan_isposinf - ! TYPE double,real - module procedure shr_infnan_isposinf_double - ! TYPE double,real - module procedure shr_infnan_isposinf_real -end interface - -# 85 "CDEPS/share/shr_infnan_mod.F90.in" -interface shr_infnan_isneginf - ! TYPE double,real - module procedure shr_infnan_isneginf_double - ! TYPE double,real - module procedure shr_infnan_isneginf_real -end interface - -! Derived types for generation of NaN/Inf -! Even though there's no reason to "use" the types directly, some compilers -! might have trouble with an object being used without its type. -public :: shr_infnan_nan_type -public :: shr_infnan_inf_type -public :: assignment(=) -public :: shr_infnan_to_r4 -public :: shr_infnan_to_r8 - -! Type representing Not A Number. -type :: shr_infnan_nan_type - logical :: quiet = .false. -end type shr_infnan_nan_type - -! Type representing +/-Infinity. -type :: shr_infnan_inf_type - logical :: positive = .true. -end type shr_infnan_inf_type - -! Allow assigning reals to NaN or Inf. -# 110 "CDEPS/share/shr_infnan_mod.F90.in" -interface assignment(=) - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_0d_double - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_1d_double - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_2d_double - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_3d_double - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_4d_double - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_5d_double - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_6d_double - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_7d_double - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_0d_real - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_1d_real - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_2d_real - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_3d_real - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_4d_real - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_5d_real - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_6d_real - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_7d_real - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_inf_0d_double - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_inf_1d_double - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_inf_2d_double - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_inf_3d_double - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_inf_4d_double - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_inf_5d_double - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_inf_6d_double - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_inf_7d_double - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_inf_0d_real - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_inf_1d_real - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_inf_2d_real - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_inf_3d_real - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_inf_4d_real - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_inf_5d_real - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_inf_6d_real - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_inf_7d_real -end interface - -! Conversion functions. -# 120 "CDEPS/share/shr_infnan_mod.F90.in" -interface shr_infnan_to_r8 - module procedure nan_r8 - module procedure inf_r8 -end interface - -# 125 "CDEPS/share/shr_infnan_mod.F90.in" -interface shr_infnan_to_r4 - module procedure nan_r4 - module procedure inf_r4 -end interface - -! Initialize objects of NaN/Inf type for other modules to use. - -! Default NaN is signaling, but also provide snan and qnan to choose -! explicitly. -type(shr_infnan_nan_type), public, parameter :: shr_infnan_nan = & - shr_infnan_nan_type(.false.) -type(shr_infnan_nan_type), public, parameter :: shr_infnan_snan = & - shr_infnan_nan_type(.false.) -type(shr_infnan_nan_type), public, parameter :: shr_infnan_qnan = & - shr_infnan_nan_type(.true.) - -! Default Inf is positive, but provide posinf to go with neginf. -type(shr_infnan_inf_type), public, parameter :: shr_infnan_inf = & - shr_infnan_inf_type(.true.) -type(shr_infnan_inf_type), public, parameter :: shr_infnan_posinf = & - shr_infnan_inf_type(.true.) -type(shr_infnan_inf_type), public, parameter :: shr_infnan_neginf = & - shr_infnan_inf_type(.false.) - -! Bit patterns for implementation without ieee_arithmetic. -! Note that in order to satisfy gfortran's range check, we have to use -! ibset to set the sign bit from a BOZ pattern. -#ifndef HAVE_IEEE_ARITHMETIC -! Single precision. -integer(i4), parameter :: ssnan_pat = int(Z'7FA00000',i4) -integer(i4), parameter :: sqnan_pat = int(Z'7FC00000',i4) -integer(i4), parameter :: sposinf_pat = int(Z'7F800000',i4) -integer(i4), parameter :: sneginf_pat = ibset(sposinf_pat,bit_size(1_i4)-1) -! Double precision. -integer(i8), parameter :: dsnan_pat = int(Z'7FF4000000000000',i8) -integer(i8), parameter :: dqnan_pat = int(Z'7FF8000000000000',i8) -integer(i8), parameter :: dposinf_pat = int(Z'7FF0000000000000',i8) -integer(i8), parameter :: dneginf_pat = ibset(dposinf_pat,bit_size(1_i8)-1) -#endif - -# 165 "CDEPS/share/shr_infnan_mod.F90.in" -contains - -!--------------------------------------------------------------------- -! TEST FUNCTIONS -!--------------------------------------------------------------------- -! The "isinf" function simply calls "isposinf" and "isneginf". -!--------------------------------------------------------------------- - -! TYPE double,real -# 174 "CDEPS/share/shr_infnan_mod.F90.in" -elemental function shr_infnan_isinf_double(x) result(isinf) - real(r8), intent(in) :: x - logical :: isinf - - isinf = shr_infnan_isposinf(x) .or. shr_infnan_isneginf(x) - -# 180 "CDEPS/share/shr_infnan_mod.F90.in" -end function shr_infnan_isinf_double -! TYPE double,real -# 174 "CDEPS/share/shr_infnan_mod.F90.in" -elemental function shr_infnan_isinf_real(x) result(isinf) - real(r4), intent(in) :: x - logical :: isinf - - isinf = shr_infnan_isposinf(x) .or. shr_infnan_isneginf(x) - -# 180 "CDEPS/share/shr_infnan_mod.F90.in" -end function shr_infnan_isinf_real - -#ifdef HAVE_IEEE_ARITHMETIC - -!--------------------------------------------------------------------- -! The "isposinf" and "isneginf" functions get the IEEE class of a -! real, and test to see if the class is equal to ieee_positive_inf -! or ieee_negative_inf. -!--------------------------------------------------------------------- - -! TYPE double,real -# 191 "CDEPS/share/shr_infnan_mod.F90.in" -elemental function shr_infnan_isposinf_double(x) result(isposinf) - use, intrinsic :: ieee_arithmetic, only: & - ieee_class, & - ieee_positive_inf, & - operator(==) - real(r8), intent(in) :: x - logical :: isposinf - - isposinf = (ieee_positive_inf == ieee_class(x)) - -# 201 "CDEPS/share/shr_infnan_mod.F90.in" -end function shr_infnan_isposinf_double -! TYPE double,real -# 191 "CDEPS/share/shr_infnan_mod.F90.in" -elemental function shr_infnan_isposinf_real(x) result(isposinf) - use, intrinsic :: ieee_arithmetic, only: & - ieee_class, & - ieee_positive_inf, & - operator(==) - real(r4), intent(in) :: x - logical :: isposinf - - isposinf = (ieee_positive_inf == ieee_class(x)) - -# 201 "CDEPS/share/shr_infnan_mod.F90.in" -end function shr_infnan_isposinf_real - -! TYPE double,real -# 204 "CDEPS/share/shr_infnan_mod.F90.in" -elemental function shr_infnan_isneginf_double(x) result(isneginf) - use, intrinsic :: ieee_arithmetic, only: & - ieee_class, & - ieee_negative_inf, & - operator(==) - real(r8), intent(in) :: x - logical :: isneginf - - isneginf = (ieee_negative_inf == ieee_class(x)) - -# 214 "CDEPS/share/shr_infnan_mod.F90.in" -end function shr_infnan_isneginf_double -! TYPE double,real -# 204 "CDEPS/share/shr_infnan_mod.F90.in" -elemental function shr_infnan_isneginf_real(x) result(isneginf) - use, intrinsic :: ieee_arithmetic, only: & - ieee_class, & - ieee_negative_inf, & - operator(==) - real(r4), intent(in) :: x - logical :: isneginf - - isneginf = (ieee_negative_inf == ieee_class(x)) - -# 214 "CDEPS/share/shr_infnan_mod.F90.in" -end function shr_infnan_isneginf_real - -#else -! Don't have ieee_arithmetic. - -#ifdef CPRGNU -! NaN testing on gfortran. -! TYPE double,real -# 222 "CDEPS/share/shr_infnan_mod.F90.in" -elemental function shr_infnan_isnan_double(x) result(is_nan) - real(r8), intent(in) :: x - logical :: is_nan - - is_nan = isnan(x) - -# 228 "CDEPS/share/shr_infnan_mod.F90.in" -end function shr_infnan_isnan_double -! TYPE double,real -# 222 "CDEPS/share/shr_infnan_mod.F90.in" -elemental function shr_infnan_isnan_real(x) result(is_nan) - real(r4), intent(in) :: x - logical :: is_nan - - is_nan = isnan(x) - -# 228 "CDEPS/share/shr_infnan_mod.F90.in" -end function shr_infnan_isnan_real -! End GNU section. -#endif - -!--------------------------------------------------------------------- -! The "isposinf" and "isneginf" functions just test against a known -! bit pattern if we don't have ieee_arithmetic. -!--------------------------------------------------------------------- - -! TYPE double,real -# 238 "CDEPS/share/shr_infnan_mod.F90.in" -elemental function shr_infnan_isposinf_double(x) result(isposinf) - real(r8), intent(in) :: x - logical :: isposinf -#if (102 == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat -#endif - - isposinf = (x == transfer(posinf_pat,x)) - -# 249 "CDEPS/share/shr_infnan_mod.F90.in" -end function shr_infnan_isposinf_double -! TYPE double,real -# 238 "CDEPS/share/shr_infnan_mod.F90.in" -elemental function shr_infnan_isposinf_real(x) result(isposinf) - real(r4), intent(in) :: x - logical :: isposinf -#if (101 == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat -#endif - - isposinf = (x == transfer(posinf_pat,x)) - -# 249 "CDEPS/share/shr_infnan_mod.F90.in" -end function shr_infnan_isposinf_real - -! TYPE double,real -# 252 "CDEPS/share/shr_infnan_mod.F90.in" -elemental function shr_infnan_isneginf_double(x) result(isneginf) - real(r8), intent(in) :: x - logical :: isneginf -#if (102 == TYPEREAL) - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif - - isneginf = (x == transfer(neginf_pat,x)) - -# 263 "CDEPS/share/shr_infnan_mod.F90.in" -end function shr_infnan_isneginf_double -! TYPE double,real -# 252 "CDEPS/share/shr_infnan_mod.F90.in" -elemental function shr_infnan_isneginf_real(x) result(isneginf) - real(r4), intent(in) :: x - logical :: isneginf -#if (101 == TYPEREAL) - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif - - isneginf = (x == transfer(neginf_pat,x)) - -# 263 "CDEPS/share/shr_infnan_mod.F90.in" -end function shr_infnan_isneginf_real - -! End ieee_arithmetic conditional. -#endif - -!--------------------------------------------------------------------- -! GENERATION FUNCTIONS -!--------------------------------------------------------------------- -! Two approaches for generation of NaN and Inf values: -! 1. With Fortran 2003, use the ieee_value intrinsic to get a value -! from the corresponding class. These are: -! - ieee_signaling_nan -! - ieee_quiet_nan -! - ieee_positive_inf -! - ieee_negative_inf -! 2. Without Fortran 2003, set the IEEE bit patterns directly. -! Use BOZ literals to get an integer with the correct bit -! pattern, then use "transfer" to transfer those bits into a -! real. -!--------------------------------------------------------------------- - -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_nan_0d_double(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#else -#if (102 == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif -#endif - real(r8), intent(out) :: output - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r8) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if -#endif - - output = tmp - -# 324 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_nan_0d_double -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_nan_1d_double(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#else -#if (102 == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif -#endif - real(r8), intent(out) :: output(:) - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r8) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if -#endif - - output = tmp - -# 324 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_nan_1d_double -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_nan_2d_double(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#else -#if (102 == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif -#endif - real(r8), intent(out) :: output(:,:) - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r8) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if -#endif - - output = tmp - -# 324 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_nan_2d_double -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_nan_3d_double(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#else -#if (102 == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif -#endif - real(r8), intent(out) :: output(:,:,:) - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r8) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if -#endif - - output = tmp - -# 324 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_nan_3d_double -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_nan_4d_double(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#else -#if (102 == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif -#endif - real(r8), intent(out) :: output(:,:,:,:) - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r8) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if -#endif - - output = tmp - -# 324 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_nan_4d_double -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_nan_5d_double(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#else -#if (102 == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif -#endif - real(r8), intent(out) :: output(:,:,:,:,:) - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r8) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if -#endif - - output = tmp - -# 324 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_nan_5d_double -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_nan_6d_double(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#else -#if (102 == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif -#endif - real(r8), intent(out) :: output(:,:,:,:,:,:) - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r8) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if -#endif - - output = tmp - -# 324 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_nan_6d_double -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_nan_7d_double(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#else -#if (102 == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif -#endif - real(r8), intent(out) :: output(:,:,:,:,:,:,:) - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r8) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if -#endif - - output = tmp - -# 324 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_nan_7d_double -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_nan_0d_real(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#else -#if (101 == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif -#endif - real(r4), intent(out) :: output - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r4) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if -#endif - - output = tmp - -# 324 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_nan_0d_real -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_nan_1d_real(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#else -#if (101 == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif -#endif - real(r4), intent(out) :: output(:) - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r4) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if -#endif - - output = tmp - -# 324 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_nan_1d_real -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_nan_2d_real(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#else -#if (101 == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif -#endif - real(r4), intent(out) :: output(:,:) - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r4) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if -#endif - - output = tmp - -# 324 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_nan_2d_real -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_nan_3d_real(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#else -#if (101 == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif -#endif - real(r4), intent(out) :: output(:,:,:) - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r4) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if -#endif - - output = tmp - -# 324 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_nan_3d_real -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_nan_4d_real(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#else -#if (101 == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif -#endif - real(r4), intent(out) :: output(:,:,:,:) - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r4) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if -#endif - - output = tmp - -# 324 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_nan_4d_real -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_nan_5d_real(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#else -#if (101 == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif -#endif - real(r4), intent(out) :: output(:,:,:,:,:) - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r4) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if -#endif - - output = tmp - -# 324 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_nan_5d_real -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_nan_6d_real(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#else -#if (101 == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif -#endif - real(r4), intent(out) :: output(:,:,:,:,:,:) - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r4) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if -#endif - - output = tmp - -# 324 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_nan_6d_real -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_nan_7d_real(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#else -#if (101 == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif -#endif - real(r4), intent(out) :: output(:,:,:,:,:,:,:) - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r4) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if -#endif - - output = tmp - -# 324 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_nan_7d_real - -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_inf_0d_double(output, inf) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_positive_inf, & - ieee_negative_inf, & - ieee_value -#else -#if (102 == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif -#endif - real(r8), intent(out) :: output - type(shr_infnan_inf_type), intent(in) :: inf - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r8) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (inf%positive) then - tmp = ieee_value(tmp,ieee_positive_inf) - else - tmp = ieee_value(tmp,ieee_negative_inf) - end if -#else - if (inf%positive) then - tmp = transfer(posinf_pat, tmp) - else - tmp = transfer(neginf_pat, tmp) - end if -#endif - - output = tmp - -# 366 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_inf_0d_double -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_inf_1d_double(output, inf) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_positive_inf, & - ieee_negative_inf, & - ieee_value -#else -#if (102 == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif -#endif - real(r8), intent(out) :: output(:) - type(shr_infnan_inf_type), intent(in) :: inf - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r8) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (inf%positive) then - tmp = ieee_value(tmp,ieee_positive_inf) - else - tmp = ieee_value(tmp,ieee_negative_inf) - end if -#else - if (inf%positive) then - tmp = transfer(posinf_pat, tmp) - else - tmp = transfer(neginf_pat, tmp) - end if -#endif - - output = tmp - -# 366 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_inf_1d_double -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_inf_2d_double(output, inf) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_positive_inf, & - ieee_negative_inf, & - ieee_value -#else -#if (102 == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif -#endif - real(r8), intent(out) :: output(:,:) - type(shr_infnan_inf_type), intent(in) :: inf - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r8) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (inf%positive) then - tmp = ieee_value(tmp,ieee_positive_inf) - else - tmp = ieee_value(tmp,ieee_negative_inf) - end if -#else - if (inf%positive) then - tmp = transfer(posinf_pat, tmp) - else - tmp = transfer(neginf_pat, tmp) - end if -#endif - - output = tmp - -# 366 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_inf_2d_double -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_inf_3d_double(output, inf) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_positive_inf, & - ieee_negative_inf, & - ieee_value -#else -#if (102 == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif -#endif - real(r8), intent(out) :: output(:,:,:) - type(shr_infnan_inf_type), intent(in) :: inf - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r8) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (inf%positive) then - tmp = ieee_value(tmp,ieee_positive_inf) - else - tmp = ieee_value(tmp,ieee_negative_inf) - end if -#else - if (inf%positive) then - tmp = transfer(posinf_pat, tmp) - else - tmp = transfer(neginf_pat, tmp) - end if -#endif - - output = tmp - -# 366 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_inf_3d_double -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_inf_4d_double(output, inf) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_positive_inf, & - ieee_negative_inf, & - ieee_value -#else -#if (102 == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif -#endif - real(r8), intent(out) :: output(:,:,:,:) - type(shr_infnan_inf_type), intent(in) :: inf - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r8) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (inf%positive) then - tmp = ieee_value(tmp,ieee_positive_inf) - else - tmp = ieee_value(tmp,ieee_negative_inf) - end if -#else - if (inf%positive) then - tmp = transfer(posinf_pat, tmp) - else - tmp = transfer(neginf_pat, tmp) - end if -#endif - - output = tmp - -# 366 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_inf_4d_double -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_inf_5d_double(output, inf) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_positive_inf, & - ieee_negative_inf, & - ieee_value -#else -#if (102 == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif -#endif - real(r8), intent(out) :: output(:,:,:,:,:) - type(shr_infnan_inf_type), intent(in) :: inf - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r8) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (inf%positive) then - tmp = ieee_value(tmp,ieee_positive_inf) - else - tmp = ieee_value(tmp,ieee_negative_inf) - end if -#else - if (inf%positive) then - tmp = transfer(posinf_pat, tmp) - else - tmp = transfer(neginf_pat, tmp) - end if -#endif - - output = tmp - -# 366 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_inf_5d_double -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_inf_6d_double(output, inf) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_positive_inf, & - ieee_negative_inf, & - ieee_value -#else -#if (102 == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif -#endif - real(r8), intent(out) :: output(:,:,:,:,:,:) - type(shr_infnan_inf_type), intent(in) :: inf - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r8) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (inf%positive) then - tmp = ieee_value(tmp,ieee_positive_inf) - else - tmp = ieee_value(tmp,ieee_negative_inf) - end if -#else - if (inf%positive) then - tmp = transfer(posinf_pat, tmp) - else - tmp = transfer(neginf_pat, tmp) - end if -#endif - - output = tmp - -# 366 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_inf_6d_double -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_inf_7d_double(output, inf) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_positive_inf, & - ieee_negative_inf, & - ieee_value -#else -#if (102 == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif -#endif - real(r8), intent(out) :: output(:,:,:,:,:,:,:) - type(shr_infnan_inf_type), intent(in) :: inf - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r8) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (inf%positive) then - tmp = ieee_value(tmp,ieee_positive_inf) - else - tmp = ieee_value(tmp,ieee_negative_inf) - end if -#else - if (inf%positive) then - tmp = transfer(posinf_pat, tmp) - else - tmp = transfer(neginf_pat, tmp) - end if -#endif - - output = tmp - -# 366 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_inf_7d_double -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_inf_0d_real(output, inf) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_positive_inf, & - ieee_negative_inf, & - ieee_value -#else -#if (101 == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif -#endif - real(r4), intent(out) :: output - type(shr_infnan_inf_type), intent(in) :: inf - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r4) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (inf%positive) then - tmp = ieee_value(tmp,ieee_positive_inf) - else - tmp = ieee_value(tmp,ieee_negative_inf) - end if -#else - if (inf%positive) then - tmp = transfer(posinf_pat, tmp) - else - tmp = transfer(neginf_pat, tmp) - end if -#endif - - output = tmp - -# 366 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_inf_0d_real -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_inf_1d_real(output, inf) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_positive_inf, & - ieee_negative_inf, & - ieee_value -#else -#if (101 == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif -#endif - real(r4), intent(out) :: output(:) - type(shr_infnan_inf_type), intent(in) :: inf - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r4) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (inf%positive) then - tmp = ieee_value(tmp,ieee_positive_inf) - else - tmp = ieee_value(tmp,ieee_negative_inf) - end if -#else - if (inf%positive) then - tmp = transfer(posinf_pat, tmp) - else - tmp = transfer(neginf_pat, tmp) - end if -#endif - - output = tmp - -# 366 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_inf_1d_real -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_inf_2d_real(output, inf) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_positive_inf, & - ieee_negative_inf, & - ieee_value -#else -#if (101 == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif -#endif - real(r4), intent(out) :: output(:,:) - type(shr_infnan_inf_type), intent(in) :: inf - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r4) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (inf%positive) then - tmp = ieee_value(tmp,ieee_positive_inf) - else - tmp = ieee_value(tmp,ieee_negative_inf) - end if -#else - if (inf%positive) then - tmp = transfer(posinf_pat, tmp) - else - tmp = transfer(neginf_pat, tmp) - end if -#endif - - output = tmp - -# 366 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_inf_2d_real -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_inf_3d_real(output, inf) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_positive_inf, & - ieee_negative_inf, & - ieee_value -#else -#if (101 == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif -#endif - real(r4), intent(out) :: output(:,:,:) - type(shr_infnan_inf_type), intent(in) :: inf - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r4) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (inf%positive) then - tmp = ieee_value(tmp,ieee_positive_inf) - else - tmp = ieee_value(tmp,ieee_negative_inf) - end if -#else - if (inf%positive) then - tmp = transfer(posinf_pat, tmp) - else - tmp = transfer(neginf_pat, tmp) - end if -#endif - - output = tmp - -# 366 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_inf_3d_real -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_inf_4d_real(output, inf) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_positive_inf, & - ieee_negative_inf, & - ieee_value -#else -#if (101 == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif -#endif - real(r4), intent(out) :: output(:,:,:,:) - type(shr_infnan_inf_type), intent(in) :: inf - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r4) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (inf%positive) then - tmp = ieee_value(tmp,ieee_positive_inf) - else - tmp = ieee_value(tmp,ieee_negative_inf) - end if -#else - if (inf%positive) then - tmp = transfer(posinf_pat, tmp) - else - tmp = transfer(neginf_pat, tmp) - end if -#endif - - output = tmp - -# 366 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_inf_4d_real -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_inf_5d_real(output, inf) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_positive_inf, & - ieee_negative_inf, & - ieee_value -#else -#if (101 == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif -#endif - real(r4), intent(out) :: output(:,:,:,:,:) - type(shr_infnan_inf_type), intent(in) :: inf - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r4) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (inf%positive) then - tmp = ieee_value(tmp,ieee_positive_inf) - else - tmp = ieee_value(tmp,ieee_negative_inf) - end if -#else - if (inf%positive) then - tmp = transfer(posinf_pat, tmp) - else - tmp = transfer(neginf_pat, tmp) - end if -#endif - - output = tmp - -# 366 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_inf_5d_real -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_inf_6d_real(output, inf) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_positive_inf, & - ieee_negative_inf, & - ieee_value -#else -#if (101 == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif -#endif - real(r4), intent(out) :: output(:,:,:,:,:,:) - type(shr_infnan_inf_type), intent(in) :: inf - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r4) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (inf%positive) then - tmp = ieee_value(tmp,ieee_positive_inf) - else - tmp = ieee_value(tmp,ieee_negative_inf) - end if -#else - if (inf%positive) then - tmp = transfer(posinf_pat, tmp) - else - tmp = transfer(neginf_pat, tmp) - end if -#endif - - output = tmp - -# 366 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_inf_6d_real -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" -pure subroutine set_inf_7d_real(output, inf) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_positive_inf, & - ieee_negative_inf, & - ieee_value -#else -#if (101 == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif -#endif - real(r4), intent(out) :: output(:,:,:,:,:,:,:) - type(shr_infnan_inf_type), intent(in) :: inf - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - real(r4) :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (inf%positive) then - tmp = ieee_value(tmp,ieee_positive_inf) - else - tmp = ieee_value(tmp,ieee_negative_inf) - end if -#else - if (inf%positive) then - tmp = transfer(posinf_pat, tmp) - else - tmp = transfer(neginf_pat, tmp) - end if -#endif - - output = tmp - -# 366 "CDEPS/share/shr_infnan_mod.F90.in" -end subroutine set_inf_7d_real - -!--------------------------------------------------------------------- -! CONVERSION INTERFACES. -!--------------------------------------------------------------------- -! Function methods to get reals from nan/inf types. -!--------------------------------------------------------------------- - -# 374 "CDEPS/share/shr_infnan_mod.F90.in" -pure function nan_r8(nan) result(output) - class(shr_infnan_nan_type), intent(in) :: nan - real(r8) :: output - - output = nan - -# 380 "CDEPS/share/shr_infnan_mod.F90.in" -end function nan_r8 - -# 382 "CDEPS/share/shr_infnan_mod.F90.in" -pure function nan_r4(nan) result(output) - class(shr_infnan_nan_type), intent(in) :: nan - real(r4) :: output - - output = nan - -# 388 "CDEPS/share/shr_infnan_mod.F90.in" -end function nan_r4 - -# 390 "CDEPS/share/shr_infnan_mod.F90.in" -pure function inf_r8(inf) result(output) - class(shr_infnan_inf_type), intent(in) :: inf - real(r8) :: output - - output = inf - -# 396 "CDEPS/share/shr_infnan_mod.F90.in" -end function inf_r8 - -# 398 "CDEPS/share/shr_infnan_mod.F90.in" -pure function inf_r4(inf) result(output) - class(shr_infnan_inf_type), intent(in) :: inf - real(r4) :: output - - output = inf - -# 404 "CDEPS/share/shr_infnan_mod.F90.in" -end function inf_r4 - -end module shr_infnan_mod From 5f29b7388de28c2a2ecfd6b13d577e0486002c70 Mon Sep 17 00:00:00 2001 From: Micael Oliveira Date: Thu, 10 Aug 2023 10:19:26 +1000 Subject: [PATCH 07/11] Replace the generated files in share/src. The previous ones where generated from the templates in CDEPS, while CESM uses the templates from CESM_share. --- share/src/shr_assert_mod.F90 | 386 +++++++++++++++++------------------ share/src/shr_frz_mod.F90 | 32 +-- share/src/shr_infnan_mod.F90 | 210 +++++++++---------- 3 files changed, 313 insertions(+), 315 deletions(-) diff --git a/share/src/shr_assert_mod.F90 b/share/src/shr_assert_mod.F90 index 89c529c..063da60 100644 --- a/share/src/shr_assert_mod.F90 +++ b/share/src/shr_assert_mod.F90 @@ -1,6 +1,6 @@ #include "dtypes.h" !=================================================== -! DO NOT EDIT THIS FILE, it was generated using /home/micael/genf90.pl +! DO NOT EDIT THIS FILE, it was generated using genf90.pl ! Any changes you make to this file may be lost !=================================================== module shr_assert_mod @@ -11,8 +11,7 @@ module shr_assert_mod r4 => shr_kind_r4, & r8 => shr_kind_r8, & i4 => shr_kind_i4, & - i8 => shr_kind_i8, & - CL => shr_kind_CL + i8 => shr_kind_i8 use shr_sys_mod, only: & shr_sys_abort @@ -36,7 +35,7 @@ module shr_assert_mod ! Assert that a numerical value satisfies certain constraints. public :: shr_assert_in_domain -# 34 "CDEPS/share/shr_assert_mod.F90.in" +# 33 "CESM_share/src/shr_assert_mod.F90.in" interface shr_assert_all module procedure shr_assert ! DIMS 1,2,3,4,5,6,7 @@ -55,7 +54,7 @@ module shr_assert_mod module procedure shr_assert_all_7d end interface -# 40 "CDEPS/share/shr_assert_mod.F90.in" +# 39 "CESM_share/src/shr_assert_mod.F90.in" interface shr_assert_any module procedure shr_assert ! DIMS 1,2,3,4,5,6,7 @@ -74,7 +73,7 @@ module shr_assert_mod module procedure shr_assert_any_7d end interface -# 46 "CDEPS/share/shr_assert_mod.F90.in" +# 45 "CESM_share/src/shr_assert_mod.F90.in" interface shr_assert_in_domain ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 @@ -176,7 +175,7 @@ module shr_assert_mod ! Private utilities. -# 54 "CDEPS/share/shr_assert_mod.F90.in" +# 53 "CESM_share/src/shr_assert_mod.F90.in" interface print_bad_loc ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 @@ -276,7 +275,7 @@ module shr_assert_mod module procedure print_bad_loc_7d_long end interface -# 60 "CDEPS/share/shr_assert_mod.F90.in" +# 59 "CESM_share/src/shr_assert_mod.F90.in" interface find_first_loc ! DIMS 0,1,2,3,4,5,6,7 module procedure find_first_loc_0d @@ -296,7 +295,7 @@ module shr_assert_mod module procedure find_first_loc_7d end interface -# 65 "CDEPS/share/shr_assert_mod.F90.in" +# 64 "CESM_share/src/shr_assert_mod.F90.in" interface within_tolerance ! TYPE double,real,int,long module procedure within_tolerance_double @@ -308,10 +307,10 @@ module shr_assert_mod module procedure within_tolerance_long end interface -# 70 "CDEPS/share/shr_assert_mod.F90.in" +# 69 "CESM_share/src/shr_assert_mod.F90.in" contains -# 72 "CDEPS/share/shr_assert_mod.F90.in" +# 71 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert(var, msg, file, line) ! Logical being asserted @@ -323,9 +322,8 @@ subroutine shr_assert(var, msg, file, line) character(len=*), intent(in), optional :: file integer , intent(in), optional :: line - character(len=CL) :: full_msg + character(len=:), allocatable :: full_msg - full_msg = '' if (.not. var) then full_msg = 'ERROR' if (present(file)) then @@ -340,11 +338,11 @@ subroutine shr_assert(var, msg, file, line) call shr_sys_abort(full_msg) end if -# 100 "CDEPS/share/shr_assert_mod.F90.in" +# 98 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert ! DIMS 1,2,3,4,5,6,7 -# 103 "CDEPS/share/shr_assert_mod.F90.in" +# 101 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_all_1d(var, msg, file, line) ! Logical being asserted @@ -358,10 +356,10 @@ subroutine shr_assert_all_1d(var, msg, file, line) call shr_assert(all(var), msg=msg, file=file, line=line) -# 116 "CDEPS/share/shr_assert_mod.F90.in" +# 114 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_all_1d ! DIMS 1,2,3,4,5,6,7 -# 103 "CDEPS/share/shr_assert_mod.F90.in" +# 101 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_all_2d(var, msg, file, line) ! Logical being asserted @@ -375,10 +373,10 @@ subroutine shr_assert_all_2d(var, msg, file, line) call shr_assert(all(var), msg=msg, file=file, line=line) -# 116 "CDEPS/share/shr_assert_mod.F90.in" +# 114 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_all_2d ! DIMS 1,2,3,4,5,6,7 -# 103 "CDEPS/share/shr_assert_mod.F90.in" +# 101 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_all_3d(var, msg, file, line) ! Logical being asserted @@ -392,10 +390,10 @@ subroutine shr_assert_all_3d(var, msg, file, line) call shr_assert(all(var), msg=msg, file=file, line=line) -# 116 "CDEPS/share/shr_assert_mod.F90.in" +# 114 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_all_3d ! DIMS 1,2,3,4,5,6,7 -# 103 "CDEPS/share/shr_assert_mod.F90.in" +# 101 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_all_4d(var, msg, file, line) ! Logical being asserted @@ -409,10 +407,10 @@ subroutine shr_assert_all_4d(var, msg, file, line) call shr_assert(all(var), msg=msg, file=file, line=line) -# 116 "CDEPS/share/shr_assert_mod.F90.in" +# 114 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_all_4d ! DIMS 1,2,3,4,5,6,7 -# 103 "CDEPS/share/shr_assert_mod.F90.in" +# 101 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_all_5d(var, msg, file, line) ! Logical being asserted @@ -426,10 +424,10 @@ subroutine shr_assert_all_5d(var, msg, file, line) call shr_assert(all(var), msg=msg, file=file, line=line) -# 116 "CDEPS/share/shr_assert_mod.F90.in" +# 114 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_all_5d ! DIMS 1,2,3,4,5,6,7 -# 103 "CDEPS/share/shr_assert_mod.F90.in" +# 101 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_all_6d(var, msg, file, line) ! Logical being asserted @@ -443,10 +441,10 @@ subroutine shr_assert_all_6d(var, msg, file, line) call shr_assert(all(var), msg=msg, file=file, line=line) -# 116 "CDEPS/share/shr_assert_mod.F90.in" +# 114 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_all_6d ! DIMS 1,2,3,4,5,6,7 -# 103 "CDEPS/share/shr_assert_mod.F90.in" +# 101 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_all_7d(var, msg, file, line) ! Logical being asserted @@ -460,11 +458,11 @@ subroutine shr_assert_all_7d(var, msg, file, line) call shr_assert(all(var), msg=msg, file=file, line=line) -# 116 "CDEPS/share/shr_assert_mod.F90.in" +# 114 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_all_7d ! DIMS 1,2,3,4,5,6,7 -# 119 "CDEPS/share/shr_assert_mod.F90.in" +# 117 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_any_1d(var, msg, file, line) ! Logical being asserted @@ -478,10 +476,10 @@ subroutine shr_assert_any_1d(var, msg, file, line) call shr_assert(any(var), msg=msg, file=file, line=line) -# 132 "CDEPS/share/shr_assert_mod.F90.in" +# 130 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_any_1d ! DIMS 1,2,3,4,5,6,7 -# 119 "CDEPS/share/shr_assert_mod.F90.in" +# 117 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_any_2d(var, msg, file, line) ! Logical being asserted @@ -495,10 +493,10 @@ subroutine shr_assert_any_2d(var, msg, file, line) call shr_assert(any(var), msg=msg, file=file, line=line) -# 132 "CDEPS/share/shr_assert_mod.F90.in" +# 130 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_any_2d ! DIMS 1,2,3,4,5,6,7 -# 119 "CDEPS/share/shr_assert_mod.F90.in" +# 117 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_any_3d(var, msg, file, line) ! Logical being asserted @@ -512,10 +510,10 @@ subroutine shr_assert_any_3d(var, msg, file, line) call shr_assert(any(var), msg=msg, file=file, line=line) -# 132 "CDEPS/share/shr_assert_mod.F90.in" +# 130 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_any_3d ! DIMS 1,2,3,4,5,6,7 -# 119 "CDEPS/share/shr_assert_mod.F90.in" +# 117 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_any_4d(var, msg, file, line) ! Logical being asserted @@ -529,10 +527,10 @@ subroutine shr_assert_any_4d(var, msg, file, line) call shr_assert(any(var), msg=msg, file=file, line=line) -# 132 "CDEPS/share/shr_assert_mod.F90.in" +# 130 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_any_4d ! DIMS 1,2,3,4,5,6,7 -# 119 "CDEPS/share/shr_assert_mod.F90.in" +# 117 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_any_5d(var, msg, file, line) ! Logical being asserted @@ -546,10 +544,10 @@ subroutine shr_assert_any_5d(var, msg, file, line) call shr_assert(any(var), msg=msg, file=file, line=line) -# 132 "CDEPS/share/shr_assert_mod.F90.in" +# 130 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_any_5d ! DIMS 1,2,3,4,5,6,7 -# 119 "CDEPS/share/shr_assert_mod.F90.in" +# 117 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_any_6d(var, msg, file, line) ! Logical being asserted @@ -563,10 +561,10 @@ subroutine shr_assert_any_6d(var, msg, file, line) call shr_assert(any(var), msg=msg, file=file, line=line) -# 132 "CDEPS/share/shr_assert_mod.F90.in" +# 130 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_any_6d ! DIMS 1,2,3,4,5,6,7 -# 119 "CDEPS/share/shr_assert_mod.F90.in" +# 117 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_any_7d(var, msg, file, line) ! Logical being asserted @@ -580,7 +578,7 @@ subroutine shr_assert_any_7d(var, msg, file, line) call shr_assert(any(var), msg=msg, file=file, line=line) -# 132 "CDEPS/share/shr_assert_mod.F90.in" +# 130 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_any_7d !-------------------------------------------------------------------------- @@ -588,7 +586,7 @@ end subroutine shr_assert_any_7d ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_0d_double(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -784,11 +782,11 @@ subroutine shr_assert_in_domain_0d_double(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_0d_double ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_1d_double(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -984,11 +982,11 @@ subroutine shr_assert_in_domain_1d_double(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_1d_double ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_2d_double(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -1184,11 +1182,11 @@ subroutine shr_assert_in_domain_2d_double(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_2d_double ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_3d_double(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -1384,11 +1382,11 @@ subroutine shr_assert_in_domain_3d_double(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_3d_double ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_4d_double(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -1584,11 +1582,11 @@ subroutine shr_assert_in_domain_4d_double(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_4d_double ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_5d_double(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -1784,11 +1782,11 @@ subroutine shr_assert_in_domain_5d_double(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_5d_double ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_6d_double(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -1984,11 +1982,11 @@ subroutine shr_assert_in_domain_6d_double(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_6d_double ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_7d_double(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -2184,11 +2182,11 @@ subroutine shr_assert_in_domain_7d_double(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_7d_double ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_0d_real(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -2384,11 +2382,11 @@ subroutine shr_assert_in_domain_0d_real(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_0d_real ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_1d_real(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -2584,11 +2582,11 @@ subroutine shr_assert_in_domain_1d_real(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_1d_real ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_2d_real(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -2784,11 +2782,11 @@ subroutine shr_assert_in_domain_2d_real(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_2d_real ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_3d_real(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -2984,11 +2982,11 @@ subroutine shr_assert_in_domain_3d_real(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_3d_real ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_4d_real(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -3184,11 +3182,11 @@ subroutine shr_assert_in_domain_4d_real(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_4d_real ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_5d_real(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -3384,11 +3382,11 @@ subroutine shr_assert_in_domain_5d_real(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_5d_real ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_6d_real(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -3584,11 +3582,11 @@ subroutine shr_assert_in_domain_6d_real(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_6d_real ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_7d_real(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -3784,11 +3782,11 @@ subroutine shr_assert_in_domain_7d_real(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_7d_real ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_0d_int(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -3984,11 +3982,11 @@ subroutine shr_assert_in_domain_0d_int(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_0d_int ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_1d_int(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -4184,11 +4182,11 @@ subroutine shr_assert_in_domain_1d_int(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_1d_int ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_2d_int(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -4384,11 +4382,11 @@ subroutine shr_assert_in_domain_2d_int(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_2d_int ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_3d_int(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -4584,11 +4582,11 @@ subroutine shr_assert_in_domain_3d_int(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_3d_int ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_4d_int(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -4784,11 +4782,11 @@ subroutine shr_assert_in_domain_4d_int(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_4d_int ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_5d_int(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -4984,11 +4982,11 @@ subroutine shr_assert_in_domain_5d_int(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_5d_int ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_6d_int(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -5184,11 +5182,11 @@ subroutine shr_assert_in_domain_6d_int(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_6d_int ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_7d_int(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -5384,11 +5382,11 @@ subroutine shr_assert_in_domain_7d_int(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_7d_int ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_0d_long(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -5584,11 +5582,11 @@ subroutine shr_assert_in_domain_0d_long(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_0d_long ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_1d_long(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -5784,11 +5782,11 @@ subroutine shr_assert_in_domain_1d_long(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_1d_long ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_2d_long(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -5984,11 +5982,11 @@ subroutine shr_assert_in_domain_2d_long(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_2d_long ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_3d_long(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -6184,11 +6182,11 @@ subroutine shr_assert_in_domain_3d_long(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_3d_long ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_4d_long(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -6384,11 +6382,11 @@ subroutine shr_assert_in_domain_4d_long(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_4d_long ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_5d_long(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -6584,11 +6582,11 @@ subroutine shr_assert_in_domain_5d_long(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_5d_long ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_6d_long(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -6784,11 +6782,11 @@ subroutine shr_assert_in_domain_6d_long(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_6d_long ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 139 "CDEPS/share/shr_assert_mod.F90.in" +# 137 "CESM_share/src/shr_assert_mod.F90.in" subroutine shr_assert_in_domain_7d_long(var, varname, msg, & is_nan, lt, gt, le, ge, eq, ne, abs_tol) @@ -6984,7 +6982,7 @@ subroutine shr_assert_in_domain_7d_long(var, varname, msg, & #undef GEN_SIZE #undef GEN_ALL -# 334 "CDEPS/share/shr_assert_mod.F90.in" +# 332 "CESM_share/src/shr_assert_mod.F90.in" end subroutine shr_assert_in_domain_7d_long !-------------------------------------------------------------------------- @@ -6992,7 +6990,7 @@ end subroutine shr_assert_in_domain_7d_long ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_0d_double(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7023,11 +7021,11 @@ subroutine print_bad_loc_0d_double(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_0d_double ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_1d_double(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7058,11 +7056,11 @@ subroutine print_bad_loc_1d_double(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_1d_double ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_2d_double(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7094,11 +7092,11 @@ subroutine print_bad_loc_2d_double(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_2d_double ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_3d_double(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7131,11 +7129,11 @@ subroutine print_bad_loc_3d_double(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_3d_double ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_4d_double(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7169,11 +7167,11 @@ subroutine print_bad_loc_4d_double(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_4d_double ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_5d_double(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7208,11 +7206,11 @@ subroutine print_bad_loc_5d_double(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_5d_double ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_6d_double(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7248,11 +7246,11 @@ subroutine print_bad_loc_6d_double(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_6d_double ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_7d_double(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7289,11 +7287,11 @@ subroutine print_bad_loc_7d_double(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_7d_double ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_0d_real(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7324,11 +7322,11 @@ subroutine print_bad_loc_0d_real(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_0d_real ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_1d_real(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7359,11 +7357,11 @@ subroutine print_bad_loc_1d_real(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_1d_real ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_2d_real(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7395,11 +7393,11 @@ subroutine print_bad_loc_2d_real(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_2d_real ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_3d_real(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7432,11 +7430,11 @@ subroutine print_bad_loc_3d_real(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_3d_real ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_4d_real(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7470,11 +7468,11 @@ subroutine print_bad_loc_4d_real(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_4d_real ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_5d_real(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7509,11 +7507,11 @@ subroutine print_bad_loc_5d_real(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_5d_real ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_6d_real(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7549,11 +7547,11 @@ subroutine print_bad_loc_6d_real(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_6d_real ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_7d_real(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7590,11 +7588,11 @@ subroutine print_bad_loc_7d_real(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_7d_real ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_0d_int(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7625,11 +7623,11 @@ subroutine print_bad_loc_0d_int(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_0d_int ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_1d_int(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7660,11 +7658,11 @@ subroutine print_bad_loc_1d_int(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_1d_int ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_2d_int(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7696,11 +7694,11 @@ subroutine print_bad_loc_2d_int(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_2d_int ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_3d_int(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7733,11 +7731,11 @@ subroutine print_bad_loc_3d_int(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_3d_int ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_4d_int(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7771,11 +7769,11 @@ subroutine print_bad_loc_4d_int(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_4d_int ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_5d_int(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7810,11 +7808,11 @@ subroutine print_bad_loc_5d_int(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_5d_int ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_6d_int(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7850,11 +7848,11 @@ subroutine print_bad_loc_6d_int(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_6d_int ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_7d_int(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7891,11 +7889,11 @@ subroutine print_bad_loc_7d_int(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_7d_int ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_0d_long(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7926,11 +7924,11 @@ subroutine print_bad_loc_0d_long(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_0d_long ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_1d_long(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7961,11 +7959,11 @@ subroutine print_bad_loc_1d_long(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_1d_long ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_2d_long(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -7997,11 +7995,11 @@ subroutine print_bad_loc_2d_long(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_2d_long ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_3d_long(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -8034,11 +8032,11 @@ subroutine print_bad_loc_3d_long(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_3d_long ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_4d_long(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -8072,11 +8070,11 @@ subroutine print_bad_loc_4d_long(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_4d_long ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_5d_long(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -8111,11 +8109,11 @@ subroutine print_bad_loc_5d_long(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_5d_long ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_6d_long(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -8151,11 +8149,11 @@ subroutine print_bad_loc_6d_long(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_6d_long ! TYPE double,real,int,long ! DIMS 0,1,2,3,4,5,6,7 -# 341 "CDEPS/share/shr_assert_mod.F90.in" +# 339 "CESM_share/src/shr_assert_mod.F90.in" subroutine print_bad_loc_7d_long(var, loc_vec, varname) ! Print information about a bad location in an variable. ! For scalars, just print value. @@ -8192,14 +8190,14 @@ subroutine print_bad_loc_7d_long(var, loc_vec, varname) if (.false.) write(*,*) loc_vec #endif -# 371 "CDEPS/share/shr_assert_mod.F90.in" +# 369 "CESM_share/src/shr_assert_mod.F90.in" end subroutine print_bad_loc_7d_long !-------------------------------------------------------------------------- !-------------------------------------------------------------------------- ! DIMS 0,1,2,3,4,5,6,7 -# 377 "CDEPS/share/shr_assert_mod.F90.in" +# 375 "CESM_share/src/shr_assert_mod.F90.in" pure function find_first_loc_0d(mask) result (loc_vec) ! Inefficient but simple subroutine for finding the location of ! the first .true. value in an array. @@ -8228,10 +8226,10 @@ pure function find_first_loc_0d(mask) result (loc_vec) #endif -# 405 "CDEPS/share/shr_assert_mod.F90.in" +# 403 "CESM_share/src/shr_assert_mod.F90.in" end function find_first_loc_0d ! DIMS 0,1,2,3,4,5,6,7 -# 377 "CDEPS/share/shr_assert_mod.F90.in" +# 375 "CESM_share/src/shr_assert_mod.F90.in" pure function find_first_loc_1d(mask) result (loc_vec) ! Inefficient but simple subroutine for finding the location of ! the first .true. value in an array. @@ -8260,10 +8258,10 @@ pure function find_first_loc_1d(mask) result (loc_vec) #endif -# 405 "CDEPS/share/shr_assert_mod.F90.in" +# 403 "CESM_share/src/shr_assert_mod.F90.in" end function find_first_loc_1d ! DIMS 0,1,2,3,4,5,6,7 -# 377 "CDEPS/share/shr_assert_mod.F90.in" +# 375 "CESM_share/src/shr_assert_mod.F90.in" pure function find_first_loc_2d(mask) result (loc_vec) ! Inefficient but simple subroutine for finding the location of ! the first .true. value in an array. @@ -8293,10 +8291,10 @@ pure function find_first_loc_2d(mask) result (loc_vec) #endif -# 405 "CDEPS/share/shr_assert_mod.F90.in" +# 403 "CESM_share/src/shr_assert_mod.F90.in" end function find_first_loc_2d ! DIMS 0,1,2,3,4,5,6,7 -# 377 "CDEPS/share/shr_assert_mod.F90.in" +# 375 "CESM_share/src/shr_assert_mod.F90.in" pure function find_first_loc_3d(mask) result (loc_vec) ! Inefficient but simple subroutine for finding the location of ! the first .true. value in an array. @@ -8327,10 +8325,10 @@ pure function find_first_loc_3d(mask) result (loc_vec) #endif -# 405 "CDEPS/share/shr_assert_mod.F90.in" +# 403 "CESM_share/src/shr_assert_mod.F90.in" end function find_first_loc_3d ! DIMS 0,1,2,3,4,5,6,7 -# 377 "CDEPS/share/shr_assert_mod.F90.in" +# 375 "CESM_share/src/shr_assert_mod.F90.in" pure function find_first_loc_4d(mask) result (loc_vec) ! Inefficient but simple subroutine for finding the location of ! the first .true. value in an array. @@ -8362,10 +8360,10 @@ pure function find_first_loc_4d(mask) result (loc_vec) #endif -# 405 "CDEPS/share/shr_assert_mod.F90.in" +# 403 "CESM_share/src/shr_assert_mod.F90.in" end function find_first_loc_4d ! DIMS 0,1,2,3,4,5,6,7 -# 377 "CDEPS/share/shr_assert_mod.F90.in" +# 375 "CESM_share/src/shr_assert_mod.F90.in" pure function find_first_loc_5d(mask) result (loc_vec) ! Inefficient but simple subroutine for finding the location of ! the first .true. value in an array. @@ -8398,10 +8396,10 @@ pure function find_first_loc_5d(mask) result (loc_vec) #endif -# 405 "CDEPS/share/shr_assert_mod.F90.in" +# 403 "CESM_share/src/shr_assert_mod.F90.in" end function find_first_loc_5d ! DIMS 0,1,2,3,4,5,6,7 -# 377 "CDEPS/share/shr_assert_mod.F90.in" +# 375 "CESM_share/src/shr_assert_mod.F90.in" pure function find_first_loc_6d(mask) result (loc_vec) ! Inefficient but simple subroutine for finding the location of ! the first .true. value in an array. @@ -8435,10 +8433,10 @@ pure function find_first_loc_6d(mask) result (loc_vec) #endif -# 405 "CDEPS/share/shr_assert_mod.F90.in" +# 403 "CESM_share/src/shr_assert_mod.F90.in" end function find_first_loc_6d ! DIMS 0,1,2,3,4,5,6,7 -# 377 "CDEPS/share/shr_assert_mod.F90.in" +# 375 "CESM_share/src/shr_assert_mod.F90.in" pure function find_first_loc_7d(mask) result (loc_vec) ! Inefficient but simple subroutine for finding the location of ! the first .true. value in an array. @@ -8473,11 +8471,11 @@ pure function find_first_loc_7d(mask) result (loc_vec) #endif -# 405 "CDEPS/share/shr_assert_mod.F90.in" +# 403 "CESM_share/src/shr_assert_mod.F90.in" end function find_first_loc_7d ! TYPE double,real,int,long -# 408 "CDEPS/share/shr_assert_mod.F90.in" +# 406 "CESM_share/src/shr_assert_mod.F90.in" elemental function within_tolerance_double(expected, actual, tolerance) & result(is_in_tol) ! Precondition: tolerance must be >= 0. @@ -8505,10 +8503,10 @@ elemental function within_tolerance_double(expected, actual, tolerance) & end if end if -# 435 "CDEPS/share/shr_assert_mod.F90.in" +# 433 "CESM_share/src/shr_assert_mod.F90.in" end function within_tolerance_double ! TYPE double,real,int,long -# 408 "CDEPS/share/shr_assert_mod.F90.in" +# 406 "CESM_share/src/shr_assert_mod.F90.in" elemental function within_tolerance_real(expected, actual, tolerance) & result(is_in_tol) ! Precondition: tolerance must be >= 0. @@ -8536,10 +8534,10 @@ elemental function within_tolerance_real(expected, actual, tolerance) & end if end if -# 435 "CDEPS/share/shr_assert_mod.F90.in" +# 433 "CESM_share/src/shr_assert_mod.F90.in" end function within_tolerance_real ! TYPE double,real,int,long -# 408 "CDEPS/share/shr_assert_mod.F90.in" +# 406 "CESM_share/src/shr_assert_mod.F90.in" elemental function within_tolerance_int(expected, actual, tolerance) & result(is_in_tol) ! Precondition: tolerance must be >= 0. @@ -8567,10 +8565,10 @@ elemental function within_tolerance_int(expected, actual, tolerance) & end if end if -# 435 "CDEPS/share/shr_assert_mod.F90.in" +# 433 "CESM_share/src/shr_assert_mod.F90.in" end function within_tolerance_int ! TYPE double,real,int,long -# 408 "CDEPS/share/shr_assert_mod.F90.in" +# 406 "CESM_share/src/shr_assert_mod.F90.in" elemental function within_tolerance_long(expected, actual, tolerance) & result(is_in_tol) ! Precondition: tolerance must be >= 0. @@ -8598,7 +8596,7 @@ elemental function within_tolerance_long(expected, actual, tolerance) & end if end if -# 435 "CDEPS/share/shr_assert_mod.F90.in" +# 433 "CESM_share/src/shr_assert_mod.F90.in" end function within_tolerance_long end module shr_assert_mod diff --git a/share/src/shr_frz_mod.F90 b/share/src/shr_frz_mod.F90 index 82f6502..4bc4550 100644 --- a/share/src/shr_frz_mod.F90 +++ b/share/src/shr_frz_mod.F90 @@ -1,5 +1,5 @@ !=================================================== -! DO NOT EDIT THIS FILE, it was generated using /home/micael/genf90.pl +! DO NOT EDIT THIS FILE, it was generated using genf90.pl ! Any changes you make to this file may be lost !=================================================== module shr_frz_mod @@ -19,7 +19,7 @@ module shr_frz_mod !---------------------------------------------------------------------------- public :: shr_frz_freezetemp, shr_frz_freezetemp_init -# 18 "CDEPS/share/shr_frz_mod.F90.in" +# 18 "CESM_share/src/shr_frz_mod.F90.in" interface shr_frz_freezetemp module procedure shr_frz_freezetemp_0d module procedure shr_frz_freezetemp_1d @@ -36,18 +36,18 @@ module shr_frz_mod integer :: tfrz_option = TFREEZE_OPTION_UNINITIALIZED !=============================================================================== -# 34 "CDEPS/share/shr_frz_mod.F90.in" +# 34 "CESM_share/src/shr_frz_mod.F90.in" contains !=============================================================================== -# 37 "CDEPS/share/shr_frz_mod.F90.in" - subroutine shr_frz_freezetemp_init(tfreeze_option, maintask) +# 37 "CESM_share/src/shr_frz_mod.F90.in" + subroutine shr_frz_freezetemp_init(tfreeze_option, mastertask) implicit none character(len=*),parameter :: subname = "(shr_frz_freezetemp_init) " character(CS),intent(in) :: tfreeze_option ! option for computing freezing point - logical, intent(in) :: maintask ! for io + logical, intent(in) :: mastertask ! for io ! minus1p8 is constant -1.8C ! linear_salt is linear equation ! mushy for CICE mushy-layer nonlinear equation @@ -56,23 +56,23 @@ subroutine shr_frz_freezetemp_init(tfreeze_option, maintask) ! Check tfreeze_option !--------------------------------------------------------------- if (trim(tfreeze_option) == 'minus1p8') then - if (maintask .and. shr_log_level>0) write(s_logunit,*) ' tfreeze_option is minus1p8' + if (mastertask .and. shr_log_level>0) write(s_logunit,*) ' tfreeze_option is minus1p8' tfrz_option = TFREEZE_OPTION_MINUS1P8 elseif (trim(tfreeze_option) == 'linear_salt') then - if (maintask .and. shr_log_level>0) write(s_logunit,*) ' tfreeze_option is linear_salt' + if (mastertask .and. shr_log_level>0) write(s_logunit,*) ' tfreeze_option is linear_salt' tfrz_option = TFREEZE_OPTION_LINEAR_SALT elseif (trim(tfreeze_option) == 'mushy') then - if (maintask .and. shr_log_level>0) write(s_logunit,*) ' tfreeze_option is mushy' + if (mastertask .and. shr_log_level>0) write(s_logunit,*) ' tfreeze_option is mushy' tfrz_option = TFREEZE_OPTION_MUSHY else call shr_sys_abort(subname//' ERROR: not a valid tfreeze_option '//trim(tfreeze_option)) endif -# 64 "CDEPS/share/shr_frz_mod.F90.in" +# 64 "CESM_share/src/shr_frz_mod.F90.in" end subroutine shr_frz_freezetemp_init ! DIMS 0,1,2 -# 67 "CDEPS/share/shr_frz_mod.F90.in" +# 67 "CESM_share/src/shr_frz_mod.F90.in" function shr_frz_freezetemp_0d(s) result(shr_frz_freezetemp) !---------------------------------------------------------------------------- @@ -115,10 +115,10 @@ function shr_frz_freezetemp_0d(s) result(shr_frz_freezetemp) shr_frz_freezetemp = max(shr_frz_freezetemp,-2.0_R8) -# 109 "CDEPS/share/shr_frz_mod.F90.in" +# 109 "CESM_share/src/shr_frz_mod.F90.in" end function shr_frz_freezetemp_0d ! DIMS 0,1,2 -# 67 "CDEPS/share/shr_frz_mod.F90.in" +# 67 "CESM_share/src/shr_frz_mod.F90.in" function shr_frz_freezetemp_1d(s) result(shr_frz_freezetemp) !---------------------------------------------------------------------------- @@ -161,10 +161,10 @@ function shr_frz_freezetemp_1d(s) result(shr_frz_freezetemp) shr_frz_freezetemp = max(shr_frz_freezetemp,-2.0_R8) -# 109 "CDEPS/share/shr_frz_mod.F90.in" +# 109 "CESM_share/src/shr_frz_mod.F90.in" end function shr_frz_freezetemp_1d ! DIMS 0,1,2 -# 67 "CDEPS/share/shr_frz_mod.F90.in" +# 67 "CESM_share/src/shr_frz_mod.F90.in" function shr_frz_freezetemp_2d(s) result(shr_frz_freezetemp) !---------------------------------------------------------------------------- @@ -207,7 +207,7 @@ function shr_frz_freezetemp_2d(s) result(shr_frz_freezetemp) shr_frz_freezetemp = max(shr_frz_freezetemp,-2.0_R8) -# 109 "CDEPS/share/shr_frz_mod.F90.in" +# 109 "CESM_share/src/shr_frz_mod.F90.in" end function shr_frz_freezetemp_2d !=============================================================================== diff --git a/share/src/shr_infnan_mod.F90 b/share/src/shr_infnan_mod.F90 index 2ba6eb9..6bd3960 100644 --- a/share/src/shr_infnan_mod.F90 +++ b/share/src/shr_infnan_mod.F90 @@ -1,6 +1,6 @@ #include "dtypes.h" !=================================================== -! DO NOT EDIT THIS FILE, it was generated using /home/micael/genf90.pl +! DO NOT EDIT THIS FILE, it was generated using genf90.pl ! Any changes you make to this file may be lost !=================================================== ! Flag representing compiler support of Fortran 2003's @@ -71,7 +71,7 @@ module shr_infnan_mod ! Locally defined isnan. #ifndef HAVE_IEEE_ARITHMETIC -# 69 "CDEPS/share/shr_infnan_mod.F90.in" +# 69 "CESM_share/src/shr_infnan_mod.F90.in" interface shr_infnan_isnan ! TYPE double,real module procedure shr_infnan_isnan_double @@ -80,7 +80,7 @@ module shr_infnan_mod end interface #endif -# 75 "CDEPS/share/shr_infnan_mod.F90.in" +# 75 "CESM_share/src/shr_infnan_mod.F90.in" interface shr_infnan_isinf ! TYPE double,real module procedure shr_infnan_isinf_double @@ -88,7 +88,7 @@ module shr_infnan_mod module procedure shr_infnan_isinf_real end interface -# 80 "CDEPS/share/shr_infnan_mod.F90.in" +# 80 "CESM_share/src/shr_infnan_mod.F90.in" interface shr_infnan_isposinf ! TYPE double,real module procedure shr_infnan_isposinf_double @@ -96,7 +96,7 @@ module shr_infnan_mod module procedure shr_infnan_isposinf_real end interface -# 85 "CDEPS/share/shr_infnan_mod.F90.in" +# 85 "CESM_share/src/shr_infnan_mod.F90.in" interface shr_infnan_isneginf ! TYPE double,real module procedure shr_infnan_isneginf_double @@ -124,7 +124,7 @@ module shr_infnan_mod end type shr_infnan_inf_type ! Allow assigning reals to NaN or Inf. -# 110 "CDEPS/share/shr_infnan_mod.F90.in" +# 110 "CESM_share/src/shr_infnan_mod.F90.in" interface assignment(=) ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 @@ -225,13 +225,13 @@ module shr_infnan_mod end interface ! Conversion functions. -# 120 "CDEPS/share/shr_infnan_mod.F90.in" +# 120 "CESM_share/src/shr_infnan_mod.F90.in" interface shr_infnan_to_r8 module procedure nan_r8 module procedure inf_r8 end interface -# 125 "CDEPS/share/shr_infnan_mod.F90.in" +# 125 "CESM_share/src/shr_infnan_mod.F90.in" interface shr_infnan_to_r4 module procedure nan_r4 module procedure inf_r4 @@ -272,7 +272,7 @@ module shr_infnan_mod integer(i8), parameter :: dneginf_pat = ibset(dposinf_pat,bit_size(1_i8)-1) #endif -# 165 "CDEPS/share/shr_infnan_mod.F90.in" +# 165 "CESM_share/src/shr_infnan_mod.F90.in" contains !--------------------------------------------------------------------- @@ -282,24 +282,24 @@ module shr_infnan_mod !--------------------------------------------------------------------- ! TYPE double,real -# 174 "CDEPS/share/shr_infnan_mod.F90.in" +# 174 "CESM_share/src/shr_infnan_mod.F90.in" elemental function shr_infnan_isinf_double(x) result(isinf) real(r8), intent(in) :: x logical :: isinf isinf = shr_infnan_isposinf(x) .or. shr_infnan_isneginf(x) -# 180 "CDEPS/share/shr_infnan_mod.F90.in" +# 180 "CESM_share/src/shr_infnan_mod.F90.in" end function shr_infnan_isinf_double ! TYPE double,real -# 174 "CDEPS/share/shr_infnan_mod.F90.in" +# 174 "CESM_share/src/shr_infnan_mod.F90.in" elemental function shr_infnan_isinf_real(x) result(isinf) real(r4), intent(in) :: x logical :: isinf isinf = shr_infnan_isposinf(x) .or. shr_infnan_isneginf(x) -# 180 "CDEPS/share/shr_infnan_mod.F90.in" +# 180 "CESM_share/src/shr_infnan_mod.F90.in" end function shr_infnan_isinf_real #ifdef HAVE_IEEE_ARITHMETIC @@ -311,7 +311,7 @@ end function shr_infnan_isinf_real !--------------------------------------------------------------------- ! TYPE double,real -# 191 "CDEPS/share/shr_infnan_mod.F90.in" +# 191 "CESM_share/src/shr_infnan_mod.F90.in" elemental function shr_infnan_isposinf_double(x) result(isposinf) use, intrinsic :: ieee_arithmetic, only: & ieee_class, & @@ -322,10 +322,10 @@ elemental function shr_infnan_isposinf_double(x) result(isposinf) isposinf = (ieee_positive_inf == ieee_class(x)) -# 201 "CDEPS/share/shr_infnan_mod.F90.in" +# 201 "CESM_share/src/shr_infnan_mod.F90.in" end function shr_infnan_isposinf_double ! TYPE double,real -# 191 "CDEPS/share/shr_infnan_mod.F90.in" +# 191 "CESM_share/src/shr_infnan_mod.F90.in" elemental function shr_infnan_isposinf_real(x) result(isposinf) use, intrinsic :: ieee_arithmetic, only: & ieee_class, & @@ -336,11 +336,11 @@ elemental function shr_infnan_isposinf_real(x) result(isposinf) isposinf = (ieee_positive_inf == ieee_class(x)) -# 201 "CDEPS/share/shr_infnan_mod.F90.in" +# 201 "CESM_share/src/shr_infnan_mod.F90.in" end function shr_infnan_isposinf_real ! TYPE double,real -# 204 "CDEPS/share/shr_infnan_mod.F90.in" +# 204 "CESM_share/src/shr_infnan_mod.F90.in" elemental function shr_infnan_isneginf_double(x) result(isneginf) use, intrinsic :: ieee_arithmetic, only: & ieee_class, & @@ -351,10 +351,10 @@ elemental function shr_infnan_isneginf_double(x) result(isneginf) isneginf = (ieee_negative_inf == ieee_class(x)) -# 214 "CDEPS/share/shr_infnan_mod.F90.in" +# 214 "CESM_share/src/shr_infnan_mod.F90.in" end function shr_infnan_isneginf_double ! TYPE double,real -# 204 "CDEPS/share/shr_infnan_mod.F90.in" +# 204 "CESM_share/src/shr_infnan_mod.F90.in" elemental function shr_infnan_isneginf_real(x) result(isneginf) use, intrinsic :: ieee_arithmetic, only: & ieee_class, & @@ -365,7 +365,7 @@ elemental function shr_infnan_isneginf_real(x) result(isneginf) isneginf = (ieee_negative_inf == ieee_class(x)) -# 214 "CDEPS/share/shr_infnan_mod.F90.in" +# 214 "CESM_share/src/shr_infnan_mod.F90.in" end function shr_infnan_isneginf_real #else @@ -374,24 +374,24 @@ end function shr_infnan_isneginf_real #ifdef CPRGNU ! NaN testing on gfortran. ! TYPE double,real -# 222 "CDEPS/share/shr_infnan_mod.F90.in" +# 222 "CESM_share/src/shr_infnan_mod.F90.in" elemental function shr_infnan_isnan_double(x) result(is_nan) real(r8), intent(in) :: x logical :: is_nan is_nan = isnan(x) -# 228 "CDEPS/share/shr_infnan_mod.F90.in" +# 228 "CESM_share/src/shr_infnan_mod.F90.in" end function shr_infnan_isnan_double ! TYPE double,real -# 222 "CDEPS/share/shr_infnan_mod.F90.in" +# 222 "CESM_share/src/shr_infnan_mod.F90.in" elemental function shr_infnan_isnan_real(x) result(is_nan) real(r4), intent(in) :: x logical :: is_nan is_nan = isnan(x) -# 228 "CDEPS/share/shr_infnan_mod.F90.in" +# 228 "CESM_share/src/shr_infnan_mod.F90.in" end function shr_infnan_isnan_real ! End GNU section. #endif @@ -402,7 +402,7 @@ end function shr_infnan_isnan_real !--------------------------------------------------------------------- ! TYPE double,real -# 238 "CDEPS/share/shr_infnan_mod.F90.in" +# 238 "CESM_share/src/shr_infnan_mod.F90.in" elemental function shr_infnan_isposinf_double(x) result(isposinf) real(r8), intent(in) :: x logical :: isposinf @@ -414,10 +414,10 @@ elemental function shr_infnan_isposinf_double(x) result(isposinf) isposinf = (x == transfer(posinf_pat,x)) -# 249 "CDEPS/share/shr_infnan_mod.F90.in" +# 249 "CESM_share/src/shr_infnan_mod.F90.in" end function shr_infnan_isposinf_double ! TYPE double,real -# 238 "CDEPS/share/shr_infnan_mod.F90.in" +# 238 "CESM_share/src/shr_infnan_mod.F90.in" elemental function shr_infnan_isposinf_real(x) result(isposinf) real(r4), intent(in) :: x logical :: isposinf @@ -429,11 +429,11 @@ elemental function shr_infnan_isposinf_real(x) result(isposinf) isposinf = (x == transfer(posinf_pat,x)) -# 249 "CDEPS/share/shr_infnan_mod.F90.in" +# 249 "CESM_share/src/shr_infnan_mod.F90.in" end function shr_infnan_isposinf_real ! TYPE double,real -# 252 "CDEPS/share/shr_infnan_mod.F90.in" +# 252 "CESM_share/src/shr_infnan_mod.F90.in" elemental function shr_infnan_isneginf_double(x) result(isneginf) real(r8), intent(in) :: x logical :: isneginf @@ -445,10 +445,10 @@ elemental function shr_infnan_isneginf_double(x) result(isneginf) isneginf = (x == transfer(neginf_pat,x)) -# 263 "CDEPS/share/shr_infnan_mod.F90.in" +# 263 "CESM_share/src/shr_infnan_mod.F90.in" end function shr_infnan_isneginf_double ! TYPE double,real -# 252 "CDEPS/share/shr_infnan_mod.F90.in" +# 252 "CESM_share/src/shr_infnan_mod.F90.in" elemental function shr_infnan_isneginf_real(x) result(isneginf) real(r4), intent(in) :: x logical :: isneginf @@ -460,7 +460,7 @@ elemental function shr_infnan_isneginf_real(x) result(isneginf) isneginf = (x == transfer(neginf_pat,x)) -# 263 "CDEPS/share/shr_infnan_mod.F90.in" +# 263 "CESM_share/src/shr_infnan_mod.F90.in" end function shr_infnan_isneginf_real ! End ieee_arithmetic conditional. @@ -484,7 +484,7 @@ end function shr_infnan_isneginf_real ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" +# 286 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_nan_0d_double(output, nan) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -523,11 +523,11 @@ pure subroutine set_nan_0d_double(output, nan) output = tmp -# 324 "CDEPS/share/shr_infnan_mod.F90.in" +# 324 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_nan_0d_double ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" +# 286 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_nan_1d_double(output, nan) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -566,11 +566,11 @@ pure subroutine set_nan_1d_double(output, nan) output = tmp -# 324 "CDEPS/share/shr_infnan_mod.F90.in" +# 324 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_nan_1d_double ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" +# 286 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_nan_2d_double(output, nan) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -609,11 +609,11 @@ pure subroutine set_nan_2d_double(output, nan) output = tmp -# 324 "CDEPS/share/shr_infnan_mod.F90.in" +# 324 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_nan_2d_double ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" +# 286 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_nan_3d_double(output, nan) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -652,11 +652,11 @@ pure subroutine set_nan_3d_double(output, nan) output = tmp -# 324 "CDEPS/share/shr_infnan_mod.F90.in" +# 324 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_nan_3d_double ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" +# 286 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_nan_4d_double(output, nan) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -695,11 +695,11 @@ pure subroutine set_nan_4d_double(output, nan) output = tmp -# 324 "CDEPS/share/shr_infnan_mod.F90.in" +# 324 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_nan_4d_double ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" +# 286 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_nan_5d_double(output, nan) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -738,11 +738,11 @@ pure subroutine set_nan_5d_double(output, nan) output = tmp -# 324 "CDEPS/share/shr_infnan_mod.F90.in" +# 324 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_nan_5d_double ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" +# 286 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_nan_6d_double(output, nan) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -781,11 +781,11 @@ pure subroutine set_nan_6d_double(output, nan) output = tmp -# 324 "CDEPS/share/shr_infnan_mod.F90.in" +# 324 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_nan_6d_double ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" +# 286 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_nan_7d_double(output, nan) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -824,11 +824,11 @@ pure subroutine set_nan_7d_double(output, nan) output = tmp -# 324 "CDEPS/share/shr_infnan_mod.F90.in" +# 324 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_nan_7d_double ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" +# 286 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_nan_0d_real(output, nan) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -867,11 +867,11 @@ pure subroutine set_nan_0d_real(output, nan) output = tmp -# 324 "CDEPS/share/shr_infnan_mod.F90.in" +# 324 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_nan_0d_real ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" +# 286 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_nan_1d_real(output, nan) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -910,11 +910,11 @@ pure subroutine set_nan_1d_real(output, nan) output = tmp -# 324 "CDEPS/share/shr_infnan_mod.F90.in" +# 324 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_nan_1d_real ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" +# 286 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_nan_2d_real(output, nan) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -953,11 +953,11 @@ pure subroutine set_nan_2d_real(output, nan) output = tmp -# 324 "CDEPS/share/shr_infnan_mod.F90.in" +# 324 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_nan_2d_real ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" +# 286 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_nan_3d_real(output, nan) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -996,11 +996,11 @@ pure subroutine set_nan_3d_real(output, nan) output = tmp -# 324 "CDEPS/share/shr_infnan_mod.F90.in" +# 324 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_nan_3d_real ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" +# 286 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_nan_4d_real(output, nan) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1039,11 +1039,11 @@ pure subroutine set_nan_4d_real(output, nan) output = tmp -# 324 "CDEPS/share/shr_infnan_mod.F90.in" +# 324 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_nan_4d_real ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" +# 286 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_nan_5d_real(output, nan) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1082,11 +1082,11 @@ pure subroutine set_nan_5d_real(output, nan) output = tmp -# 324 "CDEPS/share/shr_infnan_mod.F90.in" +# 324 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_nan_5d_real ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" +# 286 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_nan_6d_real(output, nan) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1125,11 +1125,11 @@ pure subroutine set_nan_6d_real(output, nan) output = tmp -# 324 "CDEPS/share/shr_infnan_mod.F90.in" +# 324 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_nan_6d_real ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 286 "CDEPS/share/shr_infnan_mod.F90.in" +# 286 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_nan_7d_real(output, nan) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1168,12 +1168,12 @@ pure subroutine set_nan_7d_real(output, nan) output = tmp -# 324 "CDEPS/share/shr_infnan_mod.F90.in" +# 324 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_nan_7d_real ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" +# 328 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_inf_0d_double(output, inf) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1212,11 +1212,11 @@ pure subroutine set_inf_0d_double(output, inf) output = tmp -# 366 "CDEPS/share/shr_infnan_mod.F90.in" +# 366 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_inf_0d_double ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" +# 328 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_inf_1d_double(output, inf) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1255,11 +1255,11 @@ pure subroutine set_inf_1d_double(output, inf) output = tmp -# 366 "CDEPS/share/shr_infnan_mod.F90.in" +# 366 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_inf_1d_double ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" +# 328 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_inf_2d_double(output, inf) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1298,11 +1298,11 @@ pure subroutine set_inf_2d_double(output, inf) output = tmp -# 366 "CDEPS/share/shr_infnan_mod.F90.in" +# 366 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_inf_2d_double ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" +# 328 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_inf_3d_double(output, inf) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1341,11 +1341,11 @@ pure subroutine set_inf_3d_double(output, inf) output = tmp -# 366 "CDEPS/share/shr_infnan_mod.F90.in" +# 366 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_inf_3d_double ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" +# 328 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_inf_4d_double(output, inf) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1384,11 +1384,11 @@ pure subroutine set_inf_4d_double(output, inf) output = tmp -# 366 "CDEPS/share/shr_infnan_mod.F90.in" +# 366 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_inf_4d_double ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" +# 328 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_inf_5d_double(output, inf) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1427,11 +1427,11 @@ pure subroutine set_inf_5d_double(output, inf) output = tmp -# 366 "CDEPS/share/shr_infnan_mod.F90.in" +# 366 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_inf_5d_double ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" +# 328 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_inf_6d_double(output, inf) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1470,11 +1470,11 @@ pure subroutine set_inf_6d_double(output, inf) output = tmp -# 366 "CDEPS/share/shr_infnan_mod.F90.in" +# 366 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_inf_6d_double ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" +# 328 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_inf_7d_double(output, inf) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1513,11 +1513,11 @@ pure subroutine set_inf_7d_double(output, inf) output = tmp -# 366 "CDEPS/share/shr_infnan_mod.F90.in" +# 366 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_inf_7d_double ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" +# 328 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_inf_0d_real(output, inf) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1556,11 +1556,11 @@ pure subroutine set_inf_0d_real(output, inf) output = tmp -# 366 "CDEPS/share/shr_infnan_mod.F90.in" +# 366 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_inf_0d_real ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" +# 328 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_inf_1d_real(output, inf) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1599,11 +1599,11 @@ pure subroutine set_inf_1d_real(output, inf) output = tmp -# 366 "CDEPS/share/shr_infnan_mod.F90.in" +# 366 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_inf_1d_real ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" +# 328 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_inf_2d_real(output, inf) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1642,11 +1642,11 @@ pure subroutine set_inf_2d_real(output, inf) output = tmp -# 366 "CDEPS/share/shr_infnan_mod.F90.in" +# 366 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_inf_2d_real ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" +# 328 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_inf_3d_real(output, inf) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1685,11 +1685,11 @@ pure subroutine set_inf_3d_real(output, inf) output = tmp -# 366 "CDEPS/share/shr_infnan_mod.F90.in" +# 366 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_inf_3d_real ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" +# 328 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_inf_4d_real(output, inf) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1728,11 +1728,11 @@ pure subroutine set_inf_4d_real(output, inf) output = tmp -# 366 "CDEPS/share/shr_infnan_mod.F90.in" +# 366 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_inf_4d_real ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" +# 328 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_inf_5d_real(output, inf) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1771,11 +1771,11 @@ pure subroutine set_inf_5d_real(output, inf) output = tmp -# 366 "CDEPS/share/shr_infnan_mod.F90.in" +# 366 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_inf_5d_real ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" +# 328 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_inf_6d_real(output, inf) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1814,11 +1814,11 @@ pure subroutine set_inf_6d_real(output, inf) output = tmp -# 366 "CDEPS/share/shr_infnan_mod.F90.in" +# 366 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_inf_6d_real ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 -# 328 "CDEPS/share/shr_infnan_mod.F90.in" +# 328 "CESM_share/src/shr_infnan_mod.F90.in" pure subroutine set_inf_7d_real(output, inf) #ifdef HAVE_IEEE_ARITHMETIC use, intrinsic :: ieee_arithmetic, only: & @@ -1857,7 +1857,7 @@ pure subroutine set_inf_7d_real(output, inf) output = tmp -# 366 "CDEPS/share/shr_infnan_mod.F90.in" +# 366 "CESM_share/src/shr_infnan_mod.F90.in" end subroutine set_inf_7d_real !--------------------------------------------------------------------- @@ -1866,44 +1866,44 @@ end subroutine set_inf_7d_real ! Function methods to get reals from nan/inf types. !--------------------------------------------------------------------- -# 374 "CDEPS/share/shr_infnan_mod.F90.in" +# 374 "CESM_share/src/shr_infnan_mod.F90.in" pure function nan_r8(nan) result(output) class(shr_infnan_nan_type), intent(in) :: nan real(r8) :: output output = nan -# 380 "CDEPS/share/shr_infnan_mod.F90.in" +# 380 "CESM_share/src/shr_infnan_mod.F90.in" end function nan_r8 -# 382 "CDEPS/share/shr_infnan_mod.F90.in" +# 382 "CESM_share/src/shr_infnan_mod.F90.in" pure function nan_r4(nan) result(output) class(shr_infnan_nan_type), intent(in) :: nan real(r4) :: output output = nan -# 388 "CDEPS/share/shr_infnan_mod.F90.in" +# 388 "CESM_share/src/shr_infnan_mod.F90.in" end function nan_r4 -# 390 "CDEPS/share/shr_infnan_mod.F90.in" +# 390 "CESM_share/src/shr_infnan_mod.F90.in" pure function inf_r8(inf) result(output) class(shr_infnan_inf_type), intent(in) :: inf real(r8) :: output output = inf -# 396 "CDEPS/share/shr_infnan_mod.F90.in" +# 396 "CESM_share/src/shr_infnan_mod.F90.in" end function inf_r8 -# 398 "CDEPS/share/shr_infnan_mod.F90.in" +# 398 "CESM_share/src/shr_infnan_mod.F90.in" pure function inf_r4(inf) result(output) class(shr_infnan_inf_type), intent(in) :: inf real(r4) :: output output = inf -# 404 "CDEPS/share/shr_infnan_mod.F90.in" +# 404 "CESM_share/src/shr_infnan_mod.F90.in" end function inf_r4 end module shr_infnan_mod From c88926fba49a3093e4568955d896ed8ebdc6d7ab Mon Sep 17 00:00:00 2001 From: Micael Oliveira Date: Thu, 10 Aug 2023 11:39:15 +1000 Subject: [PATCH 08/11] Change flags for one specific file to minic CESM build. --- share/CMakeLists.txt | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/share/CMakeLists.txt b/share/CMakeLists.txt index 890edf7..d572f33 100644 --- a/share/CMakeLists.txt +++ b/share/CMakeLists.txt @@ -49,6 +49,12 @@ list(APPEND stubs_src_files src/mct_mod.F90 ) +if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + # CESM reduces the precision and increases speed for the following file + set_source_files_properties(CESM_share/src/shr_wv_sat_mod.F90 PROPERTIES COMPILE_FLAGS "-fimf-precision=low -fp-model fast") +endif() + + # Collect source files for library add_library(share STATIC ${stubs_src_files} ${cesm_share_generated_files} ${cesm_share_src_files}) From 592fed3626c16d667f71ee1b0a7e70b2bb9e33dc Mon Sep 17 00:00:00 2001 From: Micael Oliveira Date: Tue, 15 Aug 2023 10:32:18 +1000 Subject: [PATCH 09/11] Compile MOM6 with non-symmetric memory layout by default. --- MOM6/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/MOM6/CMakeLists.txt b/MOM6/CMakeLists.txt index 0c5a2d2..53bdd1b 100644 --- a/MOM6/CMakeLists.txt +++ b/MOM6/CMakeLists.txt @@ -5,7 +5,7 @@ elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") set(fortran_compile_flags -r8) endif() -option(SYMMETRIC "Use symmetric memory" ON) +option(SYMMETRIC "Use symmetric memory" OFF) if(SYMMETRIC) set(MOM_memory "dynamic_symmetric") else() From 4024a1e3253065988a91912a2bf18aeea4cc8652 Mon Sep 17 00:00:00 2001 From: Micael Oliveira Date: Tue, 15 Aug 2023 10:36:58 +1000 Subject: [PATCH 10/11] Fix list of compiler definitions used when compiling CICE to match the ones used in CESM. --- CICE/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CICE/CMakeLists.txt b/CICE/CMakeLists.txt index b92a767..77b073e 100644 --- a/CICE/CMakeLists.txt +++ b/CICE/CMakeLists.txt @@ -14,7 +14,7 @@ list(APPEND lib_src_files ${cice_nuopc_cmeps_driver_files}) list(APPEND _cice_defs FORTRANUNDERSCORE - coupled) + ncdf) # Select IO source files based on CICE_IO if(CICE_IO MATCHES "NetCDF") From 6de17565890f31410e78cef6b61904465281380b Mon Sep 17 00:00:00 2001 From: Micael Oliveira Date: Tue, 15 Aug 2023 10:40:17 +1000 Subject: [PATCH 11/11] By default, do not use OpenMP. --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index f6d5281..5c2a9f4 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -45,7 +45,7 @@ else() endif() # Build options -set(OPENMP ON CACHE BOOL "Enable OpenMP threading") +set(OPENMP OFF CACHE BOOL "Enable OpenMP threading") message(STATUS "Build options") message(STATUS " - OPENMP ${OPENMP}")