diff --git a/CMakeLists.txt b/CMakeLists.txt index 55d432a5c..b0527184a 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -283,6 +283,8 @@ else() src/offline/cable_abort.F90 src/offline/cable_checks.F90 src/offline/cable_cru_TRENDY.F90 + src/offline/cable_diagnostics_casa.F90 + src/offline/cable_diagnostics.F90 src/offline/cable_driver_common.F90 src/offline/cable_initialise.F90 src/offline/cable_input.F90 @@ -290,7 +292,6 @@ else() src/offline/cable_mpi_stub_types.F90 src/offline/cable_mpi.F90 src/offline/cable_namelist_input.F90 - src/offline/cable_output.F90 src/offline/cable_parameters.F90 src/offline/cable_pft_params.F90 src/offline/cable_plume_mip.F90 @@ -299,19 +300,28 @@ else() src/offline/cable_serial.F90 src/offline/cable_soil_params.F90 src/offline/cable_weathergenerator.F90 - src/offline/cable_write.F90 src/offline/casa_cable.F90 src/offline/cbl_model_driver_offline.F90 src/offline/landuse_inout.F90 src/offline/spincasacnp.F90 + src/util/aggregator.F90 src/util/cable_climate_type_mod.F90 src/util/masks_cbl.F90 src/util/cable_array_utils.F90 + src/util/cable_grid_reductions.F90 + src/util/cable_timing.F90 src/util/netcdf/cable_netcdf_decomp_util.F90 src/util/netcdf/cable_netcdf.F90 src/util/netcdf/cable_netcdf_init.F90 src/util/netcdf/cable_netcdf_stub_types.F90 src/util/netcdf/nf90/cable_netcdf_nf90.F90 + src/util/output/cable_output_decomp.F90 + src/util/output/cable_output_define.F90 + src/util/output/cable_output_impl.F90 + src/util/output/cable_output_common.F90 + src/util/output/cable_output_reduction_buffers.F90 + src/util/output/cable_output_write.F90 + src/util/output/cable_output.F90 ) target_link_libraries(cable_common PRIVATE PkgConfig::NETCDF) diff --git a/build.bash b/build.bash index 08c6b10eb..90e76fc31 100755 --- a/build.bash +++ b/build.bash @@ -110,7 +110,7 @@ if hostname -f | grep gadi.nci.org.au > /dev/null; then # 2024.0.0 or higher module add intel-compiler-llvm/2024.0.2 else - module add intel-compiler/2019.5.281 + module add intel-compiler/2021.6.0 fi compiler_lib_install_dir=Intel [[ -n ${mpi} ]] && module add intel-mpi/2019.5.281 diff --git a/src/offline/cable_abort.F90 b/src/offline/cable_abort.F90 index 622bad1d8..445ef351d 100644 --- a/src/offline/cable_abort.F90 +++ b/src/offline/cable_abort.F90 @@ -37,8 +37,6 @@ MODULE cable_abort_module ! open_met_file ! get_met_data ! load_parameters - ! open_output_file - ! write_output ! read_gridinfo ! countpatch ! get_type_parameters @@ -47,16 +45,6 @@ MODULE cable_abort_module ! readpar_rd ! readpar_r2 ! readpar_r2d - ! define_output_variable_r1 - ! define_output_variable_r2 - ! define_output_parameter_r1 - ! define_output_parameter_r2 - ! write_output_variable_r1 - ! write_output_variable_r2 - ! write_output_parameter_r1 - ! write_output_parameter_r1d - ! write_output_parameter_r2 - ! write_output_parameter_r2d ! !============================================================================== @@ -83,26 +71,12 @@ END SUBROUTINE abort ! get_met_data ! close_met_file ! load_parameters - ! open_output_file - ! write_output - ! close_output_file - ! create_restart ! read_gridinfo ! readpar_i ! readpar_r ! readpar_rd ! readpar_r2 ! readpar_r2d - ! define_output_variable_r1 - ! define_output_variable_r2 - ! define_output_parameter_r1 - ! define_output_parameter_r2 - ! write_output_variable_r1 - ! write_output_variable_r2 - ! write_output_parameter_r1 - ! write_output_parameter_r1d - ! write_output_parameter_r2 - ! write_output_parameter_r2d ! ! MODULEs used: netcdf ! @@ -130,9 +104,6 @@ END SUBROUTINE nc_abort ! Purpose: Prints an error message and localisation information then stops the ! code ! - ! CALLed from: write_output_variable_r1 - ! write_output_variable_r2 - ! ! MODULEs used: cable_def_types_mod ! cable_IO_vars_module ! diff --git a/src/offline/cable_checks.F90 b/src/offline/cable_checks.F90 index 86fc6251b..6b8fe7755 100644 --- a/src/offline/cable_checks.F90 +++ b/src/offline/cable_checks.F90 @@ -300,7 +300,7 @@ SUBROUTINE constant_check_range(soil, veg, ktau, met) ! Commented ones in cable_def_types need to be checked ! Commented ones here need to be range-specified ! In future, it's better to have a callback for a derived type having both ranges and values - ! This also clashes with range checks in open_output_file + ! This also clashes with range checks in the output module TYPE(soil_parameter_type), INTENT(IN) :: soil TYPE(veg_parameter_type), INTENT(IN) :: veg @@ -467,9 +467,6 @@ END SUBROUTINE constant_check_range ! to scrutinise balance in particular sections of the code - largely ! for diagnostics/fault finding. ! - ! CALLed from: write_output - ! - ! !============================================================================== SUBROUTINE mass_balance(dels,ktau, ssnow,soil,canopy,met, & @@ -561,8 +558,6 @@ END SUBROUTINE mass_balance ! to scrutinise balance in particular sections of the code - largely ! for diagnostics/fault finding. ! - ! CALLed from: write_output - ! ! MODULEs used: cable_data (inherited) ! !============================================================================== diff --git a/src/offline/cable_define_types.F90 b/src/offline/cable_define_types.F90 index a7faec1f8..82c858419 100644 --- a/src/offline/cable_define_types.F90 +++ b/src/offline/cable_define_types.F90 @@ -24,7 +24,8 @@ !#define UM_BUILD yes MODULE cable_def_types_mod -USE cable_climate_type_mod, ONLY: climate_type + USE cable_climate_type_mod, ONLY: climate_type + USE aggregator_mod, ONLY: aggregator_real32_1d_t, new_aggregator ! Contains all variables which are not subroutine-internal @@ -534,6 +535,8 @@ MODULE cable_def_types_mod ! vh_js ! !litter thermal conductivity (Wm-2K-1) and vapour diffusivity (m2s-1) REAL(r_2), DIMENSION(:), POINTER :: kthLitt, DvLitt + type(aggregator_real32_1d_t), allocatable :: tscrn_max_daily + type(aggregator_real32_1d_t), allocatable :: tscrn_min_daily END TYPE canopy_type @@ -1194,6 +1197,9 @@ SUBROUTINE alloc_canopy_type(var, mp) ALLOCATE (var % kthLitt(mp)) ALLOCATE (var % DvLitt(mp)) + var%tscrn_max_daily = new_aggregator(source_data=var%tscrn); CALL var%tscrn_max_daily%init(method="max") + var%tscrn_min_daily = new_aggregator(source_data=var%tscrn); CALL var%tscrn_min_daily%init(method="min") + END SUBROUTINE alloc_canopy_type ! ------------------------------------------------------------------------------ @@ -1825,6 +1831,9 @@ SUBROUTINE dealloc_canopy_type(var) DEALLOCATE (var % kthLitt) DEALLOCATE (var % DvLitt) + DEALLOCATE(var%tscrn_max_daily) + DEALLOCATE(var%tscrn_min_daily) + END SUBROUTINE dealloc_canopy_type ! ------------------------------------------------------------------------------ diff --git a/src/offline/cable_diagnostics.F90 b/src/offline/cable_diagnostics.F90 new file mode 100644 index 000000000..f4a621235 --- /dev/null +++ b/src/offline/cable_diagnostics.F90 @@ -0,0 +1,2208 @@ +module cable_diagnostics_mod + + use cable_def_types_mod, only: met_type + use cable_def_types_mod, only: canopy_type + use cable_def_types_mod, only: soil_parameter_type + use cable_def_types_mod, only: soil_snow_type + use cable_def_types_mod, only: radiation_type + use cable_def_types_mod, only: veg_parameter_type + use cable_def_types_mod, only: balances_type + use cable_def_types_mod, only: roughness_type + use cable_def_types_mod, only: bgc_pool_type + use cable_def_types_mod, only: mvtype, mstype + + use cable_phys_constants_mod, only: c_molar_mass + use cable_phys_constants_mod, only: HL + + use cable_netcdf_mod, only: CABLE_NETCDF_INT + use cable_netcdf_mod, only: CABLE_NETCDF_FLOAT + + use aggregator_mod, only: new_aggregator + + use cable_common_module, only: cable_user + use cable_common_module, only: gw_params + use cable_common_module, only: calcsoilalbedo + + use cable_io_vars_module, only: output, patchout + use cable_io_vars_module, only: landpt_global + use cable_io_vars_module, only: patch + + use cable_output_mod, only: cable_output_variable_t + use cable_output_mod, only: cable_output_dim_t + use cable_output_mod, only: attribute => cable_output_attribute_t + use cable_output_mod, only: cable_output_get_dimension + + use cable_checks_module, only: ranges + + implicit none + private + + public :: cable_diagnostics + +contains + + function cable_diagnostics(met, canopy, soil, ssnow, rad, veg, bal, rough, bgc, dels) result(output_variables) + type(met_type), intent(inout) :: met + type(canopy_type), intent(inout) :: canopy + type(soil_parameter_type), intent(inout) :: soil + type(soil_snow_type), intent(inout) :: ssnow + type(radiation_type), intent(inout) :: rad + type(veg_parameter_type), intent(inout) :: veg + type(balances_type), intent(inout) :: bal + type(roughness_type), intent(inout) :: rough + type(bgc_pool_type), intent(inout) :: bgc + real, intent(in) :: dels + + type(cable_output_variable_t), allocatable :: output_variables(:) + + type(cable_output_dim_t) :: dim_patch + type(cable_output_dim_t) :: dim_soil + type(cable_output_dim_t) :: dim_rad + type(cable_output_dim_t) :: dim_snow + type(cable_output_dim_t) :: dim_plant_carbon + type(cable_output_dim_t) :: dim_soil_carbon + type(cable_output_dim_t) :: dim_land_global + + dim_patch = cable_output_get_dimension("patch") + dim_soil = cable_output_get_dimension("soil") + dim_rad = cable_output_get_dimension("rad") + dim_snow = cable_output_get_dimension("snow") + dim_plant_carbon = cable_output_get_dimension("plant_carbon_pools") + dim_soil_carbon = cable_output_get_dimension("soil_carbon_pools") + dim_land_global = cable_output_get_dimension("land_global") + + output_variables = [ & + cable_output_variable_t( & + field_name="fsd", & + netcdf_name="SWdown", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%SWdown, & + active=output%met .or. output%SWdown, & + patchout=output%patch .or. patchout%SWdown, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(met%ofsd), & + metadata=[ & + attribute("units", "W/m^2"), & + attribute("long_name", "Downward shortwave radiation") & + ] & + ), & + cable_output_variable_t( & + field_name="fld", & + netcdf_name="LWdown", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%LWdown, & + active=output%met .or. output%LWdown, & + patchout=output%patch .or. patchout%LWdown, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(met%fld), & + metadata=[ & + attribute("units", "W/m^2"), & + attribute("long_name", "Downward longwave radiation") & + ] & + ), & + cable_output_variable_t( & + field_name="precip", & + netcdf_name="Rainf", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Rainf, & + active=output%met .or. output%Rainf, & + patchout=output%patch .or. patchout%Rainf, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(met%precip), & + divide_by=dels, & + metadata=[ & + attribute("units", "kg/m^2/s"), & + attribute("long_name", "Rainfall+snowfall") & + ] & + ), & + cable_output_variable_t( & + field_name="precip_sn", & + netcdf_name="Snowf", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Snowf, & + active=output%met .or. output%Snowf, & + patchout=output%patch .or. patchout%Snowf, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(met%precip_sn), & + divide_by=dels, & + metadata=[ & + attribute("units", "kg/m^2/s"), & + attribute("long_name", "Snowfall") & + ] & + ), & + cable_output_variable_t( & + field_name="pmb", & + netcdf_name="PSurf", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%PSurf, & + active=output%met .or. output%PSurf, & + patchout=output%patch .or. patchout%PSurf, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(met%pmb), & + metadata=[ & + attribute("units", "hPa"), & + attribute("long_name", "Surface air pressure") & + ] & + ), & + cable_output_variable_t( & + field_name="tk", & + netcdf_name="Tair", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Tair, & + active=output%met .or. output%Tair, & + patchout=output%patch .or. patchout%Tair, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(met%tk), & + metadata=[ & + attribute("units", "K"), & + attribute("long_name", "Surface air temperature") & + ] & + ), & + cable_output_variable_t( & + field_name="qv", & + netcdf_name="Qair", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Qair, & + active=output%met .or. output%Qair, & + patchout=output%patch .or. patchout%Qair, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(met%qv), & + metadata=[ & + attribute("units", "kg/kg"), & + attribute("long_name", "Surface specific humidity") & + ] & + ), & + cable_output_variable_t( & + field_name="ua", & + netcdf_name="Wind", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Wind, & + active=output%met .or. output%Wind, & + patchout=output%patch .or. patchout%Wind, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(met%ua), & + metadata=[ & + attribute("units", "m/s"), & + attribute("long_name", "Scalar surface wind speed") & + ] & + ), & + cable_output_variable_t( & + field_name="ca", & + netcdf_name="CO2air", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%CO2air, & + active=output%met .or. output%CO2air, & + patchout=output%patch .or. patchout%CO2air, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + scale_by=1e6, & ! Convert to ppmv + aggregator=new_aggregator(met%ca), & + metadata=[ & + attribute("units", "ppmv"), & + attribute("long_name", "Surface air CO2 concentration") & + ] & + ), & + cable_output_variable_t( & + field_name="qmom", & + netcdf_name="Qmom", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Qmom, & + active=output%flux .or. output%Qmom, & + patchout=output%patch .or. patchout%Qmom, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%qmom), & + metadata=[ & + attribute("units", "kg/m/s2"), & + attribute("long_name", "Surface momentum flux") & + ] & + ), & + cable_output_variable_t( & + field_name="fe", & + netcdf_name="Qle", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Qle, & + active=output%flux .or. output%Qle, & + patchout=output%patch .or. patchout%Qle, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%fe), & + metadata=[ & + attribute("units", "W/m^2"), & + attribute("long_name", "Surface latent heat flux") & + ] & + ), & + cable_output_variable_t( & + field_name="fh", & + netcdf_name="Qh", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Qh, & + active=output%flux .or. output%Qh, & + patchout=output%patch .or. patchout%Qh, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%fh), & + metadata=[ & + attribute("units", "W/m^2"), & + attribute("long_name", "Surface sensible heat flux") & + ] & + ), & + cable_output_variable_t( & + field_name="ga", & + netcdf_name="Qg", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Qg, & + active=output%flux .or. output%Qg, & + patchout=output%patch .or. patchout%Qg, & + restart=.true., & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%ga), & + metadata=[ & + attribute("units", "W/m^2"), & + attribute("long_name", "Surface ground heat flux") & + ] & + ), & + cable_output_variable_t( & + field_name="rnof1", & + netcdf_name="Qs", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Qs, & + active=output%flux .or. output%Qs, & + patchout=output%patch .or. patchout%Qs, & + restart=.true., & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(ssnow%rnof1), & + divide_by=dels, & + metadata=[ & + attribute("units", "kg/m^2/s"), & + attribute("long_name", "Surface runoff") & + ] & + ), & + cable_output_variable_t( & + field_name="rnof2", & + netcdf_name="Qsb", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Qsb, & + active=output%flux .or. output%Qsb, & + patchout=output%patch .or. patchout%Qsb, & + restart=.true., & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(ssnow%rnof2), & + divide_by=dels, & + metadata=[ & + attribute("units", "kg/m^2/s"), & + attribute("long_name", "Subsurface runoff") & + ] & + ), & + cable_output_variable_t( & + field_name="et", & + netcdf_name="Evap", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Evap, & + active=output%flux .or. output%Evap, & + patchout=output%patch .or. patchout%Evap, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%fe), & + divide_by=HL, & + metadata=[ & + attribute("units", "kg/m^2/s"), & + attribute("long_name", "Total evapotranspiration") & + ] & + ), & + cable_output_variable_t( & + field_name="epot", & + netcdf_name="PotEvap", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%PotEvap, & + active=output%flux .or. output%PotEvap, & + patchout=output%patch .or. patchout%PotEvap, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%epot), & + divide_by=dels, & + metadata=[ & + attribute("units", "kg/m^2/s"), & + attribute("long_name", "Potential evaporation") & + ] & + ), & + cable_output_variable_t( & + field_name="eint", & + netcdf_name="ECanop", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%ECanop, & + active=output%flux .or. output%ECanop, & + patchout=output%patch .or. patchout%ECanop, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%fevw), & + divide_by=HL, & + metadata=[ & + attribute("units", "kg/m^2/s"), & + attribute("long_name", "Wet canopy evaporation") & + ] & + ), & + cable_output_variable_t( & + field_name="tveg", & + netcdf_name="TVeg", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%TVeg, & + active=output%flux .or. output%TVeg, & + patchout=output%patch .or. patchout%TVeg, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%fevc), & + divide_by=HL, & + metadata=[ & + attribute("units", "kg/m^2/s"), & + attribute("long_name", "Vegetation transpiration") & + ] & + ), & + cable_output_variable_t( & + field_name="esoil", & + netcdf_name="ESoil", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%ESoil, & + active=output%flux .or. output%ESoil, & + patchout=output%patch .or. patchout%ESoil, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%fes), & + divide_by=HL, & + metadata=[ & + attribute("units", "kg/m^2/s"), & + attribute("long_name", "Evaporation from soil") & + ] & + ), & + cable_output_variable_t( & + field_name="fhv", & + netcdf_name="HVeg", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%HVeg, & + active=output%flux .or. output%HVeg, & + patchout=output%patch .or. patchout%HVeg, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%fhv), & + metadata=[ & + attribute("units", "W/m^2"), & + attribute("long_name", "Sensible heat from vegetation") & + ] & + ), & + cable_output_variable_t( & + field_name="fhs", & + netcdf_name="HSoil", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%HSoil, & + active=output%flux .or. output%HSoil, & + patchout=output%patch .or. patchout%HSoil, & + restart=.true., & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%fhs), & + metadata=[ & + attribute("units", "W/m^2"), & + attribute("long_name", "Sensible heat from soil") & + ] & + ), & + cable_output_variable_t( & + field_name="fns", & + netcdf_name="RnetSoil", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%HSoil, & + active=output%flux .or. output%RnetSoil, & + patchout=output%patch .or. patchout%RnetSoil, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%fns), & + metadata=[ & + attribute("units", "W/m^2"), & + attribute("long_name", "Net radiation absorbed by ground") & + ] & + ), & + cable_output_variable_t( & + field_name="wb", & + netcdf_name="SoilMoist", & + data_shape=[dim_patch, dim_soil], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%SoilMoist, & + active=output%soil .or. output%SoilMoist, & + patchout=output%patch .or. patchout%SoilMoist, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(ssnow%wb), & + restart=.true., & + metadata=[ & + attribute("units", "m^3/m^3"), & + attribute("long_name", "Average layer soil moisture") & + ] & + ), & + cable_output_variable_t( & + field_name="wbice", & + netcdf_name="SoilMoistIce", & + data_shape=[dim_patch, dim_soil], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%SoilMoist, & + active=output%soil .or. output%SoilMoistIce, & + patchout=output%patch .or. patchout%SoilMoistIce, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(ssnow%wbice), & + restart=.true., & + metadata=[ & + attribute("units", "m^3/m^3"), & + attribute("long_name", "Average layer frozen soil moisture") & + ] & + ), & + cable_output_variable_t( & + field_name="tgg", & + netcdf_name="SoilTemp", & + data_shape=[dim_patch, dim_soil], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%SoilTemp, & + active=output%soil .or. output%SoilTemp, & + patchout=output%patch .or. patchout%SoilTemp, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(ssnow%tgg), & + restart=.true., & + metadata=[ & + attribute("units", "K"), & + attribute("long_name", "Average layer soil temperature") & + ] & + ), & + cable_output_variable_t( & + field_name="gammzz", & + data_shape=[dim_patch, dim_soil], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + aggregation_method="mean", & + restart=.true., & + aggregator=new_aggregator(ssnow%gammzz), & + metadata=[ & + attribute("units", "J/kg/C"), & + attribute("long_name", "Heat capacity for each soil layer") & + ] & + ), & + cable_output_variable_t( & + field_name="ssdn", & + data_shape=[dim_patch, dim_snow], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + aggregation_method="mean", & + restart=.true., & + aggregator=new_aggregator(ssnow%ssdn), & + metadata=[ & + attribute("units", "kg/m^3"), & + attribute("long_name", "Average layer snow density") & + ] & + ), & + cable_output_variable_t( & + field_name="smass", & + data_shape=[dim_patch, dim_snow], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + aggregation_method="mean", & + restart=.true., & + aggregator=new_aggregator(ssnow%smass), & + metadata=[ & + attribute("units", "kg/m^2"), & + attribute("long_name", "Average layer snow mass") & + ] & + ), & + cable_output_variable_t( & + field_name="tgg1", & + netcdf_name="BaresoilT", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%BaresoilT, & + active=output%soil .or. output%BaresoilT, & + patchout=output%patch .or. patchout%BaresoilT, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(ssnow%tgg(:, 1)), & + metadata=[ & + attribute("units", "K"), & + attribute("long_name", "Bare soil temperature") & + ] & + ), & + cable_output_variable_t( & + field_name="snowd", & + netcdf_name="SWE", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%SWE, & + active=output%snow .or. output%SWE, & + patchout=output%patch .or. patchout%SWE, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(ssnow%snowd), & + restart=.true., & + metadata=[ & + attribute("units", "kg/m^2"), & + attribute("long_name", "Snow water equivalent") & + ] & + ), & + cable_output_variable_t( & + field_name="smelt", & + netcdf_name="SnowMelt", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%SnowMelt, & + active=output%snow .or. output%SnowMelt, & + patchout=output%patch .or. patchout%SnowMelt, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(ssnow%smelt), & + divide_by=dels, & + metadata=[ & + attribute("units", "kg/m^2/s"), & + attribute("long_name", "Snow Melt Rate") & + ] & + ), & + cable_output_variable_t( & + field_name="tggsn", & + data_shape=[dim_patch, dim_snow], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + aggregation_method="mean", & + restart=.true., & + aggregator=new_aggregator(ssnow%tggsn), & + metadata=[ & + attribute("units", "K"), & + attribute("long_name", "Average layer snow temperature") & + ] & + ), & + cable_output_variable_t( & + field_name="tggsn1", & + netcdf_name="SnowT", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%SnowT, & + active=output%snow .or. output%SnowT, & + patchout=output%patch .or. patchout%SnowT, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(ssnow%tggsn(:, 1)), & + metadata=[ & + attribute("units", "K"), & + attribute("long_name", "Snow surface temperature") & + ] & + ), & + cable_output_variable_t( & + field_name="sdepth", & + data_shape=[dim_patch, dim_snow], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%SnowDepth, & + active=.false., & + aggregation_method="mean", & + restart=.true., & + aggregator=new_aggregator(ssnow%sdepth), & + metadata=[ & + attribute("units", "m"), & + attribute("long_name", "Snow layer depth") & + ] & + ), & + cable_output_variable_t( & + field_name="totsdepth", & + netcdf_name="SnowDepth", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%SnowDepth, & + active=output%snow .or. output%SnowDepth, & + patchout=output%patch .or. patchout%SnowDepth, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(ssnow%totsdepth), & + metadata=[ & + attribute("units", "m"), & + attribute("long_name", "Snow depth") & + ] & + ), & + cable_output_variable_t( & + field_name="swnet", & + netcdf_name="SWnet", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%SWnet, & + active=output%radiation .or. output%SWnet, & + patchout=output%patch .or. patchout%SWnet, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(rad%swnet), & + metadata=[ & + attribute("units", "W/m^2"), & + attribute("long_name", "Net shortwave radiation absorbed by surface") & + ] & + ), & + cable_output_variable_t( & + field_name="lwnet", & + netcdf_name="LWnet", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%LWnet, & + active=output%radiation .or. output%LWnet, & + patchout=output%patch .or. patchout%LWnet, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(rad%lwnet), & + metadata=[ & + attribute("units", "W/m^2"), & + attribute("long_name", "Net longwave radiation absorbed by surface") & + ] & + ), & + cable_output_variable_t( & + field_name="rnet", & + netcdf_name="Rnet", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Rnet, & + active=output%radiation .or. output%Rnet, & + patchout=output%patch .or. patchout%Rnet, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(rad%rnet), & + metadata=[ & + attribute("units", "W/m^2"), & + attribute("long_name", "Net radiation absorbed by surface") & + ] & + ), & + cable_output_variable_t( & + field_name="albedo_T", & + netcdf_name="Albedo", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Albedo, & + active=output%radiation .or. output%Albedo, & + patchout=output%patch .or. patchout%Albedo, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(rad%albedo_T), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Surface albedo") & + ] & + ), & + cable_output_variable_t( & + field_name="albedo_vis", & + netcdf_name="visAlbedo", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%visAlbedo, & + active=(output%radiation .or. output%visAlbedo) .and. calcsoilalbedo, & + patchout=output%patch .or. patchout%visAlbedo, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(rad%albedo(:, 1)), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Surface vis albedo") & + ] & + ), & + cable_output_variable_t( & + field_name="albedo_nir", & + netcdf_name="nirAlbedo", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%nirAlbedo, & + active=(output%radiation .or. output%nirAlbedo) .and. calcsoilalbedo, & + patchout=output%patch .or. patchout%nirAlbedo, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(rad%albedo(:, 2)), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Surface nir albedo") & + ] & + ), & + cable_output_variable_t( & + field_name="trad", & + netcdf_name="RadT", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%RadT, & + active=output%radiation .or. output%RadT, & + patchout=output%patch .or. patchout%RadT, & + restart=.true., & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(rad%trad), & + metadata=[ & + attribute("units", "K"), & + attribute("long_name", "Radiative surface temperature") & + ] & + ), & + cable_output_variable_t( & + field_name="tscrn", & + netcdf_name="Tscrn", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Tscrn, & + active=output%veg .or. output%Tscrn, & + patchout=output%patch .or. patchout%Tscrn, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%tscrn), & + metadata=[ & + attribute("units", "oC"), & + attribute("long_name", "screen level air temperature") & + ] & + ), & + cable_output_variable_t( & + field_name="tscrn_max", & + netcdf_name="Txx", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Tscrn, & + active=(output%veg .or. output%Tex) .and. any(output%averaging == ["da", "mo"]), & + patchout=output%patch .or. patchout%Tex, & + reduction_method="grid_cell_average", & + aggregation_method="max", & + aggregator=new_aggregator(canopy%tscrn), & + metadata=[ & + attribute("units", "oC"), & + attribute("long_name", "max screen-level T in reporting period") & + ] & + ), & + cable_output_variable_t( & + field_name="tscrn_min", & + netcdf_name="Tnn", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Tscrn, & + active=(output%veg .or. output%Tex) .and. any(output%averaging == ["da", "mo"]), & + patchout=output%patch .or. patchout%Tex, & + reduction_method="grid_cell_average", & + aggregation_method="min", & + aggregator=new_aggregator(canopy%tscrn), & + metadata=[ & + attribute("units", "oC"), & + attribute("long_name", "min screen-level T in reporting period") & + ] & + ), & + cable_output_variable_t( & + field_name="tscrn_max_daily", & + netcdf_name="Tmx", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + active=(output%veg .or. output%Tex) .and. output%averaging == "monthly", & + patchout=output%patch .or. patchout%Tex, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + range=ranges%Tscrn, & + accumulation_frequency="daily", & + aggregator=new_aggregator(canopy%tscrn_max_daily%aggregated_data), & + metadata=[ & + attribute("units", "oC"), & + attribute("long_name", "averaged daily maximum screen-level T") & + ] & + ), & + cable_output_variable_t( & + field_name="tscrn_min_daily", & + netcdf_name="Tmn", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + active=(output%veg .or. output%Tex) .and. output%averaging == "monthly", & + patchout=output%patch .or. patchout%Tex, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + range=ranges%Tscrn, & + accumulation_frequency="daily", & + aggregator=new_aggregator(canopy%tscrn_min_daily%aggregated_data), & + metadata=[ & + attribute("units", "oC"), & + attribute("long_name", "averaged daily minimum screen-level T") & + ] & + ), & + cable_output_variable_t( & + field_name="qscrn", & + netcdf_name="Qscrn", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Qscrn, & + active=output%veg .or. output%Qscrn, & + patchout=output%patch .or. patchout%Qscrn, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%qscrn), & + metadata=[ & + attribute("units", "kg/kg"), & + attribute("long_name", "screen level specific humidity") & + ] & + ), & + cable_output_variable_t( & + field_name="tv", & + netcdf_name="VegT", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%VegT, & + active=output%veg .or. output%VegT, & + patchout=output%patch .or. patchout%VegT, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%tv), & + metadata=[ & + attribute("units", "K"), & + attribute("long_name", "Average vegetation temperature") & + ] & + ), & + cable_output_variable_t( & + field_name="tvair", & + netcdf_name="CanT", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%CanT, & + active=output%veg .or. output%CanT, & + patchout=output%patch .or. patchout%CanT, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(met%tvair), & + metadata=[ & + attribute("units", "K"), & + attribute("long_name", "Within-canopy temperature") & + ] & + ), & + cable_output_variable_t( & + field_name="fwsoil", & + netcdf_name="Fwsoil", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Fwsoil, & + active=output%veg .or. output%Fwsoil, & + patchout=output%patch .or. patchout%Fwsoil, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%fwsoil), & + metadata=[ & + attribute("units", "[-]"), & + attribute("long_name", "soil moisture modifier to stomatal conductance") & + ] & + ), & + cable_output_variable_t( & + field_name="cansto", & + netcdf_name="CanopInt", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%CanopInt, & + active=output%veg .or. output%CanopInt, & + patchout=output%patch .or. patchout%CanopInt, & + restart=.true., & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%cansto), & + metadata=[ & + attribute("units", "kg/m^2"), & + attribute("long_name", "Canopy intercepted water storage") & + ] & + ), & + cable_output_variable_t( & + field_name="vlai", & + netcdf_name="LAI", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%LAI, & + active=output%veg .or. output%LAI, & + patchout=output%patch .or. patchout%LAI, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(veg%vlai), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Leaf area index") & + ] & + ), & + cable_output_variable_t( & + field_name="ebal_tot", & + netcdf_name="Ebal", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Ebal, & + active=output%balances .or. output%Ebal, & + patchout=output%patch .or. patchout%Ebal, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(bal%ebal_tot), & + metadata=[ & + attribute("units", "W/m^2"), & + attribute("long_name", "Cumulative energy imbalance") & + ] & + ), & + cable_output_variable_t( & + field_name="wbal_tot", & + netcdf_name="Wbal", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Wbal, & + active=output%balances .or. output%Wbal, & + patchout=output%patch .or. patchout%Wbal, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(bal%wbal_tot), & + metadata=[ & + attribute("units", "kg/m^2"), & + attribute("long_name", "Cumulative water imbalance") & + ] & + ), & + cable_output_variable_t( & + field_name="wbtot0", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + aggregator=new_aggregator(bal%wbtot0), & + metadata=[ & + attribute("units", "mm"), & + attribute("long_name", "Initial time step soil water total") & + ] & + ), & + cable_output_variable_t( & + field_name="osnowd0", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + aggregator=new_aggregator(bal%osnowd0), & + metadata=[ & + attribute("units", "mm"), & + attribute("long_name", "Initial time step snow water total") & + ] & + ), & + cable_output_variable_t( & + field_name="frday", & + netcdf_name="LeafResp", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%AutoResp, & + active=output%carbon .or. output%LeafResp, & + patchout=output%patch .or. patchout%LeafResp, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%frday), & + divide_by=c_molar_mass, & + metadata=[ & + attribute("units", "umol/m^2/s"), & + attribute("long_name", "Leaf respiration") & + ] & + ), & + cable_output_variable_t( & + field_name="frs", & + netcdf_name="HeteroResp", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%HeteroResp, & + active=output%carbon .or. output%HeteroResp, & + patchout=output%patch .or. patchout%HeteroResp, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%frs), & + divide_by=c_molar_mass, & + metadata=[ & + attribute("units", "umol/m^2/s"), & + attribute("long_name", "Heterotrophic respiration") & + ] & + ), & + cable_output_variable_t( & + field_name="fgpp", & + netcdf_name="GPP", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%GPP, & + active=output%carbon .or. output%GPP, & + patchout=output%patch .or. patchout%GPP, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%fgpp), & + divide_by=c_molar_mass, & + metadata=[ & + attribute("units", "umol/m^2/s"), & + attribute("long_name", "Gross primary production") & + ] & + ), & + cable_output_variable_t( & + field_name="fnpp", & + netcdf_name="NPP", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%NPP, & + active=output%carbon .or. output%NPP, & + patchout=output%patch .or. patchout%NPP, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%fnpp), & + divide_by=c_molar_mass, & + metadata=[ & + attribute("units", "umol/m^2/s"), & + attribute("long_name", "Net primary production") & + ] & + ), & + cable_output_variable_t( & + field_name="fra", & + netcdf_name="AutoResp", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%AutoResp, & + active=output%carbon .or. output%AutoResp, & + patchout=output%patch .or. patchout%AutoResp, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%fra), & + divide_by=c_molar_mass, & + metadata=[ & + attribute("units", "umol/m^2/s"), & + attribute("long_name", "Autotrophic respiration") & + ] & + ), & + cable_output_variable_t( & + field_name="fnee", & + netcdf_name="NEE", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%NEE, & + active=output%flux .or. output%NEE, & + patchout=output%patch .or. patchout%NEE, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(canopy%fnee), & + divide_by=c_molar_mass, & + metadata=[ & + attribute("units", "umol/m^2/s"), & + attribute("long_name", "Net ecosystem exchange of CO2") & + ] & + ), & + cable_output_variable_t( & + field_name="wtd", & + netcdf_name="WatTable", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%WatTable, & + active=(output%soil .or. output%WatTable) .and. cable_user%gw_model, & + patchout=output%patch .or. patchout%WatTable, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(ssnow%wtd), & + scale_by=1e-3, & + metadata=[ & + attribute("units", "m"), & + attribute("long_name", "Water Table Depth") & + ] & + ), & + cable_output_variable_t( & + field_name="GWwb", & + netcdf_name="GWMoist", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%GWwb, & + active=(output%soil .or. output%GWMoist) .and. cable_user%gw_model, & + patchout=output%patch .or. patchout%GWMoist, & + restart=.true., & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(ssnow%GWwb), & + metadata=[ & + attribute("units", "mm3/mm3"), & + attribute("long_name", "Aquifer moisture content") & + ] & + ), & + cable_output_variable_t( & + field_name="satfrac", & + netcdf_name="SatFrac", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%SatFrac, & + active=(output%soil .or. output%SatFrac) .and. cable_user%gw_model, & + patchout=output%patch .or. patchout%SatFrac, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(ssnow%satfrac), & + metadata=[ & + attribute("units", "unitless"), & + attribute("long_name", "Saturated fraction of grid cell") & + ] & + ), & + cable_output_variable_t( & + field_name="Qrecharge", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Qrecharge, & + active=output%soil .or. output%Qrecharge, & + patchout=output%patch .or. patchout%Qrecharge, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(ssnow%Qrecharge), & + metadata=[ & + attribute("units", "mm/s"), & + attribute("long_name", "Recharge to or from Aquifer") & + ] & + ), & + cable_output_variable_t( & + field_name="tss", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + aggregator=new_aggregator(ssnow%tss), & + metadata=[ & + attribute("units", "K"), & + attribute("long_name", "Combined soil/snow temperature") & + ] & + ), & + cable_output_variable_t( & + field_name="rtsoil", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + aggregator=new_aggregator(ssnow%rtsoil), & + metadata=[ & + attribute("units", "??"), & + attribute("long_name", "Turbulent resistance for soil") & + ] & + ), & + cable_output_variable_t( & + field_name="runoff", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + aggregator=new_aggregator(ssnow%runoff), & + metadata=[ & + attribute("units", "mm/timestep"), & + attribute("long_name", "Total runoff") & + ] & + ), & + cable_output_variable_t( & + field_name="ssdnn", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + aggregator=new_aggregator(ssnow%ssdnn), & + metadata=[ & + attribute("units", "kg/m^3"), & + attribute("long_name", "Average snow density") & + ] & + ), & + cable_output_variable_t( & + field_name="snage", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + aggregator=new_aggregator(ssnow%snage), & + metadata=[ & + attribute("units", "??"), & + attribute("long_name", "Snow age") & + ] & + ), & + cable_output_variable_t( & + field_name="osnowd", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + aggregator=new_aggregator(ssnow%osnowd), & + metadata=[ & + attribute("units", "mm"), & + attribute("long_name", "Previous time step snow depth in water equivalent") & + ] & + ), & + cable_output_variable_t( & + field_name="albsoilsn", & + data_shape=[dim_patch, dim_rad], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%albsoiln, & + active=.false., & + aggregation_method="mean", & + restart=.true., & + aggregator=new_aggregator(ssnow%albsoilsn), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Combined soil/snow albedo") & + ] & + ), & + cable_output_variable_t( & + field_name="isflag", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_INT, & + active=.false., & + restart=.true., & + aggregator=new_aggregator(ssnow%isflag), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Snow layer scheme flag") & + ] & + ), & + cable_output_variable_t( & + field_name="ghflux", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + aggregator=new_aggregator(canopy%ghflux), & + metadata=[ & + attribute("units", "W/m^2"), & + attribute("long_name", "????") & + ] & + ), & + cable_output_variable_t( & + field_name="sghflux", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + aggregator=new_aggregator(canopy%sghflux), & + metadata=[ & + attribute("units", "W/m^2"), & + attribute("long_name", "????") & + ] & + ), & + cable_output_variable_t( & + field_name="dgdtg", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + aggregator=new_aggregator(canopy%dgdtg), & + metadata=[ & + attribute("units", "W/m^2/K"), & + attribute("long_name", "Derivative of ground heat flux wrt soil temperature") & + ] & + ), & + cable_output_variable_t( & + field_name="fev", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + aggregator=new_aggregator(canopy%fev), & + metadata=[ & + attribute("units", "W/m^2"), & + attribute("long_name", "Latent heat flux from vegetation") & + ] & + ), & + cable_output_variable_t( & + field_name="fes", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + aggregator=new_aggregator(canopy%fes), & + metadata=[ & + attribute("units", "W/m^2"), & + attribute("long_name", "Latent heat flux from soil") & + ] & + ), & + cable_output_variable_t( & + field_name="albedo", & + data_shape=[dim_patch, dim_rad], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + aggregator=new_aggregator(rad%albedo), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Albedo for shortwave and NIR radiation") & + ] & + ), & + cable_output_variable_t( & + field_name="iveg", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_INT, & + range=ranges%iveg, & + active=output%params .or. output%iveg, & + patchout=output%patch .or. patchout%iveg, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + restart=.true., & + aggregator=new_aggregator(veg%iveg), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Vegetation type") & + ] & + ), & + cable_output_variable_t( & + field_name="patchfrac", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%patchfrac, & + active=(output%params .or. output%patchfrac) .and. (output%patch .or. patchout%patchfrac), & + patchout=output%patch .or. patchout%patchfrac, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + restart=.true., & + aggregator=new_aggregator(patch(:)%frac), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Fractional cover of vegetation patches") & + ] & + ), & + cable_output_variable_t( & + field_name="isoil", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_INT, & + range=ranges%isoil, & + active=output%params .or. output%isoil, & + patchout=output%patch .or. patchout%isoil, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + restart=.true., & + aggregator=new_aggregator(soil%isoilm), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Soil type") & + ] & + ), & + cable_output_variable_t( & + field_name="bch", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%bch, & + active=output%params .or. output%bch, & + patchout=output%patch .or. patchout%bch, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(soil%bch), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Parameter b, Campbell eqn 1985") & + ] & + ), & + cable_output_variable_t( & + field_name="clay", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%clay, & + active=output%params .or. output%clay, & + patchout=output%patch .or. patchout%clay, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(soil%clay), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Fraction of soil which is clay") & + ] & + ), & + cable_output_variable_t( & + field_name="sand", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%sand, & + active=output%params .or. output%sand, & + patchout=output%patch .or. patchout%sand, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(soil%sand), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Fraction of soil which is sand") & + ] & + ), & + cable_output_variable_t( & + field_name="silt", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%silt, & + active=output%params .or. output%silt, & + patchout=output%patch .or. patchout%silt, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(soil%silt), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Fraction of soil which is silt") & + ] & + ), & + cable_output_variable_t( & + field_name="ssat", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%ssat, & + active=output%params .or. output%ssat, & + patchout=output%patch .or. patchout%ssat, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(soil%ssat), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Fraction of soil volume which is water @ saturation") & + ] & + ), & + cable_output_variable_t( & + field_name="sfc", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%sfc, & + active=output%params .or. output%sfc, & + patchout=output%patch .or. patchout%sfc, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(soil%sfc), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Fraction of soil volume which is water @ field capacity") & + ] & + ), & + cable_output_variable_t( & + field_name="swilt", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%swilt, & + active=output%params .or. output%swilt, & + patchout=output%patch .or. patchout%swilt, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(soil%swilt), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Fraction of soil volume which is water @ wilting point") & + ] & + ), & + cable_output_variable_t( & + field_name="hyds", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%hyds, & + active=output%params .or. output%hyds, & + patchout=output%patch .or. patchout%hyds, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(soil%hyds), & + metadata=[ & + attribute("units", "m/s"), & + attribute("long_name", "Hydraulic conductivity @ saturation") & + ] & + ), & + cable_output_variable_t( & + field_name="sucs", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%sucs, & + active=output%params .or. output%sucs, & + patchout=output%patch .or. patchout%sucs, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(soil%sucs), & + metadata=[ & + attribute("units", "m"), & + attribute("long_name", "Suction @ saturation") & + ] & + ), & + cable_output_variable_t( & + field_name="css", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%css, & + active=output%params .or. output%css, & + patchout=output%patch .or. patchout%css, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(soil%css), & + metadata=[ & + attribute("units", "J/kg/C"), & + attribute("long_name", "Heat capacity of soil minerals") & + ] & + ), & + cable_output_variable_t( & + field_name="rhosoil", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%rhosoil, & + active=output%params .or. output%rhosoil, & + patchout=output%patch .or. patchout%rhosoil, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(soil%rhosoil), & + metadata=[ & + attribute("units", "kg/m^3"), & + attribute("long_name", "Density of soil minerals") & + ] & + ), & + cable_output_variable_t( & + field_name="rs20", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%rs20, & + active=output%params .or. output%rs20, & + patchout=output%patch .or. patchout%rs20, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%rs20), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Soil respiration coefficient at 20C") & + ] & + ), & + cable_output_variable_t( & + field_name="albsoil", & + data_shape=[dim_patch, dim_rad], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%albsoil, & + active=output%params .or. output%albsoil, & + patchout=output%patch .or. patchout%albsoil, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + restart=.true., & + aggregator=new_aggregator(soil%albsoil), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Snow free shortwave soil reflectance fraction") & + ] & + ), & + cable_output_variable_t( & + field_name="hc", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%hc, & + active=output%params .or. output%hc, & + patchout=output%patch .or. patchout%hc, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%hc), & + metadata=[ & + attribute("units", "m"), & + attribute("long_name", "Height of canopy") & + ] & + ), & + cable_output_variable_t( & + field_name="canst1", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%canst1, & + active=output%params .or. output%canst1, & + patchout=output%patch .or. patchout%canst1, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%canst1), & + metadata=[ & + attribute("units", "mm/LAI"), & + attribute("long_name", "Max water intercepted by canopy") & + ] & + ), & + cable_output_variable_t( & + field_name="dleaf", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%dleaf, & + active=output%params .or. output%dleaf, & + patchout=output%patch .or. patchout%dleaf, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%dleaf), & + metadata=[ & + attribute("units", "m"), & + attribute("long_name", "Characteristic length of leaf") & + ] & + ), & + cable_output_variable_t( & + field_name="frac4", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%frac4, & + active=output%params .or. output%frac4, & + patchout=output%patch .or. patchout%frac4, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%frac4), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Fraction of plants which are C4") & + ] & + ), & + cable_output_variable_t( & + field_name="ejmax", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%ejmax, & + active=output%params .or. output%ejmax, & + patchout=output%patch .or. patchout%ejmax, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%ejmax), & + metadata=[ & + attribute("units", "mol/m^2/s"), & + attribute("long_name", "Max potential electron transport rate top leaf") & + ] & + ), & + cable_output_variable_t( & + field_name="vcmax", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%vcmax, & + active=output%params .or. output%vcmax, & + patchout=output%patch .or. patchout%vcmax, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%vcmax), & + metadata=[ & + attribute("units", "mol/m^2/s"), & + attribute("long_name", "Maximum RuBP carboxylation rate top leaf") & + ] & + ), & + cable_output_variable_t( & + field_name="rp20", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%rp20, & + active=output%params .or. output%rp20, & + patchout=output%patch .or. patchout%rp20, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%rp20), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Plant respiration coefficient at 20C") & + ] & + ), & + cable_output_variable_t( & + field_name="g0", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%g0, & + active=output%params .or. output%g0, & + patchout=output%patch .or. patchout%g0, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%g0), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "g0 term in Medlyn Stom Cond. Param") & + ] & + ), & + cable_output_variable_t( & + field_name="g1", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%g1, & + active=output%params .or. output%g1, & + patchout=output%patch .or. patchout%g1, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%g1), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "g1 term in Medlyn Stom Cond. Param") & + ] & + ), & + cable_output_variable_t( & + field_name="rpcoef", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%rpcoef, & + active=output%params .or. output%rpcoef, & + patchout=output%patch .or. patchout%rpcoef, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%rpcoef), & + metadata=[ & + attribute("units", "1/C"), & + attribute("long_name", "Temperature coef nonleaf plant respiration") & + ] & + ), & + cable_output_variable_t( & + field_name="shelrb", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%shelrb, & + active=output%params .or. output%shelrb, & + patchout=output%patch .or. patchout%shelrb, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%shelrb), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Sheltering factor") & + ] & + ), & + cable_output_variable_t( & + field_name="xfang", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%xfang, & + active=output%params .or. output%xfang, & + patchout=output%patch .or. patchout%xfang, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%xfang), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Leaf angle parameter") & + ] & + ), & + cable_output_variable_t( & + field_name="wai", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%wai, & + active=output%params .or. output%wai, & + patchout=output%patch .or. patchout%wai, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%wai), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Wood area index") & + ] & + ), & + cable_output_variable_t( & + field_name="vegcf", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%vegcf, & + active=output%params .or. output%vegcf, & + patchout=output%patch .or. patchout%vegcf, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%vegcf), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "vegcf") & + ] & + ), & + cable_output_variable_t( & + field_name="extkn", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%extkn, & + active=output%params .or. output%extkn, & + patchout=output%patch .or. patchout%extkn, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%extkn), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Nitrogen extinction coef for vert. canopy profile") & + ] & + ), & + cable_output_variable_t( & + field_name="tminvj", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%tminvj, & + active=output%params .or. output%tminvj, & + patchout=output%patch .or. patchout%tminvj, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%tminvj), & + metadata=[ & + attribute("units", "C"), & + attribute("long_name", "Min temperature for the start of photosynthesis") & + ] & + ), & + cable_output_variable_t( & + field_name="tmaxvj", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%tmaxvj, & + active=output%params .or. output%tmaxvj, & + patchout=output%patch .or. patchout%tmaxvj, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%tmaxvj), & + metadata=[ & + attribute("units", "C"), & + attribute("long_name", "Max temperature for photosynthesis") & + ] & + ), & + cable_output_variable_t( & + field_name="vbeta", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%vbeta, & + active=output%params .or. output%vbeta, & + patchout=output%patch .or. patchout%vbeta, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%vbeta), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Stomatal sensitivity to soil water") & + ] & + ), & + cable_output_variable_t( & + field_name="xalbnir", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%xalbnir, & + active=output%params .or. output%xalbnir, & + patchout=output%patch .or. patchout%xalbnir, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%xalbnir), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Modifier for albedo in near ir band") & + ] & + ), & + cable_output_variable_t( & + field_name="meth", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%meth, & + active=output%params .or. output%meth, & + patchout=output%patch .or. patchout%meth, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%meth), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Canopy turbulence parameterisation choice") & + ] & + ), & + cable_output_variable_t( & + field_name="za_uv", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%za, & + active=output%params .or. output%za, & + patchout=output%patch .or. patchout%za, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(rough%za_uv), & + metadata=[ & + attribute("units", "m"), & + attribute("long_name", "Reference height (lowest atm. model layer) for momentum") & + ] & + ), & + cable_output_variable_t( & + field_name="za_tq", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%za, & + active=output%params .or. output%za, & + patchout=output%patch .or. patchout%za, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(rough%za_tq), & + metadata=[ & + attribute("units", "m"), & + attribute("long_name", "Reference height (lowest atm. model layer) for scalars") & + ] & + ), & + cable_output_variable_t( & + field_name="ratecp", & + data_shape=[dim_plant_carbon], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%ratecp, & + active=output%params .or. output%ratecp, & + distributed=.false., & + parameter=.true., & + aggregator=new_aggregator(bgc%ratecp), & + metadata=[ & + attribute("units", "1/year"), & + attribute("long_name", "Plant carbon rate constant") & + ] & + ), & + cable_output_variable_t( & + field_name="ratecs", & + data_shape=[dim_soil_carbon], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%ratecs, & + active=output%params .or. output%ratecs, & + distributed=.false., & + parameter=.true., & + aggregator=new_aggregator(bgc%ratecs), & + metadata=[ & + attribute("units", "1/year"), & + attribute("long_name", "Soil carbon rate constant") & + ] & + ), & + cable_output_variable_t( & + field_name="cplant", & + data_shape=[dim_patch, dim_plant_carbon], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + aggregator=new_aggregator(bgc%cplant), & + metadata=[ & + attribute("units", "gC/m^2"), & + attribute("long_name", "Plant carbon stores") & + ] & + ), & + cable_output_variable_t( & + field_name="csoil", & + data_shape=[dim_patch, dim_soil_carbon], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + aggregator=new_aggregator(bgc%csoil), & + metadata=[ & + attribute("units", "gC/m^2"), & + attribute("long_name", "Soil carbon stores") & + ] & + ), & + cable_output_variable_t( & + field_name="zse", & + data_shape=[dim_soil], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%zse, & + active=output%params .or. output%zse, & + distributed=.false., & + parameter=.true., & + restart=.true., & + aggregator=new_aggregator(soil%zse), & + metadata=[ & + attribute("units", "m"), & + attribute("long_name", "Depth of each soil layer") & + ] & + ), & + cable_output_variable_t( & + field_name="froot", & + data_shape=[dim_patch, dim_soil], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%froot, & + active=output%params .or. output%froot, & + patchout=output%patch .or. patchout%froot, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(veg%froot), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Fraction of roots in each soil layer") & + ] & + ), & + cable_output_variable_t( & + field_name="slope", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%slope, & + active=.false., & + patchout=output%patch .or. patchout%slope, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(soil%slope), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Mean subgrid topographic slope") & + ] & + ), & + cable_output_variable_t( & + field_name="slope_std", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%slope_std, & + active=.false., & + patchout=output%patch .or. patchout%slope_std, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(soil%slope_std), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Mean subgrid topographic slope_std") & + ] & + ), & + cable_output_variable_t( & + field_name="GWdz", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%GWdz, & + active=output%params .AND. cable_user%gw_model, & + patchout=output%patch .OR. patchout%GWdz, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(soil%GWdz), & + metadata=[ & + attribute("units", "m"), & + attribute("long_name", "Mean aquifer layer thickness") & + ] & + ), & + cable_output_variable_t( & + field_name="MaxHorzDrainRate", & + netcdf_name="Qhmax", & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%gw_default, & + active=output%params .AND. cable_user%gw_model, & + patchout=output%patch .OR. patchout%Qhmax, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(gw_params%MaxHorzDrainRate), & + metadata=[ & + attribute("units", "mm/s"), & + attribute("long_name", "Maximum subsurface drainage") & + ] & + ), & + cable_output_variable_t( & + field_name="EfoldHorzDrainRate", & + netcdf_name="QhmaxEfold", & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%gw_default, & + active=output%params .AND. cable_user%gw_model, & + patchout=output%patch .OR. patchout%QhmaxEfold, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(gw_params%EfoldHorzDrainRate), & + metadata=[ & + attribute("units", "m"), & + attribute("long_name", "Maximum subsurface drainage decay rate") & + ] & + ), & + cable_output_variable_t( & + field_name="MaxSatFraction", & + netcdf_name="SatFracmax", & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%gw_default, & + active=output%params .AND. cable_user%gw_model, & + patchout=output%patch .OR. patchout%SatFracmax, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(gw_params%MaxSatFraction), & + metadata=[ & + attribute("units", "-"), & + attribute("long_name", "Controls max saturated fraction") & + ] & + ), & + cable_output_variable_t( & + field_name="hkrz", & + netcdf_name="HKefold", & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%gw_default, & + active=output%params .AND. cable_user%gw_model, & + patchout=output%patch .OR. patchout%HKefold, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(gw_params%hkrz), & + metadata=[ & + attribute("units", "1/m"), & + attribute("long_name", "Rate HK decays with depth") & + ] & + ), & + cable_output_variable_t( & + field_name="zdepth", & + netcdf_name="HKdepth", & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%gw_default, & + active=output%params .AND. cable_user%gw_model, & + patchout=output%patch .OR. patchout%HKdepth, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + parameter=.true., & + aggregator=new_aggregator(gw_params%zdepth), & + metadata=[ & + attribute("units", "m"), & + attribute("long_name", "Depth at which HKsat(z) is HKsat(0)") & + ] & + ), & + cable_output_variable_t( & + field_name="nap", & + data_shape=[dim_land_global], & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + distributed=.false., & + aggregation_method="point", & + aggregator=new_aggregator(landpt_global(:)%nap), & + metadata=[ & + attribute("units", ""), & + attribute("long_name", "") & + ] & + ), & + cable_output_variable_t( & + field_name="mvtype", & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + distributed=.false., & + aggregation_method="point", & + aggregator=new_aggregator(mvtype), & + metadata=[ & + attribute("units", ""), & + attribute("long_name", "Number of vegetation types") & + ] & + ), & + cable_output_variable_t( & + field_name="mstype", & + var_type=CABLE_NETCDF_FLOAT, & + active=.false., & + restart=.true., & + distributed=.false., & + aggregation_method="point", & + aggregator=new_aggregator(mstype), & + metadata=[ & + attribute("units", ""), & + attribute("long_name", "Number of soil types") & + ] & + ) & + ] + + end function cable_diagnostics + +end module diff --git a/src/offline/cable_diagnostics_casa.F90 b/src/offline/cable_diagnostics_casa.F90 new file mode 100644 index 000000000..878ee4d9a --- /dev/null +++ b/src/offline/cable_diagnostics_casa.F90 @@ -0,0 +1,497 @@ +module cable_diagnostics_casa_mod + use casavariable, only: casa_flux + use casavariable, only: casa_pool + use casavariable, only: casa_met + + use casaparm, only: LEAF + use casaparm, only: WOOD + use casaparm, only: FROOT + + use casaparm, only: MIC + use casaparm, only: SLOW + use casaparm, only: PASS + + use casaparm, only: METB + use casaparm, only: STR + use casaparm, only: CWD + + use cable_timing_mod, only: seconds_per_day + + use cable_phys_constants_mod, only: c_molar_mass + + use cable_common_module, only: l_casacnp + + use cable_common_module, only: cable_user + + use cable_io_vars_module, only: output, patchout + + use cable_output_mod, only: cable_output_variable_t + use cable_output_mod, only: cable_output_dim_t + use cable_output_mod, only: attribute => cable_output_attribute_t + use cable_output_mod, only: cable_output_get_dimension + + use cable_netcdf_mod, only: CABLE_NETCDF_FLOAT + + use aggregator_mod, only: new_aggregator + + use cable_checks_module, only: ranges + + implicit none + private + + public :: cable_diagnostics_casa + +contains + + function cable_diagnostics_casa(casaflux, casapool, casamet) result(casa_output_variables) + type(casa_flux), intent(in) :: casaflux + type(casa_pool), intent(in) :: casapool + type(casa_met), intent(in) :: casamet + type(cable_output_variable_t), allocatable :: casa_output_variables(:) + + type(cable_output_dim_t) :: dim_patch + + if (.not. l_casacnp) then + allocate(casa_output_variables(0)) + return + end if + + dim_patch = cable_output_get_dimension("patch") + + ! TODO(Sean): Currently the accumulation frequency for the following CASA + ! outputs is set to time step accumulation (default) to restore bitwise + ! reproducibility with the previous output module. These variables should + ! ideally be accumulated at daily frequency to match the frequency at which + ! CASA is executed in CABLE. + + casa_output_variables = [ & + cable_output_variable_t( & + field_name="crmplant_froot", & + netcdf_name="RootResp", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%AutoResp, & + active=output%carbon .or. output%casa, & + patchout=output%patch .or. patchout%casa, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casaflux%crmplant(:, FROOT)), & + divide_by=(seconds_per_day * c_molar_mass), & + metadata=[ & + attribute("units", "umol/m^2/s"), & + attribute("long_name", "Fine Root Autotrophic respiration") & + ] & + ), & + cable_output_variable_t( & + field_name="crmplant_wood", & + netcdf_name="StemResp", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%AutoResp, & + active=output%carbon .or. output%casa, & + patchout=output%patch .or. patchout%casa, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casaflux%crmplant(:, WOOD)), & + divide_by=(seconds_per_day * c_molar_mass), & + metadata=[ & + attribute("units", "umol/m^2/s"), & + attribute("long_name", "StemWood Autotrophic respiration") & + ] & + ), & + cable_output_variable_t( & + field_name="cnbp", & + netcdf_name="NBP", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%NEE, & + active=output%casa .or. output%NBP, & + patchout=output%patch .or. patchout%NBP, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casaflux%cnbp), & + divide_by=(seconds_per_day * c_molar_mass), & + metadata=[ & + attribute("units", "umol/m^2/s"), & + attribute("long_name", "Net Biosphere Production (uptake +ve)") & + ] & + ), & + cable_output_variable_t( & + field_name="dCdt", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%NEE, & + active=output%casa .or. output%dCdt, & + patchout=output%patch .or. patchout%dCdt, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casapool%dCdt), & + divide_by=(seconds_per_day * c_molar_mass), & + metadata=[ & + attribute("units", "umol/m^2/s"), & + attribute("long_name", "Carbon accumulation rate (uptake +ve)") & + ] & + ), & + cable_output_variable_t( & + field_name="csoiltot", & + netcdf_name="TotSoilCarb", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%TotSoilCarb, & + active=output%casa .or. output%TotSoilCarb, & + patchout=output%patch .or. patchout%TotSoilCarb, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casapool%csoiltot), & + divide_by=1e3, & + metadata=[ & + attribute("units", "kg C/m^2"), & + attribute("long_name", "Total Soil and Litter Carbon") & + ] & + ), & + cable_output_variable_t( & + field_name="clittertot", & + netcdf_name="TotLittCarb", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%TotLittCarb, & + active=output%casa .or. output%TotLittCarb, & + patchout=output%patch .or. patchout%TotLittCarb, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casapool%clittertot), & + divide_by=1e3, & + metadata=[ & + attribute("units", "kg C/m^2"), & + attribute("long_name", "Total Litter Carbon") & + ] & + ), & + cable_output_variable_t( & + field_name="csoil_mic", & + netcdf_name="SoilCarbFast", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%TotLittCarb, & + active=output%casa .or. output%SoilCarbFast, & + patchout=output%patch .or. patchout%SoilCarbFast, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casapool%csoil(:, MIC)), & + divide_by=1e3, & + metadata=[ & + attribute("units", "kg C/m^2"), & + attribute("long_name", "Soil Carbon: Fast Turnover") & + ] & + ), & + cable_output_variable_t( & + field_name="csoil_slow", & + netcdf_name="SoilCarbSlow", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%TotSoilCarb, & + active=output%casa .or. output%SoilCarbSlow, & + patchout=output%patch .or. patchout%SoilCarbSlow, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casapool%csoil(:, SLOW)), & + divide_by=1e3, & + metadata=[ & + attribute("units", "kg C/m^2"), & + attribute("long_name", "Soil Carbon: Slow Turnover") & + ] & + ), & + cable_output_variable_t( & + field_name="csoil_pass", & + netcdf_name="SoilCarbPassive", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%TotSoilCarb, & + active=output%casa .or. output%SoilCarbPassive, & + patchout=output%patch .or. patchout%SoilCarbPassive, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casapool%csoil(:, PASS)), & + divide_by=1e3, & + metadata=[ & + attribute("units", "kg C/m^2"), & + attribute("long_name", "Soil Carbon: Passive") & + ] & + ), & + cable_output_variable_t( & + field_name="clitter_metb", & + netcdf_name="LittCarbMetabolic", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%TotLittCarb, & + active=output%casa .or. output%LittCarbMetabolic, & + patchout=output%patch .or. patchout%LittCarbMetabolic, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casapool%clitter(:, METB)), & + divide_by=1e3, & + metadata=[ & + attribute("units", "kg C/m^2"), & + attribute("long_name", "Litter Carbon: metabolic") & + ] & + ), & + cable_output_variable_t( & + field_name="clitter_str", & + netcdf_name="LittCarbStructural", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%TotLittCarb, & + active=output%casa .or. output%LittCarbStructural, & + patchout=output%patch .or. patchout%LittCarbStructural, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casapool%clitter(:, STR)), & + divide_by=1e3, & + metadata=[ & + attribute("units", "kg C/m^2"), & + attribute("long_name", "Litter Carbon: structural") & + ] & + ), & + cable_output_variable_t( & + field_name="clitter_cwd", & + netcdf_name="LittCarbCWD", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%TotLittCarb, & + active=output%casa .or. output%LittCarbCWD, & + patchout=output%patch .or. patchout%LittCarbCWD, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casapool%clitter(:, CWD)), & + divide_by=1e3, & + metadata=[ & + attribute("units", "kg C/m^2"), & + attribute("long_name", "Litter Carbon: CWD") & + ] & + ), & + cable_output_variable_t( & + field_name="cplant_leaf", & + netcdf_name="PlantCarbLeaf", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%TotLittCarb, & + active=output%casa .or. output%PlantCarbLeaf, & + patchout=output%patch .or. patchout%PlantCarbLeaf, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casapool%cplant(:, LEAF)), & + divide_by=1e3, & + metadata=[ & + attribute("units", "kg C/m^2"), & + attribute("long_name", "Plant Carbon: leaf") & + ] & + ), & + cable_output_variable_t( & + field_name="cplant_wood", & + netcdf_name="PlantCarbWood", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%TotLittCarb, & + active=output%casa .or. output%PlantCarbWood, & + patchout=output%patch .or. patchout%PlantCarbWood, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casapool%cplant(:, WOOD)), & + divide_by=1e3, & + metadata=[ & + attribute("units", "kg C/m^2"), & + attribute("long_name", "Plant Carbon: wood (above- and below-ground)") & + ] & + ), & + cable_output_variable_t( & + field_name="cplant_froot", & + netcdf_name="PlantCarbFineRoot", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%TotLittCarb, & + active=output%casa .or. output%PlantCarbFineRoot, & + patchout=output%patch .or. patchout%PlantCarbFineRoot, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casapool%cplant(:, FROOT)), & + divide_by=1e3, & + metadata=[ & + attribute("units", "kg C/m^2"), & + attribute("long_name", "Plant Carbon: Fine roots") & + ] & + ), & + cable_output_variable_t( & + field_name="cplanttot", & + netcdf_name="TotLivBiomass", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%TotLivBiomass, & + active=output%casa .or. output%TotLivBiomass, & + patchout=output%patch .or. patchout%TotLivBiomass, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casapool%cplanttot), & + divide_by=1e3, & + metadata=[ & + attribute("units", "kg C/m^2"), & + attribute("long_name", "Total Biomass") & + ] & + ), & + cable_output_variable_t( & + field_name="cplant_turnover_tot", & + netcdf_name="PlantTurnover", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%NEE, & + active=output%casa .or. output%PlantTurnover, & + patchout=output%patch .or. patchout%PlantTurnover, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casaflux%cplant_turnover_tot), & + divide_by=(seconds_per_day * c_molar_mass), & + metadata=[ & + attribute("units", "umol/m^2/s"), & + attribute("long_name", "Total Biomass Turnover") & + ] & + ), & + cable_output_variable_t( & + field_name="Cplant_turnover_leaf", & + netcdf_name="PlantTurnoverLeaf", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%NEE, & + active=output%casa .or. output%PlantTurnoverLeaf, & + patchout=output%patch .or. patchout%PlantTurnoverLeaf, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casaflux%Cplant_turnover(:, LEAF)), & + divide_by=(seconds_per_day * c_molar_mass), & + metadata=[ & + attribute("units", "umol/m^2/s"), & + attribute("long_name", "Leaf Biomass Turnover") & + ] & + ), & + cable_output_variable_t( & + field_name="Cplant_turnover_wood", & + netcdf_name="PlantTurnoverWood", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%NEE, & + active=output%casa .or. output%PlantTurnoverWood, & + patchout=output%patch .or. patchout%PlantTurnoverWood, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casaflux%Cplant_turnover(:, WOOD)), & + divide_by=(seconds_per_day * c_molar_mass), & + metadata=[ & + attribute("units", "umol/m^2/s"), & + attribute("long_name", "Woody Biomass Turnover") & + ] & + ), & + cable_output_variable_t( & + field_name="Cplant_turnover_froot", & + netcdf_name="PlantTurnoverFineRoot", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%NEE, & + active=output%casa .or. output%PlantTurnoverFineRoot, & + patchout=output%patch .or. patchout%PlantTurnoverFineRoot, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casaflux%Cplant_turnover(:, FROOT)), & + divide_by=(seconds_per_day * c_molar_mass), & + metadata=[ & + attribute("units", "umol/m^2/s"), & + attribute("long_name", "FineRoot Biomass Turnover") & + ] & + ), & + cable_output_variable_t( & + field_name="Cplant_turnover_disturbance", & + netcdf_name="PlantTurnoverWoodDist", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%NEE, & + active=output%casa .or. output%PlantTurnoverWoodDist, & + patchout=output%patch .or. patchout%PlantTurnoverWoodDist, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casaflux%Cplant_turnover_disturbance), & + divide_by=(seconds_per_day * c_molar_mass), & + metadata=[ & + attribute("units", "umol/m^2/s"), & + attribute("long_name", "Woody Biomass Turnover (disturbance)") & + ] & + ), & + cable_output_variable_t( & + field_name="Cplant_turnover_crowding", & + netcdf_name="PlantTurnoverWoodCrowding", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%NEE, & + active=output%casa .or. output%PlantTurnoverWoodCrowding, & + patchout=output%patch .or. patchout%PlantTurnoverWoodCrowding, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casaflux%Cplant_turnover_crowding), & + divide_by=(seconds_per_day * c_molar_mass), & + metadata=[ & + attribute("units", "umol/m^2/s"), & + attribute("long_name", "Woody Biomass Turnover (crowding)") & + ] & + ), & + cable_output_variable_t( & + field_name="Cplant_turnover_resource_limitation", & + netcdf_name="PlantTurnoverWoodResourceLim", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%NEE, & + active=output%casa .or. output%PlantTurnoverWoodResourceLim, & + patchout=output%patch .or. patchout%PlantTurnoverWoodResourceLim, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casaflux%Cplant_turnover_resource_limitation), & + divide_by=(seconds_per_day * c_molar_mass), & + metadata=[ & + attribute("units", "umol/m^2/s"), & + attribute("long_name", "Woody Biomass Turnover (Resource Limitation)") & + ] & + ), & + cable_output_variable_t( & + field_name="areacell", & + netcdf_name="Area", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%Area, & + parameter=.true., & + active=output%casa .or. output%Area, & + patchout=output%patch .or. patchout%Area, & + reduction_method="first_patch_in_grid_cell", & + aggregation_method="point", & + aggregator=new_aggregator(casamet%areacell), & + divide_by=1e6, & + metadata=[ & + attribute("units", "km2"), & + attribute("long_name", "Patch Area") & + ] & + ), & + cable_output_variable_t( & + field_name="FluxCtoLUC", & + netcdf_name="LandUseFlux", & + data_shape=[dim_patch], & + var_type=CABLE_NETCDF_FLOAT, & + range=ranges%NEE, & + active=cable_user%POPLUC .or. output%LandUseFlux, & + patchout=output%patch .or. patchout%LandUseFlux, & + reduction_method="grid_cell_average", & + aggregation_method="mean", & + aggregator=new_aggregator(casaflux%FluxCtoLUC), & + divide_by=(seconds_per_day * c_molar_mass), & + metadata=[ & + attribute("units", "umol/m^2/s"), & + attribute("long_name", "Sum of wood harvest and clearing fluxes") & + ] & + ) & + ] + + end function cable_diagnostics_casa + +end module diff --git a/src/offline/cable_driver_common.F90 b/src/offline/cable_driver_common.F90 index 6e58c36bc..a624621dc 100644 --- a/src/offline/cable_driver_common.F90 +++ b/src/offline/cable_driver_common.F90 @@ -31,7 +31,6 @@ MODULE cable_driver_common_mod ncciy, & gswpfile, & globalMetfile, & - set_group_output_values, & timeunits, & exists, & calendar @@ -155,12 +154,6 @@ SUBROUTINE cable_driver_init(mpi_grp, NRRRR) CALL GETARG(2, casafile%cnpipool) END IF - ! Initialise flags to output individual variables according to group - ! options from the namelist file - IF (mpi_grp%rank == 0) THEN - CALL set_group_output_values() - END IF - IF (TRIM(cable_user%POPLUC_RunType) == 'static') THEN cable_user%POPLUC= .FALSE. END IF diff --git a/src/offline/cable_iovars.F90 b/src/offline/cable_iovars.F90 index 80d87cf3a..a20066b13 100644 --- a/src/offline/cable_iovars.F90 +++ b/src/offline/cable_iovars.F90 @@ -442,138 +442,6 @@ MODULE cable_IO_vars_module ! For threading: !$OMP THREADPRIVATE(landpt,patch) CONTAINS - SUBROUTINE set_group_output_values - - !*#Purpose: - ! Set individual variables to output according to the values of the group options from the namelist entries in `output%`. - IF (output%params) THEN - output%iveg = .TRUE. - output%patchfrac = .TRUE. - output%isoil = .TRUE. - output%bch = .TRUE. - output%clay = .TRUE. - output%sand = .TRUE. - output%silt = .TRUE. - output%css = .TRUE. - output%rhosoil = .TRUE. - output%hyds = .TRUE. - output%sucs = .TRUE. - output%rs20 = .TRUE. - output%ssat = .TRUE. - output%sfc = .TRUE. - output%swilt = .TRUE. - output%albsoil = .TRUE. - output%canst1 = .TRUE. - output%dleaf = .TRUE. - output%ejmax = .TRUE. - output%vcmax = .TRUE. - output%frac4 = .TRUE. - output%hc = .TRUE. - output%rp20 = .TRUE. - output%g0 = .TRUE. - output%g1 = .TRUE. - output%rpcoef = .TRUE. - output%shelrb = .TRUE. - output%xfang = .TRUE. - output%wai = .TRUE. - output%vegcf = .TRUE. - output%extkn = .TRUE. - output%tminvj = .TRUE. - output%tmaxvj = .TRUE. - output%vbeta = .TRUE. - output%xalbnir = .TRUE. - output%meth = .TRUE. - output%za = .TRUE. - output%ratecp = .TRUE. - output%ratecs = .TRUE. - output%froot = .TRUE. - output%zse = .TRUE. - output%slope = .TRUE. - output%slope_std = .TRUE. - output%GWdz = .TRUE. - END IF - - IF (output%met) THEN - output%Swdown = .TRUE. - output%Lwdown = .TRUE. - output%Rainf = .TRUE. - output%Snowf = .TRUE. - output%PSurf = .TRUE. - output%Tair = .TRUE. - output%Qair = .TRUE. - output%Wind = .TRUE. - output%CO2air = .TRUE. - END IF - - IF (output%flux) THEN - output%Qmom = .TRUE. - output%Qh = .TRUE. - output%Qle = .TRUE. - output%Qg = .TRUE. - output%Qs = .TRUE. - output%Qsb = .TRUE. - output%Evap = .TRUE. - output%ECanop = .TRUE. - output%PotEvap = .TRUE. - output%TVeg = .TRUE. - output%ESoil = .TRUE. - output%HVeg = .TRUE. - output%HSoil = .TRUE. - output%RNetSoil = .TRUE. - output%NEE = .TRUE. - END IF - - IF (output%soil) THEN - output%SoilMoist = .TRUE. - output%SoilTemp = .TRUE. - output%BaresoilT = .TRUE. - output%WatTable = .TRUE. - output%GWMoist = .TRUE. - output%SatFrac = .TRUE. - output%Qrecharge = .TRUE. - END IF - - IF (output%snow) THEN - output%SWE = .TRUE. - output%SnowT = .TRUE. - output%SnowDepth = .TRUE. - END IF - - IF (output%radiation) THEN - output%Swnet = .TRUE. - output%Lwnet = .TRUE. - output%Rnet = .TRUE. - output%Albedo = .TRUE. - output%RadT = .TRUE. - END IF - - IF (output%veg) THEN - output%Tscrn = .TRUE. - output%Tex = .TRUE. - output%Qscrn = .TRUE. - output%VegT = .TRUE. - output%CanT = .TRUE. - output%Fwsoil = .TRUE. - output%CanopInt = .TRUE. - output%LAI = .TRUE. - END IF - - IF (output%balances) THEN - output%Ebal = .TRUE. - output%Wbal = .TRUE. - END IF - - IF (output%carbon) THEN - output%GPP = .TRUE. - output%NPP = .TRUE. - output%NBP = .TRUE. - output%NEE = .TRUE. - output%AutoResp = .TRUE. - output%LeafResp = .TRUE. - output%HeteroResp = .TRUE. - END IF - - END SUBROUTINE set_group_output_values FUNCTION to_land_index_global(land_index_local) RESULT(land_index_global) !! Translate local land index on current MPI rank to global land index diff --git a/src/offline/cable_mpicommon.F90 b/src/offline/cable_mpicommon.F90 index 05e0c1ba4..a2ce51a2a 100644 --- a/src/offline/cable_mpicommon.F90 +++ b/src/offline/cable_mpicommon.F90 @@ -29,7 +29,7 @@ MODULE cable_mpicommon ! base number of input fields: must correspond to CALLS to ! MPI_address (field ) in *_mpimaster/ *_mpiworker - INTEGER, PARAMETER :: nparam = 347 + INTEGER, PARAMETER :: nparam = 349 ! MPI: extra params sent only if nsoilparmnew is true INTEGER, PARAMETER :: nsoilnew = 1 @@ -94,7 +94,7 @@ MODULE cable_mpicommon ! vh sli nvec + 6 162 -> 168 ! INTEGER, PARAMETER :: nvec = 172! 168 ! INH REV_CORR +3 (SSEB +2 will be needed) - INTEGER, PARAMETER :: nvec = 183 + INTEGER, PARAMETER :: nvec = 185 ! MPI: number of final casa result matrices and vectors to receive ! by the master for casa_poolout and casa_fluxout diff --git a/src/offline/cable_mpimaster.F90 b/src/offline/cable_mpimaster.F90 index 3bb2b33ea..dbe1c26dd 100644 --- a/src/offline/cable_mpimaster.F90 +++ b/src/offline/cable_mpimaster.F90 @@ -38,14 +38,10 @@ ! CALLs: point2constants ! open_met_file ! load_parameters -! open_output_file ! get_met_data -! write_output ! casa_poolout ! casa_fluxout -! create_restart ! close_met_file -! close_output_file ! prepareFiles ! find_extents ! master_decomp @@ -92,8 +88,20 @@ MODULE cable_mpimaster USE cable_IO_vars_module, ONLY : NO_CHECK USE casa_cable USE casa_inout_module - USE cable_checks_module, ONLY: constant_check_range + USE cable_checks_module, ONLY: constant_check_range, mass_balance, energy_balance USE cable_mpi_mod, ONLY: mpi_grp_t + USE cable_timing_mod, ONLY: cable_timing_set_start_year + use cable_output_mod, only: cable_output_mod_init + use cable_output_mod, only: cable_output_mod_end + use cable_output_mod, only: cable_output_register_output_variables + use cable_output_mod, only: cable_output_init_streams + use cable_output_mod, only: cable_output_update + use cable_output_mod, only: cable_output_write + use cable_output_mod, only: cable_output_write_parameters + use cable_output_mod, only: cable_output_write_restart + use cable_diagnostics_mod, only: cable_diagnostics + use cable_diagnostics_casa_mod, only: cable_diagnostics_casa + use cable_netcdf_mod, only: cable_netcdf_mod_init, cable_netcdf_mod_end IMPLICIT NONE @@ -175,7 +183,7 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU, mpi_grp_master) output,check,& patch_type,landpt,& timeunits, output, & - calendar + calendar, verbose, patch USE cable_common_module, ONLY: ktau_gl, kend_gl, knode_gl, cable_user, & cable_runtime, fileName, & CurYear, & @@ -190,9 +198,6 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU, mpi_grp_master) USE cable_phys_constants_mod, ONLY : CSBOLTZ => SBOLTZ USE cable_input_module, ONLY: open_met_file,load_parameters, & get_met_data,close_met_file - USE cable_output_module, ONLY: create_restart,open_output_file, & - write_output,close_output_file - USE cable_write_module, ONLY: nullify_write USE cable_cbm_module USE cable_climate_mod @@ -319,7 +324,7 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU, mpi_grp_master) INTEGER :: count_bal = 0 INTEGER :: nkend=0 - INTEGER :: kk,m,np,ivt + INTEGER :: i,kk,m,np,ivt INTEGER, PARAMETER :: mloop = 30 ! CASA-CNP PreSpinup loops REAL :: etime @@ -333,7 +338,9 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU, mpi_grp_master) integer, dimension(:), allocatable, save :: cstart,cend,nap real(r_2), dimension(:,:,:), allocatable, save :: patchfrac_new + call cable_netcdf_mod_init(mpi_grp_master) + call cable_timing_set_start_year(cable_user%YearStart) ! END header @@ -427,6 +434,7 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU, mpi_grp_master) IF (CABLE_USER%POPLUC .AND. TRIM(CABLE_USER%POPLUC_RunType) .EQ. 'static') & CABLE_USER%POPLUC= .FALSE. + ! Open output file: IF (.NOT.CASAONLY) THEN IF ( TRIM(filename%out) .EQ. '' ) THEN @@ -441,8 +449,13 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU, mpi_grp_master) TRIM(cable_user%RunIden)//'_cable_out.nc' ENDIF ENDIF - CALL nullify_write() ! nullify pointers - CALL open_output_file( dels, soil, veg, bgc, rough, met, casamet) + call cable_output_mod_init() + call cable_output_register_output_variables([ & + cable_diagnostics(met, canopy, soil, ssnow, rad, veg, bal, rough, bgc, dels=dels), & + cable_diagnostics_casa(casaflux, casapool, casamet) & + ]) + call cable_output_init_streams(dels) + call cable_output_write_parameters(kstart, patch, landpt) ENDIF ssnow%otss_0 = ssnow%tgg(:,1) @@ -842,8 +855,6 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU, mpi_grp_master) ! Write time step's output to file if either: we're not spinning up ! or we're spinning up and the spinup has converged: - ! MPI: TODO: pull mass and energy balance calculation from write_output - ! and refactor into worker code ktau_gl = oktau @@ -864,14 +875,19 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU, mpi_grp_master) IF ( (.NOT. CASAONLY).AND. spinConv ) THEN + IF(check%mass_bal) CALL mass_balance(dels, ktau, ssnow, soil, canopy, & + met,air,bal) + + IF(check%energy_bal) CALL energy_balance(dels, ktau, met, rad, canopy, & + bal,ssnow, CSBOLTZ, CEMLEAF, CEMSOIL ) + SELECT CASE (TRIM(cable_user%MetType)) CASE ('plum', 'cru', 'gswp', 'gswp3', 'prin') - CALL write_output( dels, ktau_tot, met, canopy, casaflux, casapool, & - ssnow, rad, bal, air, soil, veg, CSBOLTZ, CEMLEAF, CEMSOIL ) + call cable_output_update(ktau_tot, dels, met) + call cable_output_write(ktau_tot, dels, met, patch, landpt) CASE DEFAULT - CALL write_output( dels, ktau, met, canopy, casaflux, casapool, & - ssnow, rad, bal, air, soil, veg, CSBOLTZ, CEMLEAF, CEMSOIL ) - + call cable_output_update(ktau, dels, met) + call cable_output_write(ktau, dels, met, patch, landpt) END SELECT END IF ENDIF @@ -1064,14 +1080,20 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU, mpi_grp_master) ENDIF IF ( (.NOT. CASAONLY) .AND. spinConv ) THEN + + IF(check%mass_bal) CALL mass_balance(dels, ktau, ssnow, soil, canopy, & + met,air,bal) + + IF(check%energy_bal) CALL energy_balance(dels, ktau, met, rad, canopy, & + bal,ssnow, CSBOLTZ, CEMLEAF, CEMSOIL ) + SELECT CASE (TRIM(cable_user%MetType)) CASE ('plum', 'cru', 'gswp', 'gswp3') - CALL write_output( dels, ktau_tot, met, canopy, casaflux, casapool, & - ssnow, rad, bal, air, soil, veg, CSBOLTZ, CEMLEAF, CEMSOIL ) + call cable_output_update(ktau_tot, dels, met) + call cable_output_write(ktau_tot, dels, met, patch, landpt) CASE DEFAULT - CALL write_output( dels, ktau, met, canopy, casaflux, casapool, & - ssnow, rad, bal, air, soil, veg, CSBOLTZ, CEMLEAF, CEMSOIL ) - + call cable_output_update(ktau, dels, met) + call cable_output_write(ktau, dels, met, patch, landpt) END SELECT END IF @@ -1218,10 +1240,25 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU, mpi_grp_master) END DO SPINLOOP IF ( SpinConv .AND. .NOT. CASAONLY) THEN - ! Close output file and deallocate main variables: - CALL close_output_file( bal, air, bgc, canopy, met, & - rad, rough, soil, ssnow, & - sum_flux, veg ) + ! Report balance info to log file if verbose writing is requested: + IF(output%balances .AND. verbose) THEN + WRITE(logn, *) + DO i = 1, mland + WRITE(logn, '(A51,I7,1X,A11,E12.4,A6)') & + ' Cumulative energy balance for each patch in site #', & + i,'is (W/m^2):' + WRITE(logn, *) & + bal%ebal_tot(landpt(i)%cstart:landpt(i)%cstart + & + landpt(i)%nap - 1) + WRITE(logn,'(A50,I7,1X,A8,E12.4,A3)') & + ' Cumulative water balance for each patch in site #', & + i,'is (mm):' + WRITE(logn, *) & + bal%wbal_tot(landpt(i)%cstart:landpt(i)%cstart + & + landpt(i)%nap - 1) + WRITE(logn, *) + END DO + END IF ENDIF IF (icycle > 0 .AND. (.NOT.spincasa).AND. (.NOT.casaonly)) THEN @@ -1260,8 +1297,6 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU, mpi_grp_master) ! Write restart file if requested: IF(output%restart .AND. (.NOT. CASAONLY)) THEN - ! MPI: TODO: receive variables that are required by create_restart - ! but not write_output !CALL receive_restart (comm,ktau,dels,soil,veg,ssnow, & ! & canopy,rough,rad,bgc,bal) ! gol124: how about call master_receive (comm, ktau, restart_ts) @@ -1271,8 +1306,7 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU, mpi_grp_master) ! CALL MPI_Waitall (wnp, recv_req, recv_stats, ierr) if(.not.l_landuse) then - CALL create_restart( logn, dels, ktau, soil, veg, ssnow, & - canopy, rough, rad, bgc, bal, met ) + call cable_output_write_restart(current_time=ktau * dels) endif IF (cable_user%CALL_climate) THEN @@ -1336,7 +1370,9 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU, mpi_grp_master) call landuse_deallocate_mp(cend(mland),ms,msn,nrb,mplant,mlitter,msoil,mwood,lucmp) ENDIF + if (.not. casaonly) call cable_output_mod_end() + call cable_netcdf_mod_end() ! Close met data input file: IF ( TRIM(cable_user%MetType) .NE. "gswp" .AND. & @@ -2532,6 +2568,14 @@ SUBROUTINE master_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& CALL MPI_Get_address (canopy%wcint(off), displs(bidx), ierr) blen(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (canopy%tscrn_max_daily%aggregated_data(off), displs(bidx), ierr) + blen(bidx) = r1len + + bidx = bidx + 1 + CALL MPI_Get_address (canopy%tscrn_min_daily%aggregated_data(off), displs(bidx), ierr) + blen(bidx) = r1len + ! bidx = bidx + 1 ! CALL MPI_Get_address (canopy%rwater(off,1), displs(bidx), ierr) ! CALL MPI_Type_create_hvector (ms, r1len, r1stride, MPI_BYTE, & @@ -5449,6 +5493,14 @@ SUBROUTINE master_outtypes (comm,met,canopy,ssnow,rad,bal,air,soil,veg) CALL MPI_Get_address (canopy%wcint(off), vaddr(vidx), ierr) ! 59 blen(vidx) = cnt * extr1 vidx = vidx + 1 + ! REAL(r_1) + CALL MPI_Get_address (canopy%tscrn_max_daily%aggregated_data(off), vaddr(vidx), ierr) + blen(vidx) = cnt * extr1 + vidx = vidx + 1 + ! REAL(r_1) + CALL MPI_Get_address (canopy%tscrn_min_daily%aggregated_data(off), vaddr(vidx), ierr) + blen(vidx) = cnt * extr1 + vidx = vidx + 1 ! REAL(r_2) CALL MPI_Get_address (canopy%fwsoil(off), vaddr(vidx), ierr) ! 59 blen(vidx) = cnt * extr2 @@ -8024,8 +8076,6 @@ SUBROUTINE master_receive(comm, ktau, types) END SUBROUTINE master_receive - ! TODO: receives variables that are required by create_restart - ! but not write_output ! gol124: how about call master_receive (comm, ktau, restart_ts) ! instead of a separate receive_restart sub? !SUBROUTINE receive_restart (comm,ktau,dels,soil,veg,ssnow, & diff --git a/src/offline/cable_mpiworker.F90 b/src/offline/cable_mpiworker.F90 index f62e3e2c3..ff928f4f9 100644 --- a/src/offline/cable_mpiworker.F90 +++ b/src/offline/cable_mpiworker.F90 @@ -139,8 +139,6 @@ SUBROUTINE mpidrv_worker (comm) USE casa_ncdf_module, ONLY: is_casa_time USE cable_input_module, ONLY: open_met_file,load_parameters, & get_met_data,close_met_file - USE cable_output_module, ONLY: create_restart,open_output_file, & - write_output,close_output_file USE cable_cbm_module USE cable_climate_mod @@ -367,10 +365,6 @@ SUBROUTINE mpidrv_worker (comm) END IF - ! Open output file: - ! MPI: only the master writes to the files - !CALL open_output_file( dels, soil, veg, bgc, rough ) - ssnow%otss_0 = ssnow%tgg(:,1) ssnow%otss = ssnow%tgg(:,1) ssnow%rtevap_sat(:) = 0.0 @@ -514,6 +508,8 @@ SUBROUTINE mpidrv_worker (comm) ssnow%rnof2 = ssnow%rnof2*dels ssnow%runoff = ssnow%runoff*dels + call canopy%tscrn_max_daily%accumulate() + call canopy%tscrn_min_daily%accumulate() !jhan this is insufficient testing. condition for !spinup=.false. & we want CASA_dump.nc (spinConv=.true.) @@ -558,11 +554,12 @@ SUBROUTINE mpidrv_worker (comm) ! Write time step's output to file if either: we're not spinning up ! or we're spinning up and the spinup has converged: ! MPI: writing done only by the master - !IF((.NOT.spinup).OR.(spinup.AND.spinConv)) & - ! CALL write_output( dels, ktau, met, canopy, ssnow, & - ! rad, bal, air, soil, veg, C%SBOLTZ, & - ! C%EMLEAF, C%EMSOIL ) + IF (.not. casaonly .and. ktau > kstart .and. mod(ktau - kstart + 1, ktauday) == 0) THEN + ! Reset daily aggregators if it is the end of day + CALL canopy%tscrn_max_daily%reset() + CALL canopy%tscrn_min_daily%reset() + END IF CALL1 = .FALSE. @@ -705,7 +702,7 @@ SUBROUTINE mpidrv_worker (comm) ! Write restart file if requested: IF(output%restart .AND. (.NOT. CASAONLY)) THEN - ! MPI: send variables that are required by create_restart + ! MPI: send variables that are required to write restart CALL MPI_Send (MPI_BOTTOM, 1, restart_t, 0, ktau_gl, comm, ierr) ! MPI: output file written by master only @@ -718,11 +715,6 @@ SUBROUTINE mpidrv_worker (comm) ! MPI: open and close by master only ! Close met data input file: !CALL close_met_file - ! MPI: open and close by master only - ! Close output file and deallocate main variables: - !CALL close_output_file( bal, air, bgc, canopy, met, & - ! rad, rough, soil, ssnow, & - ! sum_flux, veg ) !WRITE(logn,*) bal%wbal_tot, bal%ebal_tot, bal%ebal_tot_cncheck @@ -1746,7 +1738,13 @@ SUBROUTINE worker_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& CALL MPI_Get_address (canopy%wcint, displs(bidx), ierr) blen(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (canopy%tscrn_max_daily%aggregated_data, displs(bidx), ierr) + blen(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (canopy%tscrn_min_daily%aggregated_data, displs(bidx), ierr) + blen(bidx) = r1len ! bidx = bidx + 1 ! CALL MPI_Get_address (canopy%rwater, displs(bidx), ierr) @@ -3612,7 +3610,7 @@ END SUBROUTINE worker_intype ! MPI: creates send_t type to send the results to the master ! - ! list of fields that master needs to receive for use in write_output: + ! list of fields that master needs to receive to write output: ! ! air% rlam ! @@ -4599,6 +4597,14 @@ SUBROUTINE worker_outtype (comm,met,canopy,ssnow,rad,bal,air,soil,veg) CALL MPI_Get_address (canopy%wcint(off), displs(bidx), ierr) blocks(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (canopy%tscrn_max_daily%aggregated_data(off), displs(bidx), ierr) + blocks(bidx) = r1len + + bidx = bidx + 1 + CALL MPI_Get_address (canopy%tscrn_min_daily%aggregated_data(off), displs(bidx), ierr) + blocks(bidx) = r1len + bidx = bidx + 1 CALL MPI_Get_address (canopy%fwsoil(off), displs(bidx), ierr) blocks(bidx) = r2len diff --git a/src/offline/cable_output.F90 b/src/offline/cable_output.F90 deleted file mode 100644 index 0d3ae992e..000000000 --- a/src/offline/cable_output.F90 +++ /dev/null @@ -1,3112 +0,0 @@ -!============================================================================== -! This source code is part of the -! Australian Community Atmosphere Biosphere Land Exchange (CABLE) model. -! This work is licensed under the CSIRO Open Source Software License -! Agreement (variation of the BSD / MIT License). -! -! You may not use this file except in compliance with this License. -! A copy of the License (CSIRO_BSD_MIT_License_v2.0_CABLE.txt) is located -! in each directory containing CABLE code. -! -! ============================================================================== -! Purpose: Output module for CABLE offline -! -! Contact: Bernard.Pak@csiro.au -! -! History: Developed by Gab Abramowitz -! Output of additional variables and parameters relative to v1.4b -! -! -! ============================================================================== -! CALLed from: cable_serial.F90 -! -! MODULEs used: cable_abort_module -! cable_common_module -! cable_checks_module -! cable_def_types_mod -! cable_IO_vars_module -! cable_write_module -! netcdf -! -! CALLs: open_output_file -! write_output -! close_output_file -! create_restart -! -MODULE cable_output_module - - - USE cable_abort_module, ONLY: abort, nc_abort - USE cable_def_types_mod - USE casavariable, ONLY: casa_pool, casa_flux, casa_met - USE cable_IO_vars_module - USE cable_checks_module, ONLY: mass_balance, energy_balance, ranges, check_range - USE cable_write_module - USE netcdf - USE cable_common_module, ONLY: filename, calcsoilalbedo, CurYear,IS_LEAPYEAR, cable_user,& - gw_params - USE cable_phys_constants_mod, ONLY: c_molar_mass - USE cable_phys_constants_mod, ONLY: HL - IMPLICIT NONE - PRIVATE - PUBLIC open_output_file, write_output, close_output_file, create_restart, check_and_write, output_par_settings_type - INTEGER :: ncid_out, ncid_restart ! output/restart data netcdf file ID - REAL :: missing_value = -999999.0 ! for netcdf output - TYPE out_varID_type ! output variable IDs in netcdf file - INTEGER :: SWdown, LWdown, Wind, Wind_E, PSurf, & - Tair, Qair, Tscrn, Qscrn, Rainf, Snowf, CO2air, & - Tmx, Tmn, Txx, Tnn, & - Qmom, Qle, Qh, Qg, NEE, SWnet, & - LWnet, SoilMoist, SoilTemp, Albedo, & - visAlbedo, nirAlbedo, SoilMoistIce, & - Qs, Qsb, Evap, PotEvap, BaresoilT, SWE, SnowT, & - RadT, VegT, Ebal, Wbal, AutoResp, RootResp, & - StemResp, LeafResp, HeteroResp, GPP, NPP, LAI, & - ECanop, TVeg, ESoil, CanopInt, SnowDepth, & - HVeg, HSoil, Rnet, tvar, CanT,Fwsoil, RnetSoil, SnowMelt, & - NBP, TotSoilCarb, TotLivBiomass, & - TotLittCarb, SoilCarbFast, SoilCarbSlow, SoilCarbPassive, & - LittCarbMetabolic, LittCarbStructural, LittCarbCWD, & - PlantCarbLeaf, PlantCarbFineRoot, PlantCarbWood, & - PlantTurnover, PlantTurnoverLeaf, PlantTurnoverFineRoot, & - PlantTurnoverWood, PlantTurnoverWoodDist, PlantTurnoverWoodCrowding, & - PlantTurnoverWoodResourceLim, dCdt, LandUseFlux, patchfrac, & - vcmax,hc,WatTable,GWMoist,SatFrac,Qrecharge - END TYPE out_varID_type - TYPE(out_varID_type) :: ovid ! netcdf variable IDs for output variables - TYPE(parID_type) :: opid ! netcdf variable IDs for output variables - TYPE output_temporary_type - REAL(KIND=4), POINTER, DIMENSION(:) :: SWdown ! 6 downward short-wave - ! radiation [W/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: LWdown ! 7 downward long-wave - ! radiation [W/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: Rainf ! 8 rainfall [kg/m2/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: Snowf ! 9 snowfall [kg/m2/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: PSurf ! 10 surface pressure [Pa] - REAL(KIND=4), POINTER, DIMENSION(:) :: Tair ! 11 surface air temperature - ! [K] - REAL(KIND=4), POINTER, DIMENSION(:) :: Qair ! 12 specific humidity [kg/kg] - !INH new output variables - REAL(KIND=4), POINTER, DIMENSION(:) :: Tscrn ! -- screen-level air - ! temperature [oC] - REAL(KIND=4), POINTER, DIMENSION(:) :: Qscrn ! -- screen level specific - ! humidity [kg/kg] - REAL(KIND=4), POINTER, DIMENSION(:) :: Tmx ! -- averaged daily maximum - ! screen level temp [oC] - REAL(KIND=4), POINTER, DIMENSION(:) :: Txx ! -- max screen level temp - ! in averaging period [oC] - REAL(KIND=4), POINTER, DIMENSION(:) :: Tmn ! -- averaged daily minimum - ! screen level temp [oC] - REAL(KIND=4), POINTER, DIMENSION(:) :: Tnn ! -- min screen level temp - ! in averaging period [oC] - REAL(KIND=4), POINTER, DIMENSION(:) :: Tdaymx ! -- daily maximum - ! screen level temp [oC] - REAL(KIND=4), POINTER, DIMENSION(:) :: Tdaymn ! -- daily maximum - ! screen level temp [oC] - REAL(KIND=4), POINTER, DIMENSION(:) :: CO2air ! 13 CO2 concentration [ppmv] - REAL(KIND=4), POINTER, DIMENSION(:) :: Wind ! 14 windspeed [m/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: Wind_N ! 15 surface wind speed, N - ! component [m/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: Wind_E ! 16 surface wind speed, E - ! component [m/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: LAI - REAL(KIND=4), POINTER, DIMENSION(:) :: Qmom ! -- momentum flux [kg/m/s2] - REAL(KIND=4), POINTER, DIMENSION(:) :: Qh ! 17 sensible heat flux [W/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: Qle ! 18 latent heat flux [W/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: Qg ! 19 ground heat flux [W/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: SWnet ! 20 net shortwave [W/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: LWnet ! 21 net longwave [W/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: Evap ! 22 total evapotranspiration - ! [kg/m2/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: Ewater ! 23 evap. from surface water - ! storage [kg/m2/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: ESoil ! 24 bare soil evaporation - ! [kg/m2/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: TVeg ! 25 vegetation transpiration - ! [kg/m2/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: ECanop ! 26 interception evaporation - ! [kg/m2/s] - ! 27 potential evapotranspiration [kg/m2/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: PotEvap - REAL(KIND=4), POINTER, DIMENSION(:) :: ACond ! 28 aerodynamic conductance - ! [m/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: SoilWet ! 29 total soil wetness [-] - REAL(KIND=4), POINTER, DIMENSION(:) :: Albedo ! 30 albedo [-] - REAL(KIND=4), POINTER, DIMENSION(:) :: visAlbedo ! vars intro for Ticket #27 - REAL(KIND=4), POINTER, DIMENSION(:) :: nirAlbedo ! vars intro for Ticket #27 - REAL(KIND=4), POINTER, DIMENSION(:) :: VegT ! 31 vegetation temperature - ! [K] - REAL(KIND=4), POINTER, DIMENSION(:,:) :: SoilTemp ! 32 av.layer soil - ! temperature [K] - REAL(KIND=4), POINTER, DIMENSION(:,:) :: SoilMoist ! 33 av.layer soil - ! moisture [kg/m2] - REAL(KIND=4), POINTER, DIMENSION(:,:) :: SoilMoistIce ! 33 av.layer soil - ! frozen moisture [kg/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: Qs ! 34 surface runoff [kg/m2/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: Qsb ! 35 subsurface runoff [kg/m2/s] - ! 36 change in soilmoisture (sum layers) [kg/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: DelSoilMoist - ! 37 change in snow water equivalent [kg/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: DelSWE - ! 38 change in interception storage [kg/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: DelIntercept - REAL(KIND=4), POINTER, DIMENSION(:) :: SnowT ! 39 snow surface temp [K] - REAL(KIND=4), POINTER, DIMENSION(:) :: BaresoilT ! 40 surface bare soil - ! temp [K] - REAL(KIND=4), POINTER, DIMENSION(:) :: AvgSurfT ! 41 Average surface - ! temperature [K] - REAL(KIND=4), POINTER, DIMENSION(:) :: RadT ! 42 Radiative surface - ! temperature [K] - REAL(KIND=4), POINTER, DIMENSION(:) :: SWE ! 43 snow water equivalent - ! [kg/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: RootMoist ! 44 root zone soil - ! moisture [kg/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: CanopInt ! 45 total canopy water - ! storage [kg/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: NEE ! 46 net ecosystem exchange - ! [umol/m2/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: NPP ! 47 net primary production - ! of C by veg [umol/m2/s] - ! 48 gross primary production C by veg [umol/m2/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: GPP - REAL(KIND=4), POINTER, DIMENSION(:) :: AutoResp ! 49 autotrophic - ! respiration [umol/m2/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: LeafResp ! 51 autotrophic - ! respiration [umol/m2/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: HeteroResp ! 50 heterotrophic - ! respiration [umol/m2/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: SnowDepth ! actual depth of snow in - ! [m] - ! Non-Alma variables - REAL(KIND=4), POINTER, DIMENSION(:) :: Rnet ! net absorbed radiation [W/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: HVeg ! sensible heat from vegetation - ! [W/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: HSoil ! sensible heat from soil - ! [W/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: RnetSoil ! latent heat from soil - ! [kg/m2/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: SnowMelt ! snow melt - ! [W/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: Ebal ! cumulative energy balance - ! [W/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: Wbal ! cumulative water balance - ! [W/m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: CanT ! within-canopy temperature - ! [K] - REAL(KIND=4), POINTER, DIMENSION(:) :: Fwsoil ! soil-moisture modfier to stomatal conductance - ! [-] - - ![umol/m2/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: NBP - REAL(KIND=4), POINTER, DIMENSION(:) :: dCdt - ! [kg C /m2] - REAL(KIND=4), POINTER, DIMENSION(:) :: TotSoilCarb - REAL(KIND=4), POINTER, DIMENSION(:) :: TotLivBiomass - REAL(KIND=4), POINTER, DIMENSION(:) :: TotLittCarb - REAL(KIND=4), POINTER, DIMENSION(:) :: SoilCarbFast - REAL(KIND=4), POINTER, DIMENSION(:) :: SoilCarbSlow - REAL(KIND=4), POINTER, DIMENSION(:) :: SoilCarbPassive - REAL(KIND=4), POINTER, DIMENSION(:) :: LittCarbMetabolic - REAL(KIND=4), POINTER, DIMENSION(:) :: LittCarbStructural - REAL(KIND=4), POINTER, DIMENSION(:) :: LittCarbCWD - REAL(KIND=4), POINTER, DIMENSION(:) :: PlantCarbLeaf - REAL(KIND=4), POINTER, DIMENSION(:) :: PlantCarbFineRoot - REAL(KIND=4), POINTER, DIMENSION(:) :: PlantCarbWood - REAL(KIND=4), POINTER, DIMENSION(:) :: PlantTurnover - REAL(KIND=4), POINTER, DIMENSION(:) :: PlantTurnoverLeaf - REAL(KIND=4), POINTER, DIMENSION(:) :: PlantTurnoverFineRoot - REAL(KIND=4), POINTER, DIMENSION(:) :: PlantTurnoverWood - REAL(KIND=4), POINTER, DIMENSION(:) :: PlantTurnoverWoodDist - REAL(KIND=4), POINTER, DIMENSION(:) :: PlantTurnoverWoodCrowding - REAL(KIND=4), POINTER, DIMENSION(:) :: PlantTurnoverWoodResourceLim - REAL(KIND=4), POINTER, DIMENSION(:) :: LandUseFlux - REAL(KIND=4), POINTER, DIMENSION(:) :: vcmax - REAL(KIND=4), POINTER, DIMENSION(:) :: patchfrac - REAL(KIND=4), POINTER, DIMENSION(:) :: hc - REAL(KIND=4), POINTER, DIMENSION(:) :: SatFrac !Saturated Fraction of Grid Cell - REAL(KIND=4), POINTER, DIMENSION(:) :: Qrecharge !recharge rate Grid Cell - REAL(KIND=4), POINTER, DIMENSION(:) :: GWMoist ! water balance of aquifer [mm3/mm3] - REAL(KIND=4), POINTER, DIMENSION(:) :: WatTable ! water table depth [m] - - REAL(KIND=4), POINTER, DIMENSION(:) :: RootResp ! autotrophic root respiration [umol/m2/s] - REAL(KIND=4), POINTER, DIMENSION(:) :: StemResp ! autotrophic stem respiration [umol/m2/s] - END TYPE output_temporary_type - - TYPE output_var_settings_type - TYPE(met_type), POINTER :: met - LOGICAL :: writenow - ! Optional - CHARACTER(LEN=15) :: dimswitch = 'default' - END TYPE output_var_settings_type - TYPE output_par_settings_type - TYPE(met_type), POINTER :: met - ! Optional - LOGICAL :: restart = .FALSE. - CHARACTER(LEN=15) :: dimswitch = 'default' - END TYPE output_par_settings_type - TYPE(output_temporary_type), SAVE :: out - INTEGER :: ok ! netcdf error status - - - ! Some Additional internal variables - INTEGER :: out_timestep ! counter for output time steps - - INTERFACE check_and_write - MODULE PROCEDURE :: check_and_write_d1 - MODULE PROCEDURE :: check_and_write_d2 - MODULE PROCEDURE :: check_and_write_d1_p - MODULE PROCEDURE :: check_and_write_d2_p - END INTERFACE check_and_write - - INTERFACE generate_out_write_acc - MODULE PROCEDURE :: generate_out_write_acc_d1 - MODULE PROCEDURE :: generate_out_write_acc_d2 - END INTERFACE generate_out_write_acc -CONTAINS - - SUBROUTINE open_output_file(dels, soil, veg, bgc, rough, met, casamet) - ! Creates netcdf output file, defines all variables - ! and writes parameters to it if requested by user. - REAL, INTENT(IN) :: dels ! time step size - TYPE (soil_parameter_type), INTENT(IN) :: soil ! soil parameters - TYPE (veg_parameter_type), INTENT(IN) :: veg ! vegetation parameters - TYPE (bgc_pool_type), INTENT(IN) :: bgc - TYPE (roughness_type), INTENT(IN) :: rough - TYPE (met_type), TARGET, INTENT(IN) :: met - TYPE (casa_met), INTENT(IN) :: casamet - ! REAL, POINTER :: surffrac(:, :) ! fraction of each surf type - - INTEGER :: xID, yID, zID, radID, soilID, soilcarbID, & - plantcarbID, tID, landID, patchID ! dimension IDs - INTEGER :: latID, lonID, llatvID, llonvID ! time,lat,lon variable ID - INTEGER :: xvID, yvID ! coordinate variable IDs for GrADS readability - ! INTEGER :: surffracID ! surface fraction varaible ID - CHARACTER(LEN=10) :: todaydate, nowtime ! used to timestamp netcdf file - - TYPE(output_par_settings_type) :: out_settings - - out_settings = output_par_settings_type(met=met, restart=.FALSE.) - - ! Create output file: - ok = NF90_CREATE(filename%out, NF90_CLOBBER, ncid_out) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, 'Error creating output file ' & - //TRIM(filename%out)// ' (SUBROUTINE open_output_file)') - ! Put the file in define mode: - ok = NF90_REDEF(ncid_out) - ! Define dimensions: - ok = NF90_DEF_DIM(ncid_out, 'x', xdimsize, xID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining x dimension in output file. '// & - '(SUBROUTINE open_output_file)') - ok = NF90_DEF_DIM(ncid_out, 'y', ydimsize, yID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining y dimension in output file. '// & - '(SUBROUTINE open_output_file)') - ! Define patch dimension, whether it's used or not: - ok = NF90_DEF_DIM(ncid_out, 'patch', max_vegpatches, patchID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok,'Error defining patch dimension in output file. '// & - '(SUBROUTINE open_output_file)') - ! ! Define surftype dimension (currently only used for surffrac variable): - ! ok = NF90_DEF_DIM(ncid_out,'surftype',4,surftypeID) - ! IF (ok /= NF90_NOERR) CALL nc_abort & - ! (ok,'Error defining syrftype dimension in output file. '// & - ! '(SUBROUTINE open_output_file)') - ok = NF90_DEF_DIM(ncid_out, 'soil', ms, soilID) ! number of soil layers - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining vertical soil dimension in output file. '// & - '(SUBROUTINE open_output_file)') - ok = NF90_DEF_DIM(ncid_out, 'rad', nrb, radID) ! number of radiation bands - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining radiation dimension in output file. '// & - '(SUBROUTINE open_output_file)') - ok = NF90_DEF_DIM(ncid_out, 'soil_carbon_pools', ncs, soilcarbID) ! # pools - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining soil carbon pool dimension in output file. '// & - '(SUBROUTINE open_output_file)') - ok = NF90_DEF_DIM(ncid_out,'plant_carbon_pools',ncp,plantcarbID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok,'Error defining plant carbon pool dimension in output file. '// & - '(SUBROUTINE open_output_file)') - ok = NF90_DEF_DIM(ncid_out, 'time', NF90_UNLIMITED, tID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok,'Error defining time dimension in output file. '// & - '(SUBROUTINE open_output_file)') - IF(output%grid == 'mask' .OR. output%grid == 'ALMA' .OR. & - (metGrid == 'mask' .AND. output%grid == 'default')) THEN - ! for land/sea mask type grid: - ! Atmospheric 'z' dim of size 1 to comply with ALMA grid type: - ok = NF90_DEF_DIM(ncid_out, 'z', 1, zID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining z dimension in output file. '// & - '(SUBROUTINE open_output_file)') - ELSE IF(output%grid == 'land' .OR. & - (metGrid == 'land' .AND. output%grid == 'default')) THEN - ! For land only compression grid: - ok = NF90_DEF_DIM(ncid_out, 'land', mland, landID) ! number of land - ! points - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining land dimension in output file. '// & - '(SUBROUTINE open_output_file)') - - ok = NF90_DEF_VAR(ncid_out, 'local_lat', NF90_FLOAT, (/landID/), llatvID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining land lat variable in output file. '// & - '(SUBROUTINE open_output_file)') - ok = NF90_PUT_ATT(ncid_out, llatvID, 'units', "degrees_north") - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining local lat variable attributes in output file. '// & - '(SUBROUTINE open_output_file)') - ok = NF90_DEF_VAR(ncid_out, 'local_lon', NF90_FLOAT, (/landID/), llonvID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining land lon variable in output file. '// & - '(SUBROUTINE open_output_file)') - ok = NF90_PUT_ATT(ncid_out, llonvID, 'units', "degrees_east") - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining local lon variable attributes in output file. '// & - '(SUBROUTINE open_output_file)') - - END IF - ! Define "time" variable and its attributes: - ok = NF90_DEF_VAR(ncid_out, 'time', NF90_DOUBLE, (/tID/), ovid%tvar) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining time variable in output file. '// & - '(SUBROUTINE open_output_file)') - ok = NF90_PUT_ATT(ncid_out, ovid%tvar, 'units', timeunits) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining time variable attributes in output file. '// & - '(SUBROUTINE open_output_file)') - ok = NF90_PUT_ATT(ncid_out, ovid%tvar, 'coordinate', time_coord) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining time variable attributes in output file. '// & - '(SUBROUTINE open_output_file)') - ok = NF90_PUT_ATT(ncid_out, ovid%tvar, 'calendar', calendar) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining time variable attributes in output file. '// & - '(SUBROUTINE open_output_file)') - ! Define latitude and longitude variable (ALMA): - ok = NF90_DEF_VAR(ncid_out, 'latitude', NF90_FLOAT, (/xID, yID/), latID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining latitude variable in output file. '// & - '(SUBROUTINE open_output_file)') - ok = NF90_PUT_ATT(ncid_out, latID, 'units', 'degrees_north') - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining latitude variable attributes in output file. '// & - '(SUBROUTINE open_output_file)') - ok = NF90_DEF_VAR(ncid_out, 'longitude', NF90_FLOAT, (/xID, yID/), lonID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining longitude variable in output file. '// & - '(SUBROUTINE open_output_file)') - ok = NF90_PUT_ATT(ncid_out, lonID, 'units', 'degrees_east') - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining longitude variable attributes in output file. '// & - '(SUBROUTINE open_output_file)') - ! Write "cordinate variables" to enable reading by GrADS: - ok = NF90_DEF_VAR(ncid_out, 'x', NF90_FLOAT, (/xID/), xvID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining "x" variable (for GrADS) in output file. '// & - '(SUBROUTINE open_output_file)') - ok = NF90_PUT_ATT(ncid_out, xvID, 'units', 'degrees_east') - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error writing x coordinate variable (GrADS) units in output '// & - 'file. (SUBROUTINE open_output_file)') - ok = NF90_PUT_ATT(ncid_out, xvID, 'comment', & - 'x coordinate variable for GrADS compatibility') - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error writing x variables comment in output file. '// & - '(SUBROUTINE open_output_file)') - ok = NF90_DEF_VAR(ncid_out, 'y', NF90_FLOAT, (/yID/), yvID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining "y" variable (for GrADS) in output file. '// & - '(SUBROUTINE open_output_file)') - ok = NF90_PUT_ATT(ncid_out, yvID, 'units', 'degrees_north') - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error writing y coordinate variable (GrADS) units in output '// & - 'file. (SUBROUTINE open_output_file)') - ok = NF90_PUT_ATT(ncid_out, yvID, 'comment', & - 'y coordinate variable for GrADS compatibility') - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error writing y variables comment in output file. '// & - '(SUBROUTINE open_output_file)') - ! ! Define fraction of each surface type: - ! CALL define_ovar(ncid_out,surffracID,'surffrac','-', & - ! 'Fraction of each surface type: vegetated; urban; lake; land ice', & - ! .FALSE.,surftypeID,'surftype',xID,yID,zID,landID,patchID) - - !=============DEFINE OUTPUT VARIABLES======================================= - ! Define met forcing variables in output file and allocate temp output vars: - - IF(output%SWdown) THEN - CALL define_ovar(ncid_out, & - ovid%SWdown, 'SWdown', 'W/m^2', 'Downward shortwave radiation', & - patchout%SWdown, 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%SWdown(mp)) - out%SWdown = 0.0 ! initialise - END IF - IF(output%LWdown) THEN - CALL define_ovar(ncid_out, ovid%LWdown, 'LWdown', 'W/m^2', & - 'Downward longwave radiation', patchout%LWdown, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%LWdown(mp)) - out%LWdown = 0.0 ! initialise - END IF - IF(output%Tair) THEN - CALL define_ovar(ncid_out, ovid%Tair, & - 'Tair', 'K', 'Surface air temperature', patchout%Tair, & - 'ALMA', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Tair(mp)) - out%Tair = 0.0 ! initialise - END IF - IF(output%Rainf) THEN - CALL define_ovar(ncid_out, ovid%Rainf, 'Rainf', & - 'kg/m^2/s', 'Rainfall+snowfall', patchout%Rainf, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Rainf(mp)) - out%Rainf = 0.0 ! initialise - END IF - IF(output%Snowf) THEN - CALL define_ovar(ncid_out, ovid%Snowf, 'Snowf', & - 'kg/m^2/s', 'Snowfall', patchout%Snowf, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Snowf(mp)) - out%Snowf = 0.0 ! initialise - END IF - IF(output%Qair) THEN - CALL define_ovar(ncid_out, ovid%Qair, 'Qair', & - 'kg/kg', 'Surface specific humidity', patchout%Qair, & - 'ALMA', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Qair(mp)) - out%Qair = 0.0 ! initialise - END IF - IF(output%Wind) THEN - CALL define_ovar(ncid_out, ovid%Wind, 'Wind', & - 'm/s', 'Scalar surface wind speed', patchout%Wind, & - 'ALMA', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Wind(mp)) - out%Wind = 0.0 ! initialise - END IF - IF(output%PSurf) THEN - CALL define_ovar(ncid_out, ovid%PSurf, 'PSurf', & - 'hPa', 'Surface air pressure', patchout%PSurf, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%PSurf(mp)) - out%PSurf = 0.0 ! initialise - END IF - IF(output%CO2air) THEN - CALL define_ovar(ncid_out, ovid%CO2air, 'CO2air', 'ppmv', & - 'Surface air CO2 concentration', patchout%CO2air, & - 'ALMA', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%CO2air(mp)) - out%CO2air = 0.0 ! initialise - END IF - ! Define surface flux variables in output file and allocate temp output - ! vars: - IF(output%Qmom) THEN - CALL define_ovar(ncid_out, ovid%Qmom, 'Qmom', 'kg/m/s2', & - 'Surface momentum flux',patchout%Qmom,'dummy', & - xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Qmom(mp)) - out%Qmom = 0.0 ! initialise - END IF - IF(output%Qle) THEN - CALL define_ovar(ncid_out, ovid%Qle, 'Qle', 'W/m^2', & - 'Surface latent heat flux',patchout%Qle,'dummy', & - xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Qle(mp)) - out%Qle = 0.0 ! initialise - END IF - IF(output%Qh) THEN - CALL define_ovar(ncid_out,ovid%Qh,'Qh', 'W/m^2', & - 'Surface sensible heat flux',patchout%Qh,'dummy', & - xID,yID,zID,landID,patchID,tID) - ALLOCATE(out%Qh(mp)) - out%Qh = 0.0 ! initialise - END IF - - IF(output%Qg) THEN - CALL define_ovar(ncid_out, ovid%Qg, 'Qg', 'W/m^2', & - 'Surface ground heat flux', patchout%Qg, 'dummy', & - xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Qg(mp)) - out%Qg = 0.0 ! initialise - END IF - IF(output%Qs) THEN - CALL define_ovar(ncid_out, ovid%Qs, 'Qs', & - 'kg/m^2/s', 'Surface runoff', patchout%Qs, 'dummy', & - xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Qs(mp)) - out%Qs = 0.0 ! initialise - END IF - IF(output%Qsb) THEN - CALL define_ovar(ncid_out, ovid%Qsb, 'Qsb', 'kg/m^2/s', & - 'Subsurface runoff', patchout%Qsb, 'dummy', & - xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Qsb(mp)) - out%Qsb = 0.0 ! initialise - END IF - IF(output%Evap) THEN - CALL define_ovar(ncid_out, ovid%Evap,'Evap', 'kg/m^2/s', & - 'Total evapotranspiration', patchout%Evap, 'dummy', & - xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Evap(mp)) - out%Evap = 0.0 ! initialise - END IF - IF(output%PotEvap) THEN - CALL define_ovar(ncid_out, ovid%PotEvap,'PotEvap', 'kg/m^2/s', & - 'Potential evaporation', patchout%PotEvap, 'dummy', & - xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%PotEvap(mp)) - out%PotEvap = 0.0 ! initialise - END IF - IF(output%ECanop) THEN - CALL define_ovar(ncid_out, ovid%Ecanop, 'ECanop', 'kg/m^2/s', & - 'Wet canopy evaporation', patchout%ECanop, 'dummy', & - xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%ECanop(mp)) - out%ECanop = 0.0 ! initialise - END IF - IF(output%TVeg) THEN - CALL define_ovar(ncid_out, ovid%TVeg, 'TVeg', 'kg/m^2/s', & - 'Vegetation transpiration', patchout%TVeg, 'dummy', & - xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%TVeg(mp)) - out%TVeg = 0.0 ! initialise - END IF - IF(output%ESoil) THEN - CALL define_ovar(ncid_out, ovid%ESoil, 'ESoil', 'kg/m^2/s', & - 'Evaporation from soil', patchout%ESoil, 'dummy', & - xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%ESoil(mp)) - out%ESoil = 0.0 ! initialise - END IF - IF(output%HVeg) THEN - CALL define_ovar(ncid_out, ovid%HVeg, 'HVeg', 'W/m^2', & - 'Sensible heat from vegetation', patchout%HVeg, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%HVeg(mp)) - out%HVeg = 0.0 ! initialise - END IF - IF(output%HSoil) THEN - CALL define_ovar(ncid_out, ovid%HSoil, 'HSoil', 'W/m^2', & - 'Sensible heat from soil', patchout%HSoil, 'dummy', & - xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%HSoil(mp)) - out%HSoil = 0.0 ! initialise - - CALL define_ovar(ncid_out, ovid%RnetSoil, 'RnetSoil', 'W/m^2', & - 'Net radiation absorbed by ground', patchout%RnetSoil, 'dummy', & - xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%RnetSoil(mp)) - out%RnetSoil = 0.0 ! initialise - END IF - IF(output%NEE) THEN - CALL define_ovar(ncid_out, ovid%NEE, 'NEE', 'umol/m^2/s', & - 'Net ecosystem exchange of CO2', patchout%NEE, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%NEE(mp)) - out%NEE = 0.0 ! initialise - END IF - - - - ! Define soil state variables in output file and allocate temp output vars: - IF(output%SoilMoist) THEN - CALL define_ovar(ncid_out, ovid%SoilMoist, 'SoilMoist', 'm^3/m^3', & - 'Average layer soil moisture', patchout%SoilMoist, & - 'soil', xID, yID, zID, landID, patchID, soilID, tID) - CALL define_ovar(ncid_out, ovid%SoilMoistIce, 'SoilMoistIce', 'm^3/m^3', & - 'Average layer frozen soil moisture', patchout%SoilMoistIce, & - 'soil', xID, yID, zID, landID, patchID, soilID, tID) - ALLOCATE(out%SoilMoist(mp,ms)) - ALLOCATE(out%SoilMoistIce(mp,ms)) - out%SoilMoist = 0.0 ! initialise - out%SoilMoistIce = 0.0 ! initialise - END IF - IF(output%SoilTemp) THEN - CALL define_ovar(ncid_out, ovid%SoilTemp, 'SoilTemp', 'K', & - 'Average layer soil temperature', patchout%SoilTemp, & - 'soil', xID, yID, zID, landID, patchID, soilID, tID) - ALLOCATE(out%SoilTemp(mp,ms)) - out%SoilTemp = 0.0 ! initialise - END IF - IF(output%BaresoilT) THEN - CALL define_ovar(ncid_out, ovid%BaresoilT, 'BaresoilT', & - 'K', 'Bare soil temperature', patchout%BaresoilT, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%BaresoilT(mp)) - out%BaresoilT = 0.0 ! initialise - END IF - ! Define snow state variables in output file and allocate temp output vars: - IF(output%SWE) THEN - CALL define_ovar(ncid_out, ovid%SWE, 'SWE', 'kg/m^2', & - 'Snow water equivalent', patchout%SWE, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%SWE(mp)) - out%SWE = 0.0 ! initialise - - CALL define_ovar(ncid_out, ovid%SnowMelt, 'SnowMelt', 'kg/m^2/s', & - 'Snow Melt Rate', patchout%SnowMelt, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%SnowMelt(mp)) - out%SnowMelt = 0.0 ! initialise - END IF - IF(output%SnowT) THEN - CALL define_ovar(ncid_out, ovid%SnowT, 'SnowT', 'K', & - 'Snow surface temperature', patchout%SnowT, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%SnowT(mp)) - out%SnowT = 0.0 ! initialise - END IF - IF(output%SnowDepth) THEN - CALL define_ovar(ncid_out, ovid%SnowDepth, 'SnowDepth', & - 'm', 'Snow depth', patchout%SnowDepth, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%SnowDepth(mp)) - out%SnowDepth = 0.0 ! initialise - END IF - ! Define radiative variables in output file and allocate temp output vars: - IF(output%SWnet) THEN - CALL define_ovar(ncid_out, ovid%SWnet, 'SWnet', 'W/m^2', & - 'Net shortwave radiation absorbed by surface', & - patchout%SWnet, 'dummy', xID, yID, zID, landID, & - patchID, tID) - ALLOCATE(out%SWnet(mp)) - out%SWnet = 0.0 ! initialise - END IF - IF(output%LWnet) THEN - CALL define_ovar(ncid_out, ovid%LWnet, 'LWnet', 'W/m^2', & - 'Net longwave radiation absorbed by surface', & - patchout%LWnet, 'dummy', xID, yID, zID, landID, & - patchID, tID) - ALLOCATE(out%LWnet(mp)) - out%LWnet = 0.0 ! initialise - END IF - IF(output%Rnet) THEN - CALL define_ovar(ncid_out, ovid%Rnet, 'Rnet', 'W/m^2', & - 'Net radiation absorbed by surface', patchout%Rnet, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Rnet(mp)) - out%Rnet = 0.0 ! initialise - END IF - IF(output%Albedo) THEN - CALL define_ovar(ncid_out, ovid%Albedo, 'Albedo', '-', & - 'Surface albedo', patchout%Albedo, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Albedo(mp)) - out%Albedo = 0.0 ! initialise - END IF - - ! output calc of soil albedo based on colour? - Ticket #27 - IF (calcsoilalbedo) THEN - IF(output%visAlbedo) THEN - CALL define_ovar(ncid_out, ovid%visAlbedo, 'visAlbedo', '-', & - 'Surface vis albedo', patchout%visAlbedo, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%visAlbedo(mp)) - out%visAlbedo = 0.0 ! initialise - END IF - IF(output%nirAlbedo) THEN - CALL define_ovar(ncid_out, ovid%nirAlbedo, 'nirAlbedo', '-', & - 'Surface nir albedo', patchout%nirAlbedo, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%nirAlbedo(mp)) - out%nirAlbedo = 0.0 ! initialise - END IF - END IF - - IF(output%RadT) THEN - CALL define_ovar(ncid_out, ovid%RadT, 'RadT', 'K', & - 'Radiative surface temperature', patchout%RadT, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%RadT(mp)) - out%RadT = 0.0 ! initialise - END IF - ! Define vegetation variables in output file and allocate temp output vars: - ! REV_CORR - new output variables. - IF(output%Tscrn) THEN - CALL define_ovar(ncid_out, ovid%Tscrn, & - 'Tscrn', 'oC', 'screen level air temperature', & - patchout%Tscrn, & - 'ALMA', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Tscrn(mp)) - out%Tscrn = 0.0 ! initialise - END IF - IF (output%Tex) THEN - IF((output%averaging(1:2) == 'da').OR.(output%averaging(1:2)=='mo')) THEN - CALL define_ovar(ncid_out, ovid%Txx, & - 'Txx', 'oC', 'max screen-level T in reporting period',& - patchout%Tex, & - 'ALMA', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Txx(mp)) - out%Txx = -1.0E6 !initialise extremes at unreasonable value - CALL define_ovar(ncid_out, ovid%Tnn, & - 'Tnn', 'oC', 'min screen-level T in reporting period',& - patchout%Tex, & - 'ALMA', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Tnn(mp)) - out%Tnn = 1.0E6 !initialise extremes at unreasonable value - ENDIF - IF (output%averaging(1:2)=='mo') THEN - !%Tdaymx is the current day max T - this is a working variable) - !%Tmx is average of those values to be output - CALL define_ovar(ncid_out, ovid%Tmx, & - 'Tmx', 'oC', 'averaged daily maximum screen-level T', & - patchout%Tex, & - 'ALMA', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Tmx(mp), out%Tdaymx(mp)) - out%Tmx = 0.0 !initialise average - out%Tdaymx = -1.0E6 !initialise extremes at unreasonable value - CALL define_ovar(ncid_out, ovid%Tmn, & - 'Tmn', 'oC', 'averaged daily minimum screen-level T', & - patchout%Tex, & - 'ALMA', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Tmn(mp),out%Tdaymn(mp)) - out%Tmn = 0.0 - out%Tdaymn = 1.0E6 - ENDIF - ENDIF - IF(output%Qscrn) THEN - CALL define_ovar(ncid_out, ovid%Qscrn, & - 'Qscrn', 'kg/kg', 'screen level specific humdity', & - patchout%Qscrn, & - 'ALMA', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Qscrn(mp)) - out%Qscrn = 0.0 ! initialise - END IF - IF(output%VegT) THEN - CALL define_ovar(ncid_out, ovid%VegT, 'VegT', 'K', & - 'Average vegetation temperature', patchout%VegT, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%VegT(mp)) - out%VegT = 0.0 ! initialise - END IF - IF(output%CanT) THEN - CALL define_ovar(ncid_out, ovid%CanT, 'CanT', 'K', & - 'Within-canopy temperature', patchout%CanT, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%CanT(mp)) - out%CanT = 0.0 ! initialise - END IF - IF(output%Fwsoil) THEN - CALL define_ovar(ncid_out, ovid%Fwsoil, 'Fwsoil', '[-]', & - 'soil moisture modifier to stomatal conductance', patchout%Fwsoil, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Fwsoil(mp)) - out%Fwsoil = 0.0 ! initialise - END IF - IF(output%CanopInt) THEN - CALL define_ovar(ncid_out, ovid%CanopInt, 'CanopInt', 'kg/m^2', & - 'Canopy intercepted water storage', patchout%CanopInt, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%CanopInt(mp)) - out%CanopInt = 0.0 ! initialise - END IF - IF(output%LAI) THEN - CALL define_ovar(ncid_out, ovid%LAI, 'LAI', '-', & - 'Leaf area index', patchout%LAI, 'dummy', xID, & - yID, zID, landID, patchID, tID) - ALLOCATE(out%LAI(mp)) - out%LAI = 0.0 ! initialise - END IF - ! Define balance variables in output file and allocate temp output vars: - IF(output%Ebal) THEN - CALL define_ovar(ncid_out, ovid%Ebal, 'Ebal', 'W/m^2', & - 'Cumulative energy imbalance', patchout%Ebal, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Ebal(mp)) - out%Ebal = 0.0 ! initialise - END IF - IF(output%Wbal) THEN - CALL define_ovar(ncid_out, ovid%Wbal, 'Wbal', 'kg/m^2', & - 'Cumulative water imbalance', patchout%Wbal, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Wbal(mp)) - out%Wbal = 0.0 ! initialise - END IF - ! Define carbon variables in output file and allocate temp output vars: - IF(output%AutoResp) THEN - CALL define_ovar(ncid_out, ovid%AutoResp, 'AutoResp', 'umol/m^2/s', & - 'Autotrophic respiration', patchout%AutoResp, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%AutoResp(mp)) - out%AutoResp = 0.0 ! initialise - END IF - IF(output%casa .AND. output%AutoResp) THEN - CALL define_ovar(ncid_out, ovid%RootResp, 'RootResp', 'umol/m^2/s', & - 'Fine Root Autotrophic respiration', patchout%AutoResp, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%RootResp(mp)) - out%RootResp = 0.0 ! initialise - END IF - - IF(output%casa .AND. output%AutoResp) THEN - CALL define_ovar(ncid_out, ovid%StemResp, 'StemResp', 'umol/m^2/s', & - 'StemWood Autotrophic respiration', patchout%AutoResp, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%StemResp(mp)) - out%StemResp = 0.0 ! initialise - END IF - - IF(output%LeafResp) THEN - CALL define_ovar(ncid_out, ovid%LeafResp, 'LeafResp', 'umol/m^2/s', & - 'Leaf respiration', patchout%LeafResp, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%LeafResp(mp)) - out%LeafResp = 0.0 ! initialise - END IF - IF(output%HeteroResp) THEN - CALL define_ovar(ncid_out, ovid%HeteroResp, 'HeteroResp', 'umol/m^2/s', & - 'Heterotrophic respiration', patchout%HeteroResp, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%HeteroResp(mp)) - out%HeteroResp = 0.0 ! initialise - END IF - IF(output%GPP) THEN - CALL define_ovar(ncid_out, ovid%GPP, 'GPP', 'umol/m^2/s', & - 'Gross primary production', patchout%GPP, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%GPP(mp)) - out%GPP = 0.0 ! initialise - - - END IF - - - - - - IF(output%NPP) THEN - CALL define_ovar(ncid_out, ovid%NPP, 'NPP', 'umol/m^2/s', & - 'Net primary production', patchout%NPP, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%NPP(mp)) - out%NPP = 0.0 ! initialise - END IF - - !MD groundwater related variables - IF (cable_user%GW_MODEL) THEN - IF(output%WatTable) THEN - CALL define_ovar(ncid_out, ovid%WatTable, 'WatTable', 'm', & - 'Water Table Depth', patchout%WatTable, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%WatTable(mp)) - out%WatTable = 0.0 ! initialise - END IF - IF(output%GWMoist) THEN - CALL define_ovar(ncid_out, ovid%GWMoist, 'GWMoist', 'mm3/mm3', & - 'Aquifer mositure content', patchout%GWMoist, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%GWMoist(mp)) - out%GWMoist = 0.0 ! initialise - END IF - IF(output%SatFrac) THEN - CALL define_ovar(ncid_out, ovid%SatFrac, 'SatFrac', 'unitless', & - 'Saturated Fraction of Gridcell', patchout%SatFrac, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%SatFrac(mp)) - out%SatFrac = 0.0 ! initialise - END IF - END IF - - IF(output%Qrecharge) THEN - CALL define_ovar(ncid_out, ovid%Qrecharge, 'Qrecharge', 'mm/s', & - 'Recharge to or from Aquifer', patchout%Qrecharge, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%Qrecharge(mp)) - out%Qrecharge = 0.0 ! initialise - END IF - - IF(output%casa) THEN - CALL define_ovar(ncid_out, ovid%NBP, 'NBP', 'umol/m^2/s', & - 'Net Biosphere Production (uptake +ve)', patchout%NBP, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%NBP(mp)) - out%NBP = 0.0 ! initialise - - CALL define_ovar(ncid_out, ovid%dCdt, 'dCdt', 'umol/m^2/s', & - 'Carbon accumulation rate (uptake +ve)', patchout%dCdt, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%dCdt(mp)) - out%dCdt = 0.0 ! initialise - - CALL define_ovar(ncid_out, ovid%TotSoilCarb, 'TotSoilCarb', 'kg C/m^2', & - 'Total Soil and Litter Carbon', patchout%TotSoilCarb, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%TotSoilCarb(mp)) - out%TotSoilCarb = 0.0 ! initialise - - CALL define_ovar(ncid_out, ovid%TotLittCarb, 'TotLittCarb', 'kg C/m^2', & - 'Total Litter Carbon', patchout%TotLittCarb, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%TotLittCarb(mp)) - out%TotLittCarb = 0.0 ! initialise - - CALL define_ovar(ncid_out, ovid%SoilCarbFast, 'SoilCarbFast', 'kg C/m^2', & - 'Soil Carbon: Fast Turnover', patchout%SoilCarbFast, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%SoilCarbFast(mp)) - out%SoilCarbFast = 0.0 ! initialise - - CALL define_ovar(ncid_out, ovid%SoilCarbSlow, 'SoilCarbSlow', 'kg C/m^2', & - 'Soil Carbon: Slow Turnover', patchout%SoilCarbSlow, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%SoilCarbSlow(mp)) - out%SoilCarbSlow = 0.0 ! initialise - - CALL define_ovar(ncid_out, ovid%SoilCarbPassive, 'SoilCarbPassive', 'kg C/m^2', & - 'Soil Carbon: Passive', patchout%SoilCarbPassive, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%SoilCarbPassive(mp)) - out%SoilCarbPassive = 0.0 ! initialise - - - CALL define_ovar(ncid_out, ovid%LittCarbMetabolic, 'LittCarbMetabolic', 'kg C/m^2', & - 'Litter Carbon: metabolic', patchout%LittCarbMetabolic, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%LittCarbMetabolic(mp)) - out%LittCarbMetabolic = 0.0 ! initialise - - CALL define_ovar(ncid_out, ovid%LittCarbStructural, 'LittCarbStructural', 'kg C/m^2', & - 'Litter Carbon: structural', patchout%LittCarbStructural, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%LittCarbStructural(mp)) - out%LittCarbStructural = 0.0 ! initialise - - CALL define_ovar(ncid_out, ovid%LittCarbCWD, 'LittCarbCWD', 'kg C/m^2', & - 'Litter Carbon: CWD', patchout%LittCarbCWD, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%LittCarbCWD(mp)) - out%LittCarbCWD = 0.0 ! initialise - - CALL define_ovar(ncid_out, ovid%PlantCarbLeaf, 'PlantCarbLeaf', 'kg C/m^2', & - 'Plant Carbon: leaf', patchout%PlantCarbLeaf, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%PlantCarbLeaf(mp)) - out%PlantCarbLeaf = 0.0 ! initialise - - CALL define_ovar(ncid_out, ovid%PlantCarbFineRoot, 'PlantCarbFineRoot', 'kg C/m^2', & - 'Plant Carbon: Fine roots', patchout%PlantCarbFineRoot, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%PlantCarbFineRoot(mp)) - out%PlantCarbFineRoot = 0.0 ! initialise - - CALL define_ovar(ncid_out, ovid%PlantCarbWood, 'PlantCarbWood', 'kg C/m^2', & - 'Plant Carbon: wood (above- and below-ground', patchout%PlantCarbWood, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%PlantCarbWood(mp)) - out%PlantCarbWood = 0.0 ! initialise - - CALL define_ovar(ncid_out, ovid%TotLivBiomass, 'TotLivBiomass', 'kg C/m^2', & - 'Total Biomass', patchout%TotLivBiomass, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%TotLivBiomass(mp)) - out%TotLivBiomass = 0.0 ! initialise - - - CALL define_ovar(ncid_out, ovid%PlantTurnover, 'PlantTurnover', 'umol/m^2/s', & - 'Total Biomass Turnover', patchout%PlantTurnover, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%PlantTurnover(mp)) - out%PlantTurnover = 0.0 - - CALL define_ovar(ncid_out, ovid%PlantTurnoverLeaf, 'PlantTurnoverLeaf ', & - 'umol/m^2/s', & - 'Leaf Biomass Turnover', patchout%PlantTurnoverLeaf, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%PlantTurnoverLeaf(mp)) - out%PlantTurnoverLeaf = 0.0 - - CALL define_ovar(ncid_out, ovid%PlantTurnoverFineRoot, 'PlantTurnoverFineRoot ', & - 'umol/m^2/s', & - 'FineRoot Biomass Turnover', patchout%PlantTurnoverFineRoot, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%PlantTurnoverFineRoot(mp)) - out%PlantTurnoverFineRoot = 0.0 - - - CALL define_ovar(ncid_out, ovid%PlantTurnoverWood, 'PlantTurnoverWood ', & - 'umol/m^2/s', & - 'Woody Biomass Turnover', patchout%PlantTurnoverWood, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%PlantTurnoverWood(mp)) - out%PlantTurnoverWood = 0.0 - - CALL define_ovar(ncid_out, ovid%PlantTurnoverWoodDist, 'PlantTurnoverWoodDist ', & - 'umol/m^2/s', & - 'Woody Biomass Turnover (disturbance)', patchout%PlantTurnoverWoodDist, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%PlantTurnoverWoodDist(mp)) - out%PlantTurnoverWoodDist = 0.0 - - - CALL define_ovar(ncid_out, ovid%PlantTurnoverWoodCrowding, 'PlantTurnoverWoodCrowding ', & - 'umol/m^2/s', & - 'Woody Biomass Turnover (crowding)', patchout%PlantTurnoverWoodCrowding, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%PlantTurnoverWoodCrowding(mp)) - out%PlantTurnoverWoodCrowding = 0.0 - - CALL define_ovar(ncid_out, ovid%PlantTurnoverWoodResourceLim, 'PlantTurnoverWoodResourceLim ', & - 'umol/m^2/s', & - 'Woody Biomass Turnover (Resource Limitation)', patchout%PlantTurnoverWoodResourceLim, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%PlantTurnoverWoodResourceLim(mp)) - out%PlantTurnoverWoodResourceLim = 0.0 - - IF (cable_user%POPLUC) THEN - - CALL define_ovar(ncid_out, ovid%LandUseFlux, 'LandUseFlux ', & - 'umol/m^2/s', & - 'Sum of wood harvest and clearing fluxes', patchout%LandUseFlux, & - 'dummy', xID, yID, zID, landID, patchID, tID) - ALLOCATE(out%LandUseFlux(mp)) - out%LandUseFlux = 0.0 - ENDIF - - - END IF - - ! vh_js ! - IF (output%casa) CALL define_ovar(ncid_out, opid%area, & - 'Area', 'km2', 'Patch Area', patchout%Area, 'real', & - xID, yID, zID, landID, patchID) - - ! Define CABLE parameters in output file: - IF(output%iveg) CALL define_ovar(ncid_out, opid%iveg, & - 'iveg', '-', 'Vegetation type', patchout%iveg, 'integer', & - xID, yID, zID, landID, patchID) - - IF (cable_user%POPLUC) THEN - - CALL define_ovar(ncid_out, opid%patchfrac, 'patchfrac', '-', & - 'Fractional cover of vegetation patches', patchout%patchfrac, 'real', & - xID, yID, zID, landID, patchID, tID) - - ELSE - - IF((output%patchfrac) & - .AND. (patchout%patchfrac .OR. output%patch)) & - CALL define_ovar(ncid_out, opid%patchfrac, 'patchfrac', '-', & - 'Fractional cover of vegetation patches', patchout%patchfrac, 'real', & - xID, yID, zID, landID, patchID) - - ENDIF - - - IF(output%isoil) CALL define_ovar(ncid_out, opid%isoil, & - 'isoil', '-', 'Soil type', patchout%isoil, 'integer', & - xID, yID, zID, landID, patchID) - IF(output%bch) CALL define_ovar(ncid_out, opid%bch, & - 'bch', '-', 'Parameter b, Campbell eqn 1985', patchout%bch, 'real', & - xID, yID, zID, landID, patchID) - IF(output%clay) CALL define_ovar(ncid_out, opid%clay, & - 'clay', '-', 'Fraction of soil which is clay', patchout%clay, 'real', & - xID, yID, zID, landID, patchID) - IF(output%sand) CALL define_ovar(ncid_out, opid%sand, & - 'sand', '-', 'Fraction of soil which is sand', patchout%sand, 'real', & - xID, yID, zID, landID, patchID) - IF(output%silt) CALL define_ovar(ncid_out, opid%silt, & - 'silt', '-', 'Fraction of soil which is silt', patchout%silt, 'real', & - xID, yID, zID, landID, patchID) - IF(output%ssat) CALL define_ovar(ncid_out, opid%ssat, & - 'ssat', '-', 'Fraction of soil volume which is water @ saturation', & - patchout%ssat, 'real', xID, yID, zID, landID, patchID) - IF(output%sfc) CALL define_ovar(ncid_out, opid%sfc, & - 'sfc', '-', 'Fraction of soil volume which is water @ field capacity', & - patchout%sfc, 'real', xID, yID, zID, landID, patchID) - IF(output%swilt) CALL define_ovar(ncid_out, opid%swilt, & - 'swilt', '-', 'Fraction of soil volume which is water @ wilting point', & - patchout%swilt, 'real', xID, yID, zID, landID, patchID) - IF(output%hyds) CALL define_ovar(ncid_out, opid%hyds, & - 'hyds', 'm/s', 'Hydraulic conductivity @ saturation', & - patchout%hyds, 'real', xID, yID, zID, landID, patchID) - IF(output%sucs) CALL define_ovar(ncid_out, opid%sucs, & - 'sucs', 'm', 'Suction @ saturation', & - patchout%sucs, 'real', xID, yID, zID, landID, patchID) - IF(output%css) CALL define_ovar(ncid_out, opid%css, & - 'css', 'J/kg/C', 'Heat capacity of soil minerals', & - patchout%css, 'real', xID, yID, zID, landID, patchID) - IF(output%rhosoil) CALL define_ovar(ncid_out, & - opid%rhosoil, 'rhosoil', 'kg/m^3', 'Density of soil minerals', & - patchout%rhosoil, 'real', xID, yID, zID, landID, patchID) - IF(output%rs20) CALL define_ovar(ncid_out, opid%rs20, & - 'rs20', '-', 'Soil respiration coefficient at 20C', & - patchout%rs20, 'real', xID, yID, zID, landID, patchID) - IF(output%albsoil) CALL define_ovar(ncid_out, & - opid%albsoil, 'albsoil', '-', & - 'Snow free shortwave soil reflectance fraction', & - patchout%albsoil, radID, 'radiation', xID, yID, zID, landID, patchID) - ! vh_js ! - IF (cable_user%CALL_POP) THEN - IF(output%hc) CALL define_ovar(ncid_out, opid%hc, & - 'hc', 'm', 'Height of canopy', patchout%hc, & - 'real', xID, yID, zID, landID, patchID,tID) - ELSE - IF(output%hc) CALL define_ovar(ncid_out, opid%hc, & - 'hc', 'm', 'Height of canopy', patchout%hc, & - 'real', xID, yID, zID, landID, patchID) - ENDIF - - IF(output%canst1) CALL define_ovar(ncid_out, & - opid%canst1, 'canst1', 'mm/LAI', 'Max water intercepted by canopy', & - patchout%canst1, 'real', xID, yID, zID, landID, patchID) - IF(output%dleaf) CALL define_ovar(ncid_out, opid%dleaf, & - 'dleaf', 'm', 'Chararacteristic length of leaf', & - patchout%dleaf, 'real', xID, yID, zID, landID, patchID) - IF(output%frac4) CALL define_ovar(ncid_out, opid%frac4, & - 'frac4', '-', 'Fraction of plants which are C4', & - patchout%frac4, 'real', xID, yID, zID, landID, patchID) - IF(output%ejmax) CALL define_ovar(ncid_out, opid%ejmax, & - 'ejmax', 'mol/m^2/s', 'Max potential electron transport rate top leaf', & - patchout%ejmax, 'real', xID, yID, zID, landID, patchID) - IF(output%vcmax) CALL define_ovar(ncid_out, opid%vcmax, & - 'vcmax', 'mol/m^2/s', 'Maximum RuBP carboxylation rate top leaf', & - patchout%vcmax, 'real', xID, yID, zID, landID, patchID) - IF(output%rp20) CALL define_ovar(ncid_out, opid%rp20, & - 'rp20', '-', 'Plant respiration coefficient at 20C', & - patchout%rp20, 'real', xID, yID, zID, landID, patchID) - ! Ticket #56 - IF(output%g0) CALL define_ovar(ncid_out, opid%g0, & - 'g0', '-', 'g0 term in Medlyn Stom Cond. Param', & - patchout%g0, 'real', xID, yID, zID, landID, patchID) - IF(output%g1) CALL define_ovar(ncid_out, opid%g1, & - 'g1', '-', 'g1 term in Medlyn Stom Cond. Param', & - patchout%g1, 'real', xID, yID, zID, landID, patchID) - ! end Ticket #56 - - IF(output%rpcoef) CALL define_ovar(ncid_out, & - opid%rpcoef, 'rpcoef', '1/C', & - 'Temperature coef nonleaf plant respiration', & - patchout%rpcoef, 'real', xID, yID, zID, landID, patchID) - IF(output%shelrb) CALL define_ovar(ncid_out, & - opid%shelrb, 'shelrb', '-', 'Sheltering factor', patchout%shelrb, & - 'real', xID, yID, zID, landID, patchID) - IF(output%xfang) CALL define_ovar(ncid_out, opid%xfang, & - 'xfang', '-', 'Leaf angle parameter',patchout%xfang, 'real', & - xID, yID, zID, landID, patchID) - IF(output%wai) CALL define_ovar(ncid_out, opid%wai, & - 'wai', '-', 'Wood area index', patchout%wai, 'real', & - xID, yID, zID, landID, patchID) - IF(output%vegcf) CALL define_ovar(ncid_out, opid%vegcf, & - 'vegcf', '-', 'vegcf', patchout%vegcf, 'real', & - xID, yID, zID, landID, patchID) - IF(output%extkn) CALL define_ovar(ncid_out, opid%extkn, & - 'extkn', '-', 'Nitrogen extinction coef for vert. canopy profile', & - patchout%extkn, 'real', xID, yID, zID, landID, patchID) - IF(output%tminvj) CALL define_ovar(ncid_out, & - opid%tminvj, 'tminvj', 'C', & - 'Min temperature for the start of photosynthesis', & - patchout%tminvj, 'real', xID, yID, zID, landID, patchID) - IF(output%tmaxvj) CALL define_ovar(ncid_out, & - opid%tmaxvj, 'tmaxvj', 'C', 'Max temperature for photosynthesis', & - patchout%tmaxvj, 'real', xID, yID, zID, landID, patchID) - IF(output%vbeta) CALL define_ovar(ncid_out, opid%vbeta, & - 'vbeta', '-', 'Stomatal sensitivity to soil water', & - patchout%vbeta, 'real', xID, yID, zID, landID, patchID) - IF(output%xalbnir) CALL define_ovar(ncid_out, & - opid%xalbnir, 'xalbnir', '-', 'Modifier for albedo in near ir band', & - patchout%xalbnir, 'real', xID, yID, zID, landID, patchID) - IF(output%meth) CALL define_ovar(ncid_out, opid%meth, & - 'meth', '-', 'Canopy turbulence parameterisation choice', & - patchout%meth, 'real', xID, yID, zID, landID, patchID) - IF(output%za) THEN - CALL define_ovar(ncid_out, opid%za_uv, 'za_uv', 'm', & - 'Reference height (lowest atm. model layer) for momentum', & - patchout%za, 'real', xID, yID, zID, landID, patchID) - CALL define_ovar(ncid_out, opid%za_tq, 'za_tq', 'm', & - 'Reference height (lowest atm. model layer) for scalars', & - patchout%za, 'real', xID, yID, zID, landID, patchID) - ENDIF - IF(output%ratecp) CALL define_ovar(ncid_out, & - opid%ratecp, 'ratecp', '1/year', 'Plant carbon rate constant', & - patchout%ratecp, plantcarbID, 'plantcarbon', xID, yID, zID, & - landID, patchID) - IF(output%ratecs) CALL define_ovar(ncid_out, & - opid%ratecs, 'ratecs', '1/year', 'Soil carbon rate constant', & - patchout%ratecs, soilcarbID, 'soilcarbon', xID, yID, zID, & - landID, patchID) - IF(output%zse) CALL define_ovar(ncid_out, opid%zse, & - 'zse', 'm', 'Depth of each soil layer', & - patchout%zse, soilID, 'soil', xID, yID, zID, landID, patchID) - IF(output%froot) CALL define_ovar(ncid_out, opid%froot, & - 'froot', '-', 'Fraction of roots in each soil layer', & - patchout%froot, soilID, 'soil', xID, yID, zID, landID, patchID) - - ! IF(output%slope) CALL define_ovar(ncid_out, opid%slope, & - ! 'slope', '-', 'Mean subgrid topographic slope', & - ! patchout%slope, 'real', xID, yID, zID, landID, patchID) - ! - ! IF(output%slope_std) CALL define_ovar(ncid_out, opid%slope_std, & - ! 'slope_std', '-', 'Mean subgrid topographic slope_std', & - ! patchout%slope_std, 'real', xID, yID, zID, landID, patchID) - ! - ! IF(output%GWdz) CALL define_ovar(ncid_out, opid%GWdz, & - ! 'GWdz', '-', 'Mean aquifer layer thickness ', & - ! patchout%GWdz, 'real', xID, yID, zID, landID, patchID) - ! - IF(output%params .AND. cable_user%gw_model) THEN - CALL define_ovar(ncid_out, opid%Qhmax, & - 'Qhmax', 'mm/s', 'Maximum subsurface drainage ', & - patchout%Qhmax, 'real', xID, yID, zID, landID, patchID) - CALL define_ovar(ncid_out, opid%QhmaxEfold, & - 'QhmaxEfold', 'm', 'Maximum subsurface drainage decay rate', & - patchout%QhmaxEfold, 'real', xID, yID, zID, landID, patchID) - CALL define_ovar(ncid_out, opid%SatFracmax, & - 'SatFracmax', '-', 'Controls max saturated fraction ', & - patchout%SatFracmax, 'real', xID, yID, zID, landID, patchID) - CALL define_ovar(ncid_out, opid%HKefold, & - 'HKefold', '1/m', 'Rate HK decays with depth ', & - patchout%HKefold, 'real', xID, yID, zID, landID, patchID) - CALL define_ovar(ncid_out, opid%HKdepth, & - 'HKdepth', 'm', 'Depth at which HKsat(z) is HKsat(0) ', & - patchout%HKdepth, 'real', xID, yID, zID, landID, patchID) - END IF - - - ! Write global attributes for file: - CALL DATE_AND_TIME(todaydate, nowtime) - todaydate = todaydate(1:4)//'/'//todaydate(5:6)//'/'//todaydate(7:8) - nowtime = nowtime(1:2)//':'//nowtime(3:4)//':'//nowtime(5:6) - ok = NF90_PUT_ATT(ncid_out, NF90_GLOBAL, "Production", & - TRIM(todaydate)//' at '//TRIM(nowtime)) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, 'Error writing global detail to ' & - //TRIM(filename%out)// ' (SUBROUTINE open_output_file)') - ok = NF90_PUT_ATT(ncid_out,NF90_GLOBAL,"Source", & - 'CABLE LSM output file') - IF(ok /= NF90_NOERR) CALL nc_abort(ok, 'Error writing global detail to ' & - //TRIM(filename%out)// ' (SUBROUTINE open_output_file)') - ok = NF90_PUT_ATT(ncid_out, NF90_GLOBAL, "CABLE_input_file", & - TRIM(filename%met)) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, 'Error writing global detail to ' & - //TRIM(filename%out)// ' (SUBROUTINE open_output_file)') - - ! Determine output aggregation details: - IF(output%averaging(1:4) == 'user') THEN - ! User-specified aggregation interval for output: - READ(output%averaging(5:7), *) output%interval - ok = NF90_PUT_ATT(ncid_out, NF90_GLOBAL, "Output_averaging", & - TRIM(output%averaging(5:7))//'-hourly output') - IF(ok /= NF90_NOERR) CALL nc_abort(ok, & - 'Error writing global detail to ' & - //TRIM(filename%out)// ' (SUBROUTINE open_output_file)') - ! Convert interval value from hours to time steps (for use in output - ! write): - output%interval = output%interval * 3600/INT(dels) - ELSE IF(output%averaging(1:3) == 'all') THEN ! output all timesteps - ok = NF90_PUT_ATT(ncid_out, NF90_GLOBAL, "Output_averaging", & - TRIM(output%averaging)//' timesteps recorded') - IF(ok /= NF90_NOERR) CALL nc_abort(ok, & - 'Error writing global detail to ' & - //TRIM(filename%out)// ' (SUBROUTINE open_output_file)') - ! Set output interval to be one time step - output%interval = 1 - ELSE IF(output%averaging(1:2) == 'mo') THEN ! monthly output - ok = NF90_PUT_ATT(ncid_out, NF90_GLOBAL, "Output_averaging", & - TRIM(output%averaging)) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, & - 'Error writing global detail to ' & - //TRIM(filename%out)// ' (SUBROUTINE open_output_file)') - ! Output interval will be determined dynamically for monthly output - ELSE IF(output%averaging(1:2) == 'da') THEN ! daily output - ok = NF90_PUT_ATT(ncid_out, NF90_GLOBAL, "Output_averaging", & - TRIM(output%averaging)) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, & - 'Error writing global detail to ' & - //TRIM(filename%out)// ' (SUBROUTINE open_output_file)') - ! Set output interval to be # time steps in 24 hours: - output%interval = 3600*24/INT(dels) - ELSE - CALL abort ('Unknown output averaging interval specified '// & - 'in namelist file. (SUBROUTINE open_output_file)') - END IF - - ! End netcdf define mode: - ok = NF90_ENDDEF(ncid_out) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, 'Error creating output file ' & - //TRIM(filename%out)// ' (SUBROUTINE open_output_file)') - - ! Write latitude and longitude variables: - - ok = NF90_PUT_VAR(ncid_out, latID, REAL(lat_all, 4)) - IF(ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error writing latitude variable to ' & - //TRIM(filename%out)// ' (SUBROUTINE open_output_file)') - ok = NF90_PUT_VAR(ncid_out, lonID, REAL(lon_all, 4)) - IF(ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error writing longitude variable to ' & - //TRIM(filename%out)// ' (SUBROUTINE open_output_file)') - - IF (output%grid == 'land' .OR. & - (metGrid == 'land' .AND. output%grid == 'default')) THEN - - ok = NF90_PUT_VAR(ncid_out, llatvID, REAL(latitude) ) - IF(ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error writing loc lat variable to ' & - //TRIM(filename%out)// ' (SUBROUTINE open_output_file)') - - ok = NF90_PUT_VAR(ncid_out, llonvID, REAL(longitude) ) - IF(ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error writing loc lon variable to ' & - //TRIM(filename%out)// ' (SUBROUTINE open_output_file)') - - ENDIF - - ! Write GrADS coordinate variables - ok = NF90_PUT_VAR(ncid_out, xvID, REAL(lon_all(:, 1), 4)) - IF(ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error writing GrADS x coordinate variable to ' & - //TRIM(filename%out)// ' (SUBROUTINE open_output_file)') - ok = NF90_PUT_VAR(ncid_out, yvID, REAL(lat_all(1, :), 4)) - IF(ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error writing GrADS y coordinate variable to ' & - //TRIM(filename%out)// ' (SUBROUTINE open_output_file)') - - ! Write model parameters if requested: - - !~ Patch - out_settings%dimswitch = "real" - IF (output%patchfrac .AND. (patchout%patchfrac .OR. output%patch)) THEN - CALL check_and_write(opid%patchfrac, 'patchfrac', & - REAL(patch(:)%frac, 4), ranges%patchfrac, patchout%patchfrac, out_settings) - END IF - - !~ Soil - out_settings%dimswitch = "integer" - IF (output%isoil) THEN - CALL check_and_write(opid%isoil, & - 'isoil', REAL(soil%isoilm, 4), ranges%isoil, patchout%isoil, out_settings) - END IF - out_settings%dimswitch = "real" - IF (output%bch) THEN - CALL check_and_write(opid%bch, & - 'bch', REAL(soil%bch, 4), ranges%bch, patchout%bch, out_settings) - END IF - IF (output%clay) THEN - CALL check_and_write(opid%clay, & - 'clay', REAL(soil%clay, 4), ranges%clay, patchout%clay, out_settings) - END IF - IF (output%sand) THEN - CALL check_and_write(opid%sand, & - 'sand', REAL(soil%sand, 4), ranges%sand, patchout%sand, out_settings) - END IF - IF (output%silt) THEN - CALL check_and_write(opid%silt, & - 'silt', REAL(soil%silt, 4), ranges%silt, patchout%silt, out_settings) - END IF - IF (output%css) THEN - CALL check_and_write(opid%css, & - 'css', REAL(soil%css, 4), ranges%css, patchout%css, out_settings) - END IF - IF (output%rhosoil) THEN - CALL check_and_write(opid%rhosoil, 'rhosoil',REAL(soil%rhosoil,4), & - ranges%rhosoil, patchout%rhosoil, out_settings) - END IF - IF (output%hyds) THEN - CALL check_and_write(opid%hyds, & - 'hyds', REAL(soil%hyds, 4), ranges%hyds, patchout%hyds, out_settings) - END IF - IF (output%sucs) THEN - CALL check_and_write(opid%sucs, & - 'sucs', REAL(soil%sucs, 4), ranges%sucs, patchout%sucs, out_settings) - END IF - IF (output%rs20) THEN - CALL check_and_write(opid%rs20, & - 'rs20', REAL(veg%rs20, 4), ranges%rs20, patchout%rs20, out_settings) - ! 'rs20',REAL(soil%rs20,4),ranges%rs20,patchout%rs20,out_settings) - END IF - IF (output%ssat) THEN - CALL check_and_write(opid%ssat, & - 'ssat', REAL(soil%ssat, 4), ranges%ssat, patchout%ssat, out_settings) - END IF - IF (output%sfc) THEN - CALL check_and_write(opid%sfc, & - 'sfc', REAL(soil%sfc, 4), ranges%sfc, patchout%sfc, out_settings) - END IF - IF (output%swilt) THEN - CALL check_and_write(opid%swilt, & - 'swilt', REAL(soil%swilt, 4), ranges%swilt, patchout%swilt, out_settings) - END IF - - ! IF (output%slope) THEN - ! CALL check_and_write(ncid_out, opid%slope, & - ! 'slope', REAL(soil%slope, 4), ranges%slope, patchout%slope, out_settings) - ! END IF - ! IF (output%slope_std) THEN - ! CALL check_and_write(opid%slope_std, & - ! 'slope_std', REAL(soil%slope_std, 4), ranges%slope_std, patchout%slope_std, out_settings) - ! END IF - ! IF (output%GWdz) THEN - ! CALL check_and_write(opid%GWdz, & - ! 'GWdz', REAL(soil%GWdz, 4), ranges%GWdz, patchout%GWdz, out_settings) - ! END IF - - IF (output%albsoil) THEN - out_settings%dimswitch = "radiation" - CALL check_and_write(opid%albsoil, 'albsoil', REAL(soil%albsoil, 4), & - ranges%albsoil, patchout%albsoil, out_settings) - END IF - - IF (output%zse) THEN - out_settings%dimswitch = "soil" - CALL check_and_write(opid%zse, & - 'zse', SPREAD(REAL(soil%zse, 4), 1, mp),ranges%zse, & - patchout%zse, out_settings)! no spatial dim at present - END IF - - !~ Veg - out_settings%dimswitch = "integer" - IF (output%iveg) THEN - CALL check_and_write(opid%iveg, & - 'iveg', REAL(veg%iveg, 4), ranges%iveg, patchout%iveg, out_settings) - END IF - - out_settings%dimswitch = "real" - IF (output%meth) THEN - CALL check_and_write(opid%meth, & - 'meth', REAL(veg%meth, 4), ranges%meth, patchout%meth, out_settings) - END IF - IF (output%canst1) THEN - CALL check_and_write(opid%canst1, 'canst1', REAL(veg%canst1, 4), & - ranges%canst1, patchout%canst1, out_settings) - END IF - IF (output%dleaf) THEN - CALL check_and_write(opid%dleaf, & - 'dleaf', REAL(veg%dleaf, 4), ranges%dleaf, patchout%dleaf, out_settings) - END IF - IF (output%ejmax) THEN - CALL check_and_write(opid%ejmax, & - 'ejmax', REAL(veg%ejmax, 4), ranges%ejmax, patchout%ejmax, out_settings) - END IF - IF (output%vcmax) THEN - CALL check_and_write(opid%vcmax, & - 'vcmax', REAL(veg%vcmax, 4), ranges%vcmax, patchout%vcmax, out_settings) - END IF - IF (output%frac4) THEN - CALL check_and_write(opid%frac4, & - 'frac4', REAL(veg%frac4, 4), ranges%frac4, patchout%frac4, out_settings) - END IF - IF (.NOT.cable_user%CALL_POP .and. output%hc) THEN - CALL check_and_write(opid%hc, & - 'hc', REAL(veg%hc, 4), ranges%hc, patchout%hc, out_settings) - END IF - IF (output%rp20) THEN - CALL check_and_write(opid%rp20, & - 'rp20', REAL(veg%rp20, 4),ranges%rp20, patchout%rp20, out_settings) - END IF - - ! Ticket #56 - IF (output%g0) THEN - CALL check_and_write(opid%g0, & - 'g0', REAL(veg%g0, 4),ranges%g0, patchout%g0, out_settings) - END IF - IF (output%g1) THEN - CALL check_and_write(opid%g1, & - 'g1', REAL(veg%g1, 4),ranges%g1, patchout%g1, out_settings) - END IF - - ! End Ticket #56 - IF (output%rpcoef) THEN - CALL check_and_write(opid%rpcoef, 'rpcoef', REAL(veg%rpcoef, 4), & - ranges%rpcoef, patchout%rpcoef, out_settings) - END IF - IF (output%shelrb) THEN - CALL check_and_write(opid%shelrb, 'shelrb', REAL(veg%shelrb, 4), & - ranges%shelrb, patchout%shelrb, out_settings) - END IF - IF (output%xfang) THEN - CALL check_and_write(opid%xfang, & - 'xfang', REAL(veg%xfang, 4), ranges%xfang, patchout%xfang, out_settings) - END IF - IF (output%wai) THEN - CALL check_and_write(opid%wai, & - 'wai', REAL(veg%wai, 4), ranges%wai, patchout%wai, out_settings) - END IF - IF (output%vegcf) THEN - CALL check_and_write(opid%vegcf, & - 'vegcf', REAL(veg%vegcf, 4), ranges%vegcf, patchout%vegcf, out_settings) - END IF - IF (output%extkn) THEN - CALL check_and_write(opid%extkn, & - 'extkn', REAL(veg%extkn, 4), ranges%extkn, patchout%extkn, out_settings) - END IF - IF (output%tminvj) THEN - CALL check_and_write(opid%tminvj, 'tminvj', REAL(veg%tminvj, 4), & - ranges%tminvj, patchout%tminvj, out_settings) - END IF - IF (output%tmaxvj) THEN - CALL check_and_write(opid%tmaxvj, 'tmaxvj', REAL(veg%tmaxvj, 4), & - ranges%tmaxvj, patchout%tmaxvj, out_settings) - END IF - IF (output%vbeta) THEN - CALL check_and_write(opid%vbeta, & - 'vbeta', REAL(veg%vbeta, 4), ranges%vbeta, patchout%vbeta, out_settings) - END IF - IF (output%xalbnir) THEN - CALL check_and_write(opid%xalbnir, 'xalbnir', REAL(veg%xalbnir, 4), & - ranges%xalbnir, patchout%xalbnir, out_settings) - END IF - IF (output%froot) THEN - out_settings%dimswitch = "soil" - CALL check_and_write(opid%froot, & - 'froot', REAL(veg%froot, 4), ranges%froot, patchout%froot, out_settings) - END IF - - !~ Rough - out_settings%dimswitch = "real" - IF (output%za) THEN - CALL check_and_write(opid%za_uv, & - 'za_uv', REAL(rough%za_uv, 4), ranges%za, patchout%za, out_settings) - END IF - IF (output%za) THEN - CALL check_and_write(opid%za_tq, & - 'za_tq', REAL(rough%za_tq, 4), ranges%za, patchout%za, out_settings) - END IF - - !~ bgc - IF (output%ratecp) THEN - out_settings%dimswitch = "plantcarbon" - CALL check_and_write(opid%ratecp, 'ratecp',SPREAD(REAL(bgc%ratecp,4),1,mp), ranges%ratecp, & - patchout%ratecp, out_settings)! no spatial dim at present - END IF - IF (output%ratecs) THEN - out_settings%dimswitch = "soilcarbon" - CALL check_and_write(opid%ratecs, 'ratecs', SPREAD(REAL(bgc%ratecs, 4), 1, mp), ranges%ratecs, & - patchout%ratecs, out_settings)! no spatial dim at present - END IF - IF (output%casa) THEN - out_settings%dimswitch = 'real' - CALL check_and_write(opid%area, 'Area', REAL(casamet%areacell/1e6, 4), ranges%Area, patchout%Area, out_settings) - END IF - - !~ gwmodel - out_settings%dimswitch = "real" - IF (output%params .AND. cable_user%gw_model) THEN - CALL check_and_write(opid%SatFracmax, & - 'SatFracmax', SPREAD(REAL(gw_params%MaxSatFraction,4),1,mp), & - ranges%gw_default, patchout%SatFracmax, out_settings) - - CALL check_and_write(opid%Qhmax, & - 'Qhmax', SPREAD(REAL(gw_params%MaxHorzDrainRate, 4),1,mp), & - ranges%gw_default, patchout%Qhmax, out_settings) - - CALL check_and_write(opid%QhmaxEfold, & - 'QhmaxEfold', SPREAD(REAL(gw_params%EfoldHorzDrainRate, 4),1,mp), & - ranges%gw_default, patchout%QhmaxEfold, out_settings) - - CALL check_and_write(opid%HKefold, & - 'HKefold', SPREAD(REAL(gw_params%hkrz, 4),1,mp), & - ranges%gw_default, patchout%HKefold, out_settings) - - CALL check_and_write(opid%HKdepth, & - 'HKdepth', SPREAD(REAL(gw_params%zdepth, 4),1,mp), & - ranges%gw_default, patchout%HKdepth, out_settings) - END IF - - END SUBROUTINE open_output_file - - !============================================================================= - SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, ssnow, & - rad, bal, air, soil, veg, SBOLTZ, EMLEAF, EMSOIL) - ! Writes model output variables and, if requested, calls - ! energy and mass balance routines. This subroutine is called - ! each timestep, but may only write to the output file periodically, - ! depending on whether the user has specified that output should be - ! aggregated, e.g. to monthly or 6-hourly averages. - REAL, INTENT(IN) :: dels ! time step size - INTEGER, INTENT(IN) :: ktau ! timestep number in loop which include spinup - REAL, INTENT(IN) :: SBOLTZ, EMLEAF, EMSOIL - TYPE(met_type), TARGET, INTENT(IN) :: met ! met data - TYPE(canopy_type), INTENT(IN) :: canopy ! canopy variable data - TYPE(soil_snow_type), INTENT(IN) :: ssnow ! soil data - TYPE(soil_parameter_type), INTENT(IN) :: soil ! soil parameters - TYPE(radiation_type), INTENT(IN) :: rad ! radiation data - TYPE(air_type), INTENT(IN) :: air - TYPE(veg_parameter_type), INTENT(IN) :: veg ! vegetation parameters - TYPE(casa_flux), INTENT(IN) :: casaflux ! casa fluxes - TYPE(casa_pool), INTENT(IN) :: casapool ! casa fluxes - TYPE(balances_type), INTENT(INOUT) :: bal - - REAL(r_2) :: timetemp(1) ! temporary variable for storing time - ! value - INTEGER, SAVE :: out_month ! counter for output month - INTEGER :: realyear(mp) ! fix problem for yr b4 leap yr - INTEGER :: backtrack ! modify timetemp for averaged output - - INTEGER :: dday ! number of past-years days for monthly output LN - INTEGER :: iy ! Counter - !MC - use met%year(1) instead of CABLE_USER%YearStart for non-GSWP forcing and leap years - INTEGER, SAVE :: YearStart - - INTEGER :: ok - - TYPE(output_var_settings_type) :: out_settings - - out_settings = output_var_settings_type(met=met, writenow=.FALSE., dimswitch='default') - - ! IF asked to check mass/water balance: - IF(check%mass_bal) CALL mass_balance(dels, ktau, ssnow, soil, canopy, & - met,air,bal) - - ! IF asked to check energy balance: - IF(check%energy_bal) CALL energy_balance(dels,ktau,met,rad, & - canopy,bal,ssnow, & - SBOLTZ, EMLEAF, EMSOIL ) - - ! Initialise output time step counter and month counter: - IF(ktau == 1) THEN - out_timestep = 0 - out_month = 0 - !MC - use met%year(1) instead of CABLE_USER%YearStart for non-GSWP forcing and leap years - IF ( TRIM(cable_user%MetType) .EQ. '' ) THEN - YearStart = met%year(1) - ELSE - YearStart = CABLE_USER%YearStart - ENDIF - END IF - ! Decide on output averaging regime: - IF(output%averaging(1:3) == 'all') THEN ! write every time step to file - ! Set flag to write data for current time step: - out_settings%writenow = .TRUE. - ! Set output time step to be current model time step: - out_timestep = ktau - backtrack = 0 - ELSE IF(output%averaging(1:4) == 'user' .OR. output%averaging(1:2)=='da') & - THEN - ! user defined output interval or daily output - IF(MOD(ktau, output%interval) == 0) THEN ! i.e.ktau divisible by - ! interval - ! write to output file this time step - out_settings%writenow = .TRUE. - ! increment output time step counter: - out_timestep = out_timestep + 1 - backtrack = output%interval / 2 - ELSE - out_settings%writenow = .FALSE. - END IF - ELSE IF(output%averaging(1:2) == 'mo') THEN ! write monthly averages to file - !realyear = met%year - realyear = REAL(CurYear) - IF(ktau >= 365*24*3600/INT(dels)) THEN - WHERE(met%doy == 1) realyear = realyear - 1 ! last timestep of year - END IF - - ! LN Inserted for multiyear output - dday = 0 - !MC - use met%year(1) instead of CABLE_USER%YearStart for non-GSWP forcing and leap years - DO iy=YearStart, CurYear-1 - IF (IS_LEAPYEAR(iy) .AND. leaps) THEN - dday = dday + 366 - ELSE - dday = dday + 365 - ENDIF - END DO - ! LN Inserted for multiyear output - - ! Are we using leap year calendar? - IF (leaps) THEN - ! If currently a leap year: - IF (is_leapyear(CurYear)) THEN - ! vh_js ! - IF(ANY(INT(REAL(lastdayl+dday) * 24. * 3600. / dels) == ktau)) THEN - out_month = MOD(out_month, 12) + 1 ! can only be 1 - 12 - ! write to output file this time step - out_settings%writenow = .TRUE. - ! increment output time step counter: - out_timestep = out_timestep + 1 - ! set numbr of time steps in output period - output%interval = daysml(out_month) * 24 * 3600 / INT(dels) - ELSE - out_settings%writenow = .FALSE. - END IF - ELSE ! not currently a leap year - ! last time step of month - ! vh_js ! - IF(ANY(INT(REAL(lastday+dday) * 24. * 3600. / dels) == ktau)) THEN - ! increment output month counter - out_month = MOD(out_month, 12) + 1 ! can only be 1 - 12 - ! write to output file this time step - out_settings%writenow = .TRUE. - ! increment output time step counter: - out_timestep = out_timestep + 1 - ! set numbr of time steps in output period - output%interval = daysm(out_month) * 24 * 3600 / INT(dels) - ELSE - out_settings%writenow = .FALSE. - END IF - END IF - ELSE ! not using leap year timing in this run - - ! vh_js ! - IF(ANY(INT((REAL((lastday+dday))*24.*3600./REAL(INT(dels))))==ktau)) THEN ! last time step of month - ! IF(ANY(((lastday+dday)*24*3600/INT(dels))==ktau)) THEN ! last time step of month - ! increment output month counter - out_month = MOD(out_month, 12) + 1 ! can only be 1 - 12 - ! write to output file this time step - out_settings%writenow = .TRUE. - ! increment output time step counter: - out_timestep = out_timestep + 1 - ! set numbr of time steps in output period - output%interval = daysm(out_month) * 24 * 3600 / INT(dels) - ELSE - out_settings%writenow = .FALSE. - END IF - END IF ! using leap year timing or not - backtrack = output%interval / 2 - - - ELSE ! type of output aggregation - CALL abort('Unknown output averaging request in namelist file.'// & - '(SUBROUTINE write_output)') - END IF - - ! Note that size of averaging interval, output%interval, is set when opening - ! output file unless output is monthly (in which case it's set above) - - ! If this time step is an output time step: - IF(out_settings%writenow) THEN - ! Write to temporary time variable: - timetemp(1) = DBLE(REAL(ktau-backtrack)*dels) - ! Write time variable for this output time step: - ok = NF90_PUT_VAR(ncid_out, ovid%tvar, timetemp, & - start = (/out_timestep/), count = (/1/)) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, & - 'Error writing time variable to ' & - //TRIM(filename%out)// '(SUBROUTINE write_output)') - END IF - - ! Arguments to generate_out_write_acc: current time step; output file netcdf file ID; - ! netcdf variable ID; variable name; variable data; variable ranges; - ! non-land fill value; include patch info for this var; any specific - ! formatting info; met variables for reporting in case of abort. - - !-----------------------WRITE MET DATA------------------------------------- - out_settings%dimswitch = 'default' - IF (output%SWdown) THEN - ! SWdown: downward short-wave radiation [W/m^2] - CALL generate_out_write_acc(ovid%SWdown, 'SWdown', out%SWdown, REAL(met%ofsd), ranges%SWdown, patchout%SWdown, out_settings) - END IF - IF (output%LWdown) THEN - ! LWdown: downward long-wave radiation [W/m^2] - CALL generate_out_write_acc(ovid%LWdown, 'LWdown', out%LWdown, REAL(met%fld, 4), ranges%LWdown, patchout%LWdown, out_settings) - END IF - IF (output%Rainf) THEN - ! Rainf: rainfall [kg/m^2/s] - CALL generate_out_write_acc(ovid%Rainf, 'Rainf', out%Rainf, REAL(met%precip/dels, 4), ranges%Rainf, patchout%Rainf, out_settings) - END IF - IF (output%Snowf) THEN - ! Snowf: snowfall [kg/m^2/s] - CALL generate_out_write_acc(ovid%Snowf, 'Snowf', out%Snowf, REAL(met%precip_sn/dels, 4), ranges%Snowf, patchout%Snowf, out_settings) - END IF - IF (output%PSurf) THEN - ! PSurf: surface pressure [Pa] - CALL generate_out_write_acc(ovid%PSurf, 'PSurf', out%PSurf, REAL(met%pmb, 4), ranges%PSurf, patchout%PSurf, out_settings) - END IF - - out_settings%dimswitch = 'ALMA' - IF (output%Tair) THEN - ! Tair: surface air temperature [K] - CALL generate_out_write_acc(ovid%Tair, 'Tair', out%Tair, REAL(met%tk, 4), ranges%Tair, patchout%Tair, out_settings) - END IF - IF (output%Qair) THEN - ! Qair: specific humidity [kg/kg] - CALL generate_out_write_acc(ovid%Qair, 'Qair', out%Qair, REAL(met%qv, 4), ranges%Qair, patchout%Qair, out_settings) - END IF - IF (output%Wind) THEN - ! Wind: windspeed [m/s] - CALL generate_out_write_acc(ovid%Wind, 'Wind', out%Wind, REAL(met%ua, 4), ranges%Wind, patchout%Wind, out_settings) - END IF - IF (output%CO2air) THEN - ! CO2air: CO2 concentration [ppmv] - CALL generate_out_write_acc(ovid%CO2air, 'CO2air', out%CO2air, REAL(met%ca*1000000.0, 4), ranges%CO2air, patchout%CO2air, out_settings) - END IF - - !-----------------------WRITE FLUX DATA------------------------------------- - out_settings%dimswitch = 'default' - ! Qmom: momentum flux [kg/m/s2] INH - IF (output%Qmom) THEN - CALL generate_out_write_acc(ovid%Qmom, 'Qmom', out%Qmom, REAL(canopy%qmom, 4), ranges%Qmom, patchout%Qmom, out_settings) - END IF - IF (output%Qmom) THEN - ! Qle: latent heat flux [W/m^2] - CALL generate_out_write_acc(ovid%Qle, 'Qle', out%Qle, REAL(canopy%fe, 4), ranges%Qle, patchout%Qle, out_settings) - END IF - IF (output%Qh) THEN - ! Qh: sensible heat flux [W/m^2] - CALL generate_out_write_acc(ovid%Qh, 'Qh', out%Qh, REAL(canopy%fh, 4), ranges%Qh, patchout%Qh, out_settings) - END IF - IF (output%Qg) THEN - ! Qg: ground heat flux [W/m^2] - CALL generate_out_write_acc(ovid%Qg, 'Qg', out%Qg, REAL(canopy%ga, 4), ranges%Qg, patchout%Qg, out_settings) - END IF - IF (output%Qs) THEN - ! Qs: surface runoff [kg/m^2/s] - CALL generate_out_write_acc(ovid%Qs, 'Qs', out%Qs, REAL(ssnow%rnof1/dels, 4), ranges%Qs, patchout%Qs, out_settings) - END IF - IF (output%Qsb) THEN - ! Qsb: subsurface runoff [kg/m^2/s] - CALL generate_out_write_acc(ovid%Qsb, 'Qsb', out%Qsb, REAL(ssnow%rnof2/dels, 4), ranges%Qsb, patchout%Qsb, out_settings) - END IF - IF (output%Evap) THEN - ! Evap: total evapotranspiration [kg/m^2/s] - CALL generate_out_write_acc(ovid%Evap, 'Evap', out%Evap, REAL(canopy%fe/HL, 4), ranges%Evap, patchout%Evap, out_settings) - END IF - IF (output%PotEvap) THEN - ! PotEVap: potential evapotranspiration [kg/m^2/s] - CALL generate_out_write_acc(ovid%PotEvap, 'PotEvap', out%PotEvap, REAL(canopy%epot/dels, 4), ranges%PotEvap, patchout%PotEvap, out_settings) - END IF - IF (output%ECanop) THEN - ! ECanop: interception evaporation [kg/m^2/s] - CALL generate_out_write_acc(ovid%ECanop, 'ECanop', out%ECanop, REAL(canopy%fevw/HL, 4), ranges%ECanop, patchout%ECanop, out_settings) - END IF - IF (output%TVeg) THEN - ! TVeg: vegetation transpiration [kg/m^2/s] - CALL generate_out_write_acc(ovid%TVeg, 'TVeg', out%TVeg, REAL(canopy%fevc/HL, 4), ranges%TVeg, patchout%TVeg, out_settings) - END IF - - IF (output%Esoil) THEN - ! ESoil: bare soil evaporation [kg/m^2/s] - CALL generate_out_write_acc(ovid%Esoil, 'Esoil', out%Esoil, REAL(canopy%fes/HL, 4), ranges%Esoil, patchout%Esoil, out_settings) - END IF - - IF (output%HVeg) THEN - ! HVeg: sensible heat from vegetation [W/m^2] - CALL generate_out_write_acc(ovid%HVeg, 'HVeg', out%HVeg, REAL(canopy%fhv, 4), ranges%HVeg, patchout%HVeg, out_settings) - END IF - IF (output%HSoil) THEN - ! HSoil: sensible heat from soil [W/m^2] - CALL generate_out_write_acc(ovid%HSoil, 'HSoil', out%HSoil, REAL(canopy%fhs, 4), ranges%HSoil, patchout%HSoil, out_settings) - END IF - IF (output%RNetSoil) THEN - CALL generate_out_write_acc(ovid%RNetSoil, 'RNetSoil', out%RNetSoil, REAL(canopy%fns, 4), ranges%HSoil, patchout%HSoil, out_settings) - END IF - IF (output%NEE) THEN - ! NEE: net ecosystem exchange [umol/m^2/s] - CALL generate_out_write_acc(ovid%NEE, 'NEE', out%NEE, REAL(canopy%fnee/c_molar_mass, 4), ranges%NEE, patchout%NEE, out_settings) - END IF - - !-----------------------WRITE SOIL STATE DATA------------------------------- - - out_settings%dimswitch = 'soil' - IF (output%SoilMoist) THEN - ! SoilMoist: av.layer soil moisture [kg/m^2] - CALL generate_out_write_acc(ovid%SoilMoist, 'SoilMoist', out%SoilMoist, REAL(ssnow%wb, 4), ranges%SoilMoist, patchout%SoilMoistIce, out_settings) - CALL generate_out_write_acc(ovid%SoilMoistIce, 'SoilMoistIce', out%SoilMoistIce, REAL(ssnow%wbice, 4), ranges%SoilMoist, patchout%SoilMoistIce, out_settings) - END IF - IF (output%SoilTemp) THEN - ! SoilTemp: av.layer soil temperature [K] - CALL generate_out_write_acc(ovid%SoilTemp, 'SoilTemp', out%SoilTemp, REAL(ssnow%tgg, 4), ranges%SoilTemp, patchout%SoilTemp, out_settings) - END IF - - out_settings%dimswitch = 'default' - IF (output%BaresoilT) THEN - ! BaresoilT: surface bare soil temp [K] - CALL generate_out_write_acc(ovid%BaresoilT, 'BaresoilT', out%BaresoilT, REAL(ssnow%tgg(:, 1), 4), ranges%BaresoilT, patchout%BaresoilT, out_settings) - END IF - !MD Write the hydrology output data from the groundwater module calculations - IF (cable_user%GW_MODEL) THEN - IF (output%WatTable) THEN - !water table depth - CALL generate_out_write_acc(ovid%WatTable, 'WatTable', out%WatTable, REAL(ssnow%wtd/1000.0, 4), ranges%WatTable, patchout%WatTable, out_settings) - END IF - IF (output%GWMoist) THEN - !aquifer water content - CALL generate_out_write_acc(ovid%GWMoist, 'GWMoist', out%GWMoist, REAL(ssnow%GWwb, 4), ranges%GWwb, patchout%GWMoist, out_settings) - END IF - IF (output%SatFrac) THEN - !write(*,*) 'Qinfl' !MDeck - CALL generate_out_write_acc(ovid%SatFrac, 'SatFrac', out%SatFrac, REAL(ssnow%satfrac, 4), ranges%SatFrac, patchout%SatFrac, out_settings) - END IF - END IF - - IF (output%Qrecharge) THEN - ! recharge rate - CALL generate_out_write_acc(ovid%Qrecharge, 'Qrecharge', out%Qrecharge, REAL(ssnow%Qrecharge, 4), ranges%Qrecharge, patchout%Qrecharge, out_settings) - END IF - - !----------------------WRITE SNOW STATE DATA-------------------------------- - IF (output%SWE) THEN - ! SWE: snow water equivalent [kg/m^2] - CALL generate_out_write_acc(ovid%SWE, 'SWE', out%SWE, REAL(ssnow%snowd, 4), ranges%SWE, patchout%SWE, out_settings) - CALL generate_out_write_acc(ovid%SnowMelt, 'SnowMelt', out%SnowMelt, REAL(ssnow%smelt/dels, 4), ranges%SnowMelt, patchout%SnowMelt, out_settings) - END IF - - IF (output%SnowT) THEN - ! SnowT: snow surface temp [K] - CALL generate_out_write_acc(ovid%SnowT, 'SnowT', out%SnowT, REAL(ssnow%tggsn(:, 1), 4), ranges%SnowT, patchout%SnowT, out_settings) - END IF - IF (output%SnowDepth) THEN - ! SnowDepth: actual depth of snow in [m] - CALL generate_out_write_acc(ovid%SnowDepth, 'SnowDepth', out%SnowDepth, REAL(ssnow%totsdepth, 4), ranges%SnowDepth, patchout%SnowDepth, out_settings) - END IF - - !-------------------------WRITE RADIATION DATA------------------------------ - IF (output%Swnet) THEN - ! SWnet: net shortwave [W/m^2] - CALL generate_out_write_acc(ovid%Swnet, 'Swnet', out%Swnet, REAL(rad%swnet, 4), ranges%Swnet, patchout%Swnet, out_settings) - END IF - IF (output%Lwnet) THEN - ! LWnet: net longwave [W/m^2] - CALL generate_out_write_acc(ovid%Lwnet, 'Lwnet', out%Lwnet, REAL(rad%lwnet, 4), ranges%Lwnet, patchout%Lwnet, out_settings) - END IF - IF (output%Rnet) THEN - ! Rnet: net absorbed radiation [W/m^2] - CALL generate_out_write_acc(ovid%Rnet, 'Rnet', out%Rnet, REAL(rad%rnet, 4), ranges%Rnet, patchout%Rnet, out_settings) - END IF - - IF (output%Albedo) THEN - ! Albedo: - CALL generate_out_write_acc(ovid%Albedo, 'Albedo', out%Albedo, REAL(rad%albedo_T, 4), ranges%Albedo, patchout%Albedo, out_settings) - IF (calcsoilalbedo) THEN - CALL generate_out_write_acc(ovid%visAlbedo, 'visAlbedo', out%visAlbedo, REAL(rad%albedo(:, 1), 4), ranges%visAlbedo, patchout%visAlbedo, out_settings) - CALL generate_out_write_acc(ovid%nirAlbedo, 'nirAlbedo', out%nirAlbedo, REAL(rad%albedo(:, 2), 4), ranges%nirAlbedo, patchout%nirAlbedo, out_settings) - END IF - END IF - - - ! RadT: Radiative surface temperature [K] - IF (output%RadT) THEN - CALL generate_out_write_acc(ovid%RadT, 'RadT', out%RadT, REAL(rad%trad, 4), ranges%RadT, patchout%RadT, out_settings) - END IF - - !------------------------WRITE VEGETATION DATA------------------------------ - - out_settings%dimswitch = 'ALMA' - IF (output%Tscrn) THEN - ! Tscrn: screen level air temperature [oC] - CALL generate_out_write_acc(ovid%Tscrn, 'Tscrn', out%Tscrn, REAL(canopy%tscrn, 4), ranges%Tscrn, patchout%Tscrn, out_settings) - END IF - - !INH - extremes in screen level air temperature [oC] - IF (output%Tex) THEN - !if 'daily' then only daily values - using variables Txx and Tnn - IF (output%averaging(1:2) == 'da') THEN - DO iy = 1, mp - out%Txx(iy) = MAX(out%Txx(iy), REAL(canopy%tscrn(iy), 4)) - out%Tnn(iy) = MIN(out%Tnn(iy), REAL(canopy%tscrn(iy), 4)) - END DO - IF (out_settings%writenow) THEN - CALL check_and_write(ovid%Txx, 'Txx', & - out%Txx, out%Txx, ranges%Tscrn, patchout%Tex, out_settings) - CALL check_and_write(ovid%Tnn, 'Tnn', & - out%Tnn, out%Tnn, ranges%Tscrn, patchout%Tex, out_settings) - !Reset temporary output variables: - out%Txx = -1.0E6 - out%Tnn = 1.0E6 - END IF - END IF - - IF (output%averaging(1:2) == 'mo') THEN - !if monthly then both full extremes and averaged extremes - DO iy = 1, mp - out%Txx(iy) = MAX(out%Txx(iy), REAL(canopy%tscrn(iy), 4)) - out%Tnn(iy) = MIN(out%Tnn(iy), REAL(canopy%tscrn(iy), 4)) - out%Tdaymx(iy) = MAX(out%Tdaymx(iy), REAL(canopy%tscrn(iy), 4)) - out%Tdaymn(iy) = MIN(out%Tdaymn(iy), REAL(canopy%tscrn(iy), 4)) - END DO - !take copy of day's max/min for averaged output - reset Tdaymx/mn - IF (MOD(ktau, 24*3600/INT(dels)) == 0) THEN - out%Tmx = out%Tmx + out%Tdaymx - out%Tmn = out%Tmn + out%Tdaymn - out%Tdaymx = -1.0E6 - out%Tdaymn = 1.0E6 - END IF - IF (out_settings%writenow) THEN - !divide by number of records in average (dels*%interval/24/3600) - out%Tmx = out%Tmx/NINT((output%interval * dels) / 86400) - out%Tmn = out%Tmn/NINT((output%interval * dels) / 86400) - !write to file - CALL check_and_write(ovid%Txx, 'Txx', & - out%Txx, out%Txx, ranges%Tscrn, patchout%Tex, out_settings) - CALL check_and_write(ovid%Tnn, 'Tnn', & - out%Tnn, out%Tnn, ranges%Tscrn, patchout%Tex, out_settings) - CALL check_and_write(ovid%Tmx, 'Tmx', & - out%Tmx, out%Tmx, ranges%Tscrn, patchout%Tex, out_settings) - CALL check_and_write(ovid%Tmn, 'Tmn', & - out%Tmn, out%Tmn, ranges%Tscrn, patchout%Tex, out_settings) - !Reset temporary output variables: - out%Txx = -1.0E6 - out%Tnn = 1.0E6 - out%Tmx = 0.0 - out%Tmn = 0.0 - END IF - END IF - END IF - - IF (output%Qscrn) THEN - ! Qscrn: screen level specific humdity [kg/kg] - CALL generate_out_write_acc(ovid%qscrn, 'Qscrn', out%qscrn, REAL(canopy%qscrn, 4), ranges%Qscrn, patchout%Qscrn, out_settings) - END IF - - out_settings%dimswitch = 'default' - IF (output%VegT) THEN - ! VegT: vegetation temperature [K] - CALL generate_out_write_acc(ovid%VegT, 'VegT', out%VegT, REAL(canopy%tv, 4), ranges%VegT, patchout%VegT, out_settings) - END IF - IF (output%CanT) THEN - ! CanT: within-canopy temperature [K] - CALL generate_out_write_acc(ovid%CanT, 'CanT', out%CanT, REAL(met%tvair, 4), ranges%CanT, patchout%CanT, out_settings) - END IF - IF (output%Fwsoil) THEN - ! Fwsoil - CALL generate_out_write_acc(ovid%Fwsoil, 'Fwsoil', out%Fwsoil, REAL(canopy%fwsoil, 4), ranges%Fwsoil, patchout%Fwsoil, out_settings) - END IF - IF (output%CanopInt) THEN - ! CanopInt: total canopy water storage [kg/m^2] - CALL generate_out_write_acc(ovid%CanopInt, 'CanopInt', out%CanopInt, REAL(canopy%cansto, 4), ranges%CanopInt, patchout%CanopInt, out_settings) - END IF - IF (output%LAI) THEN - ! LAI: - CALL generate_out_write_acc(ovid%LAI, 'LAI', out%LAI, REAL(veg%vlai, 4), ranges%LAI, patchout%LAI, out_settings) - END IF - !------------------------WRITE BALANCES DATA-------------------------------- - IF (output%Ebal) THEN - ! Ebal: cumulative energy balance [W/m^2] - CALL generate_out_write_acc(ovid%Ebal, 'Ebal', out%Ebal, REAL(bal%ebal_tot, 4), ranges%Ebal, patchout%Ebal, out_settings) - END IF - IF (output%Wbal) THEN - ! Wbal: cumulative water balance [kg/m^2/s] - CALL generate_out_write_acc(ovid%Wbal, 'Wbal', out%Wbal, REAL(bal%wbal_tot, 4), ranges%Wbal, patchout%Wbal, out_settings) - END IF - !------------------------WRITE CARBON DATA---------------------------------- - ! GPP: gross primary production C by veg [umol/m^2/s] - ! added frday in the calculation of GPP (BP may08) - IF (output%GPP) THEN - CALL generate_out_write_acc(ovid%GPP, 'GPP', out%GPP, REAL(canopy%fgpp/c_molar_mass, 4), ranges%GPP, patchout%GPP, out_settings) - END IF - - ! NPP: net primary production of C by veg [umol/m^2/s] - IF (output%NPP) THEN - CALL generate_out_write_acc(ovid%NPP, 'NPP', out%NPP, REAL(canopy%fnpp/c_molar_mass, 4), ranges%NPP, patchout%NPP, out_settings) - END IF - - ! AutoResp: autotrophic respiration [umol/m^2/s] - IF (output%AutoResp) THEN - CALL generate_out_write_acc(ovid%AutoResp, 'AutoResp', out%AutoResp, REAL(canopy%fra/c_molar_mass, 4), ranges%AutoResp, patchout%AutoResp, out_settings) - IF (output%casa) THEN - ! rootresp alt: REAL(0.3*casaflux%crmplant(:,2)/86400.0/ c_molar_mass, 4) - CALL generate_out_write_acc(ovid%RootResp, 'RootResp', out%RootResp, & - REAL(casaflux%crmplant(:, 3)/(86400.0 * c_molar_mass), 4), ranges%AutoResp, patchout%AutoResp, out_settings) - CALL generate_out_write_acc(ovid%StemResp, 'StemResp', out%StemResp, & - REAL(casaflux%crmplant(:, 2)/(86400.0 * c_molar_mass), 4), ranges%AutoResp, patchout%AutoResp, out_settings) - END IF - END IF - - IF (output%LeafResp) THEN - ! LeafResp: Leaf respiration [umol/m^2/s] - CALL generate_out_write_acc(ovid%LeafResp, 'LeafResp', out%LeafResp, REAL(canopy%frday/c_molar_mass, 4), ranges%LeafResp, patchout%LeafResp, out_settings) - END IF - IF (output%HeteroResp) THEN - ! HeteroResp: heterotrophic respiration [umol/m^2/s] - CALL generate_out_write_acc(ovid%HeteroResp, 'HeteroResp', out%HeteroResp, REAL(canopy%frs/c_molar_mass, 4), ranges%HeteroResp, patchout%HeteroResp, out_settings) - END IF - - ! output patch area - IF (output%casa) THEN - IF (cable_user%POPLUC) THEN - CALL check_and_write(ovid%patchfrac, 'patchfrac', REAL(patch(:)%frac, 4), REAL(patch(:)%frac, 4), ranges%Area, patchout%Area, out_settings) - END IF - IF (cable_user%CALL_POP) THEN - CALL check_and_write(ovid%hc, 'hc', REAL(veg%hc, 4), REAL(veg%hc, 4), ranges%hc, patchout%hc, out_settings) - END IF - - ! NBP and turnover fluxes [umol/m^2/s] - IF (output%NBP) THEN - CALL generate_out_write_acc(ovid%NBP, 'NBP', out%NBP, REAL(casaflux%cnbp/(86400.0 * c_molar_mass), 4), ranges%NEE, patchout%NBP, out_settings) - END IF - - !------------------------WRITE REMAINING CASA DATA---------------------------------- - CALL generate_out_write_acc(ovid%dCdt, 'dCdt', out%dCdt, REAL(casapool%dCdt/(86400.0 * c_molar_mass), 4), ranges%NEE, patchout%dCdt, out_settings) - CALL generate_out_write_acc(ovid%PlantTurnover, 'PlantTurnover', out%PlantTurnover, & - REAL(casaflux%cplant_turnover_tot/(86400.0 * c_molar_mass), 4), ranges%NEE, patchout%PlantTurnover, out_settings) - CALL generate_out_write_acc(ovid%PlantTurnoverLeaf, 'PlantTurnoverLeaf', out%PlantTurnoverLeaf, & - REAL((casaflux%Cplant_turnover(:, 1))/(86400.0 * c_molar_mass), 4), ranges%NEE, patchout%PlantTurnoverLeaf, out_settings) - CALL generate_out_write_acc(ovid%PlantTurnoverFineRoot, 'PlantTurnoverFineRoot', out%PlantTurnoverFineRoot, & - REAL((casaflux%Cplant_turnover(:, 3))/(86400.0 * c_molar_mass), 4), ranges%NEE, patchout%PlantTurnoverFineRoot, out_settings) - CALL generate_out_write_acc(ovid%PlantTurnoverWood, 'PlantTurnoverWood', out%PlantTurnoverWood, & - REAL((casaflux%Cplant_turnover(:, 2))/(86400.0 * c_molar_mass), 4), ranges%NEE, patchout%PlantTurnoverWood, out_settings) - CALL generate_out_write_acc(ovid%PlantTurnoverWoodDist, 'PlantTurnoverWoodDist', out%PlantTurnoverWoodDist, & - REAL(casaflux%Cplant_turnover_disturbance/(86400.0 * c_molar_mass), 4), ranges%NEE, patchout%PlantTurnoverWoodDist, out_settings) - CALL generate_out_write_acc(ovid%PlantTurnoverWoodCrowding, 'PlantTurnoverWoodCrowding', out%PlantTurnoverWoodCrowding, & - REAL(casaflux%Cplant_turnover_crowding/(86400.0 * c_molar_mass), 4), ranges%NEE, patchout%PlantTurnoverWoodCrowding, out_settings) - CALL generate_out_write_acc(ovid%PlantTurnoverWoodResourceLim, 'PlantTurnoverWoodResourceLim', out%PlantTurnoverWoodResourceLim, & - REAL((casaflux%Cplant_turnover_resource_limitation)/(86400.0 * c_molar_mass), 4), ranges%NEE, patchout%PlantTurnoverWoodResourceLim, out_settings) - IF (cable_user%POPLUC) THEN - CALL generate_out_write_acc(ovid%LandUseFlux, 'LandUseFlux', out%LandUseFlux, & - REAL(casaflux%FluxCtoLUC/(86400.0 * c_molar_mass), 4), ranges%NEE, patchout%LandUseFlux, out_settings) - END IF - - ! plant carbon [kg C m-2] - CALL generate_out_write_acc(ovid%TotSoilCarb, 'TotSoilCarb', out%TotSoilCarb, REAL(casapool%csoiltot/1000.0, 4), & - ranges%TotSoilCarb, patchout%TotSoilCarb, out_settings) - CALL generate_out_write_acc(ovid%TotLittCarb, 'TotLittCarb', out%TotLittCarb, REAL(casapool%clittertot/1000.0, 4), & - ranges%TotLittCarb, patchout%TotLittCarb, out_settings) - - ! csoil - CALL generate_out_write_acc(ovid%SoilCarbFast, 'SoilCarbFast', out%SoilCarbFast, REAL(casapool%csoil(:, 1)/1000.0, 4), & - ranges%TotLittCarb, patchout%SoilCarbFast, out_settings) - CALL generate_out_write_acc(ovid%SoilCarbSlow, 'SoilCarbSlow', out%SoilCarbSlow, REAL(casapool%csoil(:, 2)/1000.0, 4), & - ranges%TotSoilCarb, patchout%SoilCarbSlow, out_settings) - CALL generate_out_write_acc(ovid%SoilCarbPassive, 'SoilCarbPassive', out%SoilCarbPassive, REAL(casapool%csoil(:, 3)/1000.0, 4), & - ranges%TotSoilCarb, patchout%SoilCarbPassive, out_settings) - - ! clitter - CALL generate_out_write_acc(ovid%LittCarbMetabolic, 'LittCarbMetabolic', out%LittCarbMetabolic, REAL(casapool%clitter(:, 1)/1000.0, 4), & - ranges%TotLittCarb, patchout%LittCarbMetabolic, out_settings) - CALL generate_out_write_acc(ovid%LittCarbStructural, 'LittCarbStructural', out%LittCarbStructural, REAL(casapool%clitter(:, 2)/1000.0, 4), & - ranges%TotLittCarb, patchout%LittCarbStructural, out_settings) - CALL generate_out_write_acc(ovid%LittCarbCWD, 'LittCarbCWD', out%LittCarbCWD, REAL(casapool%clitter(:, 3)/1000.0, 4), & - ranges%TotLittCarb, patchout%LittCarbCWD, out_settings) - - ! cplant - CALL generate_out_write_acc(ovid%PlantCarbLeaf, 'PlantCarbLeaf', out%PlantCarbLeaf, REAL(casapool%cplant(:, 1)/1000.0, 4), & - ranges%TotLittCarb, patchout%PlantCarbLeaf, out_settings) - CALL generate_out_write_acc(ovid%PlantCarbWood, 'PlantCarbWood', out%PlantCarbWood, REAL(casapool%cplant(:, 2)/1000.0, 4), & - ranges%TotLittCarb, patchout%PlantCarbWood, out_settings) - CALL generate_out_write_acc(ovid%PlantCarbFineRoot, 'PlantCarbFineRoot', out%PlantCarbFineRoot, REAL(casapool%cplant(:, 3)/1000.0, 4), & - ranges%TotLittCarb, patchout%PlantCarbFineRoot, out_settings) - CALL generate_out_write_acc(ovid%TotLivBiomass, 'TotLivBiomass', out%TotLivBiomass, REAL(casapool%cplanttot/1000.0, 4), & - ranges%TotLivBiomass, patchout%TotLivBiomass, out_settings) - END IF - - IF (cable_user%sync_nc_file) & - ok = NF90_SYNC(ncid_out) - - END SUBROUTINE write_output - - SUBROUTINE check_and_write_d1(varID, vname, out_var, acc_val, vrange, writepatch, out_settings) - INTEGER, INTENT(IN) :: varID ! variable's netcdf ID - CHARACTER(LEN=*), INTENT(IN) :: vname ! name of variable - REAL(4), INTENT(IN) :: out_var(:) - REAL(4), INTENT(IN) :: acc_val(:) - REAL, INTENT(IN) :: vrange(2) ! max and min for variable - LOGICAL, INTENT(IN) :: writepatch ! write patch-specific info for this var? - TYPE(output_var_settings_type), INTENT(IN) :: out_settings ! output specific settings - - IF ((check%ranges .EQ. ON_TIMESTEP) .OR. (out_settings%writenow .AND. (check%ranges .EQ. ON_WRITE))) THEN - CALL check_range(vname, acc_val, vrange, out_timestep, out_settings%met) - END IF - - IF (out_settings%writenow) THEN - ! Write value to file: - CALL write_ovar(out_timestep, ncid_out, varID, vname, & - out_var, writepatch, out_settings%dimswitch, out_settings%met) - END IF - END SUBROUTINE check_and_write_d1 - - SUBROUTINE check_and_write_d2(varID, vname, out_var, acc_val, vrange, writepatch, out_settings) - INTEGER, INTENT(IN) :: varID ! variable's netcdf ID - CHARACTER(LEN=*), INTENT(IN) :: vname ! name of variable - REAL(4), INTENT(IN) :: out_var(:, :) - REAL(4), INTENT(IN) :: acc_val(:, :) - REAL, INTENT(IN) :: vrange(2) ! max and min for variable - LOGICAL, INTENT(IN) :: writepatch ! write patch-specific info for this var? - TYPE(output_var_settings_type), INTENT(IN) :: out_settings ! output specific settings - - IF ((check%ranges .EQ. ON_TIMESTEP) .OR. (out_settings%writenow .AND. (check%ranges .EQ. ON_WRITE))) THEN - CALL check_range(vname, acc_val, vrange, out_timestep, out_settings%met) - END IF - - IF (out_settings%writenow) THEN - ! Write value to file: - CALL write_ovar(out_timestep, ncid_out, varID, vname, & - out_var, writepatch, out_settings%dimswitch, out_settings%met) - END IF - END SUBROUTINE check_and_write_d2 - - SUBROUTINE check_and_write_d1_p(parID, pname, out_par, prange, writepatch, out_settings) - INTEGER, INTENT(IN) :: parID ! parameter netcdf ID - CHARACTER(LEN=*), INTENT(IN) :: pname ! name of parameter - REAL(4), INTENT(IN) :: out_par(:) - REAL, INTENT(IN) :: prange(2) ! max and min for parameter - LOGICAL, INTENT(IN) :: writepatch ! write patch-specific info for this par? - TYPE(output_par_settings_type), INTENT(IN) :: out_settings ! output specific settings - - INTEGER :: ncid_file - - CALL check_range(pname, out_par, prange, out_timestep) - - IF (out_settings%restart) THEN - ncid_file = ncid_restart - ELSE - ncid_file = ncid_out - END IF - ! Write value to file: - CALL write_ovar(ncid_file, parID, pname, out_par, & - writepatch, out_settings%dimswitch, out_settings%restart) - - END SUBROUTINE check_and_write_d1_p - - SUBROUTINE check_and_write_d2_p(parID, pname, out_par, prange, writepatch, out_settings) - INTEGER, INTENT(IN) :: parID ! parameter netcdf ID - CHARACTER(LEN=*), INTENT(IN) :: pname ! name of parameter - REAL(4), INTENT(IN) :: out_par(:, :) - REAL, INTENT(IN) :: prange(2) ! max and min for parameter - LOGICAL, INTENT(IN) :: writepatch ! write patch-specific info for this par? - TYPE(output_par_settings_type), INTENT(IN) :: out_settings ! output specific settings - - INTEGER :: ncid_file - - CALL check_range(pname, out_par, prange, out_timestep) - - IF (out_settings%restart) THEN - ncid_file = ncid_restart - ELSE - ncid_file = ncid_out - END IF - ! Write value to file: - CALL write_ovar(ncid_file, parID, pname, out_par, & - writepatch, out_settings%dimswitch, out_settings%restart) - - END SUBROUTINE check_and_write_d2_p - - SUBROUTINE generate_out_write_acc_d1(varID, vname, out_var, acc_val, vrange, writepatch, out_settings) - INTEGER, INTENT(IN) :: varID ! variable's netcdf ID - CHARACTER(LEN=*), INTENT(IN) :: vname ! name of variable - REAL(4), INTENT(INOUT) :: out_var(:) - REAL(4), INTENT(IN) :: acc_val(:) - REAL, INTENT(IN) :: vrange(2) ! max and min for variable - LOGICAL, INTENT(IN) :: writepatch ! write patch-specific info for this var? - TYPE(output_var_settings_type), INTENT(IN) :: out_settings ! met data - - ! Accumulate out_var until interval timesteps - out_var = out_var + acc_val - IF (out_settings%writenow) THEN - out_var = out_var/REAL(output%interval, 4) - END IF - - CALL check_and_write(varID, vname, out_var, acc_val, vrange, writepatch, out_settings) - - ! Reset the value if it has been written to file - IF (out_settings%writenow) THEN - out_var = 0.0 - END IF - - END SUBROUTINE generate_out_write_acc_d1 - - SUBROUTINE generate_out_write_acc_d2(varID, vname, out_var, acc_val, vrange, writepatch, out_settings) - INTEGER, INTENT(IN) :: varID ! variable's netcdf ID - CHARACTER(LEN=*), INTENT(IN) :: vname ! name of variable - REAL(4), INTENT(INOUT) :: out_var(:, :) - REAL(4), INTENT(IN) :: acc_val(:, :) - REAL, INTENT(IN) :: vrange(2) ! max and min for variable - LOGICAL, INTENT(IN) :: writepatch ! write patch-specific info for this var? - TYPE(output_var_settings_type), INTENT(IN) :: out_settings ! met data - - ! Accumulate out_var until interval timesteps - out_var = out_var + acc_val - IF (out_settings%writenow) THEN - out_var = out_var/REAL(output%interval, 4) - END IF - - CALL check_and_write(varID, vname, out_var, acc_val, vrange, writepatch, out_settings) - - ! Reset the value if it has been written to file - IF (out_settings%writenow) THEN - out_var = 0.0 - END IF - - END SUBROUTINE generate_out_write_acc_d2 - - !============================================================================= - SUBROUTINE close_output_file(bal, air, bgc, canopy, met, & - rad, rough, soil, ssnow, sum_flux, veg) - ! Closes output file, reports cumulative mass and energy - ! balances, and deallocates variables. - TYPE (met_type), INTENT(INOUT) :: met - TYPE (air_type), INTENT(INOUT) :: air - TYPE (soil_snow_type), INTENT(INOUT) :: ssnow - TYPE (veg_parameter_type), INTENT(INOUT) :: veg - TYPE (bgc_pool_type), INTENT(INOUT) :: bgc - TYPE (soil_parameter_type), INTENT(INOUT) :: soil - TYPE (canopy_type), INTENT(INOUT) :: canopy - TYPE (roughness_type), INTENT(INOUT) :: rough - TYPE (radiation_type),INTENT(INOUT) :: rad - TYPE (sum_flux_type), INTENT(INOUT) :: sum_flux - TYPE(balances_type),INTENT(INOUT) :: bal - - INTEGER :: i ! do loop counter - - ! Close file - ok = NF90_CLOSE(ncid_out) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, 'Error closing output file ' & - //TRIM(filename%out)// '(SUBROUTINE close_output_file)') - - ! Report balance info to log file if verbose writing is requested: - IF(output%balances .AND. verbose) THEN - WRITE(logn, *) - DO i = 1, mland - WRITE(logn, '(A51,I7,1X,A11,E12.4,A6)') & - ' Cumulative energy balance for each patch in site #', & - i,'is (W/m^2):' - WRITE(logn, *) & - bal%ebal_tot(landpt(i)%cstart:landpt(i)%cstart + & - landpt(i)%nap - 1) - WRITE(logn,'(A50,I7,1X,A8,E12.4,A3)') & - ' Cumulative water balance for each patch in site #', & - i,'is (mm):' - WRITE(logn, *) & - bal%wbal_tot(landpt(i)%cstart:landpt(i)%cstart + & - landpt(i)%nap - 1) - WRITE(logn, *) - END DO - END IF - - ! Successful run! - WRITE(logn, *) - WRITE(logn, *) 'Run finished and output file closed.' - - END SUBROUTINE close_output_file - !============================================================================= - SUBROUTINE create_restart(logn, dels, ktau, soil, veg, ssnow, & - canopy, rough, rad, bgc, bal, met) - ! Creates a restart file for CABLE using a land only grid with mland - ! land points and max_vegpatches veg/soil patches (some of which may - ! not be active). It uses CABLE's internal variable names. - INTEGER, INTENT(IN) :: logn ! log file number - REAL, INTENT(IN) :: dels ! time step size - INTEGER, INTENT(IN) :: ktau ! timestep number in loop which include spinup - TYPE (met_type), TARGET, INTENT(IN) :: met ! meteorological data - TYPE (soil_parameter_type), INTENT(IN) :: soil ! soil parameters - TYPE (veg_parameter_type), INTENT(IN) :: veg ! vegetation parameters - TYPE (soil_snow_type), INTENT(IN) :: ssnow ! soil and snow variables - TYPE (bgc_pool_type), INTENT(IN) :: bgc ! carbon pool variables - TYPE (canopy_type), INTENT(IN) :: canopy ! vegetation variables - TYPE (roughness_type), INTENT(IN) :: rough ! roughness varibles - TYPE (radiation_type), INTENT(IN) :: rad ! radiation variables - TYPE (balances_type), INTENT(IN) :: bal ! energy and water balance variables - ! INTEGER, INTENT(IN) :: mvtype - ! INTEGER, INTENT(IN) :: mstype - - TYPE(parID_type) :: rpid ! parameter IDs for restart nc file - - - TYPE(output_par_settings_type) :: out_settings - - LOGICAL, PARAMETER :: patchout_var = .TRUE. - - ! REAL, POINTER, :: surffrac(:, :) ! fraction of each surf type - INTEGER :: dummy ! dummy argument in subroutine call - INTEGER :: mlandID, mpID, radID, soilID, napID, & - soilcarbID, plantcarbID, tID, snowID ! dimension IDs - ! INTEGER :: mlandID, surftypeID, patchID, radID, soilID, & - ! soilcarbID, plantcarbID, tID, snowID ! dimension IDs - INTEGER :: tvarID, latID, lonID !,surffracID ! time,lat,lon variable ID - INTEGER :: tggID, wbID, wbiceID, tssID, ssdnnID, ssdnID, osnowdID, & - smassID, sdepthID, snageID, snowdID, rtsoilID, isflagID, & - canstoID, albsoilsnID, gammzzID, tggsnID, sghfluxID, & - ghfluxID, runoffID, rnof1ID, rnof2ID, gaID, dgdtgID, & - fevID, fesID, fhsID, wbtot0ID, osnowd0ID, cplantID, & - csoilID, tradID, albedoID, gwID - INTEGER :: h0ID, snowliqID, SID, TsurfaceID, scondsID, nsnowID, TsoilID - CHARACTER(LEN=10) :: todaydate, nowtime ! used to timestamp netcdf file - ! CHARACTER :: FRST_OUT*100, CYEAR*4 - CHARACTER :: FRST_OUT*200, CYEAR*4 - - out_settings = output_par_settings_type(met=met, restart=.TRUE.) - - dummy = 0 ! initialise - - WRITE(logn, '(A24)') ' Writing restart file...' - frst_out = TRIM(filename%restart_out) - ! Look for explicit restart file (netCDF). If not, asssume input is path - IF ( INDEX(TRIM(frst_out),'.nc',BACK=.TRUE.) .NE. LEN_TRIM(frst_out)-2 ) THEN - WRITE( CYEAR,FMT="(I4)" ) CurYear + 1 - frst_out = TRIM(cable_user%RunIden)//'_'//CYEAR//'_cable_rst.nc' - ENDIF - - ! Create output file: - ok = NF90_CREATE(frst_out, NF90_CLOBBER, ncid_restart) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, 'Error creating restart file ' & - //TRIM(frst_out)// '(SUBROUTINE create_restart)') - ! Put the file in define mode: - ok = NF90_REDEF(ncid_restart) - ! Define dimensions: - ok = NF90_DEF_DIM(ncid_restart, 'mland', mland, mlandID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining mland dimension in restart file. '// & - '(SUBROUTINE create_restart)') - ok = NF90_DEF_DIM(ncid_restart, 'mp', mp, mpID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining mp dimension in restart file. '// & - '(SUBROUTINE create_restart)') - ok = NF90_DEF_DIM(ncid_restart, 'soil', ms, soilID) ! number of soil layers - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining vertical soil dimension in restart file. '// & - '(SUBROUTINE create_restart)') - ok = NF90_DEF_DIM(ncid_restart, 'snow', 3, snowID) ! number of snow layers - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining vertical snow dimension in restart file. '// & - '(SUBROUTINE create_restart)') - ok = NF90_DEF_DIM(ncid_restart, 'rad', nrb, radID) ! number of rad. bands - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining radiation dimension in restart file. '// & - '(SUBROUTINE create_restart)') - ok = NF90_DEF_DIM(ncid_restart, 'soil_carbon_pools', ncs, soilcarbID) - ! number of soil carbon pools - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining soil carbon pool dimension in restart file. '// & - '(SUBROUTINE create_restart)') - ok = NF90_DEF_DIM(ncid_restart, 'plant_carbon_pools', ncp, plantcarbID) - ! number of plant carbon pools - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining plant carbon pool dimension in restart file. '// & - '(SUBROUTINE create_restart)') - ok = NF90_DEF_DIM(ncid_restart, 'time', 1, tID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining time dimension in restart file. '// & - '(SUBROUTINE create_restart)') - ! Define "time" variable and its attributes: - ok=NF90_DEF_VAR(ncid_restart,'time',NF90_DOUBLE,(/tID/),tvarID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining time variable in restart file. '// & - '(SUBROUTINE create_restart)') - ok = NF90_PUT_ATT(ncid_restart, tvarID, 'units', timeunits) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining time variable attributes in restart file. '// & - '(SUBROUTINE create_restart)') - ok = NF90_PUT_ATT(ncid_restart, tvarID, 'coordinate', time_coord) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining time variable attributes in restart file. '// & - '(SUBROUTINE create_restart)') - ok = NF90_PUT_ATT(ncid_restart, tvarID, 'calendar', calendar) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining time variable attribute calendar in restart file. '// & - '(SUBROUTINE create_restart)') - ! Define latitude and longitude variable: - ok=NF90_DEF_VAR(ncid_restart, 'latitude', NF90_FLOAT, (/mlandID/), latID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining latitude variable in restart file. '// & - '(SUBROUTINE create_restart)') - ok = NF90_PUT_ATT(ncid_restart,latID,'units','degrees_north') - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining latitude variable attributes in restart file. '// & - '(SUBROUTINE create_restart)') - ok=NF90_DEF_VAR(ncid_restart, 'longitude', NF90_FLOAT, (/mlandID/), lonID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining longitude variable in restart file. '// & - '(SUBROUTINE create_restart)') - ok = NF90_PUT_ATT(ncid_restart, lonID, 'units', 'degrees_east') - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining longitude variable attributes in restart file. '// & - '(SUBROUTINE create_restart)') - ! Define number of active patches variable: - ok = NF90_DEF_VAR(ncid_restart, 'nap', NF90_FLOAT, (/mlandID/), napID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining nap variable in restart file. '// & - '(SUBROUTINE create_restart)') - ok = NF90_PUT_ATT(ncid_restart, napID, 'long_name', & - 'Number of active patches') - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok,'Error defining nap variable attributes in restart file. '// & - '(SUBROUTINE create_restart)') - ! Define patch fraction variable: - ok=NF90_DEF_VAR(ncid_restart, 'patchfrac', NF90_FLOAT, (/mpID/), & - rpid%patchfrac) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining patchfrac variable in restart file. '// & - '(SUBROUTINE create_restart)') - ok = NF90_PUT_ATT(ncid_restart, rpid%patchfrac, 'long_name', & - 'Fraction of vegetated grid cell area occupied by a '// & - 'vegetation/soil patch') - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining patchfrac variable attributes in restart file. '// & - '(SUBROUTINE create_restart)') - ! mvtype (Number of vegetation types): - ok = NF90_DEF_VAR(ncid_restart, 'mvtype', NF90_INT, rpid%mvtype) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining mvtype variable in restart file. '// & - '(SUBROUTINE create_restart)') - ok = NF90_PUT_ATT(ncid_restart, rpid%mvtype, "long_name", & - "Number of vegetation types") - ! mstype (Number of soil types): - ok = NF90_DEF_VAR(ncid_restart, 'mstype', NF90_INT, rpid%mstype) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining mstype variable in restart file. '// & - '(SUBROUTINE create_restart)') - ok = NF90_PUT_ATT(ncid_restart, rpid%mstype, "long_name", & - "Number of soil types") - - !======begin defining state variables======================================= - ! Interface arguments: netcdf file ID, variableID, variable name, variable - ! units, variable long name, YES to write patch info (as this is a restart - ! file), OPTIONAL extra dimension ID (e.g. for soil dimensioned variables), - ! dimension switch to indicate what extra dimension is real or integer for - ! single dim variables, xdimID,ydimID, zdimID (all three not used here), - ! land dim ID, patch dim ID, YES we're writing a restart file. - !------------------define soil states--------------------------------------- - CALL define_ovar(ncid_restart, tggID, 'tgg', 'K', & - 'Average layer soil temperature', & - .TRUE., soilID, 'soil', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, wbID, 'wb', 'vol/vol', & - 'Average layer volumetric soil moisture', & - .TRUE., soilID, 'r2soil', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, wbiceID, 'wbice', 'vol/vol', & - 'Average layer volumetric soil ice', & - .TRUE., soilID, 'r2soil', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, tssID, 'tss', 'K', & - 'Combined soil/snow temperature', & - .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, albsoilsnID, 'albsoilsn', '-', & - 'Combined soil/snow albedo', & - .TRUE., radID, 'radiation', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, rtsoilID, 'rtsoil', '??', & - 'Turbulent resistance for soil', & - .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, gammzzID, 'gammzz', 'J/kg/C', & - 'Heat capacity for each soil layer', & - .TRUE., soilID, 'r2soil', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, runoffID, 'runoff', 'mm/timestep', & - 'Total runoff', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, rnof1ID, 'rnof1', 'mm/timestep', & - 'Surface runoff', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, rnof2ID, 'rnof2', 'mm/timestep', & - 'Subsurface runoff', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - !---------------define snow states------------------------------------------ - CALL define_ovar(ncid_restart, tggsnID, 'tggsn', 'K', & - 'Average layer snow temperature', & - .TRUE., snowID, 'snow', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, ssdnnID, 'ssdnn', 'kg/m^3', & - 'Average snow density', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, ssdnID, 'ssdn', 'kg/m^3', & - 'Average layer snow density', & - .TRUE., snowID, 'snow', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, snowdID, 'snowd', 'mm', & - 'Liquid water eqivalent snow depth', & - .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, snageID, 'snage', '??', & - 'Snow age', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, smassID, 'smass', 'kg/m^2', & - 'Average layer snow mass', & - .TRUE., snowID, 'snow', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, sdepthID, 'sdepth', 'm', & - 'Snow layer depth', .TRUE., snowID, 'snow', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, osnowdID, 'osnowd', 'mm', & - 'Previous time step snow depth in water equivalent', & - .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, isflagID, 'isflag', '-', & - 'Snow layer scheme flag', .TRUE., 'integer', 0, 0, 0, mpID, dummy, .TRUE.) - !----------------define canopy states---------------------------------- - CALL define_ovar(ncid_restart, canstoID, 'cansto', 'mm', & - 'Canopy surface water storage', .TRUE., 'real', 0, 0, 0, & - mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, ghfluxID, 'ghflux', 'W/m^2?', & - '????', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, sghfluxID, 'sghflux', 'W/m^2?', & - '????', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, gaID, 'ga', 'W/m^2', & - 'Ground heat flux', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, dgdtgID, 'dgdtg', 'W/m^2/K', & - 'Derivative of ground heat flux wrt soil temperature', .TRUE., & - 'r2', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, fevID, 'fev', 'W/m^2', & - 'Latent heat flux from vegetation', & - .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, fesID, 'fes', 'W/m^2', & - 'Latent heat flux from soil', & - .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, fhsID, 'fhs', 'W/m^2', & - 'Sensible heat flux from soil', & - .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - !--------------biogeochemical variables------------------------ - CALL define_ovar(ncid_restart, cplantID, 'cplant', 'gC/m^2', & - 'Plant carbon stores', & - .TRUE., plantcarbID, 'plantcarbon', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, csoilID, 'csoil', 'gC/m^2', & - 'Soil carbon stores', & - .TRUE., soilcarbID, 'soilcarbon', 0, 0, 0, mpID, dummy, .TRUE.) - !-------------------others--------------------------------- - CALL define_ovar(ncid_restart, wbtot0ID, 'wbtot0', 'mm', & - 'Initial time step soil water total', & - .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, osnowd0ID, 'osnowd0', 'mm', & - 'Initial time step snow water total', & - .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, albedoID, 'albedo', '-', & - 'Albedo for shortwave and NIR radiation', & - .TRUE., radID, 'radiation', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, tradID, 'trad', 'K', & - 'Surface radiative temperature (soil/snow/veg inclusive)', & - .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - !---------------------MODEL PARAMETERS--------------------------------- - WRITE(logn,'(A43)') ' Writing model parameters to restart file' - CALL define_ovar(ncid_restart, rpid%iveg, 'iveg', '-', & - 'Vegetation type', .TRUE., 'integer', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, rpid%isoil, 'isoil', '-', & - 'Soil type', .TRUE., 'integer', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%clay, 'clay', '-', & -! 'Fraction of soil which is clay', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%sand, 'sand', '-', & -! 'Fraction of soil which is sand', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%silt, 'silt', '-', & -! 'Fraction of soil which is silt', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%ssat, 'ssat', '-', & -! 'Fraction of soil volume which is water @ saturation', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%sfc, 'sfc', '-', & -! 'Fraction of soil volume which is water @ field capacity', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%swilt, 'swilt', '-', & -! 'Fraction of soil volume which is water @ wilting point', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - ! zse (depth of each soil layer): - ok = NF90_DEF_VAR(ncid_restart, 'zse', NF90_FLOAT, (/soilID/), rpid%zse) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining zse variable in restart file. '// & - '(SUBROUTINE create_restart)') - ok = NF90_PUT_ATT(ncid_restart, rpid%zse, "long_name", & - "Depth of each soil layer") - ok = NF90_PUT_ATT(ncid_restart, rpid%zse, "units", "m") -! CALL define_ovar(ncid_restart, rpid%froot, 'froot', '-', & -! 'Fraction of roots in each soil layer', & -! .TRUE., soilID, 'soil', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%bch, 'bch', '-', & -! 'Parameter b, Campbell eqn 1985', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%hyds, 'hyds', 'm/s', & -! 'Hydraulic conductivity @ saturation', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%sucs, 'sucs', 'm', & -! 'Suction @ saturation', .TRUE., & -! 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%css, 'css', 'J/kg/C', & -! 'Heat capacity of soil minerals', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%rhosoil, 'rhosoil', 'kg/m^3', & -! 'Density of soil minerals', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%rs20, 'rs20', '-', & -! 'Soil respiration coefficient at 20C', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, rpid%albsoil, 'albsoil', '-', & - 'Soil reflectance', .TRUE., & - radID, 'radiation', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%hc, 'hc', 'm', & -! 'Height of canopy', .TRUE., & -! 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%canst1, 'canst1', 'mm/LAI', & -! 'Max water intercepted by canopy', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%dleaf, 'dleaf', 'm', & -! 'Chararacteristic length of leaf', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%frac4, 'frac4', '-', & -! 'Fraction of plants which are C4', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%ejmax, 'ejmax', 'mol/m^2/s', & -! 'Max potential electron transport rate top leaf', .TRUE., & -! 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%vcmax, 'vcmax', 'mol/m^2/s', & -! 'Maximum RuBP carboxylation rate top leaf', .TRUE., & -! 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%rp20, 'rp20', '-', & -! 'Plant respiration coefficient at 20C', .TRUE., 'real', & -! 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%g0, 'g0', '-', & -! 'g0 term in Medlyn Stomatal Cond. Param', .TRUE.,'real',& -! 0, 0, 0, mpID, dummy, .TRUE.) ! Ticket #56 -! CALL define_ovar(ncid_restart, rpid%g1, 'g1', '-', & -! 'g1 term in Medlyn Stomatal Cond. Param', .TRUE.,'real',& -! 0, 0, 0, mpID, dummy, .TRUE.) ! Ticket #56 -! CALL define_ovar(ncid_restart, rpid%rpcoef, 'rpcoef', '1/C', & -! 'Temperature coef nonleaf plant respiration', .TRUE., & -! 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%shelrb, 'shelrb', '-', & -! 'Sheltering factor', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%xfang, 'xfang', '-', & -! 'Leaf angle parameter', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%wai, 'wai', '-', & -! 'Wood area index', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%vegcf, 'vegcf', '-', & -! 'vegcf', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%extkn, 'extkn', '-', & -! 'Extinction coef for vertical nitrogen profile', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%tminvj, 'tminvj', 'C', & -! 'Min temperature for the start of photosynthesis', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%tmaxvj, 'tmaxvj', 'C', & -! 'Max temperature for the start of photosynthesis', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%vbeta, 'vbeta', '-', & -! 'Stomatal sensitivity to soil water', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%xalbnir, 'xalbnir', '-', & -! 'modifier for albedo in near ir band', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! ! ratecp (Plant carbon rate constant): -! ok = NF90_DEF_VAR(ncid_restart, 'ratecp', NF90_FLOAT, (/plantcarbID/), & -! rpid%ratecp) -! IF (ok /= NF90_NOERR) CALL nc_abort & -! (ok, 'Error defining ratecp variable in restart file. '// & -! '(SUBROUTINE create_restart)') -! ok = NF90_PUT_ATT(ncid_restart, rpid%ratecp, "long_name", & -! "Plant carbon rate constant") -! ok = NF90_PUT_ATT(ncid_restart, rpid%ratecp, "units", "1/year") -! ! ratecs (Soil carbon rate constant): -! ok = NF90_DEF_VAR(ncid_restart, 'ratecs', NF90_FLOAT, (/soilcarbID/), & -! rpid%ratecs) -! IF (ok /= NF90_NOERR) CALL nc_abort & -! (ok, 'Error defining ratecs variable in restart file. '// & -! '(SUBROUTINE create_restart)') -! ok = NF90_PUT_ATT(ncid_restart, rpid%ratecs, "long_name", & -! "Soil carbon rate constant") -! ok = NF90_PUT_ATT(ncid_restart, rpid%ratecs, "units", "1/year") -! CALL define_ovar(ncid_restart, rpid%meth, 'meth', '-', & -! 'Canopy turbulence parameterisation switch', & -! .TRUE., 'integer', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%za_uv, 'za_uv', 'm', & -! 'Reference height (lowest atm. model layer) for momentum', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart, rpid%za_tq, 'za_tq', 'm', & -! 'Reference height (lowest atm. model layer) for scalars', & -! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - CALL define_ovar(ncid_restart, gwID, 'GWwb', 'mm3/mm3','GW water content', & - .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) - -! IF(cable_user%SOIL_STRUC=='sli'.OR.cable_user%FWSOIL_SWITCH=='Haverd2013') THEN -! CALL define_ovar(ncid_restart,rpid%gamma,'gamma','-', & -! 'Parameter in root efficiency function (Lai and Katul 2000)', & -! .TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) -! ENDIF - ! Soil-Litter-Iso soil model - IF(cable_user%SOIL_STRUC=='sli') THEN - ! Parameters for SLI: -! CALL define_ovar(ncid_restart,rpid%nhorizons,'nhorizons','-', & -! 'Number of soil horizons',.TRUE.,'integer',0,0,0,mpID,dummy,.TRUE.) -! CALL define_ovar(ncid_restart,rpid%zeta,'zeta','[ ]', & -! 'exponent factor in Topmodel eq',.TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) -! CALL define_ovar(ncid_restart,rpid%fsatmax,'fsatmax','[ ]', & -! 'param in Topmodel eq',.TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) -! CALL define_ovar(ncid_restart,rpid%ishorizon,'ishorizon','-', & -! 'Horizon number',.TRUE., soilID, 'soil', 0, 0, 0, mpID, dummy, .TRUE.) -! CALL define_ovar(ncid_restart,rpid%clitt,'clitt','tC/ha', & -! 'Litter layer carbon content',.TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) -! CALL define_ovar(ncid_restart,rpid%ZR,'ZR','cm', & -! 'Maximum rooting depth',.TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) -! CALL define_ovar(ncid_restart,rpid%F10,'F10','-', & -! 'Fraction of roots in top 10 cm', & -! .TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) - ! Variables for SLI: - CALL define_ovar(ncid_restart,SID,'S','-',& - 'Fractional soil moisture content relative to saturated value', & - .TRUE.,soilID,'soil',0,0,0,mpID,dummy,.TRUE.) - CALL define_ovar(ncid_restart,TsoilID,'Tsoil','degC',& - 'Tsoil', & - .TRUE.,soilID,'soil',0,0,0,mpID,dummy,.TRUE.) - CALL define_ovar(ncid_restart,snowliqID,'snowliq','mm',& - 'liquid water content of snowpack', & - .TRUE.,snowID,'snow',0,0,0,mpID,dummy,.TRUE.) - CALL define_ovar(ncid_restart,scondsID,'sconds','Wm-1K-1',& - 'thermal cond of snowpack', & - .TRUE.,snowID,'snow',0,0,0,mpID,dummy,.TRUE.) - CALL define_ovar(ncid_restart,h0ID,'h0','m',& - 'Pond height above soil', & - .TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) - CALL define_ovar(ncid_restart,nsnowID,'nsnow','-',& - 'number of snow layers', & - .TRUE.,'integer',0,0,0,mpID,dummy,.TRUE.) - CALL define_ovar(ncid_restart,TsurfaceID,'Tsurface','degC',& - 'soil or snow surface T', & - .TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) - END IF ! SLI soil model - - ! Write global attributes for file: - CALL DATE_AND_TIME(todaydate, nowtime) - todaydate = todaydate(1:4)//'/'//todaydate(5:6)//'/'//todaydate(7:8) - nowtime = nowtime(1:2)//':'//nowtime(3:4)//':'//nowtime(5:6) - ok = NF90_PUT_ATT(ncid_restart, NF90_GLOBAL, "Production", & - TRIM(todaydate)//' at '//TRIM(nowtime)) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, 'Error writing global detail to ' & - //TRIM(frst_out)// ' (SUBROUTINE create_restart)') - ok = NF90_PUT_ATT(ncid_restart, NF90_GLOBAL, "Source", & - 'CABLE LSM restart file') - IF(ok /= NF90_NOERR) CALL nc_abort(ok, 'Error writing global detail to ' & - //TRIM(frst_out)// ' (SUBROUTINE create_restart)') - ok = NF90_PUT_ATT(ncid_restart, NF90_GLOBAL, "CABLE_input_file", & - TRIM(filename%met)) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, 'Error writing global detail to ' & - //TRIM(frst_out)// ' (SUBROUTINE create_restart)') - - ! End netcdf define mode: - ok = NF90_ENDDEF(ncid_restart) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, 'Error creating restart file ' & - //TRIM(frst_out)// '(SUBROUTINE create_restart)') - - ! Write time variable: - ok = NF90_PUT_VAR(ncid_restart, tvarID, REAL(REAL(ktau) * dels, r_2)) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, 'Error time variable to ' & - //TRIM(frst_out)// '(SUBROUTINE create_restart)') - - ! Write latitude and longitude variables: - ok = NF90_PUT_VAR(ncid_restart, latID, latitude) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, & - 'Error writing latitude variable to ' & - //TRIM(frst_out)// '(SUBROUTINE create_restart)') - ok = NF90_PUT_VAR(ncid_restart, lonID, longitude) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, & - 'Error writing longitude variable to ' & - //TRIM(frst_out)// '(SUBROUTINE create_restart)') - - ! Write number of active patches for each land grid cell: - ok = NF90_PUT_VAR(ncid_restart, napID, landpt(:)%nap) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, & - 'Error writing nap variable to ' & - //TRIM(frst_out)// '(SUBROUTINE create_restart)') - - ! Write vegetated patch fractions - ok = NF90_PUT_VAR(ncid_restart, rpid%patchfrac, & - patch(:)%frac, start = (/1/), count = (/mp/)) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, 'Error writing patchfrac to ' & - //TRIM(frst_out)// '(SUBROUTINE create_restart)') - - ! Write number of veg and soil types - ok = NF90_PUT_VAR(ncid_restart, rpid%mvtype,mvtype) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, & - 'Error writing mvtype parameter to ' & - //TRIM(frst_out)// '(SUBROUTINE create_restart)') - ok = NF90_PUT_VAR(ncid_restart, rpid%mstype,mstype) - IF(ok /= NF90_NOERR) CALL nc_abort(ok, & - 'Error writing mstype parameter to ' & - //TRIM(frst_out)// '(SUBROUTINE create_restart)') - - ! Write parameters: - !~ veg and soil - out_settings%dimswitch = "integer" - CALL check_and_write(rpid%iveg, & - 'iveg', REAL(veg%iveg, 4), ranges%iveg, patchout_var, out_settings) - CALL check_and_write(rpid%isoil, 'isoil', REAL(soil%isoilm, 4), & - ranges%isoil, patchout_var, out_settings) - out_settings%dimswitch = "real" -! CALL check_and_write(rpid%bch, 'bch', REAL(soil%bch, 4), & -! ranges%bch, patchout_var, out_settings) -! CALL check_and_write(rpid%bch, 'bch', REAL(soil%bch, 4), & -! ranges%bch, patchout_var, out_settings) -! CALL check_and_write(rpid%clay, 'clay', REAL(soil%clay, 4), & -! ranges%clay, patchout_var, out_settings) -! CALL check_and_write(rpid%sand, 'sand', REAL(soil%sand, 4), & -! ranges%sand, patchout_var, out_settings) -! CALL check_and_write(rpid%silt, 'silt', REAL(soil%silt, 4), & -! ranges%silt, patchout_var, out_settings) -! CALL check_and_write(rpid%css, 'css', REAL(soil%css, 4), & -! ranges%css, patchout_var, out_settings) -! CALL check_and_write(rpid%rhosoil, 'rhosoil', & -! REAL(soil%rhosoil, 4), ranges%rhosoil, patchout_var, & -! out_settings) -! CALL check_and_write(rpid%hyds, 'hyds', REAL(soil%hyds, 4), & -! ranges%hyds, patchout_var, out_settings) -! CALL check_and_write(rpid%sucs, 'sucs', REAL(soil%sucs, 4), & -! ranges%sucs, patchout_var, out_settings) -! CALL check_and_write(rpid%rs20, 'rs20', REAL(veg%rs20, 4), & -! ranges%rs20, patchout_var, out_settings) -! CALL check_and_write(rpid%ssat, 'ssat', REAL(soil%ssat, 4), & -! ranges%ssat, patchout_var, out_settings) -! CALL check_and_write(rpid%sfc, 'sfc', REAL(soil%sfc, 4), & -! ranges%sfc, patchout_var, out_settings) -! CALL check_and_write(rpid%swilt, 'swilt', REAL(soil%swilt, 4), & -! ranges%swilt, patchout_var, out_settings) - ! Soil dimensioned variables/parameters: - out_settings%dimswitch = "soil" -! CALL check_and_write(rpid%froot, 'froot', REAL(veg%froot, 4), & -! ranges%froot, patchout_var, out_settings) - - !~ ssnow - !~~ Soil dimensioned variables/parameters: - out_settings%dimswitch = "soil" - CALL check_and_write(tggID, 'tgg', REAL(ssnow%tgg, 4), & - ranges%SoilTemp, patchout_var, out_settings) - CALL check_and_write(wbID, 'wb', REAL(ssnow%wb, 4), ranges%SoilMoist, & - patchout_var, out_settings) - CALL check_and_write(wbiceID, 'wbice', REAL(ssnow%wbice, 4), & - ranges%SoilMoist, patchout_var, out_settings) - CALL check_and_write(gammzzID, 'gammzz', REAL(ssnow%gammzz, 4), & - ranges%default_l, patchout_var, out_settings) - !~~ Snow dimensioned variables/parameters: - out_settings%dimswitch = "snow" - CALL check_and_write(ssdnID, 'ssdn', REAL(ssnow%ssdn, 4), & - ranges%ssdn, patchout_var, out_settings) - CALL check_and_write(smassID, 'smass', REAL(ssnow%smass, 4), & - ranges%smass, patchout_var, out_settings) - CALL check_and_write(sdepthID, 'sdepth', REAL(ssnow%sdepth, 4), & - ranges%sdepth, patchout_var, out_settings) - CALL check_and_write(tggsnID, 'tggsn', REAL(ssnow%tggsn, 4), & - ranges%tggsn, patchout_var, out_settings) - !~~ Other dims - out_settings%dimswitch = "radiation" - CALL check_and_write(albsoilsnID, 'albsoilsn', & - REAL(ssnow%albsoilsn, 4), ranges%albsoiln, patchout_var, out_settings) - out_settings%dimswitch = "plantcarbon" - CALL check_and_write(cplantID, 'cplant', REAL(bgc%cplant, 4), & - ranges%default_l, patchout_var, out_settings) - out_settings%dimswitch = "soilcarbon" - CALL check_and_write(csoilID, 'csoil', REAL(bgc%csoil, 4), & - ranges%default_l, patchout_var, out_settings) - ok = NF90_PUT_VAR(ncid_restart, rpid%zse, REAL(soil%zse, 4)) - IF (ok /= NF90_NOERR) CALL nc_abort(ok, 'Error writing zse parameter to ' & - //TRIM(frst_out)//'(SUBROUTINE create_restart)') - ! Single dim: - out_settings%dimswitch = "radiation" - CALL check_and_write(rpid%albsoil, 'albsoil', & - REAL(soil%albsoil, 4), ranges%albsoil, patchout_var, out_settings) -! out_settings%dimswitch = "real" -! CALL check_and_write(rpid%canst1, 'canst1', REAL(veg%canst1, 4), & -! ranges%canst1, patchout_var, out_settings) -! CALL check_and_write(rpid%dleaf, 'dleaf', REAL(veg%dleaf, 4), & -! ranges%dleaf, patchout_var, out_settings) -! CALL check_and_write(rpid%ejmax, 'ejmax', REAL(veg%ejmax, 4), & -! ranges%ejmax, patchout_var, out_settings) -! CALL check_and_write(rpid%vcmax, 'vcmax', REAL(veg%vcmax, 4), & -! ranges%vcmax, patchout_var, out_settings) -! CALL check_and_write(rpid%frac4, 'frac4', REAL(veg%frac4, 4), & -! ranges%frac4, patchout_var, out_settings) -! CALL check_and_write(rpid%hc, 'hc', REAL(veg%hc, 4), & -! ranges%hc, patchout_var, out_settings) -! CALL check_and_write(rpid%rp20, 'rp20', REAL(veg%rp20, 4), & -! ranges%rp20, patchout_var, out_settings) -! CALL check_and_write(rpid%g0, 'g0', REAL(veg%g0, 4), & -! ranges%g0, patchout_var, out_settings) ! Ticket #56 -! CALL check_and_write(rpid%g1, 'g1', REAL(veg%g1, 4), & -! ranges%g1, patchout_var, out_settings) ! Ticket #56 -! CALL check_and_write(rpid%rpcoef, 'rpcoef', REAL(veg%rpcoef, 4), & -! ranges%rpcoef, patchout_var, out_settings) -! CALL check_and_write(rpid%shelrb, 'shelrb', REAL(veg%shelrb, 4), & -! ranges%shelrb, patchout_var, out_settings) -! CALL check_and_write(rpid%xfang, 'xfang', REAL(veg%xfang, 4), & -! ranges%xfang, patchout_var, out_settings) -! CALL check_and_write(rpid%wai, 'wai', REAL(veg%wai, 4), & -! ranges%wai, patchout_var, out_settings) -! CALL check_and_write(rpid%vegcf, 'vegcf', REAL(veg%vegcf, 4), & -! ranges%vegcf, patchout_var, out_settings) -! CALL check_and_write(rpid%extkn, 'extkn', REAL(veg%extkn, 4), & -! ranges%extkn, patchout_var, out_settings) -! CALL check_and_write(rpid%tminvj, 'tminvj', REAL(veg%tminvj, 4), & -! ranges%tminvj, patchout_var, out_settings) -! CALL check_and_write(rpid%tmaxvj, 'tmaxvj', REAL(veg%tmaxvj, 4), & -! ranges%tmaxvj, patchout_var, out_settings) -! CALL check_and_write(rpid%vbeta, 'vbeta', REAL(veg%vbeta, 4), & -! ranges%vbeta, patchout_var, out_settings) -! CALL check_and_write(rpid%xalbnir, 'xalbnir', & -! REAL(veg%xalbnir, 4), ranges%xalbnir, patchout_var, & -! out_settings) -! CALL check_and_write(rpid%tmaxvj, 'tmaxvj', REAL(veg%tmaxvj, 4), & -! ranges%tmaxvj, patchout_var, out_settings) -! ok = NF90_PUT_VAR(rpid%ratecp, REAL(bgc%ratecp, 4)) -! IF (ok /= NF90_NOERR) CALL nc_abort(ok, & -! 'Error writing ratecp parameter to ' & -! //TRIM(frst_out)//'(SUBROUTINE create_restart)') -! ok = NF90_PUT_VAR(rpid%ratecs, REAL(bgc%ratecs, 4)) -! IF (ok /= NF90_NOERR) CALL nc_abort(ok, & -! 'Error writing ratecs parameter to ' & -! //TRIM(frst_out)//'(SUBROUTINE create_restart)') -! out_settings%dimswitch = "integer" -! CALL check_and_write(rpid%meth, 'meth', REAL(veg%meth, 4), & -! ranges%meth, patchout_var, out_settings) -! out_settings%dimswitch = "real" -! CALL check_and_write(rpid%za_uv, 'za_uv', REAL(rough%za_uv, 4), & -! ranges%za, patchout_var, out_settings) -! CALL check_and_write(rpid%za_tq, 'za_tq', REAL(rough%za_tq, 4), & -! ranges%za, patchout_var, out_settings) - out_settings%dimswitch = "r2" - CALL check_and_write(dgdtgID, 'dgdtg', REAL(canopy%dgdtg, 4), & - ranges%default_l, patchout_var, out_settings) - out_settings%dimswitch = "integer" - CALL check_and_write(isflagID, 'isflag', REAL(ssnow%isflag, 4), & - ranges%default_l, patchout_var, out_settings) - out_settings%dimswitch = "real" - CALL check_and_write(gwID, 'GWwb', REAL(ssnow%GWwb, 4), & - ranges%GWwb, patchout_var, out_settings) - CALL check_and_write(tssID, 'tss', REAL(ssnow%tss, 4), & - ranges%default_l, patchout_var, out_settings) - CALL check_and_write(ssdnnID, 'ssdnn', REAL(ssnow%ssdnn, 4), & - ranges%default_l, patchout_var, out_settings) - CALL check_and_write(osnowdID, 'osnowd', REAL(ssnow%osnowd, 4), & - ranges%default_l, patchout_var, out_settings) - CALL check_and_write(snageID, 'snage', REAL(ssnow%snage, 4), & - ranges%default_l, patchout_var, out_settings) - CALL check_and_write(snowdID, 'snowd', REAL(ssnow%snowd, 4), & - ranges%default_l, patchout_var, out_settings) - CALL check_and_write(rtsoilID, 'rtsoil', REAL(ssnow%rtsoil, 4), & - ranges%default_l, patchout_var, out_settings) - CALL check_and_write(canstoID, 'cansto', REAL(canopy%cansto, 4), & - ranges%default_l, patchout_var, out_settings) - CALL check_and_write(sghfluxID, 'sghflux', & - REAL(canopy%sghflux, 4), ranges%default_l, & - patchout_var, out_settings) - CALL check_and_write(ghfluxID, 'ghflux', REAL(canopy%ghflux, 4), & - ranges%default_l, patchout_var, out_settings) - CALL check_and_write(runoffID, 'runoff', REAL(ssnow%runoff, 4), & - ranges%default_l, patchout_var, out_settings) - CALL check_and_write(rnof1ID, 'rnof1', REAL(ssnow%rnof1, 4), & - ranges%default_l, patchout_var, out_settings) - CALL check_and_write(rnof2ID, 'rnof2', REAL(ssnow%rnof2, 4), & - ranges%default_l, patchout_var, out_settings) - CALL check_and_write(gaID, 'ga', REAL(canopy%ga, 4), & - ranges%default_l, patchout_var, out_settings) - CALL check_and_write(fevID, 'fev', REAL(canopy%fev, 4), & - ranges%default_l, patchout_var, out_settings) - CALL check_and_write(fesID, 'fes', REAL(canopy%fes, 4), & - ranges%default_l, patchout_var, out_settings) - CALL check_and_write(fhsID, 'fhs', REAL(canopy%fhs, 4), & - ranges%default_l, patchout_var, out_settings) - CALL check_and_write(wbtot0ID, 'wbtot0', REAL(bal%wbtot0, 4), & - ranges%default_l, patchout_var, out_settings) - CALL check_and_write(osnowd0ID, 'osnowd0', REAL(bal%osnowd0, 4), & - ranges%default_l, patchout_var, out_settings) - - !~ Radiation - out_settings%dimswitch = "radiation" - CALL check_and_write(albedoID, 'albedo', REAL(rad%albedo, 4), & - ranges%Albedo, patchout_var, out_settings) - out_settings%dimswitch = "real" - CALL check_and_write(tradID, 'trad', & - REAL(rad%trad, 4), ranges%RadT, patchout_var, out_settings) - -! IF (cable_user%SOIL_STRUC == 'sli' .OR. cable_user%FWSOIL_SWITCH == 'Haverd2013') THEN -! CALL check_and_write(rpid%gamma, 'gamma', & -! REAL(veg%gamma, 4), ranges%default_s, patchout_var, out_settings) -! END IF -! - - IF (cable_user%SOIL_STRUC == 'sli') THEN - ! Write SLI parameters: - out_settings%dimswitch = "integer" -! CALL check_and_write(rpid%nhorizons, 'nhorizons', & -! REAL(soil%nhorizons, 4), ranges%default_s, patchout_var, out_settings) - CALL check_and_write(nsnowID, 'nsnow', REAL(ssnow%nsnow, 4), & - ranges%default_s, patchout_var, out_settings) - out_settings%dimswitch = "soil" -! CALL check_and_write(rpid%ishorizon, 'ishorizon', & -! REAL(soil%ishorizon, 4), ranges%default_s, patchout_var, out_settings) - CALL check_and_write(SID, 'S', REAL(ssnow%S, 4), & - ranges%S, patchout_var, out_settings) - CALL check_and_write(TsoilID, 'Tsoil', REAL(ssnow%Tsoil, 4), & - ranges%Tsoil, patchout_var, out_settings) - out_settings%dimswitch = "real" -! CALL check_and_write(rpid%clitt, 'clitt', & -! REAL(veg%clitt, 4), ranges%default_s, patchout_var, out_settings) -! CALL check_and_write(rpid%ZR, 'ZR', & -! REAL(veg%ZR, 4), ranges%default_s, patchout_var, out_settings) -! CALL check_and_write(rpid%F10, 'F10', & -! REAL(veg%F10, 4), ranges%default_s, patchout_var, out_settings) - CALL check_and_write(TsurfaceID, 'Tsurface', REAL(ssnow%Tsurface, 4), & - ranges%default_s, patchout_var, out_settings) - CALL check_and_write(h0ID, 'h0', REAL(ssnow%h0, 4), & - ranges%default_s, patchout_var, out_settings) - out_settings%dimswitch = "snow" - CALL check_and_write(snowliqID, 'snowliq', REAL(ssnow%snowliq, 4), & - ranges%default_s, patchout_var, out_settings) - CALL check_and_write(scondsID, 'sconds', REAL(ssnow%sconds, 4), & - ranges%default_s, patchout_var, out_settings) - END IF - - ! Close restart file - ok = NF90_CLOSE(ncid_restart) - - WRITE (logn, '(A36)') ' Restart file complete and closed.' - - END SUBROUTINE create_restart - - -END MODULE cable_output_module diff --git a/src/offline/cable_serial.F90 b/src/offline/cable_serial.F90 index d890f7623..d61137d9e 100644 --- a/src/offline/cable_serial.F90 +++ b/src/offline/cable_serial.F90 @@ -30,18 +30,14 @@ ! ! CALLs: open_met_file ! load_parameters -! open_output_file ! get_met_data ! casa_feedback ! cbm ! bgcdriver ! sumcflux -! write_output ! casa_poolout ! casa_fluxout -! create_restart ! close_met_file -! close_output_file ! prepareFiles ! ! @@ -75,12 +71,13 @@ MODULE cable_serial LUCdriver, & compare_consistency_check_values USE cable_mpi_mod, ONLY: mpi_grp_t + USE cable_timing_mod, ONLY: cable_timing_set_start_year USE cable_def_types_mod USE cable_IO_vars_module, ONLY: logn,gswpfile,ncciy,leaps, & fixedCO2,output,check,& patch_type,landpt,& defaultLAI, sdoy, smoy, syear, timeunits, calendar, & - NO_CHECK + NO_CHECK, verbose, patch USE casa_ncdf_module, ONLY: is_casa_time USE cable_common_module, ONLY: ktau_gl, kend_gl, knode_gl, cable_user, & filename, myhome, & @@ -107,10 +104,18 @@ MODULE cable_serial ncid_qa, & ncid_ta, & ncid_wd,ncid_mask - USE cable_output_module, ONLY: create_restart,open_output_file, & - write_output,close_output_file - USE cable_checks_module, ONLY: constant_check_range - USE cable_write_module, ONLY: nullify_write + USE cable_checks_module, ONLY: constant_check_range, mass_balance, energy_balance + use cable_output_mod, only: cable_output_mod_init + use cable_output_mod, only: cable_output_mod_end + use cable_output_mod, only: cable_output_register_output_variables + use cable_output_mod, only: cable_output_init_streams + use cable_output_mod, only: cable_output_update + use cable_output_mod, only: cable_output_write + use cable_output_mod, only: cable_output_write_parameters + use cable_output_mod, only: cable_output_write_restart + use cable_diagnostics_mod, only: cable_diagnostics + use cable_diagnostics_casa_mod, only: cable_diagnostics_casa + use cable_netcdf_mod, only: cable_netcdf_mod_init, cable_netcdf_mod_end USE cable_IO_vars_module, ONLY: timeunits,calendar USE cable_cbm_module, ONLY : cbm !mpidiff @@ -273,6 +278,9 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi ! INISTUFF + call cable_netcdf_mod_init(mpi_grp) + + call cable_timing_set_start_year(cable_user%YearStart) ! outer loop - spinup loop no. ktau_tot : ktau = 0 @@ -417,8 +425,13 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi TRIM(cable_user%RunIden)//'_cable_out.nc' ENDIF ENDIF - CALL nullify_write() ! nullify pointers - CALL open_output_file( dels, soil, veg, bgc, rough, met, casamet) + call cable_output_mod_init() + call cable_output_register_output_variables([ & + cable_diagnostics(met, canopy, soil, ssnow, rad, veg, bal, rough, bgc, dels=dels), & + cable_diagnostics_casa(casaflux, casapool, casamet) & + ]) + call cable_output_init_streams(dels) + call cable_output_write_parameters(kstart, patch, landpt) ENDIF ssnow%otss_0 = ssnow%tgg(:,1) @@ -591,9 +604,8 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi ssnow%rnof2 = ssnow%rnof2*dels ssnow%runoff = ssnow%runoff*dels - - - + call canopy%tscrn_max_daily%accumulate() + call canopy%tscrn_min_daily%accumulate() ELSE IF ( IS_CASA_TIME("dread", yyyy, ktau, kstart, & koffset, kend, ktauday, logn) ) THEN ! CLN READ FROM FILE INSTEAD ! @@ -709,17 +721,29 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi ! or we're spinning up and the spinup has converged: IF ( (.NOT. CASAONLY) .AND. spinConv ) THEN + + IF(check%mass_bal) CALL mass_balance(dels, ktau, ssnow, soil, canopy, & + met,air,bal) + + IF(check%energy_bal) CALL energy_balance(dels, ktau, met, rad, canopy, & + bal,ssnow, CSBOLTZ, CEMLEAF, CEMSOIL ) + !mpidiff SELECT CASE (TRIM(cable_user%MetType)) CASE ('plum', 'cru', 'bios', 'gswp', 'gswp3', 'site') - CALL write_output( dels, ktau_tot, met, canopy, casaflux, casapool, & - ssnow, rad, bal, air, soil, veg, CSBOLTZ, CEMLEAF, CEMSOIL ) + call cable_output_update(ktau_tot, dels, met) + call cable_output_write(ktau_tot, dels, met, patch, landpt) CASE DEFAULT - CALL write_output( dels, ktau, met, canopy, casaflux, casapool, & - ssnow, rad, bal, air, soil, veg, CSBOLTZ, CEMLEAF, CEMSOIL ) + call cable_output_update(ktau, dels, met) + call cable_output_write(ktau, dels, met, patch, landpt) END SELECT ENDIF + IF (.not. casaonly .and. ktau > kstart .and. mod(ktau - kstart + 1, ktauday) == 0) THEN + ! Reset daily aggregators if it is the end of day + CALL canopy%tscrn_max_daily%reset() + CALL canopy%tscrn_min_daily%reset() + END IF ! Check triggered by cable_user%consistency_check = .TRUE. in cable.nml IF(cable_user%consistency_check) THEN @@ -921,10 +945,25 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi l_landuse=.false. IF ( SpinConv .AND. .NOT. CASAONLY ) THEN - ! Close output file and deallocate main variables: - CALL close_output_file( bal, air, bgc, canopy, met, & - rad, rough, soil, ssnow, & - sum_flux, veg ) + ! Report balance info to log file if verbose writing is requested: + IF(output%balances .AND. verbose) THEN + WRITE(logn, *) + DO i = 1, mland + WRITE(logn, '(A51,I7,1X,A11,E12.4,A6)') & + ' Cumulative energy balance for each patch in site #', & + i,'is (W/m^2):' + WRITE(logn, *) & + bal%ebal_tot(landpt(i)%cstart:landpt(i)%cstart + & + landpt(i)%nap - 1) + WRITE(logn,'(A50,I7,1X,A8,E12.4,A3)') & + ' Cumulative water balance for each patch in site #', & + i,'is (mm):' + WRITE(logn, *) & + bal%wbal_tot(landpt(i)%cstart:landpt(i)%cstart + & + landpt(i)%nap - 1) + WRITE(logn, *) + END DO + END IF ENDIF IF ( cable_user%CALL_POP.AND.POP%np.GT.0 ) THEN @@ -1000,9 +1039,9 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi IF ( .NOT. CASAONLY.and. .not. l_landuse ) THEN ! Write restart file if requested: - IF(output%restart) & - CALL create_restart( logn, dels, ktau, soil, veg, ssnow, & - canopy, rough, rad, bgc, bal, met ) + IF(output%restart) then + call cable_output_write_restart(current_time=ktau * dels) + end if !mpidiff IF (cable_user%CALL_climate) & CALL WRITE_CLIMATE_RESTART_NC ( climate, ktauday ) @@ -1010,7 +1049,9 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi !--- LN ------------------------------------------[ ENDIF + if (.not. casaonly) call cable_output_mod_end() + call cable_netcdf_mod_end() IF ( TRIM(cable_user%MetType) .NE. "gswp" .AND. & TRIM(cable_user%MetType) .NE. "gswp3" .AND. & diff --git a/src/offline/cable_write.F90 b/src/offline/cable_write.F90 deleted file mode 100644 index 56a1fb4e8..000000000 --- a/src/offline/cable_write.F90 +++ /dev/null @@ -1,1880 +0,0 @@ -!============================================================================== -! This source code is part of the -! Australian Community Atmosphere Biosphere Land Exchange (CABLE) model. -! This work is licensed under the CSIRO Open Source Software License -! Agreement (variation of the BSD / MIT License). -! -! You may not use this file except in compliance with this License. -! A copy of the License (CSIRO_BSD_MIT_License_v2.0_CABLE.txt) is located -! in each directory containing CABLE code. -! -! ============================================================================== -! Purpose: Writing routines for CABLE offline -! -! Contact: Bernard.Pak@csiro.au -! -! History: No significant changes since v1.4b except addition of extra variables -! -! -! ============================================================================== -! -! CALLed from: cable_initialise.F90 -! cable_input.F90 -! -! MODULEs used: cable_abort_module -! cable_def_types_mod -! cable_IO_vars_module -! netcdf -! -! CALLs: define_output_variable_r1 -! define_output_variable_r2 -! define_output_parameter_r1 -! define_output_parameter_r2 -! write_output_variable_r1 -! write_output_variable_r2 -! write_output_parameter_r1 -! write_output_parameter_r1d -! write_output_parameter_r2 -! write_output_parameter_r2d -! -! -! -! Notes: Single precision netcdf writes are forced to single precision here -! (using REAL(,4)) in case of compilation with -r8 - -MODULE cable_write_module - - - USE cable_abort_module, ONLY: nc_abort, abort - USE cable_def_types_mod - USE cable_IO_vars_module, ONLY: landpt, patch, max_vegpatches, parID_type, & - metGrid, land_x, land_y, logn, output, & - xdimsize, ydimsize, mask - USE netcdf - IMPLICIT NONE - PRIVATE - PUBLIC define_ovar, write_ovar, otmp1, otmp1l, otmp2lt, otmp2xy, otmp2lp, & - otmp2ls, otmp2lpc, otmp2lsc, otmp2lsf, otmp2lr, otmp2lsn, otmp3xyt, & - otmp3lpt, otmp3lst, otmp3lsnt, otmp3lrt, otmp3lpct, otmp3lsct, & - otmp3xyp, otmp3xys, otmp3xypc, otmp3xysc, otmp3lps, otmp3lppc, & - otmp3lpsc, otmp3xysf, otmp3lpr, otmp3lpsn, otmp4xypt, otmp4xyzt, & - otmp4xyst, otmp4xysnt, otmp4xyrt, otmp4xypct, otmp4xysct, otmp4lpst, & - otmp4lpsnt, otmp4lprt, otmp4lpsct, otmp4lppct, otmp4xyps, & - otmp4xyppc, otmp4xypsc, otmp5xypst, otmp5xypsnt, otmp5xyprt, & - otmp5xyppct, otmp5xypsct, nullify_write - INTERFACE define_ovar - ! Defines an output variable in the output netcdf file. Units, long name, - ! variable, dimensions etc are created. - MODULE PROCEDURE define_output_variable_r1 - MODULE PROCEDURE define_output_variable_r2 - MODULE PROCEDURE define_output_parameter_r1 - MODULE PROCEDURE define_output_parameter_r2 - END INTERFACE - INTERFACE write_ovar - ! Writes a single time step of an output variable to the output netcdf - ! file - MODULE PROCEDURE write_output_variable_r1 - MODULE PROCEDURE write_output_variable_r2 - MODULE PROCEDURE write_output_parameter_r1 - MODULE PROCEDURE write_output_parameter_r1d - MODULE PROCEDURE write_output_parameter_r2 - MODULE PROCEDURE write_output_parameter_r2d - END INTERFACE - - INTEGER :: ncmissingi = -9999999 - INTEGER :: ok ! netcdf file read status - - ! Temporary variables of same dimension as variables in netcdf file; - ! e.g. 'o'utput 'tmp'orary with '2' dimensions: 'l'and and 't'ime -> otmp2lt - ! Other dimension abbrevs: 'x','y','z','p'atch,'s'oil,'sn'ow, - ! 'r'adiation,'p'lant 'c'arbon,'s'oil 'c'arbon,'s'urface 'f'raction - REAL, POINTER, DIMENSION(:) :: otmp1, otmp1l - REAL, POINTER, DIMENSION(:, :) :: otmp2lt, otmp2xy, otmp2lp, otmp2ls, & - otmp2lpc, otmp2lsc, otmp2lsf, & - otmp2lr, otmp2lsn - REAL, POINTER, DIMENSION(:, :, :) :: otmp3xyt, otmp3lpt, otmp3lst, & - otmp3lsnt, otmp3lrt, otmp3lpct, & - otmp3lsct, otmp3xyp, otmp3xys, & - otmp3xypc, otmp3xysc, otmp3lps, & - otmp3lppc, otmp3lpsc, otmp3xysf, & - otmp3lpr, otmp3lpsn, otmp3xyr - REAL, POINTER, DIMENSION(:, :, :, :) :: otmp4xypt, otmp4xyzt, & - otmp4xyst, otmp4xysnt, & - otmp4xyrt, otmp4xypct, & - otmp4xysct, otmp4lpst, & - otmp4lpsnt, otmp4lprt, & - otmp4lpsct, otmp4lppct, & - otmp4xyps, otmp4xyppc, & - otmp4xypsc, otmp4xypr - REAL, POINTER, DIMENSION(:, :, :, :, :) :: otmp5xypst, otmp5xypsnt, & - otmp5xyprt, otmp5xyppct, & - otmp5xypsct - REAL :: ncmissingr = -1.0e+33 - -CONTAINS - - ! Nullify all temporary pointers so that one can query associated(pointer) - SUBROUTINE nullify_write() - IMPLICIT NONE - - NULLIFY(otmp1) - NULLIFY(otmp1l) - - NULLIFY(otmp2lt) - NULLIFY(otmp2xy) - NULLIFY(otmp2lp) - NULLIFY(otmp2ls) - NULLIFY(otmp2lpc) - NULLIFY(otmp2lsc) - NULLIFY(otmp2lsf) - NULLIFY(otmp2lr) - NULLIFY(otmp2lsn) - - NULLIFY(otmp3xyt) - NULLIFY(otmp3lpt) - NULLIFY(otmp3lst) - NULLIFY(otmp3lsnt) - NULLIFY(otmp3lrt) - NULLIFY(otmp3lpct) - NULLIFY(otmp3lsct) - NULLIFY(otmp3xyp) - NULLIFY(otmp3xys) - NULLIFY(otmp3xypc) - NULLIFY(otmp3xysc) - NULLIFY(otmp3lps) - NULLIFY(otmp3lppc) - NULLIFY(otmp3lpsc) - NULLIFY(otmp3xysf) - NULLIFY(otmp3lpr) - NULLIFY(otmp3lpsn) - NULLIFY(otmp3xyr) - - NULLIFY(otmp4xypt) - NULLIFY(otmp4xyzt) - NULLIFY(otmp4xyst) - NULLIFY(otmp4xysnt) - NULLIFY(otmp4xyrt) - NULLIFY(otmp4xypct) - NULLIFY(otmp4xysct) - NULLIFY(otmp4lpst) - NULLIFY(otmp4lpsnt) - NULLIFY(otmp4lprt) - NULLIFY(otmp4lpsct) - NULLIFY(otmp4lppct) - NULLIFY(otmp4xyps) - NULLIFY(otmp4xyppc) - NULLIFY(otmp4xypsc) - NULLIFY(otmp4xypr) - - NULLIFY(otmp5xypst) - NULLIFY(otmp5xypsnt) - NULLIFY(otmp5xyprt) - NULLIFY(otmp5xyppct) - NULLIFY(otmp5xypsct) - - END SUBROUTINE nullify_write - - SUBROUTINE define_output_variable_r1(ncid, varID, vname, & - vunits, longname, writepatch, & - dimswitch, xID, yID, zID, landID, & - patchID, tID) - ! Subroutine for defining a real valued 1D variable - INTEGER, INTENT(IN) :: ncid ! netcdf file ID - INTEGER, INTENT(OUT) :: varID ! variable's netcdf ID - ! netcdf dimension IDs - INTEGER, INTENT(IN) :: xID, yID, zID, landID, patchID, tID - LOGICAL, INTENT(IN) :: writepatch ! write patch-specific info for this var? - CHARACTER(LEN=*), INTENT(IN) :: vname ! name of variable - CHARACTER(LEN=*), INTENT(IN) :: vunits ! variable units - CHARACTER(LEN=*), INTENT(IN) :: longname ! full variable name - CHARACTER(LEN=*), INTENT(IN) :: dimswitch ! indicates dimesnion of parameter - - ! First, decide which grid to use. If user has forced grid using output%grid - ! in the namelist file, use this grid. Else use format of met file. - IF(output%grid(1:3) == 'mas' .OR. & - (output%grid(1:3) == 'def' .AND. metGrid == 'mask') .OR. & - output%grid(1:3) == 'ALM') THEN - ! Should patch-specific info be written for this variable - ! (no patches in ALMA format)? - IF((writepatch .OR. output%patch) .AND. & - (.NOT. output%grid(1:3) == 'ALM')) THEN - WRITE(logn, *) 'Writing '//vname// & - ' to output file using mask grid with patch-specific info' - ok = NF90_DEF_VAR(ncid, vname, NF90_FLOAT, (/xID, yID, patchID, tID/), & - varID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//vname//' variable in output file. '// & - '(INTERFACE define_ovar)') - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF(.NOT.ASSOCIATED(otmp4xypt)) & - ALLOCATE(otmp4xypt(xdimsize, ydimsize, max_vegpatches, 1)) - ELSE ! only grid point values, no patch-specific info - ! If this is an ALMA 4D surface variable - ! AND the user has forced the grid type as ALMA: - IF(dimswitch == 'ALMA' .AND. output%grid(1:3) == 'ALM') THEN - WRITE(logn, *) 'Writing '//vname//' to output file using mask grid' - ok = NF90_DEF_VAR(ncid, vname, NF90_FLOAT, (/xID, yID, zID, tID/), & - varID) - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF(.NOT.ASSOCIATED(otmp4xyzt)) & - ALLOCATE(otmp4xyzt(xdimsize, ydimsize, 1, 1)) - ELSE ! normal x-y-t mask grid - WRITE(logn, *) 'Writing '//vname//' to output file using mask grid' - ok = NF90_DEF_VAR(ncid, vname, NF90_FLOAT, (/xID, yID, tID/), varID) - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF(.NOT.ASSOCIATED(otmp3xyt))ALLOCATE(otmp3xyt(xdimsize, ydimsize, 1)) - END IF - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//vname//' variable in output file. '// & - '(INTERFACE define_ovar)') - END IF - ELSE IF(output%grid(1:3) == 'lan' & - .OR.(output%grid(1:3) == 'def' .AND. metGrid == 'land')) THEN - ! Should patch-specific info be written for this variable? - IF(writepatch .OR. output%patch) THEN - WRITE(logn, *) 'Writing '//vname// & - ' to output file using land grid with patch-specific info' - ok = NF90_DEF_VAR(ncid, vname, NF90_FLOAT, (/landID, patchID, tID/), & - varID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok,'Error defining '//vname//' variable in output file. '// & - '(INTERFACE define_ovar)') - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp3lpt)) ALLOCATE(otmp3lpt(mland, & - max_vegpatches, 1)) - ELSE ! only grid point values, no patch-specific info - WRITE(logn, *) 'Writing '//vname//' to output file using land grid' - ok = NF90_DEF_VAR(ncid, vname, NF90_FLOAT, (/landID,tID/), varID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//vname//' variable in output file. '// & - '(INTERFACE define_ovar)') - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp2lt)) ALLOCATE(otmp2lt(mland, 1)) - END IF - ELSE - CALL abort('Unknown grid specification (INTERFACE define_ovar)') - END IF - ! Define variable units: - ok = NF90_PUT_ATT(ncid, varID, 'units', vunits) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//vname//' variable attributes in output file. '// & - '(INTERFACE define_ovar)') - ! Define long name: - ok = NF90_PUT_ATT(ncid,varID, 'long_name', longname) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//vname//' variable attributes in output file. '// & - '(INTERFACE define_ovar)') - ! Define missing/fill values: - ok = NF90_PUT_ATT(ncid, varID, '_FillValue', REAL(ncmissingr, 4)) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//vname//' variable attributes in output file. '// & - '(INTERFACE define_ovar)') - ! Define missing/fill values: - ok = NF90_PUT_ATT(ncid, varID, 'missing_value', REAL(ncmissingr, 4)) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//vname//' variable attributes in output file. '// & - '(INTERFACE define_ovar)') - - END SUBROUTINE define_output_variable_r1 - !============================================================================= - SUBROUTINE define_output_variable_r2(ncid, varID, vname, vunits, longname, & - writepatch, dimswitch, xID, yID, zID, & - landID, patchID, othdimID, tID) - ! Subroutine for defining a real valued 2D variable - INTEGER, INTENT(IN) :: ncid ! netcdf file ID - ! netcdf dimension IDs - INTEGER, INTENT(IN) :: xID, yID, zID, landID, patchID, tID - INTEGER, INTENT(IN) :: othdimID ! ID of variable's second dimension - INTEGER, INTENT(OUT) :: varID ! variable's netcdf ID - LOGICAL, INTENT(IN) :: writepatch ! write patch-specific info for this var? - CHARACTER(LEN=*), INTENT(IN) :: vname ! name of variable - CHARACTER(LEN=*), INTENT(IN) :: vunits ! variable units - CHARACTER(LEN=*), INTENT(IN) :: longname ! full variable name - CHARACTER(LEN=*), INTENT(IN) :: dimswitch ! indicates dimesnion of parameter - - ! First, decide which grid to use. If user has forced grid using output%grid - ! in the namelist file, use this grid. Else use format of met file. - IF(output%grid(1:3) == 'mas' .OR. & - (output%grid(1:3) == 'def' .AND. metGrid == 'mask') .OR. & - output%grid(1:3) == 'ALM') THEN - ! Should patch-specific info be written for this variable - ! (no patches in ALMA format)? - IF((writepatch .OR. output%patch) .AND. & - ( .NOT. output%grid(1:3) == 'ALM')) THEN - WRITE(logn, *) 'Writing '//vname// & - ' to output file using mask grid with patch-specific info' - ok = NF90_DEF_VAR(ncid, vname, NF90_FLOAT, (/xID, yID, patchID, & - othdimID, tID/), varID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//vname//' variable in output file. '// & - '(INTERFACE define_ovar)') - IF(dimswitch == 'soil') THEN ! other dim is soil - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp5xypst)) & - ALLOCATE(otmp5xypst(xdimsize, ydimsize, max_vegpatches, ms, 1)) - ELSE IF(dimswitch == 'snow') THEN ! other dim is snow - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp5xypsnt)) & - ALLOCATE(otmp5xypsnt(xdimsize, ydimsize, max_vegpatches, msn, 1)) - ELSE IF(dimswitch == 'radiation') THEN ! other dim is radiation bands - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp5xyprt)) & - ALLOCATE(otmp5xyprt(xdimsize, ydimsize, max_vegpatches, nrb, 1)) - ELSE IF(dimswitch == 'plantcarbon') THEN ! other dim is plant carbon - ! pools - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp5xyppct)) & - ALLOCATE(otmp5xyppct(xdimsize, ydimsize, max_vegpatches, ncp, 1)) - ELSE IF(dimswitch == 'soilcarbon') THEN ! other dim is soil carbon pools - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp5xypsct)) & - ALLOCATE(otmp5xypsct(xdimsize, ydimsize, max_vegpatches, ncs, 1)) - ELSE - CALL abort('Variable '//vname// & - ' defined with unknown dimension switch - '//dimswitch// & - ' - in SUBROUTINE define_output_variable_r2') - END IF - ELSE ! only grid point values, no patch-specific info - WRITE(logn, *) 'Writing '//vname//' to output file using mask grid' - ok = NF90_DEF_VAR(ncid, vname, NF90_FLOAT, (/xID, yID, othdimID, & - tID/), varID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//vname//' variable in output file. '// & - '(SUBROUTINE define_output_variable_r2)') - IF(dimswitch == 'soil') THEN ! other dim is soil - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp4xyst)) & - ALLOCATE(otmp4xyst(xdimsize, ydimsize, ms, 1)) - ELSE IF(dimswitch == 'snow') THEN ! other dim is snow - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp4xysnt)) & - ALLOCATE(otmp4xysnt(xdimsize, ydimsize, msn, 1)) - ELSE IF(dimswitch == 'radiation') THEN ! other dim is radiation bands - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp4xyrt)) & - ALLOCATE(otmp4xyrt(xdimsize, ydimsize, nrb, 1)) - ELSE IF(dimswitch == 'plantcarbon') THEN ! other dim is plant carbon - ! pools - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp4xypct)) & - ALLOCATE(otmp4xypct(xdimsize, ydimsize, ncp, 1)) - ELSE IF(dimswitch == 'soilcarbon') THEN ! other dim is soil carbon pools - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp4xysct)) & - ALLOCATE(otmp4xysct(xdimsize, ydimsize, ncs, 1)) - ELSE - CALL abort('Variable '//vname// & - ' defined with unknown dimension switch - '//dimswitch// & - ' - in SUBROUTINE define_output_variable_r2') - END IF - END IF - ELSE IF(output%grid(1:3) == 'lan' & - .OR. (output%grid(1:3) == 'def' .AND. metGrid == 'land')) THEN - ! Should patch-specific info be written for this variable? - IF(writepatch .OR. output%patch) THEN - WRITE(logn, *) 'Writing '//vname// & - ' to output file using land grid with patch-specific info' - ok = NF90_DEF_VAR(ncid, vname, NF90_FLOAT, (/landID, patchID, & - othdimID, tID/), varID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//vname//' variable in output file. '// & - '(SUBROUTINE define_output_variable_r2)') - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok,'Error defining '//vname//' variable in output file. '// & - '(SUBROUTINE define_output_variable_r2)') - IF(dimswitch == 'soil') THEN ! other dim is soil - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp4lpst)) & - ALLOCATE(otmp4lpst(mland, max_vegpatches, ms, 1)) - ELSE IF(dimswitch == 'snow') THEN ! other dim is snow - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp4xysnt)) & - ALLOCATE(otmp4xysnt(mland, max_vegpatches, msn, 1)) - ELSE IF(dimswitch == 'radiation') THEN ! other dim is radiation bands - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp4xyrt)) & - ALLOCATE(otmp4xyrt(mland, max_vegpatches, nrb, 1)) - ELSE IF(dimswitch == 'plantcarbon') THEN ! other dim is plant carbon - ! pools - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp4xypct)) & - ALLOCATE(otmp4xypct(mland, max_vegpatches, ncp, 1)) - ELSE IF(dimswitch == 'soilcarbon') THEN ! other dim is soil carbon pools - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp4xysct)) & - ALLOCATE(otmp4xysct(mland, max_vegpatches, ncs, 1)) - ELSE - CALL abort('Variable '//vname// & - ' defined with unknown dimension switch - '//dimswitch// & - ' - in SUBROUTINE define_output_variable_r2') - END IF - ELSE ! only grid point values, no patch-specific info - WRITE(logn, *) 'Writing '//vname//' to output file using land grid' - ok = NF90_DEF_VAR(ncid, vname, NF90_FLOAT, (/landID, othdimID, tID/), & - varID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//vname//' variable in output file. '// & - '(SUBROUTINE define_output_variable_r2)') - IF(dimswitch == 'soil') THEN ! other dim is soil - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp3lst)) ALLOCATE(otmp3lst(mland, ms, 1)) - ELSE IF(dimswitch == 'snow') THEN ! other dim is snow - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp3lsnt)) ALLOCATE(otmp3lsnt(mland, msn, 1)) - ELSE IF(dimswitch == 'radiation') THEN ! other dim is radiation bands - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp3lrt)) ALLOCATE(otmp3lrt(mland, nrb, 1)) - ELSE IF(dimswitch == 'plantcarbon') THEN ! other dim is plant carbon - ! pools - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF(.NOT.ASSOCIATED(otmp3lpct)) ALLOCATE(otmp3lpct(mland, ncp, 1)) - ELSE IF(dimswitch == 'soilcarbon') THEN ! other dim is soil carbon pools - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF( .NOT. ASSOCIATED(otmp3lsct)) ALLOCATE(otmp3lsct(mland, ncs, 1)) - ELSE - CALL abort('Variable '//vname// & - ' defined with unknown dimension switch - '//dimswitch// & - ' - in SUBROUTINE define_output_variable_r2') - END IF - END IF - ELSE - CALL abort('Unknown grid specification (SUBROUTINE '// & - 'define_output_variable_r2)') - END IF - ! Define variable units: - ok = NF90_PUT_ATT(ncid, varID, 'units', vunits) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//vname//' variable attributes in output file. '// & - '(SUBROUTINE define_output_variable_r2)') - ! Define long name: - ok = NF90_PUT_ATT(ncid, varID, 'long_name', longname) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//vname//' variable attributes in output file. '// & - '(SUBROUTINE define_output_variable_r2)') - ! Define missing/fill values: - ok = NF90_PUT_ATT(ncid, varID, '_FillValue', REAL(ncmissingr, 4)) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok,'Error defining '//vname//' variable attributes in output file. '// & - '(INTERFACE define_ovar)') - ! Define missing/fill values: - ok = NF90_PUT_ATT(ncid, varID, 'missing_value', REAL(ncmissingr, 4)) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//vname//' variable attributes in output file. '// & - '(INTERFACE define_ovar)') - - END SUBROUTINE define_output_variable_r2 - !============================================================================= - SUBROUTINE define_output_parameter_r1(ncid, parID, pname, punits, longname, & - writepatch, dimswitch, xID, yID, zID, & - landID, patchID, restart) - ! Subroutine for defining a real valued 1D parameter (time invariant) - INTEGER, INTENT(IN) :: ncid ! netcdf file ID - INTEGER, INTENT(IN) :: xID, yID, zID, landID, patchID ! netcdf - ! dimension IDs - INTEGER, INTENT(OUT) :: parID ! variable's netcdf ID - LOGICAL, INTENT(IN) :: writepatch ! write patch-specific info for this var? - LOGICAL, INTENT(IN), OPTIONAL :: restart ! are we writing to a restart file? ! dimension IDs - CHARACTER(LEN=*), INTENT(IN) :: pname ! name of variable - CHARACTER(LEN=*), INTENT(IN) :: punits ! variable units - CHARACTER(LEN=*), INTENT(IN) :: longname ! full variable name - CHARACTER(LEN=*), INTENT(IN) :: dimswitch ! indicates dimension of parameter - - ! First, decide which grid to use. If user has forced grid using output%grid - ! in the namelist file, use this grid. Else use format of met file. - IF((output%grid(1:3) == 'mas' .OR. & - (output%grid(1:3) == 'def' .AND. metGrid == 'mask') .OR. & - output%grid(1:3) == 'ALM') .AND. .NOT. PRESENT(restart)) THEN - ! Should patch-specific info be written for this variable - ! (no patches in ALMA format)? - IF((writepatch .OR. output%patch) .AND. & - (.NOT. output%grid(1:3) == 'ALM')) THEN - WRITE(logn, *) 'Writing '//pname// & - ' to output file using mask grid with patch-specific info' - IF(dimswitch(1:1) == 'r') THEN - ok = NF90_DEF_VAR(ncid, pname, NF90_FLOAT, (/xID, yID, patchID/) & - , parID) - ELSE IF(dimswitch(1:1) == 'i') THEN - ok = NF90_DEF_VAR(ncid, pname, NF90_INT, (/xID, yID, patchID/) & - , parID) - END IF - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable in output file. '// & - '(SUBROUTINE define_output_parameter_r1)') - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF(.NOT. ASSOCIATED(otmp3xyp)) & - ALLOCATE(otmp3xyp(xdimsize, ydimsize, max_vegpatches)) - ELSE ! only grid point values, no patch-specific info - WRITE(logn, *) 'Writing '//pname//' to output file using mask grid' - IF(dimswitch(1:1) == 'r') THEN - ok = NF90_DEF_VAR(ncid, pname, NF90_FLOAT, (/xID, yID/), parID) - ELSE IF(dimswitch(1:1) == 'i') THEN - ok = NF90_DEF_VAR(ncid, pname, NF90_INT, (/xID, yID/), parID) - END IF - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF(.NOT. ASSOCIATED(otmp2xy)) ALLOCATE(otmp2xy(xdimsize, ydimsize)) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable in output file. '// & - '(SUBROUTINE define_output_parameter_r1)') - END IF - ELSE IF(output%grid(1:3) == 'lan' .OR. (output%grid(1:3) == 'def' .AND. & - metGrid == 'land') .OR. PRESENT(restart)) THEN ! land-only grid - ! Should patch-specific info be written for this variable? - ! If this variable has been requested by user with patch-specific info - ! (writepatch) OR all have been (output%patch) AND we're NOT writing - ! a restart file (which uses a different technique to store patch info): - IF((writepatch .OR. output%patch) .AND. .NOT. PRESENT(restart)) THEN - WRITE(logn, *) 'Writing '//pname// & - ' to output file using land grid with patch-specific info' - IF(dimswitch(1:2) == 're') THEN - ok = NF90_DEF_VAR(ncid, pname, NF90_FLOAT, (/landID, patchID/) & - , parID) - ELSE IF(dimswitch(1:2) == 'r2') THEN - ok = NF90_DEF_VAR(ncid, pname, NF90_DOUBLE, (/landID, patchID/) & - , parID) - ELSE IF(dimswitch(1:1) == 'i') THEN - ok = NF90_DEF_VAR(ncid, pname, NF90_INT, (/landID, patchID/) & - , parID) - END IF - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable in output file. '// & - '(SUBROUTINE define_output_parameter_r1)') - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF(.NOT. ASSOCIATED(otmp2lp)) ALLOCATE(otmp2lp(mland, max_vegpatches)) - ELSE ! only grid point values without patch-specific info UNLESS a - ! restart variable - ! Restart file definitions will be directed to this part of interface. - ! If not writing a restart file, report variable writing to log file: - IF(.NOT. PRESENT(restart)) WRITE(logn, *) 'Writing '//pname// & - ' to output file using land grid' - IF(dimswitch(1:2) == 're') THEN - ok = NF90_DEF_VAR(ncid, pname, NF90_FLOAT, (/landID/), parID) - ELSE IF(dimswitch(1:2) == 'r2') THEN - ok = NF90_DEF_VAR(ncid, pname, NF90_DOUBLE, (/landID/), parID) - ELSE IF(dimswitch(1:1) == 'i') THEN - ok = NF90_DEF_VAR(ncid, pname, NF90_INT, (/landID/), parID) - END IF - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok,'Error defining '//pname//' variable in output or '// & - 'restart file. (SUBROUTINE define_output_parameter_r1)') - ! If not already allocated, allocate a temporary storage variable - ! of this dimension structure: - IF(.NOT. ASSOCIATED(otmp1l)) ALLOCATE(otmp1l(mland)) - END IF - ELSE - CALL abort('Unknown grid specification '// & - '(SUBROUTINE define_output_parameter_r1)') - END IF - ! Define variable units: - ok = NF90_PUT_ATT(ncid, parID, 'units', punits) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable attributes in '// & - 'output file. (SUBROUTINE define_output_parameter_r1)') - ! Define long name: - ok = NF90_PUT_ATT(ncid, parID, 'long_name', longname) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable attributes in '// & - 'output file. (SUBROUTINE define_output_parameter_r1)') - ! Define missing/fill values: - IF(dimswitch(1:1) == 'i') THEN - ok = NF90_PUT_ATT(ncid, parID, '_FillValue', ncmissingi) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable attributes in '// & - 'output file. (INTERFACE define_ovar)') - ok = NF90_PUT_ATT(ncid, parID, 'missing_value', ncmissingi) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable attributes in '// & - 'output file. (INTERFACE define_ovar)') - ELSE IF(dimswitch(1:2) == 'r2') THEN - ok = NF90_PUT_ATT(ncid, parID, '_FillValue', REAL(ncmissingr, 8)) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable attributes in '// & - 'output file. (INTERFACE define_ovar)') - ok = NF90_PUT_ATT(ncid, parID, 'missing_value', REAL(ncmissingr, 8)) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable attributes in '// & - 'output file. (INTERFACE define_ovar)') - ELSE - ok = NF90_PUT_ATT(ncid, parID, '_FillValue', REAL(ncmissingr, 4)) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable attributes in '// & - 'output file. (INTERFACE define_ovar)') - ok = NF90_PUT_ATT(ncid, parID, 'missing_value', REAL(ncmissingr, 4)) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable attributes in '// & - 'output file. (INTERFACE define_ovar)') - END IF - - END SUBROUTINE define_output_parameter_r1 - !============================================================================= - SUBROUTINE define_output_parameter_r2(ncid, parID, pname, punits, longname, & - writepatch, othdimID, dimswitch, xID, & - yID, zID, landID, patchID, restart) - ! Subroutine for defining a real valued 2D parameter (time invariant) - INTEGER, INTENT(IN) :: ncid ! netcdf file ID - INTEGER, INTENT(IN) :: othdimID ! ID of parameter's second dimension - INTEGER, INTENT(IN) :: xID, yID, zID, landID, patchID ! netcdf - ! dimension IDs - INTEGER, INTENT(OUT) :: parID ! variable's netcdf ID - LOGICAL, INTENT(IN) :: writepatch ! write patch-specific info for this var? - LOGICAL,INTENT(IN),OPTIONAL :: restart ! are we writing to a restart file? - CHARACTER(LEN=*), INTENT(IN) :: pname ! name of variable - CHARACTER(LEN=*), INTENT(IN) :: punits ! variable units - CHARACTER(LEN=*), INTENT(IN) :: longname ! full variable name - CHARACTER(LEN=*), INTENT(IN) :: dimswitch ! indicates dimesnion of parameter - - ! First, decide which grid to use. If user has forced grid using output%grid - ! in the namelist file, use this grid. Else use format of met file. - IF((output%grid(1:3) == 'mas' .OR. & - (output%grid(1:3) == 'def' .AND. metGrid == 'mask') .OR. & - output%grid(1:3) == 'ALM') .AND. .NOT. PRESENT(restart)) THEN - ! Should patch-specific info be written for this variable - ! (no patches in ALMA format)? - IF((writepatch .OR. output%patch) .AND. (.NOT. output%grid(1:3) & - == 'ALM') .AND.(dimswitch/='surftype')) THEN - WRITE(logn, *) 'Writing '//pname// & - ' to output file using mask grid with patch-specific info' - ok = NF90_DEF_VAR(ncid, pname, NF90_FLOAT, (/xID, yID, patchID, & - othdimID/),parID) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable in output file. '// & - '(SUBROUTINE define_output_parameter_r2)') - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF(dimswitch == 'soil' .OR. dimswitch == 'r2soil') THEN - IF(.NOT. ASSOCIATED(otmp4xyps)) & - ALLOCATE(otmp4xyps(xdimsize, ydimsize, max_vegpatches, ms)) - ELSE IF(dimswitch == 'plantcarbon') THEN - IF(.NOT. ASSOCIATED(otmp4xyppc)) & - ALLOCATE(otmp4xyppc(xdimsize, ydimsize, max_vegpatches, ncp)) - ELSE IF(dimswitch == 'soilcarbon') THEN - IF(.NOT. ASSOCIATED(otmp4xypsc)) & - ALLOCATE(otmp4xypsc(xdimsize, ydimsize, max_vegpatches, ncs)) - ELSE IF(dimswitch == 'radiation') THEN - IF(.NOT. ASSOCIATED(otmp4xypr)) & - ALLOCATE(otmp4xypr(xdimsize, ydimsize, max_vegpatches, nrb)) - END IF - ELSE ! only grid point values, no patch-specific info - WRITE(logn, *) 'Writing '//pname//' to output file using mask grid' - ok = NF90_DEF_VAR(ncid, pname, NF90_FLOAT, (/xID, yID, othdimID/) & - , parID) - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF(dimswitch == 'soil' .OR. dimswitch == 'r2soil') THEN - IF(.NOT. ASSOCIATED(otmp3xys)) ALLOCATE(otmp3xys(xdimsize, & - ydimsize, ms)) - ELSE IF(dimswitch == 'plantcarbon') THEN - IF(.NOT. ASSOCIATED(otmp3xypc)) & - ALLOCATE(otmp3xypc(xdimsize, ydimsize, ncp)) - ELSE IF(dimswitch == 'soilcarbon') THEN - IF(.NOT. ASSOCIATED(otmp3xysc)) & - ALLOCATE(otmp3xysc(xdimsize, ydimsize, ncs)) - ELSE IF(dimswitch == 'radiation') THEN - IF(.NOT. ASSOCIATED(otmp3xyr)) & - ALLOCATE(otmp3xyr(xdimsize, ydimsize, nrb)) - ELSE IF(dimswitch == 'surftype') THEN - IF(.NOT. ASSOCIATED(otmp3xysf)) ALLOCATE(otmp3xysf(xdimsize, & - ydimsize, 4)) - END IF - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable in output file. '// & - '(SUBROUTINE define_output_parameter_r2)') - END IF - ELSE IF(output%grid(1:3) == 'lan' .OR. (output%grid(1:3) == 'def' & - .AND. metGrid=='land') .OR. PRESENT(restart)) THEN - ! Should patch-specific info be written for this variable? - ! If this variable has been requested by user with patch-specific info - ! (writepatch) OR all have been (output%patch) AND we're NOT writing - ! a restart file (which uses a different technique to store patch info): - IF((writepatch .OR. output%patch) .AND. (dimswitch /= 'surftype') & - .AND. .NOT. PRESENT(restart)) THEN - WRITE(logn, *) 'Writing '//pname// & - ' to output file using land grid with patch-specific info' - ! Define parameter as double precision if required: - IF(dimswitch(1:2) == 'r2') THEN - ok = NF90_DEF_VAR(ncid, pname, NF90_DOUBLE, (/landID, patchID, & - othdimID/), parID) - ELSE - ok = NF90_DEF_VAR(ncid, pname, NF90_FLOAT, (/landID, patchID, & - othdimID/), parID) - END IF - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable in output file. '// & - '(SUBROUTINE define_output_parameter_r2)') - ! If not already allocated, allocate a temporary storage variable - ! of this dim: - IF(dimswitch == 'soil' .OR. dimswitch == 'r2soil') THEN - IF(.NOT. ASSOCIATED(otmp3lps)) ALLOCATE(otmp3lps(mland, & - max_vegpatches, ms)) - ELSE IF(dimswitch == 'plantcarbon') THEN - IF(.NOT. ASSOCIATED(otmp3lppc)) & - ALLOCATE(otmp3lppc(mland, max_vegpatches, ncp)) - ELSE IF(dimswitch == 'soilcarbon') THEN - IF(.NOT. ASSOCIATED(otmp3lpsc)) & - ALLOCATE(otmp3lpsc(mland, max_vegpatches, ncs)) - ELSE IF(dimswitch == 'radiation') THEN - IF(.NOT. ASSOCIATED(otmp3lpr)) & - ALLOCATE(otmp3lpr(mland, max_vegpatches, nrb)) - ELSE IF(dimswitch == 'snow') THEN - IF(.NOT. ASSOCIATED(otmp3lpsn)) & - ALLOCATE(otmp3lpsn(mland, max_vegpatches, msn)) - END IF - ELSE ! variable has no explicit patch dimension (incl. restart file) - ! Restart file definitions will be directed to this part of interface. - ! If not writing a restart file, report variable writing to log file: - IF(.NOT.PRESENT(restart)) WRITE(logn,*) 'Writing '//pname// & - ' to output file using land grid' - ! Define parameter as double precision if required for restart file: - IF(dimswitch(1:2)=='r2') THEN - ok=NF90_DEF_VAR(ncid,pname,NF90_DOUBLE,(/landID,othdimID/),parID) - ELSE - ok=NF90_DEF_VAR(ncid,pname,NF90_FLOAT,(/landID,othdimID/),parID) - END IF - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok,'Error defining '//pname//' variable in output file. '// & - '(SUBROUTINE define_output_parameter_r2)') - ! If not already allocated, allocate a temporary storage variable - ! of this dimension structure: - IF(dimswitch=='soil'.OR.dimswitch=='r2soil') THEN - IF(.NOT.ASSOCIATED(otmp2ls)) ALLOCATE(otmp2ls(mland,ms)) - ELSE IF(dimswitch=='plantcarbon') THEN - IF(.NOT.ASSOCIATED(otmp2lpc)) ALLOCATE(otmp2lpc(mland,ncp)) - ELSE IF(dimswitch=='soilcarbon') THEN - IF(.NOT.ASSOCIATED(otmp2lsc)) ALLOCATE(otmp2lsc(mland,ncs)) - ELSE IF(dimswitch=='radiation') THEN - IF(.NOT.ASSOCIATED(otmp2lr)) ALLOCATE(otmp2lr(mland,nrb)) - ELSE IF(dimswitch=='snow') THEN - IF(.NOT.ASSOCIATED(otmp2lsn)) ALLOCATE(otmp2lsn(mland,msn)) - ELSE IF(dimswitch=='surftype') THEN - IF(.NOT.ASSOCIATED(otmp2lsf)) ALLOCATE(otmp2lsf(mland,4)) - END IF - END IF - ELSE - CALL abort('Unknown grid specification '// & - '(SUBROUTINE define_output_parameter_r2)') - END IF - ! Define variable units: - ok = NF90_PUT_ATT(ncid ,parID, 'units', punits) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable attributes in '// & - 'output file. (SUBROUTINE define_output_parameter_r2)') - ! Define long name: - ok = NF90_PUT_ATT(ncid, parID, 'long_name', longname) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable attributes in '// & - 'output file. (SUBROUTINE define_output_parameter_r2)') - ! Define missing/fill values: - IF(dimswitch(1:1) == 'i') THEN - ok = NF90_PUT_ATT(ncid, parID, '_FillValue', ncmissingi) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable attributes in '// & - 'output file. (INTERFACE define_ovar)') - ok = NF90_PUT_ATT(ncid, parID, 'missing_value', ncmissingi) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable attributes in '// & - 'output file. (INTERFACE define_ovar)') - ELSE IF(dimswitch(1:2) == 'r2') THEN - ok = NF90_PUT_ATT(ncid, parID, '_FillValue', REAL(ncmissingr, 8)) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable attributes in '// & - 'output file. (INTERFACE define_ovar)') - ok = NF90_PUT_ATT(ncid, parID, 'missing_value', REAL(ncmissingr, 8)) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable attributes in '// & - 'output file. (INTERFACE define_ovar)') - ELSE - ok = NF90_PUT_ATT(ncid, parID, '_FillValue', REAL(ncmissingr, 4)) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable attributes in '// & - 'output file. (INTERFACE define_ovar)') - ok = NF90_PUT_ATT(ncid, parID, 'missing_value', REAL(ncmissingr, 4)) - IF (ok /= NF90_NOERR) CALL nc_abort & - (ok, 'Error defining '//pname//' variable attributes in '// & - 'output file. (INTERFACE define_ovar)') - END IF - - END SUBROUTINE define_output_parameter_r2 - !============================================================================= - SUBROUTINE write_output_variable_r1(ktau, ncid, varID, vname, var_r1, & - writepatch, dimswitch, met) - ! Subroutine for writing a real valued 1D variable - INTEGER, INTENT(IN) :: ktau ! current time step # - INTEGER, INTENT(IN) :: ncid ! netcdf file ID - INTEGER, INTENT(IN) :: varID ! variable's netcdf ID - REAL(KIND=4), DIMENSION(:), INTENT(IN) :: var_r1 ! variable values - LOGICAL, INTENT(IN) :: writepatch ! write patch-specific info for this var? - CHARACTER(LEN=*), INTENT(IN) :: vname ! name of variable - CHARACTER(LEN=*), INTENT(IN) :: dimswitch ! indicates dimesnion of parameter - TYPE(met_type), INTENT(IN) :: met ! met data - - INTEGER :: i,j ! do loop counter - - ! First, decide which grid to use. If user has forced grid using output%grid - ! in the namelist file, use this grid. Else use format of met file. - IF(output%grid(1:3) == 'mas' .OR. & - (output%grid(1:3) == 'def' .AND. metGrid == 'mask') .OR. & - output%grid(1:3) == 'ALM') THEN - ! Should patch-specific info be written for this variable - ! (no patches in ALMA format)? - IF((writepatch .OR. output%patch) .AND. (.NOT. output%grid(1:3) & - == 'ALM')) THEN - DO i = 1, mland ! over all land grid points - ! First write data for active patches: - otmp4xypt(land_x(i), land_y(i), 1:landpt(i)%nap, 1) & - = var_r1(landpt(i)%cstart:landpt(i)%cend) - ! Then write data for inactive patches (if any) as dummy value: - IF(landpt(i)%nap < max_vegpatches) otmp4xypt(land_x(i), & - land_y(i), (landpt(i)%nap + 1):max_vegpatches, 1) = ncmissingr - END DO - ! Fill non-land points with dummy value: - DO j = 1, max_vegpatches - WHERE(mask /= 1) otmp4xypt(:, :, j, 1) = ncmissingr ! not land - END DO - ! write data to file - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp4xypt(:, :, :, 1), 4), & - start = (/1, 1, 1, ktau/), & - count = (/xdimsize, ydimsize, max_vegpatches, 1/)) - ELSE ! only grid point values, no patch-specific info - ! If this is an ALMA 4D surface variable - ! AND the user has forced the grid type as ALMA: - IF(dimswitch == 'ALMA' .AND. output%grid(1:3) == 'ALM') THEN - DO i = 1, mland ! over all land grid points - ! Write to temporary variable (area weighted average across all - ! patches): - otmp4xyzt(land_x(i), land_y(i), 1, 1) = & - SUM(var_r1(landpt(i)%cstart: & - landpt(i)%cend) * patch(landpt(i)%cstart:landpt(i)%cend)%frac) - END DO - ! Fill non-land points with dummy value: - WHERE(mask /= 1) otmp4xyzt(:, :, 1, 1) = ncmissingr ! not land - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp4xyzt, 4), & - start = (/1, 1, 1, ktau/), & - count = (/xdimsize, ydimsize, 1, 1/)) ! write data to file - ELSE ! normal x-y-t mask grid - DO i = 1, mland ! over all land grid points - ! Write to temporary variable (area weighted average across all - ! patches): - otmp3xyt(land_x(i), land_y(i), 1) = SUM(var_r1(landpt(i)%cstart: & - landpt(i)%cend) * patch(landpt(i)%cstart:landpt(i)%cend)%frac) - END DO - ! Fill non-land points with dummy value: - WHERE(mask /= 1) otmp3xyt(:, :, 1) = ncmissingr ! not land - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp3xyt, 4), & - start = (/1,1,ktau/), & - count = (/xdimsize, ydimsize, 1/)) ! write data to file - END IF - END IF - ELSE IF(output%grid(1:3) == 'lan' & - .OR. (output%grid(1:3) == 'def' .AND. metGrid == 'land')) THEN - ! Should patch-specific info be written for this variable? - IF(writepatch .OR. output%patch) THEN - DO i = 1, mland ! over all land grid points - ! First write data for active patches: - otmp3lpt(i, 1:landpt(i)%nap, 1) = & - var_r1(landpt(i)%cstart:landpt(i)%cend) - ! Then write data for inactive patches as dummy value: - IF(landpt(i)%nap < max_vegpatches) & - otmp3lpt(i, (landpt(i)%nap + 1):max_vegpatches, 1) = ncmissingr - END DO - ! write data to file - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp3lpt(:, :, 1), 4), & - start = (/1, 1, ktau/), count = (/mland, max_vegpatches, 1/)) - ELSE ! only grid point values, no patch-specific info - DO i = 1, mland ! over all land grid points - ! Write to temporary variable (area weighted average across all - ! patches): - otmp2lt(i, 1) = SUM(var_r1(landpt(i)%cstart: & - landpt(i)%cend) * patch(landpt(i)%cstart:landpt(i)%cend)%frac) - END DO - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp2lt, 4), & - start = (/1, ktau/), count = (/mland, 1/)) ! write data to file - END IF - ELSE - CALL abort('Unknown grid specification '// & - '(SUBROUTINE write_output_variable_r1)') - END IF - ! Check writing was successful: - IF(ok /= NF90_NOERR) CALL nc_abort(ok, 'Error writing '//vname// & - ' variable to output file (SUBROUTINE write_output_variable_r1)') - - END SUBROUTINE write_output_variable_r1 - !============================================================================= - SUBROUTINE write_output_variable_r2(ktau, ncid, varID, vname, var_r2, & - writepatch, dimswitch, met) - ! Subroutine for writing a real valued 2D variable - INTEGER, INTENT(IN) :: ktau ! current time step # - INTEGER, INTENT(IN) :: ncid ! netcdf file ID - INTEGER, INTENT(IN) :: varID ! variable's netcdf ID - REAL(KIND=4), DIMENSION(:, :), INTENT(IN) :: var_r2 ! variable values - LOGICAL, INTENT(IN) :: writepatch ! write patch-specific info for this var? - CHARACTER(LEN=*), INTENT(IN) :: vname ! name of variable - CHARACTER(LEN=*), INTENT(IN) :: dimswitch ! indicates dimesnion of parameter - TYPE(met_type), INTENT(IN) :: met ! met data - - INTEGER :: i, j, k ! do loop counter - - ! First, decide which grid to use. If user has forced grid using output%grid - ! in the namelist file, use this grid. Else use format of met file. - IF(output%grid(1:3) == 'mas' .OR. & - (output%grid(1:3) == 'def' .AND. metGrid == 'mask') .OR. & - output%grid(1:3) == 'ALM') THEN - ! Should patch-specific info be written for this variable - ! (no patches in ALMA format)? - IF((writepatch .OR. output%patch) .AND. (.NOT. output%grid(1:3) & - == 'ALM')) THEN - ! Decide what the second dimension of this variable is: - IF(dimswitch == 'soil') THEN ! other dim is soil - DO i = 1, mland ! over all land grid points - ! First write data for active patches: - otmp5xypst(land_x(i), land_y(i), 1:landpt(i)%nap, :, 1) & - = var_r2(landpt(i)%cstart:landpt(i)%cend, :) - ! Then write data for inactive patches (if any) as dummy value: - IF(landpt(i)%nap < max_vegpatches) otmp5xypst(land_x(i), & - land_y(i), (landpt(i)%nap+1):max_vegpatches,:,1) = ncmissingr - END DO - ! Fill non-land points with dummy value: - DO j = 1, max_vegpatches - DO k = 1, ms - WHERE(mask /=1 ) otmp5xypst(:, :, j, k, 1) = ncmissingr ! not land - END DO - END DO - ! Write data to file: - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp5xypst(:, :, :, :,1), 4), & - start = (/1, 1, 1, 1, ktau/), & - count = (/xdimsize, ydimsize, max_vegpatches, ms, 1/)) - ELSE IF(dimswitch == 'snow') THEN ! other dim is snow - DO i = 1, mland ! over all land grid points - ! First write data for active patches: - otmp5xypsnt(land_x(i), land_y(i), 1:landpt(i)%nap, :, 1) & - = var_r2(landpt(i)%cstart:landpt(i)%cend, :) - ! Then write data for inactive patches as dummy value: - IF(landpt(i)%nap < max_vegpatches) otmp5xypsnt(land_x(i), & - land_y(i), (landpt(i)%nap + 1):max_vegpatches, :, 1) = ncmissingr - END DO - ! Fill non-land points with dummy value: - DO j = 1, max_vegpatches - DO k = 1, msn - ! not land - WHERE(mask /= 1) otmp5xypsnt(:, :, j, k, 1) = ncmissingr - END DO - END DO - ! Write data to file: - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp5xypsnt(:, :, :, :, 1), 4), & - start = (/1, 1, 1, 1, ktau/), & - count = (/xdimsize, ydimsize, max_vegpatches, msn, 1/)) - ELSE IF(dimswitch=='radiation') THEN ! other dim is radiation bands - DO i = 1, mland ! over all land grid points - ! First write data for active patches: - otmp5xyprt(land_x(i), land_y(i), 1:landpt(i)%nap, :, 1) & - = var_r2(landpt(i)%cstart:landpt(i)%cend,:) - ! Then write data for inactive patches as dummy value: - IF(landpt(i)%nap < max_vegpatches) otmp5xyprt(land_x(i), & - land_y(i), (landpt(i)%nap + 1):max_vegpatches, :, 1) = ncmissingr - END DO - ! Fill non-land points with dummy value: - DO j = 1, max_vegpatches - DO k = 1, nrb - ! not land - WHERE(mask /= 1) otmp5xyprt(:, :, j, k, 1) = ncmissingr - END DO - END DO - ! Write data to file: - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp5xyprt(:, :, :, :, 1), 4), & - start = (/1, 1, 1, 1, ktau/), & - count = (/xdimsize, ydimsize, max_vegpatches, nrb, 1/)) - ELSE IF(dimswitch == 'plantcarbon') THEN ! other dim is plant carbon - ! pools - DO i = 1, mland ! over all land grid points - ! First write data for active patches: - otmp5xyppct(land_x(i), land_y(i), 1:landpt(i)%nap, :, 1) & - = var_r2(landpt(i)%cstart:landpt(i)%cend, :) - ! Then write data for inactive patches (if any) as dummy value: - IF(landpt(i)%nap < max_vegpatches) otmp5xyppct(land_x(i), & - land_y(i), (landpt(i)%nap + 1):max_vegpatches, :, 1) = ncmissingr - END DO - ! Fill non-land points with dummy value: - DO j = 1, max_vegpatches - DO k = 1, ncp - ! not land - WHERE(mask /= 1) otmp5xyppct(:, :, j, k, 1) = ncmissingr - END DO - END DO - ! Write data to file: - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp5xyppct(:, :, :, :, 1), 4), & - start = (/1, 1, 1, 1, ktau/), & - count = (/xdimsize, ydimsize, max_vegpatches, ncp, 1/)) - ELSE IF(dimswitch == 'soilcarbon') THEN ! other dim is soil carbon pools - DO i = 1, mland ! over all land grid points - ! First write data for active patches: - otmp5xypsct(land_x(i), land_y(i), 1:landpt(i)%nap, :, 1) & - = var_r2(landpt(i)%cstart:landpt(i)%cend, :) - ! Then write data for inactive patches as dummy value: - IF(landpt(i)%nap < max_vegpatches) otmp5xypsct(land_x(i), & - land_y(i), (landpt(i)%nap + 1):max_vegpatches, :, 1) = ncmissingr - END DO - ! Fill non-land points with dummy value: - DO j = 1, max_vegpatches - DO k = 1, ncs - ! not land - WHERE(mask /= 1) otmp5xypsct(:, :, j, k, 1) = ncmissingr - END DO - END DO - ! Write data to file: - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp5xypsct(:, :, :, :, 1), 4), & - start = (/1, 1, 1, 1, ktau/), & - count = (/xdimsize, ydimsize, max_vegpatches, ncs, 1/)) - ELSE - CALL abort('Variable '//vname// & - ' defined with unknown dimension switch - '//dimswitch// & - ' - in INTERFACE write_ovar') - END IF - ELSE ! only grid point values, no patch-specific info - ! Decide what the second dimension of this variable is: - IF(dimswitch == 'soil') THEN ! other dim is soil - DO i = 1, mland ! over all land grid points - ! Write to temporary variable (sum over patches & weight by - ! fraction): - DO j = 1, ms - otmp4xyst(land_x(i), land_y(i), j, 1) = SUM( & - var_r2(landpt(i)%cstart:landpt(i)%cend, j) * & - patch(landpt(i)%cstart:landpt(i)%cend)%frac) - END DO - END DO - ! Fill non-land points with dummy value: - DO j = 1, ms - WHERE(mask /= 1) otmp4xyst(:, :, j, 1) = ncmissingr ! not land - END DO - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp4xyst, 4), & - start = (/1, 1, 1, ktau/), & - count = (/xdimsize, ydimsize, ms, 1/)) ! write data to file - ELSE IF(dimswitch == 'snow') THEN ! other dim is snow - DO i = 1, mland ! over all land grid points - ! Write to temporary variable (sum over patches & weight by - ! fraction): - DO j = 1, msn - otmp4xysnt(land_x(i), land_y(i), j, 1) = SUM( & - var_r2(landpt(i)%cstart:landpt(i)%cend, j) * & - patch(landpt(i)%cstart:landpt(i)%cend)%frac) - END DO - END DO - ! Fill non-land points with dummy value: - DO j = 1, msn - WHERE(mask /= 1) otmp4xysnt(:, :, j, 1) = ncmissingr ! not land - END DO - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp4xysnt, 4), & - start = (/1, 1, 1, ktau/), & - count = (/xdimsize, ydimsize, msn, 1/)) ! write data to file - ELSE IF(dimswitch == 'radiation') THEN ! other dim is radiation bands - DO i = 1, mland ! over all land grid points - ! Write to temporary variable (sum over patches & weight by - ! fraction): - DO j = 1, nrb - otmp4xyrt(land_x(i), land_y(i), j, 1) = SUM( & - var_r2(landpt(i)%cstart:landpt(i)%cend, j) * & - patch(landpt(i)%cstart:landpt(i)%cend)%frac) - END DO - END DO - ! Fill non-land points with dummy value: - DO j = 1, nrb - WHERE(mask /= 1) otmp4xyrt(:, :, j, 1) = ncmissingr ! not land - END DO - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp4xyrt, 4), & - start = (/1, 1, 1, ktau/), & - count = (/xdimsize, ydimsize, nrb, 1/)) ! write data to file - ELSE IF(dimswitch == 'plantcarbon') THEN ! other dim is plant carbon - ! pools - DO i = 1, mland ! over all land grid points - ! Write to temporary variable (sum over patches & weight by fraction): - DO j = 1, ncp - otmp4xypct(land_x(i), land_y(i), j, 1) = SUM( & - var_r2(landpt(i)%cstart:landpt(i)%cend, j) * & - patch(landpt(i)%cstart:landpt(i)%cend)%frac) - END DO - END DO - ! Fill non-land points with dummy value: - DO j = 1, ncp - WHERE(mask /= 1) otmp4xypct(:, :, j, 1) = ncmissingr ! not land - END DO - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp4xypct, 4), & - start = (/1, 1, 1, ktau/), & - count = (/xdimsize, ydimsize, ncp, 1/)) ! write data to file - ELSE IF(dimswitch == 'soilcarbon') THEN ! other dim is soil carbon pools - DO i = 1, mland ! over all land grid points - ! Write to temporary variable (sum over patches & weight by fraction): - DO j = 1, ncs - otmp4xysct(land_x(i), land_y(i), j, 1) = SUM( & - var_r2(landpt(i)%cstart:landpt(i)%cend, j) * & - patch(landpt(i)%cstart:landpt(i)%cend)%frac) - END DO - END DO - ! Fill non-land points with dummy value: - DO j = 1, ncs - WHERE(mask /= 1) otmp4xysct(:, :, j, 1) = ncmissingr ! not land - END DO - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp4xysct, 4), & - start = (/1, 1, 1, ktau/), & - count = (/xdimsize, ydimsize, ncs, 1/)) ! write data to file - ELSE - CALL abort('Variable '//vname// & - ' defined with unknown dimension switch - '//dimswitch// & - ' - in INTERFACE write_ovar') - END IF - END IF - ELSE IF(output%grid(1:3) == 'lan' & - .OR.(output%grid(1:3) == 'def' .AND. metGrid == 'land')) THEN - ! Should patch-specific info be written for this variable - ! (no patches in ALMA format)? - IF((writepatch .OR. output%patch) .AND. (.NOT. output%grid(1:3) & - == 'ALM')) THEN - ! Decide what the second dimension of this variable is: - IF(dimswitch == 'soil') THEN ! other dim is soil - DO i = 1, mland ! over all land grid points - ! First write data for active patches: - otmp4lpst(i, 1:landpt(i)%nap, :, 1) & - = var_r2(landpt(i)%cstart:landpt(i)%cend, :) - ! Then write data for inactive patches (if any) as dummy value: - IF(landpt(i)%nap < max_vegpatches) otmp4lpst(i, & - (landpt(i)%nap + 1):max_vegpatches, :, 1) = ncmissingr - END DO - ! Write data to file: - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp4lpst(:, :, :, 1), 4), & - start = (/1, 1, 1, ktau/), & - count = (/mland, max_vegpatches, ms, 1/)) - ELSE IF(dimswitch == 'snow') THEN ! other dim is snow - DO i = 1, mland ! over all land grid points - ! First write data for active patches: - otmp4lpsnt(i, 1:landpt(i)%nap, :, 1) = & - var_r2(landpt(i)%cstart:landpt(i)%cend, :) - ! Then write data for inactive patches as dummy value: - IF(landpt(i)%nap < max_vegpatches) otmp4lpsnt(i, & - (landpt(i)%nap + 1):max_vegpatches, :, 1) = ncmissingr - END DO - ! write data to file - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp4lpsnt(:, :, :, 1), 4), & - start = (/1, 1, 1, ktau/), & - count = (/mland, max_vegpatches, msn, 1/)) - ELSE IF(dimswitch == 'radiation') THEN ! other dim is radiation bands - DO i = 1, mland ! over all land grid points - ! First write data for active patches: - otmp4lprt(i, 1:landpt(i)%nap, :, 1) = & - var_r2(landpt(i)%cstart:landpt(i)%cend, :) - ! Then write data for inactive patches as dummy value: - IF(landpt(i)%nap < max_vegpatches) otmp4lprt(i, & - (landpt(i)%nap + 1):max_vegpatches, :, 1) = ncmissingr - END DO - ! write data to file - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp4lprt(:, :, :, 1), 4), & - start = (/1, 1, 1, ktau/), & - count = (/mland, max_vegpatches, nrb, 1/)) - ELSE IF(dimswitch == 'plantcarbon') THEN ! other dim is plant carbon - ! pools - DO i = 1, mland ! over all land grid points - ! First write data for active patches: - otmp4lppct(i, 1:landpt(i)%nap, :, 1) = & - var_r2(landpt(i)%cstart:landpt(i)%cend, :) - ! Then write data for inactive patches as dummy value: - IF(landpt(i)%nap < max_vegpatches) otmp4lppct(i, & - (landpt(i)%nap + 1):max_vegpatches, :, 1) = ncmissingr - END DO - ! write data to file - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp4lppct(:, :, :, 1), 4), & - start = (/1, 1, 1, ktau/), & - count = (/mland, max_vegpatches, ncp, 1/)) - ELSE IF(dimswitch == 'soilcarbon') THEN ! other dim is soil carbon pools - DO i = 1, mland ! over all land grid points - ! First write data for active patches: - otmp4lpsct(i, 1:landpt(i)%nap, :, 1) = & - var_r2(landpt(i)%cstart:landpt(i)%cend, :) - ! Then write data for inactive patches as dummy value: - IF(landpt(i)%nap < max_vegpatches) otmp4lpsct(i, & - (landpt(i)%nap + 1):max_vegpatches, :, 1) = ncmissingr - END DO - ! write data to file - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp4lpsct(:, :, :, 1), 4), & - start = (/1, 1, 1, ktau/), & - count = (/mland, max_vegpatches, ncs, 1/)) - ELSE - CALL abort('Variable '//vname// & - ' defined with unknown dimension switch - '//dimswitch// & - ' - in INTERFACE write_ovar') - END IF - ELSE ! only grid point values, no patch-specific info - ! Decide what the second dimension of this variable is: - IF(dimswitch == 'soil') THEN ! other dim is soil - DO i = 1, mland ! over all land grid points - ! Write to temporary variable (sum over patches & weight by - ! fraction): - DO j = 1, ms - otmp3lst(i, j, 1) = SUM( & - var_r2(landpt(i)%cstart:landpt(i)%cend, j) * & - patch(landpt(i)%cstart:landpt(i)%cend)%frac) - END DO - END DO - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp3lst, 4), & - start = (/1, 1, ktau/), & - count = (/mland, ms, 1/)) ! write data to file - ELSE IF(dimswitch == 'snow') THEN ! other dim is snow - DO i = 1, mland ! over all land grid points - ! Write to temporary variable (sum over patches & weight by - ! fraction): - DO j = 1, msn - otmp3lsnt(i, j, 1) = SUM( & - var_r2(landpt(i)%cstart:landpt(i)%cend, j) * & - patch(landpt(i)%cstart:landpt(i)%cend)%frac) - END DO - END DO - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp3lsnt, 4), & - start = (/1, 1, ktau/), & - count = (/mland, msn, 1/)) ! write data to file - ELSE IF(dimswitch == 'radiation') THEN ! other dim is radiation bands - DO i = 1, mland ! over all land grid points - ! Write to temporary variable (sum over patches & weight by fraction): - DO j = 1, nrb - otmp3lrt(i, j, 1) = SUM( & - var_r2(landpt(i)%cstart:landpt(i)%cend, j) * & - patch(landpt(i)%cstart:landpt(i)%cend)%frac) - END DO - END DO - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp3lrt, 4), & - start = (/1, 1, ktau/), & - count = (/mland, nrb, 1/)) ! write data to file - ELSE IF(dimswitch == 'plantcarbon') THEN ! other dim is plant carbon - ! pools - DO i = 1, mland ! over all land grid points - ! Write to temporary variable (sum over patches & weight by fraction): - DO j = 1, ncp - otmp3lpct(i, j, 1) = SUM( & - var_r2(landpt(i)%cstart:landpt(i)%cend, j) * & - patch(landpt(i)%cstart:landpt(i)%cend)%frac) - END DO - END DO - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp3lpct, 4), & - start = (/1, 1, ktau/), & - count = (/mland, ncp, 1/)) ! write data to file - ELSE IF(dimswitch == 'soilcarbon') THEN ! other dim is soil carbon pools - DO i = 1, mland ! over all land grid points - ! Write to temporary variable (sum over patches & weight by fraction): - DO j = 1, ncs - otmp3lsct(i, j, 1) = SUM( & - var_r2(landpt(i)%cstart:landpt(i)%cend, j) * & - patch(landpt(i)%cstart:landpt(i)%cend)%frac) - END DO - END DO - ok = NF90_PUT_VAR(ncid, varID, REAL(otmp3lsct, 4), & - start = (/1, 1, ktau/), & - count = (/mland, ncs, 1/)) ! write data to file - ELSE - CALL abort('Variable '//vname// & - ' defined with unknown dimension switch - '//dimswitch// & - ' - in SUBROUTINE write_output_variable_r2') - END IF - END IF ! patch info or no patch info - ELSE - CALL abort('Unknown grid specification '// & - '(SUBROUTINE write_output_variable_r2)') - END IF ! grid type - - ! Check writing was successful: - IF(ok /= NF90_NOERR) CALL nc_abort(ok, 'Error writing '//vname// & - ' variable to output file (SUBROUTINE write_output_variable_r2)') - - END SUBROUTINE write_output_variable_r2 - !============================================================================= - SUBROUTINE write_output_parameter_r1(ncid, parID, pname, par_r1, & - writepatch, dimswitch, restart) - ! Subroutine for writing a real valued 1D parameter (time invariant) - INTEGER, INTENT(IN) :: ncid ! netcdf file ID - INTEGER, INTENT(IN) :: parID ! variable's netcdf ID - REAL(KIND=4), DIMENSION(:), INTENT(IN) :: par_r1 ! variable values - LOGICAL, INTENT(IN) :: writepatch ! write patch-specific info for this var? - LOGICAL, INTENT(IN) :: restart ! are we writing to a restart file? - CHARACTER(LEN=*), INTENT(IN) :: pname ! name of variable - CHARACTER(LEN=*), INTENT(IN) :: dimswitch ! indicates dimesnion of parameter - - INTEGER :: i, j ! do loop counter - - ! First, decide which grid to use. If user has forced grid using output%grid - ! in the namelist file, use this grid. Else use format of met file. - IF((output%grid(1:3) == 'mas' .OR. & - (output%grid(1:3) == 'def' .AND. metGrid == 'mask') .OR. & - output%grid(1:3) == 'ALM') .AND. .NOT. restart) THEN - ! Should patch-specific info be written for this parameter - ! (no patches in ALMA format)? - IF((writepatch .OR. output%patch) .AND. (.NOT. output%grid(1:3) & - == 'ALM')) THEN - DO i = 1, mland ! over all land grid points - ! First write data for active patches: - otmp3xyp(land_x(i), land_y(i), 1:landpt(i)%nap) & - = par_r1(landpt(i)%cstart:landpt(i)%cend) - ! Then write data for inactive patches as dummy value: - IF(dimswitch(1:1) == 'r') THEN - IF(landpt(i)%nap aggregator_init !! Initialise the aggregator. + procedure :: type => aggregator_type !! Return a string identifier of the aggregator type. + procedure :: rank => aggregator_rank !! Return the rank of the aggregator. + procedure :: shape => aggregator_shape !! Return the shape of the aggregator. + procedure :: scale => aggregator_scale !! Scale the aggregated data by a specified factor. + procedure :: div => aggregator_div !! Divide the aggregated data by a specified factor. + procedure :: offset => aggregator_offset !! Add a specified offset to the aggregated data. + procedure, private :: set_method => aggregator_set_method !! Set the aggregation method. + end type aggregator_t + + abstract interface + !* Interfaces for the procedure pointers in the `aggregator_t` type to be + ! implemented by the specific aggregation methods (e.g., mean, sum, min, max). + subroutine accumulate_data(this, scale, div, offset) + !! Accumulate the aggregated data from the source data. + import aggregator_t + class(aggregator_t), intent(inout) :: this + real, intent(in), optional :: scale + !* An optional scaling factor to apply to the source data before + ! accumulation. Defaults to 1.0 if not provided. + real, intent(in), optional :: div + !* An optional division factor to apply to the source data before + ! accumulation. Defaults to 1.0 if not provided. + real, intent(in), optional :: offset + !* An optional offset to add to the source data before accumulation. + ! Defaults to 0.0 if not provided. + end subroutine accumulate_data + subroutine reset_data(this) + !! Reset the aggregated data to its initial state. + import aggregator_t + class(aggregator_t), intent(inout) :: this + end subroutine reset_data + end interface + + type, extends(aggregator_t) :: aggregator_int32_0d_t + !! An aggregator for 0-dimensional (scalar) 32-bit integer data. + integer(kind=int32), allocatable :: aggregated_data + integer(kind=int32), pointer :: source_data => null() + end type aggregator_int32_0d_t + + type, extends(aggregator_t) :: aggregator_int32_1d_t + !! An aggregator for 1-dimensional 32-bit integer data. + integer(kind=int32), dimension(:), allocatable :: aggregated_data + integer(kind=int32), dimension(:), pointer :: source_data => null() + end type aggregator_int32_1d_t + + type, extends(aggregator_t) :: aggregator_int32_2d_t + !! An aggregator for 2-dimensional 32-bit integer data. + integer(kind=int32), dimension(:,:), allocatable :: aggregated_data + integer(kind=int32), dimension(:,:), pointer :: source_data => null() + end type aggregator_int32_2d_t + + type, extends(aggregator_t) :: aggregator_int32_3d_t + !! An aggregator for 3-dimensional 32-bit integer data. + integer(kind=int32), dimension(:,:,:), allocatable :: aggregated_data + integer(kind=int32), dimension(:,:,:), pointer :: source_data => null() + end type aggregator_int32_3d_t + + type, extends(aggregator_t) :: aggregator_real32_0d_t + !! An aggregator for 0-dimensional (scalar) 32-bit real data. + real(kind=real32), allocatable :: aggregated_data + real(kind=real32), pointer :: source_data => null() + end type aggregator_real32_0d_t + + type, extends(aggregator_t) :: aggregator_real32_1d_t + !! An aggregator for 1-dimensional 32-bit real data. + real(kind=real32), dimension(:), allocatable :: aggregated_data + real(kind=real32), dimension(:), pointer :: source_data => null() + end type aggregator_real32_1d_t + + type, extends(aggregator_t) :: aggregator_real32_2d_t + !! An aggregator for 2-dimensional 32-bit real data. + real(kind=real32), dimension(:,:), allocatable :: aggregated_data + real(kind=real32), dimension(:,:), pointer :: source_data => null() + end type aggregator_real32_2d_t + + type, extends(aggregator_t) :: aggregator_real32_3d_t + !! An aggregator for 3-dimensional 32-bit real data. + real(kind=real32), dimension(:,:,:), allocatable :: aggregated_data + real(kind=real32), dimension(:,:,:), pointer :: source_data => null() + end type aggregator_real32_3d_t + + type, extends(aggregator_t) :: aggregator_real64_0d_t + !! An aggregator for 0-dimensional (scalar) 64-bit real data. +#ifdef ENFORCE_SINGLE_PRECISION + real(kind=real32), allocatable :: aggregated_data +#else + real(kind=real64), allocatable :: aggregated_data +#endif + + real(kind=real64), pointer :: source_data => null() + end type aggregator_real64_0d_t + + type, extends(aggregator_t) :: aggregator_real64_1d_t + !! An aggregator for 1-dimensional 64-bit real data. +#ifdef ENFORCE_SINGLE_PRECISION + real(kind=real32), dimension(:), allocatable :: aggregated_data +#else + real(kind=real64), dimension(:), allocatable :: aggregated_data +#endif + real(kind=real64), dimension(:), pointer :: source_data => null() + end type aggregator_real64_1d_t + + type, extends(aggregator_t) :: aggregator_real64_2d_t + !! An aggregator for 2-dimensional 64-bit real data. +#ifdef ENFORCE_SINGLE_PRECISION + real(kind=real32), dimension(:,:), allocatable :: aggregated_data +#else + real(kind=real64), dimension(:,:), allocatable :: aggregated_data +#endif + real(kind=real64), dimension(:,:), pointer :: source_data => null() + end type aggregator_real64_2d_t + + type, extends(aggregator_t) :: aggregator_real64_3d_t + !! An aggregator for 3-dimensional 64-bit real data. +#ifdef ENFORCE_SINGLE_PRECISION + real(kind=real32), dimension(:,:,:), allocatable :: aggregated_data +#else + real(kind=real64), dimension(:,:,:), allocatable :: aggregated_data +#endif + real(kind=real64), dimension(:,:,:), pointer :: source_data => null() + end type aggregator_real64_3d_t + + interface new_aggregator + !* Factory interface for creating new aggregator instances. The specific + ! type of aggregator created is determined by the type of the source data + ! array provided. + module procedure new_aggregator_int32_0d_t + module procedure new_aggregator_int32_1d_t + module procedure new_aggregator_int32_2d_t + module procedure new_aggregator_int32_3d_t + module procedure new_aggregator_real32_0d + module procedure new_aggregator_real32_1d + module procedure new_aggregator_real32_2d + module procedure new_aggregator_real32_3d + module procedure new_aggregator_real64_0d + module procedure new_aggregator_real64_1d + module procedure new_aggregator_real64_2d + module procedure new_aggregator_real64_3d + end interface + +contains + + subroutine aggregator_init(this, method) + !* Initialise the aggregator by allocating the aggregated data array and its + ! aggregation method. The values in the aggregated data array are reset + ! according to the specified aggregation method. + class(aggregator_t), intent(inout) :: this + character(len=*), intent(in) :: method + !! The aggregation method to use (e.g., "mean", "sum", "point", "min", "max"). + + select type (this) + type is (aggregator_int32_0d_t) + if (.not. allocated(this%aggregated_data)) allocate(this%aggregated_data, mold=this%source_data) + type is (aggregator_int32_1d_t) + if (.not. allocated(this%aggregated_data)) allocate(this%aggregated_data, mold=this%source_data) + type is (aggregator_int32_2d_t) + if (.not. allocated(this%aggregated_data)) allocate(this%aggregated_data, mold=this%source_data) + type is (aggregator_int32_3d_t) + if (.not. allocated(this%aggregated_data)) allocate(this%aggregated_data, mold=this%source_data) + type is (aggregator_real32_0d_t) + if (.not. allocated(this%aggregated_data)) allocate(this%aggregated_data, mold=this%source_data) + type is (aggregator_real32_1d_t) + if (.not. allocated(this%aggregated_data)) allocate(this%aggregated_data, mold=this%source_data) + type is (aggregator_real32_2d_t) + if (.not. allocated(this%aggregated_data)) allocate(this%aggregated_data, mold=this%source_data) + type is (aggregator_real32_3d_t) + if (.not. allocated(this%aggregated_data)) allocate(this%aggregated_data, mold=this%source_data) + type is (aggregator_real64_0d_t) + if (.not. allocated(this%aggregated_data)) allocate( & +#ifdef ENFORCE_SINGLE_PRECISION + this%aggregated_data, mold=real(this%source_data, kind=real32) & +#else + this%aggregated_data, mold=real(this%source_data, kind=real64) & +#endif + ) + type is (aggregator_real64_1d_t) + if (.not. allocated(this%aggregated_data)) allocate( & +#ifdef ENFORCE_SINGLE_PRECISION + this%aggregated_data, mold=real(this%source_data, kind=real32) & +#else + this%aggregated_data, mold=real(this%source_data, kind=real64) & +#endif + ) + type is (aggregator_real64_2d_t) + if (.not. allocated(this%aggregated_data)) allocate( & +#ifdef ENFORCE_SINGLE_PRECISION + this%aggregated_data, mold=real(this%source_data, kind=real32) & +#else + this%aggregated_data, mold=real(this%source_data, kind=real64) & +#endif + ) + type is (aggregator_real64_3d_t) + if (.not. allocated(this%aggregated_data)) allocate( & +#ifdef ENFORCE_SINGLE_PRECISION + this%aggregated_data, mold=real(this%source_data, kind=real32) & +#else + this%aggregated_data, mold=real(this%source_data, kind=real64) & +#endif + ) + class default + call cable_abort("Unexpected aggregator type.", file=__FILE__, line=__LINE__) + end select + + call this%set_method(method) + + call this%reset() + + end subroutine aggregator_init + + subroutine aggregator_set_method(this, method) + !* Set the aggregation method for the aggregator by assigning the appropriate + ! accumulation and reset procedures based on the specified method. + class(aggregator_t), intent(inout) :: this + character(len=*), intent(in) :: method + !! The aggregation method to use (e.g., "mean", "sum", "point", "min", "max"). + + if (method == "mean") then + this%accumulate => mean_accumulate + this%reset => other_reset + elseif (method == "sum") then + this%accumulate => sum_accumulate + this%reset => other_reset + elseif (method == "point") then + this%accumulate => point_accumulate + this%reset => point_reset + elseif (method == "min") then + this%accumulate => min_accumulate + this%reset => min_reset + elseif (method == "max") then + this%accumulate => max_accumulate + this%reset => max_reset + else + call cable_abort("Aggregation method "//method//" is invalid.", file=__FILE__, line=__LINE__) + endif + + end subroutine aggregator_set_method + + character(16) function aggregator_type(this) + !! Return a string identifier of the aggregator type (e.g., "int32", "real32", "real64"). + class(aggregator_t), intent(in) :: this + + select type (this) + type is (aggregator_int32_0d_t) + aggregator_type = "int32" + type is (aggregator_int32_1d_t) + aggregator_type = "int32" + type is (aggregator_int32_2d_t) + aggregator_type = "int32" + type is (aggregator_int32_3d_t) + aggregator_type = "int32" + type is (aggregator_real32_0d_t) + aggregator_type = "real32" + type is (aggregator_real32_1d_t) + aggregator_type = "real32" + type is (aggregator_real32_2d_t) + aggregator_type = "real32" + type is (aggregator_real32_3d_t) + aggregator_type = "real32" + type is (aggregator_real64_0d_t) + aggregator_type = "real64" + type is (aggregator_real64_1d_t) + aggregator_type = "real64" + type is (aggregator_real64_2d_t) + aggregator_type = "real64" + type is (aggregator_real64_3d_t) + aggregator_type = "real64" + class default + call cable_abort("Unexpected aggregator type.", file=__FILE__, line=__LINE__) + end select + + end function aggregator_type + + integer function aggregator_rank(this) + !! Return the rank of the aggregator. + class(aggregator_t), intent(in) :: this + + select type (this) + type is (aggregator_int32_0d_t) + aggregator_rank = 0 + type is (aggregator_int32_1d_t) + aggregator_rank = 1 + type is (aggregator_int32_2d_t) + aggregator_rank = 2 + type is (aggregator_int32_3d_t) + aggregator_rank = 3 + type is (aggregator_real32_0d_t) + aggregator_rank = 0 + type is (aggregator_real32_1d_t) + aggregator_rank = 1 + type is (aggregator_real32_2d_t) + aggregator_rank = 2 + type is (aggregator_real32_3d_t) + aggregator_rank = 3 + type is (aggregator_real64_0d_t) + aggregator_rank = 0 + type is (aggregator_real64_1d_t) + aggregator_rank = 1 + type is (aggregator_real64_2d_t) + aggregator_rank = 2 + type is (aggregator_real64_3d_t) + aggregator_rank = 3 + class default + call cable_abort("Unexpected aggregator type.", file=__FILE__, line=__LINE__) + end select + + end function aggregator_rank + + function aggregator_shape(this) result(agg_shape) + !! Return the shape of the aggregator. + class(aggregator_t), intent(in) :: this + integer, allocatable :: agg_shape(:) + + select type (this) + type is (aggregator_int32_0d_t) + agg_shape = shape(this%source_data) + type is (aggregator_int32_1d_t) + agg_shape = shape(this%source_data) + type is (aggregator_int32_2d_t) + agg_shape = shape(this%source_data) + type is (aggregator_int32_3d_t) + agg_shape = shape(this%source_data) + type is (aggregator_real32_0d_t) + agg_shape = shape(this%source_data) + type is (aggregator_real32_1d_t) + agg_shape = shape(this%source_data) + type is (aggregator_real32_2d_t) + agg_shape = shape(this%source_data) + type is (aggregator_real32_3d_t) + agg_shape = shape(this%source_data) + type is (aggregator_real64_0d_t) + agg_shape = shape(this%source_data) + type is (aggregator_real64_1d_t) + agg_shape = shape(this%source_data) + type is (aggregator_real64_2d_t) + agg_shape = shape(this%source_data) + type is (aggregator_real64_3d_t) + agg_shape = shape(this%source_data) + class default + call cable_abort("Unexpected aggregator type.", file=__FILE__, line=__LINE__) + end select + + end function aggregator_shape + + subroutine aggregator_scale(this, scale) + !! Scale the aggregated data by a specified factor. + class(aggregator_t), intent(inout) :: this + real, intent(in) :: scale !! The factor by which to scale the aggregated data. + + select type (this) + type is (aggregator_int32_0d_t) + this%aggregated_data = this%aggregated_data * scale + type is (aggregator_int32_1d_t) + this%aggregated_data = this%aggregated_data * scale + type is (aggregator_int32_2d_t) + this%aggregated_data = this%aggregated_data * scale + type is (aggregator_int32_3d_t) + this%aggregated_data = this%aggregated_data * scale + type is (aggregator_real32_0d_t) + this%aggregated_data = this%aggregated_data * scale + type is (aggregator_real32_1d_t) + this%aggregated_data = this%aggregated_data * scale + type is (aggregator_real32_2d_t) + this%aggregated_data = this%aggregated_data * scale + type is (aggregator_real32_3d_t) + this%aggregated_data = this%aggregated_data * scale + type is (aggregator_real64_0d_t) + this%aggregated_data = this%aggregated_data * scale + type is (aggregator_real64_1d_t) + this%aggregated_data = this%aggregated_data * scale + type is (aggregator_real64_2d_t) + this%aggregated_data = this%aggregated_data * scale + type is (aggregator_real64_3d_t) + this%aggregated_data = this%aggregated_data * scale + class default + call cable_abort("Unexpected aggregator type.", file=__FILE__, line=__LINE__) + end select + + end subroutine aggregator_scale + + subroutine aggregator_div(this, div) + !! Divide the aggregated data by a specified factor. + class(aggregator_t), intent(inout) :: this + real, intent(in) :: div !! The factor by which to divide the aggregated data. + + select type (this) + type is (aggregator_int32_0d_t) + this%aggregated_data = this%aggregated_data / div + type is (aggregator_int32_1d_t) + this%aggregated_data = this%aggregated_data / div + type is (aggregator_int32_2d_t) + this%aggregated_data = this%aggregated_data / div + type is (aggregator_int32_3d_t) + this%aggregated_data = this%aggregated_data / div + type is (aggregator_real32_0d_t) + this%aggregated_data = this%aggregated_data / div + type is (aggregator_real32_1d_t) + this%aggregated_data = this%aggregated_data / div + type is (aggregator_real32_2d_t) + this%aggregated_data = this%aggregated_data / div + type is (aggregator_real32_3d_t) + this%aggregated_data = this%aggregated_data / div + type is (aggregator_real64_0d_t) + this%aggregated_data = this%aggregated_data / div + type is (aggregator_real64_1d_t) + this%aggregated_data = this%aggregated_data / div + type is (aggregator_real64_2d_t) + this%aggregated_data = this%aggregated_data / div + type is (aggregator_real64_3d_t) + this%aggregated_data = this%aggregated_data / div + class default + call cable_abort("Unexpected aggregator type.", file=__FILE__, line=__LINE__) + end select + + end subroutine aggregator_div + + subroutine aggregator_offset(this, offset) + !! Offset the aggregated data by a specified value. + class(aggregator_t), intent(inout) :: this + real, intent(in) :: offset !! The value by which to offset the aggregated data. + + select type (this) + type is (aggregator_int32_0d_t) + this%aggregated_data = this%aggregated_data + offset + type is (aggregator_int32_1d_t) + this%aggregated_data = this%aggregated_data + offset + type is (aggregator_int32_2d_t) + this%aggregated_data = this%aggregated_data + offset + type is (aggregator_int32_3d_t) + this%aggregated_data = this%aggregated_data + offset + type is (aggregator_real32_0d_t) + this%aggregated_data = this%aggregated_data + offset + type is (aggregator_real32_1d_t) + this%aggregated_data = this%aggregated_data + offset + type is (aggregator_real32_2d_t) + this%aggregated_data = this%aggregated_data + offset + type is (aggregator_real32_3d_t) + this%aggregated_data = this%aggregated_data + offset + type is (aggregator_real64_0d_t) + this%aggregated_data = this%aggregated_data + offset + type is (aggregator_real64_1d_t) + this%aggregated_data = this%aggregated_data + offset + type is (aggregator_real64_2d_t) + this%aggregated_data = this%aggregated_data + offset + type is (aggregator_real64_3d_t) + this%aggregated_data = this%aggregated_data + offset + class default + call cable_abort("Unexpected aggregator type.", file=__FILE__, line=__LINE__) + end select + + end subroutine aggregator_offset + + subroutine get_accumulate_args(scale, div, offset, scale_out, div_out, offset_out) + !* Helper subroutine to get initialise optional scale, div, and offset arguments for + ! accumulate procedures. + real, intent(in), optional :: scale + !* An optional scaling factor to apply to the source data before + ! accumulation. Defaults to 1.0 if not provided. + real, intent(in), optional :: div + !* An optional division factor to apply to the source data before + ! accumulation. Defaults to 1.0 if not provided. + real, intent(in), optional :: offset + !* An optional offset to add to the source data before accumulation. + ! Defaults to 0.0 if not provided. + real :: scale_out, div_out, offset_out + + if (present(scale)) then + scale_out = scale + else + scale_out = 1.0 + end if + + if (present(div)) then + div_out = div + else + div_out = 1.0 + end if + + if (present(offset)) then + offset_out = offset + else + offset_out = 0.0 + end if + + end subroutine + + subroutine mean_accumulate(this, scale, div, offset) + !* Accumulate the aggregated data from the source data using the mean + ! aggregation method. + class(aggregator_t), intent(inout) :: this + real, intent(in), optional :: scale + !* An optional scaling factor to apply to the source data before + ! accumulation. Defaults to 1.0 if not provided. + real, intent(in), optional :: div + !* An optional division factor to apply to the source data before + ! accumulation. Defaults to 1.0 if not provided. + real, intent(in), optional :: offset + !* An optional offset to add to the source data before accumulation. + ! Defaults to 0.0 if not provided. + real :: scale_val, div_val, offset_val + + call get_accumulate_args(scale, div, offset, scale_val, div_val, offset_val) + + select type (this) + type is (aggregator_real32_0d_t) + this%aggregated_data = this%aggregated_data + ( & + scale_val * this%source_data / div + offset_val - this%aggregated_data & + ) / (this%counter + 1) + type is (aggregator_real32_1d_t) + this%aggregated_data = this%aggregated_data + ( & + scale_val * this%source_data / div + offset_val - this%aggregated_data & + ) / (this%counter + 1) + type is (aggregator_real32_2d_t) + this%aggregated_data = this%aggregated_data + ( & + scale_val * this%source_data / div + offset_val - this%aggregated_data & + ) / (this%counter + 1) + type is (aggregator_real32_3d_t) + this%aggregated_data = this%aggregated_data + ( & + scale_val * this%source_data / div + offset_val - this%aggregated_data & + ) / (this%counter + 1) + type is (aggregator_real64_0d_t) + this%aggregated_data = this%aggregated_data + ( & + real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div + offset_val, kind=real32 & +#else + scale_val * this%source_data / div + offset_val, kind=real64 & +#endif + ) - this%aggregated_data & + ) / (this%counter + 1) + type is (aggregator_real64_1d_t) + this%aggregated_data = this%aggregated_data + ( & + real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div + offset_val, kind=real32 & +#else + scale_val * this%source_data / div + offset_val, kind=real64 & +#endif + ) - this%aggregated_data & + ) / (this%counter + 1) + type is (aggregator_real64_2d_t) + this%aggregated_data = this%aggregated_data + ( & + real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div + offset_val, kind=real32 & +#else + scale_val * this%source_data / div + offset_val, kind=real64 & +#endif + ) - this%aggregated_data & + ) / (this%counter + 1) + type is (aggregator_real64_3d_t) + this%aggregated_data = this%aggregated_data + ( & + real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div + offset_val, kind=real32 & +#else + scale_val * this%source_data / div + offset_val, kind=real64 & +#endif + ) - this%aggregated_data & + ) / (this%counter + 1) + class default + call cable_abort("Unexpected aggregator type.", file=__FILE__, line=__LINE__) + end select + + this%counter = this%counter + 1 + + end subroutine mean_accumulate + + subroutine sum_accumulate(this, scale, div, offset) + !* Accumulate the aggregated data from the source data using the sum + ! aggregation method. + class(aggregator_t), intent(inout) :: this + real, intent(in), optional :: scale + !* An optional scaling factor to apply to the source data before + ! accumulation. Defaults to 1.0 if not provided. + real, intent(in), optional :: div + !* An optional division factor to apply to the source data before + ! accumulation. Defaults to 1.0 if not provided. + real, intent(in), optional :: offset + !* An optional offset to add to the source data before accumulation. + ! Defaults to 0.0 if not provided. + real :: scale_val, div_val, offset_val + + call get_accumulate_args(scale, div, offset, scale_val, div_val, offset_val) + + select type (this) + type is (aggregator_int32_0d_t) + this%aggregated_data = this%aggregated_data + int( & + scale_val * this%source_data / div_val + offset_val & + ) + type is (aggregator_int32_1d_t) + this%aggregated_data = this%aggregated_data + int( & + scale_val * this%source_data / div_val + offset_val & + ) + type is (aggregator_int32_2d_t) + this%aggregated_data = this%aggregated_data + int( & + scale_val * this%source_data / div_val + offset_val & + ) + type is (aggregator_int32_3d_t) + this%aggregated_data = this%aggregated_data + int( & + scale_val * this%source_data / div_val + offset_val & + ) + type is (aggregator_real32_0d_t) + this%aggregated_data = this%aggregated_data + ( & + scale_val * this%source_data / div_val + offset_val & + ) + type is (aggregator_real32_1d_t) + this%aggregated_data = this%aggregated_data + ( & + scale_val * this%source_data / div_val + offset_val & + ) + type is (aggregator_real32_2d_t) + this%aggregated_data = this%aggregated_data + ( & + scale_val * this%source_data / div_val + offset_val & + ) + type is (aggregator_real32_3d_t) + this%aggregated_data = this%aggregated_data + ( & + scale_val * this%source_data / div_val + offset_val & + ) + type is (aggregator_real64_0d_t) + this%aggregated_data = this%aggregated_data + real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div_val + offset_val, kind=real32 & +#else + scale_val * this%source_data / div_val + offset_val, kind=real64 & +#endif + ) + type is (aggregator_real64_1d_t) + this%aggregated_data = this%aggregated_data + real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div_val + offset_val, kind=real32 & +#else + scale_val * this%source_data / div_val + offset_val, kind=real64 & +#endif + ) + type is (aggregator_real64_2d_t) + this%aggregated_data = this%aggregated_data + real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div_val + offset_val, kind=real32 & +#else + scale_val * this%source_data / div_val + offset_val, kind=real64 & +#endif + ) + type is (aggregator_real64_3d_t) + this%aggregated_data = this%aggregated_data + real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div_val + offset_val, kind=real32 & +#else + scale_val * this%source_data / div_val + offset_val, kind=real64 & +#endif + ) + class default + call cable_abort("Unexpected aggregator type.", file=__FILE__, line=__LINE__) + end select + + this%counter = this%counter + 1 + + end subroutine sum_accumulate + + subroutine point_accumulate(this, scale, div, offset) + !* Accumulate the aggregated data from the source data using the point + ! aggregation method. + class(aggregator_t), intent(inout) :: this + real, intent(in), optional :: scale + !* An optional scaling factor to apply to the source data before + ! accumulation. Defaults to 1.0 if not provided. + real, intent(in), optional :: div + !* An optional division factor to apply to the source data before + ! accumulation. Defaults to 1.0 if not provided. + real, intent(in), optional :: offset + !* An optional offset to add to the source data before accumulation. + ! Defaults to 0.0 if not provided. + real :: scale_val, div_val, offset_val + + call get_accumulate_args(scale, div, offset, scale_val, div_val, offset_val) + + select type (this) + type is (aggregator_int32_0d_t) + this%aggregated_data = int(scale_val * this%source_data / div_val + offset_val) + type is (aggregator_int32_1d_t) + this%aggregated_data = int(scale_val * this%source_data / div_val + offset_val) + type is (aggregator_int32_2d_t) + this%aggregated_data = int(scale_val * this%source_data / div_val + offset_val) + type is (aggregator_int32_3d_t) + this%aggregated_data = int(scale_val * this%source_data / div_val + offset_val) + type is (aggregator_real32_0d_t) + this%aggregated_data = scale_val * this%source_data / div_val + offset_val + type is (aggregator_real32_1d_t) + this%aggregated_data = scale_val * this%source_data / div_val + offset_val + type is (aggregator_real32_2d_t) + this%aggregated_data = scale_val * this%source_data / div_val + offset_val + type is (aggregator_real32_3d_t) + this%aggregated_data = scale_val * this%source_data / div_val + offset_val + type is (aggregator_real64_0d_t) + this%aggregated_data = real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div_val + offset_val, kind=real32 & +#else + scale_val * this%source_data / div_val + offset_val, kind=real64 & +#endif + ) + type is (aggregator_real64_1d_t) + this%aggregated_data = real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div_val + offset_val, kind=real32 & +#else + scale_val * this%source_data / div_val + offset_val, kind=real64 & +#endif + ) + type is (aggregator_real64_2d_t) + this%aggregated_data = real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div_val + offset_val, kind=real32 & +#else + scale_val * this%source_data / div_val + offset_val, kind=real64 & +#endif + ) + type is (aggregator_real64_3d_t) + this%aggregated_data = real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div_val + offset_val, kind=real32 & +#else + scale_val * this%source_data / div_val + offset_val, kind=real64 & +#endif + ) + class default + call cable_abort("Unexpected aggregator type.", file=__FILE__, line=__LINE__) + end select + + this%counter = this%counter + 1 + + end subroutine point_accumulate + + subroutine min_accumulate(this, scale, div, offset) + !* Accumulate the aggregated data from the source data using the min + ! aggregation method. + class(aggregator_t), intent(inout) :: this + real, intent(in), optional :: scale + !* An optional scaling factor to apply to the source data before + ! accumulation. Defaults to 1.0 if not provided. + real, intent(in), optional :: div + !* An optional division factor to apply to the source data before + ! accumulation. Defaults to 1.0 if not provided. + real, intent(in), optional :: offset + !* An optional offset to add to the source data before accumulation. + ! Defaults to 0.0 if not provided. + real :: scale_val, div_val, offset_val + + call get_accumulate_args(scale, div, offset, scale_val, div_val, offset_val) + + select type (this) + type is (aggregator_int32_0d_t) + this%aggregated_data = min(this%aggregated_data, int( & + scale_val * this%source_data / div_val + offset_val & + )) + type is (aggregator_int32_1d_t) + this%aggregated_data = min(this%aggregated_data, int( & + scale_val * this%source_data / div_val + offset_val & + )) + type is (aggregator_int32_2d_t) + this%aggregated_data = min(this%aggregated_data, int( & + scale_val * this%source_data / div_val + offset_val & + )) + type is (aggregator_int32_3d_t) + this%aggregated_data = min(this%aggregated_data, int( & + scale_val * this%source_data / div_val + offset_val & + )) + type is (aggregator_real32_0d_t) + this%aggregated_data = min(this%aggregated_data, ( & + scale_val * this%source_data / div_val + offset_val & + )) + type is (aggregator_real32_1d_t) + this%aggregated_data = min(this%aggregated_data, ( & + scale_val * this%source_data / div_val + offset_val & + )) + type is (aggregator_real32_2d_t) + this%aggregated_data = min(this%aggregated_data, ( & + scale_val * this%source_data / div_val + offset_val & + )) + type is (aggregator_real32_3d_t) + this%aggregated_data = min(this%aggregated_data, ( & + scale_val * this%source_data / div_val + offset_val & + )) + type is (aggregator_real64_0d_t) + this%aggregated_data = min(this%aggregated_data, real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div_val + offset_val, kind=real32 & +#else + scale_val * this%source_data / div_val + offset_val, kind=real64 & +#endif + )) + type is (aggregator_real64_1d_t) + this%aggregated_data = min(this%aggregated_data, real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div_val + offset_val, kind=real32 & +#else + scale_val * this%source_data / div_val + offset_val, kind=real64 & +#endif + )) + type is (aggregator_real64_2d_t) + this%aggregated_data = min(this%aggregated_data, real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div_val + offset_val, kind=real32 & +#else + scale_val * this%source_data / div_val + offset_val, kind=real64 & +#endif + )) + type is (aggregator_real64_3d_t) + this%aggregated_data = min(this%aggregated_data, real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div_val + offset_val, kind=real32 & +#else + scale_val * this%source_data / div_val + offset_val, kind=real64 & +#endif + )) + class default + call cable_abort("Unexpected aggregator type.", file=__FILE__, line=__LINE__) + end select + + this%counter = this%counter + 1 + + end subroutine min_accumulate + + subroutine max_accumulate(this, scale, div, offset) + !* Accumulate the aggregated data from the source data using the max + ! aggregation method. + class(aggregator_t), intent(inout) :: this + real, intent(in), optional :: scale + !* An optional scaling factor to apply to the source data before + ! accumulation. Defaults to 1.0 if not provided. + real, intent(in), optional :: div + !* An optional division factor to apply to the source data before + ! accumulation. Defaults to 1.0 if not provided. + real, intent(in), optional :: offset + !* An optional offset to add to the source data before accumulation. + ! Defaults to 0.0 if not provided. + real :: scale_val, div_val, offset_val + + call get_accumulate_args(scale, div, offset, scale_val, div_val, offset_val) + + select type (this) + type is (aggregator_int32_0d_t) + this%aggregated_data = max(this%aggregated_data, int( & + scale_val * this%source_data / div_val + offset_val & + )) + type is (aggregator_int32_1d_t) + this%aggregated_data = max(this%aggregated_data, int( & + scale_val * this%source_data / div_val + offset_val & + )) + type is (aggregator_int32_2d_t) + this%aggregated_data = max(this%aggregated_data, int( & + scale_val * this%source_data / div_val + offset_val & + )) + type is (aggregator_int32_3d_t) + this%aggregated_data = max(this%aggregated_data, int( & + scale_val * this%source_data / div_val + offset_val & + )) + type is (aggregator_real32_0d_t) + this%aggregated_data = max(this%aggregated_data, ( & + scale_val * this%source_data / div_val + offset_val & + )) + type is (aggregator_real32_1d_t) + this%aggregated_data = max(this%aggregated_data, ( & + scale_val * this%source_data / div_val + offset_val & + )) + type is (aggregator_real32_2d_t) + this%aggregated_data = max(this%aggregated_data, ( & + scale_val * this%source_data / div_val + offset_val & + )) + type is (aggregator_real32_3d_t) + this%aggregated_data = max(this%aggregated_data, ( & + scale_val * this%source_data / div_val + offset_val & + )) + type is (aggregator_real64_0d_t) + this%aggregated_data = max(this%aggregated_data, real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div_val + offset_val, kind=real32 & +#else + scale_val * this%source_data / div_val + offset_val, kind=real64 & +#endif + )) + type is (aggregator_real64_1d_t) + this%aggregated_data = max(this%aggregated_data, real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div_val + offset_val, kind=real32 & +#else + scale_val * this%source_data / div_val + offset_val, kind=real64 & +#endif + )) + type is (aggregator_real64_2d_t) + this%aggregated_data = max(this%aggregated_data, real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div_val + offset_val, kind=real32 & +#else + scale_val * this%source_data / div_val + offset_val, kind=real64 & +#endif + )) + type is (aggregator_real64_3d_t) + this%aggregated_data = max(this%aggregated_data, real( & +#ifdef ENFORCE_SINGLE_PRECISION + scale_val * this%source_data / div_val + offset_val, kind=real32 & +#else + scale_val * this%source_data / div_val + offset_val, kind=real64 & +#endif + )) + class default + call cable_abort("Unexpected aggregator type.", file=__FILE__, line=__LINE__) + end select + + this%counter = this%counter + 1 + + end subroutine max_accumulate + + subroutine point_reset(this) + !* Reset the aggregated data for the point aggregation method. This is a + ! no-op since point aggregation always takes the value of the most recent data + ! point. + class(aggregator_t), intent(inout) :: this + end subroutine point_reset + + subroutine min_reset(this) + !! Reset the aggregated data for the min aggregation method. + class(aggregator_t), intent(inout) :: this + + select type (this) + type is (aggregator_int32_0d_t) + this%aggregated_data = huge(0_int32) + type is (aggregator_int32_1d_t) + this%aggregated_data = huge(0_int32) + type is (aggregator_int32_2d_t) + this%aggregated_data = huge(0_int32) + type is (aggregator_int32_3d_t) + this%aggregated_data = huge(0_int32) + type is (aggregator_real32_0d_t) + this%aggregated_data = huge(0.0_real32) + type is (aggregator_real32_1d_t) + this%aggregated_data = huge(0.0_real32) + type is (aggregator_real32_2d_t) + this%aggregated_data = huge(0.0_real32) + type is (aggregator_real32_3d_t) + this%aggregated_data = huge(0.0_real32) + type is (aggregator_real64_0d_t) +#ifdef ENFORCE_SINGLE_PRECISION + this%aggregated_data = huge(0.0_real32) +#else + this%aggregated_data = huge(0.0_real64) +#endif + type is (aggregator_real64_1d_t) +#ifdef ENFORCE_SINGLE_PRECISION + this%aggregated_data = huge(0.0_real32) +#else + this%aggregated_data = huge(0.0_real64) +#endif + type is (aggregator_real64_2d_t) +#ifdef ENFORCE_SINGLE_PRECISION + this%aggregated_data = huge(0.0_real32) +#else + this%aggregated_data = huge(0.0_real64) +#endif + type is (aggregator_real64_3d_t) +#ifdef ENFORCE_SINGLE_PRECISION + this%aggregated_data = huge(0.0_real32) +#else + this%aggregated_data = huge(0.0_real64) +#endif + class default + call cable_abort("Unexpected aggregator type.", file=__FILE__, line=__LINE__) + end select + + this%counter = 0 + + end subroutine min_reset + + subroutine max_reset(this) + !! Reset the aggregated data for the max aggregation method. + class(aggregator_t), intent(inout) :: this + + select type (this) + type is (aggregator_int32_0d_t) + this%aggregated_data = -huge(0_int32) + type is (aggregator_int32_1d_t) + this%aggregated_data = -huge(0_int32) + type is (aggregator_int32_2d_t) + this%aggregated_data = -huge(0_int32) + type is (aggregator_int32_3d_t) + this%aggregated_data = -huge(0_int32) + type is (aggregator_real32_0d_t) + this%aggregated_data = -huge(0.0_real32) + type is (aggregator_real32_1d_t) + this%aggregated_data = -huge(0.0_real32) + type is (aggregator_real32_2d_t) + this%aggregated_data = -huge(0.0_real32) + type is (aggregator_real32_3d_t) + this%aggregated_data = -huge(0.0_real32) + type is (aggregator_real64_0d_t) +#ifdef ENFORCE_SINGLE_PRECISION + this%aggregated_data = -huge(0.0_real32) +#else + this%aggregated_data = -huge(0.0_real64) +#endif + type is (aggregator_real64_1d_t) +#ifdef ENFORCE_SINGLE_PRECISION + this%aggregated_data = -huge(0.0_real32) +#else + this%aggregated_data = -huge(0.0_real64) +#endif + type is (aggregator_real64_2d_t) +#ifdef ENFORCE_SINGLE_PRECISION + this%aggregated_data = -huge(0.0_real32) +#else + this%aggregated_data = -huge(0.0_real64) +#endif + type is (aggregator_real64_3d_t) +#ifdef ENFORCE_SINGLE_PRECISION + this%aggregated_data = -huge(0.0_real32) +#else + this%aggregated_data = -huge(0.0_real64) +#endif + class default + call cable_abort("Unexpected aggregator type.", file=__FILE__, line=__LINE__) + end select + + this%counter = 0 + + end subroutine max_reset + + subroutine other_reset(this) + !! Reset the aggregated data for aggregation methods other than point, min, and max. + class(aggregator_t), intent(inout) :: this + + select type (this) + type is (aggregator_int32_0d_t) + this%aggregated_data = 0_int32 + type is (aggregator_int32_1d_t) + this%aggregated_data = 0_int32 + type is (aggregator_int32_2d_t) + this%aggregated_data = 0_int32 + type is (aggregator_int32_3d_t) + this%aggregated_data = 0_int32 + type is (aggregator_real32_0d_t) + this%aggregated_data = 0.0_real32 + type is (aggregator_real32_1d_t) + this%aggregated_data = 0.0_real32 + type is (aggregator_real32_2d_t) + this%aggregated_data = 0.0_real32 + type is (aggregator_real32_3d_t) + this%aggregated_data = 0.0_real32 + type is (aggregator_real64_0d_t) +#ifdef ENFORCE_SINGLE_PRECISION + this%aggregated_data = 0.0_real32 +#else + this%aggregated_data = 0.0_real64 +#endif + type is (aggregator_real64_1d_t) +#ifdef ENFORCE_SINGLE_PRECISION + this%aggregated_data = 0.0_real32 +#else + this%aggregated_data = 0.0_real64 +#endif + type is (aggregator_real64_2d_t) +#ifdef ENFORCE_SINGLE_PRECISION + this%aggregated_data = 0.0_real32 +#else + this%aggregated_data = 0.0_real64 +#endif + type is (aggregator_real64_3d_t) +#ifdef ENFORCE_SINGLE_PRECISION + this%aggregated_data = 0.0_real32 +#else + this%aggregated_data = 0.0_real64 +#endif + class default + call cable_abort("Unexpected aggregator type.", file=__FILE__, line=__LINE__) + end select + + this%counter = 0 + + end subroutine other_reset + + function new_aggregator_int32_0d_t(source_data) result(agg) + !! Create a new 0D integer aggregator. + integer(kind=int32), intent(inout), target :: source_data + !! The source data array to be sampled by the aggregator. + type(aggregator_int32_0d_t) :: agg + + agg%source_data => source_data + + end function new_aggregator_int32_0d_t + + function new_aggregator_int32_1d_t(source_data) result(agg) + !! Create a new 1D integer aggregator. + integer(kind=int32), dimension(:), intent(inout), target :: source_data + !! The source data array to be sampled by the aggregator. + type(aggregator_int32_1d_t) :: agg + + agg%source_data => source_data + + end function new_aggregator_int32_1d_t + + function new_aggregator_int32_2d_t(source_data) result(agg) + !! Create a new 2D integer aggregator. + integer(kind=int32), dimension(:,:), intent(inout), target :: source_data + !! The source data array to be sampled by the aggregator. + type(aggregator_int32_2d_t) :: agg + + agg%source_data => source_data + + end function new_aggregator_int32_2d_t + + function new_aggregator_int32_3d_t(source_data) result(agg) + !! Create a new 3D integer aggregator. + integer(kind=int32), dimension(:,:,:), intent(inout), target :: source_data + !! The source data array to be sampled by the aggregator. + type(aggregator_int32_3d_t) :: agg + + agg%source_data => source_data + + end function new_aggregator_int32_3d_t + + function new_aggregator_real32_0d(source_data) result(agg) + !! Create a new 0D 32-bit real aggregator. + real(kind=real32), intent(inout), target :: source_data + !! The source data array to be sampled by the aggregator. + type(aggregator_real32_0d_t) :: agg + + agg%source_data => source_data + + end function new_aggregator_real32_0d + + function new_aggregator_real32_1d(source_data) result(agg) + !! Create a new 1D 32-bit real aggregator. + real(kind=real32), dimension(:), intent(inout), target :: source_data + !! The source data array to be sampled by the aggregator. + type(aggregator_real32_1d_t) :: agg + + agg%source_data => source_data + + end function new_aggregator_real32_1d + + function new_aggregator_real32_2d(source_data) result(agg) + !! Create a new 2D 32-bit real aggregator. + real(kind=real32), dimension(:,:), intent(inout), target :: source_data + !! The source data array to be sampled by the aggregator. + type(aggregator_real32_2d_t) :: agg + + agg%source_data => source_data + + end function new_aggregator_real32_2d + + function new_aggregator_real32_3d(source_data) result(agg) + !! Create a new 3D 32-bit real aggregator. + real(kind=real32), dimension(:,:,:), intent(inout), target :: source_data + !! The source data array to be sampled by the aggregator. + type(aggregator_real32_3d_t) :: agg + + agg%source_data => source_data + + end function new_aggregator_real32_3d + + function new_aggregator_real64_0d(source_data) result(agg) + !! Create a new 0D 64-bit real aggregator. + real(kind=real64), intent(inout), target :: source_data + !! The source data array to be sampled by the aggregator. + type(aggregator_real64_0d_t) :: agg + + agg%source_data => source_data + + end function new_aggregator_real64_0d + + function new_aggregator_real64_1d(source_data) result(agg) + !! Create a new 1D 64-bit real aggregator. + real(kind=real64), dimension(:), intent(inout), target :: source_data + !! The source data array to be sampled by the aggregator. + type(aggregator_real64_1d_t) :: agg + + agg%source_data => source_data + + end function new_aggregator_real64_1d + + function new_aggregator_real64_2d(source_data) result(agg) + !! Create a new 2D 64-bit real aggregator. + real(kind=real64), dimension(:,:), intent(inout), target :: source_data + !! The source data array to be sampled by the aggregator. + type(aggregator_real64_2d_t) :: agg + + agg%source_data => source_data + + end function new_aggregator_real64_2d + + function new_aggregator_real64_3d(source_data) result(agg) + !! Create a new 3D 64-bit real aggregator. + real(kind=real64), dimension(:,:,:), intent(inout), target :: source_data + !! The source data array to be sampled by the aggregator. + type(aggregator_real64_3d_t) :: agg + + agg%source_data => source_data + + end function new_aggregator_real64_3d + +end module diff --git a/src/util/cable_array_utils.F90 b/src/util/cable_array_utils.F90 index 50a25ebb5..bfbb1d53d 100644 --- a/src/util/cable_array_utils.F90 +++ b/src/util/cable_array_utils.F90 @@ -4,12 +4,18 @@ module cable_array_utils_mod !! Utility procedures for working with arrays. + use iso_fortran_env, only: int32 implicit none private public array_offset public array_index public array_partition + public array_eq + + interface array_eq + module procedure array_eq_int32 + end interface contains @@ -68,4 +74,14 @@ subroutine array_partition(n, k, p, start, count) end subroutine array_partition + !> Check if two integer arrays are equal. + logical function array_eq_int32(a, b) + integer(kind=int32), dimension(:), intent(in) :: a, b + if (size(a) /= size(b)) then + array_eq_int32 = .false. + else + array_eq_int32 = all(a == b) + end if + end function array_eq_int32 + end module cable_array_utils_mod diff --git a/src/util/cable_grid_reductions.F90 b/src/util/cable_grid_reductions.F90 new file mode 100644 index 000000000..5a328fb8b --- /dev/null +++ b/src/util/cable_grid_reductions.F90 @@ -0,0 +1,426 @@ +! CSIRO Open Source Software License Agreement (variation of the BSD / MIT License) +! Copyright (c) 2015, Commonwealth Scientific and Industrial Research Organisation +! (CSIRO) ABN 41 687 119 230. + +module cable_grid_reductions_mod + !* This module provides procedures for performing various grid cell reductions + ! for data along some dimension. This is commonly used for reducing data along + ! the tile/patch dimension to a per grid cell value. + + use iso_fortran_env, only: int32, real32, real64 + + use cable_io_vars_module, only: patch_type, land_type + + implicit none + private + + public :: grid_cell_average + public :: first_patch_in_grid_cell + + interface grid_cell_average + !* Interface for computing the area weighted average over the patch/tile + ! dimension for various data types and array ranks. + module procedure grid_cell_average_real32_1d + module procedure grid_cell_average_real32_2d + module procedure grid_cell_average_real32_3d + module procedure grid_cell_average_real64_1d + module procedure grid_cell_average_real64_2d + module procedure grid_cell_average_real64_3d + end interface + + interface first_patch_in_grid_cell + !* Interface for extracting the value from the first patch/tile in each grid + ! cell for various data types and array ranks. This is useful for arrays where + ! averaging along the patch/tile dimension does not make sense, or where the + ! array contains the same value everywhere along the patch/tile dimension. + module procedure first_patch_in_grid_cell_int32_1d + module procedure first_patch_in_grid_cell_int32_2d + module procedure first_patch_in_grid_cell_int32_3d + module procedure first_patch_in_grid_cell_real32_1d + module procedure first_patch_in_grid_cell_real32_2d + module procedure first_patch_in_grid_cell_real32_3d + module procedure first_patch_in_grid_cell_real64_1d + module procedure first_patch_in_grid_cell_real64_2d + module procedure first_patch_in_grid_cell_real64_3d + end interface + +contains + + subroutine grid_cell_average_real32_1d(input_array, output_array, patch, landpt) + !* Computes the area weighted average over the patch/tile dimension for a 1D + ! 32-bit real array. + real(kind=real32), intent(in) :: input_array(:) + !* The input array to be reduced. The first (i.e. fastest varying) + ! dimension of this array must be the patch/tile dimension being reduced. + real(kind=real32), intent(out) :: output_array(:) + !* The output array containing the grid cell averaged values. The first + ! (i.e. fastest varying) dimension of this array must be equal to the number + ! of grid cells. + type(patch_type), intent(in) :: patch(:) + !* The `patch_type` instance describing the area fraction of each active + ! patch/tile dimension. + type(land_type), intent(in) :: landpt(:) + !* The `land_type` instance describing the starting and ending patch/tile + ! indexes in the input array for each grid cell. + integer :: land_index, patch_index + + do land_index = 1, size(output_array) + output_array(land_index) = 0.0_real32 + do patch_index = landpt(land_index)%cstart, landpt(land_index)%cend + output_array(land_index) = output_array(land_index) + & + input_array(patch_index) * patch(patch_index)%frac + end do + end do + + end subroutine + + subroutine grid_cell_average_real32_2d(input_array, output_array, patch, landpt) + !* Computes the area weighted average over the patch/tile dimension for a 2D + ! 32-bit real array. + real(kind=real32), intent(in) :: input_array(:, :) + !* The input array to be reduced. The first (i.e. fastest varying) dimension of + ! this array must be the patch/tile dimension being reduced. + real(kind=real32), intent(out) :: output_array(:, :) + !* The output array containing the grid cell averaged values. The first + ! (i.e. fastest varying) dimension of this array must be equal to the + ! number of grid cells. + type(patch_type), intent(in) :: patch(:) + !* The `patch_type` instance describing the area fraction of each active + ! patch/tile dimension. + type(land_type), intent(in) :: landpt(:) + !* The `land_type` instance describing the starting and ending patch/tile + ! indexes in the input array for each grid cell. + integer :: land_index, patch_index, j + + do j = 1, size(output_array, 2) + do land_index = 1, size(output_array, 1) + output_array(land_index, j) = 0.0_real32 + do patch_index = landpt(land_index)%cstart, landpt(land_index)%cend + output_array(land_index, j) = ( & + output_array(land_index, j) + input_array(patch_index, j) * patch(patch_index)%frac & + ) + end do + end do + end do + + end subroutine + + subroutine grid_cell_average_real32_3d(input_array, output_array, patch, landpt) + !* Computes the area weighted average over the patch/tile dimension for a 3D + ! 32-bit real array. + real(kind=real32), intent(in) :: input_array(:, :, :) + !* The input array to be reduced. The first (i.e. fastest varying) dimension of + ! this array must be the patch/tile dimension being reduced. + real(kind=real32), intent(out) :: output_array(:, :, :) + !* The output array containing the grid cell averaged values. The first + ! (i.e. fastest varying) dimension of this array must be equal to the + ! number of grid cells. + type(patch_type), intent(in) :: patch(:) + !* The `patch_type` instance describing the area fraction of each active + ! patch/tile dimension. + type(land_type), intent(in) :: landpt(:) + !* The `land_type` instance describing the starting and ending patch/tile + ! indexes in the input array for each grid cell. + integer :: land_index, patch_index, j, k + + do k = 1, size(output_array, 3) + do j = 1, size(output_array, 2) + do land_index = 1, size(output_array, 1) + output_array(land_index, j, k) = 0.0_real32 + do patch_index = landpt(land_index)%cstart, landpt(land_index)%cend + output_array(land_index, j, k) = ( & + output_array(land_index, j, k) + & + input_array(patch_index, j, k) * patch(patch_index)%frac & + ) + end do + end do + end do + end do + + end subroutine + + subroutine grid_cell_average_real64_1d(input_array, output_array, patch, landpt) + !* Computes the area weighted average over the patch/tile dimension for a 1D + ! 64-bit real array. + real(kind=real64), intent(in) :: input_array(:) + !* The input array to be reduced. The first (i.e. fastest varying) + ! dimension of this array must be the patch/tile dimension being reduced. + real(kind=real64), intent(out) :: output_array(:) + !* The output array containing the grid cell averaged values. The first + ! (i.e. fastest varying) dimension of this array must be equal to the number + ! of grid cells. + type(patch_type), intent(in) :: patch(:) + !* The `patch_type` instance describing the area fraction of each active + ! patch/tile dimension. + type(land_type), intent(in) :: landpt(:) + !* The `land_type` instance describing the starting and ending patch/tile + ! indexes in the input array for each grid cell. + integer :: land_index, patch_index + + do land_index = 1, size(output_array) + output_array(land_index) = 0.0_real64 + do patch_index = landpt(land_index)%cstart, landpt(land_index)%cend + output_array(land_index) = output_array(land_index) + & + input_array(patch_index) * patch(patch_index)%frac + end do + end do + + end subroutine + + subroutine grid_cell_average_real64_2d(input_array, output_array, patch, landpt) + !* Computes the area weighted average over the patch/tile dimension for a 2D + ! 64-bit real array. + real(kind=real64), intent(in) :: input_array(:, :) + !* The input array to be reduced. The first (i.e. fastest varying) dimension of + ! this array must be the patch/tile dimension being reduced. + real(kind=real64), intent(out) :: output_array(:, :) + !* The output array containing the grid cell averaged values. The first + ! (i.e. fastest varying) dimension of this array must be equal to the + ! number of grid cells. + type(patch_type), intent(in) :: patch(:) + !* The `patch_type` instance describing the area fraction of each active + ! patch/tile dimension. + type(land_type), intent(in) :: landpt(:) + !* The `land_type` instance describing the starting and ending patch/tile + ! indexes in the input array for each grid cell. + integer :: land_index, patch_index, j + + do j = 1, size(output_array, 2) + do land_index = 1, size(output_array, 1) + output_array(land_index, j) = 0.0_real64 + do patch_index = landpt(land_index)%cstart, landpt(land_index)%cend + output_array(land_index, j) = ( & + output_array(land_index, j) + input_array(patch_index, j) * patch(patch_index)%frac & + ) + end do + end do + end do + + end subroutine + + subroutine grid_cell_average_real64_3d(input_array, output_array, patch, landpt) + !* Computes the area weighted average over the patch/tile dimension for a 3D + ! 64-bit real array. + real(kind=real64), intent(in) :: input_array(:, :, :) + !* The input array to be reduced. The first (i.e. fastest varying) dimension of + ! this array must be the patch/tile dimension being reduced. + real(kind=real64), intent(out) :: output_array(:, :, :) + !* The output array containing the grid cell averaged values. The first + ! (i.e. fastest varying) dimension of this array must be equal to the + ! number of grid cells. + type(patch_type), intent(in) :: patch(:) + !* The `patch_type` instance describing the area fraction of each active + ! patch/tile dimension. + type(land_type), intent(in) :: landpt(:) + !* The `land_type` instance describing the starting and ending patch/tile + ! indexes in the input array for each grid cell. + integer :: land_index, patch_index, j, k + + do k = 1, size(output_array, 3) + do j = 1, size(output_array, 2) + do land_index = 1, size(output_array, 1) + output_array(land_index, j, k) = 0.0_real64 + do patch_index = landpt(land_index)%cstart, landpt(land_index)%cend + output_array(land_index, j, k) = ( & + output_array(land_index, j, k) + & + input_array(patch_index, j, k) * patch(patch_index)%frac & + ) + end do + end do + end do + end do + + end subroutine + + subroutine first_patch_in_grid_cell_int32_1d(input_array, output_array, landpt) + !! Extracts the first patch value for each grid cell from a 1D integer array. + integer(kind=int32), intent(in) :: input_array(:) + !* The input array to be reduced. The first (i.e. fastest varying) dimension of + ! this array must be the patch/tile dimension being reduced. + integer(kind=int32), intent(out) :: output_array(:) + !* The output array containing the reduced per grid cell values. The first + ! (i.e. fastest varying) dimension of this array must be equal to the number + ! of grid cells. + type(land_type), intent(in) :: landpt(:) + !* The `land_type` instance describing the starting and ending patch/tile + ! indexes in the input array for each grid cell. + integer :: land_index + + do land_index = 1, size(output_array) + output_array(land_index) = input_array(landpt(land_index)%cstart) + end do + + end subroutine + + subroutine first_patch_in_grid_cell_int32_2d(input_array, output_array, landpt) + !! Extracts the first patch value for each grid cell from a 2D integer array. + integer(kind=int32), intent(in) :: input_array(:, :) + !* The input array to be reduced. The first (i.e. fastest varying) dimension of + ! this array must be the patch/tile dimension being reduced. + integer(kind=int32), intent(out) :: output_array(:, :) + !* The output array containing the reduced per grid cell values. The first + ! (i.e. fastest varying) dimension of this array must be equal to the number + ! of grid cells. + type(land_type), intent(in) :: landpt(:) + !* The `land_type` instance describing the starting and ending patch/tile + ! indexes in the input array for each grid cell. + integer :: land_index, j + + do j = 1, size(output_array, 2) + do land_index = 1, size(output_array, 1) + output_array(land_index, j) = input_array(landpt(land_index)%cstart, j) + end do + end do + + end subroutine + + subroutine first_patch_in_grid_cell_int32_3d(input_array, output_array, landpt) + !! Extracts the first patch value for each grid cell from a 3D integer array. + integer(kind=int32), intent(in) :: input_array(:, :, :) + !* The input array to be reduced. The first (i.e. fastest varying) dimension of + ! this array must be the patch/tile dimension being reduced. + integer(kind=int32), intent(out) :: output_array(:, :, :) + !* The output array containing the reduced per grid cell values. The first + ! (i.e. fastest varying) dimension of this array must be equal to the number + ! of grid cells. + type(land_type), intent(in) :: landpt(:) + !* The `land_type` instance describing the starting and ending patch/tile + ! indexes in the input array for each grid cell. + integer :: land_index, j, k + + do k = 1, size(output_array, 3) + do j = 1, size(output_array, 2) + do land_index = 1, size(output_array, 1) + output_array(land_index, j, k) = input_array(landpt(land_index)%cstart, j, k) + end do + end do + end do + + end subroutine + + subroutine first_patch_in_grid_cell_real32_1d(input_array, output_array, landpt) + !! Extracts the first patch value for each grid cell from a 1D 32-bit real array. + real(kind=real32), intent(in) :: input_array(:) + !* The input array to be reduced. The first (i.e. fastest varying) dimension of + ! this array must be the patch/tile dimension being reduced. + real(kind=real32), intent(out) :: output_array(:) + !* The output array containing the reduced per grid cell values. The first + ! (i.e. fastest varying) dimension of this array must be equal to the number + ! of grid cells. + type(land_type), intent(in) :: landpt(:) + !* The `land_type` instance describing the starting and ending patch/tile + ! indexes in the input array for each grid cell. + integer :: land_index + + do land_index = 1, size(output_array) + output_array(land_index) = input_array(landpt(land_index)%cstart) + end do + + end subroutine + + subroutine first_patch_in_grid_cell_real32_2d(input_array, output_array, landpt) + !! Extracts the first patch value for each grid cell from a 2D 32-bit real array. + real(kind=real32), intent(in) :: input_array(:, :) + !* The input array to be reduced. The first (i.e. fastest varying) dimension of + ! this array must be the patch/tile dimension being reduced. + real(kind=real32), intent(out) :: output_array(:, :) + !* The output array containing the reduced per grid cell values. The first + ! (i.e. fastest varying) dimension of this array must be equal to the number + ! of grid cells. + type(land_type), intent(in) :: landpt(:) + !* The `land_type` instance describing the starting and ending patch/tile + ! indexes in the input array for each grid cell. + integer :: land_index, j + + do j = 1, size(output_array, 2) + do land_index = 1, size(output_array, 1) + output_array(land_index, j) = input_array(landpt(land_index)%cstart, j) + end do + end do + + end subroutine + + subroutine first_patch_in_grid_cell_real32_3d(input_array, output_array, landpt) + !! Extracts the first patch value for each grid cell from a 3D 32-bit real array. + real(kind=real32), intent(in) :: input_array(:, :, :) + !* The input array to be reduced. The first (i.e. fastest varying) dimension of + ! this array must be the patch/tile dimension being reduced. + real(kind=real32), intent(out) :: output_array(:, :, :) + !* The output array containing the reduced per grid cell values. The first + ! (i.e. fastest varying) dimension of this array must be equal to the number + ! of grid cells. + type(land_type), intent(in) :: landpt(:) + !* The `land_type` instance describing the starting and ending patch/tile + ! indexes in the input array for each grid cell. + integer :: land_index, j, k + + do k = 1, size(output_array, 3) + do j = 1, size(output_array, 2) + do land_index = 1, size(output_array, 1) + output_array(land_index, j, k) = input_array(landpt(land_index)%cstart, j, k) + end do + end do + end do + + end subroutine + + subroutine first_patch_in_grid_cell_real64_1d(input_array, output_array, landpt) + !! Extracts the first patch value for each grid cell from a 1D 64-bit real array. + real(kind=real64), intent(in) :: input_array(:) + !* The input array to be reduced. The first (i.e. fastest varying) dimension of + ! this array must be the patch/tile dimension being reduced. + real(kind=real64), intent(out) :: output_array(:) + !* The output array containing the reduced per grid cell values. The first + ! (i.e. fastest varying) dimension of this array must be equal to the number + ! of grid cells. + type(land_type), intent(in) :: landpt(:) + !* The `land_type` instance describing the starting and ending patch/tile + ! indexes in the input array for each grid cell. + integer :: land_index + + do land_index = 1, size(output_array) + output_array(land_index) = input_array(landpt(land_index)%cstart) + end do + + end subroutine + + subroutine first_patch_in_grid_cell_real64_2d(input_array, output_array, landpt) + !! Extracts the first patch value for each grid cell from a 2D 64-bit real array. + real(kind=real64), intent(in) :: input_array(:, :) + real(kind=real64), intent(out) :: output_array(:, :) + type(land_type), intent(in) :: landpt(:) + integer :: land_index, j + + do j = 1, size(output_array, 2) + do land_index = 1, size(output_array, 1) + output_array(land_index, j) = input_array(landpt(land_index)%cstart, j) + end do + end do + + end subroutine + + subroutine first_patch_in_grid_cell_real64_3d(input_array, output_array, landpt) + !! Extracts the first patch value for each grid cell from a 3D 64-bit real array. + real(kind=real64), intent(in) :: input_array(:, :, :) + !* The input array to be reduced. The first (i.e. fastest varying) dimension of + ! this array must be the patch/tile dimension being reduced. + real(kind=real64), intent(out) :: output_array(:, :, :) + !* The output array containing the reduced per grid cell values. The first + ! (i.e. fastest varying) dimension of this array must be equal to the number + ! of grid cells. + type(land_type), intent(in) :: landpt(:) + !* The `land_type` instance describing the starting and ending patch/tile + ! indexes in the input array for each grid cell. + integer :: land_index, j, k + + do k = 1, size(output_array, 3) + do j = 1, size(output_array, 2) + do land_index = 1, size(output_array, 1) + output_array(land_index, j, k) = input_array(landpt(land_index)%cstart, j, k) + end do + end do + end do + + end subroutine + +end module diff --git a/src/util/cable_timing.F90 b/src/util/cable_timing.F90 new file mode 100644 index 000000000..1f26fb9dd --- /dev/null +++ b/src/util/cable_timing.F90 @@ -0,0 +1,131 @@ +! CSIRO Open Source Software License Agreement (variation of the BSD / MIT License) +! Copyright (c) 2015, Commonwealth Scientific and Industrial Research Organisation +! (CSIRO) ABN 41 687 119 230. + +module cable_timing_mod + !! Module for handling timing in CABLE. + use cable_error_handler_mod, only: cable_abort + use cable_common_module, only: is_leapyear, current_year => CurYear + use cable_io_vars_module, only: leaps + implicit none + private + + public :: cable_timing_frequency_matches + public :: cable_timing_frequency_is_greater_than + public :: cable_timing_set_start_year + + integer, parameter, public :: seconds_per_hour = 3600 + integer, parameter, public :: hours_per_day = 24 + integer, parameter, public :: seconds_per_day = 86400 + integer, parameter, public :: months_in_year = 12 + + !> Cumulative day of year at the end of each month for a non-leap year. + integer, parameter, dimension(months_in_year) :: last_day = [ & + 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 & + ] + + !> Cumulative day of year at the end of each month for a leap year. + integer, parameter, dimension(months_in_year) :: last_day_leap = [ & + 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366 & + ] + + integer, parameter :: START_YEAR_UNDEFINED = -1 + + !> Start year of the simulation. + integer :: start_year = START_YEAR_UNDEFINED + +contains + + subroutine cable_timing_set_start_year(year) + !* Set the start year of the simulation. This is used for calculating monthly + ! timing. + integer, intent(in) :: year + start_year = year + end subroutine + + function cable_timing_frequency_matches(dels, ktau, frequency) result(match) + !! Determines whether the current time step matches the specified frequency. + real, intent(in) :: dels !! Model time step in seconds + integer, intent(in) :: ktau !! Current time step index + character(len=*), intent(in) :: frequency !! Frequency string: 'all', 'user', 'daily', 'monthly' + logical :: match + integer :: i, time_steps_per_interval, interval_in_hours + integer :: last_day_of_month_in_total_elapsed_days(months_in_year) + + select case (frequency) + case ('user') + read(frequency(5:7), *) interval_in_hours + time_steps_per_interval = seconds_per_hour * interval_in_hours / int(dels) + match = mod(ktau, time_steps_per_interval) == 0 + case ('all') + match = .true. + case ('daily') + time_steps_per_interval = seconds_per_hour * hours_per_day / int(dels) + match = mod(ktau, time_steps_per_interval) == 0 + case ('monthly') + if (start_year == START_YEAR_UNDEFINED) then + call cable_abort('start_year undefined for monthly frequency', __FILE__, __LINE__) + end if + last_day_of_month_in_total_elapsed_days = 0 + do i = start_year, current_year - 1 + if (leaps .and. is_leapyear(i)) then + last_day_of_month_in_total_elapsed_days = last_day_of_month_in_total_elapsed_days + 366 + else + last_day_of_month_in_total_elapsed_days = last_day_of_month_in_total_elapsed_days + 365 + end if + end do + if (leaps .and. is_leapyear(current_year)) then + last_day_of_month_in_total_elapsed_days = last_day_of_month_in_total_elapsed_days + last_day_leap + else + last_day_of_month_in_total_elapsed_days = last_day_of_month_in_total_elapsed_days + last_day + end if + match = any(int(real(last_day_of_month_in_total_elapsed_days) * seconds_per_day / dels) == ktau) + case default + call cable_abort('Error: unknown frequency "' // trim(adjustl(frequency)) // '"', __FILE__, __LINE__) + end select + + end function + + logical function cable_timing_frequency_is_greater_than(freq_a, freq_b, dels) result(freq_a_greater_than_b) + !* Utility function to determine whether one frequency is greater than + ! another following the ordering "all" > "user" > "daily" > "monthly". + character(len=*), intent(in) :: freq_a + !! The first frequency to compare, one of "all", "user", "daily", or "monthly". + character(len=*), intent(in) :: freq_b + !! The second frequency to compare, one of "all", "user", "daily", or "monthly". + real, intent(in) :: dels + !! Model time step in seconds, used for comparing against "user" frequencies. + + integer :: period_in_hours_a, period_in_hours_b + + select case (freq_a) + case ("all") + if (freq_b == "all") then + freq_a_greater_than_b = .false. + else if (freq_b == "user") then + read(freq_b(5:7), *) period_in_hours_b + freq_a_greater_than_b = dels / seconds_per_hour < period_in_hours_b + else + freq_a_greater_than_b = .true. + end if + case ("user") + read(freq_a(5:7), *) period_in_hours_a + if (freq_b == "user") then + read(freq_b(5:7), *) period_in_hours_b + freq_a_greater_than_b = period_in_hours_a < period_in_hours_b + else if (freq_b == "all") then + freq_a_greater_than_b = period_in_hours_a < dels / seconds_per_hour + else + freq_a_greater_than_b = .true. + end if + case ("daily") + freq_a_greater_than_b = freq_b == "monthly" + case ("monthly") + freq_a_greater_than_b = .false. + case default + call cable_abort("Unexpected sampling frequency '" // freq_a, __FILE__, __LINE__) + end select + + end function + +end module diff --git a/src/util/output/cable_output.F90 b/src/util/output/cable_output.F90 new file mode 100644 index 000000000..e535eb008 --- /dev/null +++ b/src/util/output/cable_output.F90 @@ -0,0 +1,526 @@ +! CSIRO Open Source Software License Agreement (variation of the BSD / MIT License) +! Copyright (c) 2015, Commonwealth Scientific and Industrial Research Organisation +! (CSIRO) ABN 41 687 119 230. + +module cable_output_mod + !* This module provides the interface for interacting with the CABLE output system. + ! + ! The output system is responsible for writing CABLE output variables to one or + ! more netCDF output and/or restart files, and includes functionality for + ! performing parallel I/O in MPI mode, grid cell reductions over sub-grid tiles, + ! and time aggregations of diagnostic variables. + ! + ! Using the output system involves the following steps: + ! + ! 1. [[cable_output_mod_init]] must be called before any + ! other procedures in this module to initialise the output system. + ! + ! 2. Diagnostics should be registered with the output system via + ! [[cable_output_register_output_variables]]. This involves creating an array of + ! `cable_output_variable_t` instances which describe the available diagnostics + ! and passing this array to `cable_output_register_output_variables`. For + ! example, a 1-dimensional diagnostic variable defined on the patch + ! dimension could be registered as follows: + ! + ! + ! call cable_output_register_output_variables([ & + ! cable_output_variable_t( & + ! field_name="my_diagnostic", & + ! data_shape=[cable_output_get_dimension("patch")], & + ! aggregator=new_aggregator(my_diagnostic_working_variable) & + ! ), & + ! cable_output_variable_t( & + ! ... + ! ) & + ! ]) + ! + ! + ! Note that registering an output variable does not necessarily mean that the + ! variable will be written to an output stream - this can depend on whether the + ! output variable is active, which often depends on the output configuration, + ! or if the variable is a restart variable and whether we are writing to a + ! restart file. There are additional properties which may be specified for each + ! registered output variable - please see [[cable_output_variable_t]] for more + ! details. In general, output variables should be registered if their associated + ! diagnostic working variables are initialised in the model as this can help + ! provide information on the diagnostics which are available. + ! + ! 3. Output streams should be initialised via [[cable_output_init_streams]]. This + ! should be done after registering output variables as the output stream + ! initialisation involves determining which output variables are active in each + ! output stream based on the current output configuration. Once an output stream + ! has been initialised, data can be written to disk. + ! + ! 4. Typically on the first time step of the simulation, + ! [[cable_output_write_parameters]] should be called to write out any non-time + ! varying parameter output variables. + ! + ! 5. On each time step, [[cable_output_update]] should be called to update the + ! time aggregation accumulation for any output variables that are active in an + ! output stream. After `cable_output_update` is called, [[cable_output_write]] + ! should be called to write out the output variables for any output streams with + ! a sampling frequency that aligns with the current time step. + ! + ! 6. If writing a CABLE restart file is required, then + ! [[cable_output_write_restart]] should be called at the end of the simulation + ! to write out the restart variables to the CABLE restart file. + ! + ! 7. Lastly, after all output has been written, [[cable_output_mod_end]] should + ! be called to close any open output streams and perform any necessary cleanup of + ! resources. + + use cable_error_handler_mod, only: cable_abort + use iso_fortran_env, only: int32, real32, real64 + use aggregator_mod, only: aggregator_t + use cable_netcdf_mod, only: cable_netcdf_file_t + use cable_def_types_mod, only: mp + use cable_def_types_mod, only: mp_global + use cable_def_types_mod, only: mland + use cable_def_types_mod, only: mland_global + use cable_def_types_mod, only: ms + use cable_def_types_mod, only: msn + use cable_def_types_mod, only: nrb + use cable_def_types_mod, only: ncp + use cable_def_types_mod, only: ncs + use cable_def_types_mod, only: met_type + use cable_io_vars_module, only: xdimsize + use cable_io_vars_module, only: ydimsize + use cable_io_vars_module, only: max_vegpatches + use cable_io_vars_module, only: patch_type, land_type + + implicit none + private + + integer, parameter :: CABLE_OUTPUT_VAR_TYPE_UNDEFINED = -1 + + !> List of allowed reduction methods for output variables. + !! Please refer to [[cable_grid_reductions_mod]] for more details on grid reductions. + character(32), parameter, public :: allowed_reduction_methods(3) = [ & + "none ", & + "grid_cell_average ", & + "first_patch_in_grid_cell" & + ] + + !> List of allowed aggregation methods for output variables. + !! Please refer to [[aggregator_mod]] for more details on aggregation methods. + character(32), parameter, public :: allowed_aggregation_methods(5) = [ & + "point", & + "mean ", & + "max ", & + "min ", & + "sum " & + ] + + !> List of allowed grid types for an output stream. + character(32), parameter, public :: allowed_grid_types(3) = [ & + "mask ", & + "land ", & + "restart" & + ] + + integer(kind=int32), parameter, public :: CABLE_OUTPUT_FILL_VALUE_INT32 = -9999999_int32 + real(kind=real32), parameter, public :: CABLE_OUTPUT_FILL_VALUE_REAL32 = -1.0e+33_real32 + real(kind=real64), parameter, public :: CABLE_OUTPUT_FILL_VALUE_REAL64 = -1.0e+33_real64 + + character(64), parameter :: NATIVE_DIM_NAME_PATCH = "patch_native" + character(64), parameter :: NATIVE_DIM_NAME_PATCH_GLOBAL = "patch_global_native" + character(64), parameter :: NATIVE_DIM_NAME_PATCH_GRID_CELL = "patch_grid_cell_native" + character(64), parameter :: NATIVE_DIM_NAME_LAND = "land_native" + character(64), parameter :: NATIVE_DIM_NAME_LAND_GLOBAL = "land_global_native" + + type, public :: cable_output_dim_t + !* Type for describing both in-memory and netCDF variable dimensions used by + ! the output module. + ! + ! Instances of `cable_output_dim_t` are created by + ! [[cable_output_get_dimension]] and is used to describe the in-memory shape + ! of the native diagnostic of each output variable in + ! `cable_output_variable_t`. + ! + ! Components of this type are private to ensure that dimensions are only + ! created via `cable_output_get_dimension` as several dimension names are + ! reserved for special handling by the output module. NetCDF variable + ! dimensions are handled internally in the output module. For more details on + ! how netCDF variable dimensions are inferred from `cable_output_dim_t` + ! instances, please refer to [[native_to_netcdf_dimensions]]. + private + character(64) :: dim_name !! Dimension name. + integer :: dim_size !! Dimension size. + contains + procedure, public :: name => cable_output_dim_get_name !! Return the dimension name. + procedure, public :: size => cable_output_dim_get_size !! Return the dimension size. + end type + + type, public :: cable_output_attribute_t + !! Type for describing string valued netCDF file attributes. + character(64) :: name !! Name of the attribute. + character(256) :: value !! Value of the attribute + end type + + type, public :: cable_output_variable_t + !* Type for describing output variables. + ! + ! This type provides the basis for registering output variables with the + ! output module via [[cable_output_register_output_variables]], and is used in + ! the definition and writing of output variables in various output streams. + character(64) :: field_name + !* The name of the variable as used in the CABLE code. This name is used + ! as the netCDF variable name when writing CABLE restart files. + character(64) :: netcdf_name = "" + !* The name of the variable as it should appear in netCDF output files. If + ! not specified, this defaults to `field_name`. + character(64) :: accumulation_frequency = "all" + !* The frequency at which the variable is accumulated when computing time + ! aggregations. Please refer to the [[cable_timing_frequency_matches]] + ! procedure for more information on the available frequency settings. If not + ! specified, this defaults to "all", meaning that the variable is + ! accumulated at every CABLE time step. + character(64) :: reduction_method = "none" + !* The grid cell reduction method to apply to the variable. The allowed + ! reduction methods are specified in `allowed_reduction_methods`. Please + ! refer to [[cable_grid_reductions_mod]] for more details on grid + ! reductions. + character(64) :: aggregation_method = "point" + !* The time aggregation method to apply when sampling a diagnostic. Please refer to + ! `allowed_aggregation_methods` for more details on the available + ! aggregation methods. + logical :: active = .true. + !* A flag indicating whether the variable is active in the default output stream. + logical :: parameter = .false. + !* A flag indicating whether the variable is a non-time varying parameter. + ! Variables with `parameter = .true.` are written once on the first time + ! step via [[cable_output_write_parameters]]. + logical :: distributed = .true. + !* A flag indicating whether the variable is distributed across multiple + ! processes. If `distributed = .true.`, the output module will infer an + ! appropriate parallel I/O decomposition from `data_shape` to perform a + ! distributed write to disk. If `distributed = .false.`, it is assumed by + ! the output module that each process has a copy of the data, and only the + ! data on the root process will be written. + logical :: restart = .false. + !* A flag indicating whether the variable should be written to the CABLE + ! restart file at the end of the run. Please see + ! [[cable_output_write_restart]] for more details on how restart variables + ! are written. + logical :: patchout = .false. + !* A flag indicating whether subgrid patch information should be included + ! in the output variable output. If `patchout = .true.`, this has the same + ! effect as setting `reduction_method = "none"`. This is a legacy flag for + ! backward compatibility with the CABLE output namelist settings. + integer :: var_type = CABLE_OUTPUT_VAR_TYPE_UNDEFINED + !* The netCDF variable type using `CABLE_NETCDF_` constants. If not + ! specified, the output module will use the native type of the data as the + ! netCDF variable type. + real :: scale_by = 1.0 + !* A multiplicative factor to apply to the native diagnostic values when + ! writing output. + real :: divide_by = 1.0 + !* A divisional factor to apply to the native diagnostic values when + ! writing output. + real :: offset_by = 0.0 + !* An additive offset to apply to the native diagnostic values when + ! writing output. + real, private :: range_native(2) = [-huge(0.0), huge(0.0)] + !* The valid range of physical values for the output variable in the units + ! of the native diagnostic. + real, allocatable :: range(:) + !* The valid range of physical values for the output variable. If a unit + ! conversion is applied to the native diagnostic via the `scale_by`, + ! `divide_by`, or `offset_by` components, the range should be given in the + ! units of the output variable after applying the unit conversion. If + ! unspecified, all values are considered valid. + type(cable_output_dim_t), allocatable :: data_shape(:) + !* An array of in-memory dimensions describing the shape of the variable + ! data. The dimensions must be created via [[cable_output_get_dimension]] + ! to ensure that reserved dimension names are handled correctly by the + ! output module. If not specified, the data shape is assumed to be a + ! scalar. + class(aggregator_t), allocatable :: aggregator + !* The aggregator object associated with the diagnostic working variable + ! to be written for this output variable. The aggregator object should not + ! be initialised when registering output variables as this is done + ! internally in the output module the output variable is active. + type(cable_output_attribute_t), allocatable :: metadata(:) + !* NetCDF variable attributes to be written with the variable. + contains + procedure, private :: get_netcdf_name => cable_output_variable_get_netcdf_name + !* Return the netCDF variable name, which defaults to `field_name` if not + ! specified via `netcdf_name`. + end type + + interface cable_output_variable_t + procedure cable_output_variable_constructor + end interface + + type :: cable_output_stream_t + !* Type for describing a netCDF file output stream. + real :: previous_write_time = 0.0 + !* The simulation time at which the output stream was last written. + integer :: frame = 0 + !* The current index along the unlimited time dimension for the output stream. + character(64) :: sampling_frequency + !* The frequency at which all output variables in the output stream are + ! aggregated in time and written to disk. Please refer to the + ! [[cable_timing_frequency_matches]] procedure for more information on the available + ! frequency settings. + character(64) :: grid_type + !* The grid type of the output stream. This controls the netCDF dimensions + ! and coordinate variables used to describe non-vertical spatial coordinates + ! in the netCDF file. Common grid types in CABLE include the compressed land + ! grid, or the lat-lon mask grid. The allowed grid types are specified in + ! `allowed_grid_types`. + character(256) :: file_name + !* The name of the netCDF file to which the output stream is written. + class(cable_netcdf_file_t), allocatable :: output_file + !* The netCDF file object associated with the output stream. + type(cable_output_variable_t), allocatable :: coordinate_variables(:) + !* An array of coordinate variables to be written to the output stream. + type(cable_output_variable_t), allocatable :: output_variables(:) + !* An array of output variables to be written to the output stream. + type(cable_output_attribute_t), allocatable :: metadata(:) + !* Global netCDF file attributes to be written to the output stream. + end type + + public cable_output_mod_init + interface cable_output_mod_init + module subroutine cable_output_impl_init() + !* Module initialisation procedure for `cable_output_mod`. + ! + ! This procedure must be called before any other procedures in + ! `cable_output_mod`. + end subroutine + end interface + + public cable_output_mod_end + interface cable_output_mod_end + module subroutine cable_output_impl_end() + !* Module finalization procedure for `cable_output_mod`. + ! + ! This procedure should be called at the end of the simulation after all + ! output has been written. + end subroutine + end interface + + public cable_output_register_output_variables + interface cable_output_register_output_variables + module subroutine cable_output_impl_register_output_variables(output_variables) + !* Registers output variables with the output module. Note that + ! registering an output variable does not necessarily mean that the variable + ! will be written to an output stream - this can depend on whether the + ! output variable is active, or if it is a restart variable. Output + ! variables should be registered if their associated diagnostic working + ! variables are initialised in the model as this can help provide the + ! information on the diagnostics which are available. + type(cable_output_variable_t), dimension(:), intent(in) :: output_variables + !! An array of output variable definitions to be registered. + end subroutine + end interface + + public cable_output_init_streams + interface cable_output_init_streams + module subroutine cable_output_impl_init_streams(dels) + !! Initialise output streams based on the current output configuration. + real, intent(in) :: dels !! The current time step size in seconds. + end subroutine + end interface + + public cable_output_update + interface cable_output_update + module subroutine cable_output_impl_update(time_index, dels, met) + !* Updates the time aggregation accumulation for any output variables that + ! are active in an output stream with an accumulation frequency that matches + ! the current time step. + integer, intent(in) :: time_index !! The current time step index in the simulation. + real, intent(in) :: dels !! The current time step size in seconds. + type(met_type), intent(in) :: met + !* Met variables at the current time step to provide informative error + ! messages for CABLE range checks. + end subroutine + end interface + + public cable_output_write + interface cable_output_write + module subroutine cable_output_impl_write(time_index, dels, met, patch, landpt) + !* Writes output variables to disk for any output streams with a sampling + ! frequency that matches the current time step. + integer, intent(in) :: time_index !! The current time step index in the simulation. + real, intent(in) :: dels !! The current time step size in seconds. + type(met_type), intent(in) :: met + !* Met variables at the current time step to provide informative error + ! messages for CABLE range checks. + type(patch_type), intent(in) :: patch(:) + !! The patch type instance for performing grid reductions over the patch dimension if required. + type(land_type), intent(in) :: landpt(:) + !! The land type instance for performing grid reductions over the patch dimension if required. + end subroutine + end interface + + public cable_output_write_parameters + interface cable_output_write_parameters + module subroutine cable_output_impl_write_parameters(time_index, patch, landpt) + !* Writes non-time varying parameter output variables to disk. This is + ! done on the first time step of the simulation after the output streams + ! have been initialised. + integer, intent(in) :: time_index !! The current time step index in the simulation. + type(patch_type), intent(in) :: patch(:) + !! The patch type instance for performing grid reductions over the patch dimension if required. + type(land_type), intent(in) :: landpt(:) + !! The land type instance for performing grid reductions over the patch dimension if required. + end subroutine + end interface + + public cable_output_write_restart + interface cable_output_write_restart + module subroutine cable_output_impl_write_restart(current_time) + !* Writes variables to the CABLE restart file. This is done at the end of + ! the simulation. + real, intent(in) :: current_time !! Current simulation time + end subroutine + end interface + + public cable_output_get_dimension + +contains + + function cable_output_get_dimension(name) result(dim) + !* Returns an output variable dimension. This function contains the + ! definitions of all dimensions used to describe the in-memory data shapes + ! of CABLE variables. + ! + ! @note "Note on adding new dimensions and shapes for output variables" + ! Adding new dimensions and shapes for output variables is possible, however + ! it is currently more involved than adding new output variables and requires + ! making changes to the output module implementation. The steps to add a new + ! dimension to the output module are as follows: + ! + ! 1. Add the new dimension name and size definition to `cable_output_get_dimension`. + ! 2. If grid cell reductions are required for variables involving the new + ! dimension, add a new grid reduction buffer allocation in + ! [[cable_output_reductions]] consistent with the data shape and any + ! necessary code to associate the buffer with an output variable. + ! 3. If distributed writes are required for variables involving the new + ! dimension, add a new decomposition definition in `cable_output_decomp_smod` + ! consistent with the data shape and any necessary code to associate the + ! decomposition with an output variable. + ! + ! In future versions this can be improved by generating the necessary grid + ! reduction buffers and parallel I/O decompositions based on the active output + ! variables across all output streams, rather than requiring hard coded + ! definitions for each dimension and shape in the output module implementation. + ! @endnote + character(*), intent(in) :: name + !* Name of the dimension. Please see the implementation of this + ! function for the list of allowed dimension names and their meanings. + type(cable_output_dim_t) :: dim + !! The output dimension object corresponding to the requested dimension name. + + select case(name) + case ("patch") + dim = cable_output_dim_t(NATIVE_DIM_NAME_PATCH, mp) + case ("patch_global") + dim = cable_output_dim_t(NATIVE_DIM_NAME_PATCH_GLOBAL, mp_global) + case ("patch_grid_cell") + dim = cable_output_dim_t(NATIVE_DIM_NAME_PATCH_GRID_CELL, max_vegpatches) + case ("land") + dim = cable_output_dim_t(NATIVE_DIM_NAME_LAND, mland) + case ("land_global") + dim = cable_output_dim_t(NATIVE_DIM_NAME_LAND_GLOBAL, mland_global) + case ("soil") + dim = cable_output_dim_t("soil", ms) + case ("snow") + dim = cable_output_dim_t("snow", msn) + case ("rad") + dim = cable_output_dim_t("rad", nrb) + case ("plant_carbon_pools") + dim = cable_output_dim_t("plant_carbon_pools", ncp) + case ("soil_carbon_pools") + dim = cable_output_dim_t("soil_carbon_pools", ncs) + case ("x") + dim = cable_output_dim_t("x", xdimsize) + case ("y") + dim = cable_output_dim_t("y", ydimsize) + case default + call cable_abort("Invalid dimension requested: " // name, __FILE__, __LINE__) + end select + + end function cable_output_get_dimension + + elemental function cable_output_dim_get_name(this) result(name) + !! Return the dimension name. + class(cable_output_dim_t), intent(in) :: this + character(64) :: name + name = this%dim_name + end function + + elemental function cable_output_dim_get_size(this) result(size) + !! Return the dimension size. + class(cable_output_dim_t), intent(in) :: this + integer :: size + size = this%dim_size + end function + + function cable_output_variable_constructor(field_name, aggregator, netcdf_name, & + accumulation_frequency, reduction_method, aggregation_method, active, & + parameter, distributed, restart, patchout, var_type, scale_by, divide_by, & + offset_by, range, data_shape, metadata & + ) result(this) + !* Custom constructor for `cable_output_variable_t`. + ! + ! This is a work-around for older gfortran compilers < 14 which require + ! allocating polymorphic components, like `aggregator`, before assignment, + ! which prevents the use of the default constructor for + ! `cable_output_variable_t` with the `aggregator` argument. + character(*), intent(in) :: field_name + class(aggregator_t), intent(in) :: aggregator + character(*), intent(in), optional :: netcdf_name + character(*), intent(in), optional :: accumulation_frequency + character(*), intent(in), optional :: reduction_method + character(*), intent(in), optional :: aggregation_method + logical, intent(in), optional :: active + logical, intent(in), optional :: parameter + logical, intent(in), optional :: distributed + logical, intent(in), optional :: restart + logical, intent(in), optional :: patchout + integer, intent(in), optional :: var_type + real, intent(in), optional :: scale_by + real, intent(in), optional :: divide_by + real, intent(in), optional :: offset_by + real, intent(in), optional :: range(:) + type(cable_output_dim_t), intent(in), optional :: data_shape(:) + type(cable_output_attribute_t), intent(in), optional :: metadata(:) + type(cable_output_variable_t) :: this + + this%field_name = field_name + allocate(this%aggregator, source=aggregator) + if (present(netcdf_name)) this%netcdf_name = netcdf_name + if (present(accumulation_frequency)) this%accumulation_frequency = accumulation_frequency + if (present(reduction_method)) this%reduction_method = reduction_method + if (present(aggregation_method)) this%aggregation_method = aggregation_method + if (present(active)) this%active = active + if (present(parameter)) this%parameter = parameter + if (present(distributed)) this%distributed = distributed + if (present(restart)) this%restart = restart + if (present(patchout)) this%patchout = patchout + if (present(var_type)) this%var_type = var_type + if (present(scale_by)) this%scale_by = scale_by + if (present(divide_by)) this%divide_by = divide_by + if (present(offset_by)) this%offset_by = offset_by + if (present(range)) this%range = range + if (present(data_shape)) this%data_shape = data_shape + if (present(metadata)) this%metadata = metadata + + end function cable_output_variable_constructor + + elemental function cable_output_variable_get_netcdf_name(this) result(netcdf_name) + !* Return the netCDF variable name, which defaults to `field_name` if not + ! specified via `netcdf_name`. + class(cable_output_variable_t), intent(in) :: this + character(64) :: netcdf_name + if (len_trim(this%netcdf_name) > 0) then + netcdf_name = this%netcdf_name + else + netcdf_name = this%field_name + end if + end function + +end module diff --git a/src/util/output/cable_output_common.F90 b/src/util/output/cable_output_common.F90 new file mode 100644 index 000000000..66a9ccb00 --- /dev/null +++ b/src/util/output/cable_output_common.F90 @@ -0,0 +1,384 @@ +! CSIRO Open Source Software License Agreement (variation of the BSD / MIT License) +! Copyright (c) 2015, Commonwealth Scientific and Industrial Research Organisation +! (CSIRO) ABN 41 687 119 230. + +submodule (cable_output_mod) cable_output_common_smod + !* Internal interfaces and procedures for [[cable_output_mod]]. + ! + ! This module declares interfaces for the procedures that are used by + ! [[cable_output_impl]], as well as various utilities used in other parts of + ! the output system. + + use cable_error_handler_mod, only: cable_abort + use cable_netcdf_mod, only: cable_netcdf_decomp_t + use cable_netcdf_mod, only: CABLE_NETCDF_FLOAT + use aggregator_mod, only: new_aggregator + use aggregator_mod, only: aggregator_int32_0d_t + use aggregator_mod, only: aggregator_int32_1d_t + use aggregator_mod, only: aggregator_int32_2d_t + use aggregator_mod, only: aggregator_int32_3d_t + use aggregator_mod, only: aggregator_real32_0d_t + use aggregator_mod, only: aggregator_real32_1d_t + use aggregator_mod, only: aggregator_real32_2d_t + use aggregator_mod, only: aggregator_real32_3d_t + use aggregator_mod, only: aggregator_real64_0d_t + use aggregator_mod, only: aggregator_real64_1d_t + use aggregator_mod, only: aggregator_real64_2d_t + use aggregator_mod, only: aggregator_real64_3d_t + use cable_checks_module, only: check_range + use cable_io_vars_module, only: lat_all, lon_all + use cable_io_vars_module, only: latitude, longitude + + implicit none + + interface + !! Interfaces for procedures used by [[cable_output_impl]]. + + module subroutine cable_output_decomp_init() + !! Intialises I/O decompositions used in the output system. + end subroutine + + module subroutine cable_output_decomp_free() + !! Deallocates I/O decompositions used in the output system. + end subroutine + + module subroutine cable_output_decomp_associate(output_stream, output_var, decomp) + !* Associates an I/O decomposition pointer with the appropriate I/O + ! decomposition, taking into account the output variable shape and type, and + ! the output stream grid type. + type(cable_output_stream_t), intent(in) :: output_stream + !! The output stream for which to associate the decomposition. + type(cable_output_variable_t), intent(in) :: output_var + !! The output variable for which to associate the decomposition. + class(cable_netcdf_decomp_t), pointer, intent(inout) :: decomp + !! The decomposition pointer to associate. + end subroutine + + module subroutine cable_output_define_stream(output_stream, restart) + !* Defines all variables, dimensions and attributes for a given output + ! stream. + type(cable_output_stream_t), intent(inout) :: output_stream + !! The output stream to define. + logical, intent(in), optional :: restart + !* Whether this is a restart stream definition. Set to `.false.` by + ! default. + end subroutine + + module subroutine cable_output_reduction_buffers_init() + !! Initialises the buffers used for performing grid reductions in the output system. + end subroutine + + module subroutine cable_output_reduction_buffers_free() + !! Deallocates the buffers used for performing grid reductions in the output system. + end subroutine + + module subroutine cable_output_write_variable(output_stream, output_variable, patch, landpt, frame, restart) + !! Writes a variable to the output stream. + type(cable_output_stream_t), intent(inout) :: output_stream !! The output stream to write to. + type(cable_output_variable_t), intent(inout), target :: output_variable !! The variable to write. + type(patch_type), intent(in), optional :: patch(:) + !! The patch type instance for performing grid reductions over the patch dimension if required. + type(land_type), intent(in), optional :: landpt(:) + !! The land type instance for performing grid reductions over the patch dimension if required. + integer, intent(in), optional :: frame !! The frame or unlimited dimension index to write at. + logical, intent(in), optional :: restart !! Whether this is a restart stream write. + end subroutine + + end interface + + interface cable_output_reduction_buffers_associate + !* Interface for associating a pointer array with the the appropriate + ! reduction buffer, taking into account the output variable shape, type and + ! reduction method. + module subroutine cable_output_reduction_buffers_associate_1d_int32(output_var, temp_buffer) + !! The reduction buffer association subroutine for 1D 32-bit integer variables. + type(cable_output_variable_t), intent(inout) :: output_var + !! The output variable for which to associate the reduction buffer. + integer(kind=int32), pointer, intent(inout) :: temp_buffer(:) + !! The pointer array to associate with the appropriate reduction buffer. + end subroutine + module subroutine cable_output_reduction_buffers_associate_1d_real32(output_var, temp_buffer) + !! The reduction buffer association subroutine for 1D 32-bit real variables. + type(cable_output_variable_t), intent(inout) :: output_var + !! The output variable for which to associate the reduction buffer. + real(kind=real32), pointer, intent(inout) :: temp_buffer(:) + !! The pointer array to associate with the appropriate reduction buffer. + end subroutine + module subroutine cable_output_reduction_buffers_associate_1d_real64(output_var, temp_buffer) + !! The reduction buffer association subroutine for 1D 64-bit real variables. + type(cable_output_variable_t), intent(inout) :: output_var + !! The output variable for which to associate the reduction buffer. + real(kind=real64), pointer, intent(inout) :: temp_buffer(:) + !! The pointer array to associate with the appropriate reduction buffer. + end subroutine + module subroutine cable_output_reduction_buffers_associate_2d_int32(output_var, temp_buffer) + !! The reduction buffer association subroutine for 2D 32-bit integer variables. + type(cable_output_variable_t), intent(inout) :: output_var + !! The output variable for which to associate the reduction buffer. + integer(kind=int32), pointer, intent(inout) :: temp_buffer(:,:) + !! The pointer array to associate with the appropriate reduction buffer. + end subroutine + module subroutine cable_output_reduction_buffers_associate_2d_real32(output_var, temp_buffer) + !! The reduction buffer association subroutine for 2D 32-bit real variables. + type(cable_output_variable_t), intent(inout) :: output_var + !! The output variable for which to associate the reduction buffer. + real(kind=real32), pointer, intent(inout) :: temp_buffer(:,:) + !! The pointer array to associate with the appropriate reduction buffer. + end subroutine + module subroutine cable_output_reduction_buffers_associate_2d_real64(output_var, temp_buffer) + !! The reduction buffer association subroutine for 2D 64-bit real variables. + type(cable_output_variable_t), intent(inout) :: output_var + !! The output variable for which to associate the reduction buffer. + real(kind=real64), pointer, intent(inout) :: temp_buffer(:,:) + !! The pointer array to associate with the appropriate reduction buffer. + end subroutine + module subroutine cable_output_reduction_buffers_associate_3d_int32(output_var, temp_buffer) + !! The reduction buffer association subroutine for 3D 32-bit integer variables. + type(cable_output_variable_t), intent(inout) :: output_var + !! The output variable for which to associate the reduction buffer. + integer(kind=int32), pointer, intent(inout) :: temp_buffer(:,:,:) + !! The pointer array to associate with the appropriate reduction buffer. + end subroutine + module subroutine cable_output_reduction_buffers_associate_3d_real32(output_var, temp_buffer) + !! The reduction buffer association subroutine for 3D 32-bit real variables. + type(cable_output_variable_t), intent(inout) :: output_var + !! The output variable for which to associate the reduction buffer. + real(kind=real32), pointer, intent(inout) :: temp_buffer(:,:,:) + !! The pointer array to associate with the appropriate reduction buffer. + end subroutine + module subroutine cable_output_reduction_buffers_associate_3d_real64(output_var, temp_buffer) + !! The reduction buffer association subroutine for 3D 64-bit real variables. + type(cable_output_variable_t), intent(inout) :: output_var + !! The output variable for which to associate the reduction buffer. + real(kind=real64), pointer, intent(inout) :: temp_buffer(:,:,:) + !! The pointer array to associate with the appropriate reduction buffer. + end subroutine + end interface + +contains + + function native_to_netcdf_dimensions(native_dimension, grid_type, reduction_method) result(netcdf_dimensions) + !* Returns the netCDF dimension(s) corresponding to a given output + ! variable dimension, taking into account the output grid type and reduction + ! method. This function is used to determine the dimensions of netCDF + ! variables based on the in-memory data shapes of CABLE variables as + ! described by `cable_output_dim_t` instances. + type(cable_output_dim_t), intent(in) :: native_dimension + !! The in-memory dimension. + character(len=*), intent(in) :: grid_type + !* The output grid type. See [[allowed_grid_types]] for the available + ! grid types. + character(len=*), intent(in) :: reduction_method + !* The reduction method applied to the variable. See + ! [[allowed_reduction_methods]] for the available reduction methods. + type(cable_output_dim_t), allocatable :: netcdf_dimensions(:) + + select case (native_dimension%name()) + case (NATIVE_DIM_NAME_PATCH) + select case (grid_type) + case ("restart") + netcdf_dimensions = [cable_output_dim_t("mp", mp_global)] + case ("land") + if (reduction_method == "none") then + netcdf_dimensions = [ & + cable_output_dim_t("land", mland_global), & + cable_output_dim_t("patch", max_vegpatches) & + ] + else + netcdf_dimensions = [cable_output_dim_t("land", mland_global)] + end if + case ("mask") + if (reduction_method == "none") then + netcdf_dimensions = [ & + cable_output_dim_t("x", xdimsize), & + cable_output_dim_t("y", ydimsize), & + cable_output_dim_t("patch", max_vegpatches) & + ] + else + netcdf_dimensions = [ & + cable_output_dim_t("x", xdimsize), & + cable_output_dim_t("y", ydimsize) & + ] + end if + case default + call cable_abort("Unable to determine output grid type.", __FILE__, __LINE__) + end select + case (NATIVE_DIM_NAME_PATCH_GLOBAL) + netcdf_dimensions = [cable_output_dim_t("mp", mp_global)] + case (NATIVE_DIM_NAME_PATCH_GRID_CELL) + netcdf_dimensions = [cable_output_dim_t("patch", max_vegpatches)] + case (NATIVE_DIM_NAME_LAND) + select case (grid_type) + case ("restart") + netcdf_dimensions = [cable_output_dim_t("mland", mland_global)] + case ("land") + netcdf_dimensions = [cable_output_dim_t("land", mland_global)] + case ("mask") + netcdf_dimensions = [ & + cable_output_dim_t("x", xdimsize), & + cable_output_dim_t("y", ydimsize) & + ] + case default + call cable_abort("Unable to determine output grid type.", __FILE__, __LINE__) + end select + case (NATIVE_DIM_NAME_LAND_GLOBAL) + if (grid_type == "restart") then + netcdf_dimensions = [cable_output_dim_t("mland", mland_global)] + else + netcdf_dimensions = [cable_output_dim_t("land", mland_global)] + end if + case default + netcdf_dimensions = [native_dimension] + end select + + end function native_to_netcdf_dimensions + + subroutine check_variable_range(output_variable, time_index, met) + !* Checks whether the value(s) of an output variable are within their + ! specified range of physical values. + ! + ! Note that range checks are done on the native diagnostic (not to be + ! confused with the netCDF variable which may have different units). + type(cable_output_variable_t), intent(in) :: output_variable + !! The output variable for which to check the range. + integer, intent(in) :: time_index + !! The current time step index, used for error messages. + type(met_type), intent(in), optional :: met + !! The met_type instance containing the current meteorological conditions, used for error messages. + + select type (aggregator => output_variable%aggregator) + type is (aggregator_int32_0d_t) + call check_range(output_variable%field_name, [real(aggregator%source_data)], output_variable%range_native, time_index, met) + type is (aggregator_int32_1d_t) + call check_range(output_variable%field_name, real(aggregator%source_data), output_variable%range_native, time_index, met) + type is (aggregator_int32_2d_t) + call check_range(output_variable%field_name, real(aggregator%source_data), output_variable%range_native, time_index, met) + type is (aggregator_int32_3d_t) + call check_range(output_variable%field_name, real(aggregator%source_data), output_variable%range_native, time_index, met) + type is (aggregator_real32_0d_t) + call check_range(output_variable%field_name, [aggregator%source_data], output_variable%range_native, time_index, met) + type is (aggregator_real32_1d_t) + call check_range(output_variable%field_name, aggregator%source_data, output_variable%range_native, time_index, met) + type is (aggregator_real32_2d_t) + call check_range(output_variable%field_name, aggregator%source_data, output_variable%range_native, time_index, met) + type is (aggregator_real32_3d_t) + call check_range(output_variable%field_name, aggregator%source_data, output_variable%range_native, time_index, met) + type is (aggregator_real64_0d_t) + call check_range(output_variable%field_name, [real(aggregator%source_data)], output_variable%range_native, time_index, met) + type is (aggregator_real64_1d_t) + call check_range(output_variable%field_name, real(aggregator%source_data), output_variable%range_native, time_index, met) + type is (aggregator_real64_2d_t) + call check_range(output_variable%field_name, real(aggregator%source_data), output_variable%range_native, time_index, met) + type is (aggregator_real64_3d_t) + call check_range(output_variable%field_name, real(aggregator%source_data), output_variable%range_native, time_index, met) + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + + end subroutine check_variable_range + + function coordinate_variables_list(grid_type) result(coord_variables) + !* Returns a list of coordinate variables to be included in an output stream + ! based on the output grid type. + character(len=*), intent(in) :: grid_type + !! The output grid type. See [[allowed_grid_types]] for the available grid types. + + type(cable_output_variable_t), allocatable :: coord_variables(:) + type(cable_output_variable_t), allocatable :: mask_coord_variables(:) + type(cable_output_dim_t) :: dim_x, dim_y, dim_land_global + + dim_x = cable_output_get_dimension("x") + dim_y = cable_output_get_dimension("y") + dim_land_global = cable_output_get_dimension("land_global") + + mask_coord_variables = [ & + cable_output_variable_t( & + field_name="lat_all", & + netcdf_name="latitude", & + data_shape=[dim_x, dim_y], & + var_type=CABLE_NETCDF_FLOAT, & + parameter=.true., & + distributed=.false., & + aggregator=new_aggregator(lat_all), & + metadata=[cable_output_attribute_t("units", "degrees_north")] & + ), & + cable_output_variable_t( & + field_name="lon_all", & + netcdf_name="longitude", & + data_shape=[dim_x, dim_y], & + parameter=.true., & + distributed=.false., & + aggregator=new_aggregator(lon_all), & + metadata=[cable_output_attribute_t("units", "degrees_east")] & + ), & + cable_output_variable_t( & + field_name="x", & + data_shape=[dim_x], & + parameter=.true., & + distributed=.false., & + aggregator=new_aggregator(lon_all(:, 1)), & + metadata=[ & + cable_output_attribute_t("units", "degrees_east"), & + cable_output_attribute_t("comment", "x coordinate variable for GrADS compatibility") & + ] & + ), & + cable_output_variable_t( & + field_name="y", & + data_shape=[dim_y], & + parameter=.true., & + distributed=.false., & + aggregator=new_aggregator(lat_all(1, :)), & + metadata=[ & + cable_output_attribute_t("units", "degrees_north"), & + cable_output_attribute_t("comment", "y coordinate variable for GrADS compatibility") & + ] & + ) & + ] + + select case (grid_type) + case ("restart") + coord_variables = [ & + cable_output_variable_t( & + field_name="latitude", & + data_shape=[dim_land_global], & + distributed=.false., & + aggregator=new_aggregator(latitude), & + metadata=[cable_output_attribute_t("units", "degrees_north")] & + ), & + cable_output_variable_t( & + field_name="longitude", & + data_shape=[dim_land_global], & + distributed=.false., & + aggregator=new_aggregator(longitude), & + metadata=[cable_output_attribute_t("units", "degrees_east")] & + ) & + ] + case ("mask") + coord_variables = mask_coord_variables + case ("land") + coord_variables = [ & + mask_coord_variables, & + cable_output_variable_t( & + field_name="local_lat", & + data_shape=[dim_land_global], & + parameter=.true., & + distributed=.false., & + aggregator=new_aggregator(latitude), & + metadata=[cable_output_attribute_t("units", "degrees_north")] & + ), & + cable_output_variable_t( & + field_name="local_lon", & + data_shape=[dim_land_global], & + parameter=.true., & + distributed=.false., & + aggregator=new_aggregator(longitude), & + metadata=[cable_output_attribute_t("units", "degrees_east")] & + ) & + ] + case default + call cable_abort("Unexpected grid type '" // grid_type // "'", __FILE__, __LINE__) + end select + + end function coordinate_variables_list + +end submodule cable_output_common_smod diff --git a/src/util/output/cable_output_decomp.F90 b/src/util/output/cable_output_decomp.F90 new file mode 100644 index 000000000..78614c417 --- /dev/null +++ b/src/util/output/cable_output_decomp.F90 @@ -0,0 +1,441 @@ +! CSIRO Open Source Software License Agreement (variation of the BSD / MIT License) +! Copyright (c) 2015, Commonwealth Scientific and Industrial Research Organisation +! (CSIRO) ABN 41 687 119 230. + +! TODO(Sean): The preprocessor define ENFORCE_SINGLE_PRECISION is enabled +! temporarily to restore bitwise reproducibility with the previous output module +! which enforces writing both double and single precision data as single +! precision. +#define ENFORCE_SINGLE_PRECISION + +submodule (cable_output_mod:cable_output_common_smod) cable_output_decomp_smod + !* Implementation of procedures for creating and managing I/O decompositions + ! for the CABLE output system. + + use cable_error_handler_mod, only: cable_abort + + use cable_array_utils_mod, only: array_eq + + use cable_def_types_mod, only: mp + use cable_def_types_mod, only: mp_global + use cable_def_types_mod, only: mland + use cable_def_types_mod, only: mland_global + use cable_def_types_mod, only: ms + use cable_def_types_mod, only: msn + use cable_def_types_mod, only: nrb + use cable_def_types_mod, only: ncs + use cable_def_types_mod, only: ncp + + use cable_io_vars_module, only: xdimsize + use cable_io_vars_module, only: ydimsize + use cable_io_vars_module, only: max_vegpatches + use cable_io_vars_module, only: land_x, land_y + use cable_io_vars_module, only: landpt + use cable_io_vars_module, only: land_decomp_start + use cable_io_vars_module, only: patch_decomp_start + + use cable_netcdf_mod, only: cable_netcdf_decomp_t + use cable_netcdf_mod, only: CABLE_NETCDF_INT + use cable_netcdf_mod, only: CABLE_NETCDF_FLOAT + use cable_netcdf_mod, only: CABLE_NETCDF_DOUBLE + + use cable_netcdf_decomp_util_mod, only: io_decomp_land_to_x_y + use cable_netcdf_decomp_util_mod, only: io_decomp_patch_to_x_y_patch + use cable_netcdf_decomp_util_mod, only: io_decomp_land_to_land + use cable_netcdf_decomp_util_mod, only: io_decomp_patch_to_land_patch + use cable_netcdf_decomp_util_mod, only: io_decomp_patch_to_patch + + implicit none + + type :: cable_output_decomp_t + !* Data structure for holding the I/O decompositions for each output grid + ! type and variable type. + ! + ! Each component represents the in-memory shape of the data being written + ! (not to be confused with the shape of the netCDF variable on disk). + class(cable_netcdf_decomp_t), allocatable :: land + !! I/O decomposition for data with shape `[mland]` + class(cable_netcdf_decomp_t), allocatable :: land_soil + !! I/O decomposition for data with shape `[mland, ms]` + class(cable_netcdf_decomp_t), allocatable :: land_snow + !! I/O decomposition for data with shape `[mland, msn]` + class(cable_netcdf_decomp_t), allocatable :: land_rad + !! I/O decomposition for data with shape `[mland, nrb]` + class(cable_netcdf_decomp_t), allocatable :: land_plantcarbon + !! I/O decomposition for data with shape `[mland, ncp]` + class(cable_netcdf_decomp_t), allocatable :: land_soilcarbon + !! I/O decomposition for data with shape `[mland, ncs]` + class(cable_netcdf_decomp_t), allocatable :: patch + !! I/O decomposition for data with shape `[mp]` + class(cable_netcdf_decomp_t), allocatable :: patch_soil + !! I/O decomposition for data with shape `[mp, ms]` + class(cable_netcdf_decomp_t), allocatable :: patch_snow + !! I/O decomposition for data with shape `[mp, msn]` + class(cable_netcdf_decomp_t), allocatable :: patch_rad + !! I/O decomposition for data with shape `[mp, nrb]` + class(cable_netcdf_decomp_t), allocatable :: patch_plantcarbon + !! I/O decomposition for data with shape `[mp, ncp]` + class(cable_netcdf_decomp_t), allocatable :: patch_soilcarbon + !! I/O decomposition for data with shape `[mp, ncs]` + end type + + type(cable_output_decomp_t), target :: decomps_grid_x_y_int32 + !! Decompositions for writing to an x-y grid. + type(cable_output_decomp_t), target :: decomps_grid_x_y_real32 + !! Decompositions for writing to an x-y grid. + type(cable_output_decomp_t), target :: decomps_grid_x_y_real64 + !! Decompositions for writing to an x-y grid. + type(cable_output_decomp_t), target :: decomps_grid_land_int32 + !! Decompositions for writing to a land grid. + type(cable_output_decomp_t), target :: decomps_grid_land_real32 + !! Decompositions for writing to a land grid. + type(cable_output_decomp_t), target :: decomps_grid_land_real64 + !! Decompositions for writing to a land grid. + type(cable_output_decomp_t), target :: decomps_grid_restart_int32 + !! Decompositions for writing to a restart grid. + type(cable_output_decomp_t), target :: decomps_grid_restart_real32 + !! Decompositions for writing to a restart grid. + type(cable_output_decomp_t), target :: decomps_grid_restart_real64 + !! Decompositions for writing to a restart grid. + +contains + + module subroutine cable_output_decomp_init() + !! Intialises I/O decompositions used in the output system. + + decomps_grid_x_y_int32%land = io_decomp_land_to_x_y(land_x, land_y, [mland], [xdimsize, ydimsize], CABLE_NETCDF_INT) + decomps_grid_x_y_int32%land_soil = io_decomp_land_to_x_y(land_x, land_y, [mland, ms], [xdimsize, ydimsize, ms], CABLE_NETCDF_INT) + decomps_grid_x_y_int32%land_snow = io_decomp_land_to_x_y(land_x, land_y, [mland, msn], [xdimsize, ydimsize, msn], CABLE_NETCDF_INT) + decomps_grid_x_y_int32%land_rad = io_decomp_land_to_x_y(land_x, land_y, [mland, nrb], [xdimsize, ydimsize, nrb], CABLE_NETCDF_INT) + decomps_grid_x_y_int32%land_plantcarbon = io_decomp_land_to_x_y(land_x, land_y, [mland, ncp], [xdimsize, ydimsize, ncp], CABLE_NETCDF_INT) + decomps_grid_x_y_int32%land_soilcarbon = io_decomp_land_to_x_y(land_x, land_y, [mland, ncs], [xdimsize, ydimsize, ncs], CABLE_NETCDF_INT) + decomps_grid_x_y_int32%patch = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, [mp], [xdimsize, ydimsize, max_vegpatches], CABLE_NETCDF_INT) + decomps_grid_x_y_int32%patch_soil = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, [mp, ms], [xdimsize, ydimsize, max_vegpatches, ms], CABLE_NETCDF_INT) + decomps_grid_x_y_int32%patch_snow = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, [mp, msn], [xdimsize, ydimsize, max_vegpatches, msn], CABLE_NETCDF_INT) + decomps_grid_x_y_int32%patch_rad = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, [mp, nrb], [xdimsize, ydimsize, max_vegpatches, nrb], CABLE_NETCDF_INT) + decomps_grid_x_y_int32%patch_plantcarbon = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, [mp, ncp], [xdimsize, ydimsize, max_vegpatches, ncp], CABLE_NETCDF_INT) + decomps_grid_x_y_int32%patch_soilcarbon = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, [mp, ncs], [xdimsize, ydimsize, max_vegpatches, ncs], CABLE_NETCDF_INT) + + decomps_grid_land_int32%land = io_decomp_land_to_land(land_decomp_start, [mland], [mland_global], CABLE_NETCDF_INT) + decomps_grid_land_int32%land_soil = io_decomp_land_to_land(land_decomp_start, [mland, ms], [mland_global, ms], CABLE_NETCDF_INT) + decomps_grid_land_int32%land_snow = io_decomp_land_to_land(land_decomp_start, [mland, msn], [mland_global, msn], CABLE_NETCDF_INT) + decomps_grid_land_int32%land_rad = io_decomp_land_to_land(land_decomp_start, [mland, nrb], [mland_global, nrb], CABLE_NETCDF_INT) + decomps_grid_land_int32%land_plantcarbon = io_decomp_land_to_land(land_decomp_start, [mland, ncp], [mland_global, ncp], CABLE_NETCDF_INT) + decomps_grid_land_int32%land_soilcarbon = io_decomp_land_to_land(land_decomp_start, [mland, ncs], [mland_global, ncs], CABLE_NETCDF_INT) + decomps_grid_land_int32%patch = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, [mp], [mland_global, max_vegpatches], CABLE_NETCDF_INT) + decomps_grid_land_int32%patch_soil = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, [mp, ms], [mland_global, max_vegpatches, ms], CABLE_NETCDF_INT) + decomps_grid_land_int32%patch_snow = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, [mp, msn], [mland_global, max_vegpatches, msn], CABLE_NETCDF_INT) + decomps_grid_land_int32%patch_rad = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, [mp, nrb], [mland_global, max_vegpatches, nrb], CABLE_NETCDF_INT) + decomps_grid_land_int32%patch_plantcarbon = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, [mp, ncp], [mland_global, max_vegpatches, ncp], CABLE_NETCDF_INT) + decomps_grid_land_int32%patch_soilcarbon = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, [mp, ncs], [mland_global, max_vegpatches, ncs], CABLE_NETCDF_INT) + + decomps_grid_restart_int32%patch = io_decomp_patch_to_patch(patch_decomp_start, [mp], [mp_global], CABLE_NETCDF_INT) + decomps_grid_restart_int32%patch_soil = io_decomp_patch_to_patch(patch_decomp_start, [mp, ms], [mp_global, ms], CABLE_NETCDF_INT) + decomps_grid_restart_int32%patch_snow = io_decomp_patch_to_patch(patch_decomp_start, [mp, msn], [mp_global, msn], CABLE_NETCDF_INT) + decomps_grid_restart_int32%patch_rad = io_decomp_patch_to_patch(patch_decomp_start, [mp, nrb], [mp_global, nrb], CABLE_NETCDF_INT) + decomps_grid_restart_int32%patch_plantcarbon = io_decomp_patch_to_patch(patch_decomp_start, [mp, ncp], [mp_global, ncp], CABLE_NETCDF_INT) + decomps_grid_restart_int32%patch_soilcarbon = io_decomp_patch_to_patch(patch_decomp_start, [mp, ncs], [mp_global, ncs], CABLE_NETCDF_INT) + + decomps_grid_x_y_real32%land = io_decomp_land_to_x_y(land_x, land_y, [mland], [xdimsize, ydimsize], CABLE_NETCDF_FLOAT) + decomps_grid_x_y_real32%land_soil = io_decomp_land_to_x_y(land_x, land_y, [mland, ms], [xdimsize, ydimsize, ms], CABLE_NETCDF_FLOAT) + decomps_grid_x_y_real32%land_snow = io_decomp_land_to_x_y(land_x, land_y, [mland, msn], [xdimsize, ydimsize, msn], CABLE_NETCDF_FLOAT) + decomps_grid_x_y_real32%land_rad = io_decomp_land_to_x_y(land_x, land_y, [mland, nrb], [xdimsize, ydimsize, nrb], CABLE_NETCDF_FLOAT) + decomps_grid_x_y_real32%land_plantcarbon = io_decomp_land_to_x_y(land_x, land_y, [mland, ncp], [xdimsize, ydimsize, ncp], CABLE_NETCDF_FLOAT) + decomps_grid_x_y_real32%land_soilcarbon = io_decomp_land_to_x_y(land_x, land_y, [mland, ncs], [xdimsize, ydimsize, ncs], CABLE_NETCDF_FLOAT) + decomps_grid_x_y_real32%patch = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, [mp], [xdimsize, ydimsize, max_vegpatches], CABLE_NETCDF_FLOAT) + decomps_grid_x_y_real32%patch_soil = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, [mp, ms], [xdimsize, ydimsize, max_vegpatches, ms], CABLE_NETCDF_FLOAT) + decomps_grid_x_y_real32%patch_snow = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, [mp, msn], [xdimsize, ydimsize, max_vegpatches, msn], CABLE_NETCDF_FLOAT) + decomps_grid_x_y_real32%patch_rad = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, [mp, nrb], [xdimsize, ydimsize, max_vegpatches, nrb], CABLE_NETCDF_FLOAT) + decomps_grid_x_y_real32%patch_plantcarbon = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, [mp, ncp], [xdimsize, ydimsize, max_vegpatches, ncp], CABLE_NETCDF_FLOAT) + decomps_grid_x_y_real32%patch_soilcarbon = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, [mp, ncs], [xdimsize, ydimsize, max_vegpatches, ncs], CABLE_NETCDF_FLOAT) + + decomps_grid_land_real32%land = io_decomp_land_to_land(land_decomp_start, [mland], [mland_global], CABLE_NETCDF_FLOAT) + decomps_grid_land_real32%land_soil = io_decomp_land_to_land(land_decomp_start, [mland, ms], [mland_global, ms], CABLE_NETCDF_FLOAT) + decomps_grid_land_real32%land_snow = io_decomp_land_to_land(land_decomp_start, [mland, msn], [mland_global, msn], CABLE_NETCDF_FLOAT) + decomps_grid_land_real32%land_rad = io_decomp_land_to_land(land_decomp_start, [mland, nrb], [mland_global, nrb], CABLE_NETCDF_FLOAT) + decomps_grid_land_real32%land_plantcarbon = io_decomp_land_to_land(land_decomp_start, [mland, ncp], [mland_global, ncp], CABLE_NETCDF_FLOAT) + decomps_grid_land_real32%land_soilcarbon = io_decomp_land_to_land(land_decomp_start, [mland, ncs], [mland_global, ncs], CABLE_NETCDF_FLOAT) + decomps_grid_land_real32%patch = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, [mp], [mland_global, max_vegpatches], CABLE_NETCDF_FLOAT) + decomps_grid_land_real32%patch_soil = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, [mp, ms], [mland_global, max_vegpatches, ms], CABLE_NETCDF_FLOAT) + decomps_grid_land_real32%patch_snow = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, [mp, msn], [mland_global, max_vegpatches, msn], CABLE_NETCDF_FLOAT) + decomps_grid_land_real32%patch_rad = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, [mp, nrb], [mland_global, max_vegpatches, nrb], CABLE_NETCDF_FLOAT) + decomps_grid_land_real32%patch_plantcarbon = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, [mp, ncp], [mland_global, max_vegpatches, ncp], CABLE_NETCDF_FLOAT) + decomps_grid_land_real32%patch_soilcarbon = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, [mp, ncs], [mland_global, max_vegpatches, ncs], CABLE_NETCDF_FLOAT) + + decomps_grid_restart_real32%patch = io_decomp_patch_to_patch(patch_decomp_start, [mp], [mp_global], CABLE_NETCDF_FLOAT) + decomps_grid_restart_real32%patch_soil = io_decomp_patch_to_patch(patch_decomp_start, [mp, ms], [mp_global, ms], CABLE_NETCDF_FLOAT) + decomps_grid_restart_real32%patch_snow = io_decomp_patch_to_patch(patch_decomp_start, [mp, msn], [mp_global, msn], CABLE_NETCDF_FLOAT) + decomps_grid_restart_real32%patch_rad = io_decomp_patch_to_patch(patch_decomp_start, [mp, nrb], [mp_global, nrb], CABLE_NETCDF_FLOAT) + decomps_grid_restart_real32%patch_plantcarbon = io_decomp_patch_to_patch(patch_decomp_start, [mp, ncp], [mp_global, ncp], CABLE_NETCDF_FLOAT) + decomps_grid_restart_real32%patch_soilcarbon = io_decomp_patch_to_patch(patch_decomp_start, [mp, ncs], [mp_global, ncs], CABLE_NETCDF_FLOAT) + + decomps_grid_x_y_real64%land = io_decomp_land_to_x_y(land_x, land_y, [mland], [xdimsize, ydimsize], CABLE_NETCDF_DOUBLE) + decomps_grid_x_y_real64%land_soil = io_decomp_land_to_x_y(land_x, land_y, [mland, ms], [xdimsize, ydimsize, ms], CABLE_NETCDF_DOUBLE) + decomps_grid_x_y_real64%land_snow = io_decomp_land_to_x_y(land_x, land_y, [mland, msn], [xdimsize, ydimsize, msn], CABLE_NETCDF_DOUBLE) + decomps_grid_x_y_real64%land_rad = io_decomp_land_to_x_y(land_x, land_y, [mland, nrb], [xdimsize, ydimsize, nrb], CABLE_NETCDF_DOUBLE) + decomps_grid_x_y_real64%land_plantcarbon = io_decomp_land_to_x_y(land_x, land_y, [mland, ncp], [xdimsize, ydimsize, ncp], CABLE_NETCDF_DOUBLE) + decomps_grid_x_y_real64%land_soilcarbon = io_decomp_land_to_x_y(land_x, land_y, [mland, ncs], [xdimsize, ydimsize, ncs], CABLE_NETCDF_DOUBLE) + decomps_grid_x_y_real64%patch = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, [mp], [xdimsize, ydimsize, max_vegpatches], CABLE_NETCDF_DOUBLE) + decomps_grid_x_y_real64%patch_soil = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, [mp, ms], [xdimsize, ydimsize, max_vegpatches, ms], CABLE_NETCDF_DOUBLE) + decomps_grid_x_y_real64%patch_snow = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, [mp, msn], [xdimsize, ydimsize, max_vegpatches, msn], CABLE_NETCDF_DOUBLE) + decomps_grid_x_y_real64%patch_rad = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, [mp, nrb], [xdimsize, ydimsize, max_vegpatches, nrb], CABLE_NETCDF_DOUBLE) + decomps_grid_x_y_real64%patch_plantcarbon = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, [mp, ncp], [xdimsize, ydimsize, max_vegpatches, ncp], CABLE_NETCDF_DOUBLE) + decomps_grid_x_y_real64%patch_soilcarbon = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, [mp, ncs], [xdimsize, ydimsize, max_vegpatches, ncs], CABLE_NETCDF_DOUBLE) + + decomps_grid_land_real64%land = io_decomp_land_to_land(land_decomp_start, [mland], [mland_global], CABLE_NETCDF_DOUBLE) + decomps_grid_land_real64%land_soil = io_decomp_land_to_land(land_decomp_start, [mland, ms], [mland_global, ms], CABLE_NETCDF_DOUBLE) + decomps_grid_land_real64%land_snow = io_decomp_land_to_land(land_decomp_start, [mland, msn], [mland_global, msn], CABLE_NETCDF_DOUBLE) + decomps_grid_land_real64%land_rad = io_decomp_land_to_land(land_decomp_start, [mland, nrb], [mland_global, nrb], CABLE_NETCDF_DOUBLE) + decomps_grid_land_real64%land_plantcarbon = io_decomp_land_to_land(land_decomp_start, [mland, ncp], [mland_global, ncp], CABLE_NETCDF_DOUBLE) + decomps_grid_land_real64%land_soilcarbon = io_decomp_land_to_land(land_decomp_start, [mland, ncs], [mland_global, ncs], CABLE_NETCDF_DOUBLE) + decomps_grid_land_real64%patch = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, [mp], [mland_global, max_vegpatches], CABLE_NETCDF_DOUBLE) + decomps_grid_land_real64%patch_soil = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, [mp, ms], [mland_global, max_vegpatches, ms], CABLE_NETCDF_DOUBLE) + decomps_grid_land_real64%patch_snow = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, [mp, msn], [mland_global, max_vegpatches, msn], CABLE_NETCDF_DOUBLE) + decomps_grid_land_real64%patch_rad = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, [mp, nrb], [mland_global, max_vegpatches, nrb], CABLE_NETCDF_DOUBLE) + decomps_grid_land_real64%patch_plantcarbon = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, [mp, ncp], [mland_global, max_vegpatches, ncp], CABLE_NETCDF_DOUBLE) + decomps_grid_land_real64%patch_soilcarbon = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, [mp, ncs], [mland_global, max_vegpatches, ncs], CABLE_NETCDF_DOUBLE) + + decomps_grid_restart_real64%patch = io_decomp_patch_to_patch(patch_decomp_start, [mp], [mp_global], CABLE_NETCDF_DOUBLE) + decomps_grid_restart_real64%patch_soil = io_decomp_patch_to_patch(patch_decomp_start, [mp, ms], [mp_global, ms], CABLE_NETCDF_DOUBLE) + decomps_grid_restart_real64%patch_snow = io_decomp_patch_to_patch(patch_decomp_start, [mp, msn], [mp_global, msn], CABLE_NETCDF_DOUBLE) + decomps_grid_restart_real64%patch_rad = io_decomp_patch_to_patch(patch_decomp_start, [mp, nrb], [mp_global, nrb], CABLE_NETCDF_DOUBLE) + decomps_grid_restart_real64%patch_plantcarbon = io_decomp_patch_to_patch(patch_decomp_start, [mp, ncp], [mp_global, ncp], CABLE_NETCDF_DOUBLE) + decomps_grid_restart_real64%patch_soilcarbon = io_decomp_patch_to_patch(patch_decomp_start, [mp, ncs], [mp_global, ncs], CABLE_NETCDF_DOUBLE) + + end subroutine cable_output_decomp_init + + module subroutine cable_output_decomp_free() + !! Deallocates I/O decompositions used in the output system. + + deallocate(decomps_grid_x_y_int32%land) + deallocate(decomps_grid_x_y_int32%land_soil) + deallocate(decomps_grid_x_y_int32%land_snow) + deallocate(decomps_grid_x_y_int32%land_rad) + deallocate(decomps_grid_x_y_int32%land_plantcarbon) + deallocate(decomps_grid_x_y_int32%land_soilcarbon) + deallocate(decomps_grid_x_y_int32%patch) + deallocate(decomps_grid_x_y_int32%patch_soil) + deallocate(decomps_grid_x_y_int32%patch_snow) + deallocate(decomps_grid_x_y_int32%patch_rad) + deallocate(decomps_grid_x_y_int32%patch_plantcarbon) + deallocate(decomps_grid_x_y_int32%patch_soilcarbon) + + deallocate(decomps_grid_land_int32%land) + deallocate(decomps_grid_land_int32%land_soil) + deallocate(decomps_grid_land_int32%land_snow) + deallocate(decomps_grid_land_int32%land_rad) + deallocate(decomps_grid_land_int32%land_plantcarbon) + deallocate(decomps_grid_land_int32%land_soilcarbon) + deallocate(decomps_grid_land_int32%patch) + deallocate(decomps_grid_land_int32%patch_soil) + deallocate(decomps_grid_land_int32%patch_snow) + deallocate(decomps_grid_land_int32%patch_rad) + deallocate(decomps_grid_land_int32%patch_plantcarbon) + deallocate(decomps_grid_land_int32%patch_soilcarbon) + + deallocate(decomps_grid_restart_int32%patch) + deallocate(decomps_grid_restart_int32%patch_soil) + deallocate(decomps_grid_restart_int32%patch_snow) + deallocate(decomps_grid_restart_int32%patch_rad) + deallocate(decomps_grid_restart_int32%patch_plantcarbon) + deallocate(decomps_grid_restart_int32%patch_soilcarbon) + + deallocate(decomps_grid_x_y_real32%land) + deallocate(decomps_grid_x_y_real32%land_soil) + deallocate(decomps_grid_x_y_real32%land_snow) + deallocate(decomps_grid_x_y_real32%land_rad) + deallocate(decomps_grid_x_y_real32%land_plantcarbon) + deallocate(decomps_grid_x_y_real32%land_soilcarbon) + deallocate(decomps_grid_x_y_real32%patch) + deallocate(decomps_grid_x_y_real32%patch_soil) + deallocate(decomps_grid_x_y_real32%patch_snow) + deallocate(decomps_grid_x_y_real32%patch_rad) + deallocate(decomps_grid_x_y_real32%patch_plantcarbon) + deallocate(decomps_grid_x_y_real32%patch_soilcarbon) + + deallocate(decomps_grid_land_real32%land) + deallocate(decomps_grid_land_real32%land_soil) + deallocate(decomps_grid_land_real32%land_snow) + deallocate(decomps_grid_land_real32%land_rad) + deallocate(decomps_grid_land_real32%land_plantcarbon) + deallocate(decomps_grid_land_real32%land_soilcarbon) + deallocate(decomps_grid_land_real32%patch) + deallocate(decomps_grid_land_real32%patch_soil) + deallocate(decomps_grid_land_real32%patch_snow) + deallocate(decomps_grid_land_real32%patch_rad) + deallocate(decomps_grid_land_real32%patch_plantcarbon) + deallocate(decomps_grid_land_real32%patch_soilcarbon) + + deallocate(decomps_grid_restart_real32%patch) + deallocate(decomps_grid_restart_real32%patch_soil) + deallocate(decomps_grid_restart_real32%patch_snow) + deallocate(decomps_grid_restart_real32%patch_rad) + deallocate(decomps_grid_restart_real32%patch_plantcarbon) + deallocate(decomps_grid_restart_real32%patch_soilcarbon) + + deallocate(decomps_grid_x_y_real64%land) + deallocate(decomps_grid_x_y_real64%land_soil) + deallocate(decomps_grid_x_y_real64%land_snow) + deallocate(decomps_grid_x_y_real64%land_rad) + deallocate(decomps_grid_x_y_real64%land_plantcarbon) + deallocate(decomps_grid_x_y_real64%land_soilcarbon) + deallocate(decomps_grid_x_y_real64%patch) + deallocate(decomps_grid_x_y_real64%patch_soil) + deallocate(decomps_grid_x_y_real64%patch_snow) + deallocate(decomps_grid_x_y_real64%patch_rad) + deallocate(decomps_grid_x_y_real64%patch_plantcarbon) + deallocate(decomps_grid_x_y_real64%patch_soilcarbon) + + deallocate(decomps_grid_land_real64%land) + deallocate(decomps_grid_land_real64%land_soil) + deallocate(decomps_grid_land_real64%land_snow) + deallocate(decomps_grid_land_real64%land_rad) + deallocate(decomps_grid_land_real64%land_plantcarbon) + deallocate(decomps_grid_land_real64%land_soilcarbon) + deallocate(decomps_grid_land_real64%patch) + deallocate(decomps_grid_land_real64%patch_soil) + deallocate(decomps_grid_land_real64%patch_snow) + deallocate(decomps_grid_land_real64%patch_rad) + deallocate(decomps_grid_land_real64%patch_plantcarbon) + deallocate(decomps_grid_land_real64%patch_soilcarbon) + + deallocate(decomps_grid_restart_real64%patch) + deallocate(decomps_grid_restart_real64%patch_soil) + deallocate(decomps_grid_restart_real64%patch_snow) + deallocate(decomps_grid_restart_real64%patch_rad) + deallocate(decomps_grid_restart_real64%patch_plantcarbon) + deallocate(decomps_grid_restart_real64%patch_soilcarbon) + + end subroutine cable_output_decomp_free + + module subroutine cable_output_decomp_associate(output_stream, output_var, decomp) + !* Associates an I/O decomposition pointer with the appropriate I/O + ! decomposition, taking into account the output variable shape and type, and + ! the output stream grid type. + type(cable_output_stream_t), intent(in) :: output_stream + !! The output stream for which to associate the decomposition. + type(cable_output_variable_t), intent(in) :: output_var + !! The output variable for which to associate the decomposition. + class(cable_netcdf_decomp_t), pointer, intent(inout) :: decomp + !! The decomposition pointer to associate. + type(cable_output_decomp_t), pointer :: output_decomp + + select case (output_stream%grid_type) + case ("restart") + call cable_output_decomp_associate_restart(output_var, decomp) + return + case ("mask") + select case (output_var%aggregator%type()) + case ("int32") + output_decomp => decomps_grid_x_y_int32 + case ("real32") + output_decomp => decomps_grid_x_y_real32 + case ("real64") +#ifdef ENFORCE_SINGLE_PRECISION + output_decomp => decomps_grid_x_y_real32 +#else + output_decomp => decomps_grid_x_y_real64 +#endif + case default + call cable_abort("Unexpected data type for output variable " // output_var%field_name, __FILE__, __LINE__) + end select + case ("land") + select case (output_var%aggregator%type()) + case ("int32") + output_decomp => decomps_grid_land_int32 + case ("real32") + output_decomp => decomps_grid_land_real32 + case ("real64") +#ifdef ENFORCE_SINGLE_PRECISION + output_decomp => decomps_grid_land_real32 +#else + output_decomp => decomps_grid_land_real64 +#endif + case default + call cable_abort("Unexpected data type for output variable " // output_var%field_name, __FILE__, __LINE__) + end select + case default + call cable_abort("Unexpected grid type for output profile " // output_stream%file_name, __FILE__, __LINE__) + end select + + if (array_eq(output_var%data_shape(:)%size(), [mp])) then + if (output_var%reduction_method == "none") then + decomp => output_decomp%patch + else + decomp => output_decomp%land + end if + else if (array_eq(output_var%data_shape(:)%size(), [mp, ms])) then + if (output_var%reduction_method == "none") then + decomp => output_decomp%patch_soil + else + decomp => output_decomp%land_soil + end if + else if (array_eq(output_var%data_shape(:)%size(), [mp, msn])) then + if (output_var%reduction_method == "none") then + decomp => output_decomp%patch_snow + else + decomp => output_decomp%land_snow + end if + else if (array_eq(output_var%data_shape(:)%size(), [mp, nrb])) then + if (output_var%reduction_method == "none") then + decomp => output_decomp%patch_rad + else + decomp => output_decomp%land_rad + end if + else if (array_eq(output_var%data_shape(:)%size(), [mp, ncp])) then + if (output_var%reduction_method == "none") then + decomp => output_decomp%patch_plantcarbon + else + decomp => output_decomp%land_plantcarbon + end if + else if (array_eq(output_var%data_shape(:)%size(), [mp, ncs])) then + if (output_var%reduction_method == "none") then + decomp => output_decomp%patch_soilcarbon + else + decomp => output_decomp%land_soilcarbon + end if + else + call cable_abort("Unsupported data shape for output variable " // output_var%field_name, __FILE__, __LINE__) + end if + + end subroutine cable_output_decomp_associate + + subroutine cable_output_decomp_associate_restart(output_var, decomp) + type(cable_output_variable_t), intent(in) :: output_var + class(cable_netcdf_decomp_t), pointer, intent(inout) :: decomp + type(cable_output_decomp_t), pointer :: output_decomp + + select case (output_var%aggregator%type()) + case ("int32") + output_decomp => decomps_grid_restart_int32 + case ("real32") + output_decomp => decomps_grid_restart_real32 + case ("real64") +#ifdef ENFORCE_SINGLE_PRECISION + output_decomp => decomps_grid_restart_real32 +#else + output_decomp => decomps_grid_restart_real64 +#endif + case default + call cable_abort("Unexpected data type for output variable " // output_var%field_name, __FILE__, __LINE__) + end select + + if (array_eq(output_var%data_shape(:)%size(), [mp])) then + decomp => output_decomp%patch + else if (array_eq(output_var%data_shape(:)%size(), [mp, ms])) then + decomp => output_decomp%patch_soil + else if (array_eq(output_var%data_shape(:)%size(), [mp, msn])) then + decomp => output_decomp%patch_snow + else if (array_eq(output_var%data_shape(:)%size(), [mp, nrb])) then + decomp => output_decomp%patch_rad + else if (array_eq(output_var%data_shape(:)%size(), [mp, ncp])) then + decomp => output_decomp%patch_plantcarbon + else if (array_eq(output_var%data_shape(:)%size(), [mp, ncs])) then + decomp => output_decomp%patch_soilcarbon + else + call cable_abort("Unsupported data shape for output variable " // output_var%field_name, __FILE__, __LINE__) + end if + + end subroutine cable_output_decomp_associate_restart + +end submodule cable_output_decomp_smod diff --git a/src/util/output/cable_output_define.F90 b/src/util/output/cable_output_define.F90 new file mode 100644 index 000000000..94c899e9f --- /dev/null +++ b/src/util/output/cable_output_define.F90 @@ -0,0 +1,239 @@ +! CSIRO Open Source Software License Agreement (variation of the BSD / MIT License) +! Copyright (c) 2015, Commonwealth Scientific and Industrial Research Organisation +! (CSIRO) ABN 41 687 119 230. + +submodule (cable_output_mod:cable_output_common_smod) cable_output_define_smod + !* Implementation of procedures for defining netCDF files for CABLE output + ! streams. + + use cable_common_module, only: filename + use cable_def_types_mod, only: mp_global + use cable_def_types_mod, only: mland_global + use cable_io_vars_module, only: xdimsize + use cable_io_vars_module, only: ydimsize + use cable_io_vars_module, only: max_vegpatches + use cable_io_vars_module, only: timeunits + use cable_io_vars_module, only: time_coord + use cable_io_vars_module, only: calendar + use cable_netcdf_mod, only: CABLE_NETCDF_UNLIMITED + use cable_netcdf_mod, only: CABLE_NETCDF_INT + use cable_netcdf_mod, only: CABLE_NETCDF_FLOAT + use cable_netcdf_mod, only: CABLE_NETCDF_DOUBLE + + implicit none + +contains + + integer function netcdf_var_type(output_variable, use_native_type) + !* Infers the appropriate netCDF variable type for a given output variable. + type(cable_output_variable_t), intent(in) :: output_variable + !! The output variable for which to infer the netCDF variable type. + logical, intent(in), optional :: use_native_type + !* Whether to use the native variable type of the output variable. Set to + ! `.false.` by default. + logical :: native_type + + native_type = .false. + if (present(use_native_type)) native_type = use_native_type + + if (.not. native_type .and. output_variable%var_type /= CABLE_OUTPUT_VAR_TYPE_UNDEFINED) then + netcdf_var_type = output_variable%var_type + return + end if + + select case (output_variable%aggregator%type()) + case ("int32") + netcdf_var_type = CABLE_NETCDF_INT + case ("real32") + netcdf_var_type = CABLE_NETCDF_FLOAT + case ("real64") + netcdf_var_type = CABLE_NETCDF_DOUBLE + case default + call cable_abort("Unable to infer variable type for variable " // trim(output_variable%field_name), __FILE__, __LINE__) + end select + + end function + + function infer_netcdf_dimensions(output_stream, output_variable, time_axis) result(netcdf_dimensions) + !* Infers the appropriate netCDF dimensions for a given output variable + ! based on its data shape and the grid type of the output stream. + type(cable_output_stream_t), intent(in) :: output_stream + !! The output stream for which to infer the netCDF dimensions. + type(cable_output_variable_t), intent(in) :: output_variable + !! The output variable for which to infer the netCDF dimensions. + logical, intent(in), optional :: time_axis + !* Whether to include the time axis as a dimension. By default, the time + ! axis will not be included. + + type(cable_output_dim_t), allocatable :: netcdf_dimensions(:) + integer :: i + + allocate(netcdf_dimensions(0)) + if (allocated(output_variable%data_shape)) then + netcdf_dimensions = [( & + native_to_netcdf_dimensions( & + native_dimension=output_variable%data_shape(i), & + grid_type=output_stream%grid_type, & + reduction_method=output_variable%reduction_method & + ), & + i = 1, size(output_variable%data_shape) & + )] + end if + + if (present(time_axis)) then; if (time_axis) then + netcdf_dimensions = [netcdf_dimensions, cable_output_dim_t("time", CABLE_NETCDF_UNLIMITED)] + end if; end if + + end function infer_netcdf_dimensions + + subroutine set_global_attributes(output_stream) + !! Sets the global attributes for a given output stream. + type(cable_output_stream_t), intent(inout) :: output_stream + !! The output stream for which to set the global attributes. + character(32) :: todaydate, nowtime + integer :: i + + if (allocated(output_stream%metadata)) then + do i = 1, size(output_stream%metadata) + call output_stream%output_file%put_att( & + att_name=output_stream%metadata(i)%name, & + att_value=output_stream%metadata(i)%value & + ) + end do + end if + + call date_and_time(todaydate, nowtime) + todaydate = todaydate(1:4) // "/" // todaydate(5:6) // "/" // todaydate(7:8) + nowtime = nowtime(1:2) // ":" // nowtime(3:4) // ":" // nowtime(5:6) + call output_stream%output_file%put_att("Production", trim(todaydate) // " at " // trim(nowtime)) + call output_stream%output_file%put_att("Source", "CABLE LSM output file") + call output_stream%output_file%put_att("CABLE_input_file", trim(filename%met)) + + select case (output_stream%sampling_frequency) + case ("user") + call output_stream%output_file%put_att("Output_averaging", TRIM(output_stream%sampling_frequency(5:7)) // "-hourly output") + case ("all") + call output_stream%output_file%put_att("Output_averaging", "all timesteps recorded") + case ("daily") + call output_stream%output_file%put_att("Output_averaging", "daily") + case ("monthly") + call output_stream%output_file%put_att("Output_averaging", "monthly") + case default + call cable_abort("Invalid sampling frequency '" // output_stream%sampling_frequency // "'", __FILE__, __LINE__) + end select + + end subroutine set_global_attributes + + module subroutine cable_output_define_stream(output_stream, restart) + !* Defines all variables, dimensions and attributes for a given output + ! stream. + type(cable_output_stream_t), intent(inout) :: output_stream !! The output stream to define. + logical, intent(in), optional :: restart !! Whether this is a restart stream definition. + type(cable_output_variable_t), allocatable :: all_output_variables(:) + type(cable_output_dim_t), allocatable :: required_dimensions(:), netcdf_dimensions(:) + logical :: restart_local + integer :: i, j + character(64) :: variable_name + + restart_local = .false. + if (present(restart)) restart_local = restart + + all_output_variables = [ & + output_stream%coordinate_variables, & + output_stream%output_variables & + ] + + do i = 1, size(all_output_variables) + associate(output_var => all_output_variables(i)) + if (.not. allocated(output_var%data_shape)) cycle + netcdf_dimensions = infer_netcdf_dimensions( & + output_stream, & + output_var, & + time_axis=(.not. (restart_local .or. output_var%parameter)) & + ) + if (.not. allocated(required_dimensions)) then + required_dimensions = netcdf_dimensions + else + required_dimensions = [ & + required_dimensions, & + pack(netcdf_dimensions, [( & + all(netcdf_dimensions(j)%name() /= required_dimensions(:)%name()), & + j = 1, & + size(netcdf_dimensions) & + )]) & + ] + end if + end associate + end do + + do i = 1, size(required_dimensions) + if (required_dimensions(i)%name() == "time") cycle + call output_stream%output_file%def_dims([required_dimensions(i)%name()], [required_dimensions(i)%size()]) + end do + + if (output_stream%grid_type == "restart") then + call output_stream%output_file%def_dims(["time"], [1]) + else + call output_stream%output_file%def_dims(["time"], [CABLE_NETCDF_UNLIMITED]) + end if + + call output_stream%output_file%def_var("time", CABLE_NETCDF_DOUBLE, ["time"]) + call output_stream%output_file%put_att("time", "units", timeunits) + call output_stream%output_file%put_att("time", "coordinate", time_coord) + call output_stream%output_file%put_att("time", "calendar", calendar) + + do i = 1, size(output_stream%coordinate_variables) + associate(coord_var => output_stream%coordinate_variables(i)) + variable_name = coord_var%get_netcdf_name() + netcdf_dimensions = infer_netcdf_dimensions(output_stream, coord_var) + call output_stream%output_file%def_var( & + var_name=variable_name, & + dim_names=netcdf_dimensions(:)%name(), & + type=netcdf_var_type(coord_var) & + ) + if (allocated(coord_var%metadata)) then + do j = 1, size(coord_var%metadata) + call output_stream%output_file%put_att(variable_name, coord_var%metadata(j)%name, coord_var%metadata(j)%value) + end do + end if + end associate + end do + + do i = 1, size(output_stream%output_variables) + associate(output_var => output_stream%output_variables(i)) + variable_name = output_var%get_netcdf_name() + if (restart_local) variable_name = output_var%field_name + netcdf_dimensions = infer_netcdf_dimensions( & + output_stream, & + output_var, & + time_axis=(.not. (restart_local .or. output_var%parameter)) & + ) + call output_stream%output_file%def_var( & + var_name=variable_name, & + dim_names=netcdf_dimensions(:)%name(), & + type=netcdf_var_type(output_var, use_native_type=restart_local) & + ) + if (allocated(output_var%metadata)) then + do j = 1, size(output_var%metadata) + call output_stream%output_file%put_att(variable_name, output_var%metadata(j)%name, output_var%metadata(j)%value) + end do + end if + select case (netcdf_var_type(output_var, use_native_type=restart_local)) + case (CABLE_NETCDF_INT) + call output_stream%output_file%put_att(variable_name, "_FillValue", CABLE_OUTPUT_FILL_VALUE_INT32) + call output_stream%output_file%put_att(variable_name, "missing_value", CABLE_OUTPUT_FILL_VALUE_INT32) + case (CABLE_NETCDF_FLOAT) + call output_stream%output_file%put_att(variable_name, "_FillValue", CABLE_OUTPUT_FILL_VALUE_REAL32) + call output_stream%output_file%put_att(variable_name, "missing_value", CABLE_OUTPUT_FILL_VALUE_REAL32) + case (CABLE_NETCDF_DOUBLE) + call output_stream%output_file%put_att(variable_name, "_FillValue", CABLE_OUTPUT_FILL_VALUE_REAL64) + call output_stream%output_file%put_att(variable_name, "missing_value", CABLE_OUTPUT_FILL_VALUE_REAL64) + end select + end associate + end do + + if (.not. restart_local) call set_global_attributes(output_stream) + + end subroutine cable_output_define_stream + +end submodule cable_output_define_smod diff --git a/src/util/output/cable_output_impl.F90 b/src/util/output/cable_output_impl.F90 new file mode 100644 index 000000000..8f44a9f6d --- /dev/null +++ b/src/util/output/cable_output_impl.F90 @@ -0,0 +1,317 @@ +! CSIRO Open Source Software License Agreement (variation of the BSD / MIT License) +! Copyright (c) 2015, Commonwealth Scientific and Industrial Research Organisation +! (CSIRO) ABN 41 687 119 230. + +submodule (cable_output_mod:cable_output_common_smod) cable_output_impl_smod + !! Implementation of the public interface procedures in [[cable_output_mod]]. + use cable_common_module, only: filename + use cable_io_vars_module, only: metgrid + use cable_io_vars_module, only: output + use cable_io_vars_module, only: check + use cable_io_vars_module, only: ON_TIMESTEP + use cable_io_vars_module, only: ON_WRITE + use cable_netcdf_mod, only: cable_netcdf_create_file + use cable_netcdf_mod, only: CABLE_NETCDF_IOTYPE_CLASSIC + use cable_timing_mod, only: frequency_matches => cable_timing_frequency_matches + use cable_timing_mod, only: frequency_is_greater_than => cable_timing_frequency_is_greater_than + use cable_array_utils_mod, only: array_eq + implicit none + + !> This flag forces time averaging to computed by summing the diagnostics at + !! each accumulation step and then dividing by the number of samples at write + !! time, rather than computing the average incrementally. This is required to + !! demonstrate bitwise reproducibility with the previous output module. + logical, parameter :: normalised_averaging = .true. + + !> Global output stream instance for the main cable output file. + type(cable_output_stream_t) :: global_output_stream + + !> Registered output variables. + type(cable_output_variable_t), allocatable :: registered_output_variables(:) + +contains + + module subroutine cable_output_impl_init() + !* Module initialisation procedure for `cable_output_mod`. + ! + ! This procedure must be called before any other procedures in + ! `cable_output_mod`. + + call cable_output_decomp_init() + call cable_output_reduction_buffers_init() + + end subroutine + + module subroutine cable_output_impl_end() + !* Module finalization procedure for `cable_output_mod`. + ! + ! This procedure should be called at the end of the simulation after all + ! output has been written. + + if (allocated(global_output_stream%output_file)) call global_output_stream%output_file%close() + + call cable_output_reduction_buffers_free() + call cable_output_decomp_free() + + end subroutine + + module subroutine cable_output_impl_register_output_variables(output_variables) + !* Registers output variables with the output module. Note that + ! registering an output variable does not necessarily mean that the variable + ! will be written to an output stream - this can depend on whether the + ! output variable is active, or if it is a restart variable. Output + ! variables should be registered if their associated diagnostic working + ! variables are initialised in the model as this can help provide the + ! information on the diagnostics which are available. + type(cable_output_variable_t), dimension(:), intent(in) :: output_variables + !! An array of output variable definitions to be registered. + integer :: i + + do i = 1, size(output_variables) + associate(output_var => output_variables(i)) + if (count(output_var%field_name == output_variables(:)%field_name) > 1) then + call cable_abort("Duplicate field_name found: " // output_var%field_name, __FILE__, __LINE__) + end if + if (all(output_var%reduction_method /= allowed_reduction_methods)) then + call cable_abort("Invalid reduction method for variable " // output_var%field_name, __FILE__, __LINE__) + end if + if (all(output_var%aggregation_method /= allowed_aggregation_methods)) then + call cable_abort("Invalid aggregation method for variable " // output_var%field_name, __FILE__, __LINE__) + end if + if (.not. allocated(output_var%aggregator)) then + call cable_abort("Undefined aggregator for variable " // output_var%field_name, __FILE__, __LINE__) + end if + if (.not. allocated(output_var%data_shape) .and. output_var%aggregator%rank() /= 0) then + call cable_abort("Data shape does not match aggregator shape for variable " // output_var%field_name, __FILE__, __LINE__) + end if + if (allocated(output_var%data_shape)) then + if (.not. array_eq(output_var%data_shape(:)%size(), output_var%aggregator%shape())) then + call cable_abort("Data shape does not match aggregator shape for variable " // output_var%field_name, __FILE__, __LINE__) + end if + end if + if (allocated(output_var%range)) then + if (output_var%range(1) >= output_var%range(2)) then + call cable_abort("Invalid range specified for variable " // output_var%field_name, __FILE__, __LINE__) + end if + end if + + end associate + end do + + registered_output_variables = output_variables + + end subroutine cable_output_impl_register_output_variables + + module subroutine cable_output_impl_init_streams(dels) + !! Initialise output streams based on the current output configuration. + real, intent(in) :: dels !! The current time step size in seconds. + integer :: i + character(32) :: grid_type + + if (.not. allocated(registered_output_variables)) then + call cable_abort("Output variables must be registered before initialising output streams.", __FILE__, __LINE__) + end if + + if (output%grid == "land" .OR. (output%grid == "default" .AND. metgrid == "land")) then + grid_type = "land" + else if (( & + output%grid == "default" .AND. metgrid == "mask" & + ) .OR. ( & + output%grid == "mask" .OR. output%grid == "ALMA" & + )) then + grid_type = "mask" + else + call cable_abort("Unable to determine output grid type.", __FILE__, __LINE__) + end if + + global_output_stream = cable_output_stream_t( & + sampling_frequency=output%averaging, & + grid_type=grid_type, & + file_name=filename%out, & + output_file=cable_netcdf_create_file(filename%out, iotype=CABLE_NETCDF_IOTYPE_CLASSIC), & + coordinate_variables=coordinate_variables_list(grid_type), & + output_variables=pack(registered_output_variables, registered_output_variables(:)%active) & + ) + + do i = 1, size(global_output_stream%output_variables) + associate(output_var => global_output_stream%output_variables(i)) + if (count(output_var%get_netcdf_name() == global_output_stream%output_variables(:)%get_netcdf_name()) > 1) then + call cable_abort("Duplicate netCDF variable name in output stream: " // output_var%get_netcdf_name(), __FILE__, __LINE__) + end if + if (frequency_is_greater_than(global_output_stream%sampling_frequency, output_var%accumulation_frequency, dels)) then + call cable_abort( & + "Output stream sampling frequency '" // global_output_stream%sampling_frequency // & + "' is greater than accumulation frequency '" // output_var%accumulation_frequency // & + "' for variable '" // output_var%field_name, __FILE__, __LINE__ & + ) + end if + if (output_var%patchout) output_var%reduction_method = "none" + if (global_output_stream%sampling_frequency == "all") output_var%aggregation_method = "point" + if (allocated(output_var%range)) output_var%range_native = (output_var%range - output_var%offset_by) * output_var%divide_by / output_var%scale_by + end associate + end do + + call cable_output_define_stream(global_output_stream) + + call global_output_stream%output_file%end_def() + + do i = 1, size(global_output_stream%coordinate_variables) + associate(coordinate_variable => global_output_stream%coordinate_variables(i)) + call coordinate_variable%aggregator%init(method="point") + call coordinate_variable%aggregator%accumulate() + call cable_output_write_variable(global_output_stream, coordinate_variable) + call coordinate_variable%aggregator%reset() + end associate + end do + + do i = 1, size(global_output_stream%output_variables) + associate(output_variable => global_output_stream%output_variables(i)) + if (normalised_averaging .and. output_variable%aggregation_method == "mean") then + call output_variable%aggregator%init(method="sum") + else + call output_variable%aggregator%init(method=output_variable%aggregation_method) + end if + end associate + end do + + end subroutine + + module subroutine cable_output_impl_update(time_index, dels, met) + !* Updates the time aggregation accumulation for any output variables that + ! are active in an output stream with an accumulation frequency that matches + ! the current time step. + integer, intent(in) :: time_index !! The current time step index in the simulation. + real, intent(in) :: dels !! The current time step size in seconds. + type(met_type), intent(in) :: met + !* Met variables at the current time step to provide informative error + ! messages for CABLE range checks. + real :: current_time + integer :: i + + if (check%ranges == ON_TIMESTEP) then + do i = 1, size(global_output_stream%output_variables) + call check_variable_range(global_output_stream%output_variables(i), time_index, met) + end do + end if + + do i = 1, size(global_output_stream%output_variables) + associate(output_variable => global_output_stream%output_variables(i)) + if (frequency_matches(dels, time_index, output_variable%accumulation_frequency)) then + call output_variable%aggregator%accumulate( & + scale=output_variable%scale_by, & + div=output_variable%divide_by, & + offset=output_variable%offset_by & + ) + end if + end associate + end do + + end subroutine + + module subroutine cable_output_impl_write(time_index, dels, met, patch, landpt) + !* Writes output variables to disk for any output streams with a sampling + ! frequency that matches the current time step. + integer, intent(in) :: time_index !! The current time step index in the simulation. + real, intent(in) :: dels !! The current time step size in seconds. + type(met_type), intent(in) :: met + !* Met variables at the current time step to provide informative error + ! messages for CABLE range checks. + type(patch_type), intent(in) :: patch(:) + !! The patch type instance for performing grid reductions over the patch dimension if required. + type(land_type), intent(in) :: landpt(:) + !! The land type instance for performing grid reductions over the patch dimension if required. + real :: current_time + integer :: i + + if (frequency_matches(dels, time_index, global_output_stream%sampling_frequency)) then + + do i = 1, size(global_output_stream%output_variables) + associate(output_variable => global_output_stream%output_variables(i)) + if (output_variable%parameter) cycle + if (check%ranges == ON_WRITE) call check_variable_range(output_variable, time_index, met) + if (normalised_averaging .and. output_variable%aggregation_method == "mean") then + call output_variable%aggregator%div(real(output_variable%aggregator%counter)) + end if + call cable_output_write_variable(global_output_stream, output_variable, patch, landpt, frame=global_output_stream%frame + 1) + call output_variable%aggregator%reset() + end associate + end do + + current_time = time_index * dels + + if (global_output_stream%sampling_frequency == "all") then + call global_output_stream%output_file%put_var("time", current_time, start=[global_output_stream%frame + 1]) + else + call global_output_stream%output_file%put_var("time", (current_time + global_output_stream%previous_write_time) / 2.0, start=[global_output_stream%frame + 1]) + end if + + global_output_stream%previous_write_time = current_time + global_output_stream%frame = global_output_stream%frame + 1 + + end if + + end subroutine cable_output_impl_write + + module subroutine cable_output_impl_write_parameters(time_index, patch, landpt) + !* Writes non-time varying parameter output variables to disk. This is + ! done on the first time step of the simulation after the output streams + ! have been initialised. + integer, intent(in) :: time_index !! The current time step index in the simulation. + type(patch_type), intent(in) :: patch(:) + !! The patch type instance for performing grid reductions over the patch dimension if required. + type(land_type), intent(in) :: landpt(:) + !! The land type instance for performing grid reductions over the patch dimension if required. + integer :: i + + do i = 1, size(global_output_stream%output_variables) + associate(output_variable => global_output_stream%output_variables(i)) + if (.not. output_variable%parameter) cycle + call check_variable_range(output_variable, time_index) + call output_variable%aggregator%accumulate( & + scale=output_variable%scale_by, & + div=output_variable%divide_by, & + offset=output_variable%offset_by & + ) + call cable_output_write_variable(global_output_stream, output_variable, patch, landpt) + call output_variable%aggregator%reset() + end associate + end do + + end subroutine + + module subroutine cable_output_impl_write_restart(current_time) + !* Writes variables to the CABLE restart file. This is done at the end of + ! the simulation. + real, intent(in) :: current_time !! Current simulation time + + type(cable_output_stream_t), allocatable :: restart_output_stream + integer :: i + + restart_output_stream = cable_output_stream_t( & + sampling_frequency="none", & + grid_type="restart", & + file_name=filename%restart_out, & + output_file=cable_netcdf_create_file(filename%restart_out, iotype=CABLE_NETCDF_IOTYPE_CLASSIC), & + coordinate_variables=coordinate_variables_list(grid_type="restart"), & + output_variables=pack(registered_output_variables, registered_output_variables(:)%restart) & + ) + + call cable_output_define_stream(restart_output_stream, restart=.true.) + + call restart_output_stream%output_file%end_def() + + call restart_output_stream%output_file%put_var("time", [current_time]) + + do i = 1, size(restart_output_stream%coordinate_variables) + call cable_output_write_variable(restart_output_stream, restart_output_stream%coordinate_variables(i), restart=.true.) + end do + + do i = 1, size(restart_output_stream%output_variables) + call cable_output_write_variable(restart_output_stream, restart_output_stream%output_variables(i), restart=.true.) + end do + + call restart_output_stream%output_file%close() + + end subroutine cable_output_impl_write_restart + +end submodule cable_output_impl_smod diff --git a/src/util/output/cable_output_reduction_buffers.F90 b/src/util/output/cable_output_reduction_buffers.F90 new file mode 100644 index 000000000..b6626ba16 --- /dev/null +++ b/src/util/output/cable_output_reduction_buffers.F90 @@ -0,0 +1,259 @@ +! CSIRO Open Source Software License Agreement (variation of the BSD / MIT License) +! Copyright (c) 2015, Commonwealth Scientific and Industrial Research Organisation +! (CSIRO) ABN 41 687 119 230. + +submodule (cable_output_mod:cable_output_common_smod) cable_output_reduction_buffers_smod + !* Implementation of procedures used for managing the grid reduction buffers + ! used in the output system. + + use cable_error_handler_mod, only: cable_abort + + use cable_array_utils_mod, only: array_eq + + use iso_fortran_env, only: int32, real32, real64 + + use cable_def_types_mod, only: mland + use cable_def_types_mod, only: mp + use cable_def_types_mod, only: ms + use cable_def_types_mod, only: msn + use cable_def_types_mod, only: nrb + use cable_def_types_mod, only: ncs + use cable_def_types_mod, only: ncp + + implicit none + + integer(kind=int32), allocatable, target :: temp_buffer_land_int32(:) + !! Grid reduction buffer for data with shape `[mp]` and type `integer(int32)`. + real(kind=real32), allocatable, target :: temp_buffer_land_real32(:) + !! Grid reduction buffer for data with shape `[mp]` and type `real(real32)`. + real(kind=real64), allocatable, target :: temp_buffer_land_real64(:) + !! Grid reduction buffer for data with shape `[mp]` and type `real(real64)`. + integer(kind=int32), allocatable, target :: temp_buffer_land_soil_int32(:, :) + !! Grid reduction buffer for data with shape `[mp, ms]` and type `integer(int32)`. + real(kind=real32), allocatable, target :: temp_buffer_land_soil_real32(:, :) + !! Grid reduction buffer for data with shape `[mp, ms]` and type `real(real32)`. + real(kind=real64), allocatable, target :: temp_buffer_land_soil_real64(:, :) + !! Grid reduction buffer for data with shape `[mp, ms]` and type `real(real64)`. + integer(kind=int32), allocatable, target :: temp_buffer_land_snow_int32(:, :) + !! Grid reduction buffer for data with shape `[mp, msn]` and type `integer(int32)`. + real(kind=real32), allocatable, target :: temp_buffer_land_snow_real32(:, :) + !! Grid reduction buffer for data with shape `[mp, msn]` and type `real(real32)`. + real(kind=real64), allocatable, target :: temp_buffer_land_snow_real64(:, :) + !! Grid reduction buffer for data with shape `[mp, msn]` and type `real(real64)`. + integer(kind=int32), allocatable, target :: temp_buffer_land_rad_int32(:, :) + !! Grid reduction buffer for data with shape `[mp, nrb]` and type `integer(int32)`. + real(kind=real32), allocatable, target :: temp_buffer_land_rad_real32(:, :) + !! Grid reduction buffer for data with shape `[mp, nrb]` and type `real(real32)`. + real(kind=real64), allocatable, target :: temp_buffer_land_rad_real64(:, :) + !! Grid reduction buffer for data with shape `[mp, nrb]` and type `real(real64)`. + integer(kind=int32), allocatable, target :: temp_buffer_land_plantcarbon_int32(:, :) + !! Grid reduction buffer for data with shape `[mp, ncp]` and type `integer(int32)`. + real(kind=real32), allocatable, target :: temp_buffer_land_plantcarbon_real32(:, :) + !! Grid reduction buffer for data with shape `[mp, ncp]` and type `real(real32)`. + real(kind=real64), allocatable, target :: temp_buffer_land_plantcarbon_real64(:, :) + !! Grid reduction buffer for data with shape `[mp, ncp]` and type `real(real64)`. + integer(kind=int32), allocatable, target :: temp_buffer_land_soilcarbon_int32(:, :) + !! Grid reduction buffer for data with shape `[mp, ncs]` and type `integer(int32)`. + real(kind=real32), allocatable, target :: temp_buffer_land_soilcarbon_real32(:, :) + !! Grid reduction buffer for data with shape `[mp, ncs]` and type `real(real32)`. + real(kind=real64), allocatable, target :: temp_buffer_land_soilcarbon_real64(:, :) + !! Grid reduction buffer for data with shape `[mp, ncs]` and type `real(real64)`. + +contains + + module subroutine cable_output_reduction_buffers_init() + !! Initialises the buffers used for performing grid reductions in the output system. + + allocate(temp_buffer_land_int32(mland)) + allocate(temp_buffer_land_real32(mland)) + allocate(temp_buffer_land_real64(mland)) + allocate(temp_buffer_land_soil_int32(mland, ms)) + allocate(temp_buffer_land_soil_real32(mland, ms)) + allocate(temp_buffer_land_soil_real64(mland, ms)) + allocate(temp_buffer_land_snow_int32(mland, msn)) + allocate(temp_buffer_land_snow_real32(mland, msn)) + allocate(temp_buffer_land_snow_real64(mland, msn)) + allocate(temp_buffer_land_rad_int32(mland, nrb)) + allocate(temp_buffer_land_rad_real32(mland, nrb)) + allocate(temp_buffer_land_rad_real64(mland, nrb)) + allocate(temp_buffer_land_plantcarbon_int32(mland, ncp)) + allocate(temp_buffer_land_plantcarbon_real32(mland, ncp)) + allocate(temp_buffer_land_plantcarbon_real64(mland, ncp)) + allocate(temp_buffer_land_soilcarbon_int32(mland, ncs)) + allocate(temp_buffer_land_soilcarbon_real32(mland, ncs)) + allocate(temp_buffer_land_soilcarbon_real64(mland, ncs)) + + end subroutine + + module subroutine cable_output_reduction_buffers_free() + !! Deallocates the buffers used for performing grid reductions in the output system. + + deallocate(temp_buffer_land_int32) + deallocate(temp_buffer_land_real32) + deallocate(temp_buffer_land_real64) + deallocate(temp_buffer_land_soil_int32) + deallocate(temp_buffer_land_soil_real32) + deallocate(temp_buffer_land_soil_real64) + deallocate(temp_buffer_land_snow_int32) + deallocate(temp_buffer_land_snow_real32) + deallocate(temp_buffer_land_snow_real64) + deallocate(temp_buffer_land_rad_int32) + deallocate(temp_buffer_land_rad_real32) + deallocate(temp_buffer_land_rad_real64) + deallocate(temp_buffer_land_plantcarbon_int32) + deallocate(temp_buffer_land_plantcarbon_real32) + deallocate(temp_buffer_land_plantcarbon_real64) + deallocate(temp_buffer_land_soilcarbon_int32) + deallocate(temp_buffer_land_soilcarbon_real32) + deallocate(temp_buffer_land_soilcarbon_real64) + + end subroutine + + module subroutine cable_output_reduction_buffers_associate_1d_int32(output_var, temp_buffer) + !! The reduction buffer association subroutine for 1D 32-bit integer variables. + type(cable_output_variable_t), intent(inout) :: output_var + !! The output variable for which to associate the reduction buffer. + integer(kind=int32), pointer, intent(inout) :: temp_buffer(:) + !! The pointer array to associate with the appropriate reduction buffer. + + if (array_eq(output_var%data_shape(:)%size(), [mp])) then + temp_buffer => temp_buffer_land_int32 + else + call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) + end if + + end subroutine cable_output_reduction_buffers_associate_1d_int32 + + module subroutine cable_output_reduction_buffers_associate_1d_real32(output_var, temp_buffer) + !! The reduction buffer association subroutine for 1D 32-bit real variables. + type(cable_output_variable_t), intent(inout) :: output_var + !! The output variable for which to associate the reduction buffer. + real(kind=real32), pointer, intent(inout) :: temp_buffer(:) + !! The pointer array to associate with the appropriate reduction buffer. + + if (array_eq(output_var%data_shape(:)%size(), [mp])) then + temp_buffer => temp_buffer_land_real32 + else + call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) + end if + + end subroutine cable_output_reduction_buffers_associate_1d_real32 + + module subroutine cable_output_reduction_buffers_associate_1d_real64(output_var, temp_buffer) + !! The reduction buffer association subroutine for 1D 64-bit real variables. + type(cable_output_variable_t), intent(inout) :: output_var + !! The output variable for which to associate the reduction buffer. + real(kind=real64), pointer, intent(inout) :: temp_buffer(:) + !! The pointer array to associate with the appropriate reduction buffer. + + if (array_eq(output_var%data_shape(:)%size(), [mp])) then + temp_buffer => temp_buffer_land_real64 + else + call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) + end if + + end subroutine cable_output_reduction_buffers_associate_1d_real64 + + module subroutine cable_output_reduction_buffers_associate_2d_int32(output_var, temp_buffer) + !! The reduction buffer association subroutine for 2D 32-bit integer variables. + type(cable_output_variable_t), intent(inout) :: output_var + !! The output variable for which to associate the reduction buffer. + integer(kind=int32), pointer, intent(inout) :: temp_buffer(:,:) + !! The pointer array to associate with the appropriate reduction buffer. + + if (array_eq(output_var%data_shape(:)%size(), [mp, ms])) then + temp_buffer => temp_buffer_land_soil_int32 + else if (array_eq(output_var%data_shape(:)%size(), [mp, msn])) then + temp_buffer => temp_buffer_land_snow_int32 + else if (array_eq(output_var%data_shape(:)%size(), [mp, nrb])) then + temp_buffer => temp_buffer_land_rad_int32 + else if (array_eq(output_var%data_shape(:)%size(), [mp, ncp])) then + temp_buffer => temp_buffer_land_plantcarbon_int32 + else if (array_eq(output_var%data_shape(:)%size(), [mp, ncs])) then + temp_buffer => temp_buffer_land_soilcarbon_int32 + else + call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) + end if + + end subroutine cable_output_reduction_buffers_associate_2d_int32 + + module subroutine cable_output_reduction_buffers_associate_2d_real32(output_var, temp_buffer) + !! The reduction buffer association subroutine for 2D 32-bit real variables. + type(cable_output_variable_t), intent(inout) :: output_var + !! The output variable for which to associate the reduction buffer. + real(kind=real32), pointer, intent(inout) :: temp_buffer(:,:) + !! The pointer array to associate with the appropriate reduction buffer. + + if (array_eq(output_var%data_shape(:)%size(), [mp, ms])) then + temp_buffer => temp_buffer_land_soil_real32 + else if (array_eq(output_var%data_shape(:)%size(), [mp, msn])) then + temp_buffer => temp_buffer_land_snow_real32 + else if (array_eq(output_var%data_shape(:)%size(), [mp, nrb])) then + temp_buffer => temp_buffer_land_rad_real32 + else if (array_eq(output_var%data_shape(:)%size(), [mp, ncp])) then + temp_buffer => temp_buffer_land_plantcarbon_real32 + else if (array_eq(output_var%data_shape(:)%size(), [mp, ncs])) then + temp_buffer => temp_buffer_land_soilcarbon_real32 + else + call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) + end if + + end subroutine cable_output_reduction_buffers_associate_2d_real32 + + module subroutine cable_output_reduction_buffers_associate_2d_real64(output_var, temp_buffer) + !! The reduction buffer association subroutine for 2D 64-bit real variables. + type(cable_output_variable_t), intent(inout) :: output_var + !! The output variable for which to associate the reduction buffer. + real(kind=real64), pointer, intent(inout) :: temp_buffer(:,:) + !! The pointer array to associate with the appropriate reduction buffer. + + if (array_eq(output_var%data_shape(:)%size(), [mp, ms])) then + temp_buffer => temp_buffer_land_soil_real64 + else if (array_eq(output_var%data_shape(:)%size(), [mp, msn])) then + temp_buffer => temp_buffer_land_snow_real64 + else if (array_eq(output_var%data_shape(:)%size(), [mp, nrb])) then + temp_buffer => temp_buffer_land_rad_real64 + else if (array_eq(output_var%data_shape(:)%size(), [mp, ncp])) then + temp_buffer => temp_buffer_land_plantcarbon_real64 + else if (array_eq(output_var%data_shape(:)%size(), [mp, ncs])) then + temp_buffer => temp_buffer_land_soilcarbon_real64 + else + call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) + end if + + end subroutine cable_output_reduction_buffers_associate_2d_real64 + + module subroutine cable_output_reduction_buffers_associate_3d_int32(output_var, temp_buffer) + !! The reduction buffer association subroutine for 3D 32-bit integer variables. + type(cable_output_variable_t), intent(inout) :: output_var + !! The output variable for which to associate the reduction buffer. + integer(kind=int32), pointer, intent(inout) :: temp_buffer(:,:,:) + !! The pointer array to associate with the appropriate reduction buffer. + + call cable_abort("Grid reduction buffers not implemented for this data type.", __FILE__, __LINE__) + + end subroutine cable_output_reduction_buffers_associate_3d_int32 + + module subroutine cable_output_reduction_buffers_associate_3d_real32(output_var, temp_buffer) + !! The reduction buffer association subroutine for 3D 32-bit real variables. + type(cable_output_variable_t), intent(inout) :: output_var + !! The output variable for which to associate the reduction buffer. + real(kind=real32), pointer, intent(inout) :: temp_buffer(:,:,:) + !! The pointer array to associate with the appropriate reduction buffer. + + call cable_abort("Grid reduction buffers not implemented for this data type.", __FILE__, __LINE__) + + end subroutine cable_output_reduction_buffers_associate_3d_real32 + + module subroutine cable_output_reduction_buffers_associate_3d_real64(output_var, temp_buffer) + !! The reduction buffer association subroutine for 3D 64-bit real variables. + type(cable_output_variable_t), intent(inout) :: output_var + !! The output variable for which to associate the reduction buffer. + real(kind=real64), pointer, intent(inout) :: temp_buffer(:,:,:) + !! The pointer array to associate with the appropriate reduction buffer. + + call cable_abort("Grid reduction buffers not implemented for this data type.", __FILE__, __LINE__) + + end subroutine cable_output_reduction_buffers_associate_3d_real64 + +end submodule cable_output_reduction_buffers_smod diff --git a/src/util/output/cable_output_write.F90 b/src/util/output/cable_output_write.F90 new file mode 100644 index 000000000..1afb72df0 --- /dev/null +++ b/src/util/output/cable_output_write.F90 @@ -0,0 +1,575 @@ +! CSIRO Open Source Software License Agreement (variation of the BSD / MIT License) +! Copyright (c) 2015, Commonwealth Scientific and Industrial Research Organisation +! (CSIRO) ABN 41 687 119 230. + +! TODO(Sean): The preprocessor define ENFORCE_SINGLE_PRECISION is enabled +! temporarily to restore bitwise reproducibility with the previous output module +! which enforces double precision variables to be sampled using single precision +! arrays, and enforces writing both double and single precision data as single +! precision. +#define ENFORCE_SINGLE_PRECISION + +submodule (cable_output_mod:cable_output_common_smod) cable_output_write_smod + !! Implementation of procedures for writing data to output streams. + + use aggregator_mod, only: aggregator_int32_0d_t + use aggregator_mod, only: aggregator_int32_1d_t + use aggregator_mod, only: aggregator_int32_2d_t + use aggregator_mod, only: aggregator_int32_3d_t + use aggregator_mod, only: aggregator_real32_0d_t + use aggregator_mod, only: aggregator_real32_1d_t + use aggregator_mod, only: aggregator_real32_2d_t + use aggregator_mod, only: aggregator_real32_3d_t + use aggregator_mod, only: aggregator_real64_0d_t + use aggregator_mod, only: aggregator_real64_1d_t + use aggregator_mod, only: aggregator_real64_2d_t + use aggregator_mod, only: aggregator_real64_3d_t + + use cable_netcdf_mod, only: cable_netcdf_decomp_t + + use cable_grid_reductions_mod, only: grid_cell_average + use cable_grid_reductions_mod, only: first_patch_in_grid_cell + + implicit none + +contains + + module subroutine cable_output_write_variable(output_stream, output_variable, patch, landpt, frame, restart) + !! Writes a variable to the output stream. + type(cable_output_stream_t), intent(inout) :: output_stream !! The output stream to write to. + type(cable_output_variable_t), intent(inout), target :: output_variable !! The variable to write. + type(patch_type), intent(in), optional :: patch(:) + !! The patch type instance for performing grid reductions over the patch dimension if required. + type(land_type), intent(in), optional :: landpt(:) + !! The land type instance for performing grid reductions over the patch dimension if required. + integer, intent(in), optional :: frame !! The frame or unlimited dimension index to write at. + logical, intent(in), optional :: restart !! Whether this is a restart stream write. + class(cable_netcdf_decomp_t), pointer :: decomp + integer :: i, ndims + logical :: restart_local + character(128) :: variable_name + + integer(kind=int32), pointer :: write_buffer_int32_0d + integer(kind=int32), pointer :: write_buffer_int32_1d(:) + integer(kind=int32), pointer :: write_buffer_int32_2d(:, :) + integer(kind=int32), pointer :: write_buffer_int32_3d(:, :, :) + real(kind=real32), pointer :: write_buffer_real32_0d + real(kind=real32), pointer :: write_buffer_real32_1d(:) + real(kind=real32), pointer :: write_buffer_real32_2d(:, :) + real(kind=real32), pointer :: write_buffer_real32_3d(:, :, :) +#ifdef ENFORCE_SINGLE_PRECISION + real(kind=real32), pointer :: write_buffer_real64_0d + real(kind=real32), pointer :: write_buffer_real64_1d(:) + real(kind=real32), pointer :: write_buffer_real64_2d(:, :) + real(kind=real32), pointer :: write_buffer_real64_3d(:, :, :) +#else + real(kind=real64), pointer :: write_buffer_real64_0d + real(kind=real64), pointer :: write_buffer_real64_1d(:) + real(kind=real64), pointer :: write_buffer_real64_2d(:, :) + real(kind=real64), pointer :: write_buffer_real64_3d(:, :, :) +#endif + + decomp => null() + + write_buffer_int32_0d => null() + write_buffer_int32_1d => null() + write_buffer_int32_2d => null() + write_buffer_int32_3d => null() + write_buffer_real32_0d => null() + write_buffer_real32_1d => null() + write_buffer_real32_2d => null() + write_buffer_real32_3d => null() + write_buffer_real64_0d => null() + write_buffer_real64_1d => null() + write_buffer_real64_2d => null() + write_buffer_real64_3d => null() + + restart_local = .false. + if (present(restart)) restart_local = restart + + if (.not. restart_local .and. output_variable%reduction_method /= "none") then + if (.not. present(patch) .or. .not. present(landpt)) then + call cable_abort("Optional arguments patch and landpt must be present for grid reductions", __FILE__, __LINE__) + end if + end if + + variable_name = output_variable%get_netcdf_name() + if (restart_local) variable_name = output_variable%field_name + + select type (aggregator => output_variable%aggregator) + type is (aggregator_int32_0d_t) + if (output_variable%reduction_method /= "none") then + call cable_abort("Grid cell reductions are not supported for scalar variables", __FILE__, __LINE__) + end if + if (output_variable%distributed) then + call cable_abort("Distributed writes are not supported for scalar variables", __FILE__, __LINE__) + end if + write_buffer_int32_0d => aggregator%aggregated_data + if (restart_local) write_buffer_int32_0d => aggregator%source_data + if (present(frame)) then + call output_stream%output_file%inq_var_ndims(variable_name, ndims) + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_int32_0d, & + start=[(1, i = 1, ndims - 1), frame]) + else + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_int32_0d) + end if + type is (aggregator_int32_1d_t) + if (restart_local) then + write_buffer_int32_1d => aggregator%source_data + else if (output_variable%reduction_method == "none") then + write_buffer_int32_1d => aggregator%aggregated_data + else if (output_variable%reduction_method == "grid_cell_average") then + call cable_abort("Reduction method grid_cell_average is not supported for integer variables", __FILE__, __LINE__) + else if (output_variable%reduction_method == "first_patch_in_grid_cell") then + call cable_output_reduction_buffers_associate(output_variable, write_buffer_int32_1d) + call first_patch_in_grid_cell( & + input_array=aggregator%aggregated_data, & + output_array=write_buffer_int32_1d, & + landpt=landpt) + else + call cable_abort("Invalid reduction method", __FILE__, __LINE__) + end if + if (output_variable%distributed) then + call cable_output_decomp_associate(output_stream, output_variable, decomp) + call output_stream%output_file%write_darray( & + var_name=variable_name, & + values=write_buffer_int32_1d, & + decomp=decomp, & + fill_value=CABLE_OUTPUT_FILL_VALUE_INT32, & + frame=frame) + else if (present(frame)) then + call output_stream%output_file%inq_var_ndims(variable_name, ndims) + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_int32_1d, & + start=[(1, i = 1, ndims - 1), frame]) + else + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_int32_1d) + end if + type is (aggregator_int32_2d_t) + if (restart_local) then + write_buffer_int32_2d => aggregator%source_data + else if (output_variable%reduction_method == "none") then + write_buffer_int32_2d => aggregator%aggregated_data + else if (output_variable%reduction_method == "grid_cell_average") then + call cable_abort("Reduction method grid_cell_average is not supported for integer variables", __FILE__, __LINE__) + else if (output_variable%reduction_method == "first_patch_in_grid_cell") then + call cable_output_reduction_buffers_associate(output_variable, write_buffer_int32_2d) + call first_patch_in_grid_cell( & + input_array=aggregator%aggregated_data, & + output_array=write_buffer_int32_2d, & + landpt=landpt) + else + call cable_abort("Invalid reduction method", __FILE__, __LINE__) + end if + if (output_variable%distributed) then + call cable_output_decomp_associate(output_stream, output_variable, decomp) + call output_stream%output_file%write_darray( & + var_name=variable_name, & + values=write_buffer_int32_2d, & + decomp=decomp, & + fill_value=CABLE_OUTPUT_FILL_VALUE_INT32, & + frame=frame) + else if (present(frame)) then + call output_stream%output_file%inq_var_ndims(variable_name, ndims) + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_int32_2d, & + start=[(1, i = 1, ndims - 1), frame]) + else + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_int32_2d) + end if + type is (aggregator_int32_3d_t) + if (restart_local) then + write_buffer_int32_3d => aggregator%source_data + else if (output_variable%reduction_method == "none") then + write_buffer_int32_3d => aggregator%aggregated_data + else if (output_variable%reduction_method == "grid_cell_average") then + call cable_abort("Reduction method grid_cell_average is not supported for integer variables", __FILE__, __LINE__) + else if (output_variable%reduction_method == "first_patch_in_grid_cell") then + call cable_output_reduction_buffers_associate(output_variable, write_buffer_int32_3d) + call first_patch_in_grid_cell( & + input_array=aggregator%aggregated_data, & + output_array=write_buffer_int32_3d, & + landpt=landpt) + else + call cable_abort("Invalid reduction method", __FILE__, __LINE__) + end if + if (output_variable%distributed) then + call cable_output_decomp_associate(output_stream, output_variable, decomp) + call output_stream%output_file%write_darray( & + var_name=variable_name, & + values=write_buffer_int32_3d, & + decomp=decomp, & + fill_value=CABLE_OUTPUT_FILL_VALUE_INT32, & + frame=frame) + else if (present(frame)) then + call output_stream%output_file%inq_var_ndims(variable_name, ndims) + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_int32_3d, & + start=[(1, i = 1, ndims - 1), frame]) + else + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_int32_3d) + end if + type is (aggregator_real32_0d_t) + if (output_variable%reduction_method /= "none") then + call cable_abort("Grid cell reductions are not supported for scalar variables", __FILE__, __LINE__) + end if + if (output_variable%distributed) then + call cable_abort("Distributed writes are not supported for scalar variables", __FILE__, __LINE__) + end if + write_buffer_real32_0d => aggregator%aggregated_data + if (restart_local) write_buffer_real32_0d => aggregator%source_data + if (present(frame)) then + call output_stream%output_file%inq_var_ndims(variable_name, ndims) + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_real32_0d, & + start=[(1, i = 1, ndims - 1), frame]) + else + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_real32_0d) + end if + type is (aggregator_real32_1d_t) + if (restart_local) then + write_buffer_real32_1d => aggregator%source_data + else if (output_variable%reduction_method == "none") then + write_buffer_real32_1d => aggregator%aggregated_data + else if (output_variable%reduction_method == "grid_cell_average") then + call cable_output_reduction_buffers_associate(output_variable, write_buffer_real32_1d) + call grid_cell_average( & + input_array=aggregator%aggregated_data, & + output_array=write_buffer_real32_1d, & + landpt=landpt, & + patch=patch) + else if (output_variable%reduction_method == "first_patch_in_grid_cell") then + call cable_output_reduction_buffers_associate(output_variable, write_buffer_real32_1d) + call first_patch_in_grid_cell( & + input_array=aggregator%aggregated_data, & + output_array=write_buffer_real32_1d, & + landpt=landpt) + else + call cable_abort("Invalid reduction method", __FILE__, __LINE__) + end if + if (output_variable%distributed) then + call cable_output_decomp_associate(output_stream, output_variable, decomp) + call output_stream%output_file%write_darray( & + var_name=variable_name, & + values=write_buffer_real32_1d, & + decomp=decomp, & + fill_value=CABLE_OUTPUT_FILL_VALUE_REAL32, & + frame=frame) + else if (present(frame)) then + call output_stream%output_file%inq_var_ndims(variable_name, ndims) + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_real32_1d, & + start=[(1, i = 1, ndims - 1), frame]) + else + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_real32_1d) + end if + type is (aggregator_real32_2d_t) + if (restart_local) then + write_buffer_real32_2d => aggregator%source_data + else if (output_variable%reduction_method == "none") then + write_buffer_real32_2d => aggregator%aggregated_data + else if (output_variable%reduction_method == "grid_cell_average") then + call cable_output_reduction_buffers_associate(output_variable, write_buffer_real32_2d) + call grid_cell_average( & + input_array=aggregator%aggregated_data, & + output_array=write_buffer_real32_2d, & + landpt=landpt, & + patch=patch) + else if (output_variable%reduction_method == "first_patch_in_grid_cell") then + call cable_output_reduction_buffers_associate(output_variable, write_buffer_real32_2d) + call first_patch_in_grid_cell( & + input_array=aggregator%aggregated_data, & + output_array=write_buffer_real32_2d, & + landpt=landpt) + else + call cable_abort("Invalid reduction method", __FILE__, __LINE__) + end if + if (output_variable%distributed) then + call cable_output_decomp_associate(output_stream, output_variable, decomp) + call output_stream%output_file%write_darray( & + var_name=variable_name, & + values=write_buffer_real32_2d, & + decomp=decomp, & + fill_value=CABLE_OUTPUT_FILL_VALUE_REAL32, & + frame=frame) + else if (present(frame)) then + call output_stream%output_file%inq_var_ndims(variable_name, ndims) + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_real32_2d, & + start=[(1, i = 1, ndims - 1), frame]) + else + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_real32_2d) + end if + type is (aggregator_real32_3d_t) + if (restart_local) then + write_buffer_real32_3d => aggregator%source_data + else if (output_variable%reduction_method == "none") then + write_buffer_real32_3d => aggregator%aggregated_data + else if (output_variable%reduction_method == "grid_cell_average") then + call cable_output_reduction_buffers_associate(output_variable, write_buffer_real32_3d) + call grid_cell_average( & + input_array=aggregator%aggregated_data, & + output_array=write_buffer_real32_3d, & + landpt=landpt, & + patch=patch) + else if (output_variable%reduction_method == "first_patch_in_grid_cell") then + call cable_output_reduction_buffers_associate(output_variable, write_buffer_real32_3d) + call first_patch_in_grid_cell( & + input_array=aggregator%aggregated_data, & + output_array=write_buffer_real32_3d, & + landpt=landpt) + else + call cable_abort("Invalid reduction method", __FILE__, __LINE__) + end if + if (output_variable%distributed) then + call cable_output_decomp_associate(output_stream, output_variable, decomp) + call output_stream%output_file%write_darray( & + var_name=variable_name, & + values=write_buffer_real32_3d, & + decomp=decomp, & + fill_value=CABLE_OUTPUT_FILL_VALUE_REAL32, & + frame=frame) + else if (present(frame)) then + call output_stream%output_file%inq_var_ndims(variable_name, ndims) + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_real32_3d, & + start=[(1, i = 1, ndims - 1), frame]) + else + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_real32_3d) + end if + type is (aggregator_real64_0d_t) + if (output_variable%reduction_method /= "none") then + call cable_abort("Grid cell reductions are not supported for scalar variables", __FILE__, __LINE__) + end if + if (output_variable%distributed) then + call cable_abort("Distributed writes are not supported for scalar variables", __FILE__, __LINE__) + end if + write_buffer_real64_0d => aggregator%aggregated_data +#ifdef ENFORCE_SINGLE_PRECISION + if (restart_local) then + call output_stream%output_file%put_var(variable_name, real(aggregator%source_data, kind=real32)) + return + end if +#else + if (restart_local) write_buffer_real64_0d => aggregator%source_data +#endif + if (present(frame)) then + call output_stream%output_file%inq_var_ndims(variable_name, ndims) + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_real64_0d, & + start=[(1, i = 1, ndims - 1), frame]) + else + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_real64_0d) + end if + type is (aggregator_real64_1d_t) + if (restart_local) then +#ifdef ENFORCE_SINGLE_PRECISION + if (output_variable%distributed) then + call cable_output_decomp_associate(output_stream, output_variable, decomp) + call output_stream%output_file%write_darray( & + var_name=variable_name, & + values=real(aggregator%source_data, kind=real32), & + decomp=decomp, & + fill_value=CABLE_OUTPUT_FILL_VALUE_REAL32, & + frame=frame) + else + call output_stream%output_file%put_var(variable_name, real(aggregator%source_data, kind=real32)) + end if + return +#else + write_buffer_real64_1d => aggregator%source_data +#endif + else if (output_variable%reduction_method == "none") then + write_buffer_real64_1d => aggregator%aggregated_data + else if (output_variable%reduction_method == "grid_cell_average") then + call cable_output_reduction_buffers_associate(output_variable, write_buffer_real64_1d) + call grid_cell_average( & + input_array=aggregator%aggregated_data, & + output_array=write_buffer_real64_1d, & + landpt=landpt, & + patch=patch) + else if (output_variable%reduction_method == "first_patch_in_grid_cell") then + call cable_output_reduction_buffers_associate(output_variable, write_buffer_real64_1d) + call first_patch_in_grid_cell( & + input_array=aggregator%aggregated_data, & + output_array=write_buffer_real64_1d, & + landpt=landpt) + else + call cable_abort("Invalid reduction method", __FILE__, __LINE__) + end if + if (output_variable%distributed) then + call cable_output_decomp_associate(output_stream, output_variable, decomp) + call output_stream%output_file%write_darray( & + var_name=variable_name, & + values=write_buffer_real64_1d, & + decomp=decomp, & +#ifdef ENFORCE_SINGLE_PRECISION + fill_value=CABLE_OUTPUT_FILL_VALUE_REAL32, & +#else + fill_value=CABLE_OUTPUT_FILL_VALUE_REAL64, & +#endif + frame=frame) + else if (present(frame)) then + call output_stream%output_file%inq_var_ndims(variable_name, ndims) + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_real64_1d, & + start=[(1, i = 1, ndims - 1), frame]) + else + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_real64_1d) + end if + type is (aggregator_real64_2d_t) + if (restart_local) then +#ifdef ENFORCE_SINGLE_PRECISION + if (output_variable%distributed) then + call cable_output_decomp_associate(output_stream, output_variable, decomp) + call output_stream%output_file%write_darray( & + var_name=variable_name, & + values=real(aggregator%source_data, kind=real32), & + decomp=decomp, & + fill_value=CABLE_OUTPUT_FILL_VALUE_REAL32, & + frame=frame) + else + call output_stream%output_file%put_var(variable_name, real(aggregator%source_data, kind=real32)) + end if + return +#else + write_buffer_real64_2d => aggregator%source_data +#endif + else if (output_variable%reduction_method == "none") then + write_buffer_real64_2d => aggregator%aggregated_data + else if (output_variable%reduction_method == "grid_cell_average") then + call cable_output_reduction_buffers_associate(output_variable, write_buffer_real64_2d) + call grid_cell_average( & + input_array=aggregator%aggregated_data, & + output_array=write_buffer_real64_2d, & + landpt=landpt, & + patch=patch) + else if (output_variable%reduction_method == "first_patch_in_grid_cell") then + call cable_output_reduction_buffers_associate(output_variable, write_buffer_real64_2d) + call first_patch_in_grid_cell( & + input_array=aggregator%aggregated_data, & + output_array=write_buffer_real64_2d, & + landpt=landpt) + else + call cable_abort("Invalid reduction method", __FILE__, __LINE__) + end if + if (output_variable%distributed) then + call cable_output_decomp_associate(output_stream, output_variable, decomp) + call output_stream%output_file%write_darray( & + var_name=variable_name, & + values=write_buffer_real64_2d, & + decomp=decomp, & +#ifdef ENFORCE_SINGLE_PRECISION + fill_value=CABLE_OUTPUT_FILL_VALUE_REAL32, & +#else + fill_value=CABLE_OUTPUT_FILL_VALUE_REAL64, & +#endif + frame=frame) + else if (present(frame)) then + call output_stream%output_file%inq_var_ndims(variable_name, ndims) + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_real64_2d, & + start=[(1, i = 1, ndims - 1), frame]) + else + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_real64_2d) + end if + type is (aggregator_real64_3d_t) + if (restart_local) then +#ifdef ENFORCE_SINGLE_PRECISION + if (output_variable%distributed) then + call cable_output_decomp_associate(output_stream, output_variable, decomp) + call output_stream%output_file%write_darray( & + var_name=variable_name, & + values=real(aggregator%source_data, kind=real32), & + decomp=decomp, & + fill_value=CABLE_OUTPUT_FILL_VALUE_REAL32, & + frame=frame) + else + call output_stream%output_file%put_var(variable_name, real(aggregator%source_data, kind=real32)) + end if + return +#else + write_buffer_real64_3d => aggregator%source_data +#endif + else if (output_variable%reduction_method == "none") then + write_buffer_real64_3d => aggregator%aggregated_data + else if (output_variable%reduction_method == "grid_cell_average") then + call cable_output_reduction_buffers_associate(output_variable, write_buffer_real64_3d) + call grid_cell_average( & + input_array=aggregator%aggregated_data, & + output_array=write_buffer_real64_3d, & + landpt=landpt, & + patch=patch) + else if (output_variable%reduction_method == "first_patch_in_grid_cell") then + call cable_output_reduction_buffers_associate(output_variable, write_buffer_real64_3d) + call first_patch_in_grid_cell( & + input_array=aggregator%aggregated_data, & + output_array=write_buffer_real64_3d, & + landpt=landpt) + else + call cable_abort("Invalid reduction method", __FILE__, __LINE__) + end if + if (output_variable%distributed) then + call cable_output_decomp_associate(output_stream, output_variable, decomp) + call output_stream%output_file%write_darray( & + var_name=variable_name, & + values=write_buffer_real64_3d, & + decomp=decomp, & +#ifdef ENFORCE_SINGLE_PRECISION + fill_value=CABLE_OUTPUT_FILL_VALUE_REAL32, & +#else + fill_value=CABLE_OUTPUT_FILL_VALUE_REAL64, & +#endif + frame=frame) + else if (present(frame)) then + call output_stream%output_file%inq_var_ndims(variable_name, ndims) + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_real64_3d, & + start=[(1, i = 1, ndims - 1), frame]) + else + call output_stream%output_file%put_var( & + var_name=variable_name, & + values=write_buffer_real64_3d) + end if + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + + end subroutine cable_output_write_variable + +end submodule cable_output_write_smod