!$Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/stomate.f90,v 1.41 2010/05/27 08:30:35 ssipsl Exp $ !IPSL (2006) ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC ! MODULE stomate !--------------------------------------------------------------------- ! Daily update of leaf area index etc. !--------------------------------------------------------------------- USE netcdf !- USE ioipsl USE defprec USE grid USE constantes USE pft_parameters USE stomate_io USE stomate_data USE stomate_season USE stomate_lpj USE stomate_assimtemp USE stomate_litter USE stomate_vmax USE stomate_soilcarbon USE stomate_resp USE parallel ! USE Write_field_p !- IMPLICIT NONE PRIVATE PUBLIC stomate_main,stomate_clear ! INTEGER,PARAMETER :: r_typ =nf90_real4 !- ! variables used inside stomate module : declaration and initialisation !- ! total natural space (fraction of total space) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: veget_cov_max ! new year total natural space (fraction of total space) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: veget_cov_max_new ! carbon pool: active, slow, or passive, (gC/(m**2 of ground)) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: carbon ! density of individuals (1/(m**2 of ground)) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: ind ! daily moisture availability REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: humrel_daily ! daily litter humidity REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: litterhum_daily ! daily 2 meter temperatures (K) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: t2m_daily ! daily minimum 2 meter temperatures (K) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: t2m_min_daily ! daily surface temperatures (K) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: tsurf_daily ! daily soil temperatures (K) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: tsoil_daily ! daily soil humidity REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: soilhum_daily ! daily precipitations (mm/day) (for phenology) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: precip_daily ! daily gross primary productivity (gC/(m**2 of ground)/day) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: gpp_daily ! daily net primary productivity (gC/(m**2 of ground)/day) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: npp_daily ! Turnover rates (gC/(m**2 of ground)/day) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: turnover_daily ! Turnover rates (gC/(m**2 of ground)*dtradia) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: turnover_littercalc ! Probability of fire REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: fireindex ! Longer term total litter above the ground (gC/m**2 of ground) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: firelitter ! "monthly" moisture availability REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: humrel_month ! "weekly" moisture availability REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: humrel_week ! "long term" 2 meter temperatures (K) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: t2m_longterm ! "long term" 2 meter reference temperatures (K) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: tlong_ref ! "monthly" 2 meter temperatures (K) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: t2m_month ! "weekly" 2 meter temperatures (K) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: t2m_week ! "monthly" soil temperatures (K) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: tsoil_month ! "monthly" soil humidity REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: soilhum_month ! growing degree days, threshold -5 deg C (for phenology) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: gdd_m5_dormance ! growing degree days, since midwinter (for phenology) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: gdd_midwinter ! number of chilling days since leaves were lost (for phenology) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: ncd_dormance ! number of growing days, threshold -5 deg C (for phenology) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: ngd_minus5 ! last year's maximum moisture availability REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: maxhumrel_lastyear ! this year's maximum moisture availability REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: maxhumrel_thisyear ! last year's minimum moisture availability REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: minhumrel_lastyear ! this year's minimum moisture availability REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: minhumrel_thisyear ! last year's maximum "weekly" GPP (gC/m**2 covered/day) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: maxgppweek_lastyear ! this year's maximum "weekly" GPP (gC/m**2 covered/day) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: maxgppweek_thisyear ! last year's annual GDD0 REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: gdd0_lastyear ! this year's annual GDD0 REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: gdd0_thisyear ! last year's annual precipitation (mm/year) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: precip_lastyear ! this year's annual precipitation (mm/year) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: precip_thisyear ! PFT exists (equivalent to veget > 0 for natural PFTs) LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: PFTpresent ! "long term" net primary productivity (gC/(m**2 of ground)/year) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: npp_longterm ! last year's maximum leaf mass, for each PFT (gC/(m**2 of ground)) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: lm_lastyearmax ! this year's maximum leaf mass, for each PFT (gC/(m**2 of ground)) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: lm_thisyearmax ! last year's maximum fpc for each natural PFT, on ground REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: maxfpc_lastyear ! this year's maximum fpc for each PFT, on ground (see stomate_season) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: maxfpc_thisyear ! "long term" turnover rate (gC/(m**2 of ground)/year) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: turnover_longterm ! "weekly" GPP (gC/day/(m**2 covered) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: gpp_week ! biomass (gC/(m**2 of ground)) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: biomass ! is the plant senescent? ! (only for deciduous trees - carbohydrate reserve) LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: senescence ! how many days ago was the beginning of the growing season REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: when_growthinit ! age (years). For trees, mean stand age. ! For grasses, ears since introduction of PFT REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: age ! Winter too cold? between 0 and 1 REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: adapted ! Winter sufficiently cold? between 0 and 1 REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: regenerate ! fraction of litter above the ground belonging to different PFTs REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: litterpart ! metabolic and structural litter, above and below ground ! (gC/(m**2 of ground)) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: litter ! dead leaves on ground, per PFT, metabolic and structural, ! in gC/(m**2 of ground) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: dead_leaves ! black carbon on the ground (gC/(m**2 of total ground)) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: black_carbon ! ratio Lignine/Carbon in structural litter, above and below ground, ! (gC/(m**2 of ground)) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: lignin_struc ! carbon emitted into the atmosphere by fire (living and dead biomass) ! (in gC/m**2 of average ground/day) !NV devient 2D REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: co2_fire ! co2 taken up (gC/(m**2 of total ground)/day) !NV devient 2D REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: co2_to_bm_dgvm ! heterotrophic respiration (gC/day/m**2 of total ground) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: resp_hetero_d ! maintenance respiration (gC/day/(m**2 of total ground)) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: resp_hetero_radia ! maintenance respiration (gC/day/(m**2 of total ground)) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: resp_maint_d ! growth respiration (gC/day/(m**2 of total ground)) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: resp_growth_d ! vegetation fractions (on ground) after last light competition REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: veget_lastlight ! is the PFT everywhere in the grid box or very localized (after its intoduction) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: everywhere ! in order for this PFT to be introduced, ! does it have to be present in an adjacent grid box? LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: need_adjacent ! leaf age (d) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: leaf_age ! fraction of leaves in leaf age class REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: leaf_frac ! How much time ago was the PFT eliminated for the last time (y) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: RIP_time ! duration of dormance (d) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: time_lowgpp ! time elapsed since strongest moisture availability (d) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: time_hum_min ! minimum moisture during dormance REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: hum_min_dormance ! time constant of probability of a leaf to be eaten by a herbivore (days) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: herbivores ! npp total written for forcesoil... REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: npp_equil ! npp total ... REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: npp_tot ! moisture control of heterotrophic respiration REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: control_moist ! temperature control of heterotrophic respiration, above and below REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: control_temp ! quantity of carbon going into carbon pools from litter decomposition ! (gC/(m**2 of ground)/day) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: soilcarbon_input ! quantity of carbon going into carbon pools from litter decomposition daily ! (gC/(m**2 of ground)/day) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:):: soilcarbon_input_daily ! moisture control of heterotrophic respiration daily REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: control_moist_daily ! temperature control of heterotrophic respiration, above and below daily REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: control_temp_daily ! how many states were calculated for a given soil forcing time step ! turnover time of leaves REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: turnover_time ! daily total CO2 flux (gC/m**2/day) !NV champs 2D REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: co2_flux_daily ! monthly total CO2 flux (gC/m**2) !NV champs 2D REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: co2_flux_monthly ! conversion of biomass to litter (gC/(m**2 of ground))/day REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: bm_to_litter ! conversion of biomass to litter (gC/(m**2 of ground))*dtradia REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: bm_to_littercalc INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: nforce ! Date and EndOfYear, intialize and update in slowproc ! (Now managed in slowproc for land_use) ! time step of STOMATE in days REAL(r_std),SAVE :: dt_days=0. ! Time step in days for stomate ! to check REAL(r_std),SAVE :: day_counter=0. ! count each sechiba (dtradia) time step each day ! date (d) INTEGER(i_std),SAVE :: date=0 ! is it time for Stomate or update of LAI etc. ? LOGICAL, SAVE :: do_slow=.FALSE. ! Do update of yearly variables ? ! This variable must be .TRUE. once a year LOGICAL, SAVE :: EndOfYear=.FALSE. ! Land cover change flag LOGICAL,SAVE :: lcchange=.FALSE. PUBLIC dt_days, day_counter, date, do_slow, EndOfYear, lcchange ! forcing data in memory REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: clay_fm REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: humrel_daily_fm REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: litterhum_daily_fm REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: t2m_daily_fm REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: t2m_min_daily_fm REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: tsurf_daily_fm REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: tsoil_daily_fm REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: soilhum_daily_fm REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: precip_fm REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: gpp_daily_fm REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:) :: resp_maint_part_fm REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: veget_fm REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: veget_max_fm REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: lai_fm REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: clay_fm_g REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: humrel_daily_fm_g REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: litterhum_daily_fm_g REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: t2m_daily_fm_g REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: t2m_min_daily_fm_g REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: tsurf_daily_fm_g REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: tsoil_daily_fm_g REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: soilhum_daily_fm_g REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: precip_fm_g REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: gpp_daily_fm_g REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:) :: resp_maint_part_fm_g REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: veget_fm_g REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: veget_max_fm_g REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: lai_fm_g INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: isf LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:) :: nf_written INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: nf_cumul ! first call LOGICAL,SAVE :: l_first_stomate = .TRUE. ! flag for cumul of forcing if teststomate LOGICAL,SAVE :: cumul_forcing=.FALSE. ! flag for cumul of forcing if forcesoil LOGICAL,SAVE :: cumul_Cforcing=.FALSE. ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: resp_maint_part_radia REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: resp_maint_part REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: resp_maint_radia ! Land cover change variables ! products remaining in the 10/100 year-turnover pool after the annual release for each compartment ! (10 or 100 + 1 : input from year of land cover change) REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: prod10 REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: prod100 ! annual release from the 10/100 year-turnover pool compartments REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: flux10 REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: flux100 ! release during first year following land cover change REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: convflux ! total annual release from the 10/100 year-turnover pool REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: cflux_prod10, cflux_prod100 ! harvest above ground biomass for agriculture REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: harvest_above CONTAINS ! != ! SUBROUTINE stomate_main & & (kjit, kjpij, kjpindex, dtradia, dt_slow, & & ldrestart_read, ldrestart_write, ldforcing_write, ldcarbon_write, & & index, lalo, neighbours, resolution, contfrac, totfrac_nobio, clay, & & t2m, t2m_min, temp_sol, stempdiag, & & humrel, shumdiag, litterhumdiag, precip_rain, precip_snow, & & gpp, deadleaf_cover, assim_param, & & lai, height, veget, veget_max, qsintmax, & & veget_max_new, totfrac_nobio_new, & & hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & & co2_flux,resp_maint,resp_hetero,resp_growth) !--------------------------------------------------------------------- ! IMPLICIT NONE ! 0 interface description ! ! 0.1 input ! ! 0.1.1 input scalar ! ! Time step number INTEGER(i_std),INTENT(in) :: kjit ! Domain size INTEGER(i_std),INTENT(in) :: kjpindex ! Total size of the un-compressed grid INTEGER(i_std),INTENT(in) :: kjpij ! Time step of SECHIBA REAL(r_std),INTENT(in) :: dtradia ! Time step of STOMATE REAL(r_std),INTENT(in) :: dt_slow ! Logical for _restart_ file to read LOGICAL,INTENT(in) :: ldrestart_read ! Logical for _restart_ file to write LOGICAL,INTENT(in) :: ldrestart_write ! Logical for _forcing_ file to write LOGICAL,INTENT(in) :: ldforcing_write ! Logical for _carbon_forcing_ file to write LOGICAL,INTENT(in) :: ldcarbon_write ! SECHIBA's _history_ file identifier INTEGER(i_std),INTENT(in) :: hist_id ! SECHIBA's _history_ file 2 identifier INTEGER(i_std),INTENT(in) :: hist2_id ! STOMATE's _Restart_ file file identifier INTEGER(i_std),INTENT(in) :: rest_id_stom ! STOMATE's _history_ file file identifier INTEGER(i_std),INTENT(in) :: hist_id_stom ! STOMATE's IPCC _history_ file file identifier INTEGER(i_std),INTENT(in) :: hist_id_stom_IPCC ! ! 0.1.2 input fields ! ! Indeces of the points on the map INTEGER(i_std),DIMENSION(kjpindex),INTENT(in) :: index ! Geogr. coordinates (latitude,longitude) (degrees) REAL(r_std),DIMENSION(kjpindex,2),INTENT(in) :: lalo ! neighoring grid points if land INTEGER(i_std),DIMENSION(kjpindex,8),INTENT(in) :: neighbours ! size in x an y of the grid (m) REAL(r_std),DIMENSION(kjpindex,2),INTENT(in) :: resolution ! fraction of continent in the grid REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: contfrac ! fraction of grid cell covered by lakes, land ice, cities, ... REAL(r_std),DIMENSION(kjpindex),INTENT(in) :: totfrac_nobio ! clay fraction REAL(r_std),DIMENSION(kjpindex),INTENT(in) :: clay ! Relative humidity ("moisture availability") REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in) :: humrel ! 2 m air temperature (K) REAL(r_std),DIMENSION(kjpindex),INTENT(in) :: t2m ! min. 2 m air temp. during forcing time step (K) REAL(r_std),DIMENSION(kjpindex),INTENT(in) :: t2m_min ! Surface temperature REAL(r_std),DIMENSION(kjpindex),INTENT(in) :: temp_sol ! Soil temperature REAL(r_std),DIMENSION(kjpindex,nbdl),INTENT(in) :: stempdiag ! Relative soil moisture REAL(r_std),DIMENSION(kjpindex,nbdl),INTENT(in) :: shumdiag ! Litter humidity REAL(r_std),DIMENSION(kjpindex),INTENT(in) :: litterhumdiag ! Rain precipitation REAL(r_std),DIMENSION(kjpindex),INTENT(in) :: precip_rain ! Snow precipitation REAL(r_std),DIMENSION(kjpindex),INTENT(in) :: precip_snow ! GPP (gC/(m**2 of total ground)/time step) REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in) :: gpp ! new "maximal" coverage fraction of a PFT (LAI -> infinity) on ground ! only if EndOfYear is activated REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in) :: veget_max_new ! new fraction of grid cell covered by lakes, land ice, cities, ... REAL(r_std),DIMENSION(kjpindex),INTENT(in) :: totfrac_nobio_new ! ! 0.2 output ! ! 0.2.1 output scalar ! ! 0.2.2 output fields ! ! CO2 flux in gC/m**2 of average ground/dt !NV champs 2D REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out) :: co2_flux ! autotrophic respiration in gC/m**2 of surface/dt REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out) :: resp_maint REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out) :: resp_growth !NV champs2D REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out) :: resp_hetero ! ! 0.3 modified ! ! 0.3.1 modified scalar ! 0.3.2 modified fields ! ! Surface foliere REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout) :: lai ! Fraction of vegetation type from hydrological module. Takes into account ice etc. REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout) :: veget ! Maximum fraction of vegetation type from hydrological module. Takes into account ice etc. REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout) :: veget_max ! height (m) REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout) :: height ! min+max+opt temps & vmax for photosynthesis REAL(r_std),DIMENSION(kjpindex,nvm,npco2),INTENT(inout) :: assim_param ! fraction of soil covered by dead leaves REAL(r_std),DIMENSION(kjpindex),INTENT(inout) :: deadleaf_cover ! Maximum water on vegetation for interception REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout) :: qsintmax ! ! 0.4 local declaration ! ! 0.4.1 variables defined on nvm in SECHIBA, nvm in STOMATE/LPJ ! gross primary productivity (gC/(m**2 of total ground)/day) REAL(r_std),DIMENSION(kjpindex,nvm) :: gpp_d ! fractional coverage: actually covered space, taking into account LAI (= grid scale fpc). ! Fraction of ground. REAL(r_std),DIMENSION(kjpindex,nvm) :: veget_cov ! 0.4.2 other ! ! soil level used for LAI INTEGER(i_std),SAVE :: lcanop ! counts time until next STOMATE time step REAL(r_std) :: day_counter_read ! STOMATE time step read in restart file REAL(r_std) :: dt_days_read ! STOMATE date INTEGER(i_std) :: date_read ! Maximum STOMATE time step (days) REAL(r_std),PARAMETER :: max_dt_days = 5. ! Writing frequency for history file (d) REAL(r_std) :: hist_days ! precipitation (mm/day) REAL(r_std),DIMENSION(kjpindex) :: precip ! Maximum rate of carboxylation REAL(r_std),DIMENSION(kjpindex,nvm) :: vcmax ! Maximum rate of RUbp regeneration REAL(r_std),DIMENSION(kjpindex,nvm) :: vjmax ! Min temperature for photosynthesis (deg C) REAL(r_std),DIMENSION(kjpindex,nvm) :: t_photo_min ! Opt temperature for photosynthesis (deg C) REAL(r_std),DIMENSION(kjpindex,nvm) :: t_photo_opt ! Max temperature for photosynthesis (deg C) REAL(r_std),DIMENSION(kjpindex,nvm) :: t_photo_max !NV supprimé ! total autotrophic respiration (gC/day/(m**2 of total ground)) ! REAL(r_std),DIMENSION(kjpindex) :: resp_auto_tot !NV gpp_tot supprimé ! total photosynthesis (gC/day/(m**2 of total ground)) ! REAL(r_std),DIMENSION(kjpindex) :: gpp_tot ! -- LOOP REAL(r_std) :: net_co2_flux_monthly, net_co2_flux_monthly_sum INTEGER :: ios ! for forcing file: "daily" gpp REAL(r_std),DIMENSION(kjpindex,nvm) :: gpp_daily_x ! for forcing file: "daily" auto resp REAL(r_std),DIMENSION(kjpindex,nvm,nparts) :: resp_maint_part_x ! total "vegetation" cover REAL(r_std),DIMENSION(kjpindex) :: cvegtot INTEGER(i_std) :: ji, jv, i, j REAL(r_std) :: trans_veg REAL(r_std) :: tmp_day(1) ! INTEGER(i_std) :: ier ! moisture control of heterotrophic respiration REAL(r_std),DIMENSION(kjpindex,nlevs) :: control_moist_inst ! temperature control of heterotrophic respiration, above and below REAL(r_std),DIMENSION(kjpindex,nlevs) :: control_temp_inst ! quantity of carbon going into carbon pools from litter decomposition ! (gC/(m**2 of ground)/day) REAL(r_std),DIMENSION(kjpindex,ncarb,nvm) :: soilcarbon_input_inst ! time step of soil forcing file (in days) REAL(r_std),SAVE :: dt_forcesoil INTEGER(i_std),SAVE :: nparan ! Number of time steps per year for carbon spinup INTEGER(i_std),SAVE :: nbyear INTEGER(i_std),PARAMETER :: nparanmax=36 ! Number max of time steps per year for carbon spinup REAL(r_std) :: sf_time INTEGER(i_std),SAVE :: iatt=1 INTEGER(i_std),SAVE :: iatt_old=1 INTEGER(i_std) :: max_totsize, totsize_1step,totsize_tmp REAL(r_std) :: xn INTEGER(i_std),SAVE :: nsfm, nsft INTEGER(i_std),SAVE :: iisf !- CHARACTER(LEN=100), SAVE :: forcing_name,Cforcing_name INTEGER(i_std),SAVE :: Cforcing_id INTEGER(i_std),PARAMETER :: ndm = 10 INTEGER(i_std) :: vid INTEGER(i_std) :: nneigh,direct INTEGER(i_std),DIMENSION(ndm) :: d_id ! root temperature (convolution of root and soil temperature profiles) REAL(r_std),DIMENSION(kjpindex,nvm) :: t_root REAL(r_std),DIMENSION(kjpindex,nvm,nparts) :: coeff_maint ! temperature which is pertinent for maintenance respiration (K) REAL(r_std),DIMENSION(kjpindex,nparts) :: t_maint_radia ! integration constant for root profile REAL(r_std),DIMENSION(kjpindex) :: rpc ! long term annual mean temperature, C REAL(r_std),DIMENSION(kjpindex) :: tl ! slope of maintenance respiration coefficient (1/K) REAL(r_std),DIMENSION(kjpindex) :: slope ! soil levels (m) REAL(r_std),DIMENSION(0:nbdl) :: z_soil ! root depth. This will, one day, be a prognostic variable. ! It will be calculated by ! STOMATE (save in restart file & give to hydrology module!), ! probably somewhere ! in the allocation routine. For the moment, it is prescribed. REAL(r_std),DIMENSION(kjpindex,nvm) :: rprof INTEGER(i_std) :: l,k ! litter heterotrophic respiration (gC/day/m**2 by PFT) REAL(r_std),DIMENSION(kjpindex,nvm) :: resp_hetero_litter ! soil heterotrophic respiration (gC/day/m**2 by PFT) REAL(r_std),DIMENSION(kjpindex,nvm) :: resp_hetero_soil INTEGER(i_std) :: iyear REAL(r_std),DIMENSION(nbp_glo) :: clay_g REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:) :: soilcarbon_input_g REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: control_moist_g REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: control_temp_g REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: npp_equil_g REAL(r_std), DIMENSION(kjpindex) :: vartmp !--------------------------------------------------------------------- ! first of all: store time step in common value itime = kjit z_soil(0) = 0. z_soil(1:nbdl) = diaglev(1:nbdl) DO j=1,nvm rprof(:,j) = 1./humcste(j) ENDDO !- ! 1 do initialisation !- resp_growth=zero IF (l_first_stomate) THEN IF (long_print) THEN WRITE (numout,*) ' l_first_stomate : call stomate_init' ENDIF ! ! ! 1.1 allocation, file definitions. Set flags. ! CALL stomate_init (kjpij, kjpindex, index, ldforcing_write, lalo, & rest_id_stom, hist_id_stom, hist_id_stom_IPCC) co2_flux_monthly(:,:) = zero ! ! 1.2 read PFT data ! CALL data (kjpindex, lalo) ! ! 1.3 Initial conditions ! ! 1.3.1 read STOMATE's start file ! CALL readstart & & (kjpindex, index, lalo, resolution, & & day_counter_read, dt_days_read, date_read, & & ind, adapted, regenerate, & & humrel_daily, litterhum_daily, & & t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, & & soilhum_daily, precip_daily, & & gpp_daily, npp_daily, turnover_daily, & & humrel_month, humrel_week, & & t2m_longterm, tlong_ref, t2m_month, t2m_week, & & tsoil_month, soilhum_month, fireindex, firelitter, & & maxhumrel_lastyear, maxhumrel_thisyear, & & minhumrel_lastyear, minhumrel_thisyear, & & maxgppweek_lastyear, maxgppweek_thisyear, & & gdd0_lastyear, gdd0_thisyear, & & precip_lastyear, precip_thisyear, & & gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, & & PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, & & maxfpc_lastyear, maxfpc_thisyear, & & turnover_longterm, gpp_week, biomass, resp_maint_part, & & leaf_age, leaf_frac, & & senescence, when_growthinit, age, & & resp_hetero_d, resp_maint_d, resp_growth_d, co2_fire, co2_to_bm_dgvm, & & veget_lastlight, everywhere, need_adjacent, RIP_time, time_lowgpp, & & time_hum_min, hum_min_dormance, & & litterpart, litter, dead_leaves, & & carbon, black_carbon, lignin_struc,turnover_time,& & prod10,prod100,flux10, flux100, & & convflux, cflux_prod10, cflux_prod100, bm_to_litter) ! 1.4 read the boundary conditions ! CALL readbc (kjpindex, lalo, resolution, tlong_ref) ! ! 1.5 check time step ! ! 1.5.1 allow STOMATE's time step to change ! although this is dangerous ! IF (dt_days /= dt_days_read) THEN WRITE(numout,*) 'slow_processes: STOMATE time step changes:', & dt_days_read,' -> ',dt_days ENDIF ! 1.5.2 time step has to be a multiple of a full day IF ( ( dt_days-REAL(NINT(dt_days),r_std) ) > min_stomate ) THEN WRITE(numout,*) 'slow_processes: STOMATE time step is wrong:', & & dt_days,' days.' STOP ENDIF ! 1.5.3 upper limit to STOMATE's time step IF ( dt_days > max_dt_days ) THEN WRITE(numout,*) 'slow_processes: STOMATE time step too large:', & & dt_days,' days.' STOP ENDIF ! 1.5.4 STOMATE time step must not be less than the forcing time step IF ( dtradia > dt_days*one_day ) THEN WRITE(numout,*) & & 'slow_processes: STOMATE time step smaller than forcing time step.' STOP ENDIF ! 1.5.5 For teststomate : test day_counter IF ( abs(day_counter - day_counter_read) > min_stomate ) THEN WRITE(numout,*) 'slow_processes: STOMATE day counter changes:', & day_counter_read,' -> ',day_counter ENDIF ! 1.5.6 date check IF (date /= date_read) THEN WRITE(numout,*) 'slow_processes: STOMATE date changes:', & date_read,' -> ',date ENDIF ! 1.5.6 some more messages WRITE(numout,*) 'slow_processes, STOMATE time step (d): ', dt_days ! ! 1.6 write forcing file for stomate? ! IF (ldforcing_write) THEN !Config Key = STOMATE_FORCING_NAME !Config Desc = Name of STOMATE's forcing file !Config Def = NONE !Config Help = Name that will be given !Config to STOMATE's offline forcing file !- forcing_name = stomate_forcing_name ! compatibilité avec driver Nicolas CALL getin_p('STOMATE_FORCING_NAME',forcing_name) IF ( TRIM(forcing_name) /= 'NONE' ) THEN IF (is_root_prc) CALL SYSTEM ('rm -f '//TRIM(forcing_name)) WRITE(numout,*) 'writing a forcing file for STOMATE.' !Config Key = STOMATE_FORCING_MEMSIZE !Config Desc = Size of STOMATE forcing data in memory (MB) !Config Def = 50 !Config Help = This variable determines how many !Config forcing states will be kept in memory. !Config Must be a compromise between memory !Config use and frequeny of disk access. max_totsize = 50 CALL getin_p('STOMATE_FORCING_MEMSIZE', max_totsize) max_totsize = max_totsize*1000000 totsize_1step = & & SIZE(clay)*KIND(clay) & & +SIZE(humrel_daily)*KIND(humrel_daily) & & +SIZE(litterhum_daily)*KIND(litterhum_daily) & & +SIZE(t2m_daily)*KIND(t2m_daily) & & +SIZE(t2m_min_daily)*KIND(t2m_min_daily) & & +SIZE(tsurf_daily)*KIND(tsurf_daily) & & +SIZE(tsoil_daily)*KIND(tsoil_daily) & & +SIZE(soilhum_daily)*KIND(soilhum_daily) & & +SIZE(precip_daily)*KIND(precip_daily) & & +SIZE(gpp_daily_x)*KIND(gpp_daily_x) & & +SIZE(resp_maint_part_x)*KIND(resp_maint_part_x) & & +SIZE(veget)*KIND(veget) & & +SIZE(veget_max)*KIND(veget_max) & & +SIZE(lai)*KIND(lai) CALL reduce_sum(totsize_1step,totsize_tmp) CALL bcast(totsize_tmp) totsize_1step=totsize_tmp ! total number of forcing steps nsft = INT(one_year/(dt_slow/one_day)) ! number of forcing steps in memory nsfm = MIN(nsft, & & MAX(1,NINT( REAL(max_totsize,r_std) & & /REAL(totsize_1step,r_std)))) CALL init_forcing (kjpindex,nsfm,nsft) isf(:) = (/ (i,i=1,nsfm) /) nf_written(:) = .FALSE. nf_cumul(:) = 0 iisf = 0 !- IF (is_root_prc) THEN ier = NF90_CREATE (TRIM(forcing_name),NF90_SHARE,forcing_id) ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL,'dtradia',dtradia) ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL,'dt_slow',dt_slow) ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL, & & 'nsft',REAL(nsft,r_std)) ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL, & & 'kjpij',REAL(iim_g*jjm_g,r_std)) ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL, & & 'kjpindex',REAL(nbp_glo,r_std)) !- ier = NF90_DEF_DIM (forcing_id,'points',nbp_glo,d_id(1)) ier = NF90_DEF_DIM (forcing_id,'layers',nbdl,d_id(2)) ier = NF90_DEF_DIM (forcing_id,'pft',nvm,d_id(3)) direct=2 ier = NF90_DEF_DIM (forcing_id,'direction',direct,d_id(4)) nneigh=8 ier = NF90_DEF_DIM (forcing_id,'nneigh',nneigh,d_id(5)) ier = NF90_DEF_DIM (forcing_id,'time',nsft,d_id(6)) ier = NF90_DEF_DIM (forcing_id,'nbparts',nparts,d_id(7)) !- ier = NF90_DEF_VAR (forcing_id,'points', r_typ,d_id(1),vid) ier = NF90_DEF_VAR (forcing_id,'layers', r_typ,d_id(2),vid) ier = NF90_DEF_VAR (forcing_id,'pft', r_typ,d_id(3),vid) ier = NF90_DEF_VAR (forcing_id,'direction', r_typ,d_id(4),vid) ier = NF90_DEF_VAR (forcing_id,'nneigh', r_typ,d_id(5),vid) ier = NF90_DEF_VAR (forcing_id,'time', r_typ,d_id(6),vid) ier = NF90_DEF_VAR (forcing_id,'nbparts', r_typ,d_id(7),vid) ier = NF90_DEF_VAR (forcing_id,'index', r_typ,d_id(1),vid) ier = NF90_DEF_VAR (forcing_id,'contfrac', r_typ,d_id(1),vid) ier = NF90_DEF_VAR (forcing_id,'lalo', & & r_typ,(/ d_id(1),d_id(4) /),vid) ier = NF90_DEF_VAR (forcing_id,'neighbours', & & r_typ,(/ d_id(1),d_id(5) /),vid) ier = NF90_DEF_VAR (forcing_id,'resolution', & & r_typ,(/ d_id(1),d_id(4) /),vid) ier = NF90_DEF_VAR (forcing_id,'clay', & & r_typ,(/ d_id(1),d_id(6) /),vid) ier = NF90_DEF_VAR (forcing_id,'humrel', & & r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid) ier = NF90_DEF_VAR (forcing_id,'litterhum', & & r_typ,(/ d_id(1),d_id(6) /),vid) ier = NF90_DEF_VAR (forcing_id,'t2m', & & r_typ,(/ d_id(1),d_id(6) /),vid) ier = NF90_DEF_VAR (forcing_id,'t2m_min', & & r_typ,(/ d_id(1),d_id(6) /),vid) ier = NF90_DEF_VAR (forcing_id,'tsurf', & & r_typ,(/ d_id(1),d_id(6) /),vid) ier = NF90_DEF_VAR (forcing_id,'tsoil', & & r_typ,(/ d_id(1),d_id(2),d_id(6) /),vid) ier = NF90_DEF_VAR (forcing_id,'soilhum', & & r_typ,(/ d_id(1),d_id(2),d_id(6) /),vid) ier = NF90_DEF_VAR (forcing_id,'precip', & & r_typ,(/ d_id(1),d_id(6) /),vid) ier = NF90_DEF_VAR (forcing_id,'gpp', & & r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid) ier = NF90_DEF_VAR (forcing_id,'veget', & & r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid) ier = NF90_DEF_VAR (forcing_id,'veget_max', & & r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid) ier = NF90_DEF_VAR (forcing_id,'lai', & & r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid) ier = NF90_DEF_VAR (forcing_id,'resp_maint_part', & & r_typ,(/ d_id(1),d_id(3),d_id(7),d_id(6) /),vid) ier = NF90_ENDDEF (forcing_id) !- ier = NF90_INQ_VARID (forcing_id,'points',vid) ier = NF90_PUT_VAR (forcing_id,vid, & & (/(REAL(i,r_std),i=1,nbp_glo) /)) ier = NF90_INQ_VARID (forcing_id,'layers',vid) ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,nbdl)/)) ier = NF90_INQ_VARID (forcing_id,'pft',vid) ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,nvm)/)) ier = NF90_INQ_VARID (forcing_id,'direction',vid) ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,2)/)) ier = NF90_INQ_VARID (forcing_id,'nneigh',vid) ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,8)/)) ier = NF90_INQ_VARID (forcing_id,'time',vid) ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,nsft)/)) ier = NF90_INQ_VARID (forcing_id,'nbparts',vid) ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,nparts)/)) ier = NF90_INQ_VARID (forcing_id,'index',vid) ier = NF90_PUT_VAR (forcing_id,vid,REAL(index_g,r_std)) ier = NF90_INQ_VARID (forcing_id,'contfrac',vid) ier = NF90_PUT_VAR (forcing_id,vid,REAL(contfrac_g,r_std)) ier = NF90_INQ_VARID (forcing_id,'lalo',vid) ier = NF90_PUT_VAR (forcing_id,vid,lalo_g) !ym attention a neighbours, a modifier plus tard ier = NF90_INQ_VARID (forcing_id,'neighbours',vid) ier = NF90_PUT_VAR (forcing_id,vid,REAL(neighbours_g,r_std)) ier = NF90_INQ_VARID (forcing_id,'resolution',vid) ier = NF90_PUT_VAR (forcing_id,vid,resolution_g) ENDIF ENDIF ENDIF ! ! 1.7 write forcing file for the soil? ! IF (ldcarbon_write) THEN ! !Config Key = STOMATE_CFORCING_NAME !Config Desc = Name of STOMATE's carbon forcing file !Config Def = NONE !Config Help = Name that will be given to STOMATE's carbon !Config offline forcing file !- Cforcing_name = stomate_Cforcing_name ! compatibilité avec driver Nicolas CALL getin_p('STOMATE_CFORCING_NAME',Cforcing_name) IF ( TRIM(Cforcing_name) /= 'NONE' ) THEN IF (is_root_prc) CALL SYSTEM ('rm -f '//TRIM(Cforcing_name)) ! ! time step of forcesoil ! !Config Key = FORCESOIL_STEP_PER_YEAR !Config Desc = Number of time steps per year for carbon spinup. !Config Def = 12 !Config Help = Number of time steps per year for carbon spinup. nparan = 12 CALL getin_p('FORCESOIL_STEP_PER_YEAR', nparan) IF ( nparan < 1 ) nparan = 1 !Config Key = FORCESOIL_NB_YEAR !Config Desc = Number of years saved for carbon spinup. !Config If internal parameter cumul_Cforcing is TRUE in stomate.f90 !config Then this parameter is forced to one. !Config Def = 1 !Config Help = Number of years saved for carbon spinup. nbyear=1 CALL getin_p('FORCESOIL_NB_YEAR', nbyear) IF ( cumul_Cforcing ) THEN CALL ipslerr (1,'stomate', & & 'Internal parameter cumul_Cforcing is TRUE in stomate.f90', & & 'Parameter FORCESOIL_NB_YEAR is forced to 1.', & & 'Then variable nbyear is forced to 1.') nbyear=1 ENDIF dt_forcesoil = 0. nparan = nparan+1 DO WHILE (dt_forcesoil < dt_slow/one_day) nparan = nparan-1 IF (nparan < 1) THEN STOP 'Problem 1 with number of soil forcing time steps.' ENDIF dt_forcesoil = one_year/REAL(nparan,r_std) ENDDO IF ( nparan > nparanmax ) THEN STOP 'Problem 2 with number of soil forcing time steps.' ENDIF WRITE(numout,*) 'time step of soil forcing (d): ',dt_forcesoil ALLOCATE( nforce(nparan*nbyear)) nforce(:) = 0 ALLOCATE(control_moist(kjpindex,nlevs,nparan*nbyear)) ALLOCATE(npp_equil(kjpindex,nparan*nbyear)) ALLOCATE(npp_tot(kjpindex)) ALLOCATE(control_temp(kjpindex,nlevs,nparan*nbyear)) ALLOCATE(soilcarbon_input(kjpindex,ncarb,nvm,nparan*nbyear)) npp_equil(:,:) = zero npp_tot(:) = zero control_moist(:,:,:) = zero control_temp(:,:,:) = zero soilcarbon_input(:,:,:,:) = zero ENDIF ENDIF ! ! 1.8 calculate STOMATE's vegetation fractions ! from veget, veget_max ! DO j=1,nvm WHERE ((1.-totfrac_nobio(:)) > min_sechiba) veget_cov(:,j)=veget(:,j)/( 1.-totfrac_nobio(:) ) veget_cov_max(:,j)=veget_max(:,j)/( 1.-totfrac_nobio(:) ) ELSEWHERE veget_cov(:,j) = zero veget_cov_max(:,j) = zero ENDWHERE ENDDO IF ( EndOfYear ) THEN DO j=1,nvm WHERE ((1.-totfrac_nobio_new(:)) > min_sechiba) veget_cov_max_new(:,j)=veget_max_new(:,j)/( 1.-totfrac_nobio_new(:) ) ELSEWHERE veget_cov_max_new(:,j) = zero ENDWHERE ENDDO ENDIF ! ! 1.9 initialize some variables ! STOMATE diagnoses some variables for SECHIBA : ! assim_param, deadleaf_cover, etc. ! These variables can be recalculated easily ! from STOMATE's prognostic variables. ! height is saved in Sechiba. ! IF (control%ok_stomate) THEN CALL stomate_var_init & & (kjpindex, veget_cov, veget_cov_max, leaf_age, leaf_frac, & & tlong_ref, t2m_month, dead_leaves, & & veget, lai, qsintmax, deadleaf_cover, assim_param) harvest_above = zero ENDIF ! ! 1.10 reset flag ! l_first_stomate = .FALSE. ! ! 1.11 retu n ! RETURN ENDIF ! first call IF (bavard >= 4) THEN WRITE(numout,*) 'DATE ',date,' ymds', year, month, day, sec, '-- stp --', itime, do_slow ENDIF !- ! 2 prepares restart file for the next simulation !- IF (ldrestart_write) THEN IF (long_print) THEN WRITE (numout,*) & & ' we have to complete restart file with STOMATE variables' ENDIF CALL writerestart & & (kjpindex, index, & & day_counter, dt_days, date, & & ind, adapted, regenerate, & & humrel_daily, litterhum_daily, & & t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, & & soilhum_daily, precip_daily, & & gpp_daily, npp_daily, turnover_daily, & & humrel_month, humrel_week, & & t2m_longterm, tlong_ref, t2m_month, t2m_week, & & tsoil_month, soilhum_month, fireindex, firelitter, & & maxhumrel_lastyear, maxhumrel_thisyear, & & minhumrel_lastyear, minhumrel_thisyear, & & maxgppweek_lastyear, maxgppweek_thisyear, & & gdd0_lastyear, gdd0_thisyear, & & precip_lastyear, precip_thisyear, & & gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, & & PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, & & maxfpc_lastyear, maxfpc_thisyear, & & turnover_longterm, gpp_week, biomass, resp_maint_part, & & leaf_age, leaf_frac, & & senescence, when_growthinit, age, & & resp_hetero_d, resp_maint_d, resp_growth_d, co2_fire, co2_to_bm_dgvm, & & veget_lastlight, everywhere, need_adjacent, & & RIP_time, time_lowgpp, & & time_hum_min, hum_min_dormance, & & litterpart, litter, dead_leaves, & & carbon, black_carbon, lignin_struc,turnover_time,& & prod10,prod100,flux10, flux100, & & convflux, cflux_prod10, cflux_prod100, bm_to_litter) IF (ldforcing_write .AND. TRIM(forcing_name) /= 'NONE' ) THEN CALL forcing_write(forcing_id,1,iisf) ! IF (is_root_prc) ier = NF90_CLOSE (forcing_id) forcing_id=-1 ENDIF IF (ldcarbon_write .AND. TRIM(Cforcing_name) /= 'NONE' ) THEN WRITE(numout,*) & & 'stomate: writing the forcing file for carbon spinup' ! DO iatt = 1, nparan*nbyear IF ( nforce(iatt) > 0 ) THEN soilcarbon_input(:,:,:,iatt) = & & soilcarbon_input(:,:,:,iatt)/REAL(nforce(iatt),r_std) control_moist(:,:,iatt) = & & control_moist(:,:,iatt)/REAL(nforce(iatt),r_std) control_temp(:,:,iatt) = & & control_temp(:,:,iatt)/REAL(nforce(iatt),r_std) npp_equil(:,iatt) = & & npp_equil(:,iatt)/REAL(nforce(iatt),r_std) ELSE WRITE(numout,*) & & 'We have no soil carbon forcing data for this time step:', & & iatt WRITE(numout,*) ' -> we set them to zero' soilcarbon_input(:,:,:,iatt) = zero control_moist(:,:,iatt) = zero control_temp(:,:,iatt) = zero npp_equil(:,iatt) = zero ENDIF ENDDO IF (is_root_prc) THEN ALLOCATE(soilcarbon_input_g(nbp_glo,ncarb,nvm,nparan*nbyear)) ALLOCATE(control_moist_g(nbp_glo,nlevs,nparan*nbyear)) ALLOCATE(control_temp_g(nbp_glo,nlevs,nparan*nbyear)) ALLOCATE(npp_equil_g(nbp_glo,nparan*nbyear)) ENDIF CALL gather(clay,clay_g) CALL gather(soilcarbon_input,soilcarbon_input_g) CALL gather(control_moist,control_moist_g) CALL gather(control_temp,control_temp_g) CALL gather(npp_equil,npp_equil_g) !- IF (is_root_prc) THEN ier = NF90_CREATE (TRIM(Cforcing_name),NF90_WRITE,Cforcing_id) ier = NF90_PUT_ATT (Cforcing_id,NF90_GLOBAL, & & 'kjpindex',REAL(nbp_glo,r_std)) ier = NF90_PUT_ATT (Cforcing_id,NF90_GLOBAL, & & 'nparan',REAL(nparan,r_std)) ier = NF90_PUT_ATT (Cforcing_id,NF90_GLOBAL, & & 'nbyear',REAL(nbyear,r_std)) ier = NF90_DEF_DIM (Cforcing_id,'points',nbp_glo,d_id(1)) ier = NF90_DEF_DIM (Cforcing_id,'carbtype',ncarb,d_id(2)) ier = NF90_DEF_DIM (Cforcing_id,'vegtype',nvm,d_id(3)) ier = NF90_DEF_DIM (Cforcing_id,'level',nlevs,d_id(4)) ier = NF90_DEF_DIM (Cforcing_id,'time_step',nparan*nbyear,d_id(5)) !- ier = NF90_DEF_VAR (Cforcing_id,'points', r_typ,d_id(1),vid) ier = NF90_DEF_VAR (Cforcing_id,'carbtype', r_typ,d_id(2),vid) ier = NF90_DEF_VAR (Cforcing_id,'vegtype', r_typ,d_id(3),vid) ier = NF90_DEF_VAR (Cforcing_id,'level', r_typ,d_id(4),vid) ier = NF90_DEF_VAR (Cforcing_id,'time_step', r_typ,d_id(5),vid) ier = NF90_DEF_VAR (Cforcing_id,'index', r_typ,d_id(1),vid) ier = NF90_DEF_VAR (Cforcing_id,'clay', r_typ,d_id(1),vid) ier = NF90_DEF_VAR (Cforcing_id,'soilcarbon_input',r_typ, & & (/ d_id(1),d_id(2),d_id(3),d_id(5) /),vid) ier = NF90_DEF_VAR (Cforcing_id,'control_moist',r_typ, & & (/ d_id(1),d_id(4),d_id(5) /),vid) ier = NF90_DEF_VAR (Cforcing_id,'control_temp',r_typ, & & (/ d_id(1),d_id(4),d_id(5) /),vid) ier = NF90_DEF_VAR (Cforcing_id,'npp_equil',r_typ, & & (/ d_id(1),d_id(5) /),vid) ier = NF90_ENDDEF (Cforcing_id) !- ier = NF90_INQ_VARID (Cforcing_id,'points',vid) ier = NF90_PUT_VAR (Cforcing_id,vid, & & (/(REAL(i,r_std),i=1,nbp_glo)/)) ier = NF90_INQ_VARID (Cforcing_id,'carbtype',vid) ier = NF90_PUT_VAR (Cforcing_id,vid, & & (/(REAL(i,r_std),i=1,ncarb)/)) ier = NF90_INQ_VARID (Cforcing_id,'vegtype',vid) ier = NF90_PUT_VAR (Cforcing_id,vid, & & (/(REAL(i,r_std),i=1,nvm)/)) ier = NF90_INQ_VARID (Cforcing_id,'level',vid) ier = NF90_PUT_VAR (Cforcing_id,vid, & & (/(REAL(i,r_std),i=1,nlevs)/)) ier = NF90_INQ_VARID (Cforcing_id,'time_step',vid) ier = NF90_PUT_VAR (Cforcing_id,vid, & & (/(REAL(i,r_std),i=1,nparan*nbyear)/)) ier = NF90_INQ_VARID (Cforcing_id,'index',vid) ier = NF90_PUT_VAR (Cforcing_id,vid, REAL(index_g,r_std) ) ier = NF90_INQ_VARID (Cforcing_id,'clay',vid) ier = NF90_PUT_VAR (Cforcing_id,vid, clay_g ) ier = NF90_INQ_VARID (Cforcing_id,'soilcarbon_input',vid) ier = NF90_PUT_VAR (Cforcing_id,vid, soilcarbon_input_g ) ier = NF90_INQ_VARID (Cforcing_id,'control_moist',vid) ier = NF90_PUT_VAR (Cforcing_id,vid, control_moist_g ) ier = NF90_INQ_VARID (Cforcing_id,'control_temp',vid) ier = NF90_PUT_VAR (Cforcing_id,vid, control_temp_g ) ier = NF90_INQ_VARID (Cforcing_id,'npp_equil',vid) ier = NF90_PUT_VAR (Cforcing_id,vid, npp_equil_g ) !- ier = NF90_CLOSE (Cforcing_id) Cforcing_id = -1 ENDIF IF (is_root_prc) THEN DEALLOCATE(soilcarbon_input_g) DEALLOCATE(control_moist_g) DEALLOCATE(control_temp_g) DEALLOCATE(npp_equil_g) ENDIF ENDIF RETURN ENDIF ! write restart-files ! ! 4 Special treatment for some input arrays. ! ! ! 4.1 Sum of liquid and solid precipitation ! precip = ( precip_rain+precip_snow )*one_day/dtradia ! ! 4.2 Copy. ! ! 4.2.1 calculate STOMATE's vegetation fractions ! from veget and veget_max ! DO j=1,nvm WHERE ((1.-totfrac_nobio(:)) > min_sechiba) veget_cov(:,j)=veget(:,j)/( 1.-totfrac_nobio(:) ) veget_cov_max(:,j)=veget_max(:,j)/( 1.-totfrac_nobio(:) ) ELSEWHERE veget_cov(:,j) = zero veget_cov_max(:,j) = zero ENDWHERE ENDDO IF ( EndOfYear ) THEN DO j=1,nvm WHERE ((1.-totfrac_nobio(:)) > min_sechiba) veget_cov_max_new(:,j)=veget_max_new(:,j)/( 1.-totfrac_nobio(:) ) ELSEWHERE veget_cov_max_new(:,j) = zero ENDWHERE ENDDO ENDIF gpp_d(:,1) = zero DO j = 2,nvm ! 4.2.2 GPP ! gpp in gC/m**2 of total ground/day WHERE (veget_cov_max(:,j) > min_stomate) gpp_d(:,j) = gpp(:,j)/ veget_cov_max(:,j)* one_day/dtradia ELSEWHERE gpp_d(:,j) = zero ENDWHERE ENDDO ! ! 5 "daily" variables ! Note: If dt_days /= 1, then xx_daily are not daily variables, ! but that is not really a problem. ! ! ! 5.1 accumulate instantaneous variables ! and eventually calculate daily mean value ! CALL stomate_accu (kjpindex, nvm, dt_slow, dtradia, & & do_slow, humrel, humrel_daily) CALL stomate_accu (kjpindex, 1, dt_slow, dtradia, & & do_slow, litterhumdiag, litterhum_daily) CALL stomate_accu (kjpindex, 1, dt_slow, dtradia, & & do_slow, t2m, t2m_daily) CALL stomate_accu (kjpindex, 1, dt_slow, dtradia, & & do_slow, temp_sol, tsurf_daily) CALL stomate_accu (kjpindex, nbdl, dt_slow, dtradia, & & do_slow, stempdiag, tsoil_daily) CALL stomate_accu (kjpindex, nbdl, dt_slow, dtradia, & & do_slow, shumdiag, soilhum_daily) CALL stomate_accu (kjpindex, 1, dt_slow, dtradia, & & do_slow, precip, precip_daily) CALL stomate_accu (kjpindex, nvm, dt_slow, dtradia, & & do_slow, gpp_d, gpp_daily) ! ! 5.2 daily minimum temperature ! t2m_min_daily(:) = MIN( t2m_min(:), t2m_min_daily(:) ) ! ! 5.3 calculate respiration (NV 14/5/2002) ! ! 5.3.1 calculate maintenance respiration ! !NV maintenant lai est passé comme argument car on n'a plus les problemes de nat/agri! !donc plus à etre calculé ici.... CALL maint_respiration & & (kjpindex,dtradia,lai,t2m,tlong_ref,stempdiag,height,veget_cov_max, & & rprof,biomass,resp_maint_part_radia) resp_maint_radia(:,:) = zero DO j=2,nvm DO k= 1, nparts resp_maint_radia(:,j) = resp_maint_radia(:,j) & & +resp_maint_part_radia(:,j,k) ENDDO ENDDO resp_maint_part(:,:,:)= resp_maint_part(:,:,:) & & +resp_maint_part_radia(:,:,:) ! ! 5.3.2 the whole litter stuff: ! litter update, lignin content, PFT parts, litter decay, ! litter heterotrophic respiration, dead leaf soil cover. ! No vertical discretisation in the soil for litter decay. ! turnover_littercalc = turnover_daily * dtradia/one_day bm_to_littercalc = bm_to_litter*dtradia/one_day CALL littercalc (kjpindex, dtradia/one_day, & turnover_littercalc, bm_to_littercalc, & veget_cov_max, temp_sol, stempdiag, shumdiag, litterhumdiag, & litterpart, litter, dead_leaves, lignin_struc, & deadleaf_cover, resp_hetero_litter, & soilcarbon_input_inst, control_temp_inst, control_moist_inst) resp_hetero_litter=resp_hetero_litter*dtradia/one_day ! ! 5.3.3 soil carbon dynamics: heterotrophic respiration from the soil. ! For the moment, no vertical discretisation. ! We might later introduce a vertical discretisation. ! However, in that case, we would have to treat the vertical ! exchanges of carbon between the different levels. ! CALL soilcarbon (kjpindex, dtradia/one_day, clay, & soilcarbon_input_inst, control_temp_inst, control_moist_inst, & carbon, resp_hetero_soil) resp_hetero_soil=resp_hetero_soil*dtradia/one_day resp_hetero_radia = resp_hetero_litter+resp_hetero_soil resp_hetero_d = resp_hetero_d + resp_hetero_radia CALL stomate_accu (kjpindex, nlevs, dt_slow, dtradia, & & do_slow, control_moist_inst, control_moist_daily) CALL stomate_accu (kjpindex, nlevs, dt_slow, dtradia, & & do_slow, control_temp_inst, control_temp_daily) DO i=1,ncarb CALL stomate_accu (kjpindex, nvm, dt_slow, dtradia, & & do_slow, soilcarbon_input_inst(:,i,:), soilcarbon_input_daily(:,i,:)) ENDDO ! ! 6 Daily processes ! IF (do_slow) THEN ! 6.0 update lai IF (control%ok_pheno) THEN ! lai from stomate lai(:,ibare_sechiba) = zero DO j = 2, nvm lai(:,j) = biomass(:,j,ileaf)*sla(j) ENDDO ELSE CALL setlai(kjpindex,lai) ! lai prescribed ENDIF ! ! 6.1 total natural space ! ! ! 6.2 Calculate longer-term "meteorological" and biological parameters ! CALL season & & (kjpindex, dt_days, EndOfYear, & & veget_cov, veget_cov_max, & & humrel_daily, t2m_daily, tsoil_daily, soilhum_daily, & & precip_daily, npp_daily, biomass, & & turnover_daily, gpp_daily, when_growthinit, & & maxhumrel_lastyear, maxhumrel_thisyear, & & minhumrel_lastyear, minhumrel_thisyear, & & maxgppweek_lastyear, maxgppweek_thisyear, & & gdd0_lastyear, gdd0_thisyear, & & precip_lastyear, precip_thisyear, & & lm_lastyearmax, lm_thisyearmax, & & maxfpc_lastyear, maxfpc_thisyear, & & humrel_month, humrel_week, t2m_longterm, & & tlong_ref, t2m_month, t2m_week, tsoil_month, soilhum_month, & & npp_longterm, turnover_longterm, gpp_week, & & gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, & & time_lowgpp, time_hum_min, hum_min_dormance, herbivores) ! ! 6.3 STOMATE: allocation, phenology, etc. ! IF (control%ok_stomate) THEN ! 6.3.1 call stomate CALL StomateLpj & & (kjpindex, dt_days, EndOfYear, & & neighbours, resolution, & & clay, herbivores, & & tsurf_daily, tsoil_daily, t2m_daily, t2m_min_daily, & & litterhum_daily, soilhum_daily, & & maxhumrel_lastyear, minhumrel_lastyear, & & gdd0_lastyear, precip_lastyear, & & humrel_month, humrel_week, tlong_ref, t2m_month, t2m_week, & & tsoil_month, soilhum_month, & & gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, & & turnover_longterm, gpp_daily, time_lowgpp, & & time_hum_min, maxfpc_lastyear, resp_maint_part,& & PFTpresent, age, fireindex, firelitter, & & leaf_age, leaf_frac, biomass, ind, adapted, regenerate, & & senescence, when_growthinit, litterpart, litter, & & dead_leaves, carbon, black_carbon, lignin_struc, & & veget_cov_max, veget_cov, npp_longterm, lm_lastyearmax, & & veget_lastlight, everywhere, need_adjacent, RIP_time, & & lai, rprof,npp_daily, turnover_daily, turnover_time,& & control_moist_inst, control_temp_inst, soilcarbon_input_inst, & & co2_to_bm_dgvm, co2_fire, & & resp_hetero_d, resp_maint_d, resp_growth_d, & & height, deadleaf_cover, vcmax, vjmax, & & t_photo_min, t_photo_opt, t_photo_max,bm_to_litter,& & prod10, prod100, flux10, flux100, veget_cov_max_new,& & convflux, cflux_prod10, cflux_prod100, harvest_above, lcchange) ! ! 6.4 output: transform from dimension nvm to dimension nvm ! Several Stomate-PFTs may correspond ! to a single Sechiba-PFT (see 4.2). ! We sum up the vegetation cover over these Stomate-PFTs. ! Mean LAI, height, and Vmax is calculated ! by ponderating with (maximum) vegetation cover. ! ! 6.4.1 calculate veget, veget_max, ! from veget_cov and veget_cov_max veget(:,:) = zero veget_max(:,:) = zero ! DO j = 1, nvm veget(:,j) = veget(:,j) + & & veget_cov(:,j) * ( 1.-totfrac_nobio(:) ) veget_max(:,j) = veget_max(:,j) + & & veget_cov_max(:,j) * ( 1.-totfrac_nobio(:) ) ENDDO ! ! 6.4.2 photosynthesis parameters assim_param(:,:,ivcmax) = zero assim_param(:,:,ivjmax) = zero assim_param(:,:,itmin) = zero assim_param(:,:,itopt) = zero assim_param(:,:,itmax) = zero DO j = 2,nvm assim_param(:,j,ivcmax)=vcmax(:,j) ENDDO DO j = 2, nvm assim_param(:,j,ivjmax)=vjmax(:,j) ENDDO DO j = 2, nvm assim_param(:,j,itmin)=t_photo_min(:,j) ENDDO DO j = 2, nvm assim_param(:,j,itopt)=t_photo_opt(:,j) ENDDO DO j = 2, nvm assim_param(:,j,itmax)=t_photo_max(:,j) ENDDO ! ! 6.5 update forcing variables for soil carbon ! IF (ldcarbon_write .AND. TRIM(Cforcing_name) /= 'NONE') THEN npp_tot(:)=0 DO j=2,nvm npp_tot(:)=npp_tot(:) + npp_daily(:,j) ENDDO sf_time = MODULO(REAL(date,r_std)-1,one_year*REAL(nbyear,r_std)) iatt=FLOOR(sf_time/dt_forcesoil)+1 IF ((iatt < 1) .OR. (iatt > nparan*nbyear)) THEN WRITE(numout,*) 'Error with iatt=',iatt CALL ipslerr (3,'stomate', & & 'Error with iatt.', '', & & '(Problem with dt_forcesoil ?)') ENDIF IF ((iatt nsft ) isf(1) = 1 DO iisf = 2, nsfm isf(iisf) = isf(iisf-1)+1 IF (isf(iisf) > nsft) isf(iisf) = 1 ENDDO ! read them !for debug only! CALL forcing_read(forcing_id,nsfm) iisf = 0 ENDIF ENDIF ! 6.8 compute daily co2_flux ! CO2 flux in gC/m**2/sec ! (positive towards the atmosphere) is sum of: ! 1/ heterotrophic respiration from ground ! 2/ maintenance respiration from the plants ! 3/ growth respiration from the plants ! 4/ co2 created by fire ! 5/ - co2 taken up in the DGVM to establish saplings. ! 6/ - co2 taken up by photosyntyhesis !NV co2_flux devient un champs dépendant du PFT co2_flux_daily(:,:)= & & resp_maint_d(:,:) + resp_growth_d(:,:) + resp_hetero_d(:,:) + & & co2_fire(:,:) - co2_to_bm_dgvm(:,:) - gpp_daily(:,:) IF ( hist_id_stom_IPCC > 0 ) THEN vartmp(:)=SUM(co2_flux_daily*veget_cov_max,dim=2)/1e3/one_day*contfrac CALL histwrite (hist_id_stom_IPCC, "nep", itime, & vartmp, kjpindex, hori_index) ENDIF ! co2_flux_monthly(:,:) = co2_flux_monthly(:,:) + co2_flux_daily(:,:) IF ( day == 1 .AND. sec .LT. dtradia ) THEN IF ( control%ok_stomate ) THEN CALL histwrite (hist_id_stomate, 'CO2FLUX_MONTHLY', itime, & co2_flux_monthly, kjpindex*nvm, horipft_index) ENDIF !MM ! Si on supprimer le cumul par mois, ! il ne faut pas oublié cette modif resolution(:,1)*resolution(:,2)*contfrac(:) DO j=2, nvm co2_flux_monthly(:,j) = co2_flux_monthly(:,j)* & resolution(:,1)*resolution(:,2)*contfrac(:) ENDDO !NV modif calcul du net_co2_flux net_co2_flux_monthly = zero DO ji=1,kjpindex DO j=2,nvm net_co2_flux_monthly = net_co2_flux_monthly + & & co2_flux_monthly(ji,j)*veget_max(ji,j) ENDDO ENDDO net_co2_flux_monthly = net_co2_flux_monthly*1e-15 WRITE(numout,*) 'net_co2_flux_monthly (Peta gC/month) = ',net_co2_flux_monthly CALL reduce_sum(net_co2_flux_monthly,net_co2_flux_monthly_sum) IF ( control%ok_stomate ) THEN CALL histwrite (hist_id_stomate, 'CO2FLUX_MONTHLY_SUM', itime, & (/ net_co2_flux_monthly /), 1, (/ 1 /) ) ENDIF !!$ IF (is_root_prc) THEN !!$ OPEN( unit=39, & !!$ file="stomate_co2flux.data", & !!$ action="write", & !!$ position="append", & !!$ iostat=ios ) !!$ IF ( ios /= 0 ) THEN !!$ STOP "Erreur lors de la lecture/ecriture du fichier stomate_co2flux.data" !!$ ELSE !!$ WRITE(numout,*) !!$ WRITE(numout,*) "Ecriture du fichier stomate_co2flux.data" !!$ WRITE(numout,*) !!$ END IF !!$ WRITE(39,*) net_co2_flux_monthly_sum !!$ CLOSE( unit=39 ) !!$ ENDIF co2_flux_monthly(:,:) = zero ENDIF ! ! 6.9 reset daily variables ! humrel_daily(:,:) = zero litterhum_daily(:) = zero t2m_daily(:) = zero t2m_min_daily(:) = large_value tsurf_daily(:) = zero tsoil_daily(:,:) = zero soilhum_daily(:,:) = zero precip_daily(:) = zero gpp_daily(:,:) = zero resp_maint_part(:,:,:)=zero resp_hetero_d=zero IF (bavard >= 3) THEN WRITE(numout,*) 'stomate_main: daily processes done' ENDIF ENDIF ! daily processes? ! CO2FLUX Daily values are saved each dtradia, ! then the value is wrong for the first day without restart. IF ( hist_id > 0 ) THEN CALL histwrite (hist_id, 'CO2FLUX', itime, & co2_flux_daily, kjpindex*nvm, horipft_index) ENDIF IF ( hist2_id > 0 ) THEN CALL histwrite (hist2_id, 'CO2FLUX', itime, & co2_flux_daily, kjpindex*nvm, horipft_index) ENDIF ! ! 7 Outputs from Stomate ! co2_flux is assigned a value only if STOMATE is activated. ! Otherwise, the calling hydrological module must do this itself. ! IF ( control%ok_stomate ) THEN resp_maint(:,:) = resp_maint_radia(:,:)*veget_cov_max(:,:) resp_maint(:,ibare_sechiba) = zero resp_growth(:,:)= resp_growth_d(:,:)*veget_cov_max(:,:)*dtradia/one_day ! resp_hetero(:,:) = resp_hetero_radia(:,:)*veget_cov_max(:,:) ! CO2 flux in gC/m**2/sec (positive towards the atmosphere) is sum of: ! 1/ heterotrophic respiration from ground ! 2/ maintenance respiration from the plants ! 3/ growth respiration from the plants ! 4/ co2 created by fire ! 5/ - co2 taken up in the DGVM to establish saplings. ! 6/ - co2 taken up by photosyntyhesis co2_flux(:,:) = resp_hetero(:,:) + resp_maint(:,:) + resp_growth(:,:) & & + (co2_fire(:,:)-co2_to_bm_dgvm(:,:))*veget_cov_max(:,:)/one_day & & - gpp(:,:) ENDIF ! ! 8 message ! IF ( (bavard >= 2).AND.EndOfYear.AND.do_slow) THEN WRITE(numout,*) 'stomate: EndOfYear' ENDIF IF (bavard >= 4) WRITE(numout,*) 'Leaving stomate_main' IF (long_print) WRITE (numout,*) ' stomate_main done ' !-------------------------- END SUBROUTINE stomate_main ! != ! SUBROUTINE stomate_init & & (kjpij, kjpindex, index, ldforcing_write, lalo, & & rest_id_stom, hist_id_stom, hist_id_stom_IPCC) !--------------------------------------------------------------------- ! interface description ! input scalar ! Total size of the un-compressed grid INTEGER(i_std),INTENT(in) :: kjpij ! Domain size INTEGER(i_std),INTENT(in) :: kjpindex ! Logical for _forcing_ file to write LOGICAL,INTENT(in) :: ldforcing_write ! Geogr. coordinates (latitude,longitude) (degrees) REAL(r_std),DIMENSION(kjpindex,2),INTENT(in) :: lalo ! STOMATE's _Restart_ file file identifier INTEGER(i_std),INTENT(in) :: rest_id_stom ! STOMATE's _history_ file file identifier INTEGER(i_std),INTENT(in) :: hist_id_stom ! STOMATE's IPCC _history_ file file identifier INTEGER(i_std),INTENT(in) :: hist_id_stom_IPCC ! input fields ! Indeces of the points on the map INTEGER(i_std),DIMENSION(kjpindex),INTENT(in) :: index ! local declaration REAL(r_std) :: tmp_day(1) ! soil depth taken for canopy REAL(r_std) :: zcanop ! soil depths at diagnostic levels REAL(r_std),DIMENSION(nbdl) :: zsoil ! Index INTEGER(i_std) :: l ! allocation error LOGICAL :: l_error ! Global world fraction of vegetation type map REAL(r_std),DIMENSION(360,180,nvm) :: veget_ori_on_disk INTEGER(i_std) :: ier ! indices INTEGER(i_std) :: ji,j,ipd !--------------------------------------------------------------------- ! ! 1 online diagnostics ! (by default, "bavard" is set to 1 in stomate_constants) ! !Config Key = BAVARD !Config Desc = level of online diagnostics in STOMATE (0-4) !Config Def = 1 !Config Help = With this variable, you can determine !Config how much online information STOMATE !Config gives during the run. 0 means !Config virtually no info. ! bavard = 1 CALL getin_p('BAVARD', bavard) IF ( kjpindex > 0 ) THEN ! !Config Key = STOMATE_DIAGPT !Config Desc = Index of grid point for online diagnostics !Config Def = 1 !Config Help = This is the index of the grid point which ! will be used for online diagnostics. ipd = 1 CALL getin_p('STOMATE_DIAGPT',ipd) ipd = MIN( ipd, kjpindex ) WRITE(numout,*) 'Stomate: ' WRITE(numout,*) ' Index of grid point for online diagnostics: ',ipd WRITE(numout,*) ' Lon, lat:',lalo(ipd,2),lalo(ipd,1) WRITE(numout,*) ' Index of this point on GCM grid: ',index(ipd) ! ENDIF ! ! 2 check consistency of flags ! IF ( ( .NOT. control%ok_stomate ) .AND. control%ok_dgvm ) THEN WRITE(numout,*) 'Cannot do dynamical vegetation without STOMATE.' WRITE(numout,*) 'We stop.' STOP ENDIF IF ((.NOT.control%ok_co2).AND.control%ok_stomate) THEN WRITE(numout,*) 'Cannot call STOMATE without GPP.' WRITE(numout,*) 'We stop.' STOP ENDIF IF ( ( .NOT. control%ok_co2 ) .AND. ldforcing_write ) THEN WRITE(numout,*) & & 'Cannot write forcing file if photosynthesis is not activated' WRITE(numout,*) 'We stop.' STOP ENDIF ! ! 3 messages ! WRITE(numout,*) 'stomate: first call' WRITE(numout,*) ' Photosynthesis: ', control%ok_co2 WRITE(numout,*) ' STOMATE: ', control%ok_stomate WRITE(numout,*) ' LPJ: ', control%ok_dgvm ! ! 4 allocation of STOMATE's variables ! l_error = .FALSE. ALLOCATE(veget_cov_max(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(veget_cov_max_new(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(ind(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(adapted(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(regenerate(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(humrel_daily(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(litterhum_daily(kjpindex),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(t2m_daily(kjpindex),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(t2m_min_daily(kjpindex),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(tsurf_daily(kjpindex),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(tsoil_daily(kjpindex,nbdl),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(soilhum_daily(kjpindex,nbdl),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(precip_daily(kjpindex),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(gpp_daily(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(npp_daily(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(turnover_daily(kjpindex,nvm,nparts),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(turnover_littercalc(kjpindex,nvm,nparts),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(humrel_month(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(humrel_week(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(t2m_longterm(kjpindex),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(tlong_ref(kjpindex),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(t2m_month(kjpindex),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(t2m_week(kjpindex),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(tsoil_month(kjpindex,nbdl),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(soilhum_month(kjpindex,nbdl),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(fireindex(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(firelitter(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(maxhumrel_lastyear(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(maxhumrel_thisyear(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(minhumrel_lastyear(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(minhumrel_thisyear(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(maxgppweek_lastyear(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(maxgppweek_thisyear(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(gdd0_lastyear(kjpindex),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(gdd0_thisyear(kjpindex),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(precip_lastyear(kjpindex),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(precip_thisyear(kjpindex),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(gdd_m5_dormance(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(gdd_midwinter(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(ncd_dormance(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(ngd_minus5(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(PFTpresent(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(npp_longterm(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(lm_lastyearmax(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(lm_thisyearmax(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(maxfpc_lastyear(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(maxfpc_thisyear(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(turnover_longterm(kjpindex,nvm,nparts),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(gpp_week(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(biomass(kjpindex,nvm,nparts),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(senescence(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(when_growthinit(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(age(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(resp_hetero_d(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(resp_hetero_radia(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(resp_maint_d(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(resp_growth_d(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) !NV devient 2D ALLOCATE(co2_fire(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) !NV devient 2D ALLOCATE(co2_to_bm_dgvm(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(veget_lastlight(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(everywhere(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(need_adjacent(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(leaf_age(kjpindex,nvm,nleafages),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(leaf_frac(kjpindex,nvm,nleafages),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(RIP_time(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(time_lowgpp(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(time_hum_min(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(hum_min_dormance(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(litterpart(kjpindex,nvm,nlitt),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(litter(kjpindex,nlitt,nvm,nlevs),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(dead_leaves(kjpindex,nvm,nlitt),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(carbon(kjpindex,ncarb,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(black_carbon(kjpindex),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(lignin_struc(kjpindex,nvm,nlevs),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(turnover_time(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(co2_flux_daily(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(co2_flux_monthly(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(bm_to_litter(kjpindex,nvm,nparts),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(bm_to_littercalc(kjpindex,nvm,nparts),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(herbivores(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(hori_index(kjpindex),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(horipft_index(kjpindex*nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(resp_maint_part_radia(kjpindex,nvm,nparts),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(resp_maint_radia(kjpindex,nvm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(resp_maint_part(kjpindex,nvm,nparts),stat=ier) l_error = l_error .OR. (ier /= 0) resp_maint_part(:,:,:)=zero ALLOCATE (horip10_index(kjpindex*10), stat=ier) l_error = l_error .OR. (ier.NE.0) ALLOCATE (horip100_index(kjpindex*100), stat=ier) l_error = l_error .OR. (ier.NE.0) ALLOCATE (horip11_index(kjpindex*11), stat=ier) l_error = l_error .OR. (ier.NE.0) ALLOCATE (horip101_index(kjpindex*101), stat=ier) l_error = l_error .OR. (ier.NE.0) ALLOCATE (prod10(kjpindex,0:10), stat=ier) l_error = l_error .OR. (ier.NE.0) ALLOCATE (prod100(kjpindex,0:100), stat=ier) l_error = l_error .OR. (ier.NE.0) ALLOCATE (flux10(kjpindex,10), stat=ier) l_error = l_error .OR. (ier.NE.0) ALLOCATE (flux100(kjpindex,100), stat=ier) l_error = l_error .OR. (ier.NE.0) ALLOCATE (convflux(kjpindex), stat=ier) l_error = l_error .OR. (ier.NE.0) ALLOCATE (cflux_prod10(kjpindex), stat=ier) l_error = l_error .OR. (ier.NE.0) ALLOCATE (cflux_prod100(kjpindex), stat=ier) l_error = l_error .OR. (ier.NE.0) ALLOCATE (harvest_above(kjpindex), stat=ier) l_error = l_error .OR. (ier.NE.0) ALLOCATE (soilcarbon_input_daily(kjpindex,ncarb,nvm), stat=ier) l_error = l_error .OR. (ier.NE.0) ALLOCATE (control_temp_daily(kjpindex,nlevs), stat=ier) l_error = l_error .OR. (ier.NE.0) ALLOCATE (control_moist_daily(kjpindex,nlevs), stat=ier) l_error = l_error .OR. (ier.NE.0) ! IF (l_error) THEN STOP 'stomate_init: error in memory allocation' ENDIF ! ! 5 file definitions: stored in common variables ! hist_id_stomate = hist_id_stom hist_id_stomate_IPCC = hist_id_stom_IPCC rest_id_stomate = rest_id_stom hori_index(:) = index(:) ! Get the indexing table for the vegetation fields. ! In STOMATE we work on ! reduced grids but to store in the full 3D filed vegetation variable ! we need another index table : indexpft DO j = 1, nvm DO ji = 1, kjpindex horipft_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij ENDDO ENDDO ! indexing tables added for land cover change fields DO j = 1, 10 DO ji = 1, kjpindex horip10_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij ENDDO ENDDO DO j = 1, 100 DO ji = 1, kjpindex horip100_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij ENDDO ENDDO DO j = 1, 11 DO ji = 1, kjpindex horip11_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij ENDDO ENDDO DO j = 1, 101 DO ji = 1, kjpindex horip101_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij ENDDO ENDDO ! ! 6 some flags ! ! !Config Key = HERBIVORES !Config Desc = herbivores allowed? !Config Def = n !Config Help = With this variable, you can determine !Config if herbivores are activated ! ok_herbivores = .FALSE. CALL getin_p('HERBIVORES', ok_herbivores) ! WRITE(numout,*) 'herbivores activated: ',ok_herbivores ! !Config Key = TREAT_EXPANSION !Config Desc = treat expansion of PFTs across a grid cell? !Config Def = n !Config Help = With this variable, you can determine !Config whether we treat expansion of PFTs across a !Config grid cell. ! treat_expansion = .FALSE. CALL getin_p('TREAT_EXPANSION', treat_expansion) ! WRITE(numout,*) & & 'expansion across a grid cell is treated: ',treat_expansion !Config Key = HARVEST_AGRI !Config Desc = Harvert model for agricol PFTs. !Config Def = y !Config Help = Compute harvest above ground biomass for agriculture. !Config Change daily turnover. harvest_agri = .TRUE. CALL getin_p('HARVEST_AGRI', harvest_agri) ! ! 7 some global initializations ! ! edit shilong ! bm_to_litter(:,:,:) = zero turnover_daily(:,:,:) = zero resp_hetero_d(:,:) = zero co2_flux_daily(:,:) = zero co2_flux_monthly(:,:) = zero ! initialisation of land cover change variables prod10(:,:) = zero prod100(:,:) = zero flux10(:,:) = zero flux100(:,:) = zero convflux(:) = zero cflux_prod10(:) = zero cflux_prod100(:)= zero !-------------------------- END SUBROUTINE stomate_init ! != ! SUBROUTINE stomate_clear !--------------------------------------------------------------------- ! 1. Deallocate all dynamics variables IF (ALLOCATED(veget_cov_max)) DEALLOCATE(veget_cov_max) IF (ALLOCATED(veget_cov_max_new)) DEALLOCATE(veget_cov_max_new) IF (ALLOCATED(ind)) DEALLOCATE(ind) IF (ALLOCATED(adapted)) DEALLOCATE(adapted) IF (ALLOCATED(regenerate)) DEALLOCATE(regenerate) IF (ALLOCATED(humrel_daily)) DEALLOCATE(humrel_daily) IF (ALLOCATED(litterhum_daily)) DEALLOCATE(litterhum_daily) IF (ALLOCATED(t2m_daily)) DEALLOCATE(t2m_daily) IF (ALLOCATED(t2m_min_daily)) DEALLOCATE(t2m_min_daily) IF (ALLOCATED(tsurf_daily)) DEALLOCATE(tsurf_daily) IF (ALLOCATED(tsoil_daily)) DEALLOCATE(tsoil_daily) IF (ALLOCATED(soilhum_daily)) DEALLOCATE(soilhum_daily) IF (ALLOCATED(precip_daily)) DEALLOCATE(precip_daily) IF (ALLOCATED(gpp_daily)) DEALLOCATE(gpp_daily) IF (ALLOCATED(npp_daily)) DEALLOCATE(npp_daily) IF (ALLOCATED(turnover_daily)) DEALLOCATE(turnover_daily) IF (ALLOCATED(turnover_littercalc)) DEALLOCATE(turnover_littercalc) IF (ALLOCATED(humrel_month)) DEALLOCATE(humrel_month) IF (ALLOCATED(humrel_week)) DEALLOCATE(humrel_week) IF (ALLOCATED(t2m_longterm)) DEALLOCATE(t2m_longterm) IF (ALLOCATED(tlong_ref)) DEALLOCATE(tlong_ref) IF (ALLOCATED(t2m_month)) DEALLOCATE(t2m_month) IF (ALLOCATED(t2m_week)) DEALLOCATE(t2m_week) IF (ALLOCATED(tsoil_month)) DEALLOCATE(tsoil_month) IF (ALLOCATED(soilhum_month)) DEALLOCATE(soilhum_month) IF (ALLOCATED(fireindex)) DEALLOCATE(fireindex) IF (ALLOCATED(firelitter)) DEALLOCATE(firelitter) IF (ALLOCATED(maxhumrel_lastyear)) DEALLOCATE(maxhumrel_lastyear) IF (ALLOCATED(maxhumrel_thisyear)) DEALLOCATE(maxhumrel_thisyear) IF (ALLOCATED(minhumrel_lastyear)) DEALLOCATE(minhumrel_lastyear) IF (ALLOCATED(minhumrel_thisyear)) DEALLOCATE(minhumrel_thisyear) IF (ALLOCATED(maxgppweek_lastyear)) DEALLOCATE(maxgppweek_lastyear) IF (ALLOCATED(maxgppweek_thisyear)) DEALLOCATE(maxgppweek_thisyear) IF (ALLOCATED(gdd0_lastyear)) DEALLOCATE(gdd0_lastyear) IF (ALLOCATED(gdd0_thisyear)) DEALLOCATE(gdd0_thisyear) IF (ALLOCATED(precip_lastyear)) DEALLOCATE(precip_lastyear) IF (ALLOCATED(precip_thisyear)) DEALLOCATE(precip_thisyear) IF (ALLOCATED(gdd_m5_dormance)) DEALLOCATE(gdd_m5_dormance) IF (ALLOCATED(gdd_midwinter)) DEALLOCATE(gdd_midwinter) IF (ALLOCATED(ncd_dormance)) DEALLOCATE(ncd_dormance) IF (ALLOCATED(ngd_minus5)) DEALLOCATE(ngd_minus5) IF (ALLOCATED(PFTpresent)) DEALLOCATE(PFTpresent) IF (ALLOCATED(npp_longterm)) DEALLOCATE(npp_longterm) IF (ALLOCATED(lm_lastyearmax)) DEALLOCATE(lm_lastyearmax) IF (ALLOCATED(lm_thisyearmax)) DEALLOCATE(lm_thisyearmax) IF (ALLOCATED(maxfpc_lastyear)) DEALLOCATE(maxfpc_lastyear) IF (ALLOCATED(maxfpc_thisyear)) DEALLOCATE(maxfpc_thisyear) IF (ALLOCATED(turnover_longterm)) DEALLOCATE(turnover_longterm) IF (ALLOCATED(gpp_week)) DEALLOCATE(gpp_week) IF (ALLOCATED(biomass)) DEALLOCATE(biomass) IF (ALLOCATED(senescence)) DEALLOCATE(senescence) IF (ALLOCATED(when_growthinit)) DEALLOCATE(when_growthinit) IF (ALLOCATED(age)) DEALLOCATE(age) IF (ALLOCATED(resp_hetero_d)) DEALLOCATE(resp_hetero_d) IF (ALLOCATED(resp_hetero_radia)) DEALLOCATE(resp_hetero_radia) IF (ALLOCATED(resp_maint_d)) DEALLOCATE(resp_maint_d) IF (ALLOCATED(resp_growth_d)) DEALLOCATE(resp_growth_d) IF (ALLOCATED(co2_fire)) DEALLOCATE(co2_fire) IF (ALLOCATED(co2_to_bm_dgvm)) DEALLOCATE(co2_to_bm_dgvm) IF (ALLOCATED(veget_lastlight)) DEALLOCATE(veget_lastlight) IF (ALLOCATED(everywhere)) DEALLOCATE(everywhere) IF (ALLOCATED(need_adjacent)) DEALLOCATE(need_adjacent) IF (ALLOCATED(leaf_age)) DEALLOCATE(leaf_age) IF (ALLOCATED(leaf_frac)) DEALLOCATE(leaf_frac) IF (ALLOCATED(RIP_time)) DEALLOCATE(RIP_time) IF (ALLOCATED(time_lowgpp)) DEALLOCATE(time_lowgpp) IF (ALLOCATED(time_hum_min)) DEALLOCATE(time_hum_min) IF (ALLOCATED(hum_min_dormance)) DEALLOCATE(hum_min_dormance) IF (ALLOCATED(litterpart)) DEALLOCATE(litterpart) IF (ALLOCATED(litter)) DEALLOCATE(litter) IF (ALLOCATED(dead_leaves)) DEALLOCATE(dead_leaves) IF (ALLOCATED(carbon)) DEALLOCATE(carbon) IF (ALLOCATED(black_carbon)) DEALLOCATE(black_carbon) IF (ALLOCATED(lignin_struc)) DEALLOCATE(lignin_struc) IF (ALLOCATED(turnover_time)) DEALLOCATE(turnover_time) IF (ALLOCATED(co2_flux_daily)) DEALLOCATE(co2_flux_daily) IF (ALLOCATED(co2_flux_monthly)) DEALLOCATE(co2_flux_monthly) IF (ALLOCATED(bm_to_litter)) DEALLOCATE(bm_to_litter) IF (ALLOCATED(bm_to_littercalc)) DEALLOCATE(bm_to_littercalc) IF (ALLOCATED(herbivores)) DEALLOCATE(herbivores) IF (ALLOCATED(resp_maint_part_radia)) DEALLOCATE(resp_maint_part_radia) IF (ALLOCATED(resp_maint_radia)) DEALLOCATE(resp_maint_radia) IF (ALLOCATED(resp_maint_part)) DEALLOCATE(resp_maint_part) IF (ALLOCATED(hori_index)) DEALLOCATE(hori_index) IF (ALLOCATED(horipft_index)) DEALLOCATE(horipft_index) IF (ALLOCATED(clay_fm)) DEALLOCATE(clay_fm) IF (ALLOCATED(humrel_daily_fm)) DEALLOCATE(humrel_daily_fm) IF (ALLOCATED(litterhum_daily_fm)) DEALLOCATE(litterhum_daily_fm) IF (ALLOCATED(t2m_daily_fm)) DEALLOCATE(t2m_daily_fm) IF (ALLOCATED(t2m_min_daily_fm)) DEALLOCATE(t2m_min_daily_fm) IF (ALLOCATED(tsurf_daily_fm)) DEALLOCATE(tsurf_daily_fm) IF (ALLOCATED(tsoil_daily_fm)) DEALLOCATE(tsoil_daily_fm) IF (ALLOCATED(soilhum_daily_fm)) DEALLOCATE(soilhum_daily_fm) IF (ALLOCATED(precip_fm)) DEALLOCATE(precip_fm) IF (ALLOCATED(gpp_daily_fm)) DEALLOCATE(gpp_daily_fm) IF (ALLOCATED(resp_maint_part_fm)) DEALLOCATE(resp_maint_part_fm) IF (ALLOCATED(veget_fm)) DEALLOCATE(veget_fm) IF (ALLOCATED(veget_max_fm)) DEALLOCATE(veget_max_fm) IF (ALLOCATED(lai_fm)) DEALLOCATE(lai_fm) IF (is_root_prc) THEN IF (ALLOCATED(clay_fm_g)) DEALLOCATE(clay_fm_g) IF (ALLOCATED(humrel_daily_fm_g)) DEALLOCATE(humrel_daily_fm_g) IF (ALLOCATED(litterhum_daily_fm_g)) DEALLOCATE(litterhum_daily_fm_g) IF (ALLOCATED(t2m_daily_fm_g)) DEALLOCATE(t2m_daily_fm_g) IF (ALLOCATED(t2m_min_daily_fm_g)) DEALLOCATE(t2m_min_daily_fm_g) IF (ALLOCATED(tsurf_daily_fm_g)) DEALLOCATE(tsurf_daily_fm_g) IF (ALLOCATED(tsoil_daily_fm_g)) DEALLOCATE(tsoil_daily_fm_g) IF (ALLOCATED(soilhum_daily_fm_g)) DEALLOCATE(soilhum_daily_fm_g) IF (ALLOCATED(precip_fm_g)) DEALLOCATE(precip_fm_g) IF (ALLOCATED(gpp_daily_fm_g)) DEALLOCATE(gpp_daily_fm_g) IF (ALLOCATED(resp_maint_part_fm_g)) DEALLOCATE(resp_maint_part_fm_g) IF (ALLOCATED(veget_fm_g)) DEALLOCATE(veget_fm_g) IF (ALLOCATED(veget_max_fm_g)) DEALLOCATE(veget_max_fm_g) IF (ALLOCATED(lai_fm_g)) DEALLOCATE(lai_fm_g) ENDIF IF (ALLOCATED(isf)) DEALLOCATE(isf) IF (ALLOCATED(nf_written)) DEALLOCATE(nf_written) IF (ALLOCATED(nf_cumul)) DEALLOCATE(nf_cumul) IF (ALLOCATED(nforce)) DEALLOCATE(nforce) IF (ALLOCATED(control_moist)) DEALLOCATE(control_moist) IF (ALLOCATED(control_temp)) DEALLOCATE(control_temp) IF (ALLOCATED(soilcarbon_input)) DEALLOCATE(soilcarbon_input) IF ( ALLOCATED (horip10_index)) DEALLOCATE (horip10_index) IF ( ALLOCATED (horip100_index)) DEALLOCATE (horip100_index) IF ( ALLOCATED (horip11_index)) DEALLOCATE (horip11_index) IF ( ALLOCATED (horip101_index)) DEALLOCATE (horip101_index) IF ( ALLOCATED (prod10)) DEALLOCATE (prod10) IF ( ALLOCATED (prod100)) DEALLOCATE (prod100) IF ( ALLOCATED (flux10)) DEALLOCATE (flux10) IF ( ALLOCATED (flux100)) DEALLOCATE (flux100) IF ( ALLOCATED (convflux)) DEALLOCATE (convflux) IF ( ALLOCATED (cflux_prod10)) DEALLOCATE (cflux_prod10) IF ( ALLOCATED (cflux_prod100)) DEALLOCATE (cflux_prod100) IF ( ALLOCATED (harvest_above)) DEALLOCATE (harvest_above) IF ( ALLOCATED (soilcarbon_input_daily)) DEALLOCATE (soilcarbon_input_daily) IF ( ALLOCATED (control_temp_daily)) DEALLOCATE (control_temp_daily) IF ( ALLOCATED (control_moist_daily)) DEALLOCATE (control_moist_daily) ! 2. reset l_first l_first_stomate=.TRUE. ! 3. call to clear functions CALL get_reftemp_clear CALL season_clear CALL stomatelpj_clear CALL littercalc_clear CALL vmax_clear !--------------------------- END SUBROUTINE stomate_clear ! != ! SUBROUTINE stomate_var_init & & (kjpindex, veget_cov, veget_cov_max, leaf_age, leaf_frac, & & tlong_ref, t2m_month, dead_leaves, & & veget, lai, qsintmax, deadleaf_cover, assim_param) !--------------------------------------------------------------------- ! this subroutine outputs values of assim_param etc. ! only if ok_stomate = .TRUE. ! otherwise,the calling procedure must do it itself. ! ! interface description ! input scalar ! Domain size INTEGER(i_std),INTENT(in) :: kjpindex ! input fields ! fractional coverage: actually covered space REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in) :: veget_cov ! fractional coverage: maximum covered space REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in) :: veget_cov_max ! "long term" 2 meter reference temperatures (K) REAL(r_std),DIMENSION(kjpindex),INTENT(in) :: tlong_ref ! "monthly" 2 meter temperatures (K) REAL(r_std),DIMENSION(kjpindex),INTENT(in) :: t2m_month ! dead leaves on ground, per PFT, metabolic and structural, ! in gC/(m**2 of ground) REAL(r_std),DIMENSION(kjpindex,nvm,nlitt),INTENT(in) :: dead_leaves ! Fraction of vegetation type REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in) :: veget ! Surface foliere REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in) :: lai ! modified fields (actually NOT modified) ! leaf age (d) REAL(r_std),DIMENSION(kjpindex,nvm,nleafages),INTENT(inout) :: leaf_age ! fraction of leaves in leaf age class REAL(r_std),DIMENSION(kjpindex,nvm,nleafages),INTENT(inout) :: leaf_frac ! output scalar ! output fields ! Maximum water on vegetation for interception REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out) :: qsintmax ! fraction of soil covered by dead leaves REAL(r_std),DIMENSION(kjpindex), INTENT (out) :: deadleaf_cover ! min+max+opt temps & vmax for photosynthesis REAL(r_std),DIMENSION(kjpindex,nvm,npco2),INTENT(out) :: assim_param !- ! local declaration !- ! dummy time step, must be zero REAL(r_std),PARAMETER :: dt_0 = 0. REAL(r_std),DIMENSION(kjpindex,nvm) :: vcmax REAL(r_std),DIMENSION(kjpindex,nvm) :: vjmax ! Min temperature for photosynthesis (deg C) REAL(r_std),DIMENSION(kjpindex,nvm) :: t_photo_min ! Opt temperature for photosynthesis (deg C) REAL(r_std),DIMENSION(kjpindex,nvm) :: t_photo_opt ! Max temperature for photosynthesis (deg C) REAL(r_std),DIMENSION(kjpindex,nvm) :: t_photo_max ! Index INTEGER(i_std) :: j !--------------------------------------------------------------------- IF (control%ok_stomate) THEN ! ! 1 photosynthesis parameters ! ! ! 1.1 vcmax ! only if STOMATE is activated ! CALL vmax (kjpindex, dt_0, leaf_age, leaf_frac, vcmax, vjmax) ! ! 1.2 assimilation temperatures ! CALL assim_temp(kjpindex, tlong_ref, t2m_month, & & t_photo_min, t_photo_opt, t_photo_max) ! ! 1.3 transform into nvm vegetation types ! assim_param(:,:,ivcmax) = zero DO j = 2, nvm assim_param(:,j,ivcmax)=vcmax(:,j) ENDDO assim_param(:,:,ivjmax) = zero DO j = 2, nvm assim_param(:,j,ivjmax)=vjmax(:,j) ENDDO assim_param(:,:,itmin) = zero DO j = 2, nvm assim_param(:,j,itmin)=t_photo_min(:,j) ENDDO assim_param(:,:,itopt) = zero DO j = 2, nvm assim_param(:,j,itopt)=t_photo_opt(:,j) ENDDO assim_param(:,:,itmax) = zero DO j = 2, nvm assim_param(:,j,itmax)=t_photo_max(:,j) ENDDO ! ! 2 dead leaf cover ! ! edit shilong ! CALL deadleaf (kjpindex, dead_leaves, deadleaf_cover) CALL deadleaf (kjpindex, veget_cov_max, dead_leaves, deadleaf_cover) ! ! 3 qsintmax ! qsintmax(:,ibare_sechiba) = zero DO j=2,nvm qsintmax(:,j) = qsintcst*veget(:,j)*lai(:,j) ENDDO ENDIF ! ok_stomate = .TRUE. !-------------------------------- END SUBROUTINE stomate_var_init ! != ! SUBROUTINE stomate_accu & & (npts, n_dim2, dt_tot, dt, ldmean, field_in, field_out) !--------------------------------------------------------------------- ! ! 0 declarations ! ! 0.1 input ! ! Domain size INTEGER(i_std),INTENT(in) :: npts ! 2nd dimension (1 or nvm) INTEGER(i_std),INTENT(in) :: n_dim2 ! Time step of STOMATE (days) REAL(r_std),INTENT(in) :: dt_tot ! Time step in days REAL(r_std),INTENT(in) :: dt ! Calculate mean ? LOGICAL,INTENT(in) :: ldmean ! Daily field REAL(r_std),DIMENSION(npts,n_dim2),INTENT(in) :: field_in ! ! 0.2 modified field ! ! Annual field REAL(r_std),DIMENSION(npts,n_dim2),INTENT(inout) :: field_out !--------------------------------------------------------------------- ! ! 1 accumulation ! field_out(:,:) = field_out(:,:)+field_in(:,:)*dt ! ! 2 mean fields ! IF (ldmean) THEN field_out(:,:) = field_out(:,:)/dt_tot ENDIF !--------------------------------------------------------------------- END SUBROUTINE stomate_accu SUBROUTINE init_forcing (kjpindex,nsfm,nsft) !--------------------------------------------------------------------- INTEGER(i_std),INTENT(in) :: kjpindex INTEGER(i_std),INTENT(in) :: nsfm INTEGER(i_std),INTENT(in) :: nsft ! LOGICAL :: l_error INTEGER(i_std) :: ier !--------------------------------------------------------------------- l_error = .FALSE. ! ALLOCATE(clay_fm(kjpindex,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(humrel_daily_fm(kjpindex,nvm,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(litterhum_daily_fm(kjpindex,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(t2m_daily_fm(kjpindex,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(t2m_min_daily_fm(kjpindex,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(tsurf_daily_fm(kjpindex,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(tsoil_daily_fm(kjpindex,nbdl,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(soilhum_daily_fm(kjpindex,nbdl,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(precip_fm(kjpindex,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(gpp_daily_fm(kjpindex,nvm,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(resp_maint_part_fm(kjpindex,nvm,nparts,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(veget_fm(kjpindex,nvm,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(veget_max_fm(kjpindex,nvm,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(lai_fm(kjpindex,nvm,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(isf(nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(nf_written(nsft),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(nf_cumul(nsft),stat=ier) l_error = l_error .OR. (ier /= 0) IF (is_root_prc) THEN ALLOCATE(clay_fm_g(nbp_glo,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(humrel_daily_fm_g(nbp_glo,nvm,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(litterhum_daily_fm_g(nbp_glo,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(t2m_daily_fm_g(nbp_glo,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(t2m_min_daily_fm_g(nbp_glo,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(tsurf_daily_fm_g(nbp_glo,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(tsoil_daily_fm_g(nbp_glo,nbdl,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(soilhum_daily_fm_g(nbp_glo,nbdl,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(precip_fm_g(nbp_glo,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(gpp_daily_fm_g(nbp_glo,nvm,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(resp_maint_part_fm_g(nbp_glo,nvm,nparts,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(veget_fm_g(nbp_glo,nvm,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(veget_max_fm_g(nbp_glo,nvm,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ALLOCATE(lai_fm_g(nbp_glo,nvm,nsfm),stat=ier) l_error = l_error .OR. (ier /= 0) ENDIF ! IF (l_error) THEN WRITE(numout,*) 'Problem with memory allocation: forcing variables' STOP 'init_forcing' ENDIF ! CALL forcing_zero !-------------------------- END SUBROUTINE init_forcing ! != ! SUBROUTINE forcing_zero !--------------------------------------------------------------------- clay_fm(:,:) = zero humrel_daily_fm(:,:,:) = zero litterhum_daily_fm(:,:) = zero t2m_daily_fm(:,:) = zero t2m_min_daily_fm(:,:) = zero tsurf_daily_fm(:,:) = zero tsoil_daily_fm(:,:,:) = zero soilhum_daily_fm(:,:,:) = zero precip_fm(:,:) = zero gpp_daily_fm(:,:,:) = zero resp_maint_part_fm(:,:,:,:)=zero veget_fm(:,:,:) = zero veget_max_fm(:,:,:) = zero lai_fm(:,:,:) = zero !-------------------------------- END SUBROUTINE forcing_zero ! != ! SUBROUTINE forcing_write(forcing_id,ibeg,iend) !--------------------------------------------------------------------- INTEGER(i_std),INTENT(in) :: forcing_id INTEGER(i_std),INTENT(in) :: ibeg, iend ! INTEGER(i_std) :: iisf, iblocks, nblocks INTEGER(i_std) :: ier INTEGER(i_std),DIMENSION(0:2) :: ifirst, ilast INTEGER(i_std),PARAMETER :: ndm = 10 INTEGER(i_std),DIMENSION(ndm) :: start, count_force INTEGER(i_std) :: ndim, vid !--------------------------------------------------------------------- ! ! determine blocks of forcing states that are contiguous in memory ! nblocks = 0 ifirst(:) = 1 ilast(:) = 1 ! DO iisf = ibeg, iend IF ( (nblocks /= 0) & & .AND.(isf(iisf) == isf(ilast(nblocks))+1)) THEN ! element is contiguous with last element found ilast(nblocks) = iisf ELSE ! found first element of new block nblocks = nblocks+1 IF (nblocks > 2) STOP 'Problem in forcing_write' ifirst(nblocks) = iisf ilast(nblocks) = iisf ENDIF ENDDO ! CALL gather(clay_fm,clay_fm_g) CALL gather(humrel_daily_fm,humrel_daily_fm_g) CALL gather(litterhum_daily_fm,litterhum_daily_fm_g) CALL gather(t2m_daily_fm,t2m_daily_fm_g) CALL gather(t2m_min_daily_fm,t2m_min_daily_fm_g) CALL gather(tsurf_daily_fm,tsurf_daily_fm_g) CALL gather(tsoil_daily_fm,tsoil_daily_fm_g) CALL gather(soilhum_daily_fm,soilhum_daily_fm_g) CALL gather(precip_fm,precip_fm_g) CALL gather(gpp_daily_fm,gpp_daily_fm_g) CALL gather(resp_maint_part_fm,resp_maint_part_fm_g) CALL gather(veget_fm,veget_fm_g) CALL gather(veget_max_fm,veget_max_fm_g) CALL gather(lai_fm,lai_fm_g) IF (is_root_prc) THEN DO iblocks = 1, nblocks IF (ifirst(iblocks) /= ilast(iblocks)) THEN ndim = 2 start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(clay_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'clay',vid) ier = NF90_PUT_VAR (forcing_id,vid, & & clay_fm_g(:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 3; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(humrel_daily_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'humrel',vid) ier = NF90_PUT_VAR (forcing_id, vid, & & humrel_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 2; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(litterhum_daily_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'litterhum',vid) ier = NF90_PUT_VAR (forcing_id, vid, & & litterhum_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 2; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(t2m_daily_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'t2m',vid) ier = NF90_PUT_VAR (forcing_id, vid, & & t2m_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 2; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(t2m_min_daily_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'t2m_min',vid) ier = NF90_PUT_VAR (forcing_id, vid, & & t2m_min_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 2; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(tsurf_daily_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'tsurf',vid) ier = NF90_PUT_VAR (forcing_id, vid, & & tsurf_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 3; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(tsoil_daily_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'tsoil',vid) ier = NF90_PUT_VAR (forcing_id, vid, & & tsoil_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 3; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(soilhum_daily_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'soilhum',vid) ier = NF90_PUT_VAR (forcing_id, vid, & & soilhum_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 2; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(precip_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'precip',vid) ier = NF90_PUT_VAR (forcing_id, vid, & & precip_fm_g(:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 3; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(gpp_daily_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'gpp',vid) ier = NF90_PUT_VAR (forcing_id, vid, & & gpp_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 4; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim)=SHAPE(resp_maint_part_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'resp_maint_part',vid) ier = NF90_PUT_VAR (forcing_id,vid, & & resp_maint_part_fm_g(:,:,:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 3; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(veget_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'veget',vid) ier = NF90_PUT_VAR (forcing_id, vid, & & veget_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 3; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(veget_max_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'veget_max',vid) ier = NF90_PUT_VAR (forcing_id, vid, & & veget_max_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 3; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(lai_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'lai',vid) ier = NF90_PUT_VAR (forcing_id, vid, & & lai_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ENDIF ENDDO ENDIF nf_written(isf(:)) = .TRUE. !--------------------------- END SUBROUTINE forcing_write ! != ! SUBROUTINE forcing_read(forcing_id,nsfm) !--------------------------------------------------------------------- INTEGER(i_std),INTENT(in) :: forcing_id INTEGER(i_std),INTENT(in) :: nsfm ! INTEGER(i_std) :: iisf, iblocks, nblocks INTEGER(i_std) :: ier INTEGER(i_std),DIMENSION(0:2) :: ifirst, ilast INTEGER(i_std),PARAMETER :: ndm = 10 INTEGER(i_std),DIMENSION(ndm) :: start, count_force INTEGER(i_std) :: ndim, vid !--------------------------------------------------------------------- ! ! set to zero if the corresponding forcing state ! has not yet been written into the file ! DO iisf = 1, nsfm IF (.NOT.nf_written(isf(iisf))) THEN clay_fm(:,iisf) = zero humrel_daily_fm(:,:,iisf) = zero litterhum_daily_fm(:,iisf) = zero t2m_daily_fm(:,iisf) = zero t2m_min_daily_fm(:,iisf) = zero tsurf_daily_fm(:,iisf) = zero tsoil_daily_fm(:,:,iisf) = zero soilhum_daily_fm(:,:,iisf) = zero precip_fm(:,iisf) = zero gpp_daily_fm(:,:,iisf) = zero resp_maint_part_fm(:,:,:,iisf) = zero veget_fm(:,:,iisf) = zero veget_max_fm(:,:,iisf) = zero lai_fm(:,:,iisf) = zero ENDIF ENDDO ! ! determine blocks of forcing states that are contiguous in memory ! nblocks = 0 ifirst(:) = 1 ilast(:) = 1 ! DO iisf = 1, nsfm IF (nf_written(isf(iisf))) THEN IF ( (nblocks /= 0) & & .AND.(isf(iisf) == isf(ilast(nblocks))+1)) THEN ! element is contiguous with last element found ilast(nblocks) = iisf ELSE ! found first element of new block nblocks = nblocks+1 IF (nblocks > 2) STOP 'Problem in forcing_read' ! ifirst(nblocks) = iisf ilast(nblocks) = iisf ENDIF ENDIF ENDDO ! IF (is_root_prc) THEN DO iblocks = 1, nblocks IF (ifirst(iblocks) /= ilast(iblocks)) THEN ndim = 2; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(clay_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'clay',vid) ier = NF90_GET_VAR (forcing_id, vid, & & clay_fm_g(:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 3; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(humrel_daily_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'humrel',vid) ier = NF90_GET_VAR (forcing_id, vid, & & humrel_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 2; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(litterhum_daily_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'litterhum',vid) ier = NF90_GET_VAR (forcing_id, vid, & & litterhum_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 2; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(t2m_daily_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'t2m',vid) ier = NF90_GET_VAR (forcing_id, vid, & & t2m_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 2; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(t2m_min_daily_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'t2m_min',vid) ier = NF90_GET_VAR (forcing_id, vid, & & t2m_min_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 2; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(tsurf_daily_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'tsurf',vid) ier = NF90_GET_VAR (forcing_id, vid, & & tsurf_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 3; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(tsoil_daily_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'tsoil',vid) ier = NF90_GET_VAR (forcing_id, vid, & & tsoil_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 3; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(soilhum_daily_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'soilhum',vid) ier = NF90_GET_VAR (forcing_id, vid, & & soilhum_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 2; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(precip_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'precip',vid) ier = NF90_GET_VAR (forcing_id, vid, & & precip_fm_g(:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 3; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(gpp_daily_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'gpp',vid) ier = NF90_GET_VAR (forcing_id, vid, & & gpp_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 4; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim)=SHAPE(resp_maint_part_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'resp_maint_part',vid) ier = NF90_GET_VAR (forcing_id,vid, & & resp_maint_part_fm_g(:,:,:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 3; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(veget_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'veget',vid) ier = NF90_GET_VAR (forcing_id, vid, & & veget_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 3; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(veget_max_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'veget_max',vid) ier = NF90_GET_VAR (forcing_id, vid, & & veget_max_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ndim = 3; start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); count_force(1:ndim) = SHAPE(lai_fm_g) count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 ier = NF90_INQ_VARID (forcing_id,'lai',vid) ier = NF90_GET_VAR (forcing_id, vid, & & lai_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & & start=start(1:ndim), count=count_force(1:ndim)) ENDIF ENDDO ENDIF CALL scatter(clay_fm_g,clay_fm) CALL scatter(humrel_daily_fm_g,humrel_daily_fm) CALL scatter(litterhum_daily_fm_g,litterhum_daily_fm) CALL scatter(t2m_daily_fm_g,t2m_daily_fm) CALL scatter(t2m_min_daily_fm_g,t2m_min_daily_fm) CALL scatter(tsurf_daily_fm_g,tsurf_daily_fm) CALL scatter(tsoil_daily_fm_g,tsoil_daily_fm) CALL scatter(soilhum_daily_fm_g,soilhum_daily_fm) CALL scatter(precip_fm_g,precip_fm) CALL scatter(gpp_daily_fm_g,gpp_daily_fm) CALL scatter(resp_maint_part_fm_g,resp_maint_part_fm) CALL scatter(veget_fm_g,veget_fm) CALL scatter(veget_max_fm_g,veget_max_fm) CALL scatter(lai_fm_g,lai_fm_g) !-------------------------- END SUBROUTINE forcing_read ! != ! SUBROUTINE setlai(npts,lai) !--------------------------------------------------------------------- ! routine to force the lai in STOMATE (for assimilation procedures) ! for the moment setlai only gives the lai from stomate, ! this routine must be written in the future ! ! 0 declarations ! ! 0.1 input ! ! Domain size INTEGER(i_std),INTENT(in) :: npts ! 0.3 output REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: lai ! 0.4 local definitions INTEGER(i_std) :: j !--------------------------------------------------------------------- lai(:,ibare_sechiba) = zero DO j=2,nvm lai(:,j) = biomass(:,j,ileaf)*sla(j) ENDDO !-------------------- END SUBROUTINE setlai ! ! !----------------- END MODULE stomate