diff --git a/CMakeLists.txt b/CMakeLists.txt index 93d150c94..e239a2836 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -37,148 +37,247 @@ if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") ) endif() -add_library( - cable_common - STATIC - src/offline/cable_abort.F90 - src/offline/cable_checks.F90 - src/offline/cable_cru_TRENDY.F90 - src/offline/cable_define_types.F90 - src/offline/cable_driver_init.F90 - src/offline/cable_initialise.F90 - src/offline/cable_input.F90 - src/offline/cable_iovars.F90 - src/offline/cable_LUC_EXPT.F90 - src/offline/cable_metutils.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_phenology.F90 - src/offline/cable_plume_mip.F90 - src/offline/cable_read.F90 - src/offline/cable_site.F90 - src/offline/cable_serial.F90 - src/offline/cable_soil_params.F90 - src/offline/cable_surface_types.F90 - src/offline/cable_weathergenerator.F90 - src/offline/cable_write.F90 - src/offline/casa_cable.F90 - src/offline/casa_ncdf.F90 - src/offline/casa_offline_inout.F90 - src/offline/CASAONLY_LUC.F90 - src/offline/cbl_model_driver_offline.F90 - src/offline/landuse_inout.F90 - src/offline/spincasacnp.F90 - src/offline/cable_surface_types.F90 - src/params/cable_maths_constants_mod.F90 - src/params/cable_other_constants_mod.F90 - src/params/cable_photo_constants_mod.F90 - src/params/cable_phys_constants_mod.F90 - src/params/grid_constants_cbl.F90 - src/science/albedo/cbl_albedo.F90 - src/science/albedo/cbl_snow_albedo.F90 - src/science/albedo/cbl_soilColour_albedo.F90 - src/science/canopy/cable_canopy.F90 - src/science/canopy/cbl_dryLeaf.F90 - src/science/canopy/cbl_friction_vel.F90 - src/science/canopy/cbl_fwsoil.F90 - src/science/canopy/cbl_init_wetfac_mod.F90 - src/science/canopy/cbl_latent_heat.F90 - src/science/canopy/cbl_photosynthesis.F90 - src/science/canopy/cbl_pot_evap_snow.F90 - src/science/canopy/cbl_qsat.F90 - src/science/canopy/cbl_SurfaceWetness.F90 - src/science/canopy/cbl_wetleaf.F90 - src/science/canopy/cbl_within_canopy.F90 - src/science/canopy/cbl_zetar.F90 - src/science/casa-cnp/bgcdriver.F90 - src/science/casa-cnp/biogeochem_casa.F90 - src/science/casa-cnp/casa_cnp.F90 - src/science/casa-cnp/casa_dimension.F90 - src/science/casa-cnp/casa_feedback.F90 - src/science/casa-cnp/casa_inout.F90 - src/science/casa-cnp/casa_param.F90 - src/science/casa-cnp/casa_phenology.F90 - src/science/casa-cnp/casa_readbiome.F90 - src/science/casa-cnp/casa_rplant.F90 - src/science/casa-cnp/casa_sumcflux.F90 - src/science/casa-cnp/casa_variable.F90 - src/science/gw_hydro/cable_gw_hydro.F90 - src/science/gw_hydro/cable_psm.F90 - src/science/landuse/landuse3.F90 - src/science/landuse/landuse_constant.F90 - src/science/misc/cable_air.F90 - src/science/misc/cable_carbon.F90 - src/science/misc/cable_climate.F90 - src/science/pop/pop_constants.F90 - src/science/pop/pop_def.F90 - src/science/pop/POP.F90 - src/science/pop/pop_io.F90 - src/science/pop/POPLUC.F90 - src/science/pop/pop_types.F90 - src/science/radiation/cbl_init_radiation.F90 - src/science/radiation/cbl_radiation.F90 - src/science/radiation/cbl_rhoch.F90 - src/science/radiation/cbl_sinbet.F90 - src/science/radiation/cbl_spitter.F90 - src/science/roughness/cable_roughness.F90 - src/science/roughness/roughnessHGT_effLAI_cbl.F90 - src/science/sli/cable_sli_main.F90 - src/science/sli/cable_sli_numbers.F90 - src/science/sli/cable_sli_roots.F90 - src/science/sli/cable_sli_solve.F90 - src/science/sli/cable_sli_utils.F90 - src/science/soilsnow/cbl_conductivity.F90 - src/science/soilsnow/cbl_GW.F90 - src/science/soilsnow/cbl_hyd_redistrib.F90 - src/science/soilsnow/cbl_Oldconductivity.F90 - src/science/soilsnow/cbl_remove_trans.F90 - src/science/soilsnow/cbl_smoisturev.F90 - src/science/soilsnow/cbl_snowAccum.F90 - src/science/soilsnow/cbl_snow_aging.F90 - src/science/soilsnow/cbl_snowCheck.F90 - src/science/soilsnow/cbl_snowDensity.F90 - src/science/soilsnow/cbl_snowl_adjust.F90 - src/science/soilsnow/cbl_snowMelt.F90 - src/science/soilsnow/cbl_soilfreeze.F90 - src/science/soilsnow/cbl_soilsnow_data.F90 - src/science/soilsnow/cbl_soilsnow_init_special.F90 - src/science/soilsnow/cbl_soilsnow_main.F90 - src/science/soilsnow/cbl_stempv.F90 - src/science/soilsnow/cbl_surfbv.F90 - src/science/soilsnow/cbl_thermal.F90 - src/science/soilsnow/cbl_trimb.F90 - src/util/cable_climate_type_mod.F90 - src/util/cable_common.F90 - src/util/cable_runtime_opts_mod.F90 - src/util/masks_cbl.F90 -) -target_link_libraries(cable_common PRIVATE PkgConfig::NETCDF) -if(CABLE_MPI) - target_compile_definitions(cable_common PRIVATE __MPI__) - target_link_libraries(cable_common PRIVATE MPI::MPI_Fortran) -endif() +if(CABLE_LIBRARY) -if(CABLE_MPI) - add_executable( - cable-mpi - src/offline/cable_mpicommon.F90 - src/offline/cable_mpimaster.F90 - src/offline/cable_mpiworker.F90 - src/science/pop/pop_mpi.F90 - src/offline/cable_offline_driver.F90 + add_library( + cable_science + STATIC + src/science/albedo/cbl_albedo.F90 + src/science/albedo/cbl_snow_albedo.F90 + src/science/albedo/cbl_soilColour_albedo.F90 + src/science/canopy/cable_canopy.F90 + src/science/canopy/cbl_dryLeaf.F90 + src/science/canopy/cbl_friction_vel.F90 + src/science/canopy/cbl_fwsoil.F90 + src/science/canopy/cbl_init_wetfac_mod.F90 + src/science/canopy/cbl_latent_heat.F90 + src/science/canopy/cbl_photosynthesis.F90 + src/science/canopy/cbl_pot_evap_snow.F90 + src/science/canopy/cbl_qsat.F90 + src/science/canopy/cbl_SurfaceWetness.F90 + src/science/canopy/cbl_wetleaf.F90 + src/science/canopy/cbl_within_canopy.F90 + src/science/canopy/cbl_zetar.F90 + src/science/casa-cnp/bgcdriver.F90 + src/science/casa-cnp/biogeochem_casa.F90 + src/science/casa-cnp/casa_cnp.F90 + src/science/casa-cnp/casa_dimension.F90 + src/science/casa-cnp/casa_feedback.F90 + src/science/casa-cnp/casa_inout.F90 + src/science/casa-cnp/casa_param.F90 + src/science/casa-cnp/casa_phenology.F90 + src/science/casa-cnp/casa_readbiome.F90 + src/science/casa-cnp/casa_rplant.F90 + src/science/casa-cnp/casa_sumcflux.F90 + src/science/casa-cnp/casa_variable.F90 + src/science/gw_hydro/cable_gw_hydro.F90 + src/science/gw_hydro/cable_psm.F90 + src/science/landuse/landuse3.F90 + src/science/landuse/landuse_constant.F90 + src/science/misc/cable_air.F90 + src/science/misc/cable_carbon.F90 + src/science/misc/cable_climate.F90 + src/science/pop/pop_constants.F90 + src/science/pop/pop_def.F90 + src/science/pop/POP.F90 + src/science/pop/pop_io.F90 + src/science/pop/POPLUC.F90 + src/science/pop/pop_types.F90 + src/science/radiation/cbl_init_radiation.F90 + src/science/radiation/cbl_radiation.F90 + src/science/radiation/cbl_rhoch.F90 + src/science/radiation/cbl_sinbet.F90 + src/science/radiation/cbl_spitter.F90 + src/science/roughness/cable_roughness.F90 + src/science/roughness/roughnessHGT_effLAI_cbl.F90 + src/science/sli/cable_sli_main.F90 + src/science/sli/cable_sli_numbers.F90 + src/science/sli/cable_sli_roots.F90 + src/science/sli/cable_sli_solve.F90 + src/science/sli/cable_sli_utils.F90 + src/science/soilsnow/cbl_conductivity.F90 + src/science/soilsnow/cbl_GW.F90 + src/science/soilsnow/cbl_hyd_redistrib.F90 + src/science/soilsnow/cbl_Oldconductivity.F90 + src/science/soilsnow/cbl_remove_trans.F90 + src/science/soilsnow/cbl_smoisturev.F90 + src/science/soilsnow/cbl_snowAccum.F90 + src/science/soilsnow/cbl_snow_aging.F90 + src/science/soilsnow/cbl_snowCheck.F90 + src/science/soilsnow/cbl_snowDensity.F90 + src/science/soilsnow/cbl_snowl_adjust.F90 + src/science/soilsnow/cbl_snowMelt.F90 + src/science/soilsnow/cbl_soilfreeze.F90 + src/science/soilsnow/cbl_soilsnow_data.F90 + src/science/soilsnow/cbl_soilsnow_init_special.F90 + src/science/soilsnow/cbl_soilsnow_main.F90 + src/science/soilsnow/cbl_stempv.F90 + src/science/soilsnow/cbl_surfbv.F90 + src/science/soilsnow/cbl_thermal.F90 + src/science/soilsnow/cbl_trimb.F90 + src/params/cable_phys_constants_mod.F90 + src/params/grid_constants_cbl.F90 + src/params/cable_photo_constants_mod.F90 + src/params/cable_other_constants_mod.F90 + src/params/cable_maths_constants_mod.F90 + src/util/cable_runtime_opts_mod.F90 + src/util/cable_common.F90 + src/coupled/esm16/casa_offline_inout.F90 + src/coupled/esm16/casa_ncdf.F90 + src/coupled/esm16/cable_iovars.F90 + src/coupled/esm16/cable_surface_types.F90 + src/coupled/esm16/cable_define_types.F90 + src/coupled/esm16/cable_phenology.F90 + src/coupled/esm16/cable_LUC_EXPT.F90 ) - target_link_libraries(cable-mpi PRIVATE cable_common MPI::MPI_Fortran) - install(TARGETS cable-mpi RUNTIME) + else() - add_executable( - cable - src/offline/cable_mpimaster_stub.F90 - src/offline/cable_mpiworker_stub.F90 - src/offline/cable_offline_driver.F90 + + add_library( + cable_common + STATIC + src/science/albedo/cbl_albedo.F90 + src/science/albedo/cbl_snow_albedo.F90 + src/science/albedo/cbl_soilColour_albedo.F90 + src/science/canopy/cable_canopy.F90 + src/science/canopy/cbl_dryLeaf.F90 + src/science/canopy/cbl_friction_vel.F90 + src/science/canopy/cbl_fwsoil.F90 + src/science/canopy/cbl_init_wetfac_mod.F90 + src/science/canopy/cbl_latent_heat.F90 + src/science/canopy/cbl_photosynthesis.F90 + src/science/canopy/cbl_pot_evap_snow.F90 + src/science/canopy/cbl_qsat.F90 + src/science/canopy/cbl_SurfaceWetness.F90 + src/science/canopy/cbl_wetleaf.F90 + src/science/canopy/cbl_within_canopy.F90 + src/science/canopy/cbl_zetar.F90 + src/science/casa-cnp/bgcdriver.F90 + src/science/casa-cnp/biogeochem_casa.F90 + src/science/casa-cnp/casa_cnp.F90 + src/science/casa-cnp/casa_dimension.F90 + src/science/casa-cnp/casa_feedback.F90 + src/science/casa-cnp/casa_inout.F90 + src/science/casa-cnp/casa_param.F90 + src/science/casa-cnp/casa_phenology.F90 + src/science/casa-cnp/casa_readbiome.F90 + src/science/casa-cnp/casa_rplant.F90 + src/science/casa-cnp/casa_sumcflux.F90 + src/science/casa-cnp/casa_variable.F90 + src/science/gw_hydro/cable_gw_hydro.F90 + src/science/gw_hydro/cable_psm.F90 + src/science/landuse/landuse3.F90 + src/science/landuse/landuse_constant.F90 + src/science/misc/cable_air.F90 + src/science/misc/cable_carbon.F90 + src/science/misc/cable_climate.F90 + src/science/pop/pop_constants.F90 + src/science/pop/pop_def.F90 + src/science/pop/POP.F90 + src/science/pop/pop_io.F90 + src/science/pop/POPLUC.F90 + src/science/pop/pop_types.F90 + src/science/radiation/cbl_init_radiation.F90 + src/science/radiation/cbl_radiation.F90 + src/science/radiation/cbl_rhoch.F90 + src/science/radiation/cbl_sinbet.F90 + src/science/radiation/cbl_spitter.F90 + src/science/roughness/cable_roughness.F90 + src/science/roughness/roughnessHGT_effLAI_cbl.F90 + src/science/sli/cable_sli_main.F90 + src/science/sli/cable_sli_numbers.F90 + src/science/sli/cable_sli_roots.F90 + src/science/sli/cable_sli_solve.F90 + src/science/sli/cable_sli_utils.F90 + src/science/soilsnow/cbl_conductivity.F90 + src/science/soilsnow/cbl_GW.F90 + src/science/soilsnow/cbl_hyd_redistrib.F90 + src/science/soilsnow/cbl_Oldconductivity.F90 + src/science/soilsnow/cbl_remove_trans.F90 + src/science/soilsnow/cbl_smoisturev.F90 + src/science/soilsnow/cbl_snowAccum.F90 + src/science/soilsnow/cbl_snow_aging.F90 + src/science/soilsnow/cbl_snowCheck.F90 + src/science/soilsnow/cbl_snowDensity.F90 + src/science/soilsnow/cbl_snowl_adjust.F90 + src/science/soilsnow/cbl_snowMelt.F90 + src/science/soilsnow/cbl_soilfreeze.F90 + src/science/soilsnow/cbl_soilsnow_data.F90 + src/science/soilsnow/cbl_soilsnow_init_special.F90 + src/science/soilsnow/cbl_soilsnow_main.F90 + src/science/soilsnow/cbl_stempv.F90 + src/science/soilsnow/cbl_surfbv.F90 + src/science/soilsnow/cbl_thermal.F90 + src/science/soilsnow/cbl_trimb.F90 + src/params/cable_phys_constants_mod.F90 + src/params/grid_constants_cbl.F90 + src/params/cable_photo_constants_mod.F90 + src/params/cable_other_constants_mod.F90 + src/params/cable_maths_constants_mod.F90 + src/util/cable_runtime_opts_mod.F90 + src/util/cable_common.F90 + src/offline/casa_offline_inout.F90 + src/offline/casa_ncdf.F90 + src/offline/cable_iovars.F90 + src/offline/cable_surface_types.F90 + src/offline/cable_define_types.F90 + src/offline/cable_phenology.F90 + src/offline/cable_LUC_EXPT.F90 + src/offline/CASAONLY_LUC.F90 + src/offline/cable_abort.F90 + src/offline/cable_checks.F90 + src/offline/cable_cru_TRENDY.F90 + src/offline/cable_driver_init.F90 + src/offline/cable_initialise.F90 + src/offline/cable_input.F90 + src/offline/cable_metutils.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 + src/offline/cable_read.F90 + src/offline/cable_site.F90 + 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/cable_climate_type_mod.F90 + src/util/masks_cbl.F90 ) - target_link_libraries(cable PRIVATE cable_common) - install(TARGETS cable RUNTIME) -endif() + + target_link_libraries(cable_common PRIVATE PkgConfig::NETCDF) + + if(CABLE_MPI) + target_compile_definitions(cable_common PRIVATE __MPI__) + target_link_libraries(cable_common PRIVATE MPI::MPI_Fortran) + endif() + + if(CABLE_MPI) + add_executable( + cable-mpi + src/offline/cable_mpicommon.F90 + src/offline/cable_mpimaster.F90 + src/offline/cable_mpiworker.F90 + src/science/pop/pop_mpi.F90 + src/offline/cable_offline_driver.F90 + ) + target_link_libraries(cable-mpi PRIVATE cable_common MPI::MPI_Fortran) + install(TARGETS cable-mpi RUNTIME) + else() + add_executable( + cable + src/offline/cable_mpimaster_stub.F90 + src/offline/cable_mpiworker_stub.F90 + src/offline/cable_offline_driver.F90 + ) + target_link_libraries(cable PRIVATE cable_common) + install(TARGETS cable RUNTIME) + endif() + +endif() \ No newline at end of file diff --git a/build.bash b/build.bash index 75e3b3198..c698d596f 100755 --- a/build.bash +++ b/build.bash @@ -1,5 +1,8 @@ #!/usr/bin/env bash +# Exit immediately on error +set -e + ncpus_default=4 script_name=$(basename "${0}") @@ -19,6 +22,8 @@ Options: -n, --ncpus Specify the number of parallel jobs in the compilation. By default this value is set to ${ncpus_default}. + -l, --library + Build just CABLE science library (libscable_science.a) -h, --help Show this screen. Enabling debug mode: @@ -34,19 +39,33 @@ Enabling verbose output from Makefile builds: EOF } +# DEFAULTS + +# Configure cmake_args=(-DCMAKE_BUILD_TYPE=Release -DCABLE_MPI=OFF) +# Build +build_args=() + +# Install +do_install=1 + # Argument parsing adapted and stolen from http://mywiki.wooledge.org/BashFAQ/035#Complex_nonstandard_add-on_utilities while [ ${#} -gt 0 ]; do case ${1} in -c|--clean) - rm -r build bin + rm -rf build bin exit ;; -m|--mpi) mpi=1 cmake_args+=(-DCABLE_MPI="ON") ;; + -l|--library) + build_args+=(--target cable_science) + cmake_args+=(-DCABLE_LIBRARY="ON") + do_install=0 # Disable installation when only building the science library + ;; -C|--compiler) compiler=${2} shift @@ -118,6 +137,13 @@ fi export CMAKE_BUILD_PARALLEL_LEVEL="${CMAKE_BUILD_PARALLEL_LEVEL:=${ncpus_default}}" -cmake -S . -B build "${cmake_args[@]}" &&\ -cmake --build build &&\ -cmake --install build --prefix . +# Configure by default +cmake -S . -B build "${cmake_args[@]}" + +# Build requested targets +cmake --build build "${build_args[@]}" + +# Install if requested +if [ $do_install -eq 1 ]; then + cmake --install build --prefix . +fi \ No newline at end of file diff --git a/src/coupled/esm16/cable_LUC_EXPT.F90 b/src/coupled/esm16/cable_LUC_EXPT.F90 new file mode 100644 index 000000000..c4229b467 --- /dev/null +++ b/src/coupled/esm16/cable_LUC_EXPT.F90 @@ -0,0 +1,601 @@ +MODULE CABLE_LUC_EXPT + + USE netcdf + USE casa_ncdf_module, ONLY: HANDLE_ERR, GET_UNIT + USE CABLE_COMMON_MODULE, ONLY: IS_LEAPYEAR, LEAP_DAY + + USE cable_IO_vars_module, ONLY: logn, land_x, land_y, landpt, latitude, longitude + USE cable_def_types_mod, ONLY: mland, r_2 + + IMPLICIT NONE + + TYPE LUC_INPUT_TYPE + REAL, DIMENSION(:), ALLOCATABLE :: VAL + ! INTEGER :: YEAR + END TYPE LUC_INPUT_TYPE + + TYPE LUC_EXPT_TYPE + CHARACTER(len=200):: TransitionFilePath,ClimateFile, Run + LOGICAL :: DirectRead, READrst, WRITErst + LOGICAL, ALLOCATABLE :: prim_only(:) + LOGICAL, ALLOCATABLE :: ptos(:), ptog(:), stog(:), gtos(:) + INTEGER, ALLOCATABLE :: ivegp(:) + INTEGER, ALLOCATABLE :: biome(:) + INTEGER :: YearStart, YearEnd, nfile + INTEGER :: CTSTEP + REAL, ALLOCATABLE :: primaryf(:), mtemp_min20(:), grass(:), secdf(:) + CHARACTER(len=200),DIMENSION(9) :: TransFile + CHARACTER(len=12) ,DIMENSION(9) :: VAR_NAME + INTEGER, DIMENSION(9) :: F_ID, V_ID + TYPE(LUC_INPUT_TYPE), DIMENSION(9):: INPUT + INTEGER :: YEAR, ydimsize, xdimsize, nrec, FirstYear + + END TYPE LUC_EXPT_TYPE + + TYPE (LUC_EXPT_TYPE), SAVE :: LUC_EXPT + + INTEGER, PARAMETER :: & + ptos = 1, & + ptog = 2, & + stog = 3, & + gtos = 4, & + grassfrac = 5, & + primffrac = 6, & + pharv = 7, & + smharv = 8, & + syharv = 9 + + +CONTAINS + +!=============================================================================== + ! CALBE_LUC_EXPT routines +!=============================================================================== + + !============================================================================= + SUBROUTINE LUC_EXPT_INIT( LUC_EXPT) + + IMPLICIT NONE + + TYPE (LUC_EXPT_TYPE), INTENT(INOUT) :: LUC_EXPT + + REAL :: tmparr(720,360), tmp + INTEGER :: t, i, ii, k, x, y, realk + INTEGER :: fID, vID, timID,latID, lonID, tdimsize, xdimsize, ydimsize + INTEGER :: xds, yds, tds + INTEGER :: STATUS, iu + CHARACTER(len=15) :: Run + CHARACTER(len=200) :: TransitionFilePath, ClimateFile + LOGICAL :: DirectRead + INTEGER :: YearStart, YearEnd + REAL, ALLOCATABLE :: tmpvec(:), tmparr3(:,:,:) + + NAMELIST /LUCNML/ TransitionFilePath, ClimateFile, Run, DirectRead, YearStart, YearEnd + + ALLOCATE( LUC_EXPT%prim_only(mland) ) + ALLOCATE( LUC_EXPT%ivegp(mland) ) + ALLOCATE( LUC_EXPT%biome(mland) ) + ALLOCATE( LUC_EXPT%ptos(mland) ) + ALLOCATE( LUC_EXPT%ptog(mland) ) + ALLOCATE( LUC_EXPT%stog(mland) ) + ALLOCATE( LUC_EXPT%gtos(mland) ) + ALLOCATE( LUC_EXPT%primaryf(mland) ) + ALLOCATE( LUC_EXPT%secdf(mland) ) + ALLOCATE( LUC_EXPT%grass(mland) ) + ALLOCATE( LUC_EXPT%mtemp_min20(mland) ) + + + + ! READ LUC_EXPT settings + CALL GET_UNIT(iu) + OPEN (iu,FILE="LUC.nml",STATUS='OLD',ACTION='READ') + READ (iu,NML=LUCNML) + CLOSE(iu) + LUC_EXPT%TransitionFilePath = TransitionFilePath + LUC_EXPT%ClimateFile = ClimateFile + LUC_EXPT%DirectRead = DirectRead + LUC_EXPT%YearStart = YearStart + LUC_EXPT%YearEnd = YearEnd + + WRITE(* ,*)"================== LUC_EXPT ============" + WRITE(* ,*)"LUC_EXPT settings chosen:" + WRITE(* ,*)" TransitionFilePath: ",TRIM(LUC_EXPT%TransitionFilePath) + WRITE(* ,*)" ClimateFile : ",TRIM(LUC_EXPT%ClimateFile) + + + ! Transition Filenames and variables + LUC_EXPT%TransFile(1) = TRIM(LUC_EXPT%TransitionFilePath)//"/ptos.nc" + LUC_EXPT%TransFile(2) = TRIM(LUC_EXPT%TransitionFilePath)//"/ptog.nc" + LUC_EXPT%TransFile(3) = TRIM(LUC_EXPT%TransitionFilePath)//"/stog.nc" + LUC_EXPT%TransFile(4) = TRIM(LUC_EXPT%TransitionFilePath)//"/gtos.nc" + LUC_EXPT%TransFile(5) = TRIM(LUC_EXPT%TransitionFilePath)//"/grass.nc" + LUC_EXPT%TransFile(6) = TRIM(LUC_EXPT%TransitionFilePath)//"/primaryf.nc" + LUC_EXPT%TransFile(7) = TRIM(LUC_EXPT%TransitionFilePath)//"/pharv.nc" + LUC_EXPT%TransFile(8) = TRIM(LUC_EXPT%TransitionFilePath)//"/smharv.nc" + LUC_EXPT%TransFile(9) = TRIM(LUC_EXPT%TransitionFilePath)//"/syharv.nc" + + LUC_EXPT%VAR_NAME(1) = 'ptos' + LUC_EXPT%VAR_NAME(2) = 'ptog' + LUC_EXPT%VAR_NAME(3) = 'stog' + LUC_EXPT%VAR_NAME(4) = 'gtos' + LUC_EXPT%VAR_NAME(5) = 'grass' + LUC_EXPT%VAR_NAME(6) = 'primaryf' + LUC_EXPT%VAR_NAME(7) = 'pharv' + LUC_EXPT%VAR_NAME(8) = 'smharv' + LUC_EXPT%VAR_NAME(9) = 'syharv' + + LUC_EXPT%nfile = 9 + + DO x = 1, LUC_EXPT%nfile + ALLOCATE( LUC_EXPT%INPUT(x)%VAL(mland) ) + END DO + + ! OPEN LUC INPUT FILES + DO i = 1, LUC_EXPT%nfile + + WRITE(* ,*) 'LUC input data file: ', LUC_EXPT%TransFile(i) + WRITE(logn,*) 'LUC input data file: ', LUC_EXPT%TransFile(i) + + STATUS = NF90_OPEN(TRIM(LUC_EXPT%TransFile(i)), NF90_NOWRITE, LUC_EXPT%F_ID(i)) + CALL HANDLE_ERR(STATUS, "Opening LUH2 file "//LUC_EXPT%TransFile(i) ) + STATUS = NF90_INQ_VARID(LUC_EXPT%F_ID(i),TRIM(LUC_EXPT%VAR_NAME(i)), LUC_EXPT%V_ID(i)) + CALL HANDLE_ERR(STATUS, "Inquiring LUC_EXPT var "//TRIM(LUC_EXPT%VAR_NAME(i))// & + " in "//LUC_EXPT%TransFile(i) ) + + ! inquire dimensions + IF (i.EQ.1) THEN + FID = LUC_EXPT%F_ID(i) + STATUS = NF90_INQ_DIMID(FID,'lat',latID) + STATUS = NF90_INQUIRE_DIMENSION(FID,latID,len=ydimsize) + CALL HANDLE_ERR(STATUS, "Inquiring 'lat'"//TRIM(LUC_EXPT%TransFile(i))) + LUC_EXPT%ydimsize = ydimsize + + STATUS = NF90_INQ_DIMID(FID,'lon',lonID) + STATUS = NF90_INQUIRE_DIMENSION(FID,lonID,len=xdimsize) + CALL HANDLE_ERR(STATUS, "Inquiring 'lon'"//TRIM(LUC_EXPT%TransFile(i))) + LUC_EXPT%xdimsize = xdimsize + + STATUS = NF90_INQ_DIMID(FID,'time',timID) + STATUS = NF90_INQUIRE_DIMENSION(FID,timID,len=tdimsize) + CALL HANDLE_ERR(STATUS, "Inquiring 'time'"//TRIM(LUC_EXPT%TransFile(i))) + LUC_EXPT%nrec = tdimsize + +!$ STATUS = NF90_GET_VAR( Luc_expt%f_id(i), timID, tmp, & +!$ start=(/1,1,1/) ) +!$ CALL HANDLE_ERR(STATUS, "Reading from "//LUC_EXPT%TransFile(i) ) + + + + xds = LUC_EXPT%xdimsize + yds = LUC_EXPT%ydimsize + ENDIF + !write(*,*) 'length LUH2 data: ', tdimsize + ENDDO + + + + LUC_EXPT%FirstYEAR = 850 + ! Set internal counter + LUC_EXPT%CTSTEP = 1 + LUC_EXPT%YearStart- LUC_EXPT%FirstYEAR + + ! READ initial states + i = grassfrac + IF ( LUC_EXPT%DirectRead ) THEN + + DO k = 1, mland + STATUS = NF90_GET_VAR( LUC_EXPT%F_ID(i), LUC_EXPT%V_ID(i), tmp, & + start=(/land_x(k),land_y(k),LUC_EXPT%CTSTEP/) ) + CALL HANDLE_ERR(STATUS, "Reading direct from "//LUC_EXPT%TransFile(i) ) + LUC_EXPT%grass(k) = tmp + END DO + ELSE + STATUS = NF90_GET_VAR(LUC_EXPT%F_ID(i), LUC_EXPT%V_ID(i), tmparr, & + start=(/1,1,LUC_EXPT%CTSTEP/),count=(/xds,yds,1/) ) + CALL HANDLE_ERR(STATUS, "Reading from "//LUC_EXPT%TransFile(i) ) + + DO k = 1, mland + LUC_EXPT%grass(k) = tmparr( land_x(k), land_y(k) ) + END DO + + ENDIF + + i = primffrac + IF ( LUC_EXPT%DirectRead ) THEN + DO k = 1, mland + STATUS = NF90_GET_VAR( LUC_EXPT%F_ID(i), LUC_EXPT%V_ID(i), tmp, & + start=(/land_x(k),land_y(k),LUC_EXPT%CTSTEP/) ) + CALL HANDLE_ERR(STATUS, "Reading direct from "//LUC_EXPT%TransFile(i) ) + LUC_EXPT%primaryf(k) = tmp + END DO + ELSE + STATUS = NF90_GET_VAR(LUC_EXPT%F_ID(i), LUC_EXPT%V_ID(i), tmparr, & + start=(/1,1,LUC_EXPT%CTSTEP/),count=(/xds,yds,1/) ) + CALL HANDLE_ERR(STATUS, "Reading from "//LUC_EXPT%TransFile(i) ) + + DO k = 1, mland + LUC_EXPT%primaryf(k) = tmparr( land_x(k), land_y(k) ) + END DO + + ENDIF + + + + LUC_EXPT%grass = MIN(LUC_EXPT%grass, 1.0) + LUC_EXPT%primaryf = MIN(LUC_EXPT%primaryf, 1.0- LUC_EXPT%grass) + LUC_EXPT%secdf = MAX((1.0 - LUC_EXPT%grass - LUC_EXPT%primaryf), 0.0) + + CALL READ_ClimateFile(LUC_EXPT) + ! hot desert + WHERE (LUC_EXPT%biome.EQ.15 ) + LUC_EXPT%ivegp = 14 + ENDWHERE + + WHERE (LUC_EXPT%biome .EQ. 3 .OR. LUC_EXPT%biome .EQ. 11) ! savanna/ xerophytic woods + LUC_EXPT%grass = LUC_EXPT%grass + (LUC_EXPT%primaryf+LUC_EXPT%secdf)*1.0/2.0 + LUC_EXPT%primaryf = LUC_EXPT%primaryf * 1.0/2.0 + LUC_EXPT%secdf = LUC_EXPT%secdf * 1.0/2.0 + ELSEWHERE (LUC_EXPT%biome .EQ. 12 .OR. LUC_EXPT%biome .EQ. 13 & ! shrub + .OR. LUC_EXPT%biome .EQ. 15 .OR. LUC_EXPT%biome .EQ. 16 ) + LUC_EXPT%grass = LUC_EXPT%grass + (LUC_EXPT%primaryf+LUC_EXPT%secdf)*4.0/5.0 + LUC_EXPT%primaryf = LUC_EXPT%primaryf * 1.0/5.0 + LUC_EXPT%secdf = LUC_EXPT%secdf * 1.0/5.0 + ELSEWHERE (LUC_EXPT%biome .EQ. 7 .OR. LUC_EXPT%biome .EQ. 8 & ! boreal + .OR. LUC_EXPT%biome .EQ. 9 .OR. LUC_EXPT%biome .EQ. 10 ) + LUC_EXPT%grass = LUC_EXPT%grass + (LUC_EXPT%primaryf+LUC_EXPT%secdf)*1.0/5.0 + LUC_EXPT%primaryf = LUC_EXPT%primaryf * 4.0/5.0 + LUC_EXPT%secdf = LUC_EXPT%secdf * 4.0/5.0 + ELSEWHERE (LUC_EXPT%biome .EQ. 5 .OR. LUC_EXPT%biome .EQ. 6 ) ! DBL + LUC_EXPT%grass = LUC_EXPT%grass + (LUC_EXPT%primaryf+LUC_EXPT%secdf)*0.3 + LUC_EXPT%primaryf = LUC_EXPT%primaryf *0.7 + LUC_EXPT%secdf = LUC_EXPT%secdf * 0.7 + END WHERE + + + + + ! READ transitions from primary to see if primary remains primary + + LUC_EXPT%prim_only = .TRUE. + IF(.NOT.ALLOCATED(tmpvec)) ALLOCATE(tmpvec(tdimsize)) + IF(.NOT.ALLOCATED(tmparr3)) ALLOCATE(tmparr3(xds,yds,tdimsize)) + DO i=1,2 ! ptos and ptog + IF ( LUC_EXPT%DirectRead ) THEN + DO k = 1, mland + + STATUS = NF90_GET_VAR( LUC_EXPT%F_ID(i), LUC_EXPT%V_ID(i), tmpvec, & + start=(/land_x(k),land_y(k),1/), & + count=(/1,1,tdimsize/) ) + CALL HANDLE_ERR(STATUS, "Reading direct from "//LUC_EXPT%TransFile(i) ) + + !IF (sum(tmpvec).gt.1e-3 .OR. LUC_EXPT%primaryf(k).lt.0.99) LUC_EXPT%prim_only(k) = .FALSE. + IF (SUM(tmpvec).GT.1e-3 ) LUC_EXPT%prim_only(k) = .FALSE. + END DO + + ELSE + + STATUS = NF90_GET_VAR(LUC_EXPT%F_ID(i), LUC_EXPT%V_ID(i), tmparr3, & + start=(/1,1,1/),count=(/xds,yds,tdimsize/) ) + CALL HANDLE_ERR(STATUS, "Reading from "//LUC_EXPT%TransFile(i) ) + DO k = 1, mland + tmpvec = tmparr3( land_x(k), land_y(k) , :) + ! IF (sum(tmpvec).gt.1e-3.OR. LUC_EXPT%primaryf(k).lt.0.99) LUC_EXPT%prim_only(k) = .FALSE. + IF (SUM(tmpvec).GT.1e-3) LUC_EXPT%prim_only(k) = .FALSE. + END DO + + ENDIF + + END DO + + ! set secondary vegetation area to be zero where land use transitions don't occur + ! set grass component of primary vegetation cover + WHERE (LUC_EXPT%prim_only .EQV. .TRUE.) + LUC_EXPT%secdf = 0.0 + LUC_EXPT%primaryf = 1.0 + LUC_EXPT%grass = 0.0 + WHERE (LUC_EXPT%biome .EQ. 3 .OR. LUC_EXPT%biome .EQ. 11) ! savanna/ xerophytic woods + LUC_EXPT%grass = LUC_EXPT%primaryf*1.0/2.0 + LUC_EXPT%primaryf = LUC_EXPT%primaryf * 1.0/2.0 + ELSEWHERE (LUC_EXPT%biome .EQ. 12 .OR. LUC_EXPT%biome .EQ. 13 & + .OR. LUC_EXPT%biome .EQ. 15 .OR. LUC_EXPT%biome .EQ. 16 ) ! shrub + LUC_EXPT%grass = LUC_EXPT%primaryf*4.0/5.0 + LUC_EXPT%primaryf = LUC_EXPT%primaryf * 1.0/5.0 + ELSEWHERE (LUC_EXPT%biome .EQ. 7 .OR. LUC_EXPT%biome .EQ. 8 & + .OR. LUC_EXPT%biome .EQ. 9 .OR. LUC_EXPT%biome .EQ. 10) ! boreal + LUC_EXPT%grass = LUC_EXPT%primaryf*1.0/5.0 + LUC_EXPT%primaryf = LUC_EXPT%primaryf * 4.0/5.0 + ELSEWHERE (LUC_EXPT%biome .EQ. 5 .OR. LUC_EXPT%biome .EQ. 6 ) ! DBL + LUC_EXPT%grass = LUC_EXPT%primaryf*0.3 + LUC_EXPT%primaryf = LUC_EXPT%primaryf *0.7 + END WHERE + END WHERE + + +!$ WHERE (LUC_EXPT%ivegp == 14) +!$ LUC_EXPT%prim_only = .TRUE. +!$ END WHERE + + END SUBROUTINE LUC_EXPT_INIT + + ! ============================================================================== + + + SUBROUTINE LUC_EXPT_SET_TILES(inVeg, inPfrac, LUC_EXPT ) + + IMPLICIT NONE + + INTEGER, INTENT(INOUT) :: inVeg(:,:,:) + REAL, INTENT(INOUT) :: inPFrac(:,:,:) + TYPE (LUC_EXPT_TYPE), INTENT(INOUT) :: LUC_EXPT + INTEGER :: k, m, n + + + + + DO k=1,mland + m = landpt(k)%ilon + n = landpt(k)%ilat + + + IF (inVeg(m,n,1).LT.11) THEN ! vegetated + + IF (LUC_EXPT%prim_only(k) ) THEN + + inVeg(m,n,1) = LUC_EXPT%ivegp(k) + inVeg(m,n,2:3) = 0 + inPFrac(m,n,2:3) = 0 + inPFrac(m,n,1) = 1.0 + IF ( LUC_EXPT%grass(k) .GT. 0.01) THEN + IF (LUC_EXPT%mtemp_min20(k).LE. 15.5) THEN + inVeg(m,n,2) = 6 ! C3 grass + ELSE + inVeg(m,n,2) = 7 ! C4 grass + ENDIF + inPFrac(m,n,1) = MIN(LUC_EXPT%primaryf(k),1.0) + inPFrac(m,n,2) = 1.0 - MIN(LUC_EXPT%primaryf(k),1.0) + ENDIF + + ELSEIF ((.NOT.LUC_EXPT%prim_only(k)) ) THEN + inVeg(m,n,1) = LUC_EXPT%ivegp(k) + inVeg(m,n,2) = LUC_EXPT%ivegp(k) + + IF (LUC_EXPT%mtemp_min20(k).LE. 15.5) THEN + inVeg(m,n,3) = 6 ! C3 grass + ELSE + inVeg(m,n,3) = 7 ! C4 grass + ENDIF + inPFrac(m,n,1) = MIN(LUC_EXPT%primaryf(k),1.0) + inPFrac(m,n,2) = MIN(LUC_EXPT%secdf(k),1.0) + inPFrac(m,n,3) = 1.0 - inPFrac(m,n,1) - inPFrac(m,n,2) + + + ENDIF + ELSE + LUC_EXPT%prim_only(k)=.TRUE. + + ENDIF + + ! don't consider LUC events in desert or tundra + IF (inveg(m,n,1)==14 .OR. inveg(m,n,1)==8 ) THEN + LUC_EXPT%prim_only(k)=.TRUE. + LUC_EXPT%primaryf(k) = 1.0 + LUC_EXPT%secdf(k) = 0.0 + LUC_EXPT%grass(k) = 0.0 + inPFrac(m,n,1) = 1.0 + inPFrac(m,n,2:3) = 0.0 + inVeg(m,n,2:3) = 0 + ENDIF + + + ENDDO + + + +991 FORMAT(1166(e12.4,2x)) + + END SUBROUTINE LUC_EXPT_SET_TILES + ! ============================================================================== + + SUBROUTINE READ_ClimateFile(LUC_EXPT) + + USE netcdf + + + IMPLICIT NONE + + TYPE (LUC_EXPT_type), INTENT(INOUT) :: LUC_EXPT ! climate variables + + INTEGER*4 :: mp4 + INTEGER*4, PARAMETER :: pmp4 =0 + INTEGER, PARAMETER :: fmp4 = KIND(pmp4) + INTEGER*4 :: STATUS + INTEGER*4 :: FILE_ID, land_ID, nyear_ID, nday_ID, dID, i, land_dim + CHARACTER :: CYEAR*4, FNAME*99,dum*50 + + ! 0 dim arrays + CHARACTER(len=20),DIMENSION(2) :: A0 + ! 1 dim arrays (npt ) + CHARACTER(len=20),DIMENSION(3) :: A1 + ! 1 dim arrays (integer) (npt ) + CHARACTER(len=20),DIMENSION(2) :: AI1 + + REAL(r_2), DIMENSION(mland) :: LAT, LON, TMP + INTEGER*4 :: TMPI(mland), TMPI0 + LOGICAL :: EXISTFILE + + mp4=INT(mland,fmp4) + A0(1) = 'nyears' + A0(2) = 'year' + + A1(1) = 'latitude' + A1(2) = 'longitude' + A1(3) = 'mtemp_min20' + + + AI1(1) = 'iveg' + AI1(2) = 'biome' + + fname = TRIM(LUC_EXPT%ClimateFile) + + INQUIRE( FILE=TRIM( fname ), EXIST=EXISTFILE ) + + IF ( .NOT.EXISTFILE) THEN + WRITE(*,*) fname, ' does not exist!' + ELSE + WRITE(*,*) 'reading biome from : ', fname + ENDIF + ! Open NetCDF file: + STATUS = NF90_OPEN(fname, NF90_NOWRITE, FILE_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + + ! dimensions: + ! Land (number of points) + + + STATUS = NF90_INQ_DIMID(FILE_ID, 'land' , dID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_INQUIRE_DIMENSION( FILE_ID, dID, LEN=land_dim ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + IF ( land_dim .NE. mland) THEN + WRITE(*,*) "Dimension misfit, ", fname + WRITE(*,*) "land_dim", land_dim + STOP + ENDIF + + ! LAT & LON + STATUS = NF90_INQ_VARID( FILE_ID, A1(1), dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_GET_VAR( FILE_ID, dID, LAT ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + + STATUS = NF90_INQ_VARID( FILE_ID, A1(2), dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_GET_VAR( FILE_ID, dID, LON ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + + ! READ 1-dimensional real fields + DO i = 3, SIZE(A1) + STATUS = NF90_INQ_VARID( FILE_ID, A1(i), dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_GET_VAR( FILE_ID, dID, TMP ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + SELECT CASE ( TRIM(A1(i))) + CASE ('mtemp_min20' ) ; LUC_EXPT%mtemp_min20 = TMP + END SELECT + END DO + + ! READ 1-dimensional integer fields + DO i = 1, SIZE(AI1) + + WRITE(*,*) TRIM(AI1(i)) + STATUS = NF90_INQ_VARID( FILE_ID, AI1(i), dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_GET_VAR( FILE_ID, dID, TMPI ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + SELECT CASE ( TRIM(AI1(i))) + CASE ('iveg' ) ; LUC_EXPT%ivegp = TMPI + CASE ('biome' ) ; LUC_EXPT%biome = TMPI + END SELECT + END DO + + ! non-woody potential vegetation not considered to undergo LU change + WHERE (LUC_EXPT%ivegp.GT.5) + LUC_EXPT%prim_only=.TRUE. + ENDWHERE + + ! Close NetCDF file: + STATUS = NF90_close(FILE_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + + + + END SUBROUTINE READ_CLIMATEFILE + + ! ============================================================================== + SUBROUTINE READ_LUH2(LUC_EXPT) + + IMPLICIT NONE + + TYPE (LUC_EXPT_TYPE), INTENT(INOUT) :: LUC_EXPT + + REAL :: tmp + REAL, ALLOCATABLE :: tmparr(:,:) + INTEGER :: t, i, ii, k, x, y, realk + INTEGER :: fid, vid, tid + INTEGER :: xds, yds, tds + INTEGER :: STATUS, iu + + yds = LUC_EXPT%ydimsize + xds = LUC_EXPT%xdimsize + t = LUC_EXPT%CTSTEP + IF(.NOT.ALLOCATED(tmparr)) ALLOCATE(tmparr(xds,yds)) + + IF (t.LE. LUC_EXPT%nrec) THEN + DO i=1, LUC_EXPT%nfile + IF ( LUC_EXPT%DirectRead ) THEN + + DO k = 1, mland + + STATUS = NF90_GET_VAR( LUC_EXPT%F_ID(i), LUC_EXPT%V_ID(i), tmp, & + start=(/land_x(k),land_y(k),t/) ) + CALL HANDLE_ERR(STATUS, "Reading direct from "//LUC_EXPT%TransFile(i) ) + LUC_EXPT%INPUT(i)%VAL(k) = tmp + END DO + ELSE + STATUS = NF90_GET_VAR(LUC_EXPT%F_ID(i), LUC_EXPT%V_ID(i), tmparr, & + start=(/1,1,t/),count=(/xds,yds,1/) ) + CALL HANDLE_ERR(STATUS, "Reading from "//LUC_EXPT%TransFile(i) ) + + DO k = 1, mland + LUC_EXPT%INPUT(i)%VAL(k) =tmparr( land_x(k), land_y(k) ) + IF (LUC_EXPT%INPUT(i)%VAL(k).GT.1.0) THEN + LUC_EXPT%INPUT(i)%VAL(k) = 0.0 + ENDIF + END DO + + ENDIF + ENDDO + + ELSE + + WRITE(*,*) 'warning: past end of LUH2 record' + + ENDIF + + + ! Adjust transition areas based on primary wooded fraction + WHERE (LUC_EXPT%biome .EQ. 3 .OR. LUC_EXPT%biome .EQ. 11) ! savanna/ xerophytic woods + LUC_EXPT%INPUT(ptos)%VAL = LUC_EXPT%INPUT(ptos)%VAL * 1.0/2.0 + LUC_EXPT%INPUT(ptog)%VAL = LUC_EXPT%INPUT(ptog)%VAL * 1.0/2.0 + LUC_EXPT%INPUT(gtos)%VAL = LUC_EXPT%INPUT(gtos)%VAL * 1.0/2.0 + LUC_EXPT%INPUT(stog)%VAL = LUC_EXPT%INPUT(stog)%VAL * 1.0/2.0 + ELSEWHERE (LUC_EXPT%biome .EQ. 12 .OR. LUC_EXPT%biome .EQ. 13 & + .OR. LUC_EXPT%biome .EQ. 15 .OR. LUC_EXPT%biome .EQ. 16 ) ! shrub + LUC_EXPT%INPUT(ptos)%VAL = LUC_EXPT%INPUT(ptos)%VAL * 1.0/5.0 + LUC_EXPT%INPUT(ptog)%VAL = LUC_EXPT%INPUT(ptog)%VAL * 1.0/5.0 + LUC_EXPT%INPUT(gtos)%VAL = LUC_EXPT%INPUT(gtos)%VAL * 1.0/5.0 + LUC_EXPT%INPUT(stog)%VAL = LUC_EXPT%INPUT(stog)%VAL * 1.0/5.0 + ELSEWHERE (LUC_EXPT%biome .EQ. 7 .OR. LUC_EXPT%biome .EQ. 8 & + .OR. LUC_EXPT%biome .EQ. 9 .OR. LUC_EXPT%biome .EQ. 10) ! boreal + LUC_EXPT%INPUT(ptos)%VAL = LUC_EXPT%INPUT(ptos)%VAL * 0.8 + LUC_EXPT%INPUT(ptog)%VAL = LUC_EXPT%INPUT(ptog)%VAL * 0.8 + LUC_EXPT%INPUT(gtos)%VAL = LUC_EXPT%INPUT(gtos)%VAL * 0.8 + LUC_EXPT%INPUT(stog)%VAL = LUC_EXPT%INPUT(stog)%VAL * 0.8 + ELSEWHERE (LUC_EXPT%biome .EQ. 5 .OR. LUC_EXPT%biome .EQ. 6 ) ! DBL + LUC_EXPT%INPUT(ptos)%VAL = LUC_EXPT%INPUT(ptos)%VAL * 0.7 + LUC_EXPT%INPUT(ptog)%VAL = LUC_EXPT%INPUT(ptog)%VAL * 0.7 + LUC_EXPT%INPUT(gtos)%VAL = LUC_EXPT%INPUT(gtos)%VAL * 0.7 + LUC_EXPT%INPUT(stog)%VAL = LUC_EXPT%INPUT(stog)%VAL * 0.7 + ENDWHERE + + END SUBROUTINE READ_LUH2 + ! ============================================================================== + + +END MODULE CABLE_LUC_EXPT diff --git a/src/coupled/esm16/cable_define_types.F90 b/src/coupled/esm16/cable_define_types.F90 new file mode 100644 index 000000000..9d0187475 --- /dev/null +++ b/src/coupled/esm16/cable_define_types.F90 @@ -0,0 +1,2013 @@ +!============================================================================== +! 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: defines parameters, variables and derived types, allocation and +! deallocation of these derived types +! +! Contact: Bernard.Pak@csiro.au +! +! History: Brings together define_dimensions and define_types from v1.4b +! rs20 now in veg% instead of soil% +! fes split into fess and fesp (though fes still defined) +! +! Jan 2016: Now includes climate% for use in climate variables required for +! prognostic phenology and potential veg type +! ============================================================================== +!#define UM_BUILD yes +MODULE cable_def_types_mod + + ! Contains all variables which are not subroutine-internal + + IMPLICIT NONE + + SAVE + + PUBLIC + + !---CABLE default KINDs for representing INTEGER/REAL values + !---at least 10-digit precision + + INTEGER :: mp, & ! # total no of patches/tiles + mvtype,& ! total # vegetation types, from input +#ifdef UM_BUILD + mstype=9,& ! total # soil types, needs to be defined at compile time for now +#else + mstype,& ! total # soil types, from input +#endif + mland,& ! ! # land grid cells + mpatch !number of patches ! mpatch added by rk4417 - phase2 + !allows for setting this to a const value + + INTEGER, PARAMETER :: & + i_d = KIND(9), & +#ifdef UM_BUILD + r_2 = KIND(1.0),&!SELECTED_REAL_KIND(12, 50), & +#else + r_2 = KIND(1.d0),&!SELECTED_REAL_KIND(12, 50), & +#endif + n_tiles = 17, & ! # possible no of different + ncp = 3, & ! # vegetation carbon stores + ncs = 2, & ! # soil carbon stores + mf = 2, & ! # leaves (sunlit, shaded) + nrb = 3, & ! # radiation bands + msn = 3, & ! max # snow layers + swb = 2, & ! # shortwave bands + niter = 4, & ! number of iterations for za/L + ! ms = 12 ! # soil layers + ms = 6 ! # soil layers - standard + ! ms = 13 ! for Loetschental experiment + INTEGER, PARAMETER :: n_ktherm = 3 + ! PRIVATE :: r_2, ms, msn, mf, nrb, ncp, ncs + + ! ............................................................................. + + ! Energy and water balance variables: + TYPE balances_type + + REAL, DIMENSION(:), POINTER :: & + drybal, & ! energy balance for dry canopy + ebal, & ! energy balance per time step (W/m^2) + ebal_tot, & ! cumulative energy balance (W/m^2) + ebal_cncheck, & ! energy balance consistency check (W/m^2) + ebal_tot_cncheck, & ! cumulative energy balance (W/m^2) + ebaltr, & ! energy balance per time step (W/m^2) + ebal_tottr, & ! cumulative energy balance (W/m^2) + evap_tot, & ! cumulative evapotranspiration (mm/dels) + osnowd0, & ! snow depth, first time step + precip_tot, & ! cumulative precipitation (mm/dels) + rnoff_tot, & ! cumulative runoff (mm/dels) + wbal, & ! water balance per time step (mm/dels) + wbal_tot, & ! cumulative water balance (mm/dels) + wbtot0, & ! total soil water (mm), first time step + wetbal, & ! energy balance for wet canopy + cansto0, & ! canopy water storage (mm) + owbtot, & ! total soil water (mm), first time step + evapc_tot, & ! cumulative evapotranspiration (mm/dels) + evaps_tot, & ! cumulative evapotranspiration (mm/dels) + rnof1_tot, & ! cumulative runoff (mm/dels) + rnof2_tot, & ! cumulative runoff (mm/dels) + snowdc_tot, & ! cumulative runoff (mm/dels) + wbal_tot1, & ! cumulative water balance (mm/dels) + delwc_tot, & ! energy balance for wet canopy + qasrf_tot, & ! heat advected to the snow by precip. + qfsrf_tot, & ! energy of snowpack phase changes + qssrf_tot, & ! energy of snowpack phase changes + Radbal, & + EbalSoil, & + Ebalveg, & + Radbalsum + + END TYPE balances_type + + ! ............................................................................. + + ! Soil parameters: + TYPE soil_parameter_type + + INTEGER, DIMENSION(:), POINTER :: & + isoilm ! integer soil type + + REAL, DIMENSION(:), POINTER :: & + bch, & ! parameter b in Campbell equation + c3, & ! c3 drainage coeff (fraction) + clay, & ! fraction of soil which is clay + css, & ! soil specific heat capacity [kJ/kg/K] + hsbh, & ! difsat * etasat (=hyds*abs(sucs)*bch) + hyds, & ! hydraulic conductivity @ saturation [m/s], Ksat + i2bp3, & ! par. one in K vis suction (=nint(bch)+2) + ibp2, & ! par. two in K vis suction (fn of pbch) + rhosoil, & ! soil density [kg/m3] + sand, & ! fraction of soil which is sand + sfc, & ! vol H2O @ field capacity + silt, & ! fraction of soil which is silt + ssat, & ! vol H2O @ saturation + sucs, & ! suction at saturation (m) + swilt, & ! vol H2O @ wilting + zse, & ! thickness of each soil layer (1=top) in m + zshh, & ! distance between consecutive layer midpoints (m) + ! vars intro for Ticket #27 + soilcol, & ! keep color for all patches/tiles + albsoilf ! soil reflectance + + REAL, DIMENSION(:,:), POINTER :: & + heat_cap_lower_limit + + REAL(r_2), DIMENSION(:,:), POINTER :: & + zse_vec,css_vec,cnsd_vec + + REAL(r_2), DIMENSION(:), POINTER :: & + cnsd, & ! thermal conductivity of dry soil [W/m/K] + pwb_min ! working variable (swilt/ssat)**ibp2 + + REAL, DIMENSION(:,:), POINTER :: & + albsoil ! soil reflectance (2nd dim. BP 21Oct2009) + !mrd561 + !MD parameters for GW module that vary with soil layer + REAL(r_2), DIMENSION(:,:), POINTER :: & + sucs_vec, & !psi at saturation in [mm] + hyds_vec, & !saturated hydraulic conductivity [mm/s] + bch_vec, & !C and H B [none] + clay_vec, & !fraction of soil that is clay [frac] + sand_vec, & !fraction of soil that is sand [frac] + silt_vec, & !fraction of soil that is silt [frac] + org_vec, & !fration of soil made of organic soils [frac] + rhosoil_vec,& !soil density [kg/m3] + ssat_vec, & !volumetric water content at saturation [mm3/mm3] + watr, & !residual water content of the soil [mm3/mm3] + smpc_vec, & ! Hutson Cass SWC potential cutoff ! 2 lines inserted by rk4417 - phase2 + wbc_vec, & ! Hutson Cass SWC volumetric water cutoff + sfc_vec, & !field capcacity (hk = 1 mm/day) + swilt_vec ! wilting point (hk = 0.02 mm/day) + + REAL(r_2), DIMENSION(:), POINTER :: & + hkrz,&! rate hyds changes with depth + zdepth,&! depth [m] where hkrz has zero impact + srf_frac_ma,&! fraction of surface with macropores + edepth_ma,&! e fold depth macropore fraction + qhz_max,&! maximum base flow when fully sat + qhz_efold,&! base flow efold rate dep on wtd, from drain-dens and param +! block above inserted by rk4417 - phase2 + drain_dens,&! drainage density ( mean dist to rivers/streams ) + elev, & !elevation above sea level + elev_std, & !elevation above sea level + slope, & !mean slope of grid cell + slope_std !stddev of grid cell slope + + !MD parameters for GW module for the aquifer + REAL(r_2), DIMENSION(:), POINTER :: & + GWsucs_vec, & !head in the aquifer [mm] + GWhyds_vec, & !saturated hydraulic conductivity of the aquifer [mm/s] + GWbch_vec, & !clapp and horn b of the aquifer [none] + GWssat_vec, & !saturated water content of the aquifer [mm3/mm3] + GWwatr, & !residual water content of the aquifer [mm3/mm3] + GWz, & !node depth of the aquifer [m] + smpc_GW, & ! Hutson Cass SWC potential cutoff ! 2 lines inserted by rk4417 - phase2 + wbc_GW, & ! Hutson Cass SWC volumetric water cutoff + GWdz, & !thickness of the aquifer [m] + GWrhosoil_vec !density of the aquifer substrate [kg/m3] + + ! Additional SLI parameters + INTEGER, DIMENSION(:), POINTER :: nhorizons ! number of soil horizons + INTEGER, DIMENSION(:,:), POINTER :: ishorizon ! horizon number 1:nhorizons + REAL(r_2), DIMENSION(:), POINTER :: clitt ! litter (tC/ha) + REAL(r_2), DIMENSION(:), POINTER :: zeta ! macropore parameter + REAL(r_2), DIMENSION(:), POINTER :: fsatmax ! variably saturated area parameter + !REAL(r_2), DIMENSION(:,:), POINTER :: swilt_vec ! vol H2O @ wilting + !REAL(r_2), DIMENSION(:,:), POINTER :: ssat_vec ! vol H2O @ sat + !REAL(r_2), DIMENSION(:,:), POINTER :: sfc_vec ! vol H2O @ fc + + END TYPE soil_parameter_type + + ! ............................................................................. + + ! Soil and snow variables: + TYPE soil_snow_type + + INTEGER, DIMENSION(:), POINTER :: isflag ! 0 => no snow 1 => snow + + REAL, DIMENSION(:), POINTER :: & + iantrct, & ! pointer to Antarctic land points + pudsto, & ! puddle storage + pudsmx, & ! puddle storage + cls, & ! factor for latent heat + dfn_dtg, & ! d(canopy%fns)/d(ssnow%tgg) + dfh_dtg, & ! d(canopy%fhs)/d(ssnow%tgg) + dfe_ddq, & ! d(canopy%fes)/d(dq) - REV_CORR: no longer necessary + ddq_dtg, & ! d(dq)/d(ssnow%tgg) - REV_CORR: no longer necessary + dfe_dtg, & ! d(canopy%fes)/d(ssnow%tgg) - REV_CORR: covers above vars + evapsn, & ! snow evaporation + fwtop, & ! water flux to the soil + fwtop1, & ! water flux to the soil + fwtop2, & ! water flux to the soil + fwtop3, & ! water flux to the soil + osnowd, & ! snow depth from previous time step + potev, & ! potential evapotranspiration + runoff, & ! total runoff (mm/dels) + rnof1, & ! surface runoff (mm/dels) + rnof2, & ! deep drainage (mm/dels) + rtsoil, & ! turbulent resistance for soil + wbtot1, & ! total soil water (mm) + wbtot2, & ! total soil water (mm) + wb_lake, & + totwblake, & !daily integrated wb_lake: used in ACCESS + sinfil, & + qstss, & + wetfac, & ! surface wetness fact. at current time step + owetfac, & ! surface wetness fact. at previous time step + t_snwlr, & ! top snow layer depth in 3 layer snowpack + tggav, & ! mean soil temperature in K +! otgg, & ! soil temperature in K ! moved below by rk4417 - phase2 + otss, & ! surface temperature (weighted soil, snow) + otss_0, & ! surface temperature (weighted soil, snow) + tprecip, & + tevap, & + trnoff, & + totenbal,&! + totenbal2,& + fland, & ! factor for latent heat + ifland, & ! integer soil type + qasrf, & ! heat advected to the snow by precip. + qfsrf, & ! energy of snowpack phase changes + qssrf, & ! sublimation + snage, & ! snow age + snowd, & ! snow depth (liquid water) + smelt, & ! snow melt + ssdnn, & ! average snow density + tss, & ! surface temperature (weighted soil, snow) + tss_p, & ! surface temperature (weighted soil, snow) + deltss, & ! surface temperature (weighted soil, snow) + owb1 ! surface temperature (weighted soil, snow) + + REAL, DIMENSION(:,:), POINTER :: & + sconds, & ! + sdepth, & ! snow depth + smass, & ! snow mass + ssdn, & ! snow densities + otgg, & ! soil temperature in K ! moved here from above by rk4417 - phase2 + tgg, & ! soil temperature in K + tggsn, & ! snow temperature in K + dtmlt, & ! water flux to the soil + albsoilsn, & ! soil + snow reflectance + evapfbl, & ! + tilefrac ! factor for latent heat + + + REAL(r_2), DIMENSION(:), POINTER :: & + wbtot ! total soil water (mm) + + REAL(r_2), DIMENSION(:,:), POINTER :: & + gammzz, & ! heat capacity for each soil layer + wb, & ! volumetric soil moisture (solid+liq) + wbice, & ! soil ice + wblf, & ! + wbfice ! + + !mrd561 + !MD variables for the revised soil moisture + GW scheme + REAL(r_2), DIMENSION(:), POINTER :: & + GWwb, & ! water content in aquifer [mm3/mm3] + GWhk, & ! aquifer hydraulic conductivity [mm/s] + GWdhkdw, & ! aquifer d(hk) over d(water content) [(mm/s)/(mm3/mm3)] + GWdsmpdw,& ! aquifer d(smp) / dw [(mm)/(mm3/mm3)] + wtd, & ! water table depth [mm] + GWsmp, & ! aquifer soil matric potential [mm] + GWwbeq, & ! equilibrium aquifer water content [mm3/mm3] + GWzq, & ! equilibrium aquifer smp [mm] + qhz, & ! horizontal hydraulic conductivity in 1D gw model for soil layers [mm/s] + satfrac, & + Qrecharge,& + rh_srf, & + rtevap_sat,& + rtevap_unsat,& + rt_qh_sublayer + + REAL(r_2), DIMENSION(:,:), POINTER :: & + wbeq, & ! equilibrium water content [mm3/mm3] + zq, & ! equilibrium smp [mm] + icefrac, & ! ice fraction [none] -> ice mass / total mass + fracice, & ! alternate ice fraction [none] - parameterized + hk, & ! hydraulic conductivity for soil layers [mm/s] + smp, & ! soil matric potential for soil layers [mm] + dhkdw, & ! d(hydraulic conductivity ) d(water) for soil layers [(mm/s)/(mm3/mm3)] + dsmpdw, & ! d(smp)/ d(water) for soil layers [(mm)/(mm3/mm3)] + wbliq, & ! volumetric liquid water content [mm3/mm3] + wmliq, & !water mass [mm] liq + wmice, & !water mass [mm] ice + wmtot, & !water mass [mm] liq+ice ->total + qhlev, & + smp_hys, & !soil swc props dynamic from hysteresis ! from here to end added by rk4417 - phase2 + wb_hys, & + sucs_hys,& + ssat_hys,& + watr_hys,& + hys_fac, & + wbliq_old + + ! Additional SLI variables: + REAL(r_2), DIMENSION(:,:), POINTER :: S ! moisture content relative to sat value (edit vh 23/01/08) + REAL(r_2), DIMENSION(:,:), POINTER :: Tsoil ! Tsoil (deg C) + REAL(r_2), DIMENSION(:), POINTER :: SL ! litter moisture content relative to sat value (edit vh 23/01/08) + REAL(r_2), DIMENSION(:), POINTER :: TL ! litter temperature in K (edit vh 23/01/08) + REAL(r_2), DIMENSION(:), POINTER :: h0 ! pond height in m (edit vh 23/01/08) + REAL(r_2), DIMENSION(:,:), POINTER :: rex ! root extraction from each layer (mm/dels) + REAL(r_2), DIMENSION(:,:), POINTER :: wflux ! water flux at layer boundaries (mm s-1) + REAL(r_2), DIMENSION(:), POINTER :: delwcol ! change in water column (mm / dels) + REAL(r_2), DIMENSION(:), POINTER :: zdelta ! water table depth (edit vh 23/06/08) + REAL(r_2), DIMENSION(:,:), POINTER :: kth ! thermal conductivity (edit vh 29/07/08) + REAL(r_2), DIMENSION(:), POINTER :: Tsurface ! tepmerature at surface (soil, pond or litter) (edit vh 22/10/08) + REAL(r_2), DIMENSION(:), POINTER :: lE ! soil latent heat flux + REAL(r_2), DIMENSION(:), POINTER :: evap ! soil evaporation (mm / dels) + REAL(r_2), DIMENSION(:,:), POINTER :: ciso ! concentration of minor isotopologue in soil water (kg m-3 water) + REAL(r_2), DIMENSION(:), POINTER :: cisoL ! concentration of minor isotopologue in litter water (kg m-3 water) + REAL(r_2), DIMENSION(:), POINTER :: rlitt ! resistance to heat/moisture transfer through litter (m-1 s) + REAL(r_2), DIMENSION(:,:), POINTER :: thetai ! volumetric ice content (MC) + REAL(r_2), DIMENSION(:,:), POINTER :: snowliq ! liquid snow content (mm H2O) + REAL(r_2), DIMENSION(:), POINTER :: nsteps ! number of iterations at each timestep + REAL(r_2), DIMENSION(:), POINTER :: TsurfaceFR ! tepmerature at surface (soil, pond or litter) (edit vh 22/10/08) + REAL(r_2), DIMENSION(:,:), POINTER :: Ta_daily ! air temp averaged over last 24h + INTEGER, DIMENSION(:), POINTER :: nsnow ! number of layers in snow-pack (0-nsnow_max) + REAL(r_2), DIMENSION(:), POINTER :: Qadv_daily ! advective heat flux into surface , daily average (W m-2) + REAL(r_2), DIMENSION(:), POINTER :: G0_daily ! conductive heat flux into surface , daily average (W m-2) + REAL(r_2), DIMENSION(:), POINTER :: Qevap_daily ! evaporative flux at surface, daily average (m s-1) + REAL(r_2), DIMENSION(:), POINTER :: Qprec_daily ! liquid precip, daily average (m s-1) + REAL(r_2), DIMENSION(:), POINTER :: Qprec_snow_daily ! solid precip, daily average (m s-1) + + + + END TYPE soil_snow_type + + ! ............................................................................. + + ! Vegetation parameters: + TYPE veg_parameter_type + + INTEGER, DIMENSION(:), POINTER :: & + iveg , & ! vegetation type + iLU ! land use type + REAL, DIMENSION(:), POINTER :: & + canst1, & ! max intercepted water by canopy (mm/LAI) + dleaf, & ! chararacteristc legnth of leaf (m) + ejmax, & ! max pot. electron transp rate top leaf(mol/m2/s) + meth, & ! method for calculation of canopy fluxes and temp. + frac4, & ! fraction of c4 plants + hc, & ! roughness height of canopy (veg - snow) + vlai, & ! leaf area index + xalbnir, & + rp20, & ! plant respiration coefficient at 20 C + rpcoef, & ! temperature coef nonleaf plant respiration (1/C) + rs20, & ! soil respiration at 20 C [mol m-2 s-1] + shelrb, & ! sheltering factor (dimensionless) + vegcf, & ! kdcorbin, 08/10 + tminvj, & ! min temperature of the start of photosynthesis + toptvj, & ! opt temperature of the start of photosynthesis + tmaxvj, & ! max temperature of the start of photosynthesis + vbeta, & ! + vcmax, & ! max RuBP carboxylation rate top leaf (mol/m2/s) + xfang, & ! leaf angle PARAMETER + extkn, & ! extinction coef for vertical + vlaimax, & ! extinction coef for vertical + wai, & ! wood area index (stem+branches+twigs) + a1gs, & ! a1 parameter in stomatal conductance model + d0gs, & ! d0 in stomatal conductance model + alpha, & ! initial slope of J-Q response curve + convex, & ! convexity of J-Q response curve + cfrd, & ! ratio of day respiration to vcmax + gswmin, & ! minimal stomatal conductance + conkc0, & ! Michaelis-menton constant for carboxylase + conko0, & ! Michaelis-menton constant for oxygenase + ekc, & ! activation energy for caroxylagse + eko, & ! acvtivation enegery for oxygenase + g0, & ! Belinda's stomatal model intercept, Ticket #56. + g1 ! Belinda's stomatal model slope, Ticket #56. + + LOGICAL, DIMENSION(:), POINTER :: & + deciduous ! flag used for phenology fix + + REAL, DIMENSION(:,:), POINTER :: & + refl, & + taul, & + froot ! fraction of root in each soil layer + + ! Additional veg parameters: + REAL(r_2), DIMENSION(:), POINTER :: rootbeta ! parameter for estimating vertical root mass distribution (froot) + REAL(r_2), DIMENSION(:), POINTER :: gamma ! parameter in root efficiency function (Lai and Katul 2000) + REAL(r_2), DIMENSION(:), POINTER :: ZR ! maximum rooting depth (cm) + REAL(r_2), DIMENSION(:), POINTER :: F10 ! fraction of roots in top 10 cm + + REAL(r_2), DIMENSION(:), POINTER :: clitt ! + + ! Additional POP veg param + INTEGER, DIMENSION(:,:), POINTER :: disturbance_interval + REAL(r_2), DIMENSION(:,:), POINTER :: disturbance_intensity + + END TYPE veg_parameter_type + + ! ............................................................................. + + ! Canopy/vegetation variables: + TYPE canopy_type + + + REAL, DIMENSION(:), POINTER :: & + cansto, & ! canopy water storage (mm) + cduv, & ! drag coefficient for momentum + delwc, & ! change in canopy water store (mm/dels) + dewmm, & ! dewfall (mm) + fe, & ! total latent heat (W/m2) + fh, & ! total sensible heat (W/m2) + fpn, & ! plant photosynthesis (g C m-2 s-1) + frp, & ! plant respiration (g C m-2 s-1) + frpw, & ! plant respiration (woody component) (g C m-2 s-1) + frpr, & ! plant respiration (root component) (g C m-2 s-1) + frs, & ! soil respiration (g C m-2 s-1) + fnee, & ! net carbon flux (g C m-2 s-1) + frday, & ! daytime leaf resp + fnv, & ! net rad. avail. to canopy (W/m2) + fev, & ! latent hf from canopy (W/m2) + epot, & ! total potential evaporation + fnpp, & ! npp flux + fevw_pot,& ! potential lat heat from canopy + gswx_T, & ! ! stom cond for water + cdtq, & ! drag coefficient for momentum + wetfac_cs,&! + fevw, & ! lat heat fl wet canopy (W/m2) + fhvw, & ! sens heatfl from wet canopy (W/m2) + oldcansto,&! canopy water storage (mm) + fhv, & ! sens heatfl from canopy (W/m2) + fns, & ! net rad avail to soil (W/m2) + fhs, & ! sensible heat flux from soil + fhs_cor, & + ga, & ! ground heat flux (W/m2) ??? + ghflux, & ! ground heat flux (W/m2) ??? + precis, & ! throughfall to soil, after snow (mm) + qscrn, & ! specific humudity at screen height (g/g) + rnet, & ! net radiation absorbed by surface (W/m2) + rniso, & !isothermal net radiation absorbed by surface (W/m2) + segg, & ! latent heatfl from soil mm + sghflux, & ! ground heat flux (W/m2) ??? + through, & ! canopy throughfall (mm) + through_sn, & ! canopy snow throughfall (equal to precip_sn) (mm) + spill, & ! can.storage excess after dewfall (mm) + tscrn, & ! air temperature at screen height (oC) + wcint, & ! canopy rainfall interception (mm) + tv, & ! vegetation temp (K) + us, & ! friction velocity + uscrn, & ! wind speed at screen height (m/s) + vlaiw, & ! lai adj for snow depth for calc of resistances + rghlai, & ! lai adj for snow depth for calc of resistances + fwet ! fraction of canopy wet + + !INH - new REV_CORR coupling variables + REAL, DIMENSION(:), POINTER :: & + fns_cor, & ! correction to net rad avail to soil (W/m2) + ga_cor ! correction to ground heat flux (W/m2) + + REAL, DIMENSION(:,:), POINTER :: & + evapfbl, & + gswx, & ! stom cond for water + zetar, & ! stability parameter (ref height) + ! vh_js ! + zetash ! stability parameter (shear height) + + REAL(r_2), DIMENSION(:), POINTER :: & + fess, & ! latent heatfl from soil (W/m2) + fesp, & ! latent heatfl from soil (W/m2) + dgdtg, & ! derivative of gflux wrt soil temp + fes, & ! latent heatfl from soil (W/m2) + fes_cor, & ! latent heatfl from soil (W/m2) + fevc, & ! dry canopy transpiration (W/m2) + ofes ! latent heatfl from soil (W/m2) + + !SSEB - new variables limits on correction terms - for future use + !REAL(r_2), DIMENSION(:), POINTER :: & + ! fescor_upp,& ! upper limit on the correction term fes_cor (W/m2) + ! fescor_low ! lower limit on the correction term fes_cor (W/m2) + + REAL(r_2), DIMENSION(:), POINTER :: & + sublayer_dz + + ! Additional variables: + REAL(r_2), DIMENSION(:,:), POINTER :: gw ! dry canopy conductance (ms-1) edit vh 6/7/09 + REAL(r_2), DIMENSION(:,:,:), POINTER :: ancj ! limiting photosynthetic rates (Rubisco,RuBP,sink) vh 6/7/09 + REAL(r_2), DIMENSION(:,:), POINTER :: tlfy ! sunlit and shaded leaf temperatures + REAL(r_2), DIMENSION(:,:), POINTER :: ecy ! sunlit and shaded leaf transpiration (dry canopy) + REAL(r_2), DIMENSION(:,:), POINTER :: ecx ! sunlit and shaded leaf latent heat flux + REAL(r_2), DIMENSION(:,:,:), POINTER :: ci ! intra-cellular CO2 vh 6/7/09 + REAL(r_2), DIMENSION(:), POINTER :: fwsoil ! + + ! vh_js ! !litter thermal conductivity (Wm-2K-1) and vapour diffusivity (m2s-1) + REAL(r_2), DIMENSION(:), POINTER :: kthLitt, DvLitt + + + END TYPE canopy_type + + ! ............................................................................. + + ! Radiation variables: + TYPE radiation_type + + REAL, DIMENSION(:), POINTER :: & + transb, & ! fraction SW beam tranmitted through canopy + albedo_T,& ! canopy+soil albedo for VIS+NIR + longitude,&! longitude + workp1, & ! absorbed short-wave radiation for soil + workp2, & ! absorbed short-wave radiation for soil + workp3, & ! absorbed short-wave radiation for soil + extkb, & ! beam radiation extinction coeff + extkd2, & ! diffuse 2D radiation extinction coeff + extkd, & ! diffuse radiation extinction coeff (-) + flws, & ! soil long-wave radiation + latitude,& ! latitude + lwabv, & ! long wave absorbed by vegetation + qssabs, & ! absorbed short-wave radiation for soil + transd, & ! frac SW diffuse transmitted through canopy + trad, & ! radiative temperature (soil and veg) + otrad ! radiative temperature on previous timestep (ACCESS) + + REAL, DIMENSION(:,:), POINTER :: & + fvlai, & ! leaf area index of big leaf + rhocdf, & ! canopy diffuse reflectance (-) + rniso, & ! sum(rad%qcan, 3) total abs by canopy (W/m2) + scalex, & ! scaling PARAMETER for big leaf + albedo, & ! canopy+soil albedo + reffdf, & ! effective conopy diffuse reflectance + reffbm, & ! effective conopy beam reflectance + extkbm, & ! modified k beam(6.20)(for leaf scattering) + extkdm, & ! modified k diffuse(6.20)(for leaf scattering) + fbeam, & ! beam fraction + cexpkbm, & ! canopy beam transmittance + cexpkdm, & ! canopy diffuse transmittance + rhocbm, & ! modified canopy beam reflectance(6.21) + gradis ! radiative conductance + + REAL, DIMENSION(:,:,:), POINTER :: & + qcan ! absorbed radiation for canopy (W/m^2) + + + END TYPE radiation_type + + ! ............................................................................. + + ! Roughness variables: + TYPE roughness_type + + REAL, DIMENSION(:), POINTER :: & + disp, & ! zero-plane displacement + hruff, & ! canopy height above snow level + hruff_grmx,&! max ht of canopy from tiles on same grid + rt0us, & ! eq. 3.54, SCAM manual (CSIRO tech report 132) + rt1usa, & ! resistance from disp to hruf + rt1usb, & ! resist fr hruf to zruffs (zref if zref0%) patches (<=max_vegpatches) + cstart, & ! pos of 1st gridcell veg patch in main arrays + cend, & ! pos of last gridcell veg patch in main arrays + ilat, & ! replacing land_y ! ?? + ilon ! replacing land_x ! ?? + + END TYPE land_type + + + TYPE(land_type),DIMENSION(:),POINTER :: landpt + TYPE(patch_type), DIMENSION(:), POINTER :: patch + + INTEGER :: & + max_vegpatches, & ! The maximum # of patches in any grid cell + nmetpatches ! size of patch dimension in met file, if exists + + ! =============== File details ========================== + TYPE globalMet_type + LOGICAL :: & + l_gpcc,&! = .FALSE., & ! ypwang following Chris Lu (30/oct/2012) + l_gswp,&!= .FALSE. , & ! BP May 2013 + l_ncar,&! = .FALSE., & ! BP Dec 2013 + l_access ! = .FALSE. ! BP May 2013 + + CHARACTER(LEN=99) :: & + rainf, & + snowf, & + LWdown, & + SWdown, & + PSurf, & + Qair, & + Tair, & + wind + + END TYPE globalMet_type + + TYPE(globalMet_type) :: globalMetfile + + TYPE gswp_type + + CHARACTER(LEN=200) :: & + rainf, & + snowf, & + LWdown, & + SWdown, & + PSurf, & + Qair, & + Tair, & + wind, & + mask + + END TYPE gswp_type + + TYPE(gswp_type) :: gswpfile + + + INTEGER :: & + ncciy, & ! year number (& switch) for gswp run + ncid_rin, & ! input netcdf restart file ID + logn ! log file unit number + + LOGICAL :: & + verbose, & ! print init and param details of all grid cells? + soilparmnew ! read IGBP new soil map. Q.Zhang @ 12/20/2010 + + ! ================ Veg and soil type variables ============================ + INTEGER, POINTER :: & + soiltype_metfile(:,:), & ! user defined soil type (from met file) + vegtype_metfile(:,:) ! user-def veg type (from met file) + + REAL, POINTER :: vegpatch_metfile(:,:) ! Anna: patchfrac for user-def vegtype + + + TYPE parID_type ! model parameter IDs in netcdf file + + INTEGER :: bch,latitude,clay,css,rhosoil,hyds,rs20,sand,sfc,silt, & + ssat,sucs,swilt,froot,zse,canst1,dleaf,meth,za_tq,za_uv, & + ejmax,frac4,hc,lai,rp20,rpcoef,shelrb, vbeta, xalbnir, & + vcmax,xfang,ratecp,ratecs,refsbare,isoil,iveg,albsoil, & + taul,refl,tauw,refw,wai,vegcf,extkn,tminvj,tmaxvj, & + veg_class,soil_class,mvtype,mstype,patchfrac, & + WatSat,GWWatSat,SoilMatPotSat,GWSoilMatPotSat, & + HkSat,GWHkSat,FrcSand,FrcClay,Clappb,Watr,GWWatr,sfc_vec,forg,swilt_vec, & + slope,slope_std,GWdz,SatFracmax,Qhmax,QhmaxEfold,HKefold,HKdepth + INTEGER :: ishorizon,nhorizons,clitt, & + zeta,fsatmax, & + gamma,ZR,F10 + + INTEGER :: g0,g1 ! Ticket #56 + + END TYPE parID_type + + ! =============== Logical variables ============================ + TYPE input_details_type + + LOGICAL :: & + Wind, & ! T => 'Wind' is present; F => use vector component wind + LWdown, & ! T=> downward longwave is present in met file + CO2air, & ! T=> air CO2 concentration is present in met file + PSurf, & ! T=> surface air pressure is present in met file + Snowf, & ! T=> snowfall variable is present in met file + avPrecip,& ! T=> ave rainfall present in met file (use for spinup) + LAI, & ! T=> LAI is present in the met file + LAI_T, & ! T=> LAI is time dependent, for each time step + LAI_M, & ! T=> LAI is time dependent, for each month + LAI_P, & ! T=> LAI is patch dependent + parameters,&! TRUE if non-default parameters are found + initial, & ! switched to TRUE when initialisation data are loaded + patch, & ! T=> met file have a subgrid veg/soil patch dimension + laiPatch ! T=> LAI file have a subgrid veg patch dimension + + END TYPE input_details_type + + TYPE(input_details_type) :: exists + + TYPE output_inclusion_type + + ! Which variables to include in output file, values initialised here + ! and can be reset by namelist file read in driver: + ! Groups of output variables: + + LOGICAL :: & + met = .FALSE., & ! input met data + flux = .FALSE., & ! convective, runoff, NEE + radiation = .FALSE., & ! net rad, albedo + carbon = .FALSE., & ! NEE, GPP, NPP, stores + soil = .FALSE., & ! soil states + snow = .FALSE., & ! snow states + veg = .FALSE., & ! vegetation states + params = .FALSE., & ! input parameters used to produce run + balances = .FALSE., & ! energy and water balances + restart = .FALSE., & ! create restart file? + ensemble = .FALSE., & ! are we creating an ensemble run? + patch = .FALSE. , & ! should patch-specific info be written + ! to output file? + ! vh_js ! + casa = .FALSE. ! additional casa outputs (C stores and plant turnover) + + ! Should output grid follow met file 'default'; force with 'land' or 'mask': + CHARACTER(LEN=7) :: & + grid = 'default', & + averaging = 'all' ! 'all', 'daily', 'monthly', 'user6'(6hrly) + + INTEGER :: & + interval ! in case of 'user6' above, interval will be 6 + + ! variables specified individually: + LOGICAL :: & + SWdown = .FALSE., & ! 6 downward short-wave radiation [W/m2] + LWdown = .FALSE., & ! 7 downward long-wave radiation [W/m2] + Rainf = .FALSE., & ! 8 rainfall [kg/m2/s] + Snowf = .FALSE., & ! 9 snowfall [kg/m2/s] + PSurf = .FALSE., & ! 10 surface pressure [Pa] + Tair = .FALSE., & ! 11 surface air temperature [K] + Qair = .FALSE., & ! 12 specific humidity [kg/kg] + Tscrn = .FALSE., & ! screen level air temperature [oC] + Tex = .FALSE., & ! extremes in screen level temperature [oC] + Qscrn = .FALSE., & ! screen level specific humidity [kg/kg] + CO2air = .FALSE., & ! 13 CO2 concentration [ppmv] + Wind = .FALSE., & ! 14 windspeed [m/s] + Wind_N = .FALSE., & ! 15 surface wind speed, N component [m/s] + Wind_E = .FALSE., & ! 16 surface wind speed, E component [m/s] + LAI = .FALSE., & ! + Qmom = .FALSE., & ! momentum flux [kg/m/s2] + Qh = .FALSE., & ! 17 sensible heat flux [W/m2] + Qle = .FALSE., & ! 18 latent heat flux [W/m2] + Qg = .FALSE., & ! 19 ground heat flux [W/m2] + SWnet = .FALSE., & ! 20 net shortwave [W/m2] + LWnet = .FALSE., & ! 21 net longwave [W/m2] + Evap = .FALSE., & ! 22 total evapotranspiration [kg/m2/s] + Ewater = .FALSE., & ! 23 evap. from surface water storage [kg/m2/s] + ESoil = .FALSE., & ! 24 bare soil evaporation [kg/m2/s] + TVeg = .FALSE., & ! 25 vegetation transpiration [kg/m2/s] + ECanop = .FALSE., & ! 26 interception evaporation [kg/m2/s] + PotEvap = .FALSE., & ! 27 potential evapotranspiration [kg/m2/s] + ACond = .FALSE., & ! 28 aerodynamic conductance [m/s] + SoilWet = .FALSE., & ! 29 total soil wetness [-] + Albedo = .FALSE., & ! 30 albedo [-] + visAlbedo = .FALSE., & ! vars intro for Ticket #27 + nirAlbedo = .FALSE., & ! vars intro for Ticket #27 + VegT = .FALSE., & ! 31 vegetation temperature [K] + SoilTemp = .FALSE., & ! 32 av.layer soil temperature [K] + SoilMoist = .FALSE., & ! 33 av.layer soil moisture [kg/m2] + SoilMoistIce = .FALSE., & ! 33 av.layer soil frozen moisture [kg/m2] + Qs = .FALSE., & ! 34 surface runoff [kg/m2/s] + Qsb = .FALSE., &! 35 subsurface runoff [kg/m2/s] + DelSoilMoist = .FALSE., & ! 36 change in soilmoisture + ! (sum layers) [kg/m2] + DelSWE = .FALSE., & ! 37 change in snow water equivalent [kg/m2] + DelIntercept = .FALSE.,& ! 38 change in interception storage [kg/m2] + SnowT = .FALSE., & ! 39 snow surface temp [K] + BaresoilT = .FALSE., & ! 40 surface bare soil temp [K] + AvgSurfT = .FALSE., & ! 41 Average surface temperature [K] + RadT = .FALSE., & ! 42 Radiative surface temperature [K] + SWE = .FALSE., & ! 43 snow water equivalent [kg/m2] + SnowMelt = .FALSE., & ! 43 snow melt [kg/m2/s] !vh! + RootMoist = .FALSE., & ! 44 root zone soil moisture [kg/m2] + CanopInt = .FALSE., & ! 45 total canopy water storage [kg/m2] + NEE = .FALSE., & ! 46 net ecosystem exchange [umol/m2/s] + NPP = .FALSE., & ! 47 net primary production of C + ! by veg [umol/m2/s] + GPP = .FALSE., & ! 48 gross primary production C + ! by veg [umol/m2/s] + AutoResp = .FALSE., & ! 49 autotrophic respiration [umol/m2/s] + LeafResp = .FALSE., & ! 51 autotrophic respiration [umol/m2/s] + HeteroResp = .FALSE.,& ! 50 heterotrophic respiration [umol/m2/s] + SnowDepth = .FALSE., & ! actual depth of snow in [m] + !variables + Rnet = .FALSE., & ! net absorbed radiation [W/m2] + HVeg = .FALSE., & ! sensible heat from vegetation [W/m2] + HSoil = .FALSE., & ! sensible heat from soil [W/m2] + RnetSoil = .FALSE., & ! sensible heat from soil [W/m2] !vh! + Ebal = .FALSE., & ! cumulative energy balance [W/m2] + Wbal = .FALSE., & ! cumulative water balance [W/m2] + ! vh_js ! added CanT and fwsoil to the list + CanT = .FALSE., & ! within-canopy temperature [K] + Fwsoil = .FALSE., & ! soil moisture modifier to stomatal conductance + Area = .FALSE., & ! patch area in km2 + !mrd561 + !MD GW + GWMoist = .FALSE., & ! water balance of aquifer [mm3/mm3] + WatTable = .FALSE., & ! water table depth [m] + Qrecharge=.FALSE., & !recharge to /from auqifer + SatFrac=.FALSE., & ! Saturated Fraction of Gridcell (tile) + + ! vh_js ! additional casa variables + NBP = .FALSE., & + dCdt = .FALSE., & + TotSoilCarb = .FALSE., & + TotLivBiomass = .FALSE., & + TotLittCarb = .FALSE., & + SoilCarbFast = .FALSE., & + SoilCarbSlow = .FALSE., & + SoilCarbPassive = .FALSE., & + LittCarbMetabolic = .FALSE., & + LittCarbStructural = .FALSE., & + LittCarbCWD = .FALSE., & + PlantCarbLeaf = .FALSE., & + PlantCarbFineRoot = .FALSE., & + PlantCarbWood = .FALSE., & + PlantTurnover = .FALSE., & + PlantTurnoverLeaf = .FALSE., & + PlantTurnoverFineRoot = .FALSE., & + PlantTurnoverWood = .FALSE., & + PlantTurnoverWoodDist = .FALSE., & + PlantTurnoverWoodCrowding = .FALSE., & + PlantTurnoverWoodResourceLim = .FALSE., & + LandUseFlux = .FALSE., & + !parameters + bch = .FALSE., & ! parameter b in Campbell equation 1985 + latitude = .FALSE., & ! site latitude + clay = .FALSE., & ! fraction of clay in soil + css = .FALSE., & ! heat capacity of soil minerals [J/kg/C] + rhosoil = .FALSE., & ! soil density [kg/m3] + hyds = .FALSE., & ! hydraulic conductivity @ saturation [m/s], Ksat + rs20 = .FALSE., & ! soil respiration at 20 C [dimensionless], + ! (0.1 - 10), prop to om + sand = .FALSE., & ! fraction of sand in soil + sfc = .FALSE., & ! vol H2O @ field capacity + silt = .FALSE., & ! fraction of silt in soil + ssat = .FALSE., & ! vol H2O @ saturation + sucs = .FALSE., & ! suction at saturation [m] + swilt = .FALSE., & ! vol H2O @ wilting + froot = .FALSE., & ! fraction of roots in each soil layer + zse = .FALSE., & ! thickness of each soil layer (1=top) (m) + canst1 = .FALSE., & ! max intercepted water by canopy [mm/LAI] + ! (0.08 - 0.12) {avoid} + dleaf = .FALSE., & ! chararacteristic length of leaf [m], + ! (0.005 - 0.2) pine -> tropical + ejmax = .FALSE., & ! max pot. electron transport rate + ! top leaf[mol/m2/s](1e-5 - 3e-4) {use} + frac4 = .FALSE., & ! fraction of c4 plants [-] + hc = .FALSE., & ! height of canopy [m] + rp20 = .FALSE., & ! plant respiration coefficient at + ! 20 C [-] 0.1 - 10 (frp 0 - 15e-6 mol/m2/s) + g0 = .FALSE., & ! Ticket #56 + g1 = .FALSE., & ! Ticket #56 + rpcoef = .FALSE., & ! temperature coef nonleaf plant + ! respiration [1/C] (0.8 - 1.5) + shelrb = .FALSE., & ! sheltering factor [-] {avoid - insensitive?} + vcmax = .FALSE., & ! maximum RuBP carboxylation rate + ! top leaf [mol/m2/s](5e-6 - 1.5e-4){use} + xfang = .FALSE., & ! leaf angle PARAMETER (dimensionless) + ! (v leaf -1.0 horiz 1.0 sphere 0 (-1 - 1)) + wai = .FALSE., & ! wood area index + vegcf = .FALSE., & ! + extkn = .FALSE., & ! + ratecp = .FALSE., & ! plant carbon pool rate constant (1/year) + ratecs = .FALSE., & ! soil carbon pool rate constant (1/year) + albsoil = .FALSE., & ! soil reflectance [-] + taul = .FALSE., & ! leaf transmissivity [-](V:0.07 - 0.15 + ! NIR: 0.3 - 0.6 IR: 0.0 - 0.05) + refl = .FALSE., & ! leaf reflectance [-](V:0.07 - 0.15 \ + ! NIR: 0.3 - 0.6 IR: 0.0 - 0.05) + tminvj = .FALSE., & ! min temperature of the start of + ! photosynthesis(leaf phenology)[-] (-10 - 10) + tmaxvj = .FALSE., & ! max temperature of the start of + ! photosynthesis(leaf phenology)[-] (-5 - 15) + vbeta = .FALSE., & ! stomatal sensitivity to soil water + xalbnir = .FALSE., & ! modifier for albedo in near ir band + iveg = .FALSE., & ! vegetation type from global index + patchfrac = .FALSE.,& ! fractional cover of each veg/soil patch + isoil = .FALSE., & ! soil type from global index + meth = .FALSE., & ! method for solving turbulence in canopy scheme + za = .FALSE., & ! something to do with roughness ???? + slope = .FALSE.,& !mean subgrid slope + slope_std=.FALSE.,& !stddev of subgrid slope + GWdz=.FALSE.,& !aquifer thickness + SatFracmax=.FALSE.,& + Qhmax=.FALSE.,& + QhmaxEfold=.FALSE.,& + HKefold=.FALSE.,& + HKdepth + + END TYPE output_inclusion_type + + + TYPE(output_inclusion_type),SAVE :: output + TYPE(output_inclusion_type),SAVE :: patchout ! do we want patch-specific info + + ENUM, BIND(C) + ENUMERATOR :: NO_CHECK = 0 + ENUMERATOR :: ON_TIMESTEP = 1 + ENUMERATOR :: ON_WRITE = 2 + ENUMERATOR :: RANGE_CHECK + END ENUM + TYPE checks_type + LOGICAL :: energy_bal, mass_bal + INTEGER(KIND(RANGE_CHECK)) :: ranges ! 0 = NO , 1 = TIMESTEP , 2 = WRITE + LOGICAL :: exit + END TYPE checks_type + + TYPE(checks_type) :: check ! what types of checks to perform + + ! ============== Proxy input variables ================================ + REAL,POINTER,DIMENSION(:) :: PrecipScale! precip scaling per site for spinup + REAL,POINTER,DIMENSION(:,:) :: defaultLAI ! in case met file/host model + ! has no LAI + REAL :: fixedCO2 ! CO2 level if CO2air not in met file + + ! 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 + +END MODULE cable_IO_vars_module diff --git a/src/coupled/esm16/cable_phenology.F90 b/src/coupled/esm16/cable_phenology.F90 new file mode 100644 index 000000000..ac5d090ab --- /dev/null +++ b/src/coupled/esm16/cable_phenology.F90 @@ -0,0 +1,144 @@ + +!============================================================================== +! 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: climate-dependent phenology +! +! Called from: SUBROUTINE bgcdriver in casa_cable.F90 +! +! History: Vanessa Haverd Jan 2015 + +! ============================================================================== +MODULE cable_phenology_module + + USE cable_def_types_mod, ONLY: met_type, climate_type, canopy_type, veg_parameter_type, & + mp, r_2 + USE TypeDef, ONLY: i4b, dp + USE cable_IO_vars_module, ONLY: patch + USE casa_ncdf_module, ONLY: HANDLE_ERR + USE CABLE_COMMON_MODULE, ONLY: CurYear, filename, cable_user + +CONTAINS + ! ============================================================================== + + SUBROUTINE cable_phenology_clim (veg, climate, phen) + + ! sets the following days of year for use in allocation and leaf senescence + ! algorithm depends on pft and climate + !phen%doyphase(np,1) ! DOY for greenup + !phen%doyphase(np,2) ! DOY for steady LAI + ! phen%doyphase(np,3) ! DOY for leaf senescence + !phen%doyphase(np,4) ! DOY for minimal LAI season + + + USE casadimension + USE casaparm + USE casavariable + USE phenvariable + IMPLICIT NONE + + TYPE (veg_parameter_type), INTENT(IN) :: veg ! vegetation parameters + TYPE (phen_variable), INTENT(INOUT) :: phen + TYPE (climate_type), INTENT(IN) :: climate ! climate variables + INTEGER :: np, days + REAL:: gdd0 + REAL(r_2) :: phen_tmp + REAL, PARAMETER :: k_chilla = 0, k_chillb = 100, k_chillk = 0.05 + REAL, PARAMETER :: APHEN_MAX = 200.0, mmoisture_min=0.30 + INTEGER, PARAMETER:: COLDEST_DAY_NHEMISPHERE = 355 + INTEGER, PARAMETER:: COLDEST_DAY_SHEMISPHERE = 172 + REAL :: phengdd5ramp + + DO np= 1,mp + + ! evergreen pfts + IF (veg%iveg(np) == 31 .OR. veg%iveg(np) == 2 .OR. veg%iveg(np) == 5) THEN + phen%doyphase(np,1) = -50 + phen%doyphase(np,2) = phen%doyphase(np,1) +14 + phen%doyphase(np,3) = 367 + phen%doyphase(np,4) = phen%doyphase(np,3) + 14 + phen%phase(np) = 2 + ENDIF + + ! summergreen woody pfts + IF (veg%iveg(np) == 3 .OR. veg%iveg(np) == 4) THEN ! deciduous needleleaf(3) and broadleaf(4) + + ! Calculate GDD0 base value (=gdd to bud burst) for this PFT given + ! current length of chilling period (Sykes et al 1996, Eqn 1) + gdd0 = k_chilla + k_chillb*EXP(-k_chillk*REAL(climate%chilldays(np))) + phengdd5ramp = 200 + + IF (climate%gdd5(np).GT.gdd0 .AND. phen%aphen(np).LT. APHEN_MAX) THEN + + phen_tmp = MIN(1.0_r_2, (climate%gdd5(np)-gdd0)/phengdd5ramp) + + ELSE + + phen_tmp = 0.0 + + ENDIF + + ENDIF + + ! summergreen grass or crops + IF (veg%iveg(np).GE.6.AND.veg%iveg(np).LE.10) THEN ! grass or crops + + phengdd5ramp = 50 + phen_tmp = MIN(1.0_r_2, climate%gdd5(np)/phengdd5ramp) + + ENDIF + + ! raingreen pfts + IF (veg%iveg(np).GE.6.AND.veg%iveg(np).LE.10) THEN ! (grass or crops) need to include raingreen savanna trees here too + + IF (climate%dmoist(np).LT. mmoisture_min) phen_tmp = 0.0 + + + ENDIF + + IF ((veg%iveg(np) == 3 .OR. veg%iveg(np) == 4) .OR. & + (veg%iveg(np).GE.6.AND.veg%iveg(np).LE.10)) THEN + + + IF (phen_tmp.GT.0.0 .AND.( phen%phase(np).EQ.3 .OR. phen%phase(np).EQ.0 )) THEN + phen%phase(np) = 1 ! greenup + phen%doyphase(np,1) = climate%doy + ELSEIF (phen_tmp.GE.1.0_r_2 .AND. phen%phase(np).EQ.1) THEN + phen%phase(np) = 2 ! steady LAI + phen%doyphase(np,2) = climate%doy + ELSEIF (phen_tmp.LT.1.0_r_2 .AND. phen%phase(np).EQ.2) THEN + phen%phase(np) = 3 ! senescence + phen%doyphase(np,3) = climate%doy + ENDIF + + IF (phen%phase(np)==3) THEN + days = MIN(climate%doy,365)-phen%doyphase(np,3) + IF (days < 0) days = days + 365 + IF (days > 14) phen%phase(np) = 0 ! mimimum LAI + ENDIF + + ! Update annual leaf-on sum + IF ((patch(np)%latitude>=0.0 .AND. climate%doy==COLDEST_DAY_NHEMISPHERE).OR. & + (patch(np)%latitude <0.0 .AND. climate%doy==COLDEST_DAY_SHEMISPHERE) ) & + phen%aphen(np) = 0 + phen%phen(np) = phen_tmp + phen%aphen(np) = phen%aphen(np) + phen%phen(np) + + ENDIF + + ENDDO ! end loop over patches + + + END SUBROUTINE cable_phenology_clim + + + ! ============================================================================== +END MODULE cable_phenology_module diff --git a/src/coupled/esm16/cable_surface_types.F90 b/src/coupled/esm16/cable_surface_types.F90 new file mode 100644 index 000000000..8b51b0e7e --- /dev/null +++ b/src/coupled/esm16/cable_surface_types.F90 @@ -0,0 +1,37 @@ +!#define UM_CBL YES +!****************************************************************************** +! This source code is part of the 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 +! this file except in compliance with this License. A copy of the License is +! available at https://trac.nci.org.au/trac/cable/wiki/license. +!****************************************************************************** + +MODULE cable_surface_types_mod + +IMPLICIT NONE + +PUBLIC + +!----------------------------------------------------------------------------- +! cable_surface_type (nml) Index +INTEGER, PARAMETER :: evergreen_needleleaf = 1 +INTEGER, PARAMETER :: evergreen_broadleaf = 2 +INTEGER, PARAMETER :: deciduous_needleleaf = 3 +INTEGER, PARAMETER :: deciduous_broadleaf = 4 +INTEGER, PARAMETER :: shrub_cable = 5 +INTEGER, PARAMETER :: c3_grassland = 6 +INTEGER, PARAMETER :: c4_grassland = 7 +INTEGER, PARAMETER :: tundra = 8 +INTEGER, PARAMETER :: c3_cropland = 9 +INTEGER, PARAMETER :: c4_cropland = 10 +INTEGER, PARAMETER :: wetland = 11 +INTEGER, PARAMETER :: empty1 = 12 +INTEGER, PARAMETER :: empty2 = 13 +INTEGER, PARAMETER :: barren_cable = 14 +INTEGER, PARAMETER :: urban_cable = 15 +INTEGER, PARAMETER :: lakes_cable = 16 +INTEGER, PARAMETER :: ice_cable = 17 + +END MODULE cable_surface_types_mod + diff --git a/src/coupled/esm16/casa_ncdf.F90 b/src/coupled/esm16/casa_ncdf.F90 new file mode 100644 index 000000000..593f922b9 --- /dev/null +++ b/src/coupled/esm16/casa_ncdf.F90 @@ -0,0 +1,480 @@ +!============================================================================== +! 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: handles additional, dynamically decided diagnostic output from model. +! permanently used for bitwise identical testing. more applications +! will follow. +! +! Contact: Jhan.Srbinovsky@csiro.au +! +! History: Currently stripped down version of cable_diag here. will be +! re-implemented in time. +! +! ============================================================================== + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! +!+++ USE this module in any subr. you wish to write vars from. +++! +!+++ x is typically the number of landpoints(tiles). binary file is +++! +!+++ then appended every timestep with the new foo(x_i) +++! +!+++ +++! +!+++ CALL syntax: +++! +!+++ +++! +!+++ cable_diag( Nvars, filename, dimx, dimy, timestep, vname1, var1 ) +++! +!+++ +++! +!+++ output binaries can be interpreted from the command line +++! +!+++ using a suite of tools. Currently, only zero_diff.ksh is supported. +++! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! +!CABLE_LSM:This has to be commented for offline +!#define UM_BUILD YES +MODULE casa_ncdf_module + + IMPLICIT NONE + +#ifndef UM_BUILD + interface put_var_nc + module procedure put_var_ncr1, put_var_ncr2, put_var_ncr3 + end interface put_var_nc + + interface get_var_nc + module procedure get_var_ncr2, get_var_ncr3 + end interface get_var_nc + +#endif + +CONTAINS + +#ifndef UM_BUILD + subroutine def_dims(nd, ncid, dimID, dim_len, dim_name ) + use netcdf + implicit none + integer, intent(in) :: nd, ncid + character(len=*), dimension(:), intent(in) :: dim_name + integer, dimension(:), intent(out) :: dimID + integer, dimension(:), intent(in) :: dim_len + integer :: j, ncok + + do j=1, nd + ncok = NF90_DEF_DIM(ncid, trim(dim_name(j)), dim_len(j), dimID(j) ) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'def dim ', dim_name(j)) + enddo + + return + end subroutine def_dims + + + + + subroutine def_vars(nv, ncid, xtype, dimID, var_name,varID ) + use netcdf + implicit none + integer, intent(in) :: nv, ncid, xtype + integer, dimension(:), intent(in) :: dimID + integer, dimension(:), intent(inout) :: varID + character(len=*), dimension(:), intent(in) :: var_name + integer :: j, ncok + + ! lat + ncok = NF90_DEF_VAR( ncid, trim(var_name(1)), xtype, & + (/ dimID(1) /), varID(1)) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'def var ', var_name(1)) + + ! lon + ncok = NF90_DEF_VAR(ncid, trim(var_name(2)), xtype, & + (/ dimID(1) /), varID(2)) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'def var ', var_name(2)) + + ! tairk + ncok = NF90_DEF_VAR(ncid, trim(var_name(3)), xtype, & + (/ dimID(1), dimID(3) /), varID(3)) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'def var ', var_name(3)) + + !tsoil + ncok = NF90_DEF_VAR(ncid, trim(var_name(4)), xtype, & + (/ dimID(1), dimID(2),dimID(3)/), varID(4)) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'def var ', var_name(4)) + + ! moist + ncok = NF90_DEF_VAR(ncid, trim(var_name(5)), xtype, & + (/ dimID(1), dimID(2),dimID(3)/), varID(5)) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'def var ', var_name(5)) + + !cgpp + ncok = NF90_DEF_VAR(ncid, trim(var_name(6)), xtype, & + (/ dimID(1), dimID(3)/), varID(6)) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'def var ', var_name(6)) + + !crmplant + ncok = NF90_DEF_VAR(ncid, trim(var_name(7)), xtype, & + (/ dimID(1), dimID(2),dimID(3)/), varID(7)) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'def var ', var_name(7)) + + !phenphase + ncok = NF90_DEF_VAR(ncid, trim(var_name(8)), xtype, & + (/ dimID(1), dimID(3)/), varID(8)) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'def var ', var_name(8)) + + !doyphase1 + ncok = NF90_DEF_VAR(ncid, trim(var_name(9)), xtype, & + (/ dimID(1), dimID(3)/), varID(9)) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'def var ', var_name(9)) + + !doyphase2 + ncok = NF90_DEF_VAR(ncid, trim(var_name(10)), xtype, & + (/ dimID(1), dimID(3)/), varID(10)) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'def var ', var_name(10)) + + !doyphase3 + ncok = NF90_DEF_VAR(ncid, trim(var_name(11)), xtype, & + (/ dimID(1), dimID(3)/), varID(11)) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'def var ', var_name(11)) + + !doyphase4 + ncok = NF90_DEF_VAR(ncid, trim(var_name(12)), xtype, & + (/ dimID(1), dimID(3)/), varID(12)) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'def var ', var_name(12)) + + + !mtemp + ncok = NF90_DEF_VAR(ncid, trim(var_name(13)), xtype, & + (/ dimID(1),dimID(3)/), varID(13)) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'def var ', var_name(13)) + + !Ndep + ncok = NF90_DEF_VAR(ncid, trim(var_name(14)), xtype, & + (/ dimID(1),dimID(3)/), varID(14)) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'def var ', var_name(14)) + + return + end subroutine def_vars + + subroutine def_var_atts( ncfile_in, ncid, varID ) + use netcdf + implicit none + character(len=*), intent(in) :: ncfile_in + integer, intent(in):: ncid ! netcdf file ID + integer, dimension(:), intent(in) :: varID ! (1) ~ tvair, (2) ~ pmb + integer :: j, ncok + character(len=10) dummy + + write(dummy,11) varID(1) +11 format(i2) + ncok = NF90_PUT_ATT(ncid, nf90_global, "Title", "Forcing for define_air subroutine") + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'def att ', ncfile_in) + ncok = NF90_PUT_ATT(ncid, varID(3), "longname", "air temperature within canopy") + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'def att ', dummy) + ncok = NF90_PUT_ATT(ncid, varID(3), "units", "K") + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'def att ', dummy) + + write(dummy,11) varID(2) + + + return + end subroutine def_var_atts + + + subroutine put_var_ncr1(ncid, var_name, var ) + use netcdf + use cable_def_types_mod, only : mp + implicit none + character(len=*), intent(in) :: var_name + real, dimension(:),intent(in) :: var + integer, intent(in) :: ncid + integer :: ncok, varID,j + + ncok = NF90_INQ_VARID(ncid, var_name, varId ) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'inquire var ', var_name) + + ncok = NF90_PUT_VAR(ncid, varId, var, start=(/1/), & + count=(/mp/) ) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'putting var ', var_name) + + end subroutine put_var_ncr1 + + + subroutine put_var_ncr2(ncid, var_name, var, n_call ) + use netcdf + use cable_def_types_mod, only : r_2, mp + implicit none + character(len=*), intent(in) :: var_name + real(r_2), dimension(:),intent(in) :: var + integer, intent(in) :: ncid, n_call + integer :: ncok, varID + + ncok = NF90_INQ_VARID(ncid, var_name, varId ) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'inquire var ', var_name) + + ncok = NF90_PUT_VAR(ncid, varId, var, start=(/1,n_call /), & + count=(/mp,1/) ) + + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'putting var ', var_name) + + end subroutine put_var_ncr2 + + !soil vars + subroutine put_var_ncr3(ncid, var_name, var, n_call, nl) + use netcdf + use cable_def_types_mod, only : r_2, mp, ms + implicit none + character(len=*), intent(in) :: var_name + real(r_2), dimension(:,:),intent(in) :: var + integer, intent(in) :: ncid, n_call, nl + integer :: ncok, varID + + ncok = NF90_INQ_VARID( ncid, var_name, varId ) + IF( ncok /= nf90_noerr ) call stderr_nc(ncok,'inquire var ', var_name ) + + ncok = NF90_PUT_VAR(ncid, varId, var, start=(/1,1,n_call /), & + count=(/mp,nl,1/)) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'putting var ', var_name) + + return + end subroutine put_var_ncr3 + + + + subroutine get_var_ncr2(ncid, var_name, var, n_call ) + use netcdf + use cable_def_types_mod, only : r_2,mp + implicit none + character(len=*), intent(in) :: var_name + real(r_2), dimension(:),intent(out) :: var + integer, intent(in) :: ncid + integer :: ncok, varID, n_call + real, dimension(mp) :: temp + + temp = 0. + + ncok = NF90_INQ_VARID(ncid, var_name, varId ) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'inquire var ', var_name) + ncok = NF90_GET_VAR(ncid, varId, temp, start=(/1,n_call/), & + count=(/mp,1/) ) + + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'getting var ', var_name) + + var = real( temp, r_2 ) + end subroutine get_var_ncr2 + + subroutine get_var_ncr3(ncid, var_name, var, n_call, nl ) + use netcdf + use cable_def_types_mod, only : r_2, mp, ms + implicit none + character(len=*), intent(in) :: var_name + real(r_2), dimension(:,:),intent(out) :: var + integer, intent(in) :: ncid, n_call, nl + integer :: ncok, varID + real, dimension(mp,1:nl) :: temp + + ncok = NF90_INQ_VARID(ncid, var_name, varId ) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'inquire var ', var_name) + + ncok = NF90_GET_VAR(ncid, varId, temp, start=(/1,1,n_call /), & + count=(/mp, nl, 1/)) + if (ncok /= nf90_noerr ) call stderr_nc(ncok,'putting var ', var_name) + var = real( temp, r_2 ) + end subroutine get_var_ncr3 + + SUBROUTINE HANDLE_ERR( status, msg ) + ! LN 06/2013 + USE netcdf + INTEGER :: status + CHARACTER(LEN=*), INTENT(IN),OPTIONAL :: msg + IF(status /= NF90_noerr) THEN + WRITE(*,*)"netCDF error:" + IF ( PRESENT( msg ) ) WRITE(*,*)msg + !#define Vanessas_common + !#ifdef Vanessas_common + WRITE(*,*) TRIM(NF90_strerror(INT(status,4))) + !#else + ! WRITE(*,*) "UM builds with -i8. Therefore call to nf90_strerror is ", & + ! " invalid. Quick fix to eliminate for now. Build NF90 with -i8, force -i4?" + !#endif + STOP -1 + END IF + END SUBROUTINE HANDLE_ERR + + SUBROUTINE GET_UNIT (IUNIT) + + ! Find an unused unit for intermediate use + ! PLEASE, use it ONLY when you OPEN AND CLOSE WITHIN THE SAME CALL + ! or there could be interferences with other files! + ! LN 05/2014 + + IMPLICIT NONE + + INTEGER,INTENT(OUT) :: IUNIT + INTEGER :: i + LOGICAL :: is_open = .FALSE. + + DO i = 200, 10000 + INQUIRE ( UNIT=i, OPENED=is_open ) + IF ( .NOT. is_open ) EXIT + END DO + IUNIT = i + + END SUBROUTINE GET_UNIT + + + + + subroutine stderr_nc(status,message, var) + use netcdf + character(len=*), intent(in) :: message, var + INTEGER, INTENT(IN) :: status + character(len=7) :: err_mess + err_mess = 'ERROR:' + print *, (err_mess//message), var + PRINT*,NF90_STRERROR(status) + stop + end subroutine stderr_nc +#endif + SUBROUTINE YMDHMS2DOYSOD( YYYY,MM,DD,HOUR,MINUTE,SECOND,DOY,SOD ) +USE cable_common_module, ONLY: IS_LEAPYEAR + + ! Compute Day-of-year and second-of-day from given date and time or + + IMPLICIT NONE + + INTEGER,INTENT(IN) :: YYYY,MM,DD,HOUR,MINUTE,SECOND + INTEGER,INTENT(OUT) :: DOY,SOD + + ! LOGICAL :: IS_LEAPYEAR + INTEGER, DIMENSION(12) :: MONTH = (/ 31,28,31,30,31,30,31,31,30,31,30,31 /) + + IF ( IS_LEAPYEAR( YYYY ) ) MONTH(2) = 29 + + IF ( DD .GT. MONTH(MM) .OR. DD .LT. 1 .OR. & + MM .GT. 12 .OR. MM .LT. 1 ) THEN + WRITE(*,*)"Wrong date entered in YMDHMS2DOYSOD " + WRITE(*,*)"DATE : ",YYYY,MM,DD + STOP + ENDIF + DOY = DD + IF ( MM .GT. 1 ) DOY = DOY + SUM( MONTH( 1:MM-1 ) ) + SOD = HOUR * 3600 + MINUTE * 60 + SECOND + + END SUBROUTINE YMDHMS2DOYSOD + + SUBROUTINE DOYSOD2YMDHMS( YYYY,DOY,SOD,MM,DD,HOUR,MINUTE,SECOND ) +USE cable_common_module, ONLY: IS_LEAPYEAR + + ! Compute Day-of-year and second-of-day from given date and time or + + IMPLICIT NONE + + INTEGER,INTENT(IN) :: YYYY,DOY,SOD + INTEGER,INTENT(OUT) :: MM,DD + INTEGER,INTENT(OUT),OPTIONAL :: HOUR,MINUTE,SECOND + + ! LOGICAL :: IS_LEAPYEAR + INTEGER :: MON, i + INTEGER, DIMENSION(12) :: MONTH = (/ 31,28,31,30,31,30,31,31,30,31,30,31 /) + + IF ( IS_LEAPYEAR( YYYY ) ) MONTH(2) = 29 + + IF ( SOD .GE. 86400 .OR. SOD .LT. 0 .OR. & + DOY .GT. SUM(MONTH) .OR. DOY .LT. 1 ) THEN + WRITE(*,*)"Wrong date entered in DOYSOD2YMDHMS " + WRITE(*,*)"YYYY DOY SOD : ",YYYY,DOY,SOD + STOP + ENDIF + + MON = 0 + DO i = 1, 12 + IF ( MON + MONTH(i) .LT. DOY ) THEN + MON = MON + MONTH(i) + ELSE + MM = i + DD = DOY - MON + EXIT + ENDIF + END DO + IF ( PRESENT ( HOUR ) ) HOUR = INT( REAL(SOD)/3600. ) + IF ( PRESENT (MINUTE) ) MINUTE = INT( ( REAL(SOD) - REAL(HOUR)*3600.) / 60. ) + IF ( PRESENT (SECOND) ) SECOND = SOD - HOUR*3600 - MINUTE*60 + + END SUBROUTINE DOYSOD2YMDHMS + + FUNCTION IS_CASA_TIME(iotype, yyyy, ktau, kstart, koffset, kend, ktauday, logn) + + USE cable_common_module, ONLY: CABLE_USER + ! Correctly determine if it is time to dump-read or standard-write + ! casa output from cable_serial. + ! Writing casa-dump data is handled in casa_cable and therefore not \ + ! captured here + !cable_common module was intended to be unequivocally common to all + !applications. iovars is an offline module and so not appropriate to include + !here. Suggested FIX is to move decs of vars needed (e.g. leaps) to here, and + !then use common in iovars +#ifdef Vanessas_common + USE cable_IO_vars_module, ONLY: leaps +#endif + IMPLICIT NONE + + LOGICAL :: IS_CASA_TIME + INTEGER ,INTENT(IN) :: yyyy, ktau, kstart, koffset, kend, ktauday, logn + CHARACTER,INTENT(IN) :: iotype*5 + LOGICAL :: is_eod, is_eom, is_eoy + INTEGER :: doy, m + INTEGER, DIMENSION(12) :: MONTH + + is_eom = .FALSE. + is_eoy = .FALSE. + IS_CASA_TIME = .FALSE. + + MONTH = (/ 31,28,31,30,31,30,31,31,30,31,30,31 /) + is_eod = ( MOD((ktau-kstart+1+koffset),ktauday).EQ.0 ) + IF ( .NOT. is_eod ) RETURN ! NO if it is not end of day + +#ifdef Vanessas_common + IF ( IS_LEAPYEAR( YYYY ) .AND. leaps ) THEN + MONTH(2) = 29 + ELSE + MONTH(2) = 28 + ENDIF +#endif + + ! Check for reading from dump-file (hard-wired to daily casa-timestep) + IF ( iotype .EQ. "dread" ) THEN + IF ( CABLE_USER%CASA_DUMP_READ ) IS_CASA_TIME = .TRUE. + ! Check for writing of casa dump output + ELSE IF ( iotype .EQ. "dwrit" ) THEN + IF ( CABLE_USER%CASA_DUMP_WRITE ) IS_CASA_TIME = .TRUE. + ! Check for writing of casa standard output + ELSE IF ( iotype .EQ. "write" ) THEN + + doy = NINT(REAL(ktau-kstart+1+koffset)/REAL(ktauday)) + DO m = 1, 12 + IF ( doy .EQ. SUM(MONTH(1:m)) ) THEN + is_eom = .TRUE. + IF ( m .EQ. 12 ) is_eoy = .TRUE. + EXIT + ENDIF + END DO + + SELECT CASE ( TRIM(CABLE_USER%CASA_OUT_FREQ) ) + CASE ("daily" ) ; IS_CASA_TIME = .TRUE. + CASE ("monthly" ) ; IF ( is_eom ) IS_CASA_TIME = .TRUE. + CASE ("annually") ; IF ( is_eoy ) IS_CASA_TIME = .TRUE. + END SELECT + ELSE + WRITE(logn,*)"Wrong statement 'iotype'", iotype, "in call to IS_CASA_TIME" + WRITE(* ,*)"Wrong statement 'iotype'", iotype, "in call to IS_CASA_TIME" + STOP -1 + ENDIF + + END FUNCTION IS_CASA_TIME + + + +END MODULE casa_ncdf_module + + + diff --git a/src/coupled/esm16/casa_offline_inout.F90 b/src/coupled/esm16/casa_offline_inout.F90 new file mode 100644 index 000000000..c56c8861f --- /dev/null +++ b/src/coupled/esm16/casa_offline_inout.F90 @@ -0,0 +1,1472 @@ +!============================================================================== +! 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: Input and output code for CASA-CNP when run offline +! ACCESS version may use some of this code but split into different files? +! +! Contact: Yingping.Wang@csiro.au and Bernard.Pak@csiro.au +! +! History: Developed for offline code. Expect to re-write for MPI and ACCESS +! versions +! +! +! ============================================================================== +! casa_inout.f90 +! +! the following routines are used when "casacnp" is coupled to "cable" +! casa_readbiome +! casa_readphen +! casa_readpoint (removed, now done in parameter_module) +! casa_init +! casa_poolout +! casa_cnpflux (zeros casabal quantites on doy 1 and updates casabal at end of biogeochem) +! biogeochem +!CABLE_LSM:This has to be commented for offline +!#define UM_BUILD YES +MODULE casa_offline_inout_module + +USE casavariable, ONLY : casafile + +CONTAINS + +#ifndef UM_BUILD + SUBROUTINE WRITE_CASA_RESTART_NC ( casamet, casapool, casaflux, phen, CASAONLY ) + + USE casavariable, ONLY : casa_met, casa_pool, casa_flux, icycle, mplant, mlitter, msoil + USE cable_common_module + USE casa_ncdf_module, ONLY: HANDLE_ERR + + USE cable_def_types_mod, ONLY: met_type, mp + USE phenvariable + USE netcdf + + IMPLICIT NONE + + + TYPE (casa_met), INTENT(IN) :: casamet + TYPE (casa_pool), INTENT(IN) :: casapool + TYPE (casa_flux), INTENT(IN) :: casaflux + TYPE (phen_variable), INTENT(IN) :: phen + + INTEGER*4 :: mp4 + INTEGER*4, PARAMETER :: pmp4 =0 + INTEGER, PARAMETER :: fmp4 = KIND(pmp4) + INTEGER*4 :: STATUS + INTEGER*4 :: FILE_ID, land_ID, plnt_ID, litt_ID, soil_ID, i + LOGICAL :: CASAONLY + CHARACTER :: CYEAR*4, FNAME*99,dum*50 + + ! ! 1 dim arrays (npt ) + ! CHARACTER(len=20),DIMENSION(7), PARAMETER :: A1 = (/ 'latitude', 'longitude', 'glai', & + ! 'clabile', 'psoillab','psoilsorb','psoilocc' /) + ! ! 2 dim arrays (npt,mplant) + ! CHARACTER(len=20),DIMENSION(3), PARAMETER :: A2 = (/ 'cplant' , 'nplant' , 'pplantc' /) + ! ! 2 dim arrays (npt,mlitter) + ! CHARACTER(len=20),DIMENSION(3), PARAMETER :: A3 = (/ 'clitter', 'nlitter', 'plitter' /) + ! ! 2 dim arrays (npt,msoil) + ! CHARACTER(len=20),DIMENSION(3), PARAMETER :: A4 = (/ 'csoil', 'nsoil', 'psoil' /) + + ! 1 dim arrays (npt ) + CHARACTER(len=20),DIMENSION(12) :: A1 + CHARACTER(len=20),DIMENSION(2) :: AI1 + ! 2 dim arrays (npt,mplant) + CHARACTER(len=20),DIMENSION(3) :: A2 + ! 2 dim arrays (npt,mlitter) + CHARACTER(len=20),DIMENSION(3) :: A3 + ! 2 dim arrays (npt,msoil) + CHARACTER(len=20),DIMENSION(3) :: A4 + INTEGER*4 :: VID1(SIZE(A1)), VIDI1(SIZE(AI1)), VID2(SIZE(A2)), VID3(SIZE(A3)), VID4(SIZE(A4)) + + mp4=INT(mp,fmp4) + A1(1) = 'latitude' + A1(2) = 'longitude' + A1(3) = 'glai' + A1(4) = 'clabile' + A1(5) = 'psoillab' + A1(6) = 'psoilsorb' + A1(7) = 'psoilocc' + A1(8) = 'frac_sapwood' + A1(9) = 'sapwood_area' + A1(10) = 'phen' + A1(11) = 'aphen' + A1(12) = 'nsoilmin' + + AI1(1) = 'phase' + AI1(2) = 'doyphase3' + + + A2(1) = 'cplant' + A2(2) = 'nplant' + A2(3) = 'pplant' + A3(1) = 'clitter' + A3(2) = 'nlitter' + A3(3) = 'plitter' + A4(1) = 'csoil' + A4(2) = 'nsoil' + A4(3) = 'psoil' + + ! Get File-Name + WRITE(CYEAR, FMT='(I4)') CurYear + 1 + + IF (LEN( TRIM(casafile%cnpepool) ) .GT. 0) THEN + fname=TRIM(casafile%cnpepool) + ELSE + fname = TRIM(filename%path)//'/'//TRIM( cable_user%RunIden )//& + '_casa_rst.nc' + ENDIF + ! Create NetCDF file: + STATUS = NF90_create(fname, NF90_CLOBBER, FILE_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + WRITE(*,*) 'writing casa restart', fname + ! Put the file in define mode: + STATUS = NF90_redef(FILE_ID) + + STATUS = NF90_PUT_ATT( FILE_ID, NF90_GLOBAL, "Valid restart date", "01/01/"//CYEAR ) + STATUS = NF90_PUT_ATT( FILE_ID, NF90_GLOBAL, "Icycle", icycle ) + IF ( CASAONLY ) THEN + dum = 'CASA-ONLY run' + ELSE + dum = 'CABLE-CASA coupled run' + ENDIF + STATUS = NF90_PUT_ATT( FILE_ID, NF90_GLOBAL, "Run-Type", TRIM(dum) ) + + ! Define dimensions: + ! Land (number of points) + STATUS = NF90_def_dim(FILE_ID, 'land' , mp4 , land_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_def_dim(FILE_ID, 'mplant' , mplant , plnt_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_def_dim(FILE_ID, 'mlitter', mlitter, litt_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_def_dim(FILE_ID, 'msoil' , msoil , soil_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + DO i = 1, SIZE(A1) + STATUS = NF90_def_var(FILE_ID,TRIM(A1(i)) ,NF90_FLOAT,(/land_ID/),VID1(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + DO i = 1, SIZE(AI1) + STATUS = NF90_def_var(FILE_ID,TRIM(AI1(i)) ,NF90_INT,(/land_ID/),VIDI1(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + DO i = 1, SIZE(A2) + STATUS = NF90_def_var(FILE_ID,TRIM(A2(i)) ,NF90_FLOAT,(/land_ID,plnt_ID/),VID2(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + DO i = 1, SIZE(A3) + STATUS = NF90_def_var(FILE_ID,TRIM(A3(i)) ,NF90_FLOAT,(/land_ID,litt_ID/),VID3(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + DO i = 1, SIZE(A4) + STATUS = NF90_def_var(FILE_ID,TRIM(A4(i)) ,NF90_FLOAT,(/land_ID,soil_ID/),VID4(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + ! End define mode: + STATUS = NF90_enddef(FILE_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + ! PUT LAT / LON + STATUS = NF90_PUT_VAR(FILE_ID, VID1(1), casamet%lat ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID1(2), casamet%lon ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + ! PUT VARS + STATUS = NF90_PUT_VAR(FILE_ID, VID1(3), casamet%glai ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID1(4), casapool%clabile ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + + STATUS = NF90_PUT_VAR(FILE_ID, VID1(8), casaflux%frac_sapwood ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID1(9), casaflux%sapwood_area ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID1(10), phen%phen ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID1(11), phen%aphen ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID1(12), casapool%Nsoilmin ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VIDI1(1), phen%phase ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VIDI1(2), phen%doyphase(:,3) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID2(1), casapool%cplant ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID2(2), casapool%nplant ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(1), casapool%clitter ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(2), casapool%nlitter ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(1), casapool%csoil ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(2), casapool%nsoil ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID1(5), casapool%psoillab ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID1(6), casapool%psoilsorb ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID1(7), casapool%psoilocc ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(3), casapool%psoil ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID2(3), casapool%pplant ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(3), casapool%plitter ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + ! Close NetCDF file: + STATUS = NF90_close(FILE_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + END SUBROUTINE WRITE_CASA_RESTART_NC + +#ifndef UM_BUILD + SUBROUTINE READ_CASA_RESTART_NC ( casamet, casapool, casaflux,phen ) + + USE CASAVARIABLE + USE phenvariable + USE CABLE_COMMON_MODULE + USE casa_ncdf_module, ONLY: HANDLE_ERR + USE CABLE_DEF_TYPES_MOD, ONLY: MET_TYPE, r_2, mp + USE netcdf + + IMPLICIT NONE + + !INTEGER, INTENT(in) :: YEAR + TYPE (casa_met) , INTENT(inout) :: casamet + TYPE (casa_pool), INTENT(inout) :: casapool + TYPE (casa_flux), INTENT(inout) :: casaflux + TYPE (phen_variable), INTENT(INOUT) :: phen + + INTEGER*4 :: mp4 + INTEGER*4, PARAMETER :: pmp4 =0 + INTEGER, PARAMETER :: fmp4 = KIND(pmp4) + INTEGER*4 :: STATUS, i + INTEGER*4 :: FILE_ID, dID, land_dim, mp_dim, ml_dim, ms_dim, mw_dim + CHARACTER :: FRST_IN*99, CYEAR*4, CDATE*12, RSTDATE*12, FNAME*99 + + ! ! 1 dim arrays (npt ) + ! CHARACTER(len=20),DIMENSION(7), PARAMETER :: A1 = (/ 'latitude', 'longitude', 'glai', & + ! 'clabile', 'psoillab','psoilsorb','psoilocc' /) + ! ! 2 dim arrays (npt,mplant) + ! CHARACTER(len=20),DIMENSION(3), PARAMETER :: A2 = (/ 'cplant' , 'nplant' , 'pplantc' /) + ! ! 2 dim arrays (npt,mlitter) + ! CHARACTER(len=20),DIMENSION(3), PARAMETER :: A3 = (/ 'clitter', 'nlitter', 'plitter' /) + ! ! 2 dim arrays (npt,msoil) + ! CHARACTER(len=20),DIMENSION(3), PARAMETER :: A4 = (/ 'csoil', 'nsoil', 'psoil' /) + REAL(r_2), DIMENSION(mp) :: LAT, LON, TMP + REAL(r_2) :: TMP2(mp,mplant),TMP3(mp,mlitter),TMP4(mp,msoil) + + ! 1 dim arrays (npt ) + CHARACTER(len=20),DIMENSION(12) :: A1 + CHARACTER(len=20),DIMENSION(2) :: AI1 + ! 2 dim arrays (npt,mplant) + CHARACTER(len=20),DIMENSION(3) :: A2 + ! 2 dim arrays (npt,mlitter) + CHARACTER(len=20),DIMENSION(3) :: A3 + ! 2 dim arrays (npt,msoil) + CHARACTER(len=20),DIMENSION(3) :: A4 + ! 2-d array (npt,mwood) + CHARACTER(len=20),DIMENSION(3) :: A5 + + INTEGER :: VID1(SIZE(A1)), VID2(SIZE(A2)), VID3(SIZE(A3)), VID4(SIZE(A4)) + LOGICAL :: EXISTFILE, EXISTFILE1 + mp4=INT(mp,fmp4) + A1(1) = 'latitude' + A1(2) = 'longitude' + A1(3) = 'glai' + A1(4) = 'clabile' + A1(5) = 'psoillab' + A1(6) = 'psoilsorb' + A1(7) = 'psoilocc' + A1(8) = 'frac_sapwood' + A1(9) = 'sapwood_area' + A1(10) = 'phen' + A1(11) = 'aphen' + A1(12) = 'nsoilmin' + + AI1(1) = 'phase' + AI1(2) = 'doyphase3' + + A2(1) = 'cplant' + A2(2) = 'nplant' + A2(3) = 'pplant' + A3(1) = 'clitter' + A3(2) = 'nlitter' + A3(3) = 'plitter' + A4(1) = 'csoil' + A4(2) = 'nsoil' + A4(3) = 'psoil' + + A5(1) = 'cwoodprod' + A5(2) = 'nwoodprod' + A5(3) = 'pwoodprod' + + + + !fname = TRIM(filename%path)//'/'//TRIM( cable_user%RunIden )//& + ! '_casa_rst.nc' + fname = TRIM(casafile%cnpipool) + INQUIRE( FILE=TRIM(fname), EXIST=EXISTFILE ) + IF (EXISTFILE) THEN + STATUS = NF90_OPEN( TRIM(fname), NF90_NOWRITE, FILE_ID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + PRINT *, 'initial pool from restart file: ', fname + ELSE + WRITE(*,*) 'CASA restart file:', TRIM(fname), ' does not exist' + fname = TRIM(filename%path)//'/'//TRIM( cable_user%RunIden )//& + '_casa_rst.nc' + INQUIRE( FILE=TRIM(fname), EXIST=EXISTFILE1 ) + IF (EXISTFILE1) THEN + STATUS = NF90_OPEN( TRIM(fname), NF90_NOWRITE, FILE_ID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + PRINT *, 'initial pool from restart file: ', fname + ELSE + WRITE(*,*) 'CASA restart file:', TRIM(fname), ' does not exist either' + WRITE(*,*) 'Set cable_user%CASA_fromZero to true to initialise without restart file.' + WRITE(*,*) 'Otherwise set casafile%cnpipool to netcdf restart file name in cable.nml' + STOP + ENDIF + ENDIF + + ! TIME + STATUS = NF90_GET_ATT( FILE_ID, NF90_GLOBAL, "Valid restart date", RSTDATE ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) +!!$ + WRITE(CYEAR, FMT="(I4)") CurYear + CDATE = '01/01/'//CYEAR + ! compare current year with restart year (only for non-site type met data) + IF ( CDATE .NE. RSTDATE .AND. & + TRIM(cable_user%MetType).NE.'' .AND. TRIM(cable_user%MetType).NE.'site' ) THEN + WRITE(*,*)"Restart Date in rst file doesn't match start date of Run!" + WRITE(*,*)"File: "//RSTDATE//' Run: '//CDATE + ! STOP + ENDIF + + ! DIMS + STATUS = NF90_INQ_DIMID( FILE_ID, 'land', dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_INQUIRE_DIMENSION( FILE_ID, dID, LEN=land_dim ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + STATUS = NF90_INQ_DIMID( FILE_ID, 'mplant', dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_INQUIRE_DIMENSION( FILE_ID, dID, LEN=mp_dim ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + STATUS = NF90_INQ_DIMID( FILE_ID, 'mlitter', dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_INQUIRE_DIMENSION( FILE_ID, dID, LEN=ml_dim ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + STATUS = NF90_INQ_DIMID( FILE_ID, 'msoil', dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_INQUIRE_DIMENSION( FILE_ID, dID, LEN=ms_dim ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + if(l_landuse) then + STATUS = NF90_INQ_DIMID( FILE_ID, 'mwood', dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_INQUIRE_DIMENSION( FILE_ID, dID, LEN=mw_dim ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + endif + + IF ( land_dim .NE. SIZE(casamet%lon) .OR. mp_dim .NE. mplant .OR. & + ml_dim .NE. mlitter .OR. ms_dim .NE. msoil ) THEN + WRITE(*,*)"Dimension misfit!" + WRITE(*,*)"Restart file Run" + WRITE(*,*)"# points ",land_dim," ",SIZE(casamet%lon) + WRITE(*,*)"# mplant ",mp_dim," ",mplant + WRITE(*,*)"# mlitter ",ml_dim," ",mlitter + WRITE(*,*)"# msoil ",ms_dim," ",msoil + STOP + ENDIF + + ! LAT & LON + STATUS = NF90_INQ_VARID( FILE_ID, A1(1), dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_GET_VAR( FILE_ID, dID, LAT ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + STATUS = NF90_INQ_VARID( FILE_ID, A1(2), dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_GET_VAR( FILE_ID, dID, LON ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + ! CHECK FOR VALID LONS + + ! READ 1-dimensional fields + DO i = 3, SIZE(A1) + STATUS = NF90_INQ_VARID( FILE_ID, A1(i), dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_GET_VAR( FILE_ID, dID, TMP ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + SELECT CASE ( TRIM(A1(i))) + CASE ('glai' ) ; casamet%glai = TMP + CASE ('clabile' ) ; casapool%clabile = TMP + CASE ('frac_sapwood' ) ; casaflux%frac_sapwood = TMP + CASE ( 'sapwood_area' ) ; casaflux%sapwood_area = TMP + CASE ( 'phen' ) ; phen%phen = TMP + CASE ( 'aphen' ) ; phen%aphen = TMP + CASE ( 'nsoilmin' ) ; casapool%Nsoilmin = TMP + END SELECT + END DO + IF (icycle==3) THEN + DO i = 3, SIZE(A1) + STATUS = NF90_INQ_VARID( FILE_ID, A1(i), dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_GET_VAR( FILE_ID, dID, TMP ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + SELECT CASE ( TRIM(A1(i))) + CASE ('psoillab' ) ; casapool%psoillab = TMP + CASE ('psoilsorb' ) ; casapool%psoilsorb = TMP + CASE ('psoilocc' ) ; casapool%psoilocc = TMP + END SELECT + END DO + ENDIF + + DO i = 1, SIZE(AI1) + STATUS = NF90_INQ_VARID( FILE_ID, AI1(i), dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_GET_VAR( FILE_ID, dID, TMP ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + SELECT CASE ( TRIM(AI1(i))) + CASE ( 'phase' ) ; phen%phase = TMP + CASE ( 'doyphase3' ) ; phen%doyphase(:,3) = TMP + END SELECT + END DO + + ! READ 2-dimensional fields (mplant) + DO i = 1, SIZE(A2) + STATUS = NF90_INQ_VARID( FILE_ID, A2(i), dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_GET_VAR( FILE_ID, dID, TMP2 ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + SELECT CASE ( TRIM(A2(i))) + CASE ('cplant' ) ; casapool%cplant = TMP2 + CASE ('nplant' ) ; casapool%nplant = TMP2 + END SELECT + END DO + + + IF (icycle==3) THEN + DO i = 1, SIZE(A2) + STATUS = NF90_INQ_VARID( FILE_ID, A2(i), dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_GET_VAR( FILE_ID, dID, TMP2 ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + SELECT CASE ( TRIM(A2(i))) + CASE ('pplant' ) ; casapool%pplant = TMP2 + END SELECT + END DO + ENDIF + + ! READ 2-dimensional fields (mlitter) + DO i = 1, SIZE(A3) + STATUS = NF90_INQ_VARID( FILE_ID, A3(i), dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_GET_VAR( FILE_ID, dID, TMP3 ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + SELECT CASE ( TRIM(A3(i))) + CASE ('clitter' ) ; casapool%clitter = TMP3 + CASE ('nlitter' ) ; casapool%nlitter = TMP3 + END SELECT + END DO + + IF (icycle==3) THEN + + DO i = 1, SIZE(A3) + STATUS = NF90_INQ_VARID( FILE_ID, A3(i), dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_GET_VAR( FILE_ID, dID, TMP3 ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + SELECT CASE ( TRIM(A3(i))) + CASE ('plitter' ) ; casapool%plitter = TMP3 + END SELECT + END DO + + + ENDIF + + ! READ 2-dimensional fields (msoil) + DO i = 1, SIZE(A4) + STATUS = NF90_INQ_VARID( FILE_ID, A4(i), dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_GET_VAR( FILE_ID, dID, TMP4 ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + SELECT CASE ( TRIM(A4(i))) + CASE ('csoil' ) ; casapool%csoil = TMP4 + CASE ('nsoil' ) ; casapool%nsoil = TMP4 + END SELECT + END DO + + if(l_landuse) then + + DO i = 1, SIZE(A5) + STATUS = NF90_INQ_VARID( FILE_ID, A5(i), dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_GET_VAR( FILE_ID, dID, TMP4 ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + SELECT CASE ( TRIM(A4(i))) + CASE ('cwoodprod' ) ; casapool%cwoodprod = TMP4 + CASE ('nwoodprod' ) ; casapool%nwoodprod = TMP4 + CASE ('pwoodprod' ) ; casapool%pwoodprod = TMP4 + END SELECT + END DO + + endif + + IF (icycle==3) THEN + DO i = 1, SIZE(A4) + STATUS = NF90_INQ_VARID( FILE_ID, A4(i), dID ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_GET_VAR( FILE_ID, dID, TMP4 ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + SELECT CASE ( TRIM(A4(i))) + CASE ('psoil' ) ; casapool%psoil = TMP4 + END SELECT + END DO + ENDIF + + STATUS = NF90_CLOSE( FILE_ID ) + + END SUBROUTINE READ_CASA_RESTART_NC +#endif + SUBROUTINE WRITE_CASA_OUTPUT_NC ( veg, casamet, casapool, casabal, casaflux, & + CASAONLY, ctime, FINAL ) + + USE CASAVARIABLE + USE CABLE_COMMON_MODULE + USE casa_ncdf_module, ONLY: HANDLE_ERR + + + USE cable_def_types_mod, ONLY: veg_parameter_type + + USE netcdf + + IMPLICIT NONE + + TYPE (casa_met) , INTENT(in) :: casamet + TYPE (casa_pool), INTENT(in) :: casapool + TYPE (casa_balance),INTENT(in) :: casabal + TYPE (casa_flux), INTENT(in) :: casaflux + TYPE (veg_parameter_type), INTENT(IN) :: veg ! vegetation parameters + + INTEGER :: STATUS, ctime + INTEGER :: land_ID, plnt_ID, litt_ID, soil_ID, t_ID, i + LOGICAL :: CASAONLY, FINAL + CHARACTER :: CYEAR*4, FNAME*99,dum*50 + LOGICAL, SAVE :: CALL1 = .TRUE. + + ! ! 1 dim arrays (mp ) + ! CHARACTER(len=20),DIMENSION(2), PARAMETER :: A0 = (/ 'latitude', 'longitude' /) + ! ! 2 dim arrays (mp,t) + ! CHARACTER(len=20),DIMENSION(44),PARAMETER :: A1 = (/ 'glai', 'clabile', & + ! 'psoillab','psoilsorb','psoilocc', 'sumcbal','sumnbal','sumpbal','Cgpp',& + ! 'Cnpp','stemnpp','Crp','Crgplant','Nminfix','Plabuptake','Clabloss', & + ! 'fraclabile','Cnep','Crsoil','Nmindep','Nminloss','Nminleach', & + ! 'Nupland','Nlittermin','Nsmin','Nsnet','fNMinloss','fNMinleach','Pdep', & + ! 'pwea','Pleach','Ploss','Pupland','Plittermin','Psmin','Psimm','Psnet', & + ! 'fPleach','kPlab','kPsorb','kpocc','kmlabP','Psorbmax','FluxCtoco2'/) + ! ! 3 dim arrays (mp,mplant,t) + ! CHARACTER(len=20),DIMENSION(8), PARAMETER :: A2 = (/ 'cplant' , 'nplant' , & + ! 'pplantc','fracCalloc','fracNalloc','fracPalloc','kplant','Crmplant'/) + ! ! 3 dim arrays (mp,mlitter,t) + ! CHARACTER(len=20),DIMENSION(8), PARAMETER :: A3 = (/ 'clitter', 'nlitter', & + ! 'plitter','klitter','fromL2CO2','FluxCtolitter','FluxNtolitter', & + ! 'FluxPtolitter' /) + ! ! 3 dim arrays (mp,msoil,t) + ! CHARACTER(len=20),DIMENSION(8), PARAMETER :: A4 = (/ 'csoil','nsoil','psoil',& + ! 'ksoil','fromStoCO2','FluxCtosoil','FluxNtosoil','FluxPxtosoil'/) + + ! 1 dim arrays (mp ) + CHARACTER(len=20),DIMENSION(2) :: A0 + ! 2 dim arrays (mp,t) + CHARACTER(len=20),DIMENSION(51):: A1 + ! 3 dim arrays (mp,mplant,t) + CHARACTER(len=20),DIMENSION(8) :: A2 + ! 3 dim arrays (mp,mlitter,t) + CHARACTER(len=20),DIMENSION(8) :: A3 + ! 3 dim arrays (mp,msoil,t) + CHARACTER(len=20),DIMENSION(8) :: A4 + + ! 4 dim arrays (mp,mlitter,mplant,t) + CHARACTER(len=20),DIMENSION(1), PARAMETER :: A5 = (/ 'fromPtoL'/) + ! 4 dim arrays (mp,msoil,mlitter,t) + CHARACTER(len=20),DIMENSION(1), PARAMETER :: A6 = (/ 'fromLtoS'/) + ! 4 dim arrays (mp,msoil,msoil,t) + CHARACTER(len=20),DIMENSION(1), PARAMETER :: A7 = (/ 'fromStoS'/) + + INTEGER, SAVE :: VIDtime, VID0(SIZE(A0)),VID1(SIZE(A1)),VID2(SIZE(A2)),VID3(SIZE(A3)) + INTEGER, SAVE :: VID4(SIZE(A4)),VID5(SIZE(A5)),VID6(SIZE(A6)),VID7(SIZE(A7)) + INTEGER, SAVE :: FILE_ID, CNT = 0 + LOGICAL :: EXRST + CHARACTER(len=50) :: RecordDimName + ! temporary fixer: ypwang 10-6-2021 + REAL(r_2), DIMENSION(mp,mplant) :: tempFCrmyear + REAL(R_2), DIMENSION(mp) :: tempFCrgyear + + tempFCrmyear(:,1) = casabal%FCrmleafyear(:) ! leaf + tempFCrmyear(:,2) = casabal%FCrmwoodyear(:) ! wood + tempFCrmyear(:,3) = casabal%FCrmrootyear(:) ! froot + tempFCrgyear(:) = casabal%FCrgrowyear(:) + + + + A0(1) = 'latitude' + A0(2) = 'longitude' + + A1(1) = 'glai' + A1(2) = 'clabile' + A1(3) = 'psoillab' + A1(4) = 'psoilsorb' + A1(5) = 'psoilocc' + A1(6) = 'sumcbal' + A1(7) = 'sumnbal' + A1(8) = 'sumpbal' + A1(9) = 'Cgpp' + A1(10) = 'Cnpp' + A1(11) = 'stemnpp' + A1(12) = 'Crp' + A1(13) = 'Crgplant' + A1(14) = 'Nminfix' + A1(15) = 'Plabuptake' + A1(16) = 'Clabloss' + A1(17) = 'fraclabile' + A1(18) = 'Cnep' + A1(19) = 'Crsoil' + A1(20) = 'Nmindep' + A1(21) = 'Nminloss' + A1(22) = 'Nminleach' + A1(23) = 'Nupland' + A1(24) = 'Nlittermin' + A1(25) = 'Nsmin' + A1(26) = 'Nsimm' + A1(27) = 'Nsnet' + A1(28) = 'fNMinloss' + A1(29) = 'Pdep' + A1(30) = 'pwea' + A1(31) = 'Pleach' + A1(32) = 'Ploss' + A1(33) = 'Pupland' + A1(34) = 'Plittermin' + A1(35) = 'Psmin' + A1(36) = 'Psimm' + A1(37) = 'Psnet' + A1(38) = 'fPleach' + A1(39) = 'kPlab' + A1(40) = 'kPsorb' + A1(41) = 'kpocc' + A1(42) = 'kmlabP' + A1(43) = 'Psorbmax' + A1(44) = 'FluxCtoco2' + A1(45) = 'FCgppyear' + A1(46) = 'FCrpyear' + A1(47) = 'FCnppyear' + A1(48) = 'FCrsyear' + A1(49) = 'FCNeeyear' + A1(50) = 'vcmax' + A1(51) = 'Nsoilmin' + + A2(1) = 'cplant' + A2(2) = 'nplant' + A2(3) = 'pplant' + A2(4) = 'fracCalloc' + A2(5) = 'fracNalloc' + A2(6) = 'fracPalloc' + A2(7) = 'kplant' + A2(8) = 'Crmplant' + + A3(1) = 'clitter' + A3(2) = 'nlitter' + A3(3) = 'plitter' + A3(4) = 'klitter' + A3(5) = 'fromL2CO2' + A3(6) = 'FluxCtolitter' + A3(7) = 'FluxNtolitter' + A3(8) = 'FluxPtolitter' + + A4(1) = 'csoil' + A4(2) = 'nsoil' + A4(3) = 'psoil' + A4(4) = 'ksoil' + A4(5) = 'fromStoCO2' + A4(6) = 'FluxCtosoil' + A4(7) = 'FluxNtosoil' + A4(8) = 'FluxPxtosoil' + + + CNT = CNT + 1 + + IF ( CALL1 ) THEN + ! Get File-Name + + IF (TRIM(cable_user%MetType).NE.'' ) THEN + + WRITE( dum, FMT="(I4,'_',I4)")CABLE_USER%YEARSTART,CABLE_USER%YEAREND + IF (CABLE_USER%YEARSTART.LT.1000.AND.CABLE_USER%YEAREND.LT.1000) THEN + WRITE( dum, FMT="(I3,'_',I3)")CABLE_USER%YEARSTART,CABLE_USER%YEAREND + ELSEIF (CABLE_USER%YEARSTART.LT.1000) THEN + WRITE( dum, FMT="(I3,'_',I4)")CABLE_USER%YEARSTART,CABLE_USER%YEAREND + ENDIF + fname = TRIM(filename%path)//'/'//TRIM(cable_user%RunIden)//'_'//& + TRIM(dum)//'_casa_out.nc' + ELSE + ! site data + fname = TRIM(filename%path)//'/'//TRIM(cable_user%RunIden)//'_casa_out.nc' + ENDIF + INQUIRE( FILE=TRIM( fname ), EXIST=EXRST ) + EXRST = .FALSE. + IF ( EXRST ) THEN + STATUS = NF90_open(fname, mode=nf90_write, ncid=FILE_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + CALL1 = .FALSE. + + STATUS = nf90_inq_dimid(FILE_ID, 'time', t_id) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + !CRM status = nf90_inquire_dimension(FILE_ID, t_id,name = RecordDimName, len = CNT) + !CRM if (status /= nf90_noerr) call handle_err(status) + !CRM CNT = CNT+1 + + STATUS = nf90_inq_varid(FILE_ID, 'time', VIDTime) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + DO i = 1, SIZE(A0) + STATUS = nf90_inq_varid(FILE_ID,TRIM(A0(i)),VID0(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + DO i = 1, SIZE(A1) + STATUS = nf90_inq_varid(FILE_ID,TRIM(A1(i)), VID1(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + DO i = 1, SIZE(A2) + STATUS = nf90_inq_varid(FILE_ID,TRIM(A2(i)) , VID2(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + DO i = 1, SIZE(A3) + STATUS = nf90_inq_varid(FILE_ID,TRIM(A3(i)) ,VID3(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + DO i = 1, SIZE(A4) + STATUS = nf90_inq_varid(FILE_ID,TRIM(A4(i)) ,VID4(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + DO i = 1, SIZE(A5) + STATUS = nf90_inq_varid(FILE_ID,TRIM(A5(i)), VID5(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + DO i = 1, SIZE(A6) + STATUS = nf90_inq_varid(FILE_ID,TRIM(A6(i)), VID6(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + DO i = 1, SIZE(A7) + STATUS = nf90_inq_varid(FILE_ID,TRIM(A7(i)),VID7(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + ELSE + ! Create NetCDF file: + STATUS = NF90_create(fname, NF90_CLOBBER, FILE_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + ! Put the file in define mode: + STATUS = NF90_redef(FILE_ID) + + STATUS = NF90_PUT_ATT( FILE_ID, NF90_GLOBAL, "Icycle" , icycle ) + STATUS = NF90_PUT_ATT( FILE_ID, NF90_GLOBAL, "StartYear", CABLE_USER%YEARSTART ) + STATUS = NF90_PUT_ATT( FILE_ID, NF90_GLOBAL, "EndYear" , CABLE_USER%YEAREND ) + STATUS = NF90_PUT_ATT( FILE_ID, NF90_GLOBAL, "RunIden" , CABLE_USER%RunIden ) + IF ( CASAONLY ) THEN + dum = 'CASA-ONLY run' + ELSE + dum = 'CABLE-CASA coupled run' + ENDIF + STATUS = NF90_PUT_ATT( FILE_ID, NF90_GLOBAL, "Run-Type", TRIM(dum) ) + + ! Define dimensions: + ! Land (number of points) + STATUS = NF90_def_dim(FILE_ID, 'land' , mp , land_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_def_dim(FILE_ID, 'mplant' , mplant , plnt_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_def_dim(FILE_ID, 'mlitter', mlitter, litt_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_def_dim(FILE_ID, 'msoil' , msoil , soil_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + STATUS = NF90_def_dim(FILE_ID, 'time' , NF90_UNLIMITED, t_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + ! Define variables + STATUS = NF90_def_var(FILE_ID,'time' ,NF90_INT,(/t_ID/),VIDtime ) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + DO i = 1, SIZE(A0) + STATUS = NF90_def_var(FILE_ID,TRIM(A0(i)) ,NF90_FLOAT,(/land_ID/),VID0(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + DO i = 1, SIZE(A1) + STATUS = NF90_def_var(FILE_ID,TRIM(A1(i)) ,NF90_FLOAT,(/land_ID,t_ID/),VID1(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + DO i = 1, SIZE(A2) + STATUS = NF90_def_var(FILE_ID,TRIM(A2(i)) ,NF90_FLOAT,(/land_ID,plnt_ID,t_ID/),VID2(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + DO i = 1, SIZE(A3) + STATUS = NF90_def_var(FILE_ID,TRIM(A3(i)) ,NF90_FLOAT,(/land_ID,litt_ID,t_ID/),VID3(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + DO i = 1, SIZE(A4) + STATUS = NF90_def_var(FILE_ID,TRIM(A4(i)) ,NF90_FLOAT,(/land_ID,soil_ID,t_ID/),VID4(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + DO i = 1, SIZE(A5) + STATUS = NF90_def_var(FILE_ID,TRIM(A5(i)) ,NF90_FLOAT, & + (/land_ID,litt_ID,plnt_ID,t_ID/),VID5(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + DO i = 1, SIZE(A6) + STATUS = NF90_def_var(FILE_ID,TRIM(A6(i)) ,NF90_FLOAT, & + (/land_ID,soil_ID,litt_ID,t_ID/),VID6(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + DO i = 1, SIZE(A7) + STATUS = NF90_def_var(FILE_ID,TRIM(A7(i)) ,NF90_FLOAT, & + (/land_ID,soil_ID,soil_ID,t_ID/),VID7(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + END DO + + ! End define mode: + STATUS = NF90_enddef(FILE_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + + ! PUT LAT / LON ( mp ) + STATUS = NF90_PUT_VAR(FILE_ID, VID0(1), casamet%lat ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID0(2), casamet%lon ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + CALL1 = .FALSE. + ENDIF !( EXRST ) + ENDIF + + ! TIME ( t ) + STATUS = NF90_PUT_VAR(FILE_ID, VIDtime, ctime, start=(/ CNT /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + SELECT CASE(icycle) + CASE(1) + ! PUT 2D VARS ( mp, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 1), casamet%glai, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 2), casapool%clabile, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 6), casabal%sumcbal, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 7), casabal%sumnbal, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 9), casaflux%Cgpp, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(10), REAL(casaflux%Cnpp), start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(11), casaflux%stemnpp, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(12), casaflux%Crp, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID1(13), tempFCrgyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(16), casaflux%Clabloss, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(17), casaflux%fracClabile,start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(18), casaflux%Cnep, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(19), casaflux%Crsoil, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + + STATUS = NF90_PUT_VAR(FILE_ID, VID1(45), casabal%FCgppyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(46), casabal%FCrpyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(47), casabal%FCnppyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(48), casabal%FCrsyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(49), casabal%FCneeyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(50), veg%vcmax, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + ! PUT 3D VARS ( mp, mplant, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(1), casapool%cplant, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(4), casaflux%fracCalloc, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(7), casaflux%kplant, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(8), tempFCrmyear, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + ! PUT 3D VARS ( mp, mlitter, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID3(1), casapool%clitter, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(4), casaflux%klitter, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(5), casaflux%fromLtoCO2, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(6), casaflux%FluxCtolitter, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + + ! PUT 3D VARS ( mp, msoil, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID4(1), casapool%csoil, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(4), casaflux%ksoil, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(5), casaflux%fromStoCO2, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(6), casaflux%FluxCtosoil, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + + ! PUT 4D VARS ( mp, mlitter,mplant, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID5(1), casaflux%fromPtoL, & + start=(/ 1,1,1,CNT /), count=(/ mp,mlitter,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + ! PUT 4D VARS ( mp, msoil, mlitter, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID6(1), casaflux%fromLtoS, & + start=(/ 1,1,1,CNT /), count=(/ mp,msoil,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + ! PUT 4D VARS ( mp, msoil, msoil, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID7(1), casaflux%fromStoS, & + start=(/ 1,1,1,CNT /), count=(/ mp,msoil,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + CASE(2) + + + ! PUT 2D VARS ( mp, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 1), casamet%glai, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 2), casapool%clabile, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 3), casapool%psoillab, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 4), casapool%psoilsorb, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 5), casapool%psoilocc, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 6), casabal%sumcbal, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 7), casabal%sumnbal, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 8), casabal%sumpbal, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 9), casaflux%Cgpp, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(10), casaflux%Cnpp, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(11), casaflux%stemnpp, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(12), casaflux%Crp, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(13), tempFCrgyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(14), casabal%FNfixyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + ! STATUS = NF90_PUT_VAR(FILE_ID, VID1(15), casaflux%Nminuptake, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + ! IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(15), casabal%FPupyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(16), casaflux%Clabloss, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(17), casaflux%fracClabile,start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(18), casaflux%Cnep, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(19), casabal%FCrsyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(20), casabal%FNdepyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(21), casabal%FNlossyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(22), casabal%FNleachyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(23), casabal%FNleachyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(24), casaflux%Nlittermin, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(25), casaflux%Nsmin, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(26), casaflux%Nsimm, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(27), casabal%FNsnetyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(28), casaflux%fNminloss, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(29), casabal%FPdustyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(30), casabal%FPweayear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(31), casabal%FPleachyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(32), casabal%FPlossyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(33), casaflux%Pupland, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(34), casaflux%Plittermin, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(35), casaflux%Psmin, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(36), casaflux%Psimm, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(37), casabal%FPsnetyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(38), casaflux%fPleach, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(39), casaflux%kplab, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(40), casaflux%kpsorb, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(41), casaflux%kpocc, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(42), casaflux%kmlabP, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(43), casaflux%Psorbmax, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(44), casaflux%FluxCtoco2, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(45), casabal%FCgppyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(46), casabal%FCrpyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(47), casabal%FCnppyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(48), casabal%FCrsyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(49), casabal%FCneeyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(50), veg%vcmax, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(51), casapool%Nsoilmin, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + ! PUT 3D VARS ( mp, mplant, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(1), casapool%cplant, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(2), casapool%nplant, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(3), casapool%pplant, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(4), casaflux%fracCalloc, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(5), casaflux%fracNalloc, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(6), casaflux%fracPalloc, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(7), casaflux%kplant, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(8), tempFCrmyear, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + ! PUT 3D VARS ( mp, mlitter, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID3(1), casapool%clitter, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(2), casapool%nlitter, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(3), casapool%plitter, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(4), casaflux%klitter, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(5), casaflux%fromLtoCO2, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(6), casaflux%FluxCtolitter, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(7), casaflux%FluxNtolitter, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(8), casaflux%FluxPtolitter, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + ! PUT 3D VARS ( mp, msoil, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID4(1), casapool%csoil, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(2), casapool%nsoil, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(3), casapool%psoil, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(4), casaflux%ksoil, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(5), casaflux%fromStoCO2, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(6), casaflux%FluxCtosoil, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(7), casaflux%FluxNtosoil, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(8), casaflux%FluxPtosoil, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + ! PUT 4D VARS ( mp, mlitter,mplant, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID5(1), casaflux%fromPtoL, & + start=(/ 1,1,1,CNT /), count=(/ mp,mlitter,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + ! PUT 4D VARS ( mp, msoil, mlitter, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID6(1), casaflux%fromLtoS, & + start=(/ 1,1,1,CNT /), count=(/ mp,msoil,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + ! PUT 4D VARS ( mp, msoil, msoil, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID7(1), casaflux%fromStoS, & + start=(/ 1,1,1,CNT /), count=(/ mp,msoil,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + CASE(3) + ! PUT 2D VARS ( mp, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 1), casamet%glai, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 2), casapool%clabile, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 3), casapool%psoillab, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 4), casapool%psoilsorb, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 5), casapool%psoilocc, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 6), casabal%sumcbal, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 7), casabal%sumnbal, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 8), casabal%sumpbal, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1( 9), casaflux%Cgpp, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(10), casaflux%Cnpp, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(11), casaflux%stemnpp, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(12), casaflux%Crp, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(13), tempFCrgyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(14), casabal%FNfixyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + ! IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + ! STATUS = NF90_PUT_VAR(FILE_ID, VID1(15), casaflux%Nminuptake, start=(/ 1, CNT /), count=(/ mp, 1 !/) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(15), casabal%FPupyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(16), casaflux%Clabloss, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(17), casaflux%fracClabile,start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(18), casaflux%Cnep, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(19), casabal%FCrsyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(20), casabal%FNdepyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(21), casabal%FNlossyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(22), casabal%FNleachyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(23), casabal%FNupyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(24), casaflux%Nlittermin, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(25), casaflux%Nsmin, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(26), casaflux%Nsimm, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(27), casabal%FNsnetyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(28), casaflux%fNminloss, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(29), casabal%FPdustyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(30), casabal%FPweayear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(31), casabal%FPleachyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(32), casabal%FPlossyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(33), casaflux%Pupland, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(34), casaflux%Plittermin, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(35), casaflux%Psmin, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(36), casaflux%Psimm, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(37), casabal%FPsnetyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(38), casaflux%fPleach, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(39), casaflux%kplab, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(40), casaflux%kpsorb, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(41), casaflux%kpocc, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(42), casaflux%kmlabP, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(43), casaflux%Psorbmax, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(44), casaflux%FluxCtoCo2, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(45), casabal%FCgppyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(46), casabal%FCrpyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(47), casabal%FCnppyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(48), casabal%FCrsyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(49), casabal%FCneeyear, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(50), veg%vcmax, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID1(51), casapool%Nsoilmin, start=(/ 1, CNT /), count=(/ mp, 1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + + ! PUT 3D VARS ( mp, mplant, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(1), casapool%cplant, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(2), casapool%nplant, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(3), casapool%pplant, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(4), casaflux%fracCalloc, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(5), casaflux%fracNalloc, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(6), casaflux%fracPalloc, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(7), casaflux%kplant, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + STATUS = NF90_PUT_VAR(FILE_ID, VID2(8), tempFCrmyear, & + start=(/ 1,1,CNT /), count=(/ mp,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + ! PUT 3D VARS ( mp, mlitter, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID3(1), casapool%clitter, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(2), casapool%nlitter, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(3), casapool%plitter, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(4), casaflux%klitter, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(5), casaflux%fromLtoCO2, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(6), casaflux%FluxCtolitter, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(7), casaflux%FluxNtolitter, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID3(8), casaflux%FluxPtolitter, & + start=(/ 1,1,CNT /), count=(/ mp,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + ! PUT 3D VARS ( mp, msoil, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID4(1), casapool%csoil, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(2), casapool%nsoil, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(3), casapool%psoil, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(4), casaflux%ksoil, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(5), casaflux%fromStoCO2, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(6), casaflux%FluxCtosoil, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(7), casaflux%FluxNtosoil, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + STATUS = NF90_PUT_VAR(FILE_ID, VID4(8), casaflux%FluxPtosoil, & + start=(/ 1,1,CNT /), count=(/ mp,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + ! PUT 4D VARS ( mp, mlitter,mplant, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID5(1), casaflux%fromPtoL, & + start=(/ 1,1,1,CNT /), count=(/ mp,mlitter,mplant,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + ! PUT 4D VARS ( mp, msoil, mlitter, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID6(1), casaflux%fromLtoS, & + start=(/ 1,1,1,CNT /), count=(/ mp,msoil,mlitter,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + ! PUT 4D VARS ( mp, msoil, msoil, t ) + STATUS = NF90_PUT_VAR(FILE_ID, VID7(1), casaflux%fromStoS, & + start=(/ 1,1,1,CNT /), count=(/ mp,msoil,msoil,1 /) ) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + + END SELECT + + IF ( FINAL ) THEN + ! Close NetCDF file: + STATUS = NF90_close(FILE_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + WRITE(*,*) " Casa Output written to ",fname + ENDIF + + END SUBROUTINE WRITE_CASA_OUTPUT_NC +#endif + +END MODULE casa_offline_inout_module