From 8bc114b9d961fb67e965b2eb5563430b0aa127d9 Mon Sep 17 00:00:00 2001
From: Dethinne Thomas <tdethinne@uliege.be>
Date: Wed, 24 Apr 2024 09:38:57 +0000
Subject: [PATCH] add source code
---
.../ver01_Iv_couplage/Carbon/carbon_01_Iv.F | 4 +
.../caraib_main_01_Iv_couplage.F | 862 +++++++++++
.../carbon_biomass_correction.f | 43 +
.../CARAIB/ver01_Iv_couplage/carbon_cal_in.f | 289 ++++
.../CARAIB/ver01_Iv_couplage/carbon_fire.f | 237 +++
.../ver01_Iv_couplage/carbon_frac_herbs.f | 48 +
.../ver01_Iv_couplage/carbon_frac_trees.f | 49 +
.../CARAIB/ver01_Iv_couplage/carbon_gpp_cal.f | 559 +++++++
.../ver01_Iv_couplage/carbon_lai_limit_w.f | 124 ++
.../carbon_lai_limit_w_monthly.f | 134 ++
.../ver01_Iv_couplage/carbon_lailim_init.f | 33 +
.../ver01_Iv_couplage/carbon_mortality.f | 148 ++
.../ver01_Iv_couplage/carbon_new_frac.f | 153 ++
.../CARAIB/ver01_Iv_couplage/carbon_npp_cal.f | 391 +++++
.../ver01_Iv_couplage/carbon_pft_estab.f | 150 ++
.../ver01_Iv_couplage/carbon_ponc_init.f | 128 ++
.../ver01_Iv_couplage/carbon_set_cpools.f | 96 ++
.../ver01_Iv_couplage/carbon_soil_resp.f | 303 ++++
.../ver01_Iv_couplage/carbon_solar_flux.f | 92 ++
.../ver01_Iv_couplage/carbon_solar_trees.f | 107 ++
.../ver01_Iv_couplage/carbon_wat_limit.f | 69 +
.../CARAIB/ver01_Iv_couplage/carbon_wri_res.f | 395 +++++
.../ver01_Iv_couplage/carbon_year_iteration.f | 574 +++++++
.../ver01_Iv_couplage/com_18/abobio.common | 2 +
.../ver01_Iv_couplage/com_18/acclim.common | 3 +
.../ver01_Iv_couplage/com_18/ageclas.common | 6 +
.../ver01_Iv_couplage/com_18/all.common | 771 ++++++++++
.../ver01_Iv_couplage/com_18/angppf.common | 2 +
.../ver01_Iv_couplage/com_18/annee.common | 4 +
.../ver01_Iv_couplage/com_18/annppf.common | 2 +
.../ver01_Iv_couplage/com_18/bagnum.common | 2 +
.../ver01_Iv_couplage/com_18/biomasse.common | 4 +
.../ver01_Iv_couplage/com_18/bkdf.common | 2 +
.../ver01_Iv_couplage/com_18/burned.common | 10 +
.../ver01_Iv_couplage/com_18/c3cst.common | 4 +
.../ver01_Iv_couplage/com_18/c3en.common | 2 +
.../ver01_Iv_couplage/com_18/c4cst.common | 2 +
.../com_18/carbon_maxi.common | 2 +
.../ver01_Iv_couplage/com_18/climin.common | 5 +
.../ver01_Iv_couplage/com_18/climin0.common | 6 +
.../ver01_Iv_couplage/com_18/climin1.common | 2 +
.../ver01_Iv_couplage/com_18/climin2.common | 2 +
.../ver01_Iv_couplage/com_18/climin3.common | 2 +
.../ver01_Iv_couplage/com_18/climkop.common | 4 +
.../ver01_Iv_couplage/com_18/cloud.common | 2 +
.../ver01_Iv_couplage/com_18/cmoiRmin.common | 3 +
.../ver01_Iv_couplage/com_18/co2.common | 2 +
.../ver01_Iv_couplage/com_18/coldrv.common | 2 +
.../ver01_Iv_couplage/com_18/coord.common | 7 +
.../ver01_Iv_couplage/com_18/crops.common | 11 +
.../ver01_Iv_couplage/com_18/cstmort.common | 4 +
.../ver01_Iv_couplage/com_18/cstpi.common | 2 +
.../ver01_Iv_couplage/com_18/cte.common | 10 +
.../ver01_Iv_couplage/com_18/day_corr.common | 2 +
.../ver01_Iv_couplage/com_18/dayres.common | 7 +
.../ver01_Iv_couplage/com_18/deltac13.common | 2 +
.../ver01_Iv_couplage/com_18/disper.common | 13 +
.../ver01_Iv_couplage/com_18/down_reg.common | 2 +
.../ver01_Iv_couplage/com_18/drain.common | 3 +
.../ver01_Iv_couplage/com_18/eco.common | 5 +
.../ver01_Iv_couplage/com_18/ecoin.common | 2 +
.../ver01_Iv_couplage/com_18/ecoin2.common | 2 +
.../ver01_Iv_couplage/com_18/ecopro.common | 6 +
.../ver01_Iv_couplage/com_18/envi.common | 6 +
.../com_18/epaiss_tot.common | 2 +
.../ver01_Iv_couplage/com_18/epaisseur.common | 2 +
.../ver01_Iv_couplage/com_18/estab.common | 3 +
.../ver01_Iv_couplage/com_18/ext_con.common | 5 +
.../ver01_Iv_couplage/com_18/ext_con2.common | 2 +
.../ver01_Iv_couplage/com_18/fgr.common | 3 +
.../ver01_Iv_couplage/com_18/files_car.common | 35 +
.../ver01_Iv_couplage/com_18/files_ext.common | 6 +
.../com_18/files_ext2.common | 5 +
.../ver01_Iv_couplage/com_18/files_ibm.common | 26 +
.../ver01_Iv_couplage/com_18/fileunits.common | 10 +
.../ver01_Iv_couplage/com_18/fire_emi.common | 2 +
.../ver01_Iv_couplage/com_18/firevpar.common | 4 +
.../ver01_Iv_couplage/com_18/flux_w.common | 2 +
.../com_18/frac_change.common | 14 +
.../ver01_Iv_couplage/com_18/fracc13.common | 2 +
.../ver01_Iv_couplage/com_18/gama.common | 2 +
.../ver01_Iv_couplage/com_18/gcaci.common | 5 +
.../ver01_Iv_couplage/com_18/gcaci2.common | 5 +
.../ver01_Iv_couplage/com_18/gddpix.common | 16 +
.../ver01_Iv_couplage/com_18/gene.common | 6 +
.../ver01_Iv_couplage/com_18/ginp_old.common | 3 +
.../CARAIB/ver01_Iv_couplage/com_18/gk.common | 3 +
.../ver01_Iv_couplage/com_18/gridclim.common | 2 +
.../ver01_Iv_couplage/com_18/griddata.common | 5 +
.../ver01_Iv_couplage/com_18/gridin2.common | 2 +
.../ver01_Iv_couplage/com_18/h2ocst.common | 2 +
.../ver01_Iv_couplage/com_18/hcst.common | 2 +
.../ver01_Iv_couplage/com_18/heure.common | 3 +
.../ver01_Iv_couplage/com_18/icyr.common | 20 +
.../ver01_Iv_couplage/com_18/inidata.common | 15 +
.../ver01_Iv_couplage/com_18/init.common | 2 +
.../ver01_Iv_couplage/com_18/input_par.common | 2 +
.../ver01_Iv_couplage/com_18/iprt.common | 40 +
.../ver01_Iv_couplage/com_18/irep.common | 6 +
.../ver01_Iv_couplage/com_18/kernel.common | 7 +
.../ver01_Iv_couplage/com_18/lai.common | 2 +
.../ver01_Iv_couplage/com_18/laih2o.common | 6 +
.../ver01_Iv_couplage/com_18/lailim.common | 2 +
.../ver01_Iv_couplage/com_18/laiste.common | 2 +
.../ver01_Iv_couplage/com_18/landuse.common | 5 +
.../ver01_Iv_couplage/com_18/landuse0.common | 5 +
.../ver01_Iv_couplage/com_18/litiere.common | 3 +
.../ver01_Iv_couplage/com_18/loop.common | 2 +
.../ver01_Iv_couplage/com_18/lstcli.common | 2 +
.../ver01_Iv_couplage/com_18/lstreg.common | 2 +
.../ver01_Iv_couplage/com_18/lstz.common | 2 +
.../ver01_Iv_couplage/com_18/luc.common | 5 +
.../ver01_Iv_couplage/com_18/lucflx.common | 3 +
.../com_18/management.common | 5 +
.../ver01_Iv_couplage/com_18/memory.common | 2 +
.../ver01_Iv_couplage/com_18/mois.common | 2 +
.../ver01_Iv_couplage/com_18/monres.common | 5 +
.../ver01_Iv_couplage/com_18/monthcst.common | 4 +
.../ver01_Iv_couplage/com_18/monthcst2.common | 3 +
.../ver01_Iv_couplage/com_18/monwat.common | 2 +
.../ver01_Iv_couplage/com_18/mort.common | 18 +
.../com_18/netcdf_name.common | 6 +
.../com_18/netcdf_par.common | 6 +
.../ver01_Iv_couplage/com_18/newbdo.common | 2 +
.../ver01_Iv_couplage/com_18/npp.common | 2 +
.../ver01_Iv_couplage/com_18/nspc.common | 2 +
.../com_18/number_year.common | 2 +
.../com_18/old_cstmort.common | 4 +
.../ver01_Iv_couplage/com_18/parameter.common | 12 +
.../com_18/parameter2.common | 10 +
.../com_18/parameter_orb.common | 10 +
.../ver01_Iv_couplage/com_18/pathg.common | 2 +
.../ver01_Iv_couplage/com_18/pheno.common | 2 +
.../ver01_Iv_couplage/com_18/pho_sch.common | 2 +
.../ver01_Iv_couplage/com_18/pixdata.common | 2 +
.../com_18/plant_evol.common | 3 +
.../com_18/plant_pool.common | 4 +
.../ver01_Iv_couplage/com_18/plheight.common | 2 +
.../ver01_Iv_couplage/com_18/pnpp.common | 7 +
.../ver01_Iv_couplage/com_18/pnpp2.common | 7 +
.../ver01_Iv_couplage/com_18/prev_yr.common | 3 +
.../ver01_Iv_couplage/com_18/prt.common | 21 +
.../ver01_Iv_couplage/com_18/prt_ctrl.common | 2 +
.../ver01_Iv_couplage/com_18/prt_old.common | 17 +
.../ver01_Iv_couplage/com_18/pzone.common | 2 +
.../ver01_Iv_couplage/com_18/radcst.common | 2 +
.../ver01_Iv_couplage/com_18/rblcst1.common | 2 +
.../ver01_Iv_couplage/com_18/res_par.common | 2 +
.../ver01_Iv_couplage/com_18/res_temp.common | 4 +
.../ver01_Iv_couplage/com_18/res_temp2.common | 4 +
.../CARAIB/ver01_Iv_couplage/com_18/rk.common | 4 +
.../ver01_Iv_couplage/com_18/smrd.common | 3 +
.../ver01_Iv_couplage/com_18/snow.common | 2 +
.../com_18/soil_marie.common | 3 +
.../ver01_Iv_couplage/com_18/soil_pool.common | 2 +
.../ver01_Iv_couplage/com_18/soilin.common | 1 +
.../ver01_Iv_couplage/com_18/sol_in.common | 2 +
.../ver01_Iv_couplage/com_18/solpar.common | 6 +
.../ver01_Iv_couplage/com_18/sr_par.common | 2 +
.../ver01_Iv_couplage/com_18/sresp.common | 2 +
.../ver01_Iv_couplage/com_18/strate.common | 2 +
.../ver01_Iv_couplage/com_18/temper.common | 2 +
.../com_18/test_conve.common | 1 +
.../com_18/test_conver.common | 1 +
.../ver01_Iv_couplage/com_18/textcst1.common | 6 +
.../ver01_Iv_couplage/com_18/textcst2.common | 1 +
.../ver01_Iv_couplage/com_18/tresh.common | 6 +
.../ver01_Iv_couplage/com_18/varday.common | 6 +
.../ver01_Iv_couplage/com_18/varnow.common | 14 +
.../ver01_Iv_couplage/com_18/vegfr.common | 2 +
.../ver01_Iv_couplage/com_18/veglab.common | 2 +
.../ver01_Iv_couplage/com_18/waflux.common | 5 +
.../ver01_Iv_couplage/com_18/watmin.common | 1 +
.../ver01_Iv_couplage/com_18/xlaic.common | 3 +
.../ver01_Iv_couplage/com_18/xvalues.common | 5 +
.../CARAIB/ver01_Iv_couplage/compil_01_Iv.sh | 4 +
.../ver01_Iv_couplage/hydro/hydro_01_Iv.F | 45 +
.../CARAIB/ver01_Iv_couplage/hydro_backdiff.f | 35 +
.../CARAIB/ver01_Iv_couplage/hydro_bashfor.f | 37 +
.../CARAIB/ver01_Iv_couplage/hydro_drainage.f | 156 ++
.../CARAIB/ver01_Iv_couplage/hydro_esat.f | 28 +
.../ver01_Iv_couplage/hydro_fgrn_calc.f | 17 +
.../CARAIB/ver01_Iv_couplage/hydro_funcx.f | 101 ++
.../CARAIB/ver01_Iv_couplage/hydro_givedrv.f | 811 ++++++++++
.../CARAIB/ver01_Iv_couplage/hydro_initbdo.f | 62 +
.../CARAIB/ver01_Iv_couplage/hydro_moulton.f | 37 +
.../CARAIB/ver01_Iv_couplage/hydro_nonlineq.f | 188 +++
couplage/CARAIB/ver01_Iv_couplage/hydro_ode.f | 82 +
.../CARAIB/ver01_Iv_couplage/hydro_printing.f | 363 +++++
.../CARAIB/ver01_Iv_couplage/hydro_remember.f | 34 +
.../CARAIB/ver01_Iv_couplage/hydro_runkut4.f | 45 +
.../CARAIB/ver01_Iv_couplage/hydro_set_frac.f | 206 +++
.../CARAIB/ver01_Iv_couplage/hydro_timdep.f | 109 ++
.../CARAIB/ver01_Iv_couplage/hydro_utils.f | 234 +++
couplage/CARAIB/ver01_Iv_couplage/mod_TDT.f | 139 ++
.../ver01_Iv_couplage/mod_calrapportprecip.f | 78 +
.../mod_check_and_open_files.f | 85 ++
.../CARAIB/ver01_Iv_couplage/mod_clasparam.f | 157 ++
.../CARAIB/ver01_Iv_couplage/mod_close_file.f | 339 +++++
.../CARAIB/ver01_Iv_couplage/mod_close_mig.f | 26 +
.../ver01_Iv_couplage/mod_crop_sowing_dates.f | 38 +
.../CARAIB/ver01_Iv_couplage/mod_crops_seas.f | 74 +
couplage/CARAIB/ver01_Iv_couplage/mod_ctgen.f | 69 +
couplage/CARAIB/ver01_Iv_couplage/mod_cth2o.f | 527 +++++++
.../ver01_Iv_couplage/mod_daily_weather.f | 247 +++
.../CARAIB/ver01_Iv_couplage/mod_dispersion.f | 520 +++++++
.../CARAIB/ver01_Iv_couplage/mod_dryseas.f | 46 +
couplage/CARAIB/ver01_Iv_couplage/mod_exch.f | 36 +
.../ver01_Iv_couplage/mod_fraction_luc.f | 266 ++++
.../CARAIB/ver01_Iv_couplage/mod_funcx2.f | 96 ++
.../CARAIB/ver01_Iv_couplage/mod_generator.f | 260 ++++
.../CARAIB/ver01_Iv_couplage/mod_hourly.f | 32 +
.../CARAIB/ver01_Iv_couplage/mod_humiseas.f | 47 +
.../CARAIB/ver01_Iv_couplage/mod_koppen2.f | 274 ++++
.../CARAIB/ver01_Iv_couplage/mod_monthparam.f | 68 +
.../ver01_Iv_couplage/mod_neighborhood.f | 77 +
.../ver01_Iv_couplage/mod_neighborhood_old.f | 124 ++
.../ver01_Iv_couplage/mod_netcdfcaraib.mod | Bin 0 -> 64175 bytes
.../ver01_Iv_couplage/mod_netcdfcaraib_09.f | 137 ++
.../CARAIB/ver01_Iv_couplage/mod_new_frac2.f | 233 +++
.../CARAIB/ver01_Iv_couplage/mod_nonlineq2.f | 219 +++
.../CARAIB/ver01_Iv_couplage/mod_open_file.f | 1355 +++++++++++++++++
.../ver01_Iv_couplage/mod_open_input5.f | 407 +++++
.../CARAIB/ver01_Iv_couplage/mod_open_mig.f | 71 +
.../CARAIB/ver01_Iv_couplage/mod_orb_params.f | 496 ++++++
.../ver01_Iv_couplage/mod_pixel_corners.f | 61 +
.../CARAIB/ver01_Iv_couplage/mod_printparam.f | 36 +
.../CARAIB/ver01_Iv_couplage/mod_randnum.F | 31 +
.../CARAIB/ver01_Iv_couplage/mod_read_eco.f | 69 +
.../CARAIB/ver01_Iv_couplage/mod_read_in.f | 710 +++++++++
.../CARAIB/ver01_Iv_couplage/mod_read_init.f | 108 ++
.../CARAIB/ver01_Iv_couplage/mod_read_lu.f | 139 ++
.../ver01_Iv_couplage/mod_read_luspecies.f | 53 +
.../CARAIB/ver01_Iv_couplage/mod_read_mig.f | 157 ++
.../ver01_Iv_couplage/mod_record_grid.f | 72 +
couplage/CARAIB/ver01_Iv_couplage/mod_solar.f | 132 ++
couplage/CARAIB/ver01_Iv_couplage/mod_utils.f | 104 ++
.../CARAIB/ver01_Iv_couplage/mod_veg_phases.f | 171 +++
.../CARAIB/ver01_Iv_couplage/mod_wri_1st.f | 58 +
.../CARAIB/ver01_Iv_couplage/mod_write_luc.f | 52 +
couplage/CARAIB/ver01_Iv_couplage/mod_zone2.f | 134 ++
.../CARAIB/ver01_Iv_couplage/mod_zonepxl2.f | 124 ++
242 files changed, 17851 insertions(+)
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/Carbon/carbon_01_Iv.F
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/caraib_main_01_Iv_couplage.F
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_biomass_correction.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_cal_in.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_fire.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_frac_herbs.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_frac_trees.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_gpp_cal.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_lai_limit_w.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_lai_limit_w_monthly.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_lailim_init.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_mortality.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_new_frac.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_npp_cal.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_pft_estab.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_ponc_init.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_set_cpools.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_soil_resp.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_solar_flux.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_solar_trees.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_wat_limit.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_wri_res.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/carbon_year_iteration.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/abobio.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/acclim.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/ageclas.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/all.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/angppf.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/annee.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/annppf.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/bagnum.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/biomasse.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/bkdf.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/burned.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/c3cst.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/c3en.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/c4cst.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/carbon_maxi.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/climin.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/climin0.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/climin1.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/climin2.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/climin3.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/climkop.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/cloud.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/cmoiRmin.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/co2.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/coldrv.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/coord.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/crops.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/cstmort.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/cstpi.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/cte.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/day_corr.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/dayres.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/deltac13.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/disper.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/down_reg.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/drain.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/eco.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/ecoin.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/ecoin2.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/ecopro.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/envi.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/epaiss_tot.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/epaisseur.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/estab.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/ext_con.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/ext_con2.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/fgr.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/files_car.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/files_ext.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/files_ext2.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/files_ibm.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/fileunits.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/fire_emi.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/firevpar.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/flux_w.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/frac_change.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/fracc13.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/gama.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/gcaci.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/gcaci2.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/gddpix.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/gene.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/ginp_old.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/gk.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/gridclim.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/griddata.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/gridin2.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/h2ocst.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/hcst.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/heure.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/icyr.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/inidata.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/init.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/input_par.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/iprt.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/irep.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/kernel.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/lai.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/laih2o.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/lailim.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/laiste.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/landuse.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/landuse0.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/litiere.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/loop.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/lstcli.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/lstreg.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/lstz.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/luc.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/lucflx.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/management.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/memory.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/mois.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/monres.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/monthcst.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/monthcst2.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/monwat.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/mort.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/netcdf_name.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/netcdf_par.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/newbdo.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/npp.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/nspc.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/number_year.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/old_cstmort.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/parameter.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/parameter2.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/parameter_orb.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/pathg.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/pheno.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/pho_sch.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/pixdata.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/plant_evol.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/plant_pool.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/plheight.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/pnpp.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/pnpp2.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/prev_yr.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/prt.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/prt_ctrl.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/prt_old.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/pzone.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/radcst.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/rblcst1.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/res_par.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/res_temp.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/res_temp2.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/rk.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/smrd.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/snow.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/soil_marie.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/soil_pool.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/soilin.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/sol_in.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/solpar.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/sr_par.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/sresp.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/strate.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/temper.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/test_conve.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/test_conver.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/textcst1.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/textcst2.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/tresh.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/varday.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/varnow.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/vegfr.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/veglab.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/waflux.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/watmin.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/xlaic.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/com_18/xvalues.common
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/compil_01_Iv.sh
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/hydro/hydro_01_Iv.F
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/hydro_backdiff.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/hydro_bashfor.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/hydro_drainage.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/hydro_esat.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/hydro_fgrn_calc.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/hydro_funcx.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/hydro_givedrv.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/hydro_initbdo.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/hydro_moulton.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/hydro_nonlineq.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/hydro_ode.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/hydro_printing.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/hydro_remember.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/hydro_runkut4.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/hydro_set_frac.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/hydro_timdep.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/hydro_utils.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_TDT.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_calrapportprecip.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_check_and_open_files.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_clasparam.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_close_file.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_close_mig.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_crop_sowing_dates.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_crops_seas.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_ctgen.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_cth2o.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_daily_weather.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_dispersion.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_dryseas.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_exch.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_fraction_luc.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_funcx2.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_generator.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_hourly.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_humiseas.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_koppen2.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_monthparam.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_neighborhood.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_neighborhood_old.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_netcdfcaraib.mod
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_netcdfcaraib_09.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_new_frac2.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_nonlineq2.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_open_file.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_open_input5.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_open_mig.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_orb_params.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_pixel_corners.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_printparam.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_randnum.F
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_read_eco.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_read_in.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_read_init.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_read_lu.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_read_luspecies.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_read_mig.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_record_grid.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_solar.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_utils.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_veg_phases.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_wri_1st.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_write_luc.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_zone2.f
create mode 100644 couplage/CARAIB/ver01_Iv_couplage/mod_zonepxl2.f
diff --git a/couplage/CARAIB/ver01_Iv_couplage/Carbon/carbon_01_Iv.F b/couplage/CARAIB/ver01_Iv_couplage/Carbon/carbon_01_Iv.F
new file mode 100644
index 0000000..b3bc259
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/Carbon/carbon_01_Iv.F
@@ -0,0 +1,4 @@
+
+Il n'y a plus rien ici
+
+
diff --git a/couplage/CARAIB/ver01_Iv_couplage/caraib_main_01_Iv_couplage.F b/couplage/CARAIB/ver01_Iv_couplage/caraib_main_01_Iv_couplage.F
new file mode 100644
index 0000000..3871ea7
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/caraib_main_01_Iv_couplage.F
@@ -0,0 +1,862 @@
+ subroutine caraib
+c// Fichier caraib_netcdf_02.F du jeudi 18 d�cembre 2014, 11:51:02 (UTC+0100)
+c// - completed enhanced NetCDF
+c// Fichier caraib_netcdf_01.F du mercredi 17 d�cembre 2014, 08:19:43 (UTC+0100)
+c// - Corrected a few Fortran non-conformities ("name="; "rand(0.)")
+c// - Also corrected declaration in common/disper.common
+c// - Further added more verbose HANDLE_NCERRORS to mod_netcdfcaraib
+c//
+c// Fichier caraib_netcdf_00.f du mardi 16 d�cembre 2014, 16:05:38 (UTC+0100)
+c// - Initial NetCDF version
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c CCCC AA RRRAR AA II BBB
+c CC AAA R RA AAA II B BB
+c CC A AA R RR AA A II B BB
+c CC AAAAA RRRR AAAAA II BBB
+c CC A AA R RA AA A II B BB
+c CC A AA R RA AA A II B BB
+c CCCC A AA R RA AA A II BBBB
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c CARAIB: CARbon Assimilation In the Biosphere
+c A global vegetation model
+c contact: francois@astro.ulg.ac.be
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc72
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc72
+c II BBBBBB MM MM
+c II BB BB MMM MMM
+c II BB BB MMMM MMMM
+c II BBBBBB MM MMM MM
+c II BB BB MM M MM
+c II BB BB MM MM
+c II BBBBBB MM MM
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc72
+c IBM: Improved Bucket Model
+c A global soil hydrological model
+c written by : L. Francois, B. Hubert
+c contact: francois@astro.ulg.ac.be
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc72
+c
+c !!! CAUTION-CAUTION-CAUTION-CAUTION-CAUTION-CAUTION-CAUTION !!!
+c
+c CAUTION: maximum number of pixels : ngrid = 100000
+c maximum number of vegetation types : nplant = 40
+c
+c if larger values of these parameters are to be used,
+c they should be changed in the parameter line
+c ('parameter.common' file)
+c
+c=====================================================================72
+ USE MOD_NETCDFCARAIB
+ IMPLICIT NONE
+
+c// BEGIN
+ CHARACTER(LEN=*), PARAMETER :: fn_caraib = __FILE__
+c
+ INTEGER :: istatusn
+ ! Starting indices and counters for NetCDF reads
+ INTEGER, DIMENSION(3), SAVE :: istart = 0, ncount = 0
+c ! Starting indices and counters for NetCDF reads
+ INTEGER, DIMENSION(3), SAVE :: istartn = 0, ncountn = 0
+c ! Temporary indices for searching purposes
+ INTEGER :: ncpos_lon_saven, ncpos_lat_saven, ntimedata
+
+c// END
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer i,i_pix,igrr,ipr,iprint,istatus,iy,k,m,niter,ny0
+ real*4 dn,xxx,yyy
+c
+c-----------------------------------------------
+
+ include './com_18/parameter.common'
+ include './com_18/griddata.common'
+ include './com_18/annee.common'
+ include './com_18/burned.common'
+ include './com_18/climin0.common'
+ include './com_18/climin.common'
+ include './com_18/climkop.common'
+ include './com_18/coord.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/drain.common'
+ include './com_18/eco.common'
+ include './com_18/ecopro.common'
+ include './com_18/envi.common'
+ include './com_18/files_car.common'
+ include './com_18/files_ibm.common'
+ include './com_18/fileunits.common'
+ include './com_18/flux_w.common'
+ include './com_18/gene.common'
+ include './com_18/gridclim.common'
+ include './com_18/icyr.common'
+ include './com_18/input_par.common'
+ include './com_18/iprt.common'
+ include './com_18/kernel.common'
+ include './com_18/netcdf_par.common'
+ include './com_18/nspc.common'
+ include './com_18/pathg.common'
+ include './com_18/pixdata.common'
+ include './com_18/plant_pool.common'
+ include './com_18/pzone.common'
+ include './com_18/smrd.common'
+ include './com_18/solpar.common'
+ include './com_18/sr_par.common'
+ include './com_18/varday.common'
+ include './com_18/vegfr.common'
+ include './com_18/frac_change.common'
+ include './com_18/mort.common'
+ include './com_18/soil_marie.common'
+
+ integer iread,nyrmax,itmt,ngt,iy_past
+
+ real*4 graine
+ real*4 stept,tbegin,tend,tmt_it
+ real*4 aaa,bbb
+ double precision y
+ dimension y(nequat)
+ character*100 label
+
+ REAL, ALLOCATABLE, DIMENSION(:,:,:) :: xxxx1year
+
+
+c default value of nd (number of days in year)
+ nd = 365
+c time step for hydrological module (IBM) integration (day)
+ stept = 1.
+
+ call open_input5(nyrmax,itmt,stept,iread)
+ write(*,*) 'open input file finish'
+
+ if (ifull.eq.1) open(24,file=filres)
+
+c=======================================================================
+c constants
+c=======================================================================
+ if (iterun .eq.1) then
+ call ctgen
+ write(*,*) 'ctgen finish'
+
+ call monthparam
+ write(*,*) 'monthparam finish'
+
+ call cth2o
+ write(*,*) 'cth2o finish'
+
+ call clasparam
+ write(*,*) 'clasparam finish'
+
+ call crops_seas
+ write(*,*) 'crop_seas finish'
+
+c=======================================================================
+c calculates hourly (only) dependent parameters.
+c=======================================================================
+
+ call hourly
+ write(*,*) 'hourly finish'
+
+ if(itmt.ne.0) tmt_it = nyear/20.
+
+ call open_file(iread) ! open_file opens all the files and
+ ! initialises the longitude (zlon)
+ ! and latitude (zlat) arrays
+
+ if ((imig.eq.1).and.(igtyp.ne.0)) then
+ write(*,*)'A regular rectangular grid should be used '
+ write(*,*)'when the migration module is called : '
+ write(*,*)'parameters igtyp=',igtyp,' and imig=',imig
+ write(*,*)'are not compatible - Program stop'
+ write(61,*)'A regular rectangular grid should be used '
+ write(61,*)'when the migration module is called : '
+ write(61,*)'parameters igtyp=',igtyp,' and imig=',imig
+ write(61,*)'are not compatible - Program stop'
+ stop
+ endif
+
+ DO ngt = 1, n_pix ! Read in soil and lon-lat data
+ call read_eco(ngt)
+ ENDDO
+
+
+c=======================================================================
+c Initializes the CO2 pressure of the previous years
+c=======================================================================
+
+ if ((iread.ge.1)) then
+ read(325,*)(co2_prev(iy),iy=1,20)
+ endif
+
+c=======================================================================
+c initialisation of the weather generator: calculation of different
+c probabilities for the 176 climatic zones of Koppen or read
+c on unit 23 if ngener is not equal to 1
+c=======================================================================
+
+ if (idaily_in.eq.0) then
+ if (ngener.eq.1) then
+ graine = float(1)
+ iprint=0
+ call generator(graine,iprint)
+ else
+ read(23) rapportP
+ read(23) rapportT
+ read(23) rapportDT
+ read(23) ioccu
+ read(23) nombrejp
+ read(23) nombrejpS
+ endif
+ endif
+
+ endif !(iterun=1)
+
+
+c=======================================================================
+c Calculates the orbital parameters for a given situation/year
+c=======================================================================
+ if(ipar.eq.1) call orb_params
+
+c=======================================================================
+c i dont know
+c=======================================================================
+
+ IF (idaily_in == 0) THEN
+ ntimedata = nm
+ ELSE
+ ntimedata = nd
+ ENDIF
+
+
+ ALLOCATE(tcel1year(ntimedata, n_pix))
+ ALLOCATE(temax1year(ntimedata, n_pix))
+ ALLOCATE(temin1year(ntimedata, n_pix))
+ ALLOCATE(prc1year(ntimedata, n_pix))
+ ALLOCATE(sunhour1year(ntimedata, n_pix))
+ ALLOCATE(rhu1year(ntimedata, n_pix))
+ ALLOCATE(win1year(ntimedata, n_pix))
+
+c=======================================================================
+c i dont know
+c=======================================================================
+
+ if (num_ncdf.ge.1) then
+
+ IF (iterun == 1) THEN ! At the beginning of the first year
+
+ ALLOCATE(ngt4ilonjlat(nclen_lon,nclen_lat))
+ ALLOCATE(ilon4ngt(n_pix))
+ ALLOCATE(jlat4ngt(n_pix))
+ ngt4ilonjlat(:,:) = -1 ! preset the arrays to the value -1
+ ilon4ngt(:) = -1
+ jlat4ngt(:) = -1
+
+
+ DO ngt = 1, n_pix ! Locate each land grid-point on the
+ ! lon-lat grid of the NetCDF files
+ ncpos_lon_saven = ncpos_lon
+ DO WHILE(ABS(xlg(ngt) - zlon(ncpos_lon)) > zdel_lon)
+ ncpos_lon = ncpos_lon + 1
+ IF (ncpos_lon == nclen_lon + 1) ncpos_lon = 1
+ IF (ncpos_lon == ncpos_lon_saven) THEN
+ WRITE(*,*) ' Could not find any longitude close to ',
+ & xlg(ngt)
+ WRITE(*,*) ' Aborting.'
+ CALL ABORT()
+ ENDIF
+ ENDDO
+
+ ncpos_lat_saven = ncpos_lat
+ DO WHILE(ABS(xlt(ngt) - zlat(ncpos_lat)) > zdel_lat)
+ ncpos_lat = ncpos_lat + 1
+ IF (ncpos_lat == nclen_lat + 1) ncpos_lat = 1
+ IF (ncpos_lat == ncpos_lat_saven) THEN
+ WRITE(*,*) ' Could not find any latitude close to ',
+ & xlt(ngt)
+ WRITE(*,*) ' Aborting.'
+ CALL ABORT()
+ ENDIF
+ ENDDO
+
+ ngt4ilonjlat(ncpos_lon,ncpos_lat) = ngt
+ ilon4ngt(ngt) = ncpos_lon
+ jlat4ngt(ngt) = ncpos_lat
+
+ ENDDO
+
+ ENDIF !(iterun = 1)
+
+
+ ALLOCATE(xxxx1year(nclen_lon, nclen_lat, ntimedata))
+
+ istart = (/ 1, 1, ncpos_time /)
+ ncount = (/ nclen_lon, nclen_lat, ntimedata /)
+
+ endif !(num_ncdf)
+
+c=======================================================================
+c i dont know
+c=======================================================================
+
+
+ if (incdf_tem.eq.1) then
+ istatus = NF_GET_VARA_REAL(ncid_filtema, ncvar_tema,
+ & istart, ncount, xxxx1year)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-3))
+
+ DO i_pix = 1, n_pix
+ tcel1year(:, i_pix)
+ & = xxxx1year(ilon4ngt(i_pix), jlat4ngt(i_pix),:)
+ ENDDO
+ else
+
+ DO i_pix = 1, n_pix
+ read(iunit_tema,*)aaa,bbb,(tcel1year(k,i_pix),k=1,ntimedata)
+ ENDDO
+
+ endif !(incdf_tem)
+
+c=======================================================================
+c i dont know
+c=======================================================================
+
+ if (incdf_dta.eq.1) then
+ istatus = NF_GET_VARA_REAL(ncid_fildtaa, ncvar_dtaa,
+ & istart, ncount, xxxx1year)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-3))
+
+ DO i_pix = 1, n_pix
+ temax1year(:, i_pix)
+ & = xxxx1year(ilon4ngt(i_pix), jlat4ngt(i_pix),:)
+ ENDDO
+
+ else
+
+ DO i_pix = 1, n_pix
+ read(iunit_dtaa,*)aaa,bbb,(temax1year(k,i_pix),k=1,ntimedata)
+ ENDDO
+
+ endif !(incdf_dta)
+
+c=======================================================================
+c i dont know
+c=======================================================================
+
+
+ if (idtem.eq.1) then
+ if (incdf_dtb.eq.1) then
+ istatus = NF_GET_VARA_REAL(ncid_fildtba, ncvar_dtba,
+ & istart, ncount, xxxx1year)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-3))
+
+ DO i_pix = 1, n_pix
+ temin1year(:, i_pix)
+ & = xxxx1year(ilon4ngt(i_pix), jlat4ngt(i_pix),:)
+ ENDDO
+ else
+ DO i_pix = 1, n_pix
+ read(iunit_dtba,*)aaa,bbb,(temin1year(k,i_pix),k=1,ntimedata)
+ ENDDO
+ endif
+ endif !(idtem)
+
+c=======================================================================
+c i dont know
+c=======================================================================
+
+
+ if (incdf_prc.eq.1) then
+ istatus = NF_GET_VARA_REAL(ncid_filprca, ncvar_prca,
+ & istart, ncount, xxxx1year)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-3))
+
+ DO i_pix = 1, n_pix
+ prc1year(:, i_pix)
+ & = xxxx1year(ilon4ngt(i_pix), jlat4ngt(i_pix),:)
+ where(prc1year(:,i_pix).gt.0.5e20)
+ prc1year(:, i_pix) = 0.
+ endwhere
+ ENDDO
+ else
+ DO i_pix = 1, n_pix
+ read(iunit_prca,*)aaa,bbb,(prc1year(k,i_pix),k=1,ntimedata)
+ ENDDO
+ endif
+
+c=======================================================================
+c i dont know
+c=======================================================================
+
+ if (incdf_shi.eq.1) then
+ istatus = NF_GET_VARA_REAL(ncid_filshia, ncvar_shia,
+ & istart, ncount, xxxx1year)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-3))
+
+ DO i_pix = 1, n_pix
+ sunhour1year(:, i_pix)
+ & = xxxx1year(ilon4ngt(i_pix), jlat4ngt(i_pix),:)
+ ENDDO
+ else
+ DO i_pix = 1, n_pix
+ read(iunit_shia,*)
+ & aaa,bbb,(sunhour1year(k,i_pix),k=1,ntimedata)
+ ENDDO
+ endif
+
+c=======================================================================
+c i dont know
+c=======================================================================
+
+ if (incdf_rhu.eq.1) then
+ istatus = NF_GET_VARA_REAL(ncid_filrhua, ncvar_rhua,
+ & istart, ncount, xxxx1year)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-3))
+
+ DO i_pix = 1, n_pix
+ rhu1year(:, i_pix)
+ & = xxxx1year(ilon4ngt(i_pix), jlat4ngt(i_pix),:)
+ ENDDO
+ else
+ DO i_pix = 1, n_pix
+ read(iunit_rhua,*)aaa,bbb,(rhu1year(k,i_pix),k=1,ntimedata)
+ ENDDO
+ endif
+
+c=======================================================================
+c i dont know
+c=======================================================================
+
+ if (incdf_win.eq.1) then
+ istatus = NF_GET_VARA_REAL(ncid_filwina, ncvar_wina,
+ & istart, ncount, xxxx1year)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-3))
+
+ DO i_pix = 1, n_pix
+ win1year(:, i_pix)
+ & = xxxx1year(ilon4ngt(i_pix), jlat4ngt(i_pix),:)
+ ENDDO
+ else
+ DO i_pix = 1, n_pix
+ read(iunit_wina,*)aaa,bbb,(win1year(k,i_pix),k=1,ntimedata)
+ ENDDO
+ endif
+
+ ! deallocate after all the tests
+ if (num_ncdf.ge.1) DEALLOCATE(xxxx1year)
+
+
+c#######################################################################
+c=======================================================================
+c Loop over the pixels for ....
+c=======================================================================
+c#######################################################################
+
+ DO ngt = 1, n_pix
+
+c=======================================================================
+c calculates or reads :
+c - coordinates of pixel corners
+c - pixel area
+c=======================================================================
+ if (iterun.eq. 1) call pixel_corners(ngt)
+
+c=======================================================================
+c reads land use file and
+c initialization of variables for all pixels
+c=======================================================================
+
+ call read_lu(ngt,iread)
+
+ if (iterun.eq. 1) then
+ call init_frac_and_lai(ngt)
+ call read_init(iread,ngt)
+ endif
+
+c=======================================================================
+c land use change and associated carbon reservoir changes
+c=======================================================================
+
+ if (ilu.eq.1) then
+ call fraction_luc(ngt)
+ call write_luc(ngt)
+ endif
+
+c=======================================================================
+c reads cover fractions for crops and pastures
+c=======================================================================
+
+ if ((ifrac_rd.ne.1).and.(ilu.eq.1)) call read_luspecies(ngt)
+
+c=======================================================================
+c reads climatological means (for Koppen zone calculation)
+c tcel_clim, tcelkop : temperature (deg.),
+c prc_clim, prckop : precipitation (mm/mo),
+c=======================================================================
+ if (idaily_in.eq.0) then
+
+ if (num_ncdf.ge.1) then
+
+ cpos_lon = ilon4ngt(ngt)
+ ncpos_lat = jlat4ngt(ngt)
+
+ istartn = (/ ncpos_lon, ncpos_lat, 1 /)
+ ncountn = (/ 1, 1, nm /)
+
+ endif
+
+ if (incdf_tclim.eq.1) then
+ istatusn = NF_GET_VARA_REAL(ncid_filtclima, ncvar_tclima,
+ & istartn, ncountn, tcelkop(1:nm))
+ IF (istatusn /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatusn, fn_caraib, (__LINE__-2))
+ else
+ read(iunit_tclim,*)ylongi,ylati,(tcelkop(m),m=1,nm)
+ endif
+
+
+ if (incdf_pclim.eq.1) then
+ istatusn = NF_GET_VARA_REAL(ncid_filpclima, ncvar_pclima,
+ & istartn, ncountn, prckop(1:nm))
+ IF (istatusn /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatusn, fn_caraib, (__LINE__-2))
+ else
+ read(iunit_pclim,*)ylongi,ylati,(prckop(m),m=1,nm)
+ endif
+
+c UNIT CONVERSION (monthly climatological values)
+ do m = 1, nm
+ tcelkop(m) = uc0_tclim + uc1_tclim * tcelkop(m)
+ prckop(m) = uc0_pclim + uc1_pclim * prckop(m)
+ end do
+c END OF UNIT CONVERSION (monthly climatological values))
+
+ do m = 1, nm
+ tcel_clim(m,ngt) = tcelkop(m)
+ prc_clim(m,ngt) = prckop(m)
+ end do
+
+c=======================================================================
+c determines the climate zone for all pixels
+c=======================================================================
+ if (iczon.eq.1) then
+ iprint=1
+ call zonepxl2(iprint)
+ else
+ if(nyear.eq.1) then
+ read(22,*)xxx,yyy,izonepxl
+ else
+ izonepxl=kzone(ngt)
+ endif
+ endif
+ kzone(ngt)=izonepxl
+
+ endif ! endif idaily_in
+
+ end do ! end of loop on pixels
+
+c#######################################################################
+c=======================================================================
+c i dont know
+c=======================================================================
+c#######################################################################
+
+ if(iczon.eq.1.or.iterun.eq.1) close(22)
+
+ if (idaily_in.eq.0) then
+
+ if (incdf_tclim.eq.1) then
+
+ istatusn = NF_CLOSE(ncid_filtclima)
+ IF (istatusn /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatusn, fn_caraib, (__LINE__-2))
+
+ else
+ close(iunit_tclim)
+ endif
+
+ if (incdf_pclim.eq.1) then
+
+ istatusn = NF_CLOSE(ncid_filpclima)
+ IF (istatusn /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatusn, fn_caraib, (__LINE__-2))
+
+ else
+ close(iunit_pclim)
+ endif
+
+ endif
+
+ if (num_ncdf.ge.1) then
+ ncpos_lon = 1 ! Reset ncpos_lon and ncpos_lat
+ ncpos_lat = 1
+ endif
+
+c=======================================================================
+c calculates pixel neighborhood
+c=======================================================================
+ if (iterun.eq.1) then
+ do ngt = 1, n_pix
+ call neighborhood_old(ngt)
+ end do
+
+ if(imig.eq.1) then
+ if(isp.eq.8) then
+ open(401,file='midpoints_picea.txt')
+ open(402,file='probdenswind_picea.txt')
+
+ do i = 1, 96
+ read(401,*) igrr,midpoint_pi(i)
+ read(402,*) igrr,probdenswind_pi(i)
+ enddo
+
+ close(401)
+ close(402)
+ endif
+ endif
+
+ endif !(iterun)
+
+ if (((imig.eq.1).and.(isteady.eq.0)).or.
+ & ((imig.eq.1).and.(isteady.eq.1).and.(iterun.ne.1)))
+ & call read_mig
+
+c#######################################################################
+c=======================================================================
+c loop on grid cells for subroutines
+c=======================================================================
+c#######################################################################
+
+ do ngt = 1, n_pix
+
+c=======================================================================
+c reads climatic, vegetation and soil data
+c and "sets" them into common blocks
+c=======================================================================
+ igr = ngt
+ call read_in(ngt,iread)
+ if (jclonly.eq.1) go to 2455
+c=======================================================================
+c climate zone corresponding to the studied pixel
+c=======================================================================
+
+ izonepxl = kzone(ngt)
+
+c=======================================================================
+c estimates daily climatic conditions
+c=======================================================================
+
+ call daily_weather(ngt,iread)
+
+c=======================================================================
+c calculates solar fluxes and related parameters
+c=======================================================================
+
+ call solar
+
+ niter=3
+ ipr=24
+ nprt=nstprt-1
+ ny0prv = 0
+
+c=======================================================================
+c Set the number of year for spin up
+c If for iteration : do X loop else only do it once
+c=======================================================================
+
+ if ((itepex.eq.1).and.(isteady.eq.1).and.(readsteady.eq.0)) then
+ nyr_t = 0
+ else
+ ny0max = 1
+ nyr_t = 1
+ if ((readsteady.eq.0).and. (itepex.eq.1)) call read_spinup
+ endif
+
+c=======================================================================
+c reads or evaluates sowing dates for crops if standard values from
+c species file ("bagseas") are not used
+c=======================================================================
+
+ if (ilu.eq.1) call crop_sowing_dates
+
+ ! if first time : do multiple year == spinup
+ do ny0 = 1,ny0max
+ nyr_t2 = 0
+ if(itepex.eq.1 .and. ny0.eq.1 .and. iread.ge.1) nyr_t2 = 1
+
+c=====================================================================72
+c Call subroutine set_frac to set vegetation fraction
+c and calculate albedo & emissivity, rooting depths, fsi,fci,wpi
+c=====================================================================72
+
+ call set_frac(ngt)
+
+c=====================================================================72
+c Call subroutine drainage to initialize drainage calculation
+c=====================================================================72
+
+ call drainage(stept)
+
+c=====================================================================72
+c Call subroutine init_c to set initial conditions of the variables
+c in the hydrological module (y, aswday)
+c=====================================================================72
+
+ call init_c(y,ngt)
+
+c=====================================================================72
+c Call differential equation solver for hydrological module (IBM)
+c=====================================================================72
+
+ tbegin = float(ny0-1)*float(nd)
+ tend = tbegin + float(nd)
+ call ode(tbegin,tend,y,stept,niter,ipr)
+ dn = tend - float(ny0-1) * float(nd)
+
+c=====================================================================72
+c Call CARAIB routines
+c=====================================================================72
+
+c=======================================================================
+c criteria for PFT establishment
+c=======================================================================
+
+ call pft_estab(ngt)
+
+c=======================================================================
+c calculates the external conditions at an hourly time step.
+c=======================================================================
+
+ call cal_in
+
+c=======================================================================
+c ponctual data initialisation at zero.
+c=======================================================================
+
+ call ponc_init
+
+c=======================================================================
+c carbon pool values
+c=======================================================================
+
+ call set_cpools(ngt)
+
+c=======================================================================
+c calculates vegetation phases
+c=======================================================================
+
+ call veg_phases(ngt)
+
+c=======================================================================
+c initialization of the lai limitation due to water stress
+c=======================================================================
+cIngrid201804
+
+ if(ny0.eq.1) call lailim_init
+
+c=======================================================================
+c npp calculation
+c=======================================================================
+
+ call npp_cal(ngt,ny0,iread,itmt,tmt_it)
+
+c=======================================================================
+c soil respiration calculation
+c=======================================================================
+
+ call soil_resp(ngt)
+
+c=======================================================================
+c vegetation succession
+c=======================================================================
+
+ if ((ifrac.eq.1.and.imig.eq.0).or.
+ & (ifrac.eq.1.and.imig.eq.1.and.nyr_t.eq.0)) then
+ call new_frac(ngt)
+ endif
+
+c=======================================================================
+c grid point results
+c=======================================================================
+
+ if (ny0.eq.ny0max) then
+ call wri_res
+ endif
+
+ call record_grid(y,ngt)
+
+
+ enddo ! end of loop on ny0 == end of spinup or year
+
+c=====================================================================72
+c writes results for 1st day of year in output nr 26
+c (initialization file)
+c writes net budgets for last in output nr 27
+c (test of convergence file)
+c=====================================================================72
+
+ call wri_1st(y,nyear,ngt)
+
+2455 continue
+
+ enddo ! end of loop on ngt
+
+c=======================================================================
+c records CO2 of previous years
+c=======================================================================
+
+ write(326,'(20(1x,f10.3))')(co2_prev(iy),iy=1,20)
+
+c=======================================================================
+c dispersion module
+c=======================================================================
+
+ if (imig.eq.1.and.nyr_t.eq.1) call close_mig
+
+ if (imig.eq.1.and.nyr_t.eq.1) call open_mig
+
+ if (imig.eq.1.and.nyr_t.eq.1) call dispersion
+
+c=======================================================================
+c vegetation succession
+c=======================================================================
+
+ if (imig.eq.1.and.nyr_t.eq.1) call close_mig
+
+ if (imig.eq.1.and.nyr_t.eq.1) call open_mig
+
+ if (ifrac.eq.1.and.imig.eq.1.and.nyr_t.eq.1)
+ & call new_frac2
+
+ call close_file(iread)
+ if(iprt_zon.eq.0) iczon=0
+ iread=1
+
+ if(itmt.ne.0.and.tmt_it.eq.itmt) itmt = itmt + 1
+
+cc incrementation of day counter (idayct) at the end of year
+cc Not incremented anymore: idayct must be read every year in
+cc control file when netcdf files are used)
+cc idayct = idayct + nd
+
+ DEALLOCATE(tcel1year)
+ DEALLOCATE(temax1year)
+ DEALLOCATE(temin1year)
+ DEALLOCATE(sunhour1year)
+ DEALLOCATE(prc1year)
+ DEALLOCATE(rhu1year)
+ DEALLOCATE(win1year)
+
+ if(iclim.eq.1) close(666)
+ close(5)
+ close(28)
+ close(61)
+ if (ifull.eq.1) close(24)
+
+ stop
+ end subroutine caraib
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_biomass_correction.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_biomass_correction.f
new file mode 100644
index 0000000..c58e25c
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_biomass_correction.f
@@ -0,0 +1,43 @@
+c=======================================================================
+c**********************************************************************
+ subroutine biomass_correction
+c***********************************************************************
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/annppf.common'
+ include './com_18/biomasse.common'
+ include './com_18/dayres.common'
+ include './com_18/ecoin.common'
+ include './com_18/fire_emi.common'
+ include './com_18/npp.common'
+ include './com_18/nspc.common'
+ include './com_18/plant_pool.common'
+ include './com_18/soil_marie.common'
+ include './com_18/soil_pool.common'
+ integer iday,iday1,ip,ipool
+ real*4 sum_xlit,sum_emi
+
+
+ do ip = 1,npft0
+ if ((frac(ip).gt.1.e-7)) then
+ do iday = 1, nd
+ do ipool = 1, npool
+ sum_xlit = 0.
+ sum_emi = 0.
+ do iday1 = 1, iday
+ sum_xlit = sum_xlit + xlit_newprod(ip,ipool,iday1)
+ & + xlit_burn(ip,ipool,iday1)
+ sum_emi = sum_emi + emi_burn_veg(ip,ipool,iday1)
+ end do
+ carbon(ip,ipool,iday) = carbon(ip,ipool,iday)
+ & - sum_xlit - sum_emi
+ if(carbon(ip,ipool,iday).lt.0.) carbon(ip,ipool,iday) = 0
+ enddo
+ enddo
+ endif
+ enddo
+
+ return
+ end subroutine biomass_correction
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_cal_in.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_cal_in.f
new file mode 100644
index 0000000..4b2ad6e
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_cal_in.f
@@ -0,0 +1,289 @@
+c=======================================================================
+c***********************************************************************
+ subroutine cal_in
+c***********************************************************************
+c=======================================================================
+ implicit none
+c=======================================================================
+c this routine calculates the external conditions at an hourly
+c time step:
+c
+c temp = air temperature (K);
+c hs = air relative humidity;
+c apar = absorbed irradiance at the leaf level
+c (micromol m-2 s-1);
+c rbl = aerodynamic + boundary layer resistance(m2 s /mol).
+c=======================================================================
+
+ include './com_18/parameter.common'
+ include './com_18/climin.common'
+ include './com_18/cstpi.common'
+ include './com_18/day_corr.common'
+ include './com_18/eco.common'
+ include './com_18/ecoin.common'
+ include './com_18/ecopro.common'
+ include './com_18/envi.common'
+ include './com_18/ext_con.common'
+ include './com_18/ext_con2.common'
+ include './com_18/gridin2.common'
+ include './com_18/hcst.common'
+ include './com_18/h2ocst.common'
+ include './com_18/nspc.common'
+ include './com_18/heure.common'
+ include './com_18/laiste.common'
+ include './com_18/radcst.common'
+ include './com_18/rblcst1.common'
+ include './com_18/res_par.common'
+ include './com_18/sol_in.common'
+ include './com_18/solpar.common'
+ include './com_18/temper.common'
+ include './com_18/varday.common'
+
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer iday,ih,ip,irad,jday,jday2,jd,ndmean_t,ndmean_w
+
+ real*4 arglog0,cdel,ch0,clcd,cte,facto,fdif,fexpo
+ real*4 ftrsdif,ftrsdir,h0,ho1,hoo
+ real*4 qh2o,rm,sdel,sl
+ real*4 slsd,sth,temp2,tempi,th,theta
+ real*4 tmin_day,tmax_day,xpar
+ real*4 unitchg,us,us0,xls
+
+
+c------------------------------------------------
+
+ dimension tmin_day(ndy),tmax_day(ndy),xpar(ndy)
+
+
+c=======================================================================
+c loops over the days
+c=======================================================================
+
+ do iday = 1, nd
+ tmin_day(iday) = tcel(iday) - tdiff(iday) / 2.
+ tmax_day(iday) = tcel(iday) + tdiff(iday) / 2.
+
+c=======================================================================
+c calculation of the daily mean atmospheric pressure of h2o.
+c=======================================================================
+
+ tempi = tcel(iday) + temp0
+ if(tcel(iday) .ge. 0.) then
+ fexpo = ah2o/tempi + bh2o*log10(tempi) + ch2o
+ qh2o = 10.**fexpo
+ else
+ facto = tcel(iday) * eh2o / tempi
+ qh2o = dh2o * exp(facto)
+ endif
+ qh2o = qh2o * rhu(iday)
+
+c=======================================================================
+c calculation of angles necessary in the atmospheric radiative
+c transfert scheme:
+c
+c sdel = sinus of the declinaison;
+c h0 = hourly angle of the day beginning;
+c ftrs = atmospheric transmittance(dimensionless).
+c=======================================================================
+
+ sl = pi365 * (iday - 79.092)
+ if(sl .lt. 0.) sl = pi2 + sl
+ th = sl - xlsper
+ sth = sin(th)
+ xls = sl + sth*exc6 + sth*cos(th)*exc7
+ & + (3.*sth - 13.*sth*sth*sth/3.) * exc5
+ theta = xls - xlsper
+ rm = (1. - exc4) / (1. + exc*cos(theta))
+ sdel = sin(obl) * sin(xls)
+ cdel = sqrt(1.-sdel*sdel)
+ cte = sunea / (rm * rm)
+ slsd = slati * sdel
+ clcd = clati * cdel
+ ch0 = -slsd / clcd
+
+ if(ch0 .ge. 1.) then
+ h0 = 0.
+ else
+ if(ch0 .le. -1) then
+ h0 = pi
+ else
+ h0 = acos(ch0)
+ endif
+ endif
+
+ ftrsdir = ftrmax*sunhour(iday)
+ ftrsdif = ftrmin*(1. - sunhour(iday))
+ xpar(iday) = 0.
+ partoc(iday) = 0.
+ do ih = 1, nh2
+ do ip = 1, npft
+ do irad = 1,3
+ apar(ip,iday,ih,irad) = 0.
+ enddo
+ end do
+ enddo
+ do ih = 1, nh2
+ do ip = 1, nplant
+ fsun(ip,iday,ih) = 0.
+ end do
+ enddo
+
+c=======================================================================
+c rbl = aerodynamic (rae) + boundary layer (rbw) resitance
+c rae in s m-1
+c rbw in s m-1
+c=======================================================================
+
+ if(win(iday) .lt. 0.1 ) win(iday) = 0.1
+
+ us0 = win(iday) * arbl
+
+ do ip = 1, npft
+ arglog0 = (zzra(ip) - disd(ip)) / z0vs(ip)
+ us = us0 / log(arglog0)
+ rae(ip,iday) = win(iday) / (us*us)
+ rbw(ip,iday) = brbl / (us**exrbl)
+ unitchg = unitfac*(1.+(tcel(iday)/temp0))
+ & *patm0/patm
+ rbl(ip,iday) = (rae(ip,iday) + h2osurco2*rbw(ip,iday))
+ & * unitchg
+ enddo
+
+c=======================================================================
+c loops over the hours
+c=======================================================================
+
+ do ih = 1, nh2
+
+c=======================================================================
+c temperature estimates
+c temp(iday,ih) = air temperature (K)
+c=======================================================================
+
+ temp(iday,ih) = temp0+tcel(iday)+0.5
+ & *tdiff(iday)*cohour(ih)
+
+c=======================================================================
+c air relative humidity estimates. It is supposed that the
+c atmospheric water content is constant during the day.
+c qsatmb = saturation vapor pressure (mbar)
+c=======================================================================
+
+ temp2 = temp(iday,ih) - temp0
+ if(temp2 .ge. 0.) then
+ fexpo = ah2o/temp(iday,ih)+bh2o*log10(temp(iday,ih))
+ & + ch2o
+ qsatmb(iday,ih) = 10.**fexpo
+ else
+ facto = temp2 * eh2o / temp(iday,ih)
+ qsatmb(iday,ih) = dh2o * exp(facto)
+ endif
+
+ hs(iday,ih) = qh2o / qsatmb(iday,ih)
+ if(hs(iday,ih) .gt. 1.) hs(iday,ih) = 1.
+ if(hs(iday,ih) .lt. 0.) hs(iday,ih) = 0.
+
+c=======================================================================
+c calculation of the solar irradiance at the earth surface
+c solg = hourly value of the surface solar
+c irradiance for the grid point studied
+c (w m-2);
+c xmucar = cosine of the solar zenithal angle , one
+c value at each hour (dimensionless).
+c=======================================================================
+
+ xmucar(iday,ih) = 0.
+ do irad = 1, 3
+ par0(iday,ih,irad) = 0.
+ enddo
+ corr_hour(iday,ih) = 0.
+
+ if(abs(hour2(ih)) .lt. h0) then
+ if(abs(hour1(ih)) .le. h0) then
+
+ xmucar(iday,ih) = slsd + clcd * codelhour(ih)
+ corr_hour(iday,ih) = 1.
+
+ else
+
+ ho1 = -h0
+ hoo = (hour2(ih) + ho1) / 2.
+ xmucar(iday,ih) = slsd + clcd
+ & * (sin(hour2(ih)) - sin(ho1))
+ & / (hour2(ih) - ho1)
+ if(xmucar(iday,ih).lt.0.) xmucar(iday,ih) = 0.
+ corr_hour(iday,ih) = (h0 - abs(hour2(ih))) / h_step
+ if(corr_hour(iday,ih).lt.0. .or.
+ & corr_hour(iday,ih).gt.1.) then
+ write(61,*) 'error, hour cor:', iday,ih,
+ & corr_hour(iday,ih)
+ write(61,*) 'h_step', h_step
+ stop
+ endif
+
+ endif
+ if(xmucar(iday,ih).lt.0.) then
+ write(61,*) 'error sun angle = ',xmucar(iday,ih),
+ & 'hour = ',ih
+ stop
+ endif
+
+ fdif = 0.2
+ par0(iday,ih,1) = cte * xmucar(iday,ih) * ftrmax
+ & * (1.-fdif) * 0.45
+ par0(iday,ih,2) = cte * xmucar(iday,ih) * ftrmax
+ & * fdif * 0.45 ! old value: 0.45
+ par0(iday,ih,3) = cte * xmucar(iday,ih) * ftrmin * 0.55
+ endif
+
+c=======================================================================
+c dirrad = direct irradiance (w m-2);
+c difrad = diffuse irradiance (w m-2);
+c=======================================================================
+
+ xpar(iday) = xpar(iday) + corr_hour(iday,ih) *
+ & ( par0(iday,ih,1) * sunhour(iday)
+ & + par0(iday,ih,2) * sunhour(iday)
+ & + par0(iday,ih,3) * (1. -sunhour(iday)))
+
+ enddo
+
+ partoc(iday) = xpar(iday)
+ xpar(iday) = xpar(iday) * parun
+
+ enddo
+
+c=======================================================================
+c minimum and maximum temperature, soil water content and day
+c length for the ndmean previous days.
+c=======================================================================
+
+ do iday = 1, nd
+
+ tmin2(iday) = 0.
+ tmax2(iday) = 0.
+ xpar2(iday) = 0.
+ water2(iday) = 0.
+
+ ndmean_t=4
+ do jday = 1, ndmean_t
+ jday2 = iday - jday
+ if(jday2 .le. 0) jday2 = jday2 + nd
+ tmin2(iday) = tmin2(iday) + tmin_day(jday2)/float(ndmean_t)
+ tmax2(iday) = tmax2(iday) + tmax_day(jday2)/float(ndmean_t)
+ xpar2(iday) = xpar2(iday) + xpar(jday2) /float(ndmean_t)
+ end do
+
+ ndmean_w=7
+ do jday = 1, ndmean_w
+ jday2 = iday - jday
+ if(jday2 .le. 0) jday2 = jday2 + nd
+ water2(iday) = water2(iday) + water(jday2)/float(ndmean_w)
+ enddo
+
+ enddo
+
+ return
+ end subroutine cal_in
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_fire.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_fire.f
new file mode 100644
index 0000000..df8a53f
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_fire.f
@@ -0,0 +1,237 @@
+c=======================================================================
+c***********************************************************************
+ subroutine fire(ngt)
+c***********************************************************************
+c=======================================================================
+ implicit none
+
+c=======================================================================
+c This routine calculates probability of fire and area burned
+c INPUTS:
+c commons must be set and iday in common cte
+c OUTPUTS:
+c Pf = Probability of fire
+c frac_burn = fraction of the pixel burned
+c area_burn = area burned (m2)
+c=======================================================================
+
+ include './com_18/parameter.common'
+ include './com_18/annppf.common'
+ include './com_18/abobio.common'
+ include './com_18/bagnum.common'
+ include './com_18/burned.common'
+ include './com_18/climin.common'
+ include './com_18/coord.common'
+ include './com_18/crops.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/ecoin.common'
+ include './com_18/fire_emi.common'
+ include './com_18/firevpar.common'
+ include './com_18/griddata.common'
+c include './com_18/inidata.common'
+ include './com_18/landuse.common'
+ include './com_18/litiere.common'
+ include './com_18/nspc.common'
+ include './com_18/npp.common'
+ include './com_18/plant_evol.common'
+ include './com_18/plant_pool.common'
+ include './com_18/soil_marie.common'
+ include './com_18/soil_pool.common'
+
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer , intent(in) :: ngt
+
+ integer iday,iday2,ip,ipool,kpool
+
+ real*4 area_mean,area_star,argth,beta_e,beta_m,
+ & beta_root,beta_xl,bio_low,bio_up,biom_ag,f_burned,
+ & fac_flash,facbio,g0wind,gwinds,h_broot,
+ & pbio,pign,pign_hum,pmst,q,uf_b,uf_p,ufmax,winkmh,
+ & xign,xlf_b,xlf_low,xlf_up
+
+c-----------------------------------------------
+ yfnoburn = 1.
+
+ if(ifire.eq.1) then
+
+ fday(nd) = 1.
+
+ do iday = 1, nd
+
+ iday2 = iday - 1
+ if(iday.eq.1) iday2 = nd
+
+c fraction of aboveground biomass for each pool and each pft (constant)
+ do ip = 1, npft0
+ do ipool = 1, npool
+ if(ipool.eq.1)then
+ fag_pft(ip,ipool) = 1.00
+ else
+ if (carbon(ip,2,iday2).ge.1.e-5) then
+ fag_pft(ip,ipool)=
+ & 1.- (root_biomass(ip,iday2)/carbon(ip,2,iday2))
+ else
+ fag_pft(ip,ipool)=0.
+ endif
+ endif
+ end do
+ end do
+
+c Fire module from Arora and Boer, 2005. J. Geophys. Res., 110, G02008,
+c doi 10:1029/2005JG000042
+
+
+c open writing file
+c open(10,file='./fire.res')
+
+
+c Que j'aime a faire connaitre un nombre utile aux sages
+c 3 .1 4 1 5 9 2 6 5 3 5
+c pi = 3.14159265
+c Lightning frequency (flashes/km2/month)
+c xl_flash(iday) = 0.41-0.41*cos(2.*pi*float(iday)/365.)
+c Probability of extinguishing fire over one day
+
+ q_extinc(iday) = 0.5
+
+c Aboveground biomass for each plant biomf_ag (g C m-2)
+c Aboveground biomass and litter carbon biom_ag (g C m-2)
+
+ biom_ag = 0.
+ do ip = 1, npft0
+ biomf_ag(ip) = 0.
+ do ipool = 1, npool
+ biomf_ag(ip)=biomf_ag(ip) +
+ & carbon(ip,ipool,iday2)*fag_pft(ip,ipool)
+ end do
+ biom_ag = biom_ag + frac(ip)*biomf_ag(ip)
+ end do
+
+ do kpool = 1, 2
+ biom_ag = biom_ag + xlit(kpool,iday2)
+ end do
+
+ Bio_low = 200.
+ Bio_up = 1000.
+ beta_e = 0.35
+ xlf_low = 0.02
+ xlf_up = 0.85
+ pign_hum = 0.
+ g0wind = 0.1
+c maximum fire spread rate (km/day)
+ ufmax = 86400.*0.13/1000.
+
+c Fire Occurrence probability
+c Fire occurrence probability linked to biomass (Pbio)
+ facbio = (biom_ag-Bio_low)/(Bio_up-Bio_low)
+ Pbio = max(0.,min(1.,facbio))
+
+c Fire occurrence probability linked to soil moisture (Pmst)
+ beta_root = max(0.,min(1.,water(iday)))
+ argth=1.75*beta_root/beta_e
+ Pmst = 1. - tanh(argth*argth)
+
+c Fire occurrence probability linked to ignition source (Pign)
+ fac_flash = (0.25*xl_flash(iday)-xlf_low)/(xlf_up-xlf_low)
+ beta_xl = max(0.,min(1.,fac_flash))
+ xIgn=beta_xl/(beta_xl+exp(1.5-6.*beta_xl))
+ Pign = xIgn + (1.-xIgn)*pign_hum
+
+c Fire occurrence probability linked to all factors (Pf)
+ Pf(iday) = Pbio*Pmst*Pign
+
+c Area burned
+c dependence of fire spread on soil wetness (h_broot) (dimensionless)
+ beta_m = 1.
+ if (beta_root.le.beta_e) beta_m = beta_root/beta_e
+ h_broot = (1-beta_m)*(1.-beta_m)
+c dependence of fire spread on wind speed (gwinds)(dimensionless)
+ winkmh = 3.6*win(iday)
+ gwinds = 1.-(1.-g0wind)*exp(-winkmh*winkmh/2500.)
+c downwind fire propagation speed uf_p (km/day)
+ uf_p = ufmax*gwinds*h_broot
+c backspread fire propagation speed uf_b (km/day)
+ uf_b = 0.2 * uf_p
+c length-to-breadth ratio of fire xLf_B (dimensionless)
+ xLf_B = 1.+10.*(1.-exp(-0.017*winkmh))
+c Area burned in one day (area_star)
+ area_star = pi*(uf_p+uf_b)*(uf_p+uf_b)/(4.*xLf_B)
+c Mean area (km2) burned per 1000 km2 (over the whole duration of fire)
+ q = q_extinc(iday)
+ area_mean = area_star*(1.-q)*(2.-q)/(q*q)
+ if (area_mean.lt.0.)area_mean=0.
+ if (area_mean.gt.1000.)area_mean=1000.
+c Fraction burned
+ f_burned = Pf(iday)*area_mean/1000.
+
+
+c Non-burned fraction
+ fnoburn(iday) = 1. - f_burned
+
+c Yearly cumulated non-burned fraction
+ yfnoburn = fnoburn(iday)*yfnoburn
+
+c Cumulated non-burned fraction at day iday
+ fday(iday) = yfnoburn
+
+c Burned fraction
+ frac_burn(iday) = fday(iday2)-fday(iday)
+ if (frac_burn(iday).lt.0.) frac_burn(iday)=0.
+
+c Area burned per pixel (m2)
+ area_burn(iday) = frac_burn(iday)*areapix(ngt)*frac_nat(ngt)
+
+
+ do ip = 1, npft0
+ if (frac(ip).gt.1.e-7) then
+
+c=======================================================================
+c Fire carbon emission per PFT
+c emi_burn_veg = carbon emission for each pool per day and per m2
+c of PFT (g C m-2 day-1)
+c
+c The sum over ip of:
+c frac(ip)*(emi_burn_veg(ip,1,iday)+emi_burn_veg(ip,2,iday))
+c provides the total carbon emission by fires per day and per m2
+c=======================================================================
+
+ emi_burn_veg(ip,1,iday) =
+ & frac_burn(iday)*phi_L(ip)*carbon(ip,1,iday)
+ emi_burn_veg(ip,2,iday) = frac_burn(iday)*phi_S(ip)
+ & *(carbon(ip,2,iday)-root_biomass(ip,iday))
+ & +frac_burn(iday)*phi_R(ip)*root_biomass(ip,iday)
+
+c=======================================================================
+c Fire mortality per PFT
+c xlit_burn = litter production due to fire for each pool per day
+c and per m2 of PFT (g C m-2 day-1)
+c
+c The sum over ip of:
+c frac(ip)*(xlit_burn(ip,1,iday)+xlit_burn(ip,2,iday))
+c provides the total litter production by fires per day and per m2
+c=======================================================================
+
+ xlit_burn(ip,1,iday) =
+ & frac_burn(iday)*psi_L(ip)*carbon(ip,1,iday)
+ xlit_burn(ip,2,iday) = frac_burn(iday)*psi_S(ip)
+ & *(carbon(ip,2,iday)-root_biomass(ip,iday))
+ & +frac_burn(iday)*psi_R(ip)*root_biomass(ip,iday)
+
+ do ipool = 1, npool
+ xlit_prod(ip,ipool,iday) = xlit_prod(ip,ipool,iday)
+ & + xlit_burn(ip,ipool,iday)
+ enddo
+
+ endif
+
+ enddo
+
+ enddo
+
+ endif
+
+ return
+ end subroutine fire
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_frac_herbs.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_frac_herbs.f
new file mode 100644
index 0000000..8154290
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_frac_herbs.f
@@ -0,0 +1,48 @@
+c=======================================================================
+c***********************************************************************
+ subroutine frac_herbs(ngt)
+c***********************************************************************
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/annppf.common'
+ include './com_18/ecoin.common'
+ include './com_18/landuse.common'
+ include './com_18/mois.common'
+ include './com_18/nspc.common'
+
+
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer , intent(in) :: ngt
+
+ integer ip
+ real*4 herb_suc
+
+c-----------------------------------------------
+c=======================================================================
+c ynppf represents an annual npp
+c if it is negative, it is set to 0 : an herb with
+c a negative annual npp is considered as inexistant
+c=======================================================================
+
+ herb_suc = 0.
+ do ip = 1, nherb+nbush
+ if ((suc_est(ip,ngt).gt.1.e-5).and.(ynppf(ip).gt.1.e-5)) then
+ herb_suc = herb_suc + suc_est(ip,ngt)*ynppf(ip)
+ endif
+ enddo
+
+ do ip = 1, nherb+nbush
+ if ((suc_est(ip,ngt).gt.1.e-5).and.(ynppf(ip).gt.1.e-5)) then
+ frac(ip) = suc_est(ip,ngt)*frac_nat(ngt)*ynppf(ip)/herb_suc
+ else
+ frac(ip) = 0.
+ endif
+
+ enddo
+
+ return
+ end subroutine frac_herbs
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_frac_trees.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_frac_trees.f
new file mode 100644
index 0000000..ebdc545
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_frac_trees.f
@@ -0,0 +1,49 @@
+c=======================================================================
+c***********************************************************************
+ subroutine frac_trees(ngt)
+c***********************************************************************
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/annppf.common'
+ include './com_18/ecoin.common'
+ include './com_18/landuse.common'
+ include './com_18/mois.common'
+ include './com_18/nspc.common'
+
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer , intent(in) :: ngt
+
+ integer ip
+ real*4 tree_suc
+
+
+c-----------------------------------------------
+c=======================================================================
+c ynppf represents an annual npp
+c if it is negative, it is set to 0 : a tree with
+c a negative annual npp is considered as not present
+c=======================================================================
+
+ tree_suc = 0.
+ do ip = nherb+nbush+1, npft0
+ if ((suc_est(ip,ngt).gt.1.e-5).and.(ynppf(ip).gt.1.e-5)) then
+ tree_suc = tree_suc + suc_est(ip,ngt)*ynppf(ip)
+ endif
+ enddo
+
+ do ip = nherb+nbush+1, npft0
+ if ((suc_est(ip,ngt).gt.1.e-5).and.(ynppf(ip).gt.1.e-5)) then
+ frac(ip) = suc_est(ip,ngt)*frac_nat(ngt)*ynppf(ip)/tree_suc
+ else
+ frac(ip) = 0.
+ endif
+ enddo
+
+
+
+ return
+ end subroutine frac_trees
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_gpp_cal.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_gpp_cal.f
new file mode 100644
index 0000000..3e1117c
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_gpp_cal.f
@@ -0,0 +1,559 @@
+c=======================================================================
+c***********************************************************************
+ subroutine gpp_cal(ngt)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c
+c this routine calculates the co2 net assimilation by leaves
+c
+c output: xgpp : leaf gross primary productivity (gC m-2 d-1 for
+c an leaf layer).
+c
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/acclim.common'
+ include './com_18/climin0.common'
+ include './com_18/climin.common'
+ include './com_18/coord.common'
+ include './com_18/cstpi.common'
+ include './com_18/c3cst.common'
+ include './com_18/c3en.common'
+ include './com_18/c4cst.common'
+ include './com_18/cte.common'
+ include './com_18/day_corr.common'
+ include './com_18/deltac13.common'
+ include './com_18/down_reg.common'
+ include './com_18/eco.common'
+ include './com_18/ecoin.common'
+ include './com_18/envi.common'
+ include './com_18/ext_con.common'
+ include './com_18/ext_con2.common'
+ include './com_18/gcaci2.common'
+ include './com_18/h2ocst.common'
+ include './com_18/lai.common'
+ include './com_18/laih2o.common'
+ include './com_18/laiste.common'
+ include './com_18/loop.common'
+ include './com_18/monthcst.common'
+ include './com_18/nspc.common'
+ include './com_18/pho_sch.common'
+ include './com_18/pnpp2.common'
+ include './com_18/monwat.common'
+ include './com_18/rblcst1.common'
+ include './com_18/res_par.common'
+ include './com_18/res_temp2.common'
+ include './com_18/snow.common'
+ include './com_18/temper.common'
+ include './com_18/tresh.common'
+ include './com_18/varday.common'
+
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer , intent(in) :: ngt
+
+
+ integer ipool,ih,irad
+
+ real*4 a0,a1,b,b1,b2,beta0
+ real*4 c,c1,c2,co2cl,coeffs
+ real*4 d,f00,fac,fac0,fac1,fac2,fac02,fac04,fac05
+ real*4 fac23,fac3,fac4,fac5,fac6,fac7,fac8,fac34,fac35
+ real*4 facgj,facgjm,factt,factt2,farbl,fard,fkt0,fkt3
+ real*4 fkt4,fkt5,fracth,fs,fh2o_mth,g1new
+ real*4 gamet,gj,gjm0,gjmax,gkc,gko
+ real*4 gn,gn0,gn1,gn2,gn3,gnd,gst
+ real*4 pkc,pko,q,r,rd,rd0,rd34
+ real*4 rbl04,rbl05,rd35,rdfac,rho1,rho2,roo,rtot
+ real*4 rto,s,sqrtq,tdep,test,test1,test2,tfact
+ real*4 tfacto,theta0,unitchg,vcm00,vcmax,vt0,wat_eff
+ real*4 xkt,xkt0,rtot_w,test0
+
+c-----------------------------------------------
+
+ dimension gn2(3),gnd(3),g1new(ndy,nplant),fh2o_mth(nm)
+ real*4 co2past,xco2,x365,x567,rfac_CO2,rvcm,rjm,rrd
+ real*4 tempast,rdaccl,tempast_m,rdaccl_f
+ integer iy_past,maxyr,m,m_past,maxmth,k
+
+ character*100 formatw,formaty
+
+
+
+c=======================================================================
+c initialisation
+c=======================================================================
+
+ do ipool = 1, npool
+ resp_fac(ip,ipool,iday) = 0.
+ enddo
+
+ gca(ip,iday) = 0.
+ gci(ip,iday) = 0.
+c-----------------------------------------------------------------------
+ zgpp(ip,iday) = 0.
+CNPP znpp(ip,iday) = 0.
+ zfract(ip,iday) = 0.
+ zfh2o(ip,iday) = 0.
+c-----------------------------------------------------------------------
+
+c======================================================================
+c downregulation of vcmax and jmax (FACE data)
+c rvcm = downregulation factor for Vcmax
+c rjm = downregulation factor for Jmax
+c rrd = downregulation factor for Rd
+c CO2 is averaged over the last N years (N=maxyr,
+c with maxyr+1<20)
+c======================================================================
+
+ if (jdwnCO2.ge.1) then
+ co2past = 0.
+ maxyr = 4
+ do iy_past = 2, maxyr+1
+ co2past = co2past + co2_prev(iy_past)/float(maxyr)
+ end do
+ xco2 = co2past/(co2past+gkc3)
+ x365 = 365./(365.+gkc3)
+ x567 = 567./(567.+gkc3)
+ rfac_CO2 = (xco2-x365)/(x567-x365)
+ rvcm = 1. + (rvcm567(ip)-1.)*rfac_CO2
+ if (rvcm.le.0.1) rvcm = 0.1
+ rjm = 1. + (rjm567(ip)-1.)*rfac_CO2
+ if (rjm.le.0.1) rjm = 0.1
+ if (jdwnCO2.eq.1) then
+ rrd = rvcm
+ else
+ rrd = 1.
+ endif
+ else
+ rvcm = 1.
+ rjm = 1.
+ rrd = 1.
+ endif
+
+c======================================================================
+c acclimation of leaf respiration to temperature
+c jrd_accl = 0/1/2
+c 0 : No acclimation
+c 1 : long-term (several years) acclimation for all plant parts
+c 2 : mid-term (several months) acclimation for leaves
+c and long-term (several years) acclimation for structural
+c parts
+c
+c rdsurvc = Rd/Vcmax = assumed to respond to temperature of the
+c previous years - decreases at higher temperatures
+c tempast = mean temperature of the N previous years (N=maxyr,
+c with maxyr+1.le.5) (long-term)
+c tempast_m = mean temperature of the N previous months
+c (N=maxmth, with maxmth<12) (mid-term)
+c rdaccl = temperature acclimation factor for structural parts
+c rdaccl_f = temperature acclimation factor for leaves
+c======================================================================
+
+ if (jrd_accl.eq.0) then
+ rdaccl = 1.
+ rdaccl_f = 1.
+ rdsurvc = rdsurvc0
+ else
+ tempast = 0.
+ maxyr = 4
+ do iy_past = 2, maxyr+1
+ tempast = tempast + ytem_prev(ngt,iy_past)/float(maxyr)
+ end do
+c adapted from Wythers et al., GCB, 11, 435-449, 2005
+c rdaccl = normalized ratio = (0.14 - 0.002*tcel)/0.09
+c with 0.09 the value of the bracket term at 25°C
+ rdaccl=1.5556-0.0222*tempast
+ rdsurvc = rdsurvc0
+ if (jrd_accl.eq.1) then
+ rdaccl_f = rdaccl
+ else
+ m = imonth(iday)
+ tempast_m = 0.
+ maxmth = 2
+ do k = 1, maxmth
+ m_past = m-k
+ if (m_past.le.0) then
+ tempast_m = tempast_m+py_mtem(ngt,m_past+nm)/float(maxmth)
+ else
+ tempast_m = tempast_m+tcel0(m_past)/float(maxmth)
+ endif
+ end do
+ rdaccl_f = 1.5556-0.0222*tempast_m
+ endif
+ endif
+
+
+c=======================================================================
+c la resistance stomatique (pas g0 mais g1) a ete multipliee par
+c l'exponentielle de Wijk plottee sur Leuning
+
+ wat_eff = (water(iday)-0.5*wattresh2(ip)) / (1.-0.5*wattresh2(ip))
+ if (wat_eff.lt.0.) wat_eff=0.
+ fs = 1.-0.016572*exp(4.1*(1.-wat_eff))
+
+ g1new(iday,ip) = g1(ip) * fs
+
+c=======================================================================
+c beginning of the calculation:
+c g0 = intercept for the stomatal conductance;
+c g1 = slope for the stomatal conductance;
+c temp = temperature in k;
+c gjmax = light potential rate of electron tranport on area basis
+c (mueq m-2 s-1);
+c gj = potential rate of electron transport on area basis
+c (mueq m-2 s-1);
+c apar = solar irradiance (micromol photons/(m2 s));
+c ea = activation energy used to calculate the temperature
+c dependance of a paramater(j mlo-1);
+c gkc = michaelis constant for co2 (mubar);
+c gko = michaelis constant for o2 (mbar);
+c pkc = turnover number of rup2 carboxylase (s-1);
+c pko = turnover number of rup2 oxygenase (s-1);
+c vcmax = maximum carboxylation velocity (mumol m-2 s-1);
+c gamet = co2 compensation point without dark respiration (mubar);
+c rd = dark respiration (mumol m-2 s-1);
+c co2a = atmospheric partial pressure of co2 (mubar);
+c hs = air relative humidity;
+c o2cl = partial pressure of o2;
+c rbl = boundary layer resistance (mol m-2 s-1).
+c=======================================================================
+
+c=======================================================================
+c C4 parameters:
+c
+c vc4 = rubisco capacity (mumol m-2 s-1);
+c xkt = initial slope of the photosynthetic co2 response
+c (mol m-2 s-1).
+c=======================================================================
+
+c=======================================================================
+c loops over the hours
+c=======================================================================
+
+ do ih = 1, nh2
+c no photosynthesis below -10 oC (-4 oC in earlier version)
+ if(temp(iday,ih).ge.(temp0-10.)) then
+
+c=======================================================================
+c C3 plants
+c=======================================================================
+
+ tdep = (temp(iday,ih) - 298.15) / temp(iday,ih)
+ tfact = exp(tdep * eapkc)
+ gkc = gkc3 * exp(tdep * eagkc)
+ gko = gko3 * exp(tdep * eagko)
+ pkc = pkc3 * tfact
+ pko = pkcko * pkc
+ gamet = gkc * o2cl * pko / (2 * gko * pkc)
+ f00 = co2a - gamet
+ test1 = f00 / (co2a + 2. * gamet)
+ fac1 = gkc * (1. + o2cl/gko)
+ facgj = 1. + exp((sjm*temp(iday,ih)-hjm)/temp(iday,ih))
+ tfacto = tfact
+
+c=======================================================================
+c C4 plants
+c=======================================================================
+
+ fac = (temp(iday,ih) - 298.15) / 10.
+ factt = 0.3 * temp(iday,ih)
+ factt2 = 1.3 * temp(iday,ih)
+ xkt0 = (q10**fac)
+ vt0 = xkt0
+ & / ((1+exp(fact0-factt)) * (1+exp(factt-fact1)))
+ rdfac = factt2-fact2
+ if(rdfac.lt.-40.) rdfac = -40.
+ rd0 = xkt0 / (1. + exp(rdfac))
+
+ if (ic4(ip).eq.1) then
+ resp_fac(ip,1,iday) = resp_fac(ip,1,iday)
+ & + rd0 *rrd*rdaccl_f* (1. - snow_frac(iday))
+ else
+ resp_fac(ip,1,iday) = resp_fac(ip,1,iday)
+ & + rrd*rdaccl_f*tfacto*(1. - snow_frac(iday))
+ endif
+ resp_fac(ip,2,iday) = resp_fac(ip,2,iday)
+ & + rrd*rdaccl*tfacto*(1. - snow_frac(iday))
+
+ a1 = 1.6 / g0(ip) + rbl(ip,iday)
+ fac0 = g1new(iday,ip) * hs(iday,ih) / co2a
+
+ gn = 0.
+ gn0 = 0.
+ gn1 = 0.
+ gn3 = 0.
+
+c======================================================================
+
+ vcm00 = vcm0(ip)*rvcm
+
+ if (ic4(ip).eq.1) then
+
+ rd = rd0 * rdsurvc * vcm0(ip)*rrd*rdaccl_f
+ xkt = xkt0 * xkc4
+ fkt0 = 1.6 * xkt
+ fkt3 = 1. + xkt * rbl(ip,iday)
+ fkt5 = xkt * a1
+ a0 = -fac0 * fkt3
+
+ test0 = xkt * co2a
+c test 1
+c-----------------------------------------------------------------------
+ if(test0.gt.rd.and.a0.gt.0.) then
+ fac2 = g0(ip) - fac0 * rd
+ fac4 = co2a + rd * rbl(ip,iday)
+ fkt4 = xkt * fac4
+ b = 0.5*( fkt4*fac0 - fac2*fkt3 - fkt0 )
+ c = fkt4*fac2 + fkt0*rd
+ roo = b*b - a0*c
+ gn3 = -(b + sqrt(roo))/a0
+ else
+
+c=======================================================================
+c limits the stomatal conductance to g0
+c=======================================================================
+
+ gn3 = (xkt*co2a + rd*fkt5) / (1.+fkt5)
+ endif
+
+ gn1 = vcm00 * vt0 /2.
+
+ else
+
+ vcmax = vcm00 * tfacto
+ rd = rdsurvc * vcm0(ip) * rrd*rdaccl_f * tfacto
+ a0 = rbl(ip,iday) * fac0
+ test0 = vcmax*f00
+ & / (co2a + gkc*(1.+o2cl/gko))
+ fac3 = -fac0 * rd + g0(ip)
+ fac4 = f00 + rd * rbl(ip,iday)
+ fac5 = fac4 + 3. * gamet
+ fac6 = co2a + rd * a1
+ fac7 = fac6 - gamet
+ fac8 = fac6 + 2. * gamet
+ fard = 1.6 * rd
+ farbl = 1.6 + rbl(ip,iday) * fac3
+ fac04 = fac0 * fac4
+ fac05 = fac0 * fac5
+ fac34 = fac3 * fac4
+ fac35 = fac3 * fac5
+ rbl04 = farbl - fac04
+ rbl05 = farbl - fac05
+ rd34 = fard + fac34
+ rd35 = fard + fac35
+
+c=======================================================================
+c rubisco limitation
+c=======================================================================
+
+c test2
+c-----------------------------------------------------------------------
+
+ if(test0.gt.rd.and.a0.gt.0.) then
+
+ fac2 = co2a + fac1+ rd * rbl(ip,iday)
+ fac02 = fac0 * fac2
+ fac23 = fac2 * fac3
+
+ b = ( (farbl - fac02)/a0 - vcmax )/3.
+ c = - (vcmax*rbl04 + fac23 + fard)/a0
+ d = (vcmax*rd34)/a0
+
+ b2 = b*b
+ q = b2 - c/3.
+ r = b*(b2 - 0.5*c) + 0.5*d
+ sqrtq = sqrt(q)
+ coeffs = r /(sqrtq*q)
+
+ if(coeffs .lt. -1.) coeffs = -1.
+ if (coeffs.gt.1.) coeffs = 1.
+
+ s = acos(coeffs)
+ gn1 = -2.*sqrtq*cos((4.*pi+s)/3.) - b
+
+ else
+
+c=======================================================================
+c limits the stomatal conductance to g0
+c=======================================================================
+
+ b = -0.5*(fac6 + vcmax*a1 + fac1)
+ c = vcmax*fac7
+ roo = b*b - a1*c
+ gn1 = -(b + sqrt(roo))/a1
+
+ endif
+
+ gn3 = vcmax / 2.
+c gjm0 = 1.67 * vcm0(ip) * rjm
+ gjm0 = 2.11 * vcm0(ip) * rjm
+ gjmax = gjm0 * exp(tdep * ejm) / facgj
+
+ endif
+
+c=======================================================================
+c loops over the lai
+c
+c an = potential c3 net assimilation rate (micromol m-2 s-1);
+c gn = potential c3 gross assimilation rate (micromol m-2 s-1).
+c
+c then;
+c sums the values --> daily values for each lai step.
+c=======================================================================
+
+ gn = 0.
+ do irad = 1, 3
+ gn2(irad) = 0.
+ enddo
+ if (ic4(ip).eq.1) then
+
+c=======================================================================
+c irradiance limitation
+c=======================================================================
+
+ do irad = 1, 3
+ gn2(irad) = alpc4 * apar(ip,iday,ih,irad)
+ enddo
+
+ else
+
+ do irad = 1, 3
+
+ if(apar(ip,iday,ih,irad).gt.0.) then
+ facgjm = 2.1*gjmax + apar(ip,iday,ih,irad)
+ gj = gjmax * apar(ip,iday,ih,irad)/facgjm
+ gj = gj / 4.
+ test2 = test1 * gj
+c test 3
+c-----------------------------------------------------------------------
+ if(test2.gt.rd.and.a0.gt.0.) then
+
+ b = ( - gj + rbl05/a0 )/3.
+ c = -(gj*rbl04 + rd35)/a0
+ d = (gj*rd34 )/a0
+
+ b2 = b*b
+ q = b2 - c/3.
+ r = b*(b2 - 0.5*c) + 0.5*d
+ sqrtq = sqrt(q)
+ coeffs = r /(sqrtq*q)
+ if(coeffs .lt. -1.) coeffs = -1.
+ if (coeffs.gt.1.) coeffs = 1.
+ s = acos(coeffs)
+ gn2(irad) = -2.*sqrtq*cos((s+4.*pi)/3.) - b
+
+ else
+
+c=======================================================================
+c limits the stomatal conductance to g0
+c=======================================================================
+
+ b = -0.5*(fac8 + gj*a1)
+ c = gj*fac7
+ roo = b*b - a1*c
+ gn2(irad) = -(b + sqrt(roo))/a1
+
+ endif
+ endif
+ enddo
+ endif
+
+ if(gn1 .lt. 0.) gn1 = 0.
+ do irad = 1, 3
+ if(gn2(irad) .lt. 0.) gn2(irad) = 0.
+ enddo
+
+ if(gn3 .lt. 0.) gn3 = 0.
+
+c=======================================================================
+c coupling of limitations
+c=======================================================================
+
+ theta0 = 0.90
+ beta0 = 0.90
+
+ do irad = 1, 3
+ b1 = - 0.5*(gn1 + gn2(irad))
+ c1 = gn1 * gn2(irad)
+ rho1 = b1*b1 - theta0*c1
+ gn0 = -(b1 + sqrt(rho1))/theta0
+
+ b2 = - 0.5*(gn0 + gn3)
+ c2 = gn0 * gn3
+ rho2 = b2*b2 - beta0*c2
+ gnd(irad) = -(b2 + sqrt(rho2))/beta0
+
+ if(gnd(irad) .lt. 0.) gnd(irad) = 0.
+ enddo
+
+ gn = sunhour(iday) * (fsun(ip,iday,ih) * gnd(1)
+ & + (1.-fsun(ip,iday,ih)) * gnd(2))
+ & + (1. - sunhour(iday)) * gnd(3)
+ gn = gn * corr_hour(iday,ih)
+ zgpp(ip,iday) = zgpp(ip,iday) + gn
+
+CNPP znpp(ip,iday) = znpp(ip,iday)
+CNPP & + gn - rd
+c modification Wijk : g1new au lieu g1
+ gst = g0(ip) + g1new(iday,ip)*(gn-rd)*hs(iday,ih)/
+ & co2a
+ if(gst.le.g0(ip)) gst = g0(ip)
+ rtot = 1.6/gst + rbl(ip,iday)
+ unitchg = unitfac * (1.+(tcel(iday)/temp0))
+ & * patm0/patm
+c rtot_w: total resistance for water vapour (s m-1) (stom+bl+aer)
+c-----------------------------------------------------------------------
+ rtot_w = 1./(gst*unitchg)
+ & + rbw(ip,iday) + rae(ip,iday)
+ co2cl = co2a - (gn-rd)*rtot
+ if(co2cl.le.0.) co2cl = 0.
+
+ gca(ip,iday) = gca(ip,iday) + co2a / rtot
+ gci(ip,iday) = gci(ip,iday) + co2cl /rtot
+
+ fracth = delc1 + delc2(ip) * co2cl / co2a
+
+ zfract(ip,iday) = zfract(ip,iday)
+ & + fracth * gn
+ zfh2o(ip,iday) = zfh2o(ip,iday)
+ & + qsatmb(iday,ih)*100.*(1.-hs(iday,ih))
+ & / (rtot_w*rgas_v*temp(iday,ih))
+
+ endif
+ enddo
+
+c=======================================================================
+c transformation into g m-2 day-1 for one lai layer
+c=======================================================================
+
+
+ zgpp(ip,iday) = zgpp(ip,iday) * transfo * (1. - snow_frac(iday))
+CNPP znpp(ip,iday) = znpp(ip,iday) * transfo
+CNPP & * (1. - snow_frac(iday))
+ zfract(ip,iday) = zfract(ip,iday)*transfo * (1. - snow_frac(iday))
+ zfh2o(ip,iday) = zfh2o(ip,iday) * transfw * (1. - snow_frac(iday))
+
+ gca(ip,iday) = gca(ip,iday) * transfo * (1. - snow_frac(iday))
+ gci(ip,iday) = gci(ip,iday) * transfo * (1. - snow_frac(iday))
+
+
+c do ipool = 1, npool
+c resp_fac_temp(ip,ipool,iday,ngt)
+c & = resp_fac(ip,ipool,iday)
+c enddo
+
+c gca_temp(ip,iday,ngt) = gca(ip,iday)
+c gci_temp(ip,iday,ngt) = gci(ip,iday)
+
+c zgpp_temp(ip,iday,ngt) = zgpp(ip,iday)
+
+c zfract_temp(ip,iday,ngt) = zfract(ip,iday)
+c zfh2o_temp(ip,iday,ngt) = zfh2o(ip,iday)
+
+ return
+ end subroutine gpp_cal
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_lai_limit_w.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_lai_limit_w.f
new file mode 100644
index 0000000..2bcd96c
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_lai_limit_w.f
@@ -0,0 +1,124 @@
+c=======================================================================
+c***********************************************************************
+ subroutine lai_limit_w
+c***********************************************************************
+c=======================================================================
+ implicit none
+c=======================================================================
+c This routine calculates monthly lai limits to assure coherence
+c between CARAIB and IBM
+c=======================================================================
+
+ include './com_18/annee.common'
+ include './com_18/parameter.common'
+ include './com_18/bagnum.common'
+ include './com_18/climin0.common'
+ include './com_18/ecoin.common'
+ include './com_18/laih2o.common'
+ include './com_18/laiste.common'
+ include './com_18/loop.common'
+ include './com_18/monthcst.common'
+ include './com_18/monwat.common'
+ include './com_18/pho_sch.common'
+ include './com_18/pnpp2.common'
+ include './com_18/strate.common'
+ include './com_18/tresh.common'
+ include './com_18/xvalues.common'
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer m
+ real*4 corr_wat,etrmax,fh2o_mth,tmin0,wgt_yvs,xlai_mth
+
+c-----------------------------------------------
+
+ dimension fh2o_mth(nm),xlai_mth(nm)
+
+ do ip = ipi,ipf
+ if(frac(ip).gt.1.e-7) then
+
+ do m = 1, nm
+ fh2o_mth(m) = 0.
+ xlai_mth(m) = 0.
+ enddo
+ do iday = 1,nd
+ m = imonth(iday)
+ fh2o_mth(m) = fh2o_mth(m) + zfh2o(ip,iday) * xlai(ip,iday)
+ xlai_mth(m) = xlai_mth(m) + xlai(ip,iday)
+ end do
+ do m = 1, nm
+ cfh2o(ip,m) = fh2o_mth(m)
+ xlai_mth(m) = xlai_mth(m) / float(mlength(m))
+ enddo
+
+ ylai_w(ip) = 0.
+ wgt_yvs = 0.
+ yvslai_w(ip) = 0.
+ yminlai_w(ip) = xlaimax
+
+c rtrcar(m) = fraction of evaporation svecar(m) associated with
+c vegetation transpiration
+c-----------------------------------------------------------------------
+
+ do m = 1, nm
+ xlai_w(ip,m) = xlaimax
+ etrmax = rtrcar(m) * svecar(m)
+ if(etrmax.lt.0.) etrmax = 0.
+
+c------------------A CHANGER----------------------------------------
+ if(cfh2o(ip,m).gt.0. .and. cfh2o(ip,m).gt.etrmax) then
+ corr_wat = etrmax/cfh2o(ip,m)
+CV8 if(nyr_t.eq.0) corr_wat = (1.+ (etrmax/cfh2o(ip,m)))/2.
+ xlai_w(ip,m) = xlai_mth(m)*corr_wat
+ endif
+c-----------------A CHANGER------------------------------------------
+
+ if (xlai_w(ip,m).le.0.) then
+ xlai_w(ip,m) = 0.
+ endif
+
+
+ ylai_w(ip) = ylai_w(ip)+xlai_w(ip,m)
+ & * float(mlength(m))/float(nd)
+ if (fsncar(m).lt.0.1) then
+ if (idec(ip).eq.0) then
+ wgt_yvs = wgt_yvs+float(mlength(m))/float(nd)
+ yvslai_w(ip) = yvslai_w(ip)+xlai_w(ip,m)
+ & * float(mlength(m))/float(nd)
+ if(yminlai_w(ip).ge.xlai_w(ip,m))then
+ yminlai_w(ip)=xlai_w(ip,m)
+ endif
+ elseif (idec(ip).eq.1) then
+ tmin0 = tcel0(m)-tdiff0(m)/2.
+ if (tmin0.gt.ttreshi1(ip)) then
+ wgt_yvs = wgt_yvs+float(mlength(m))/float(nd)
+ yvslai_w(ip) = yvslai_w(ip)+xlai_w(ip,m)
+ & * float(mlength(m))/float(nd)
+ if(yminlai_w(ip).ge.xlai_w(ip,m))then
+ yminlai_w(ip)=xlai_w(ip,m)
+ endif
+ endif
+ elseif (idec(ip).eq.2) then
+ if (swcar(m).gt.wattresh1(ip)) then
+ wgt_yvs = wgt_yvs+float(mlength(m))/float(nd)
+ yvslai_w(ip) = yvslai_w(ip)+xlai_w(ip,m)
+ & * float(mlength(m))/float(nd)
+ if(yminlai_w(ip).ge.xlai_w(ip,m))then
+ yminlai_w(ip)=xlai_w(ip,m)
+ endif
+ endif
+ endif
+ endif
+ enddo
+
+ if (wgt_yvs.gt.1.e-5) then
+ yvslai_w(ip) = yvslai_w(ip)/wgt_yvs
+ else
+ yvslai_w(ip) = 0.
+ endif
+
+ endif
+ enddo
+
+ return
+ end subroutine lai_limit_w
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_lai_limit_w_monthly.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_lai_limit_w_monthly.f
new file mode 100644
index 0000000..0efdc57
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_lai_limit_w_monthly.f
@@ -0,0 +1,134 @@
+c=======================================================================
+c***********************************************************************
+ subroutine lai_limit_w_monthly
+c***********************************************************************
+c=======================================================================
+ implicit none
+c=======================================================================
+c This routine calculates monthly lai limits to assure coherence
+c between CARAIB and IBM
+c=======================================================================
+
+ include './com_18/annee.common'
+ include './com_18/parameter.common'
+ include './com_18/bagnum.common'
+ include './com_18/climin0.common'
+ include './com_18/ecoin.common'
+ include './com_18/laih2o.common'
+ include './com_18/laiste.common'
+ include './com_18/loop.common'
+ include './com_18/monthcst.common'
+ include './com_18/monwat.common'
+ include './com_18/pho_sch.common'
+ include './com_18/pnpp2.common'
+ include './com_18/strate.common'
+ include './com_18/tresh.common'
+ include './com_18/xvalues.common'
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer m,day,n
+ real*4 corr_wat,etrmax,fh2o_mth,tmin0,wgt_yvs,xlai_mth
+
+c-----------------------------------------------
+
+ dimension fh2o_mth(nm),xlai_mth(nm)
+
+ if(frac(ip).gt.1.e-7) then
+
+cIngrid201804
+ m = imonth(iday)
+ n=m+1
+ fh2o_mth(m) = 0.
+ xlai_mth(m) = 0.
+ do day = ini(m),ifin(m)
+ fh2o_mth(m) = fh2o_mth(m) + zfh2o(ip,day) * xlai(ip,day)
+ xlai_mth(m) = xlai_mth(m) + xlai(ip,day)
+ enddo
+ cfh2o(ip,m) = fh2o_mth(m)
+ xlai_mth(m) = xlai_mth(m) / float(mlength(m))
+cIngrid201804
+
+
+cIngrid201804
+c ylai_w(ip) = 0.
+ wgt_yvs = 0.
+ yvslai_w(ip) = 0.
+cIngrid201804
+c yminlai_w(ip) = xlaimax
+
+
+c rtrcar(m) = fraction of evaporation svecar(m) associated with
+c vegetation transpiration
+c-----------------------------------------------------------------------
+
+cIngrid201804
+c do m = 1, nm
+ xlai_w(ip,m) = xlaimax
+ etrmax = rtrcar(m) * svecar(m)
+ if(etrmax.lt.0.) etrmax = 0.
+
+cc------------------A CHANGER----------------------------------------
+ if(cfh2o(ip,m).gt.0. .and. cfh2o(ip,m).gt.etrmax) then
+ corr_wat = etrmax/cfh2o(ip,m)
+CV8 if(nyr_t.eq.0) corr_wat = (1.+ (etrmax/cfh2o(ip,m)))/2.
+ xlai_w(ip,m) = xlai_mth(m)*corr_wat
+ xlai_w(ip,n)=xlai_w(ip,m)
+ endif
+cc-----------------A CHANGER------------------------------------------
+
+ if (xlai_w(ip,m).le.0.) then
+ xlai_w(ip,m) = 0.
+ endif
+ ylai_w(ip) = ylai_w(ip)+xlai_w(ip,m)
+ & * float(mlength(m))/float(nd)
+
+c if (fsncar(m).lt.0.1) then
+c if (idec(ip).eq.0) then
+c wgt_yvs = wgt_yvs+float(mlength(m))/float(nd)
+c yvslai_w(ip) = yvslai_w(ip)+xlai_w(ip,m)
+c & * float(mlength(m))/float(nd)
+c if(yminlai_w(ip).ge.xlai_w(ip,m))then
+c yminlai_w(ip)=xlai_w(ip,m)
+c endif
+c elseif (idec(ip).eq.1) then
+c tmin0 = tcel0(m)-tdiff0(m)/2.
+c if (tmin0.gt.ttreshi1(ip)) then
+c wgt_yvs = wgt_yvs+float(mlength(m))/float(nd)
+c yvslai_w(ip) = yvslai_w(ip)+xlai_w(ip,m)
+c & * float(mlength(m))/float(nd)
+c if(yminlai_w(ip).ge.xlai_w(ip,m))then
+c yminlai_w(ip)=xlai_w(ip,m)
+c endif
+c endif
+c elseif (idec(ip).eq.2) then
+c if (swcar(m).gt.wattresh1(ip)) then
+c wgt_yvs = wgt_yvs+float(mlength(m))/float(nd)
+c yvslai_w(ip) = yvslai_w(ip)+xlai_w(ip,m)
+c & * float(mlength(m))/float(nd)
+c if(yminlai_w(ip).ge.xlai_w(ip,m))then
+c yminlai_w(ip)=xlai_w(ip,m)
+c endif
+c endif
+c endif
+c endif
+cIngrid201804
+c boucle sur les mois
+c enddo
+
+
+c if (wgt_yvs.gt.1.e-5) then
+c yvslai_w(ip) = yvslai_w(ip)/wgt_yvs
+c else
+c yvslai_w(ip) = 0.
+c endif
+
+c if sur frac
+ endif
+
+cIngrid201804
+c boucle sur les ip
+c enddo
+
+ return
+ end subroutine lai_limit_w_monthly
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_lailim_init.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_lailim_init.f
new file mode 100644
index 0000000..be57926
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_lailim_init.f
@@ -0,0 +1,33 @@
+c=======================================================================
+c***********************************************************************
+ subroutine lailim_init
+c***********************************************************************
+c=======================================================================
+ implicit none
+c=======================================================================
+c This routine reads initial value of lai limitation due to water
+c stress
+c=======================================================================
+
+ include './com_18/parameter.common'
+ include './com_18/laiste.common'
+ include './com_18/laih2o.common'
+ include './com_18/nspc.common'
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer ip,m
+c------------------------------------------------
+
+ do ip = 1, npft
+ yminlai_w(ip) = xlaimax
+ yvslai_w(ip) = 0.
+cIngrid201804
+ ylai_w(ip) = 0.
+ do m = 1, nm
+ xlai_w(ip,m) = xlaimax
+ end do
+ enddo
+
+ return
+ end subroutine lailim_init
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_mortality.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_mortality.f
new file mode 100644
index 0000000..bc5fdf1
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_mortality.f
@@ -0,0 +1,148 @@
+c=======================================================================
+c***********************************************************************
+ subroutine mortality(ngt)
+c***********************************************************************
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/ageclas.common'
+ include './com_18/annppf.common'
+ include './com_18/burned.common'
+ include './com_18/coord.common'
+ include './com_18/cte.common'
+ include './com_18/cstmort.common'
+ include './com_18/ecoin.common'
+ include './com_18/ext_con2.common'
+ include './com_18/mort.common'
+ include './com_18/gk.common'
+ include './com_18/inidata.common'
+ include './com_18/litiere.common'
+ include './com_18/npp.common'
+ include './com_18/nspc.common'
+ include './com_18/plant_pool.common'
+ include './com_18/prev_yr.common'
+ include './com_18/soil_marie.common'
+ include './com_18/tresh.common'
+
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer , intent(in) :: ngt
+
+ integer iday,iday2,ip,ipool
+
+c-----------------------------------------------
+
+
+
+ real*4 ftmin_tempo(npft),fwat_tempo(npft),fnat_tempo(npft)
+ real*4 gkfall_tree,vigor
+
+c=======================================================================
+c loss fraction
+c=======================================================================
+
+ do ip = 1, npft
+
+ ftot(ip) = 1.
+ ftmin(ip) = 1.
+ fwat(ip) = 1.
+ fnat(ip) = 1.
+ ftmin_tempo(ip) = 1.
+ fwat_tempo(ip) = 1.
+ fnat_tempo(ip) = 1.
+
+ if (frac(ip).gt.1.e-7) then
+
+ tmin_inf(ip) = ttreshi2(ip) - delta_tmin
+ tmin_sup(ip) = ttreshi2(ip) + delta_tmin
+
+ wat_inf(ip) = wattresh2(ip) * (1. - delta_watmin)
+ wat_sup(ip) = wattresh2(ip) * (1. + delta_watmin)
+
+ if ((ilgtree.eq.1).and.
+ & ((ip.ge.nherb+nbush+1).and.(ip.le.npft0))) then
+ if (xlaimax_prv(ip).ge.0.1) then
+ vigor = max(0.,ybinc_prv(ip)/xlaimax_prv(ip))
+ else
+ vigor = 0.
+ endif
+ gkfall_tree = 0.000274/(1.+0.035*vigor)
+ fnat(ip) = 1. - gkfall_tree
+
+ write(61,'(2(1x,f8.3),1x,i2,5(1x,e12.5))')ylongi,ylati,ip
+ & ,ybinc_prv(ip),xlaimax_prv(ip),vigor,gkfall_tree,fnat(ip)
+
+ else
+c fnat(ip) = 1. - 1. / (365.*icyear_mean(ip,nclas(ip)))
+ fnat(ip) = 1. - 1. / (365.*icyear_max(ip,nclas(ip)))
+CXC & - gk_fall(ip,2,1)
+
+ endif
+
+
+
+ ftemp(ip,nd) = 1.
+
+ do iday = 1, nd
+
+ iday2 = iday - 1
+ if(iday.eq.1) iday2 = nd
+
+ if ((ilgtree.eq.1).and.
+ & ((ip.ge.nherb+nbush+1).and.(ip.le.npft0))) then
+ ftmin(ip) = 1.
+ fwat(ip) = 1.
+ else
+ ftmin(ip) = 1.-gk_fall(ip,2,3)+gk_fall(ip,2,3)*
+ & (0.5*(1.+erf(xk_erf*(tmin2(iday)-ttreshi2(ip))/
+ & delta_tmin)))
+ fwat(ip) = 1.-gk_fall(ip,2,2)+gk_fall(ip,2,2)*
+ & (0.5*(1.+erf(xk_erf*(water2(iday)-wattresh2(ip))/
+ & (delta_watmin*wattresh2(ip)))))
+ endif
+
+ if(ftmin(ip).lt.0. .or. ftmin(ip).gt.1.000001) then
+ write(61,*) 'errrrrrror',ftmin(ip)
+ endif
+
+ ftot(ip) = ftot(ip)*ftmin(ip)*fwat(ip)*fnat(ip)
+
+ ftmin_tempo(ip) = ftmin_tempo(ip)*ftmin(ip)
+ fwat_tempo(ip) = fwat_tempo(ip)*fwat(ip)
+ fnat_tempo(ip) = fnat_tempo(ip)*fnat(ip)
+
+ if(iday.eq.nd) then
+ ftmin(ip) = ftmin_tempo(ip)
+ fwat(ip) = fwat_tempo(ip)
+ fnat(ip) = fnat_tempo(ip)
+ endif
+
+ ftemp(ip,iday) = ftot(ip)
+
+c=======================================================================
+c litter production
+c=======================================================================
+
+ do ipool = 1, npool
+ if(iday.eq.1) then
+ xlit_newprod(ip,ipool,iday) = (1.-ftemp(ip,iday))
+ & *ycar_ini(ip,ipool,ngt)
+ else
+ xlit_newprod(ip,ipool,iday) = (ftemp(ip,iday2)
+ & -ftemp(ip,iday))*carbon(ip,ipool,iday2)
+ xlit_prod(ip,ipool,iday) = xlit_prod(ip,ipool,iday)
+ & + xlit_newprod(ip,ipool,iday)
+ endif
+
+ enddo
+
+ enddo
+ endif
+
+ ftot(ip) = ftot(ip) * yfnoburn
+ enddo
+
+ return
+ end subroutine mortality
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_new_frac.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_new_frac.f
new file mode 100644
index 0000000..026abb9
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_new_frac.f
@@ -0,0 +1,153 @@
+c=======================================================================
+c***********************************************************************
+ subroutine new_frac(ngt)
+c***********************************************************************
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/annppf.common'
+ include './com_18/burned.common'
+ include './com_18/coord.common'
+ include './com_18/cte.common'
+ include './com_18/disper.common'
+ include './com_18/ecoin.common'
+ include './com_18/estab.common'
+ include './com_18/files_car.common'
+ include './com_18/frac_change.common'
+ include './com_18/gddpix.common'
+ include './com_18/inidata.common'
+ include './com_18/init.common'
+ include './com_18/input_par.common'
+ include './com_18/landuse.common'
+ include './com_18/mort.common'
+ include './com_18/npp.common'
+ include './com_18/nspc.common'
+ include './com_18/pho_sch.common'
+ include './com_18/plheight.common'
+ include './com_18/tresh.common'
+
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer , intent(in) :: ngt
+
+ integer ip
+ real*4 herb_seed,tree_seed
+
+c-----------------------------------------------
+c=======================================================================
+c initialization
+c=======================================================================
+
+ hole_herb = 0.
+ hole_tree = 0.
+ strat_herb = 0.
+ strat_tree = 0.
+ stratnew1 = 0.
+ stratnew2 = 0.
+
+ do ip = 1, npft0
+
+ if(ip.le.nherb+nbush) then
+ strat_herb = strat_herb + frac(ip)
+ else
+ strat_tree = strat_tree + frac(ip)
+ endif
+
+ enddo
+
+c=======================================================================
+c loss fraction
+c=======================================================================
+
+ do ip = 1, npft0
+
+ fracnew(ip) = ftot(ip)*frac(ip)
+
+ enddo
+
+ do ip = 1, nherb+nbush
+ stratnew1 = stratnew1 + fracnew(ip)
+ enddo
+
+ do ip = 1+nherb+nbush, npft0
+ stratnew2 = stratnew2 + fracnew(ip)
+ enddo
+
+ do ip = 1, npft0
+ perte(ip) = frac(ip)-fracnew(ip)
+ enddo
+
+
+c hole_herb = strat_herb-stratnew1
+ hole_herb = frac_nat(ngt)-stratnew1
+ if(hole_herb.lt.0.) hole_herb = 0.
+
+c hole_tree = strat_tree-stratnew2
+ hole_tree = frac_nat(ngt)-stratnew2
+ if(hole_tree.lt.0.) hole_tree = 0.
+
+c=======================================================================
+c seed production
+c=======================================================================
+
+ do ip = 1, npft0
+ seed_prod(ip) = 0.
+ seed_estab(ip) = 0.
+ dispin(ip) = 0.
+ dispout(ip) = 0.
+ frac_seed(ip) = 0.
+ density(ip) = 0.
+ if (suc_est(ip,ngt).gt.1.e-5) then
+ density(ip) = 1.
+ dispin(ip) = carb_init(ip,2)
+ if(imig.eq.1.and.ip.eq.isp
+!c if(ip.eq.isp
+ & .and.irfg(ngt).ne.1) then
+ density(ip) = 0.
+ dispin(ip) = 0.
+ endif
+ endif
+
+ end do
+
+ do ip = 1, npft0
+
+ seed_prod(ip) =
+ & Fgdd5(ip)*frac(ip)*ynppf(ip)+dispin(ip)-dispout(ip)
+ seed_estab(ip) =
+ & FTmmin(ip)*Fwatmin(ip)*pgerm(ip)*seed_prod(ip)
+
+ enddo
+
+ herb_seed = 0.
+ tree_seed = 0.
+ do ip = 1, nherb+nbush
+ herb_seed = herb_seed + density(ip)*seed_estab(ip)
+ enddo
+
+ do ip = nherb+nbush+1, npft0
+ tree_seed = tree_seed + density(ip)*seed_estab(ip)
+ enddo
+
+ if(herb_seed.gt.0.) then
+ do ip = 1, nherb+nbush
+ frac_seed(ip) = hole_herb
+ & *(density(ip)*seed_estab(ip)/herb_seed)
+ enddo
+ endif
+
+ if(tree_seed.gt.0.) then
+ do ip = nherb+nbush+1, npft0
+ frac_seed(ip) = hole_tree
+ & *(density(ip)*seed_estab(ip)/tree_seed)
+ enddo
+ endif
+
+ do ip = 1, npft0
+ frac(ip) = fracnew(ip) + frac_seed(ip)
+ enddo
+
+ return
+ end subroutine new_frac
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_npp_cal.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_npp_cal.f
new file mode 100644
index 0000000..4cb7ff8
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_npp_cal.f
@@ -0,0 +1,391 @@
+c=======================================================================
+c***********************************************************************
+ subroutine npp_cal(ngt,ny0,iread,itmt,tmt_it)
+c***********************************************************************
+c=======================================================================
+ implicit none
+c=======================================================================
+c
+c this routine calculates the net primary productivity and the
+c co2 carbon pools.
+c
+c Plant are divided in 3 pools:
+c 1 = "green biomass" including leaves (and active roots);
+c 2 = rest of the plant
+c 3 = reserve
+c
+c Pool values are determined resolving the differential equations:
+c
+c dC/dt = Fin - Fout
+c where C = carbon pool (g m-2);
+c t = time (day);
+c Fin = incoming fluxes (g m-2 d-1) expressed as a
+c fraction of the total gpp except for "green
+c biomass for which Fin comes also from reserves in
+c the growing season;
+c Fout = outgoing fluxes (g m-2 d-1) supposed proportional
+c to carbon pools (k*C) except growing respiration
+c supposed equal to 0 when Fout > Fin and equal to
+c h * dC/dt in other cases (h = 0.20).
+c Supposing that Fin and K are constant during a time step (here
+c one day) the solution of this equation is:
+c
+c C = C0 exp(-k*t/(1+h)) + {1 - exp(-k*t/(1_h))}*Fin/{(1+h)*k}
+c where C0 is the initial value of the pool.
+c
+c carbon(ip,ipool,iday) = C.
+c=======================================================================
+
+ include './com_18/parameter.common'
+ include './com_18/ageclas.common'
+ include './com_18/annee.common'
+ include './com_18/angppf.common'
+ include './com_18/bagnum.common'
+ include './com_18/biomasse.common'
+ include './com_18/carbon_maxi.common'
+ include './com_18/climin.common'
+ include './com_18/cmoiRmin.common'
+ include './com_18/coord.common'
+ include './com_18/crops.common'
+ include './com_18/cte.common'
+ include './com_18/day_corr.common'
+ include './com_18/dayres.common'
+ include './com_18/ecoin.common'
+ include './com_18/ext_con.common'
+ include './com_18/ext_con2.common'
+ include './com_18/fire_emi.common'
+ include './com_18/fracc13.common'
+ include './com_18/gcaci2.common'
+ include './com_18/gk.common'
+ include './com_18/inidata.common'
+ include './com_18/lai.common'
+ include './com_18/laih2o.common'
+ include './com_18/laiste.common'
+ include './com_18/loop.common'
+ include './com_18/management.common'
+ include './com_18/mois.common'
+ include './com_18/monthcst.common'
+ include './com_18/nspc.common'
+ include './com_18/number_year.common'
+ include './com_18/pho_sch.common'
+ include './com_18/plant_evol.common'
+ include './com_18/plant_pool.common'
+ include './com_18/pnpp2.common'
+ include './com_18/radcst.common'
+ include './com_18/res_par.common'
+ include './com_18/res_temp2.common'
+ include './com_18/strate.common'
+ include './com_18/tresh.common'
+ include './com_18/xvalues.common'
+ include './com_18/frac_change.common'
+
+
+
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer , intent(in) :: ngt,ny0,iread,itmt
+ integer ih,ipool,iday2,iday_sow,iharv
+ real*4 , intent(in) :: tmt_it
+ real*4 faparl,tot_frac,faparh
+c------------------------------------------------
+
+c second argument of year_iteration :
+c tree = 0
+c grass = 1
+c-----------------------------------------------------------------------
+
+c=======================================================================
+c crops
+c=======================================================================
+
+ nstrate = 0
+ ipi = npft0+1
+ ipf = npft0+ncrop
+
+c=======================================================================
+c limite the lai due to water fluxes.. CARAIB and IBM have to be
+c coherent
+c=======================================================================
+
+cIngrid2018
+ call wat_limit
+
+c=======================================================================
+c carbon fluxes calulation
+c=======================================================================
+
+ call year_iteration(ngt,itmt,tmt_it)
+
+cIngrid2018
+ call lai_limit_w
+
+c=======================================================================
+c pastures
+c=======================================================================
+
+ nstrate = 0
+ ipi = npft0+ncrop+1
+ ipf = npft0+ncrop+npast
+
+c=======================================================================
+c limite the lai due to water fluxes.. CARAIB and IBM have to be
+c coherent
+c=======================================================================
+
+cIngrid2018
+ call wat_limit
+
+c=======================================================================
+c carbon fluxes calulation
+c=======================================================================
+
+ call year_iteration(ngt,itmt,tmt_it)
+
+cIngrid2018
+ call lai_limit_w
+
+c=======================================================================
+c trees
+c=======================================================================
+
+ nstrate = 0
+ ipi = nherb+nbush+1
+ ipf = npft0
+
+c=======================================================================
+c limits the lai due to water fluxes.. CARAIB and IBM have to be
+c coherent
+c=======================================================================
+
+cIngrid2018
+ call wat_limit
+
+c=======================================================================
+c carbon fluxes calulation
+c=======================================================================
+
+ call year_iteration(ngt,itmt,tmt_it)
+
+cIngrid2018
+ call lai_limit_w
+
+ if (ifrac.eq.1 .and.ny0.eq.1 .and. nyear.eq.1 .and. iread.eq.0
+ & .and. ifrac_rd.eq.0)
+ & call frac_trees(ngt)
+
+c=======================================================================
+c herbs and shrubs
+c=======================================================================
+
+ call solar_trees(ngt)
+
+ nstrate = 1
+ ipi = 1
+ ipf = nherb+nbush
+
+c=======================================================================
+c limits the lai according to water fluxes.. CARAIB and IBM have to
+c be coherent
+c=======================================================================
+
+cIngrid2018
+ call wat_limit
+
+c=======================================================================
+c carbon fluxes calulation
+c=======================================================================
+
+ call year_iteration(ngt,itmt,tmt_it)
+
+cIngrid2018
+ call lai_limit_w
+
+ if (ifrac.eq.1 .and. ny0.eq.1 .and. nyear.eq.1 .and. iread.eq.0
+ & .and. ifrac_rd.eq.0)
+ & call frac_herbs(ngt)
+
+c=======================================================================
+c yearly gpp and fractionation calculation
+c=======================================================================
+ do ip = 1,npft
+ iharv = 0
+ if(frac(ip).gt.1.e-7) then
+ do iday = 1, nd
+ if(ip.le.npft0.or.ip.ge.npft0+ncrop+1) then
+ ygppf(ip) = ygppf(ip) + xgpp(ip,iday)
+ ygppf_ini(ip,ngt) = ygppf(ip)
+ else
+ if(iharv.eq.0) then
+ ygppf(ip) = ygppf(ip) + xgpp(ip,iday)
+ if(maturity(ip).eq.-999) ygppf(ip) =0.
+ ygppf_ini(ip,ngt) = ygppf(ip)
+ if(iphase(ip,iday).eq.2) then
+ ygppf_ini(ip,ngt) = 0.
+ iharv = 1
+ endif
+ else
+ ygppf_ini(ip,ngt) = ygppf_ini(ip,ngt) + xgpp(ip,iday)
+ endif
+ endif
+ yfractf(ip) = yfractf(ip) + xfract(ip,iday)
+ enddo
+ if (ygppf(ip).eq.0.) then
+ yfractf(ip) = 0.
+ else
+ yfractf(ip) = yfractf(ip) / ygppf(ip)
+ endif
+ endif
+ end do
+
+
+c=======================================================================
+c fire module
+c=======================================================================
+
+ call fire(ngt)
+
+c=======================================================================
+c mortality calculation
+c=======================================================================
+
+ call mortality(ngt)
+
+c=======================================================================
+c biomass correction module
+c=======================================================================
+
+ call biomass_correction
+
+
+
+c=======================================================================
+c grid point gpp, npp, lai, biomass, 13C fract and fire emission
+c=======================================================================
+
+ do iday = 1, nd
+ iday2 = iday-1
+ if(iday .eq. 1) iday2 = nd
+ do ip = 1, npft
+ xdgpp(iday) = xdgpp(iday) + frac(ip) * xgpp(ip,iday)
+ xdnpp(iday) = xdnpp(iday) + frac(ip) * xnpp(ip,iday)
+ xdlai(iday) = xdlai(iday) + frac(ip) * xlai(ip,iday)
+ xdfract(iday) = xdfract(iday)
+ & + frac(ip) * xfract(ip,iday)
+ do ipool = 1, npool
+ xdbiom(iday) = xdbiom(iday) + frac(ip)*carbon(ip,ipool,iday)
+ ybiomf(ip) = ybiomf(ip) + carbon(ip,ipool,iday)/float(nd)
+ xemifire(ip,iday) = xemifire(ip,iday)
+ & + emi_burn_veg(ip,ipool,iday)
+ xcharvest(ip,iday) = xcharvest(ip,iday)
+ & + charvest(ip,ipool,iday)
+ yemifiref(ip) = yemifiref(ip) + emi_burn_veg(ip,ipool,iday)
+ enddo
+
+ if(ip.le.npft0.or.ip.ge.npft0+ncrop+1) then
+ ybiomag(ip) = ybiomag(ip)
+ & + (carbon(ip,1,iday)
+ & + carbon(ip,2,iday)-root_biomass(ip,iday))/float(nd)
+ ybiombg(ip) = ybiombg(ip)+root_biomass(ip,iday)/float(nd)
+c Ingrid
+ ybiomtot(ip) = carbon(ip,1,iday)+carbon(ip,2,iday)
+ else
+ if (iphase(ip,iday2).eq.1.and.iphase(ip,iday).eq.2) then
+ if(iday.eq.1) then
+ root_biomass(ip,iday2) = root_ini(ip)
+ carbon(ip,1,iday2) = ycar_ini(ip,1,ngt) !carbon_ini(ip,1)
+ carbon(ip,2,iday2) = ycar_ini(ip,2,ngt) !carbon_ini(ip,2)
+ endif
+ ybiomag(ip) = carbon(ip,1,iday2)
+ & + carbon(ip,2,iday2)-root_biomass(ip,iday2)
+ ybiombg(ip) = root_biomass(ip,iday2)
+c Ingrid
+ ybiomtot(ip) = carbon(ip,1,iday2) + carbon(ip,2,iday2)
+ endif
+ endif
+c Ingrid
+ yield(ip)=yield_fac(ip)*ybiomtot(ip)
+
+ enddo
+
+
+
+ if(xdgpp(iday).ne.0.) then
+ xdfract(iday) = xdfract(iday) / xdgpp(iday)
+ else
+ if(abs(xdfract(iday)).gt.1.e-20) then
+ write(61,*) 'error, fractionation:',iday,xdfract(iday),
+ & xdgpp(iday)
+ endif
+ xdfract(iday) = 0.
+ endif
+
+ enddo
+
+c=======================================================================
+c vegetation fraction calculation. It is used to normalize FAPAR
+c=======================================================================
+
+ tot_frac = 0.
+ do ip = 1, npft
+ tot_frac = tot_frac + frac(ip)
+ end do
+
+c write(*,*)'npp_cal:after loop iday,ip, ybiom'
+c=======================================================================
+c fapar calculation
+c=======================================================================
+
+ do iday = 1, nd
+ xdfapar(iday) = 0.
+ if(partoc(iday).gt.0.) then
+ do ip = 1, npft
+ faparl = 0.
+ if(frac(ip) .gt. 1.e-7) then
+ do ih = 1, nh2
+ faparh = 0.
+
+ faparh = faparh
+ & + (sunhour(iday) * (fsun(ip,iday,ih)*apar(ip,iday,ih,1)
+ & + (1.-fsun(ip,iday,ih))*apar(ip,iday,ih,2))
+ & + (1.-sunhour(iday)) * apar(ip,iday,ih,3))
+ & *corr_hour(iday,ih)/radun
+
+ faparl = faparl + faparh
+ enddo
+ faparl = faparl * xlai(ip,iday) * frac(ip)
+ endif
+ xdfapar(iday) = xdfapar(iday) + faparl
+ enddo
+ xdfapar(iday) = xdfapar(iday) / partoc(iday)
+
+ if(tot_frac.gt.0.0) then
+ xdfapar(iday)= xdfapar(iday) / tot_frac
+ endif
+ endif
+ if(xdfapar(iday).lt.0. .or. xdfapar(iday).gt.1.) then
+ write(61,*) 'error L',iday,xdfapar(iday)
+ endif
+ enddo
+
+c write(*,*)'npp_cal:after loop iday fapar'
+
+c=======================================================================
+c calculation of g*Ca and g*Ci
+c=======================================================================
+
+ do iday = 1, nd
+ do ip = 1, npft
+
+ xdgca(iday) = xdgca(iday)
+ & + gca(ip,iday) * xlai(ip,iday) * frac(ip)
+ xdgci(iday) = xdgci(iday)
+ & + gci(ip,iday) * xlai(ip,iday) * frac(ip)
+ enddo
+ enddo
+
+c write(*,*)'npp_cal: end of subroutine'
+
+
+ return
+ end subroutine npp_cal
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_pft_estab.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_pft_estab.f
new file mode 100644
index 0000000..a169f02
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_pft_estab.f
@@ -0,0 +1,150 @@
+c=======================================================================
+c***********************************************************************
+ subroutine pft_estab(ngt)
+c***********************************************************************
+c=======================================================================
+ implicit none
+c=======================================================================
+c This routine estimates establishment success for plant types.
+c=======================================================================
+
+ include './com_18/parameter.common'
+ include './com_18/annee.common'
+ include './com_18/climin0.common'
+ include './com_18/climin.common'
+ include './com_18/coord.common'
+ include './com_18/cstmort.common'
+ include './com_18/cte.common'
+ include './com_18/disper.common'
+ include './com_18/ecoin.common'
+ include './com_18/estab.common'
+ include './com_18/gddpix.common'
+ include './com_18/inidata.common'
+ include './com_18/monthcst.common'
+ include './com_18/nspc.common'
+ include './com_18/pho_sch.common'
+ include './com_18/monwat.common'
+ include './com_18/snow.common'
+ include './com_18/temper.common'
+ include './com_18/xlaic.common'
+
+ real*4 watmin
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer , intent(in) :: ngt
+
+ integer im,ip,mmm
+ real*4 tot_frac
+
+c------------------------------------------------
+
+ watmin = 1000.
+ do im = 1, nm
+ if (swcar(im).le.watmin) then
+ watmin = swcar(im)
+ endif
+ enddo
+
+ if (ifrac.eq.1) then
+ do ip = 1, npft
+
+ gdd_inf(ip) = gdd_est(ip) * (1.- delta_gdd5)
+ gdd_sup(ip) = gdd_est(ip) * (1.+ delta_gdd5)
+
+ Tmmin_inf(ip) = tcmax_est(ip) - delta_tmax
+ Tmmin_sup(ip) = tcmax_est(ip) + delta_tmax
+
+ watmin_inf(ip) = watmax_est(ip) * (1. -delta_watmax)
+ watmin_sup(ip) = watmax_est(ip) * (1. +delta_watmax)
+
+ tot_frac = 0.
+ ylaimax_mean = 0.
+
+ do mmm = 2, 17
+ if(mmm.ne.ip) then
+ ylaimax_mean = ylaimax_mean
+ & + yfrac_ini(mmm,ngt)*ylaimax_ini(mmm,ngt)
+ tot_frac = tot_frac + yfrac_ini(mmm,ngt)
+ endif
+ enddo
+
+ ylaimax_mean = ylaimax_mean/tot_frac
+
+ ylai_inf = 1.
+ ylai_sup = 2.
+ ylai_est = 1.5
+
+ suc_est(ip,ngt) = pgerm(ip)
+ if (gdd5.lt.gdd_inf(ip)) suc_est(ip,ngt) = 0.
+ if (Tmmin.gt.Tmmin_sup(ip)) suc_est(ip,ngt) = 0.
+ if (watmin.gt.watmin_sup(ip)) suc_est(ip,ngt) = 0.
+c if ((ip.eq.3.or.ip.eq.10.or.ip.eq.13.or.ip.eq.14.
+c & or.ip.eq.16).and.nyear.ne.1) then
+C if (xlmax(ip).gt.1.5) suc_est(ip,ngt) = 0.
+c if (ylaimax_mean.gt.ylai_est) suc_est(ip,ngt) = 0.
+c endif
+
+ Fgdd5(ip) = 1.
+ if (gdd_est(ip) .gt. 0. .and. gdd5.lt.gdd_sup(ip)) then
+ if (gdd5.lt.gdd_inf(ip)) then
+ Fgdd5(ip) = 0.
+ else
+ Fgdd5(ip)=(1./2.)*(1.+erf(xk_erf*(gdd5-gdd_est(ip))
+ & /(delta_gdd5*gdd_est(ip))))
+ endif
+ endif
+
+ FTmmin(ip) = 1.
+ if (Tmmin.gt.Tmmin_inf(ip)) then
+ if (Tmmin.gt.Tmmin_sup(ip)) then
+ FTmmin(ip) = 0.
+ else
+ FTmmin(ip)=(1./2.)*(1.-erf(xk_erf*(Tmmin-tcmax_est(ip))
+ & /(delta_tmax)))
+ endif
+ endif
+
+ Fwatmin(ip) = 1.
+ if(watmax_est(ip).gt.0. .and.
+ & watmin.gt.watmin_inf(ip)) then
+ if (watmin.gt.watmin_sup(ip)) then
+ Fwatmin(ip) = 0.
+ else
+ Fwatmin(ip)=(1./2.)*(1.-erf(xk_erf*(watmin-watmax_est(ip))
+ & /(delta_watmax*watmax_est(ip))))
+ endif
+ endif
+
+ if(nyr_t.eq.0.and.imig.eq.1.and.ip.eq.isp
+!c if(ip.eq.isp
+ & .and.irfg(ngt).ne.1) then
+
+ suc_est(ip,ngt) = 0.
+
+ endif
+
+ enddo
+
+
+ else
+ do ip = 1, npft
+ if (frac(ip).le.1.e-7) then
+ suc_est(ip,ngt) = 0.
+ else
+ suc_est(ip,ngt) = pgerm(ip)
+ endif
+
+ if(nyr_t.eq.0.and.imig.eq.1.and.ip.eq.isp
+!c if(ip.eq.isp
+ & .and.irfg(ngt).ne.1) then
+
+ suc_est(ip,ngt) = 0.
+
+ endif
+
+ enddo
+ endif
+
+ return
+ end subroutine pft_estab
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_ponc_init.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_ponc_init.f
new file mode 100644
index 0000000..69e5e1d
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_ponc_init.f
@@ -0,0 +1,128 @@
+c=======================================================================
+c***********************************************************************
+ subroutine ponc_init
+c***********************************************************************
+c=======================================================================
+ implicit none
+c=======================================================================
+c This routine performs the initialisation of:
+c
+c ynpp = yearly npp;
+c ygpp = yearly leaf gpp;
+c ynep = yearly nep;
+c xmnpp = daily leaf npp (gc m-2 d-1);
+c xmgpp = daily gross primary productivity (gc m-2 d-1);
+c zgpp(ip,iday,nlai) = daily gpp for the grid point .
+c=======================================================================
+
+ include './com_18/parameter.common'
+ include './com_18/angppf.common'
+ include './com_18/annppf.common'
+ include './com_18/biomasse.common'
+ include './com_18/burned.common'
+ include './com_18/cmoiRmin.common'
+ include './com_18/crops.common'
+ include './com_18/cte.common'
+ include './com_18/dayres.common'
+ include './com_18/fire_emi.common'
+ include './com_18/frac_change.common'
+ include './com_18/fracc13.common'
+ include './com_18/litiere.common'
+ include './com_18/management.common'
+ include './com_18/monres.common'
+ include './com_18/nspc.common'
+ include './com_18/pnpp2.common'
+ include './com_18/soil_marie.common'
+ include './com_18/xvalues.common'
+
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+
+ integer iday,ip,ipool,kpool,m
+
+c----------------------------------------------------
+ do m = 1, nm
+ xmgpp(m) = 0.
+ xmra(m) = 0.
+ xmnpp(m) = 0.
+ xmnep(m) = 0.
+ xmrh(m) = 0.
+ xmnbp(m) = 0.
+ xmemifire(m) = 0.
+ xmcharvest(m) = 0.
+ xmemiblit(m) = 0.
+ xmlai(m) = 0.
+ xmbiom(m) = 0.
+c initialization of monthly variables of fire module
+ xmPf(m) = 0.
+ xmPnf(m) = 1.
+ xmfapar(m) = 0.
+ xmfrac_burn(m) = 0.
+ xmarea_burn(m) = 0.
+ enddo
+
+ do kpool = 0, 3
+ ysoilr(kpool) = 0.
+ end do
+
+ do ip = 1, npft
+ if(ip.le.npft0.or.ip.ge.npft0+ncrop+1) ynppf(ip) = 0.
+ if(ip.le.npft0.or.ip.ge.npft0+ncrop+1) ygppf(ip) = 0.
+ ybiomf(ip) = 0.
+ ybiomag(ip) = 0.
+ ybiombg(ip) = 0.
+ ybiomtot(ip) = 0.
+ yfractf(ip) = 0.
+ xlai_min(ip) = 0.
+ xlai_max(ip) = 0.
+ R_min(ip) = 0.
+ xlai_moy(ip) = 0.
+ fracnew(ip) = 0.
+ frac_seed(ip) = 0.
+ ycharvest(ip) = 0.
+ yield(ip) = 0.
+ yemifiref(ip) = 0.
+ enddo
+
+ do iday = 1, nd
+ xdnpp(iday) = 0.
+ xdgpp(iday) = 0.
+ xdnep(iday) = 0.
+ xdnbp(iday) = 0.
+ xdemifire(iday) = 0.
+ xdcharvest(iday) = 0.
+ emi_burn_lit(iday) = 0.
+ xdlai(iday) = 0.
+ xdbiom(iday) = 0.
+ xdfract(iday) = 0.
+ xdfapar(iday) = 0.
+ xdgca(iday) = 0.
+ xdgci(iday) = 0.
+
+ do kpool = 1, 2
+ xhum_prod(kpool,iday) = 0.
+ end do
+ do ip = 1, npft
+ xlai(ip,iday) = 0.
+ xemifire(ip,iday) = 0.
+ xcharvest(ip,iday) = 0.
+ do ipool = 1, npool
+ xlit_prod(ip,ipool,iday) = 0.
+ xlit_newprod(ip,ipool,iday) = 0.
+ xlit_burn(ip,ipool,iday) = 0.
+ emi_burn_veg(ip,ipool,iday) = 0.
+ enddo
+
+ zgpp(ip,iday) = 0.
+CNPP znpp(ip,iday) = 0.
+ zfract(ip,iday) = 0.
+ zfh2o(ip,iday) = 0.
+
+ enddo
+
+ enddo
+
+
+ return
+ end subroutine ponc_init
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_set_cpools.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_set_cpools.f
new file mode 100644
index 0000000..3746983
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_set_cpools.f
@@ -0,0 +1,96 @@
+c=======================================================================
+c***********************************************************************
+ subroutine set_cpools(ngt)
+c***********************************************************************
+c=======================================================================
+ implicit none
+c=======================================================================
+c This routine reads initial value of carbon pools
+c and set them in the right form.
+c=======================================================================
+ include './com_18/parameter.common'
+ include './com_18/angppf.common'
+ include './com_18/annee.common'
+ include './com_18/annppf.common'
+ include './com_18/ecoin.common'
+ include './com_18/init.common'
+ include './com_18/inidata.common'
+ include './com_18/nspc.common'
+ include './com_18/plant_pool.common'
+ include './com_18/plant_evol.common'
+ include './com_18/prev_yr.common'
+ include './com_18/soil_pool.common'
+
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer , intent(in) :: ngt
+
+ integer iday,ip,ipool,kpool
+
+ real*4 val_min_rese
+c-----------------------------------------------
+
+c=======================================================================
+c initial value of carbon pools.
+c=======================================================================
+
+ do iday = 1, nd-1
+ xhumus(iday) = 0.
+ do kpool = 1, 2
+ xlit(kpool,iday) = 0.
+ end do
+ do ip = 1, npft
+ do ipool = 1, npool
+ carbon(ip,ipool,iday) = 0.
+ enddo
+ enddo
+ enddo
+
+ do kpool = 1, 2
+ xlit(kpool,nd) = ylit_ini(kpool,ngt)
+ end do
+
+ xhumus(nd) = yhum_ini(ngt)
+
+ do ip = 1, npft
+ do ipool = 1, npool
+ carbon(ip,ipool,nd) = ycar_ini(ip,ipool,ngt)
+c if(nyr_t.eq.0. .and. suc_est(ip,ngt).gt.1.e-5) then
+ if(ip.le.npft0.or.ip.ge.npft0+ncrop+1.
+ &and.frac(ip).gt.1.e-7) then
+ if(carbon(ip,ipool,nd).le.0.)
+ & carbon(ip,ipool,nd) = carb_init(ip,ipool)
+
+ endif
+ enddo
+
+ if(ip.gt.npft0.and.ip.le.npft0+ncrop) then
+ ygppf(ip) = ygppf_ini(ip,ngt)
+ ynppf(ip) = ynppf_ini(ip,ngt)
+ endif
+
+ rese(ip) = yrese_ini(ip,ngt)
+c if(nyr_t.eq.0. .and. suc_est(ip,ngt).gt.1.e-5) then
+ val_min_rese = rese_frac(ip) * xip(ip,1) *
+ & (carbon(ip,2,nd)**xkappa(ip))
+ if(rese(ip).lt.val_min_rese) rese(ip) = val_min_rese
+c endif
+ ybinc_prv(ip) = ybinc_ini(ip,ngt)
+ enddo
+
+ if(nyr_t .eq. 0) then
+ do ip = 1, npft
+ if(suc_est(ip,ngt).le.1.e-5) then
+ do ipool = 1, npool
+ carbon(ip,ipool,nd) = 0.
+ enddo
+ rese(ip) = 0.
+ ybinc_prv(ip) = 0.
+ endif
+ enddo
+ endif
+
+
+ return
+ end subroutine set_cpools
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_soil_resp.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_soil_resp.f
new file mode 100644
index 0000000..dc55d71
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_soil_resp.f
@@ -0,0 +1,303 @@
+c=======================================================================
+c**********************************************************************
+ subroutine soil_resp(ngt)
+c***********************************************************************
+c=======================================================================
+ implicit none
+c=======================================================================
+c This routine estimates the monthly soil respiration rate
+c=======================================================================
+
+ include './com_18/parameter.common'
+ include './com_18/annee.common'
+ include './com_18/annppf.common'
+ include './com_18/biomasse.common'
+ include './com_18/burned.common'
+ include './com_18/climin.common'
+ include './com_18/cte.common'
+ include './com_18/dayres.common'
+ include './com_18/eco.common'
+ include './com_18/ecoin.common'
+ include './com_18/fire_emi.common'
+ include './com_18/firevpar.common'
+ include './com_18/gama.common'
+ include './com_18/griddata.common'
+ include './com_18/landuse.common'
+ include './com_18/litiere.common'
+ include './com_18/loop.common'
+ include './com_18/mort.common'
+ include './com_18/nspc.common'
+ include './com_18/textcst1.common'
+ include './com_18/soil_marie.common'
+ include './com_18/soil_pool.common'
+ include './com_18/smrd.common'
+ include './com_18/sresp.common'
+ include './com_18/varday.common'
+
+
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer , intent(in) :: ngt
+
+ integer iday2,iyear,kpool,max_year
+
+ real*4 b,cm,cmopt,cmoxm1,fin,fout,fsw,psat,rg,rt,tem10,
+ & test_conv,test_conv_max,testc,xlit_prod_tot,xm1
+
+c-----------------------------------------------
+ dimension xmresp(3,ndy),Fin_lit(2,ndy)
+ real*4 xmresp,Fin_lit,phi_D_mean,sum_mean,totfrac
+
+
+c=======================================================================
+c soil respiration factor calculation i.e.
+c soil respiration
+c ------------------
+c soil carbon content
+c=======================================================================
+
+ xm1 = (xm1cla*cla + xm1sil*sil + xm1san*san)*0.01
+ cmopt = (cmoptcla*cla + cmoptsil*sil + cmoptsan*san)*0.01
+ psat = (psatcla*cla + psatsil*sil + psatsan*san)*0.01
+ cmoxm1 = cmopt**xm1
+
+ do iday = 1, nd
+
+ xdnep(iday) = xdnpp(iday)
+
+ tem10 = (tcel(iday) - 10.) / 10.
+
+ cm = ((fci-wpi)*water(iday) + wpi)/fsi
+ b = (cm**xm1-cmoxm1)/(1.-cmoxm1)
+ fsw = 0.2 + 0.8 * psat**(b*b)
+ rg = facgrnd * (q10grnd**tem10)*fsw
+ rt = factree * (q10tree**tem10)*fsw
+
+ xmresp(1,iday) = rg
+ xmresp(2,iday) = rt
+ xmresp(3,iday) = rt
+ enddo
+
+c=======================================================================
+c soil carbon estimation
+c=======================================================================
+
+ max_year = 1
+ if(nys.eq.1) max_year = 1000
+ test_conv_max = 0.001
+
+
+ phi_D_mean = 0.
+ sum_mean = 0.
+
+ do iday = 1, nd
+
+ do kpool = 1, 2
+ Fin_lit(kpool,iday) = 0.
+
+ end do
+
+ do ip = 1, npft
+ xlit_prod_tot=xlit_prod(ip,1,iday)+xlit_prod(ip,2,iday)
+ if (ip.le.npft0) phi_D_mean = phi_D_mean
+ & + phi_D(ip) * xlit_prod_tot * frac(ip)
+ sum_mean = sum_mean + xlit_prod_tot * frac(ip)
+
+ Fin_lit(1,iday) = Fin_lit(1,iday)
+ & + xlit_prod(ip,1,iday)*frac(ip)
+ctt if(ip.le.nherb .or. ip.gt.npft0) then
+ctt Fin_lit(1,iday) = Fin_lit(1,iday)
+ctt & + xlit_prod(ip,2,iday)*frac(ip)
+ctt else
+ Fin_lit(2,iday) = Fin_lit(2,iday)
+ & + xlit_prod(ip,2,iday)*frac(ip)
+ctt endif
+
+ end do
+
+ do kpool = 1, 2
+ if(Fin_lit(kpool,iday).lt.0.) Fin_lit(kpool,iday) = 0.
+ end do
+ end do
+
+ if (sum_mean.gt.1.e-10) then
+ phi_D_mean = phi_D_mean/sum_mean
+ else
+ phi_D_mean = 0.
+ totfrac = 0.
+ do ip = 1, npft0
+ totfrac = totfrac + frac(ip)
+ phi_D_mean = phi_D_mean + frac(ip)*phi_D(ip)
+ end do
+ if (totfrac.gt.1.e-10) then
+ phi_D_mean = phi_D_mean*frac_nat(ngt)/totfrac
+ else
+ phi_D_mean = 0.
+ endif
+ endif
+
+c=======================================================================
+c Litter
+c=======================================================================
+
+
+ do kpool = 1, 2
+ test_conv = 999999.
+ iyear = 0
+
+c=======================================================================
+c beginning of integration loop
+c=======================================================================
+
+ 8000 continue
+
+ testc = xlit(kpool,nd)
+ do iday = 1, nd
+
+ iday2 = iday - 1
+ if(iday.eq.1) iday2 = nd
+
+c=======================================================================
+c incoming and outgoing fluxes
+c=======================================================================
+
+
+ Fout = gama1(kpool)*xmresp(kpool,iday)*xlit(kpool,iday2)
+ emi_burn_lit(iday) = frac_burn(iday) * phi_D_mean
+ & * xlit(kpool,iday2)
+
+ xhum_prod(kpool,iday) = alpha * Fout
+
+c=======================================================================
+c pool calculation
+c=======================================================================
+
+ xlit(kpool,iday) = xlit(kpool,iday2)
+ & + Fin_lit(kpool,iday) - Fout
+ & - emi_burn_lit(iday)
+ if(xlit(kpool,iday).lt.0.01) xlit(kpool,iday) = 0.
+
+ enddo
+
+c=======================================================================
+c convergence test
+c=======================================================================
+
+ iyear = iyear + 1
+ if(nys.eq.1) then
+
+ if(xlit(kpool,nd).le.test_conv_max) then
+ testc = abs(testc-xlit(kpool,nd))
+ else
+ testc = 100.*abs(testc-xlit(kpool,nd))
+ & / xlit(kpool,nd)
+ endif
+ else
+ testc = 0.
+ endif
+ test_conv = testc
+ if(iyear.ge.max_year) test_conv = 0.
+
+c=======================================================================
+c end of integration loop
+c=======================================================================
+
+ if(test_conv.gt.test_conv_max) goto 8000
+
+ enddo
+
+c=======================================================================
+c HUMUS
+c=======================================================================
+c=======================================================================
+c first estimate of the humus pool:
+c initialisation for a steady state.
+c=======================================================================
+
+ test_conv = 9999999.
+ iyear = 0
+
+c=======================================================================
+c beginning of integration loop
+c=======================================================================
+
+ 8100 continue
+
+ testc = xhumus(nd)
+
+ do iday = 1, nd
+
+ iday2 = iday - 1
+ if(iday.eq.1) iday2 = nd
+
+c=======================================================================
+c incoming and outgoing fluxes
+c=======================================================================
+
+ Fin = 0.
+
+ do kpool = 1, 2
+ Fin = Fin + xhum_prod(kpool,iday)
+ enddo
+
+ if(Fin .lt. 0.) Fin = 0.
+
+ Fout = gama2 * xmresp(3,iday) * xhumus(iday2)
+
+c=======================================================================
+c pool calculation
+c=======================================================================
+
+ xhumus(iday) = xhumus(iday2) + Fin - Fout
+ if(xhumus(iday).lt.0.01) xhumus(iday) = 0.
+
+ enddo
+
+c=======================================================================
+c convergence test
+c=======================================================================
+
+ iyear = iyear + 1
+ if(nys.eq.1) then
+
+ if(xhumus(nd).le.test_conv_max) then
+ testc = abs(testc-xhumus(nd))
+ else
+ testc = 100.*abs(testc-xhumus(nd))
+ & / xhumus(nd)
+ endif
+
+ else
+ testc = 0.
+ endif
+ test_conv = testc
+ if(iyear.ge.max_year) test_conv = 0.
+
+c=======================================================================
+c end of integration loop
+c=======================================================================
+
+ if(test_conv.gt.test_conv_max) goto 8100
+
+c=======================================================================
+c total soil carbon content and nep
+c=======================================================================
+
+ do iday = 1, nd
+ ysoilr(1) = ysoilr(1) + xlit(1,iday)
+ ysoilr(2) = ysoilr(2) + xlit(2,iday)
+ ysoilr(3) = ysoilr(3) + xhumus(iday)
+ xdnep(iday) = xdnep(iday)
+ & - gama1(1)*xlit(1,iday)*xmresp(1,iday)*(1.-alpha)
+ & - gama1(2)*xlit(2,iday)*xmresp(2,iday)*(1.-alpha)
+ & - gama2*xhumus(iday)*xmresp(3,iday)
+ end do
+
+ do kpool = 1, 3
+ ysoilr(kpool) = ysoilr(kpool) / float(nd)
+ ysoilr(0) = ysoilr(0) + ysoilr(kpool)
+ end do
+
+ return
+ end subroutine soil_resp
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_solar_flux.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_solar_flux.f
new file mode 100644
index 0000000..2ec8008
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_solar_flux.f
@@ -0,0 +1,92 @@
+
+c=======================================================================
+c***********************************************************************
+ subroutine solar_flux
+c***********************************************************************
+c=======================================================================
+ implicit none
+c=======================================================================
+c calculation of the radiative transfer within the canopy.
+c clump_fac = clumping factor
+c=======================================================================
+ include './com_18/parameter.common'
+ include './com_18/ext_con.common'
+ include './com_18/loop.common'
+ include './com_18/radcst.common'
+ include './com_18/sol_in.common'
+ include './com_18/strate.common'
+ include './com_18/xvalues.common'
+
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer ih
+
+ real*4 atte,attedif,attedir1,attedir2
+ real*4 facgk,facpk,facpkdif,fsun_toc
+ real*4 gk,pk,pkdif,rhoc
+
+
+c------------------------------------------------
+ do ih = 1,nh2
+
+ attedir1 = 0.
+ attedir2 = 0.
+ attedif = 0.
+ fsun(ip,iday,ih) = 1.
+
+ if(xmucar(iday,ih) .ne. 0.) then
+
+ gk = clump_fac * 0.5 / xmucar(iday,ih)
+ facgk = - gk * xlai(ip,iday) / 2.
+ if(facgk .lt. -40.) facgk = -40.
+
+ fsun_toc = 1.
+ if(nstrate.eq.1) fsun_toc = fsun0(iday,ih)
+ fsun(ip,iday,ih) = fsun_toc * exp(facgk)
+ fsun(ip,iday,ih) = 0.01*int(0.49 + 100.*fsun(ip,iday,ih))
+ if(fsun(ip,iday,ih).gt.1..or.fsun(ip,iday,ih).lt.0.) then
+ write(61,*) 'error sun/shade',fsun(ip,iday,ih)
+ stop
+ endif
+
+ attedir1 = (1- ome) * gk
+ pk = facome * gk
+ rhoc = (2 / (1. + 1.6 *xmucar(iday,ih))) * rhoc0
+
+ facpk = -pk * xlai(ip,iday) / 2.
+ if(facpk .lt. -40.) facpk = -40.
+ atte = exp(facpk) * pk * (1 - rhoc)
+ attedir2 = (atte - fsun(ip,iday,ih) * attedir1)
+ if(attedir2.lt.0.) then
+ attedir2 = 0.
+ attedir1 = atte/fsun(ip,iday,ih)
+ endif
+
+ pkdif = 0.8 * facome
+ facpkdif = -pkdif * xlai(ip,iday) / 2.
+ if(facpkdif .lt. -40.) facpkdif = -40.
+ attedif = exp(facpkdif) * pkdif * (1. - rhoc0)
+
+ endif
+
+ if(nstrate.eq.0) then
+ apar(ip,iday,ih,1) = radun *
+ & ((attedir1+attedir2)*par0(iday,ih,1)
+ & + attedif*par0(iday,ih,2))
+ apar(ip,iday,ih,2) = radun *
+ & (attedir2*par0(iday,ih,1) + attedif*par0(iday,ih,2))
+ apar(ip,iday,ih,3) = radun * attedif * par0(iday,ih,3)
+ else
+ apar(ip,iday,ih,1) = radun *
+ & ((attedir1+attedir2)*par1(iday,ih,1)
+ & + attedif*par1(iday,ih,2))
+ apar(ip,iday,ih,2) = radun *
+ & (attedir2*par1(iday,ih,1) + attedif*par1(iday,ih,2))
+ apar(ip,iday,ih,3) = radun * attedif * par1(iday,ih,3)
+ endif
+
+ enddo
+
+ return
+ end subroutine solar_flux
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_solar_trees.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_solar_trees.f
new file mode 100644
index 0000000..ee1e425
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_solar_trees.f
@@ -0,0 +1,107 @@
+c=======================================================================
+c***********************************************************************
+ subroutine solar_trees(ngt)
+c***********************************************************************
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/ecoin.common'
+ include './com_18/ext_con.common'
+ include './com_18/landuse.common'
+ include './com_18/loop.common'
+ include './com_18/nspc.common'
+ include './com_18/radcst.common'
+ include './com_18/sol_in.common'
+ include './com_18/xvalues.common'
+
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer , intent(in) :: ngt
+
+ integer ih,irad
+ real*4 facgk,facpkdif,frac_free,frac_tree_tot,gk,pkdif
+
+
+c-----------------------------------------------
+c========================================================================
+c cover fractions:
+c frac_tree_tot = total fraction of the pixel covered by trees
+c frac_free = fraction of the pixel free from trees
+c========================================================================
+
+ frac_tree_tot = 0.
+ if(frac_nat(ngt).gt.0.) then
+ do ip = nherb+nbush+1,npft0
+ frac_tree_tot = frac_tree_tot + frac(ip)
+ end do
+ endif
+ if(frac_tree_tot.gt.1.001*frac_nat(ngt)) then
+ write(61,*) 'ERROR total cover of trees',ngt
+ & ,frac_tree_tot,frac_nat(ngt)
+ stop
+ endif
+
+ frac_free = 1. - frac_tree_tot / frac_nat(ngt)
+ if(frac_free.lt.0.) frac_free = 0.
+ if(frac_free.gt.1.) frac_free = 1.
+
+c========================================================================
+c initialisation of the solar fluxes for the understorey:
+c par1 (photosynthetically active radiation)
+c 1 direct radiation
+c 2 diffuse radiation on sunny days
+c 3 diffuse radiation on cloudy days
+c fsun0 fraction of sunlit leaves
+c========================================================================
+
+ do iday = 1, nd
+ do ih = 1,nh2
+ fsun0(iday,ih) = 1. * frac_free
+ do irad = 1, 3
+ par1(iday,ih,irad) = par0(iday,ih,irad) * frac_free
+ end do
+ end do
+ end do
+
+c========================================================================
+c calculation of solar fluxes and sunlit fraction for understorey
+c========================================================================
+
+ if(frac_free .lt. 1.) then
+ do iday = 1, nd
+ do ih = 1, nh2
+ gk = 0.
+ if(xmucar(iday,ih) .ne. 0.) gk = clump_fac * 0.5
+ & / xmucar(iday,ih)
+ pkdif = 0.8 * facome
+
+ do ip = nherb+nbush+1,npft0
+ if(frac(ip).gt.1.e-7) then
+
+ facgk = - gk * xlai(ip,iday)
+ if(facgk .lt. -40.) facgk = -40.
+
+ fsun0(iday,ih) = fsun0(iday,ih)
+ & + exp(facgk) * frac(ip) / frac_nat(ngt)
+ facpkdif = -pkdif * xlai(ip,iday)
+ if(facpkdif .lt. -40.) facpkdif = -40.
+
+ par1(iday,ih,1) = par1(iday,ih,1)
+ & + par0(iday,ih,1)*(1.-ome)*exp(facgk)
+ & * frac(ip) / frac_nat(ngt)
+ par1(iday,ih,2) = par1(iday,ih,2)
+ & + par0(iday,ih,2)*(1.-rhoc0)*exp(facpkdif)
+ & * frac(ip) / frac_nat(ngt)
+ par1(iday,ih,3) = par1(iday,ih,3)
+ & + par0(iday,ih,3)*(1.-rhoc0)*exp(facpkdif)
+ & * frac(ip) /frac_nat(ngt)
+ endif
+ end do
+ end do
+ enddo
+ endif
+
+ return
+ end subroutine solar_trees
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_wat_limit.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_wat_limit.f
new file mode 100644
index 0000000..5834fbe
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_wat_limit.f
@@ -0,0 +1,69 @@
+c=======================================================================
+c***********************************************************************
+ subroutine wat_limit
+c***********************************************************************
+c=======================================================================
+ implicit none
+c=======================================================================
+c This routine determinates the maximum lai when soil water is
+c missing. Behaviour is different for grasses, evergreen, cold
+c deciduous or warm deciduous trees
+c=======================================================================
+
+ include './com_18/parameter.common'
+ include './com_18/annee.common'
+ include './com_18/bagnum.common'
+ include './com_18/carbon_maxi.common'
+ include './com_18/ecoin.common'
+ include './com_18/lai.common'
+ include './com_18/laih2o.common'
+ include './com_18/lailim.common'
+ include './com_18/loop.common'
+ include './com_18/monthcst.common'
+ include './com_18/nspc.common'
+ include './com_18/pho_sch.common'
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer m
+ real*4 ylailim
+
+c-----------------------------------------------
+
+ do ip = ipi, ipf
+ if(frac(ip).gt.1.e-7)then
+
+ xleaf_max(ip) = 0.
+ ylailim = 0.
+ if (ip.gt.nherb) then
+ if (idec(ip).eq.0) then
+ ylailim=yminlai_w(ip)+0.4*(yvslai_w(ip)-yminlai_w(ip))
+c ylailim=yminlai_w(ip)+0.8*(yvslai_w(ip)-yminlai_w(ip))
+ elseif (idec(ip).eq.1) then
+ ylailim=yminlai_w(ip)+0.4*(yvslai_w(ip)-yminlai_w(ip))
+c ylailim=yminlai_w(ip)+0.8*(yvslai_w(ip)-yminlai_w(ip))
+ endif
+ if(ylailim.lt.yminlai_w(ip)) ylailim = yminlai_w(ip)
+ endif
+ do m = 1, nm
+ if (ip.le.nherb) then
+ ylailim= xlai_w(ip,m)
+ elseif (idec(ip).eq.2) then
+ ylailim=yminlai_w(ip)+0.4*(xlai_w(ip,m)-yminlai_w(ip))
+c ylailim=yminlai_w(ip)+0.8*(xlai_w(ip,m)-yminlai_w(ip))
+ if(ylailim.lt.yminlai_w(ip)) ylailim = yminlai_w(ip)
+ endif
+
+ if(nyr_t2.eq.1) ylailim = ylailim0(ip,m)
+
+ ylailim0(ip,m) = ylailim
+
+ do iday = ini(m),ifin(m)
+ carb_max0(ip,iday) = ylailim / splai(ip)
+ end do
+ end do
+ endif
+ enddo
+
+ return
+ end subroutine wat_limit
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_wri_res.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_wri_res.f
new file mode 100644
index 0000000..acc51cc
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_wri_res.f
@@ -0,0 +1,395 @@
+c=======================================================================
+c***********************************************************************
+ subroutine wri_res
+c***********************************************************************
+c=======================================================================
+ implicit none
+c=======================================================================
+c This routine write results.
+c=======================================================================
+
+ include './com_18/parameter.common'
+ include './com_18/abobio.common'
+ include './com_18/angppf.common'
+ include './com_18/annee.common'
+ include './com_18/annppf.common'
+ include './com_18/biomasse.common'
+ include './com_18/burned.common'
+ include './com_18/cmoiRmin.common'
+ include './com_18/coord.common'
+ include './com_18/crops.common'
+ include './com_18/cte.common'
+ include './com_18/dayres.common'
+ include './com_18/ecoin.common'
+ include './com_18/fire_emi.common'
+ include './com_18/fracc13.common'
+ include './com_18/frac_change.common'
+ include './com_18/gddpix.common'
+ include './com_18/gridin2.common'
+ include './com_18/iprt.common'
+ include './com_18/loop.common'
+ include './com_18/nspc.common'
+ include './com_18/management.common'
+ include './com_18/monres.common'
+ include './com_18/monthcst.common'
+ include './com_18/monthcst2.common'
+ include './com_18/mort.common'
+ include './com_18/plant_pool.common'
+ include './com_18/plant_evol.common'
+ include './com_18/prt_ctrl.common'
+ include './com_18/pzone.common'
+ include './com_18/soil_pool.common'
+ include './com_18/xvalues.common'
+
+
+ character*100 formatw
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+
+ integer m,kpool
+
+c-----------------------------------------------
+CC real*4 tempo1(npft),tempo2(npft),tempo3(npft),tempo4,tempo5(npft)
+CC & ,tempo6(npft),tempo7(npft),tempo8(npft)
+ real*4 ylitr
+
+c=======================================================================
+c write annual and monthly results.
+c ynpp = yearly npp;
+c ygpp = yearly leaf gpp;
+c xmnpp = monthly npp;
+c xmnep = monthly nep;
+c xmlai = monthly mean leaf area index.
+c xmbiom = monthly mean total biomass
+c=======================================================================
+
+ do ip = 1, npft
+ yraf(ip) = ygppf(ip) - ynppf(ip)
+ end do
+
+ do iday = 1, nd
+ xdra(iday) = xdgpp(iday) - xdnpp(iday)
+ xdrh(iday) = xdnpp(iday) - xdnep(iday)
+ xdemifire(iday) = emi_burn_lit(iday)
+ do ip = 1, npft
+ xra(ip,iday) = xgpp(ip,iday) - xnpp(ip,iday)
+ xdemifire(iday) = xdemifire(iday)+frac(ip)*xemifire(ip,iday)
+ xdcharvest(iday)= xdcharvest(iday)+frac(ip)*xcharvest(ip,iday)
+ end do
+ xdnbp(iday) = xdnep(iday) - xdemifire(iday) - xdcharvest(iday)
+ end do
+
+ do iday = 1, nd
+ m = imonth(iday)
+ xmnpp(m) = xmnpp(m) + xdnpp(iday)
+ xmgpp(m) = xmgpp(m) + xdgpp(iday)
+ xmra(m) = xmra(m) + xdra(iday)
+ xmrh(m) = xmrh(m) + xdrh(iday)
+ xmnep(m) = xmnep(m) + xdnep(iday)
+ xmnbp(m) = xmnbp(m) + xdnbp(iday)
+ xmemifire(m) = xmemifire(m) + xdemifire(iday)
+ xmcharvest(m) = xmcharvest(m) + xdcharvest(iday)
+ xmemiblit(m) = xmemiblit(m) + emi_burn_lit(iday)
+ xmlai(m) = xmlai(m) + xdlai(iday)
+ xmbiom(m) = xmbiom(m) + xdbiom(iday)
+ xmPnf(m) = xmPnf(m) * (1.-Pf(iday))
+ xmfapar(m) = xmfapar(m) + xdfapar(iday)
+ xmfrac_burn(m) = xmfrac_burn(m) + frac_burn(iday)
+ xmarea_burn(m) = xmarea_burn(m) + area_burn(iday)
+ enddo
+
+ do m = 1, nm
+ xmnpp(m) = xmnpp(m) * xmfac(m)
+ xmgpp(m) = xmgpp(m) * xmfac(m)
+ xmra(m) = xmra(m) * xmfac(m)
+ xmrh(m) = xmrh(m) * xmfac(m)
+ xmnep(m) = xmnep(m) * xmfac(m)
+ xmnbp(m) = xmnbp(m) * xmfac(m)
+ xmemifire(m) = xmemifire(m) * xmfac(m)
+ xmcharvest(m) = xmcharvest(m) * xmfac(m)
+ xmemiblit(m) = xmemiblit(m) * xmfac(m)
+ xmlai(m) = xmlai(m) / float(mlength(m))
+ xmfapar(m) = xmfapar(m) / float(mlength(m))
+ xmbiom(m) = xmbiom(m) / float(mlength(m))
+ xmfrac_burn(m) = xmfrac_burn(m) * xmfac(m)
+ xmarea_burn(m) = xmarea_burn(m) * xmfac(m)
+ xmPf(m) = 1. - xmPnf(m)
+ enddo
+
+c if ((ifrac.eq.1.and.imig.eq.0).or.
+c & (ifrac.eq.1.and.imig.eq.1.and.nyr_t.eq.0)) then ! marie
+c if (ifrac.eq.1) then
+ write(formatw,*)'(f8.3,1x,f8.3,',npft,'(1x,f10.8))'
+ if(iprt_frac.eq.1)
+ & write(60,formatw) ylongi,ylati,(frac(ip),ip=1,npft)
+c endif
+
+ write(formatw,*)'(2(f8.3,1x),',2*npft,'(f5.2,1x))'
+ if(iprt_laimin.eq.1)
+ & write(64,formatw) ylongi,ylati,(xlai_min(ip),ip=1,npft)
+ & ,(xlai_max(ip),ip=1,npft)
+
+c beginning of if statement on iyprt
+ if (iyprt.ge.1) then
+
+ if (idaily_out.eq.0) then
+ write(formatw,*)'(f8.3,1x,f8.3,',nm,'(1x,f11.2))'
+ if(iprt_biomm.eq.1)
+ & write(55,formatw)ylongi,ylati,(xmbiom(m),m=1,nm)
+ if(iprt_gppm.eq.1)
+ & write(56,formatw)ylongi,ylati,(xmgpp(m),m=1,nm)
+ if(iprt_ram.eq.1)
+ & write(556,formatw)ylongi,ylati,(xmra(m),m=1,nm)
+ if(iprt_nppm.eq.1)
+ & write(57,formatw)ylongi,ylati,(xmnpp(m),m=1,nm)
+ if(iprt_nepm.eq.1)
+ & write(58,formatw)ylongi,ylati,(xmnep(m),m=1,nm)
+ if(iprt_rhm.eq.1)
+ & write(558,formatw)ylongi,ylati,(xmrh(m),m=1,nm)
+ if(iprt_laim.eq.1)
+ & write(59,formatw)ylongi,ylati,(xmlai(m),m=1,nm)
+ if(iprt_emifirem.eq.1)
+ & write(559,formatw)ylongi,ylati,(xmemifire(m),m=1,nm)
+ if(iprt_emiblitm.eq.1)
+ & write(560,formatw)ylongi,ylati,(xmemiblit(m),m=1,nm)
+ if(iprt_nbpm.eq.1)
+ & write(561,formatw)ylongi,ylati,(xmnbp(m),m=1,nm)
+ if ((imanag.eq.1).or.(ncrop.gt.0)) then
+ if(iprt_harvm.eq.1)
+ & write(562,formatw)ylongi,ylati,(xmcharvest(m),m=1,nm)
+ endif
+ write(formatw,*)'(f8.3,1x,f8.3,',nm,'(1x,f6.3))'
+ if(iprt_faparm.eq.1)
+ & write(98,formatw)ylongi,ylati,(xmfapar(m),m=1,nm)
+ else
+ write(formatw,*)'(f8.3,1x,f8.3,',nd,'(1x,f11.2))'
+ if(iprt_biomm.eq.1)
+ & write(55,formatw)ylongi,ylati,(xdbiom(iday),iday=1,nd)
+ if(iprt_gppm.eq.1)
+ & write(56,formatw)ylongi,ylati,(xdgpp(iday),iday=1,nd)
+ if(iprt_ram.eq.1)
+ & write(556,formatw)ylongi,ylati,(xdra(iday),iday=1,nd)
+ if(iprt_nppm.eq.1)
+ & write(57,formatw)ylongi,ylati,(xdnpp(iday),iday=1,nd)
+ if(iprt_nepm.eq.1)
+ & write(58,formatw)ylongi,ylati,(xdnep(iday),iday=1,nd)
+ if(iprt_rhm.eq.1)
+ & write(558,formatw)ylongi,ylati,(xdrh(iday),iday=1,nd)
+ if(iprt_laim.eq.1)
+ & write(59,formatw)ylongi,ylati,(xdlai(iday),iday=1,nd)
+ if(iprt_emifirem.eq.1)
+ & write(559,formatw)ylongi,ylati,(xdemifire(iday),iday=1,nd)
+ if(iprt_emiblitm.eq.1)
+ & write(560,formatw)ylongi,ylati,(emi_burn_lit(iday),iday=1,nd)
+ if(iprt_nbpm.eq.1)
+ & write(561,formatw)ylongi,ylati,(xdnbp(iday),iday=1,nd)
+ if ((imanag.eq.1).or.(ncrop.gt.0)) then
+ if(iprt_harvm.eq.1)
+ & write(562,formatw)ylongi,ylati,(xdcharvest(iday),iday=1,nd)
+ endif
+ endif
+ if (iyprt.eq.1) then
+ write(formatw,*)'(f8.3,1x,f8.3,',npft,'(1x,f11.2))'
+ if(iprt_nppf.eq.1)
+ & write(62,formatw) ylongi,ylati,(ynppf(ip),ip=1,npft)
+ if(iprt_gpp.eq.1)
+ & write(65,formatw) ylongi,ylati,(ygppf(ip),ip=1,npft)
+ if(iprt_raf.eq.1)
+ & write(565,formatw) ylongi,ylati,(yraf(ip),ip=1,npft)
+ if(iprt_emifiref.eq.1)
+ & write(665,formatw) ylongi,ylati,(yemifiref(ip),ip=1,npft)
+ elseif (iyprt.eq.2) then
+ write(formatw,*)'(',nd,'(1x,f6.2))'
+ if(iprt_nppf.eq.1) then
+ write(62,'(f8.3,1x,f8.3)') ylongi,ylati
+ do ip = 1, npft
+ write(62,formatw) (xnpp(ip,iday),iday=1,nd)
+ end do
+ endif
+ if(iprt_gpp.eq.1) then
+ write(65,'(f8.3,1x,f8.3)') ylongi,ylati
+ do ip = 1, npft
+ write(65,formatw) (xgpp(ip,iday),iday=1,nd)
+ end do
+ endif
+ if(iprt_raf.eq.1) then
+ write(565,'(f8.3,1x,f8.3)') ylongi,ylati
+ do ip = 1, npft
+ write(565,formatw) (xra(ip,iday),iday=1,nd)
+ end do
+ endif
+ if(iprt_emifiref.eq.1) then
+ write(665,'(f8.3,1x,f8.3)') ylongi,ylati
+ do ip = 1, npft
+ write(665,formatw) (xemifire(ip,iday),iday=1,nd)
+ end do
+ endif
+ endif
+
+ write(formatw,*)'(f8.3,1x,f8.3,',npft,'(1x,f11.2))'
+ if(iprt_Cveg.eq.1)
+ & write(66,formatw) ylongi,ylati,(ybiomf(ip),ip=1,npft)
+ if(iprt_Csoil.eq.1) then
+ ylitr=ysoilr(1)+ysoilr(2)
+ write(67,6767) ylongi,ylati,ysoilr(0),ylitr
+ & ,(ysoilr(kpool),kpool=1,3)
+ endif
+ 6767 format(f8.3,1x,f8.3,5(1x,f11.2))
+ if(iprt_frcC13.eq.1)
+ & write(68,formatw) ylongi,ylati,(yfractf(ip),ip=1,npft)
+ write(formatw,*)'(2(f8.3,1x),',npft,'(f9.2,1x))'
+ if(iprt_Rmin.eq.1)
+ & write(63,formatw) ylongi,ylati,(R_min(ip),ip=1,npft)
+
+ if (iyprt.eq.1) then
+ write(formatw,*)'(f8.3,1x,f8.3,',npft,'(1x,f6.3))'
+ if(iprt_laimoy.eq.1)
+ & write(69,formatw) ylongi,ylati,(xlai_moy(ip),ip=1,npft)
+ elseif (iyprt.eq.2) then
+ write(formatw,*)'(',nd,'(1x,f6.3))'
+ write(69,'(f8.3,1x,f8.3)') ylongi,ylati
+ do ip = 1, npft
+ write(69,formatw) (xlai(ip,iday),iday=1,nd)
+ end do
+ endif
+
+
+ if (ifire.eq.1) then
+ if (idaily_out.eq.0) then
+c monthly results of fire module
+ write(formatw,*)'(f8.3,1x,f8.3,',nm,'(1x,1pe9.2))'
+ if(iprt_fire.eq.1)
+ & write(73,formatw)ylongi,ylati,(xmPf(m),m=1,nm)
+ if(iprt_fburn.eq.1)
+ & write(74,formatw)ylongi,ylati,(xmfrac_burn(m),m=1,nm)
+ if(iprt_aburn.eq.1)
+ & write(75,formatw)ylongi,ylati,(xmarea_burn(m),m=1,nm)
+ else
+c daily results of fire module
+ write(formatw,*)'(f8.3,1x,f8.3,',nd,'(1x,1pe9.2))'
+ if(iprt_fire.eq.1)
+ & write(73,formatw)ylongi,ylati,(Pf(iday),iday=1,nd)
+ if(iprt_fburn.eq.1)
+ & write(74,formatw)ylongi,ylati,(frac_burn(iday),iday=1,nd)
+ if(iprt_aburn.eq.1)
+ & write(75,formatw)ylongi,ylati,(area_burn(iday),iday=1,nd)
+ endif
+ endif
+
+ if ((imanag.eq.1).or.(ncrop.gt.0)) then
+ write(formatw,*)'(f8.3,1x,f8.3,',npft,'(1x,f11.2))'
+ if(iprt_harv.eq.1)
+ & write(79,formatw)ylongi,ylati,(ycharvest(ip),ip=1,npft)
+ endif
+ if (ncrop.gt.0) then
+ write(formatw,*)'(f8.3,1x,f8.3,',npft,'(1x,f11.2))'
+ if(iprt_yield.eq.1)
+ & write(880,formatw)ylongi,ylati,(yield(ip),ip=1,npft)
+ endif
+ write(formatw,*)'(f8.3,1x,f8.3,',npft,'(1x,f11.2))'
+ if(iprt_agbiom.eq.1)
+ & write(881,formatw)ylongi,ylati,(ybiomag(ip),ip=1,npft)
+ if(iprt_bgbiom.eq.1)
+ & write(882,formatw)ylongi,ylati,(ybiombg(ip),ip=1,npft)
+ write(formatw,*)'(f8.3,1x,f8.3,',npft,'(1x,i4))'
+ if(iprt_mat.eq.1)
+ & write(883,formatw)ylongi,ylati,(maturity(ip),ip=1,npft)
+
+c tempo4 = yfnoburn
+c yfnoburn = -1.
+
+CC do ip = 1, npft
+CC if (frac(ip).lt.1.e-7) then
+CC tempo1(ip) = ftmin(ip)
+CC ftmin(ip) = -1.
+CC tempo2(ip) = fwat(ip)
+CC fwat(ip) = -1.
+CC tempo3(ip) = ftot(ip)
+CC ftot(ip) = -1.
+CC tempo5(ip) = Fgdd5(ip)
+CC Fgdd5(ip) = -1.
+CC tempo6(ip) = FTmmin(ip)
+CC FTmmin(ip) = -1.
+CC tempo7(ip) = Fwatmin(ip)
+CC Fwatmin(ip) = -1.
+CC tempo8(ip) = fnat(ip)
+CC fnat(ip) = -1.
+CC endif
+CC enddo
+
+c if (ifrac.eq.1) then
+
+ write(formatw,*)'(f8.3,1x,f8.3,',npft,'(1x,f12.8))'
+ if(iprt_yfnoburn.eq.1)
+ & write(83,'(f8.3,1x,f8.3,1x,f10.8)')ylongi,ylati,yfnoburn
+ if(iprt_ftomin.eq.1)
+ & write(84,formatw)ylongi,ylati,(ftmin(ip),ip=1,npft)
+ if(iprt_ftotw.eq.1)
+ & write(85,formatw)ylongi,ylati,(fwat(ip),ip=1,npft)
+ if(iprt_ftot.eq.1)
+ & write(86,formatw)ylongi,ylati,(ftot(ip),ip=1,npft)
+c endif
+
+ if (ifrac.eq.1) then
+
+ write(formatw,*)'(f8.3,1x,f8.3,',npft,'(1x,f10.8))'
+ if(iprt_Fgdd5.eq.1)
+ & write(87,formatw)ylongi,ylati,(Fgdd5(ip),ip=1,npft)
+ if(iprt_FTmmin.eq.1)
+ & write(88,formatw)ylongi,ylati,(FTmmin(ip),ip=1,npft)
+ if(iprt_Fwatmin.eq.1)
+ & write(89,formatw)ylongi,ylati,(Fwatmin(ip),ip=1,npft)
+ endif
+
+c end of if statement on iyprt
+ endif
+
+c write(formatw,*)'(f8.3,1x,f8.3,',npft,'(1x,f11.2))'
+c if(iprt_nppf.eq.1)
+c & write(62,formatw) ylongi,ylati,(ynppf(ip),ip=1,npft)
+
+ if (ifrac.eq.1) then
+
+ write(formatw,*)'(f8.3,1x,f8.3,1x,f12.8,',npft,'(1x,f12.8))'
+ if(iprt_yfnoburn.eq.1)
+ & write(83,formatw)
+ & ylongi,ylati,yfnoburn,(fnat(ip),ip=1,npft)
+
+ write(formatw,*)'(f8.3,1x,f8.3,',npft,'(1x,f12.8))'
+ if(iprt_ftot.eq.1)
+ & write(86,formatw)ylongi,ylati,(ftot(ip),ip=1,npft)
+
+ endif
+
+c if (imig.eq.1) then
+
+ write(formatw,*)'(f8.3,1x,f8.3,',npft,'(1x,f12.8))'
+ if(iprt_Fgdd5.eq.1)
+ & write(87,formatw)ylongi,ylati,(Fgdd5(ip),ip=1,npft)
+ if(iprt_FTmmin.eq.1)
+ & write(88,formatw)ylongi,ylati,(FTmmin(ip),ip=1,npft)
+ if(iprt_Fwatmin.eq.1)
+ & write(89,formatw)ylongi,ylati,(Fwatmin(ip),ip=1,npft)
+c endif
+
+c yfnoburn = tempo4
+
+CC do ip = 1, npft
+CC if (frac(ip).lt.1.e-7) then
+CC ftmin(ip) = tempo1(ip)
+CC fwat(ip) = tempo2(ip)
+CC ftot(ip) = tempo3(ip)
+CC Fgdd5(ip) = tempo5(ip)
+CC FTmmin(ip) = tempo6(ip)
+CC Fwatmin(ip) = tempo7(ip)
+CC fnat(ip) = tempo8(ip)
+CC endif
+CC enddo
+
+ 1000 format(6(1x,f6.1),7(1x,f8.0))
+ 1200 format(12(1x,f5.2))
+ 1500 format(i3)
+
+ return
+ end subroutine wri_res
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/carbon_year_iteration.f b/couplage/CARAIB/ver01_Iv_couplage/carbon_year_iteration.f
new file mode 100644
index 0000000..f35e278
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/carbon_year_iteration.f
@@ -0,0 +1,574 @@
+c=======================================================================
+c***********************************************************************
+ subroutine year_iteration(ngt,itmt,tmt_it)
+c***********************************************************************
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/annee.common'
+ include './com_18/annppf.common'
+ include './com_18/bagnum.common'
+ include './com_18/carbon_maxi.common'
+cIngrid201804
+ include './com_18/climin0.common'
+ include './com_18/cmoiRmin.common'
+ include './com_18/crops.common'
+ include './com_18/cte.common'
+ include './com_18/ecoin.common'
+ include './com_18/ext_con2.common'
+ include './com_18/gcaci2.common'
+ include './com_18/gk.common'
+ include './com_18/inidata.common'
+ include './com_18/init.common'
+ include './com_18/iprt.common'
+ include './com_18/lai.common'
+cIngrid201804
+ include './com_18/laih2o.common'
+cIngrid201804
+ include './com_18/lailim.common'
+ include './com_18/laiste.common'
+ include './com_18/litiere.common'
+ include './com_18/loop.common'
+ include './com_18/management.common'
+ include './com_18/mois.common'
+cIngrid201804
+ include './com_18/monthcst.common'
+cIngrid201804
+ include './com_18/monwat.common'
+ include './com_18/number_year.common'
+ include './com_18/nspc.common'
+ include './com_18/pho_sch.common'
+ include './com_18/plant_evol.common'
+ include './com_18/plant_pool.common'
+ include './com_18/pnpp2.common'
+ include './com_18/prev_yr.common'
+ include './com_18/res_temp2.common'
+cIngrid201804
+ include './com_18/strate.common'
+ include './com_18/tresh.common'
+ include './com_18/xvalues.common'
+ccccc Ingrid - stress_aera
+c donnees de sol (clay)
+ include './com_18/griddata.common'
+c aswday
+ include './com_18/varday.common'
+c fci,fsi,wpi
+ include './com_18/eco.common'
+ccccc Ingrid - stress_aera
+ integer iday_sow,iharv
+
+
+ real*4 dorm_rfac,rbmax,rem_harvbio,xlit_harvbio,rbudget
+ real*4 stress_aera(npft),poro_h2o,poro_h2o_crit(npft)
+ real*4 asw_dim,ssw
+
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer , intent(in) :: ngt, itmt
+ real*4 , intent(in) :: tmt_it
+
+ integer iday2,ipool,m
+
+ real*4 carb_max,d_leaf_max,Fin,Fin0,gk1,gk2,gk2_dorm,gk3
+ real*4 gk3max,gknew,gktot,grow_fac,h_res,resp_frac,s,test_grow,
+ & w_min,wminfac,wminfacm1,xf1,xf2,rbmax_ini
+c-----------------------------------------------
+
+ dimension gktot(npool),Fin0(npool),Fin(npool),gk2(npool),
+ & gk1(npool),
+ & resp_frac(npool),w_min(nplant)
+
+
+ do ip = ipi,ipf
+
+ if(ip.le.npft0.or.ip.ge.npft0+ncrop+1) ynppf(ip) = 0.
+
+ iharv = 0
+
+ ybinc(ip) = 0.
+
+ if(frac(ip).gt.1.e-7) then
+
+ iday_sow = int(sow_date(ip))
+
+ do iday = 1, nd
+
+ if (iday.eq.1) then
+
+ w_min(ip) = rese(ip)
+cfv & + (rese(ip)/xip(ip,1))**(1./xkappa(ip))
+ if(iday_sow.gt.0) w_min(ip) = carb_init(ip,2)
+
+ if(ip.le.npft0.or.ip.ge.npft0+ncrop+1)
+ & xlai_max(ip) = 0.
+ if(ip.gt.npft0.and.ip.le.npft0+ncrop)
+ & xlai_max(ip) = ylaimax_ini(ip,ngt)
+ if(ip.le.npft0.or.ip.ge.npft0+ncrop+1)
+ & xlai_min(ip) = 100.
+ if(ip.gt.npft0.and.ip.le.npft0+ncrop)
+ & xlai_min(ip) = ylaimin_ini(ip,ngt)
+
+ xlai_moy(ip) = 0.
+
+ endif
+
+ iday2 = iday - 1
+ if(iday .eq. 1) iday2 = nd
+ if(iphase(ip,iday).eq.1.and.carbon(ip,2,iday2).eq.0.) then
+ do ipool = 1, npool
+ carbon(ip,ipool,iday2) = carb_init(ip,ipool)
+ end do
+ rese(ip) = carbon(ip,2,iday2)
+ endif
+ if(rese(ip).gt.carbon(ip,2,iday2)) rese(ip)
+ & = carbon(ip,2,iday2)
+
+ xgpp(ip,iday) = 0.
+ xnpp(ip,iday) = 0.
+ xlrm(ip,iday) = 0.
+ xfract(ip,iday) = 0.
+ xlai(ip,iday) = carbon(ip,1,iday2) * splai(ip)
+
+ if(ip.le.npft0.or.ip.ge.npft0+ncrop+1) then
+ if (xlai(ip,iday).gt.xlai_max(ip)) xlai_max(ip) =
+ & xlai(ip,iday)
+ if (xlai(ip,iday).lt.xlai_min(ip)) xlai_min(ip) =
+ & xlai(ip,iday)
+ else
+ if(iharv.eq.0) then
+ if (xlai(ip,iday).gt.xlai_max(ip)) xlai_max(ip) =
+ & xlai(ip,iday)
+ if (xlai(ip,iday).lt.xlai_min(ip)) xlai_min(ip) =
+ & xlai(ip,iday)
+ if(maturity(ip).eq.-999) xlai_max(ip) = 0.
+ if(maturity(ip).eq.-999) xlai_max(ip) = 0.
+ ylaimax_ini(ip,ngt) = xlai_max(ip)
+ ylaimin_ini(ip,ngt) = xlai_min(ip)
+ if(iphase(ip,iday).eq.2) then
+ ylaimax_ini(ip,ngt) = 0.
+ ylaimin_ini(ip,ngt) = 0.
+c iharv = 1
+ endif
+ else
+ if (xlai(ip,iday).gt.ylaimax_ini(ip,ngt))
+ & ylaimax_ini(ip,ngt) = xlai(ip,iday)
+ if (xlai(ip,iday).gt.ylaimin_ini(ip,ngt))
+ & ylaimin_ini(ip,ngt) = xlai(ip,iday)
+ endif
+ endif
+ xlai_moy(ip) = xlai_moy(ip) + xlai(ip,iday)
+
+c=======================================================================
+c gpp calculation:
+c
+c gpp = sum over LAI of leaf layer gpp;
+c splai = specific leaf area (m2 gC-1).
+c=======================================================================
+
+c-----------------------------------------------------------------------
+ if(xlai(ip,iday).gt.0.) call solar_flux
+
+ if(itmt.eq.0.or.
+ & (nyear.eq.1.or.tmt_it.eq.itmt.or.ip.eq.isp)) then
+
+ call gpp_cal(ngt)
+
+ endif
+
+
+c do ipool = 1, npool
+c resp_fac(ip,ipool,iday) =
+c & resp_fac_temp(ip,ipool,iday,ngt)
+c enddo
+
+c gca(ip,iday) = gca_temp(ip,iday,ngt)
+c gci(ip,iday) = gci_temp(ip,iday,ngt)
+
+c zgpp(ip,iday) = zgpp_temp(ip,iday,ngt)
+
+c zfract(ip,iday) = zfract_temp(ip,iday,ngt)
+c zfh2o(ip,iday) = zfh2o_temp(ip,iday,ngt)
+
+c endif
+
+c-----------------------------------------------------------------------
+
+ xgpp(ip,iday) = xgpp(ip,iday) + zgpp(ip,iday) * xlai(ip,iday)
+ xfract(ip,iday) = xfract(ip,iday)
+ & + zfract(ip,iday) * xlai(ip,iday)
+
+c=======================================================================
+c determination of pool decrease factor, ktot (d-1):
+c ktot = k1 + k2 + k3
+c where k1 = respiration factor;
+c k2 = litter production factor;
+c k3 = factor describing biomass tranfer from reserves to
+c "green" pool.
+c
+c xnpp = daily npp.
+c=======================================================================
+
+ resp_frac(1) = 1.
+ resp_frac(2) = 1.
+
+cIngrid201806
+c if (ip.gt.nherb .and. carbon(ip,2,iday2).gt.0.) then
+ if (ip.gt.nherb .and. ip.le.npft0) then
+ if (carbon(ip,2,iday2).gt.0.) then
+
+ resp_frac(2) = xip(ip,2)
+ & * (carbon(ip,2,iday2)**(xkappa(ip)-1.))
+ if (resp_frac(2).gt.1.) resp_frac(2) = 1.
+ endif
+ endif
+
+ if((idec(ip).eq.2).and.(xlai(ip,iday).le.0.01))then
+ dorm_rfac = 0.1
+ else
+ dorm_rfac = 1.
+ endif
+c Ingrid201806 - stress aeration
+ ssw=(fsi-wpi)/(fci-wpi)
+ poro_h2o=aswday(iday)/ssw
+ poro_h2o_crit(ip)=poro_crit(ip)+(0.004*clay(ngt))
+ stress_aera(ip)=
+ & max(0.,min(1.,((1.-poro_h2o)/(1.-poro_h2o_crit(ip)))))
+c Ingrid201806 - stress aeration
+
+
+ do ipool = 1, npool
+ gk1(ipool) = gk1_25(ip,ipool) * resp_frac(ipool)
+ & * resp_fac(ip,ipool,iday)*dorm_rfac
+ gk2(ipool) = gk_fall(ip,ipool,1)
+ if(ipool.eq.1) then
+ if (
+c & tmin2(iday) .le. ttreshi1(ip) .or.
+c & tmax2(iday) .ge. ttresha1(ip) .or.
+ & water2(iday) .le. wattresh1(ip)) then !.or.
+c & xpar2(iday) .le. xpar_tresh1(ip) .or.
+c & iphase(ip,iday) .eq. 2) then
+ gk2(ipool) = gk_fall(ip,ipool,2)
+ endif
+ if (tmin2(iday) .le. ttreshi1(ip) .or.
+ & xpar2(iday) .le. xpar_tresh1(ip)) then !.or.
+charv & iphase(ip,iday) .eq. 2) then
+ gk2(ipool) = gk_fall(ip,ipool,3)
+ endif
+ elseif (ipool.eq.2) then
+cb if (tmin2(iday) .le. ttreshi2(ip) .or.
+c & tmax2(iday) .ge. ttresha2(ip) .or.
+cb & water2(iday) .le. wattresh2(ip) .or.
+cb & xpar2(iday) .le. xpar_tresh2(ip) .or.
+cb & iphase(ip,iday).eq.2) then
+charv if(iphase(ip,iday).eq.2) then
+charv gk2(ipool) = gk_fall(ip,ipool,3)
+charv endif
+c Ingrid201806 - aeration stress
+c if(poro_h2o.gt.poro_h2o_crit(ip))then
+c gk2(ipool) = gk_fall(ip,ipool,2)
+c & +((gk_fall(ip,ipool,1)-gk_fall(ip,ipool,2))
+c & *(stress_aera(ip))**2)
+c endif
+
+ endif
+ enddo
+
+ gk2_dorm = 0.2 / 365.
+ if (carbon(ip,2,iday2).le.w_min(ip) .and.
+ & iphase(ip,iday).ne.2) then
+ gk1(2) = 0.
+ gk2(2) = gk2_dorm
+ endif
+
+ wminfac = 1.5
+ wminfacm1 = wminfac - 1.
+ if (carbon(ip,2,iday2).lt.wminfac*w_min(ip).and.
+ & carbon(ip,2,iday2).gt.w_min(ip) .and.
+ & iphase(ip,iday).ne.2) then
+ xf1 = carbon(ip,2,iday2) - w_min(ip)
+ xf2 = wminfac * w_min(ip) - carbon(ip,2,iday2)
+ gk1(2) = gk1(2) * xf1 / (wminfacm1 * w_min(ip))
+ gk2(2) = (gk2(2)*xf1 + xf2*gk2_dorm) / (wminfacm1*w_min(ip))
+ endif
+
+ do ipool = 1, npool
+ gktot(ipool) = gk1(ipool) + gk2(ipool)
+ xlit_prod(ip,ipool,iday) = gk2(ipool)
+ & * carbon(ip,ipool,iday2)
+ enddo
+
+c=======================================================================
+c phenology:
+c
+c S is a phenological parameter. It determine the fraction
+c of the gross primary productivity allocated to leaves and fine roots.
+c
+c S = 0 during cold or warm period;
+c S = rootf during the growing season;
+c S = Smax during the rest of the year, limiting the green carbon
+c pool to a maximum function of the wood biomass.
+c=======================================================================
+
+ S = 0.
+ gk3 = 0.
+ carb_max = 0.
+
+
+ if (tmin2(iday) .gt. ttreshi1(ip) .and.
+c & tmax2(iday) .lt. ttresha1(ip) .and.
+ & water2(iday) .gt. wattresh1(ip) .and.
+ & xpar2(iday) .gt. xpar_tresh1(ip).and.
+ & iphase(ip,iday) .eq. 1) then
+ if (ip.le.npft0) then
+ carb_max = xip(ip,1) *
+ & (carbon(ip,2,iday2)**xkappa(ip))
+ else
+ carb_max = 10./splai(ip)
+ endif
+ if(carb_max.lt.rese(ip)) carb_max = rese(ip)
+ gknew = gktot(1)
+ if (carb_max.gt.carb_max0(ip,iday)) then
+ if (carbon(ip,1,iday2).le.carb_max0(ip,iday)) then
+ carb_max = carb_max0(ip,iday)
+ else
+ carb_max = carbon(ip,1,iday2)
+ endif
+ gknew = gk1(1)
+ endif
+ d_leaf_max = (carb_max - carbon(ip,1,iday2))/(1-h_grow)
+ & + gknew*carbon(ip,1,iday2)
+ if (d_leaf_max .lt. 0.) d_leaf_max = 0.
+ if (xgpp(ip,iday).gt.0.) S = d_leaf_max / xgpp(ip,iday)
+ if (xgpp(ip,iday).eq.0.) S = 1.
+ if (S .lt. 0.) S = 0.
+ if (S .gt. rootf(ip)) S = rootf(ip)
+ if (S.eq.rootf(ip) .and. rese(ip).gt.0.) then
+ gk3max = gkboom(ip)
+ if (carbon(ip,1,iday2).lt.carb_max .and.
+ & carbon(ip,1,iday2).lt.rese(ip)) then
+ gk3max = (d_leaf_max - S * xgpp(ip,iday))/ rese(ip)
+ if(gk3max.lt.0.) then
+ gk3max = 0.
+ endif
+ gk3 = gkboom(ip)
+ if(gk3.gt.gk3max) gk3 = gk3max
+ endif
+ endif
+ endif
+
+c=======================================================================
+c incoming fluxes
+c=======================================================================
+
+ Fin0(1) = S * xgpp(ip,iday)
+ Fin0(2) = (1. - S) * xgpp(ip,iday)
+ Fin(1) = Fin0(1) + gk3 * rese(ip)
+ Fin(2) = Fin0(2)
+
+
+
+c=======================================================================
+c management control (for management cuts)
+c=======================================================================
+
+ if (imanag.eq. 1) then
+ icut = 0
+ do ict = 1, mg_days
+ if (iday_mg(ict).eq.iday) icut = ict
+ end do
+ endif
+
+c=======================================================================
+c pools calculation
+c=======================================================================
+c write(*,*)'year_iteration:before ipool=1,npool, if carbon ...'
+
+ do ipool = 1, npool
+
+ if (carbon(ip,ipool,iday2).lt.0.) then
+ write(61,*) iyear(ip),iday,ip,ipool,
+ & carbon(ip,ipool,iday2)
+ stop
+ endif
+ if (Fin(ipool).lt.0.) Fin(ipool) = 0.
+ if (ipool.eq.1) then
+ xlrm(ip,iday) = xlrm(ip,iday)+gk1(ipool)
+ & * carbon(ip,ipool,iday2)
+ endif
+ h_res = 0.
+ test_grow = gk1(ipool) * carbon(ip,ipool,iday2)
+ if (ipool.eq.2) test_grow = test_grow + gk3 * rese(ip)
+ if (Fin(ipool) .gt. test_grow) h_res = h_grow
+ grow_fac = 1. - h_res
+ Fin(ipool) = Fin(ipool) * grow_fac
+
+ gktot(ipool) = gk1(ipool) * grow_fac
+ if (ipool.eq.2 .and. carbon(ip,ipool,iday2).ne.0.)
+ & gktot(ipool) = gktot(ipool)
+ & + gk3*rese(ip)/carbon(ip,ipool,iday2)
+ xnpp(ip,iday) = xnpp(ip,iday) + Fin(ipool)
+ & - gktot(ipool)*carbon(ip,ipool,iday2)
+
+ gktot(ipool) = gktot(ipool) + gk2(ipool)
+
+c=======================================================================
+c Reservoir budget and update of carbon biomass pool
+c=======================================================================
+
+ rbudget = Fin(ipool) - gktot(ipool)*carbon(ip,ipool,iday2)
+
+ carbon(ip,ipool,iday) = carbon(ip,ipool,iday2) + rbudget
+ if(iday.eq.1) carbon_ini(ip,ipool) = carbon(ip,ipool,iday2)
+
+
+c=======================================================================
+c Biomass increment for species longevity calculation
+c=======================================================================
+
+ ybinc(ip) = ybinc(ip)+ rbudget
+
+
+c=======================================================================
+c Estimation of PFT root biomass per m2 of presence (g C m-2)
+c rootsh = root:shoot ratio (from Mokani et al., Global Change Biol
+c 12, 84-96, 2006)
+c root_biomass = root biomass (gC m-2)
+c=======================================================================
+ if (ipool.eq.2)then
+ rbmax = (rootsh(ip)/(1.+rootsh(ip)))
+ & *(carbon(ip,1,iday)+carbon(ip,2,iday))
+ root_biomass(ip,iday) = min(carbon(ip,2,iday),rbmax)
+ if(iday.eq.1) then
+ rbmax_ini = (rootsh(ip)/(1.+rootsh(ip)))
+ & *(carbon(ip,1,iday2)+carbon(ip,2,iday2))
+ root_ini(ip) = min(carbon(ip,2,iday2),rbmax_ini)
+ endif
+ endif
+
+c=======================================================================
+c Management calculation
+c fcut = fraction of reservoir cut
+c=======================================================================
+ fcut = 0.
+
+ if ((imanag.eq.1).and.(icut.ne.0)) then
+ if (mg_mode.eq.1) then
+c reservoir 1: LAI is reduced to value stored in cleft_mg
+ if((ipool.eq.1).and.(carbon(ip,1,iday).gt.1.e-10)) fcut =
+ & 1.-((cleft_mg(1,icut)/splai(ip))/carbon(ip,1,iday))
+c reservoir 2: aboveground carbon is reduced to value stored
+c in cleft_mg
+c belowground fraction is calculated from
+c root:shoot ratio rootsh(ip)
+ if((ipool.eq.2).and.(carbon(ip,2,iday).gt.1.e-5)) fcut =
+ & 1.-((cleft_mg(2,icut)+root_biomass(ip,iday))
+ & /carbon(ip,2,iday))
+ if (fcut.lt.0.) fcut = 0.
+ if (fcut.gt.1.) fcut = 1.
+ endif
+ endif
+c=======================================================================
+c crop harvested biomass
+c=======================================================================
+ rem_harvbio = 0.
+ xlit_harvbio = 0.
+
+ if(iphase(ip,iday).eq.2.or.
+ & (iphase(ip,iday2).eq.1.and.iphase(ip,iday).eq.0)) then
+
+c crop is harvested not cut => remove any possible management cut
+ fcut = 0.
+
+c rem_harvbio = harvested biomass removed from site
+ if (ipool.eq.1) then
+ rem_harvbio = fL_harv(ip)*carbon(ip,1,iday)
+ endif
+ if (ipool.eq.2) then
+ rem_harvbio = fR_harv(ip)*root_biomass(ip,iday)
+ & +fS_harv(ip)*(carbon(ip,2,iday)-root_biomass(ip,iday))
+ endif
+
+c xlit_harvbio = harvested biomass transferred to litter
+ xlit_harvbio = carbon(ip,ipool,iday)- rem_harvbio
+
+ endif
+c=======================================================================
+
+
+c charvest= harvested or (management) cut biomass removed from site
+c
+ charvest(ip,ipool,iday) = fcut*carbon(ip,ipool,iday)
+ & + rem_harvbio
+ carbon(ip,ipool,iday) = carbon(ip,ipool,iday)
+ & - charvest(ip,ipool,iday) - xlit_harvbio
+ ycharvest(ip) = ycharvest(ip) + charvest(ip,ipool,iday)
+
+ xlit_prod(ip,ipool,iday) = xlit_prod(ip,ipool,iday)
+ & + xlit_harvbio
+
+ if (carbon(ip,ipool,iday).lt.0.01) then
+ xlit_prod(ip,ipool,iday) =
+ & xlit_prod(ip,ipool,iday) +
+ & carbon(ip,ipool,iday)
+ carbon(ip,ipool,iday) = 0.
+ endif
+
+
+ enddo ! end do ipool
+
+ 2323 format(i6,2(1x,f8.2))
+c write(*,*)'year_iteration:befor if(carbon(ip...xleaf_max'
+
+ if(carbon(ip,1,iday).gt.xleaf_max(ip))
+ & xleaf_max(ip) = carbon(ip,1,iday)
+ if(rese(ip).gt.carbon(ip,2,iday))
+ & rese(ip) = carbon(ip,2,iday)
+
+
+ if (iday.eq.nd) then
+
+cmoi----Rmin------------------------------------------------------------
+ if (xlai_max(ip).ne.0.) then
+ R_min(ip) = xlai_min(ip) / xlai_max(ip)
+ else
+ R_min(ip) = 0.
+ endif
+ xlai_moy(ip) = xlai_moy(ip) / float(nd)
+cmoi----Rmin------------------------------------------------------------
+
+ rese(ip) = rese_frac(ip) * xleaf_max(ip)
+
+ endif
+
+ if(ip.le.npft0.or.ip.ge.npft0+ncrop+1) then
+ ynppf(ip) = ynppf(ip) + xnpp(ip,iday)
+ ynppf_ini(ip,ngt) = ynppf(ip)
+ else
+ if(iharv.eq.0) then
+ ynppf(ip) = ynppf(ip) + xnpp(ip,iday)
+ if(maturity(ip).eq.-999) ynppf(ip) =0.
+ ynppf_ini(ip,ngt) = ynppf(ip)
+ if(iphase(ip,iday).eq.2) then
+ ynppf_ini(ip,ngt) = 0.
+ iharv = 1
+ endif
+ else
+ ynppf_ini(ip,ngt) = ynppf_ini(ip,ngt) + xnpp(ip,iday)
+ endif
+ endif
+
+ end do ! end do iday
+ endif
+ if(ynppf(ip).lt.0.) ynppf(ip) = 0.
+ ynppf_grd(ip,ngt) = ynppf(ip)
+
+c Ingrid
+c yield(ip) = yield_fac(ip)*ynppf(ip)
+
+
+ end do ! end do ip
+
+ return
+ end subroutine year_iteration
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/abobio.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/abobio.common
new file mode 100644
index 0000000..9827f7b
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/abobio.common
@@ -0,0 +1,2 @@
+ common /abobio/ biomf_ag(nplant),fag_pft(nplant,npool)
+ real*4 biomf_ag,fag_pft
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/acclim.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/acclim.common
new file mode 100644
index 0000000..2f94b65
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/acclim.common
@@ -0,0 +1,3 @@
+ common /acclim/ ytem_prev(ngrid,5),py_mtem(ngrid,nm),jrd_accl
+ real*4 ytem_prev,py_mtem
+ integer jrd_accl
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/ageclas.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/ageclas.common
new file mode 100644
index 0000000..234cb2f
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/ageclas.common
@@ -0,0 +1,6 @@
+ common /ageclas/ nclas(nplant),icyear_min(nplant,nclas_max),
+ & icyear_mean(nplant,nclas_max),
+ & icyear_max(nplant,nclas_max),
+ & frac_clas0(nplant,nclas_max)
+ integer nclas,icyear_min,icyear_mean,icyear_max
+ real*4 frac_clas0
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/all.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/all.common
new file mode 100644
index 0000000..9b35d02
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/all.common
@@ -0,0 +1,771 @@
+ common /abobio/ biomf_ag(nplant),fag_pft(nplant,npool)
+ real*4 biomf_ag,fag_pft
+
+ common /acclim/ ytem_prev(ngrid,5),py_mtem(ngrid,nm),jrd_accl
+ real*4 ytem_prev,py_mtem
+ integer jrd_accl
+
+ common /ageclas/ nclas(nplant),icyear_min(nplant,nclas_max),
+ & icyear_mean(nplant,nclas_max),
+ & icyear_max(nplant,nclas_max),
+ & frac_clas0(nplant,nclas_max)
+ integer nclas,icyear_min,icyear_mean,icyear_max
+ real*4 frac_clas0
+
+ common /angppf/ ygppf(nplant),yraf(nplant),yemifiref(nplant)
+ real*4 ygppf,yraf,yemifiref
+
+ common /annee/ nyr_t, iczon, ngener, ifrac, ifrac_rd, ilai_rd,
+ & nyr_t2, nys
+ integer nyr_t, iczon, ngener, ifrac, ifrac_rd, ilai_rd,
+ & nyr_t2, nys
+
+ common /annppf/ ynppf(nplant),ynppf_grd(nplant,ngrid)
+ real*4 ynppf,ynppf_grd
+
+ common /bagnum/ ipi,ipf
+ integer ipi,ipf
+
+ common /biomasse/ ybiomf(nplant),ysoilr(0:3)
+ & ,ybiomag(nplant),ybiombg(nplant)
+ & ,ybiomtot(nplant)
+ real*4 ybiomf,ysoilr,ybiomag,ybiombg,ybiomtot
+
+ common /bkdf/ deldrv(nequat,norder)
+ double precision deldrv
+
+ common /burned/ xl_flash(ndy),q_extinc(ndy)
+ & ,Pf(ndy),frac_burn(ndy),area_burn(ndy)
+ & ,fnoburn(ndy),fday(ndy),yfnoburn
+ & ,xmPf(nm),xmfrac_burn(nm),xmarea_burn(nm)
+ & ,xmPnf(nm),xmflash(nm)
+ real*4 xl_flash,q_extinc
+ & ,Pf,frac_burn,area_burn
+ & ,fnoburn,fday,yfnoburn
+ & ,xmPf,xmfrac_burn,xmarea_burn
+ & ,xmPnf,xmflash
+
+ common /c3cst/ g0(nplant),g1(nplant),gkc3,gko3,pkc3,pkcko,
+ 1 vcm0(nplant),rdsurvc0,rdsurvc,transfw,transfo
+ real*4 g0,g1,gkc3,gko3,pkc3,pkcko,
+ 1 vcm0,rdsurvc0,rdsurvc,transfw,transfo
+
+ common /c4cst/ alpc4,xkc4,q10,fact0,fact1,fact2
+ real*4 alpc4,xkc4,q10,fact0,fact1,fact2
+
+ common /c3en/ ejm,sjm,hjm,eagkc,eagko,eapkc
+ real*4 ejm,sjm,hjm,eagkc,eagko,eapkc
+
+ common /carbon_maxi/ carb_max0(nplant,ndy)
+ real*4 carb_max0
+
+ common /climin/ tcel(ndy),tdiff(ndy),rhu(ndy),prc(ndy),win(ndy),
+ 1 sunhour(ndy),water(ndy),etr(ndy),
+ 2 temax(ndy),temin(ndy),fsol(ndy)
+ real*4 tcel,tdiff,rhu,prc,win,sunhour,water,etr,
+ 1 temax,temin,fsol
+
+ common /climin0/ tcel0(nm),tdiff0(nm),rhu0(nm),prc0(nm),win0(nm),
+ 1 sunhour0(nm),water0(nm),snow_frac0(nm),etr0(nm),
+ 2 temax0(nm),temin0(nm),fsol0(nm),iaa,ibb
+ real*4 tcel0,tdiff0,rhu0,prc0,win0,sunhour0,water0
+ 1 ,snow_frac0,etr0,temax0,temin0,fsol0
+ integer iaa,ibb
+
+ common /climkop/ tcelkop(nm),prckop(nm)
+ real*4 tcelkop,prckop
+
+ common /cloud/ eh2o,rscp_air,tk
+ real*4 eh2o,rscp_air,tk
+
+ common /cmoiRmin/xlai_max(nplant),R_min(nplant),
+ & xlai_min(nplant),xlai_moy(nplant)
+ real*4 xlai_max,R_min,xlai_min,xlai_moy
+
+ common /co2/ pco2_rd
+ real*4 pco2_rd
+
+ common /coldrv/ tbldrv(nequat,norder)
+ double precision tbldrv
+
+ common /coord/ ylongi,ylati,area,declg,declat,prec_co
+ 1 ,dist_ngh(n_nghmx,ngrid)
+ 2 ,xlgcor(n_nghmx,ngrid),xltcor(n_nghmx,ngrid)
+ 3 ,igr,n_nghi,n_ngh(ngrid),ncor(ngrid)
+ real*4 ylongi,ylati,area,declg,declat,prec_co,dist_ngh
+ 1 ,xlgcor,xltcor
+ integer igr,n_nghi,n_ngh,ncor
+
+ common /crops/ sow_date(nplant),tbase(nplant),gdd_germ(nplant),
+ & gdd_harv(nplant),
+ & fL_harv(nplant),fS_harv(nplant),fR_harv(nplant),
+ & date_crops(nplant),iphase(nplant,ndy)
+ real *4 sow_date,tbase,gdd_germ,gdd_harv,
+ & fL_harv,fS_harv,fR_harv,
+ & date_crops
+ integer iphase
+
+ common /cstmort/ xk_erf,delta_tmin,delta_watmin,
+ & delta_tmax,delta_watmax,delta_gdd5
+ real*4 xk_erf,delta_tmin,delta_watmin,
+ & delta_tmax,delta_watmax,delta_gdd5
+
+ common /cstpi/ pi,pi2,pi180,pi365
+ real*4 pi,pi2,pi180,pi365
+
+ common /cte/ igtyp,idayt,ifire,ny0max,ny0prv,ny0prt,nstprt
+ 1 ,nprt,ifull,ibinrd,ibinwr,nyear,isteady,ilu,imig
+ 2 ,idaily_in,idaily_out,isp,nyear2,iclim,iclim_cal
+ 3 ,ipar,myear,ileap,iii,idtem,isol,ilusp_rd,isowd_rd
+ 4 ,jdwnCO2,jclonly,readsteady,coupling
+ integer igtyp,idayt,ifire,ny0max,ny0prv,ny0prt,nstprt
+ 1 ,nprt,ifull,ibinrd,ibinwr,nyear,isteady,ilu,imig
+ 2 ,idaily_in,idaily_out,isp,nyear2,iclim,iclim_cal
+ 3 ,ipar,myear,ileap,iii,idtem,isol,ilusp_rd,isowd_rd
+ 4 ,jdwnCO2,jclonly, readsteady,coupling
+
+ common /day_corr/ corr_hour(ndy,nh2)
+ real*4 corr_hour
+
+ common /dayres/ xdgpp(ndy),xdnpp(ndy),xdnep(ndy),xdlai(ndy),
+ & xdbiom(ndy),xdfract(ndy),xdfapar(ndy),xdgca(ndy),
+ & xdgci(ndy),xdra(ndy),xdrh(ndy),xdemifire(ndy),
+ & xdcharvest(ndy),xdnbp(ndy)
+ real*4 xdgpp,xdnpp,xdnep,xdlai,
+ & xdbiom,xdfract,xdfapar,xdgca,
+ & xdgci,xdra,xdrh,xdemifire,xdcharvest,xdnbp
+
+ common /deltac13/ delc1,delc2(nplant)
+ real*4 delc1,delc2
+
+ common /disper/ dist(n_nghmx,n_nghmx),mig_rate(nplant,ngrid)
+ & ,neighbor(n_nghmx,ngrid),pres(nplant,ngrid)
+ & ,pres_new(nplant,ngrid),pres_side(nplant,n_nghmx,ngrid)
+ & ,preside_new(nplant,n_nghmx,ngrid),reso
+ & ,ylat(n_nghmx,ngrid),ylon(n_nghmx,ngrid)
+ & ,prop(nplant,n_nghmx,ngrid),seed_persistence(ngrid)
+ & ,count(nplant,n_nghmx,ngrid)
+ & ,prop_time(nplant,n_nghmx,ngrid)
+ real*4 dist,mig_rate
+ & ,ylat,ylon,prop
+ integer neighbor,pres,pres_new,pres_side
+ & ,preside_new,seed_persistence
+ & ,count,prop_time
+
+ common /down_reg/ rvcm567(nplant),rjm567(nplant)
+ real*4 rvcm567,rjm567
+
+ common /drain/ wa0(0:nwa),fntmax,ajdr(0:nde+1,0:nwa)
+ 1 ,bjdr(0:nde+1,0:nwa)
+ real*4 wa0,fntmax,ajdr,bjdr
+
+ common /eco/ rootd,drn_fac,sdens,fsi,fci,wpi
+ 1 ,tlai,albv,colour,emiv,patm,isunit,albwd
+ real*4 rootd,drn_fac,sdens,fsi,fci,wpi,tlai,albv,colour,emiv,patm
+ 1 ,albwd
+ integer isunit
+
+ common /ecoin/ suc_est(nplant,ngrid),frac(nplant)
+ real*4 suc_est,frac
+
+ common /ecopro/ alvsw(nplant),alvlw(nplant),z0vw(nplant)
+ 1 ,z0vs(nplant),disd(nplant),emv(nplant),rdveg(nplant)
+ 2 ,zzra(nplant),zzlog(nplant),zzlogs,usmuls
+ 3 ,alvwd(nplant)
+ real*4 alvsw,alvlw,z0vw,z0vs,disd,emv,rdveg,zzra,zzlog,zzlogs
+ 1 ,usmuls,alvwd
+
+ common /envi/ o2cl,co2a,patm0,asat,bsat,csat,psat0,eaice
+ 1 ,cpdry,cph2o,drymw,h2omw,epsi,rdry,rh2o,rgas,sigma
+ 2 ,co2_prev(20)
+ real*4 o2cl,co2a,patm0,asat,bsat,csat,psat0,eaice
+ 1 ,cpdry,cph2o,drymw,h2omw,epsi,rdry,rh2o,rgas,sigma
+ 2 ,co2_prev
+
+ common /epaiss_tot/ epais_tot(nplant)
+ real*4 epais_tot
+
+ common /epaisseur/ epais(nplant,nd,nlay)
+ real*4 epais
+
+ common /estab/ gdd_est(nplant),tcmax_est(nplant)
+ & ,watmax_est(nplant),pgerm(nplant)
+ real*4 gdd_est,tcmax_est,watmax_est,pgerm
+
+ common /ext_con/ temp(ndy,nh2),hs(ndy,nh2),apar(nplant,ndy,nh2,3),
+ & rbl(nplant,ndy),fsun(nplant,ndy,nh2),
+ & fsun0(ndy,nh2),qsatmb(ndy,nh2),
+ & rae(nplant,ndy),rbw(nplant,ndy)
+ real*4 temp,hs,apar,rbl,fsun,fsun0,qsatmb,rae,rbw
+
+ common /ext_con2/ tmin2(ndy),tmax2(ndy),water2(ndy),xpar2(ndy)
+ real*4 tmin2,tmax2,water2,xpar2
+
+ common /fgr/ fgrn(nplant),fgrnmax(nplant),fgreen
+ & woodfgrn(nplant)
+ real*4 fgrn,fgrnmax,fgreen,woodfgrn
+
+ common /fileunits/ iunit_tclim,iunit_pclim
+ & ,iunit_tema,iunit_dtaa,iunit_dtba,iunit_prca
+ & ,iunit_shia,iunit_rhua,iunit_wina
+ & ,iunit_temb,iunit_dtab,iunit_dtbb,iunit_prcb
+ & ,iunit_shib,iunit_rhub,iunit_winb
+ integer iunit_tclim,iunit_pclim
+ & ,iunit_tema,iunit_dtaa,iunit_dtba,iunit_prca
+ & ,iunit_shia,iunit_rhua,iunit_wina
+ & ,iunit_temb,iunit_dtab,iunit_dtbb,iunit_prcb
+ & ,iunit_shib,iunit_rhub,iunit_winb
+
+ common /files_ibm/ filtim,filtem,fildta,filres,filtxt,filprc
+ 1 ,filshi,filrhu,filwin,filveg_in,filzon,filgen,filini
+ 2 ,filinn,filnet,filtes,filyr,filsw,filpet,filaet
+ 3 ,filrun,filrbl,filalb,filemi,filrn,filgrf,filts
+ 4 ,filfird,filfgs,filfsn,filsnd,fildrn,filsve,fillai
+ 5 ,filxh,filxle,filsol,filsf,filsne,filsml,filbagibm
+ 6 ,filtnmin,fillai_in,filtclim,filpclim,filpixcorners
+ 7 ,filelailimi,filelailimo,filclim,fildtb,filfrc,filrtr
+ 8 ,filsrun,fileint,filetr,fileso,filswmm
+ 9 ,filotem,filodte,filoprc,filoshr,filorhu,filowin
+ 1 ,fileco2prev,filetemprev,fileco2prevo,filetemprevo
+ 2 ,fileluprev
+ 3 ,filalbsv,filalbs,filalbv,filemins,filez0
+ character*120 filtim,filtem,fildta,filres,filtxt,filprc
+ 1 ,filshi,filrhu,filwin,filveg_in,filzon,filgen,filini
+ 2 ,filinn,filnet,filtes,filyr,filsw,filpet,filaet
+ 3 ,filrun,filrbl,filalb,filemi,filrn,filgrf,filts
+ 4 ,filfird,filfgs,filfsn,filsnd,fildrn,filsve,fillai
+ 5 ,filxh,filxle,filsol,filsf,filsne,filsml,filbagibm
+ 6 ,filtnmin,fillai_in,filtclim,filpclim,filpixcorners
+ 7 ,filelailimi,filelailimo,filclim,fildtb,filfrc,filrtr
+ 8 ,filsrun,fileint,filetr,fileso,filswmm
+ 9 ,filotem,filodte,filoprc,filoshr,filorhu,filowin
+ 1 ,fileco2prev,filetemprev,fileco2prevo,filetemprevo
+ 2 ,fileluprev
+ 3 ,filalbsv,filalbs,filalbv,filemins,filez0
+
+ common /files_ext/ extin, extout, kextin, kextout,
+ 1 filexti,filexto,filextlu
+ character*120 extin,extout
+ character*120 filexti
+ character*16 filexto,filextlu
+ integer kextin, kextout
+
+ common /files_car/ filebiomassi,filesoili,filenppf,
+ 1 fileRmin,filelaimin,filegpp,fileCveg,fileCsoil,
+ 2 filefrcC13,filelaimoy,fileTdmin,fileTmmin,filegdd,
+ 3 filebagtol,filebagpar,filecsurn,filegkf,filegama,
+ 4 filecinit,filetest,filefrac,filetime,filefaparm,
+ 5 filebiomm,filegppm,filenppm,filenepm,filelaim,
+ 6 fileram,filerhm,fileemifirem,filenbpm,fileemiblitm,
+ 6 fileharvm,fileraf,fileemifiref,
+ 6 filepfire,filefburn,fileaburn,fillight,fillanduse,
+ 7 fillusp,filsowd,fileclaspar,fileseas,
+ 8 filemanag,fileharvest,filelucdfr,filelucflx,
+ 9 filmig,filref,fileprop,fileside,filepres,
+ 1 fileyfnoburn,fileftomin,fileftotw,fileftot,
+ 2 fileFgdd5,fileFTmmin,fileFwatmin,
+ 3 fileprop_in,fileside_in,filepres_in
+ character*120 filebiomassi,filesoili,filenppf,
+ 1 fileRmin,filelaimin,filegpp,fileCveg,fileCsoil,
+ 2 filefrcC13,filelaimoy,fileTdmin,fileTmmin,filegdd,
+ 3 filebagtol,filebagpar,filecsurn,filegkf,filegama,
+ 4 filecinit,filetest,filefrac,filetime,filefaparm,
+ 5 filebiomm,filegppm,filenppm,filenepm,filelaim,
+ 6 fileram,filerhm,fileemifirem,filenbpm,fileemiblitm,
+ 6 fileharvm,fileraf,fileemifiref,
+ 6 filepfire,filefburn,fileaburn,fillight,fillanduse,
+ 7 fillusp,filsowd,fileclaspar,fileseas,
+ 8 filemanag,fileharvest,filelucdfr,filelucflx,
+ 9 filmig,filref,fileprop,fileside,filepres,
+ 1 fileyfnoburn,fileftomin,fileftotw,fileftot,
+ 2 fileFgdd5,fileFTmmin,fileFwatmin,
+ 3 fileprop_in,fileside_in,filepres_in
+
+ common /fire_emi/ emi_burn_veg(nplant,npool,ndy),emi_burn_lit(ndy)
+ real*4 emi_burn_veg,emi_burn_lit
+
+ common /firevpar/ phi_L(nplant),phi_S(nplant),phi_R(nplant),
+ & phi_D(nplant),psi_L(nplant),psi_S(nplant),
+ & psi_R(nplant)
+ real*4 phi_L,phi_S,phi_R,phi_D,psi_L,psi_S,psi_R
+
+ common /flux_w/ fin_w(nres),fout_w(nres),sumnet(nres)
+ real*4 fin_w,fout_w,sumnet
+
+ common /frac_change/ fracnew(nplant),fraction(nplant,ngrid)
+ & ,seed_prod(nplant),seed_estab(nplant),frac_seed(nplant)
+ & ,density(nplant),dispin(nplant),dispout(nplant)
+ & ,fraction_seed(nplant,ngrid)
+ & ,hole_herb,hole_tree,strat_herb
+ & ,strat_tree,stratnew1,stratnew2
+ & ,fraction_loss(nplant,ngrid),perte(nplant)
+ real*4 fracnew,fraction
+ & ,seed_prod,seed_estab,frac_seed
+ & ,density,dispin,dispout
+ & ,fraction_seed,hole_herb,hole_tree
+ & ,strat_herb,strat_tree,stratnew1,stratnew2
+ & ,fraction_loss,perte
+
+ common /fracc13/ yfractf(nplant)
+ real*4 yfractf
+
+c7 common /gama/ gama1(nplant,npool),gama2(nplant),alpha
+ common /gama/ gama1(2),gama2,alpha
+ real*4 gama1,gama2,alpha
+
+ common /gcaci/ gca(nplant,ndy),gci(nplant,ndy)
+c & ,gca_temp(nplant,ndy,ngrid)
+c & ,gci_temp(nplant,ndy,ngrid)
+ real*4 gca,gci
+c & ,gca_temp,gci_temp
+
+ common /gddpix/ gdd0,gdd5,Tmmin,Tdmin,Tnmin
+ & ,gdd_inf(nplant),gdd_sup(nplant)
+ & ,Tmmin_inf(nplant),Tmmin_sup(nplant)
+ & ,watmin_inf(nplant),watmin_sup(nplant)
+ & ,Fgdd5(nplant),FTmmin(nplant),Fwatmin(nplant)
+ real*4 gdd0,gdd5,Tmmin,Tdmin,Tnmin
+ & ,gdd_inf,gdd_sup
+ & ,Tmmin_inf,Tmmin_sup
+ & ,watmin_inf,watmin_sup
+ & ,Fgdd5,FTmmin,Fwatmin
+
+ common /gene/ rapportP(nzone,ndy),rapportT(nzone,ndy),
+ 1 rapportDT(nzone,ndy),ioccu(nzone,ndy),
+ 2 nombrejp(nzone,nm),nombrejpS(nzone,nm)
+ real*4 rapportP,rapportT,rapportDT
+ integer ioccu,nombrejp,nombrejps
+
+ common /gk/ gk1_25(nplant,npool),gk_fall(nplant,npool,3),
+ & gkboom(nplant),h_grow,poro_crit(nplant)
+ real*4 gk1_25,gk_fall,gkboom,h_grow,poro_crit
+
+ common /gridclim/ tcel_clim(nm,ngrid),prc_clim(nm,ngrid)
+ real*4 tcel_clim,prc_clim
+
+ common /griddata/ xlg(ngrid),xlt(ngrid),clay(ngrid)
+ & ,silt(ngrid),sand(ngrid),elev(ngrid)
+ & ,xcolor(ngrid),isu(ngrid),areapix(ngrid)
+ real*4 xlg,xlt,clay,silt,sand,elev,xcolor,areapix
+ integer isu
+
+ common /gridin2/ clati,slati
+ real*4 clati,slati
+
+ common /h2ocst/ ah2o,bh2o,ch2o,dh2o,eh2o,rgas_v
+ real*4 ah2o,bh2o,ch2o,dh2o,eh2o,rgas_v
+
+ common /hcst/ xhstep,timeday,h_step
+ real*4 xhstep,timeday,h_step
+
+ common /heure/ hour(nh2),cohour(nh2),hour1(nh2),hour2(nh2),
+ & codelhour(nh2)
+ real*4 hour,cohour,hour1,hour2,codelhour
+
+ common /icyr/ icyr_tem,icyr_dta,icyr_dtb,icyr_prc,icyr_shi,
+ 1 icyr_rhu,icyr_win,icyr_tclim,icyr_pclim,
+ 2 icyr_manag,icyr_light,icyr_landuse,icyr_lusp,
+ 3 icyr_sowd,icyr_mig,icyr_ref,
+ 4 uc0_tem,uc0_dta,uc0_dtb,uc0_prc,uc0_shi,
+ 5 uc0_rhu,uc0_win,uc0_tclim,uc0_pclim,
+ 6 uc1_tem,uc1_dta,uc1_dtb,uc1_prc,uc1_shi,
+ 7 uc1_rhu,uc1_win,uc1_tclim,uc1_pclim
+ integer icyr_tem,icyr_dta,icyr_dtb,icyr_prc,icyr_shi,
+ 1 icyr_rhu,icyr_win,icyr_tclim,icyr_pclim,
+ 2 icyr_manag,icyr_light,icyr_landuse,icyr_lusp,
+ 3 icyr_sowd,icyr_mig,icyr_ref
+ real*4 uc0_tem,uc0_dta,uc0_dtb,uc0_prc,uc0_shi,
+ 1 uc0_rhu,uc0_win,uc0_tclim,uc0_pclim,
+ 2 uc1_tem,uc1_dta,uc1_dtb,uc1_prc,uc1_shi,
+ 3 uc1_rhu,uc1_win,uc1_tclim,uc1_pclim
+
+ common /inidata/ ycar_ini(nplant,npool,ngrid)
+ & ,ylit_ini(npool,ngrid)
+ & ,yhum_ini(ngrid)
+ & ,yrese_ini(nplant,ngrid)
+ & ,yfrac_ini(nplant,ngrid)
+ & ,ylaimin_ini(nplant,ngrid)
+ & ,ylaimax_ini(nplant,ngrid)
+ & ,ybinc_ini(nplant,ngrid)
+ & ,ywat_ini(nres,ngrid)
+ real*4 ycar_ini,ylit_ini,yhum_ini,yrese_ini,yfrac_ini
+ & ,ylaimin_ini,ylaimax_ini,ybinc_ini,ywat_ini
+
+ common /init/ carb_init(nplant,npool)
+ real*4 carb_init
+
+ common /input_par/ n_pix
+ integer n_pix
+
+ common /iprt/ iprt_yr,iprt_frc,iprt_sw,iprt_swmm,iprt_rtr
+ 1 ,iprt_pet,iprt_aet,iprt_run,iprt_fsn,iprt_snd
+ 1 ,iprt_drn,iprt_sve,iprt_srun,iprt_eint,iprt_etr
+ 1 ,iprt_eso,iprt_rbl,iprt_alb,iprt_rn
+ 2 ,iprt_grf,iprt_ts,iprt_fgs,iprt_lai,iprt_fird
+ 3 ,iprt_xh,iprt_xle,iprt_sol,iprt_sf,iprt_sne,iprt_sml
+ 4 ,iprt_emi,iprt_biomm,iprt_gppm,iprt_nppm,iprt_nepm
+ 5 ,iprt_ram,iprt_rhm,iprt_laim,iprt_emifirem,iprt_nbpm
+ 6 ,iprt_emiblitm,iprt_harvm,iprt_raf,iprt_emifiref
+ 5 ,iprt_frac,iprt_nppf,iprt_Rmin,iprt_faparm
+ 6 ,iprt_laimin,iprt_gpp,iprt_Cveg,iprt_Csoil
+ 7 ,iprt_frcC13,iprt_laimoy,iprt_harv,iprt_Tdmin
+ 8 ,iprt_Tmmin,iprt_gdd,iprt_fire,iprt_fburn,iprt_aburn
+ 9 ,iprt_yfnoburn,iprt_ftomin,iprt_ftotw,iprt_ftot
+ 1 ,iprt_Fgdd5,iprt_FTmmin,iprt_Fwatmin
+ 2 ,iprt_prop,iprt_side,iprt_pres,iprt_zon
+ 3 ,iprt_tem,iprt_dte,iprt_prc,iprt_shr,iprt_rhu
+ 4 ,iprt_win,iprt_lucdfr,iprt_lucflx
+ 5 ,iprt_albsv,iprt_albs,iprt_albv,iprt_emins,iprt_z0
+ integer iprt_yr,iprt_frc,iprt_sw,iprt_swmm,iprt_rtr
+ 1 ,iprt_pet,iprt_aet,iprt_run,iprt_fsn,iprt_snd
+ 1 ,iprt_drn,iprt_sve,iprt_srun,iprt_eint,iprt_etr
+ 1 ,iprt_eso,iprt_rbl,iprt_alb,iprt_rn
+ 2 ,iprt_grf,iprt_ts,iprt_fgs,iprt_lai,iprt_fird
+ 3 ,iprt_xh,iprt_xle,iprt_sol,iprt_sf,iprt_sne,iprt_sml
+ 4 ,iprt_emi,iprt_biomm,iprt_gppm,iprt_nppm,iprt_nepm
+ 5 ,iprt_ram,iprt_rhm,iprt_laim,iprt_emifirem,iprt_nbpm
+ 6 ,iprt_emiblitm,iprt_harvm,iprt_raf,iprt_emifiref
+ 5 ,iprt_frac,iprt_nppf,iprt_Rmin,iprt_faparm
+ 6 ,iprt_laimin,iprt_gpp,iprt_Cveg,iprt_Csoil
+ 7 ,iprt_frcC13,iprt_laimoy,iprt_harv,iprt_Tdmin
+ 8 ,iprt_Tmmin,iprt_gdd,iprt_fire,iprt_fburn,iprt_aburn
+ 9 ,iprt_yfnoburn,iprt_ftomin,iprt_ftotw,iprt_ftot
+ 1 ,iprt_Fgdd5,iprt_FTmmin,iprt_Fwatmin
+ 2 ,iprt_prop,iprt_side,iprt_pres,iprt_zon
+ 3 ,iprt_tem,iprt_dte,iprt_prc,iprt_shr,iprt_rhu
+ 4 ,iprt_win,iprt_lucdfr,iprt_lucflx
+ 5 ,iprt_albsv,iprt_albs,iprt_albv,iprt_emins,iprt_z0
+
+
+ common /kernel/ Xmin,Xmax,ynppf_mean,ynppf_max,
+ & spec_npp,
+ & midpoint_ab(100),probdenswind_ab(100),
+ & midpoint_pi(96),probdenswind_pi(96)
+ real*4 Xmin,Xmax,ynppf_mean,ynppf_max,spec_npp,
+ & midpoint_ab,probdenswind_ab,
+ & midpoint_pi,probdenswind_pi
+
+ common /lai/ splai(nplant),xleaf_max(nplant)
+ real*4 splai,xleaf_max
+
+ common /laih2o/ xlai_w(nplant,nm)
+ & ,cfh2o(nplant,nm),ylai_w(nplant)
+ & ,yvslai_w(nplant),yminlai_w(nplant)
+ real*4 xlai_w
+ & ,cfh2o,ylai_w
+ & ,yvslai_w,yminlai_w
+
+ common /lailim/ ylailim0(nplant,nm)
+ real*4 ylailim0
+
+ common /laiste/ xlaimax
+ real*4 xlaimax
+
+ common /landuse/ frac_nat(ngrid),frac_crop(ngrid)
+ & ,frac_past(ngrid),frac_urb(ngrid)
+ & ,frac_rock(ngrid),frac_wat(ngrid)
+ real*4 frac_nat,frac_crop,frac_past,frac_urb,frac_rock
+ & ,frac_wat
+
+ common /landuse0/ frac_nat0(ngrid),frac_crop0(ngrid)
+ & ,frac_past0(ngrid),frac_urb0(ngrid)
+ & ,frac_rock0(ngrid),frac_wat0(ngrid)
+ real*4 frac_nat0,frac_crop0,frac_past0,frac_urb0,frac_rock0
+ & ,frac_wat0
+
+ common /litiere/ xlit_prod(nplant,npool,ndy),xhum_prod(2,ndy)
+ real*4 xlit_prod,xhum_prod
+
+ common /loop/ ip,iday
+ integer ip,iday
+
+ common /luc/ dfr_nat,dfr_crop,dfr_past,dfr_urb,dfr_rock,dfr_wat
+ & ,rdfr_nat,rdfr_crop,rdfr_past,rdfr_urb,rdfr_rock,rdfr_wat
+ real*4 dfr_nat,dfr_crop,dfr_past,dfr_urb,dfr_rock,dfr_wat
+ & ,rdfr_nat,rdfr_crop,rdfr_past,rdfr_urb,rdfr_rock,rdfr_wat
+
+ common /lucflx/ yemi_luc(nplant,npool),xlit_luc(nplant,npool)
+ & ,frac0(nplant),bg_bio(nplant),ag_bio(nplant,npool)
+ real*4 yemi_luc,xlit_luc,frac0,bg_bio,ag_bio
+
+ common /lstcli/ climatslst
+ character*3 climatslst(34)
+
+ common /lstreg/ reg
+ character*1 reg(34)
+
+ common /lstz/ listezone
+ character*8 listezone(nzone)
+
+ common /management/ iday_mg(ndy),imanag,mg_mode,mg_days,icut,ict
+ & ,cleft_mg(npool,ndy),fcut,ycharvest(nplant)
+ & ,charvest(nplant,npool,ndy)
+ integer iday_mg,imanag,mg_mode,mg_days,icut,ict
+ real*4 cleft_mg,fcut,ycharvest,charvest
+
+ common /memory/ olddrv(nequat), oldbdo(nequat,norder)
+ double precision olddrv,oldbdo
+
+ common /mois/ month
+ integer month
+
+ common /monres/ xmgpp(nm),xmnpp(nm),xmnep(nm),xmlai(nm),xmbiom(nm)
+ & ,xmfapar(nm),xmra(nm),xmrh(nm),xmemifire(nm)
+ & ,xmcharvest(nm),xmemiblit(nm),xmnbp(nm)
+ real*4 xmgpp,xmnpp,xmnep,xmlai,xmbiom,xmfapar,xmra,xmrh,xmemifire
+ & ,xmcharvest,xmemiblit,xmnbp
+
+ common /monthcst/ imonth(ndy),mlength(nm),mondec(nm),numday(nm)
+ & ,ini(nm),ifin(nm)
+ integer imonth,mlength,mondec,numday
+ & ,ini,ifin
+
+ common /monthcst2/ xmfac(nm)
+ real*4 xmfac
+
+ common /monwat/ swcar(nm),rtrcar(nm),svecar(nm),fsncar(nm),aswmin
+ real*4 swcar,rtrcar,svecar,fsncar,aswmin
+
+ common /mort/ tmin_inf(nplant),tmin_sup(nplant)
+ & ,tmax_inf(nplant),tmax_sup(nplant)
+ & ,wat_inf(nplant),wat_sup(nplant)
+ & ,xpar_inf(nplant),xpar_sup(nplant)
+ & ,ftmin(nplant),ftmax(nplant)
+ & ,fwat(nplant),fxpar(nplant),ftemp(nplant,ndy)
+ & ,ftot(nplant),fnat(nplant),ftotmin(nplant)
+ & ,ftotw(nplant)
+ real*4 tmin_inf,tmin_sup
+ & ,tmax_inf,tmax_sup
+ & ,wat_inf,wat_sup
+ & ,xpar_inf,xpar_sup
+ & ,ftmin,ftmax
+ & ,fwat,fxpar,ftemp
+ & ,ftot,fnat,ftotmin
+ & ,ftotw
+
+ common /netcdf_name/ ncname_tclim,ncname_pclim
+ & ,ncname_tem,ncname_dta,ncname_dtb,ncname_prc
+ & ,ncname_shi,ncname_rhu,ncname_win
+ character*10 ncname_tclim,ncname_pclim
+ & ,ncname_tem,ncname_dta,ncname_dtb,ncname_prc
+ & ,ncname_shi,ncname_rhu,ncname_win
+
+ common /netcdf_par/ num_ncdf,incdf_tclim,incdf_pclim
+ & ,incdf_tem,incdf_dta,incdf_dtb,incdf_prc
+ & ,incdf_shi,incdf_rhu,incdf_win
+ integer num_ncdf,incdf_tclim,incdf_pclim
+ & ,incdf_tem,incdf_dta,incdf_dtb,incdf_prc
+ & ,incdf_shi,incdf_rhu,incdf_win
+
+ common /newbdo/ bdo(nequat,norder)
+ double precision bdo
+
+ common /npp/ xnpp_year(nplant)
+ real*4 xnpp_year
+
+ common /nspc/ nherb,nbush,ntree,npft0,ncrop,npast,npft
+ integer nherb,nbush,ntree,npft0,ncrop,npast,npft
+
+c parameter.common
+ integer ndy,nde,nfmean,nfn,
+ 1 nres,nequat,nh2,nh,nlay,
+ 2 nm,nm2,norder,nplant,nclas_max,npool,
+ 3 nwa,nw,nzone,ngrid,n_nghmx,
+ 4 ny_tempo
+ parameter (ndy=366,nde=2,nfmean=10,nfn=2*nfmean,
+ 1 nres=2,nequat=nres,nh2=6,nh=2*nh2,nlay=16,
+ 2 nm=12,nm2=2*nm,norder=4,nplant=90,nclas_max=6,npool=2,
+ 3 nwa=20,nw=73,nzone=176,ngrid=100000,n_nghmx=8,
+ 4 ny_tempo=50)
+ common /ndays/ nd,idayct
+ integer nd,idayct
+
+
+c parameter_orb.common
+ integer ORB_UNDEF_INT,ORB_NOT_YEAR_BASED
+ real ORB_ECCEN_MIN,ORB_ECCEN_MAX,ORB_OBLIQ_MIN,
+ 1 ORB_OBLIQ_MAX,ORB_MVELP_MIN,ORB_MVELP_MAX,
+ 2 ORB_UNDEF_REAL,ORB_DEFAULT
+ parameter (ORB_ECCEN_MIN=0.0,ORB_ECCEN_MAX=0.1,
+ 1 ORB_OBLIQ_MIN=-90.0,ORB_OBLIQ_MAX=90.0,
+ 2 ORB_MVELP_MIN=0.0,ORB_MVELP_MAX=360.0,
+ 3 ORB_UNDEF_REAL = 1.e36,ORB_DEFAULT=ORB_UNDEF_REAL,
+ 4 ORB_UNDEF_INT=2000000000,
+ 5 ORB_NOT_YEAR_BASED=ORB_UNDEF_INT)
+
+ common /number_year/ iyear(nplant),max_year
+ integer iyear,max_year
+
+ common /pathg/ pathgene
+ character*120 pathgene
+
+ common /pheno/ iday_stress(nplant)
+ integer iday_stress
+
+ common /pho_sch/ ic4(nplant),idec(nplant)
+ integer ic4,idec
+
+ common /pixdata/ kzone(ngrid)
+ integer kzone
+
+ common /plant_evol/ xip(nplant,2),xkappa(nplant),rese_frac(nplant)
+ & ,rootf(nplant),rootsh(nplant)
+ real*4 xip,xkappa,rese_frac,rootf,rootsh
+
+ common /plant_pool/ carbon(nplant,npool,ndy),rese(nplant),
+ & root_biomass(nplant,ndy),ybinc(nplant)
+ real*4 carbon,rese,root_biomass,ybinc
+
+ common /plheight/ bag_h(nplant)
+ real*4 bag_h
+
+ common /pnpp/ zgpp(nplant,ndy),znpp(nplant,ndy),
+ & zfract(nplant,ndy),zfh2o(nplant,ndy)
+c & ,zgpp_temp(nplant,ndy,ngrid)
+c & ,zfract_temp(nplant,ndy,ngrid)
+c & ,zfh2o_temp(nplant,ndy,ngrid)
+ real*4 zgpp,znpp,zfract,zfh2o
+c & ,zgpp_temp,zfract_temp,zfh2o_temp
+
+ common /prev_yr/ ybinc_prv(nplant),xlaimax_prv(nplant),ilgtree
+ real*4 ybinc_prv,xlaimax_prv
+ integer ilgtree
+
+ common /prt/ swmth(ndy),swmmmth(ndy),petmth(ndy),aetmth(ndy)
+ 1 ,runmth(ndy),rblmth(ndy),albmth(ndy)
+ 2 ,drnmth(ndy),svemth(ndy),firdmth(ndy)
+ 3 ,rnmth(ndy),grfmth(ndy),tsmth(ndy)
+ 4 ,xhmth(ndy),xlemth(ndy),solmth(ndy)
+ 5 ,fgsmth(ndy),fsnmth(ndy),sndmth(ndy),tlamth(ndy)
+ 6 ,sfmth(ndy),snemth(ndy),smlmth(ndy)
+ 7 ,emimth(ndy),rtrmth(ndy),srunmth(ndy),eintmth(ndy)
+ 8 ,etrmth(ndy),esomth(ndy)
+ 8 ,runy,soey,pety,sney,prcy,svey
+ 9 ,mdur(ndy),nsmth(ndy),nsyr
+ 1 ,albsvmth(ndy),albsmth(ndy),albvmth(ndy)
+ 2 ,eminsmth(ndy),z0mth(ndy)
+ real*4 swmth,swmmmth,petmth,aetmth,runmth,rblmth,albmth,drnmth
+ 1 ,svemth,firdmth
+ 2 ,rnmth,grfmth,tsmth,xhmth,xlemth,solmth,fgsmth
+ 3 ,fsnmth,sndmth,tlamth,sfmth,snemth,smlmth,emimth,rtrmth
+ 4 ,srunmth,eintmth,etrmth,esomth
+ 5 ,runy,soey,pety,sney,prcy,svey
+ 6 ,albsvmth,albsmth,albvmth,eminsmth,z0mth
+ integer mdur,nsmth,nsyr
+
+ common /prt_ctrl/ iyprt,ipr_clim
+ integer iyprt,ipr_clim
+
+ common /pzone/ izonepxl
+ integer izonepxl
+
+ common /radcst/ ome,facome,rhoc0,radun,parun,clump_fac
+ real*4 ome,facome,rhoc0,radun,parun,clump_fac
+
+ common /rblcst1/ zzras,arbl,brbl,exrbl,unitfac,h2osurco2
+ real*4 zzras,arbl,brbl,exrbl,unitfac,h2osurco2
+
+ common /res_par/ partoc(ndy)
+ real*4 partoc
+
+ common /res_temp/ resp_fac(nplant,npool,ndy)
+c & ,resp_fac_temp(nplant,npool,ndy,ngrid)
+ real*4 resp_fac
+c & ,resp_fac_temp
+
+ common /rk/ yk1(nequat), yk2(nequat), yk3(nequat),
+ 1 drvk2(nequat), drvk3(nequat), drvk4(nequat)
+ double precision yk1, yk2, yk3, drvk2, drvk3, drvk4
+
+
+ common /smrd/ smfs,smfc,smwp,cla
+ 1 ,san,sil,acd,bcd
+ real*4 smfs,smfc,smwp,cla,san,sil,acd,bcd
+
+ common /snow/ snow_frac(ndy)
+ real*4 snow_frac
+
+ common /soil_marie/ xlit_burn(nplant,npool,ndy)
+ & ,xlit_newprod(nplant,npool,ndy)
+ real*4 xlit_burn,xlit_newprod
+
+ common /sol_in/ xmucar(ndy,nh2),par0(ndy,nh2,3),par1(ndy,nh2,3)
+ real*4 xmucar,par0,par1
+
+ common /solpar/ exc,exc2,exc3,exc4,exc5,xlsper,obl,sunea
+ 1 ,rearth,rearth2,hatrea,hatm,ftrmin,ftrmax
+ real*4 exc,exc2,exc3,exc4,exc5,xlsper,obl,sunea
+ 1 ,rearth,rearth2,hatrea,hatm,ftrmin,ftrmax
+
+c7 common /soil_pool/ xlit(nplant,npool,ndy),xhumus(nplant,ndy)
+ common /soil_pool/ xlit(npool,ndy),xhumus(ndy)
+ real*4 xlit,xhumus
+
+ common /sresp/ facgrnd,q10grnd,factree,q10tree
+ real*4 facgrnd,q10grnd,factree,q10tree
+
+ common /sr_par/ cmoxm1,xm1,pssat
+ real*4 cmoxm1,xm1,pssat
+
+ common /strate/ nstrate
+ integer nstrate
+
+ common /temper/ temp0
+ real*4 temp0
+
+ common /textcst1/ cmoptcla,cmoptsil,cmoptsan,
+ & xm1cla,xm1sil,xm1san,
+ & psatcla,psatsil,psatsan
+ real*4 cmoptcla,cmoptsil,cmoptsan,
+ & xm1cla,xm1sil,xm1san,
+ & psatcla,psatsil,psatsan
+
+ common /tresh/ ttreshi1(nplant),ttresha1(nplant),wattresh1(nplant)
+ & ,xpar_tresh1(nplant),ttreshi2(nplant)
+ & ,ttresha2(nplant),wattresh2(nplant)
+ & ,xpar_tresh2(nplant)
+ real*4 ttreshi1,ttresha1,wattresh1,xpar_tresh1,ttreshi2
+ & ,ttresha2,wattresh2,xpar_tresh2
+
+ common /varday/ solday(ndy,0:nh2),ftrday(ndy,0:nh2)
+ 2 ,xmuday(ndy,0:nh2),tladay(ndy)
+ 3 ,aswday(ndy),rblday(ndy,nplant)
+ 4 ,gppday(ndy),ppnday(ndy),penday(ndy)
+ real*4 solday,ftrday,xmuday,tladay,aswday,rblday,gppday
+ 1 ,ppnday,penday
+
+ common /varnow/ temi,delti,preci,shi
+ 1 ,hai,windi,grflx,rnet,axle
+ 2 ,asw,ts,fgs,alb,rblwm
+ 3 ,rblcv(nplant),fsn,snd,fird,xh
+ 4 ,solg(0:nh),ftrs(0:nh),xmu(0:nh)
+ 5 ,rf,sf,sml,emisf,albsv,albsoil
+ 6 ,albvege,emisfns,z0tot
+ double precision temi,delti,preci,shi
+ 1 ,hai,windi,grflx,rnet,axle
+ 2 ,asw,ts,fgs,alb,rblwm
+ 3 ,rblcv,fsn,snd,fird,xh
+ 4 ,solg,ftrs,xmu
+ 5 ,rf,sf,sml,emisf,albsv,albsoil
+ 6 ,albvege,emisfns,z0tot
+
+ common /vegfr/ frc(nplant),plai(nplant),fveg
+ real*4 frc,plai,fveg
+
+ common /veglab/ pft_name
+ character*50 pft_name(nplant)
+
+ common /waflux/ pet,soe,sve,sne,aet
+ 1 ,drun,srun,rtrans
+ double precision pet,soe,sve,sne,aet
+ 1 ,drun,srun,rtrans
+
+ common /xlaic/ t1pft(nplant),t2pft(nplant),xlmin(nplant)
+ & ,xlmax(nplant),wai(nplant)
+ real*4 t1pft,t2pft,xlmin,xlmax,wai
+
+ common /xvalues/ xgpp(nplant,ndy),xnpp(nplant,ndy),
+ & xlrm(nplant,ndy),xfract(nplant,ndy),
+ & xlai(nplant,ndy),xra(nplant,ndy),
+ & xemifire(nplant,ndy),xcharvest(nplant,ndy)
+ real*4 xgpp,xnpp,xlrm,xfract,xlai,xra,xemifire,xcharvest
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/angppf.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/angppf.common
new file mode 100644
index 0000000..dc4dfb7
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/angppf.common
@@ -0,0 +1,2 @@
+ common /angppf/ ygppf(nplant),yraf(nplant),yemifiref(nplant)
+ real*4 ygppf,yraf,yemifiref
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/annee.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/annee.common
new file mode 100644
index 0000000..963e798
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/annee.common
@@ -0,0 +1,4 @@
+ common /annee/ nyr_t, iczon, ngener, ifrac, ifrac_rd, ilai_rd,
+ & nyr_t2, nys, imig_rd
+ integer nyr_t, iczon, ngener, ifrac, ifrac_rd, ilai_rd,
+ & nyr_t2, nys, imig_rd
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/annppf.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/annppf.common
new file mode 100644
index 0000000..bf7a3c7
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/annppf.common
@@ -0,0 +1,2 @@
+ common /annppf/ ynppf(nplant),ynppf_grd(nplant,ngrid)
+ real*4 ynppf,ynppf_grd
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/bagnum.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/bagnum.common
new file mode 100644
index 0000000..c82b7b4
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/bagnum.common
@@ -0,0 +1,2 @@
+ common /bagnum/ ipi,ipf
+ integer ipi,ipf
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/biomasse.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/biomasse.common
new file mode 100644
index 0000000..6be59ed
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/biomasse.common
@@ -0,0 +1,4 @@
+ common /biomasse/ ybiomf(nplant),ysoilr(0:3)
+ & ,ybiomag(nplant),ybiombg(nplant)
+ & ,ybiomtot(nplant)
+ real*4 ybiomf,ysoilr,ybiomag,ybiombg,ybiomtot
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/bkdf.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/bkdf.common
new file mode 100644
index 0000000..ac2e09e
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/bkdf.common
@@ -0,0 +1,2 @@
+ common /bkdf/ deldrv(nequat,norder)
+ double precision deldrv
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/burned.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/burned.common
new file mode 100644
index 0000000..adcb231
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/burned.common
@@ -0,0 +1,10 @@
+ common /burned/ xl_flash(ndy),q_extinc(ndy)
+ & ,Pf(ndy),frac_burn(ndy),area_burn(ndy)
+ & ,fnoburn(ndy),fday(ndy),yfnoburn
+ & ,xmPf(nm),xmfrac_burn(nm),xmarea_burn(nm)
+ & ,xmPnf(nm),xmflash(nm)
+ real*4 xl_flash,q_extinc
+ & ,Pf,frac_burn,area_burn
+ & ,fnoburn,fday,yfnoburn
+ & ,xmPf,xmfrac_burn,xmarea_burn
+ & ,xmPnf,xmflash
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/c3cst.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/c3cst.common
new file mode 100644
index 0000000..ceee81a
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/c3cst.common
@@ -0,0 +1,4 @@
+ common /c3cst/ g0(nplant),g1(nplant),gkc3,gko3,pkc3,pkcko,
+ 1 vcm0(nplant),rdsurvc0,rdsurvc,transfw,transfo
+ real*4 g0,g1,gkc3,gko3,pkc3,pkcko,
+ 1 vcm0,rdsurvc0,rdsurvc,transfw,transfo
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/c3en.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/c3en.common
new file mode 100644
index 0000000..c459d32
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/c3en.common
@@ -0,0 +1,2 @@
+ common /c3en/ ejm,sjm,hjm,eagkc,eagko,eapkc
+ real*4 ejm,sjm,hjm,eagkc,eagko,eapkc
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/c4cst.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/c4cst.common
new file mode 100644
index 0000000..66c820a
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/c4cst.common
@@ -0,0 +1,2 @@
+ common /c4cst/alpc4,xkc4,q10,fact0,fact1,fact2
+ real*4 alpc4,xkc4,q10,fact0,fact1,fact2
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/carbon_maxi.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/carbon_maxi.common
new file mode 100644
index 0000000..ed130c1
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/carbon_maxi.common
@@ -0,0 +1,2 @@
+ common /carbon_maxi/ carb_max0(nplant,ndy)
+ real*4 carb_max0
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/climin.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/climin.common
new file mode 100644
index 0000000..c91c5c9
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/climin.common
@@ -0,0 +1,5 @@
+ common /climin/ tcel(ndy),tdiff(ndy),rhu(ndy),prc(ndy),win(ndy),
+ 1 sunhour(ndy),water(ndy),etr(ndy),
+ 2 temax(ndy),temin(ndy),fsol(ndy)
+ real*4 tcel,tdiff,rhu,prc,win,sunhour,water,etr,
+ 1 temax,temin,fsol
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/climin0.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/climin0.common
new file mode 100644
index 0000000..f77302f
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/climin0.common
@@ -0,0 +1,6 @@
+ common /climin0/ tcel0(nm),tdiff0(nm),rhu0(nm),prc0(nm),win0(nm),
+ 1 sunhour0(nm),water0(nm),snow_frac0(nm),etr0(nm),
+ 2 temax0(nm),temin0(nm),fsol0(nm),iaa,ibb
+ real*4 tcel0,tdiff0,rhu0,prc0,win0,sunhour0,water0
+ 1 ,snow_frac0,etr0,temax0,temin0,fsol0
+ integer iaa,ibb
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/climin1.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/climin1.common
new file mode 100644
index 0000000..3628fb8
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/climin1.common
@@ -0,0 +1,2 @@
+ common /climin1/ tdiff(ndy),rhu(ndy),prc(ndy),win(ndy)
+ real*4 tdiff,rhu,prc,win
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/climin2.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/climin2.common
new file mode 100644
index 0000000..ffac483
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/climin2.common
@@ -0,0 +1,2 @@
+ common /climin2/ tcel(ndy),water(ndy),etr(ndy)
+ real*4 tcel,water,etr
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/climin3.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/climin3.common
new file mode 100644
index 0000000..055f48b
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/climin3.common
@@ -0,0 +1,2 @@
+ common /climin3/ sunhour(ndy)
+ real*4 sunhour
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/climkop.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/climkop.common
new file mode 100644
index 0000000..bf1741e
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/climkop.common
@@ -0,0 +1,4 @@
+ common /climkop/ tcelkop(nm),prckop(nm)
+ real*4 tcelkop,prckop
+
+
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/cloud.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/cloud.common
new file mode 100644
index 0000000..9064775
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/cloud.common
@@ -0,0 +1,2 @@
+ common /cloud/ eh2o,rscp_air,tk
+ real*4 eh2o,rscp_air,tk
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/cmoiRmin.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/cmoiRmin.common
new file mode 100644
index 0000000..869637d
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/cmoiRmin.common
@@ -0,0 +1,3 @@
+ common /cmoiRmin/ xlai_max(nplant),R_min(nplant),
+ & xlai_min(nplant),xlai_moy(nplant)
+ real*4 xlai_max,R_min,xlai_min,xlai_moy
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/co2.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/co2.common
new file mode 100644
index 0000000..0486102
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/co2.common
@@ -0,0 +1,2 @@
+ common /co2/ pco2_rd
+ real*4 pco2_rd
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/coldrv.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/coldrv.common
new file mode 100644
index 0000000..1c8f898
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/coldrv.common
@@ -0,0 +1,2 @@
+ common /coldrv/ tbldrv(nequat,norder)
+ double precision tbldrv
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/coord.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/coord.common
new file mode 100644
index 0000000..8d07502
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/coord.common
@@ -0,0 +1,7 @@
+ common /coord/ ylongi,ylati,area,declg,declat,prec_co
+ 1 ,dist_ngh(n_nghmx,ngrid)
+ 2 ,xlgcor(n_nghmx,ngrid),xltcor(n_nghmx,ngrid)
+ 3 ,igr,n_nghi,n_ngh(ngrid),ncor(ngrid)
+ real*4 ylongi,ylati,area,declg,declat,prec_co,dist_ngh
+ 1 ,xlgcor,xltcor
+ integer igr,n_nghi,n_ngh,ncor
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/crops.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/crops.common
new file mode 100644
index 0000000..4cbf8f2
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/crops.common
@@ -0,0 +1,11 @@
+ common /crops/ sow_date(nplant),tbase(nplant),gdd_germ(nplant),
+ & gdd_harv(nplant),gr_seas(nplant),icvar(nplant),
+ & fL_harv(nplant),fS_harv(nplant),fR_harv(nplant),
+ & date_crops(nplant),iphase(nplant,ndy),
+ & harv_ind(nplant),wc_harv(nplant),
+ & yield_fac(nplant),yield(nplant),maturity(nplant),
+ & iday_germ(nplant,ngrid),iday_harv(nplant)
+ real *4 sow_date,tbase,gdd_germ,gdd_harv,
+ & fL_harv,fS_harv,fR_harv,
+ & date_crops,harv_ind,wc_harv,yield_fac,yield
+ integer iphase,maturity,gr_seas,icvar,iday_germ,iday_harv
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/cstmort.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/cstmort.common
new file mode 100644
index 0000000..1e930d9
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/cstmort.common
@@ -0,0 +1,4 @@
+ common /cstmort/ xk_erf,delta_tmin,delta_watmin,
+ & delta_tmax,delta_watmax,delta_gdd5
+ real*4 xk_erf,delta_tmin,delta_watmin,
+ & delta_tmax,delta_watmax,delta_gdd5
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/cstpi.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/cstpi.common
new file mode 100644
index 0000000..d05d642
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/cstpi.common
@@ -0,0 +1,2 @@
+ common /cstpi/ pi,pi2,pi180,pi365
+ real*4 pi,pi2,pi180,pi365
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/cte.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/cte.common
new file mode 100644
index 0000000..8b12b8a
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/cte.common
@@ -0,0 +1,10 @@
+ common /cte/ igtyp,idayt,ifire,ny0max,ny0prv,ny0prt,nstprt
+ 1 ,nprt,ifull,ibinrd,ibinwr,nyear,isteady,ilu,imig
+ 2 ,idaily_in,idaily_out,isp,nyear2,iclim,iclim_cal
+ 3 ,ipar,myear,ileap,iii,idtem,isol,ilusp_rd,isowd_rd
+ 4 ,jdwnCO2,jclonly,icvar_rd,readsteady,coupling
+ integer igtyp,idayt,ifire,ny0max,ny0prv,ny0prt,nstprt
+ 1 ,nprt,ifull,ibinrd,ibinwr,nyear,isteady,ilu,imig
+ 2 ,idaily_in,idaily_out,isp,nyear2,iclim,iclim_cal
+ 3 ,ipar,myear,ileap,iii,idtem,isol,ilusp_rd,isowd_rd
+ 4 ,jdwnCO2,jclonly,icvar_rd,readsteady,coupling
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/day_corr.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/day_corr.common
new file mode 100644
index 0000000..6166184
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/day_corr.common
@@ -0,0 +1,2 @@
+ common /day_corr/ corr_hour(ndy,nh2)
+ real*4 corr_hour
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/dayres.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/dayres.common
new file mode 100644
index 0000000..a8d0520
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/dayres.common
@@ -0,0 +1,7 @@
+ common /dayres/ xdgpp(ndy),xdnpp(ndy),xdnep(ndy),xdlai(ndy),
+ & xdbiom(ndy),xdfract(ndy),xdfapar(ndy),xdgca(ndy),
+ & xdgci(ndy),xdra(ndy),xdrh(ndy),xdemifire(ndy),
+ & xdcharvest(ndy),xdnbp(ndy)
+ real*4 xdgpp,xdnpp,xdnep,xdlai,
+ & xdbiom,xdfract,xdfapar,xdgca,
+ & xdgci,xdra,xdrh,xdemifire,xdcharvest,xdnbp
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/deltac13.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/deltac13.common
new file mode 100644
index 0000000..7c79b10
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/deltac13.common
@@ -0,0 +1,2 @@
+ common /deltac13/ delc1,delc2(nplant)
+ real*4 delc1,delc2
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/disper.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/disper.common
new file mode 100644
index 0000000..4e2683f
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/disper.common
@@ -0,0 +1,13 @@
+ common /disper/ dist(n_nghmx,n_nghmx),mig_rate(nplant,ngrid)
+ & ,neighbor(n_nghmx,ngrid),pres(nplant,ngrid)
+ & ,pres_new(nplant,ngrid),pres_side(nplant,n_nghmx,ngrid)
+ & ,preside_new(nplant,n_nghmx,ngrid)
+ & ,ylat(n_nghmx,ngrid),ylon(n_nghmx,ngrid)
+ & ,prop(nplant,n_nghmx,ngrid),seed_persistence(ngrid)
+ & ,count(nplant,n_nghmx,ngrid)
+ & ,prop_time(nplant,n_nghmx,ngrid),irfg(ngrid)
+ real*4 dist,mig_rate
+ & ,ylat,ylon,prop
+ integer neighbor,pres,pres_new,pres_side
+ & ,preside_new,seed_persistence
+ & ,count,prop_time,irfg
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/down_reg.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/down_reg.common
new file mode 100644
index 0000000..be06fa8
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/down_reg.common
@@ -0,0 +1,2 @@
+ common /down_reg/ rvcm567(nplant),rjm567(nplant)
+ real*4 rvcm567,rjm567
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/drain.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/drain.common
new file mode 100644
index 0000000..0cb4508
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/drain.common
@@ -0,0 +1,3 @@
+ common /drain/ wa0(0:nwa),fntmax,ajdr(0:nde+1,0:nwa)
+ 1 ,bjdr(0:nde+1,0:nwa)
+ real*4 wa0,fntmax,ajdr,bjdr
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/eco.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/eco.common
new file mode 100644
index 0000000..857be37
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/eco.common
@@ -0,0 +1,5 @@
+ common /eco/ rootd,drn_fac,sdens,fsi,fci,wpi
+ 1 ,tlai,albv,colour,emiv,patm,isunit,albwd
+ real*4 rootd,drn_fac,sdens,fsi,fci,wpi,tlai,albv,colour,emiv,patm
+ 1 ,albwd
+ integer isunit
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/ecoin.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/ecoin.common
new file mode 100644
index 0000000..320ae6d
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/ecoin.common
@@ -0,0 +1,2 @@
+ common /ecoin/ suc_est(nplant,ngrid),frac(nplant)
+ real*4 suc_est,frac
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/ecoin2.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/ecoin2.common
new file mode 100644
index 0000000..8c25a9b
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/ecoin2.common
@@ -0,0 +1,2 @@
+ common /ecoin/ suc_est(nplant),frac(nplant)
+ real*4 suc_est,frac
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/ecopro.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/ecopro.common
new file mode 100644
index 0000000..0fed482
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/ecopro.common
@@ -0,0 +1,6 @@
+ common /ecopro/ alvsw(nplant),alvlw(nplant),z0vw(nplant)
+ 1 ,z0vs(nplant),disd(nplant),emv(nplant),rdveg(nplant)
+ 2 ,zzra(nplant),zzlog(nplant),zzlogs,usmuls
+ 3 ,alvwd(nplant)
+ real*4 alvsw,alvlw,z0vw,z0vs,disd,emv,rdveg,zzra,zzlog,zzlogs
+ 1 ,usmuls,alvwd
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/envi.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/envi.common
new file mode 100644
index 0000000..a593ab7
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/envi.common
@@ -0,0 +1,6 @@
+ common /envi/ o2cl,co2a,patm0,asat,bsat,csat,psat0,eaice
+ 1 ,cpdry,cph2o,drymw,h2omw,epsi,rdry,rh2o,rgas,sigma
+ 2 ,co2_prev(20)
+ real*4 o2cl,co2a,patm0,asat,bsat,csat,psat0,eaice
+ 1 ,cpdry,cph2o,drymw,h2omw,epsi,rdry,rh2o,rgas,sigma
+ 2 ,co2_prev
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/epaiss_tot.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/epaiss_tot.common
new file mode 100644
index 0000000..aa66544
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/epaiss_tot.common
@@ -0,0 +1,2 @@
+ common /epaiss_tot/ epais_tot(nplant)
+ real*4 epais_tot
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/epaisseur.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/epaisseur.common
new file mode 100644
index 0000000..c0b860b
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/epaisseur.common
@@ -0,0 +1,2 @@
+ common /epaisseur/ epais(nplant,nd,nlay)
+ real*4 epais
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/estab.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/estab.common
new file mode 100644
index 0000000..6f94fdc
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/estab.common
@@ -0,0 +1,3 @@
+ common /estab/ gdd_est(nplant),tcmax_est(nplant)
+ & ,watmax_est(nplant),pgerm(nplant)
+ real*4 gdd_est,tcmax_est,watmax_est,pgerm
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/ext_con.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/ext_con.common
new file mode 100644
index 0000000..2e4a1df
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/ext_con.common
@@ -0,0 +1,5 @@
+ common /ext_con/ temp(ndy,nh2),hs(ndy,nh2),apar(nplant,ndy,nh2,3),
+ & rbl(nplant,ndy),fsun(nplant,ndy,nh2),
+ & fsun0(ndy,nh2),qsatmb(ndy,nh2),
+ & rae(nplant,ndy),rbw(nplant,ndy)
+ real*4 temp,hs,apar,rbl,fsun,fsun0,qsatmb,rae,rbw
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/ext_con2.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/ext_con2.common
new file mode 100644
index 0000000..53f5775
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/ext_con2.common
@@ -0,0 +1,2 @@
+ common /ext_con2/ tmin2(ndy),tmax2(ndy),water2(ndy),xpar2(ndy)
+ real*4 tmin2,tmax2,water2,xpar2
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/fgr.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/fgr.common
new file mode 100644
index 0000000..802eea5
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/fgr.common
@@ -0,0 +1,3 @@
+ common /fgr/ fgrn(nplant),fgrnmax(nplant),fgreen
+ & ,woodfgrn(nplant)
+ real*4 fgrn,fgrnmax,fgreen,woodfgrn
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/files_car.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/files_car.common
new file mode 100644
index 0000000..55545cb
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/files_car.common
@@ -0,0 +1,35 @@
+ common /files_car/ filebiomassi,filesoili,filenppf,
+ 1 fileRmin,filelaimin,filegpp,fileCveg,fileCsoil,
+ 2 filefrcC13,filelaimoy,fileTdmin,fileTmmin,filegdd,
+ 3 filebagtol,filebagpar,filecsurn,filegkf,filegama,
+ 4 filecinit,filetest,filefrac,filetime,filefaparm,
+ 5 filebiomm,filegppm,filenppm,filenepm,filelaim,
+ 6 fileram,filerhm,fileemifirem,filenbpm,fileemiblitm,
+ 6 fileharvm,fileraf,fileemifiref,
+ 6 filepfire,filefburn,fileaburn,fillight,fillanduse,
+ 7 fillusp,filsowd,fileclaspar,fileseas,filcropvar,
+ 8 filemanag,fileharvest,fileyield,
+ 9 fileagbiom,filebgbiom,filharvd,
+ 1 filemat,filelucdfr,filelucflx,
+ 2 filmig,filref,fileprop,fileside,filepres,
+ 3 fileyfnoburn,fileftomin,fileftotw,fileftot,
+ 4 fileFgdd5,fileFTmmin,fileFwatmin,
+ 5 fileprop_in,fileside_in,filepres_in
+ character*120 filebiomassi,filesoili,filenppf,
+ 1 fileRmin,filelaimin,filegpp,fileCveg,fileCsoil,
+ 2 filefrcC13,filelaimoy,fileTdmin,fileTmmin,filegdd,
+ 3 filebagtol,filebagpar,filecsurn,filegkf,filegama,
+ 4 filecinit,filetest,filefrac,filetime,filefaparm,
+ 5 filebiomm,filegppm,filenppm,filenepm,filelaim,
+ 6 fileram,filerhm,fileemifirem,filenbpm,fileemiblitm,
+ 6 fileharvm,fileraf,fileemifiref,
+ 6 filepfire,filefburn,fileaburn,fillight,fillanduse,
+ 7 fillusp,filsowd,fileclaspar,fileseas,filcropvar,
+ 8 filemanag,fileharvest,fileyield,
+ 9 fileagbiom,filebgbiom,filharvd,
+ 1 filemat,filelucdfr,filelucflx,
+ 2 filmig,filref,fileprop,fileside,filepres,
+ 3 fileyfnoburn,fileftomin,fileftotw,fileftot,
+ 4 fileFgdd5,fileFTmmin,fileFwatmin,
+ 5 fileprop_in,fileside_in,filepres_in
+
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/files_ext.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/files_ext.common
new file mode 100644
index 0000000..2bccac2
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/files_ext.common
@@ -0,0 +1,6 @@
+ common /files_ext/ extin, extout, kextin, kextout,
+ 1 filexti,filexto,filextlu
+ character*120 extin,extout
+ character*120 filexti
+ character*16 filexto,filextlu
+ integer kextin, kextout
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/files_ext2.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/files_ext2.common
new file mode 100644
index 0000000..c65f9ff
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/files_ext2.common
@@ -0,0 +1,5 @@
+ common /files_ext/ extin, extout, kextin, kextout,
+ 1 filexti,filexto
+ character*100 extin,extout
+ character*6 filexti,filexto
+ integer kextin, kextout
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/files_ibm.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/files_ibm.common
new file mode 100644
index 0000000..bad74df
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/files_ibm.common
@@ -0,0 +1,26 @@
+ common /files_ibm/ filtim,filtem,fildta,filres,filtxt,filprc
+ 1 ,filshi,filrhu,filwin,filveg_in,filzon,filgen,filini
+ 2 ,filinn,filnet,filtes,filyr,filsw,filpet,filaet
+ 3 ,filrun,filrbl,filalb,filemi,filrn,filgrf,filts
+ 4 ,filfird,filfgs,filfsn,filsnd,fildrn,filsve,fillai
+ 5 ,filxh,filxle,filsol,filsf,filsne,filsml,filbagibm
+ 6 ,filtnmin,fillai_in,filtclim,filpclim,filpixcorners
+ 7 ,filelailimi,filelailimo,filclim,fildtb,filfrc,filrtr
+ 8 ,filsrun,fileint,filetr,fileso,filswmm
+ 9 ,filotem,filodte,filoprc,filoshr,filorhu,filowin
+ 1 ,fileco2prev,filetemprev,fileco2prevo,filetemprevo
+ 2 ,fileluprev,filecropini,filecropino
+ 3 ,filalbsv,filalbs,filalbv,filemins,filez0
+ character*120 filtim,filtem,fildta,filres,filtxt,filprc
+ 1 ,filshi,filrhu,filwin,filveg_in,filzon,filgen,filini
+ 2 ,filinn,filnet,filtes,filyr,filsw,filpet,filaet
+ 3 ,filrun,filrbl,filalb,filemi,filrn,filgrf,filts
+ 4 ,filfird,filfgs,filfsn,filsnd,fildrn,filsve,fillai
+ 5 ,filxh,filxle,filsol,filsf,filsne,filsml,filbagibm
+ 6 ,filtnmin,fillai_in,filtclim,filpclim,filpixcorners
+ 7 ,filelailimi,filelailimo,filclim,fildtb,filfrc,filrtr
+ 8 ,filsrun,fileint,filetr,fileso,filswmm
+ 9 ,filotem,filodte,filoprc,filoshr,filorhu,filowin
+ 1 ,fileco2prev,filetemprev,fileco2prevo,filetemprevo
+ 2 ,fileluprev,filecropini,filecropino
+ 3 ,filalbsv,filalbs,filalbv,filemins,filez0
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/fileunits.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/fileunits.common
new file mode 100644
index 0000000..17596ce
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/fileunits.common
@@ -0,0 +1,10 @@
+ common /fileunits/ iunit_tclim,iunit_pclim
+ & ,iunit_tema,iunit_dtaa,iunit_dtba,iunit_prca
+ & ,iunit_shia,iunit_rhua,iunit_wina
+ & ,iunit_temb,iunit_dtab,iunit_dtbb,iunit_prcb
+ & ,iunit_shib,iunit_rhub,iunit_winb
+ integer iunit_tclim,iunit_pclim
+ & ,iunit_tema,iunit_dtaa,iunit_dtba,iunit_prca
+ & ,iunit_shia,iunit_rhua,iunit_wina
+ & ,iunit_temb,iunit_dtab,iunit_dtbb,iunit_prcb
+ & ,iunit_shib,iunit_rhub,iunit_winb
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/fire_emi.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/fire_emi.common
new file mode 100644
index 0000000..bd6ec85
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/fire_emi.common
@@ -0,0 +1,2 @@
+ common /fire_emi/ emi_burn_veg(nplant,npool,ndy),emi_burn_lit(ndy)
+ real*4 emi_burn_veg,emi_burn_lit
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/firevpar.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/firevpar.common
new file mode 100644
index 0000000..d96b694
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/firevpar.common
@@ -0,0 +1,4 @@
+ common /firevpar/ phi_L(nplant),phi_S(nplant),phi_R(nplant),
+ & phi_D(nplant),psi_L(nplant),psi_S(nplant),
+ & psi_R(nplant)
+ real*4 phi_L,phi_S,phi_R,phi_D,psi_L,psi_S,psi_R
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/flux_w.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/flux_w.common
new file mode 100644
index 0000000..8db2885
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/flux_w.common
@@ -0,0 +1,2 @@
+ common /flux_w/ fin_w(nres),fout_w(nres),sumnet(nres)
+ real*4 fin_w,fout_w,sumnet
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/frac_change.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/frac_change.common
new file mode 100644
index 0000000..3ae40ff
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/frac_change.common
@@ -0,0 +1,14 @@
+ common /frac_change/ fracnew(nplant),fraction(nplant,ngrid)
+ & ,seed_prod(nplant),seed_estab(nplant),frac_seed(nplant)
+ & ,density(nplant),dispin(nplant),dispout(nplant)
+ & ,fraction_seed(nplant,ngrid)
+ & ,hole_herb,hole_tree,strat_herb
+ & ,strat_tree,stratnew1,stratnew2
+ & ,fraction_loss(nplant,ngrid),perte(nplant)
+ real*4 fracnew,fraction
+ & ,seed_prod,seed_estab,frac_seed
+ & ,density,dispin,dispout
+ & ,fraction_seed,hole_herb,hole_tree
+ & ,strat_herb,strat_tree,stratnew1,stratnew2
+ & ,fraction_loss,perte
+
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/fracc13.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/fracc13.common
new file mode 100644
index 0000000..c293fb5
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/fracc13.common
@@ -0,0 +1,2 @@
+ common /fracc13/ yfractf(nplant)
+ real*4 yfractf
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/gama.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/gama.common
new file mode 100644
index 0000000..6d10d96
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/gama.common
@@ -0,0 +1,2 @@
+ common /gama/ gama1(2),gama2,alpha
+ real*4 gama1,gama2,alpha
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/gcaci.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/gcaci.common
new file mode 100644
index 0000000..7e5b5b8
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/gcaci.common
@@ -0,0 +1,5 @@
+ common /gcaci/ gca(nplant,ndy),gci(nplant,ndy)
+ & ,gca_temp(nplant,ndy,ngrid)
+ & ,gci_temp(nplant,ndy,ngrid)
+ real*4 gca,gci
+ & ,gca_temp,gci_temp
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/gcaci2.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/gcaci2.common
new file mode 100644
index 0000000..db4b7bd
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/gcaci2.common
@@ -0,0 +1,5 @@
+ common /gcaci/ gca(nplant,ndy),gci(nplant,ndy)
+c & ,gca_temp(nplant,ndy,ngrid)
+c & ,gci_temp(nplant,ndy,ngrid)
+ real*4 gca,gci
+c & ,gca_temp,gci_temp
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/gddpix.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/gddpix.common
new file mode 100644
index 0000000..43945ae
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/gddpix.common
@@ -0,0 +1,16 @@
+ common /gddpix/ gdd0,gdd5,Tmmin,Tdmin,Tnmin
+ & ,gdd_inf(nplant),gdd_sup(nplant)
+ & ,Tmmin_inf(nplant),Tmmin_sup(nplant)
+ & ,watmin_inf(nplant),watmin_sup(nplant)
+ & ,Fgdd5(nplant),FTmmin(nplant),Fwatmin(nplant)
+ & ,ylaimax_mean,ylai_est,ylai_inf,ylai_sup
+ real*4 gdd0,gdd5,Tmmin,Tdmin,Tnmin
+ & ,gdd_inf,gdd_sup
+ & ,Tmmin_inf,Tmmin_sup
+ & ,watmin_inf,watmin_sup
+ & ,Fgdd5,FTmmin,Fwatmin
+ & ,ylaimax_mean,ylai_est
+ & ,ylai_inf,ylai_sup
+
+
+
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/gene.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/gene.common
new file mode 100644
index 0000000..e745e0a
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/gene.common
@@ -0,0 +1,6 @@
+ common /gene/ rapportP(nzone,ndy),rapportT(nzone,ndy)
+ 1 ,rapportDT(nzone,ndy),ioccu(nzone,ndy)
+ 2 ,nombrejp(nzone,nm),nombrejpS(nzone,nm)
+ real*4 rapportP,rapportT,rapportDT
+ integer ioccu,nombrejp,nombrejps
+
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/ginp_old.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/ginp_old.common
new file mode 100644
index 0000000..e929e87
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/ginp_old.common
@@ -0,0 +1,3 @@
+ common /ginp/ tem(ngr,nm),delt(ngr,nm),prec(ngr,nm)
+ 1 ,sh(ngr,nm),ha(ngr,nm),wind(ngr,nm)
+ real*4 tem,delt,prec,sh,ha,wind
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/gk.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/gk.common
new file mode 100644
index 0000000..b610b37
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/gk.common
@@ -0,0 +1,3 @@
+ common /gk/ gk1_25(nplant,npool),gk_fall(nplant,npool,3),
+ & gkboom(nplant),h_grow,poro_crit(nplant)
+ real*4 gk1_25,gk_fall,gkboom,h_grow,poro_crit
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/gridclim.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/gridclim.common
new file mode 100644
index 0000000..c53dda8
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/gridclim.common
@@ -0,0 +1,2 @@
+ common /gridclim/ tcel_clim(nm,ngrid),prc_clim(nm,ngrid)
+ real*4 tcel_clim,prc_clim
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/griddata.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/griddata.common
new file mode 100644
index 0000000..18ae6bc
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/griddata.common
@@ -0,0 +1,5 @@
+ common /griddata/ xlg(ngrid),xlt(ngrid),clay(ngrid)
+ & ,silt(ngrid),sand(ngrid),elev(ngrid)
+ & ,xcolor(ngrid),isu(ngrid),areapix(ngrid)
+ real*4 xlg,xlt,clay,silt,sand,elev,xcolor,areapix
+ integer isu
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/gridin2.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/gridin2.common
new file mode 100644
index 0000000..329a091
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/gridin2.common
@@ -0,0 +1,2 @@
+ common /gridin2/ clati,slati
+ real*4 clati,slati
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/h2ocst.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/h2ocst.common
new file mode 100644
index 0000000..e8c92df
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/h2ocst.common
@@ -0,0 +1,2 @@
+ common /h2ocst/ ah2o,bh2o,ch2o,dh2o,eh2o,rgas_v
+ real*4 ah2o,bh2o,ch2o,dh2o,eh2o,rgas_v
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/hcst.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/hcst.common
new file mode 100644
index 0000000..eecba71
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/hcst.common
@@ -0,0 +1,2 @@
+ common /hcst/ xhstep,timeday,h_step
+ real*4 xhstep,timeday,h_step
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/heure.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/heure.common
new file mode 100644
index 0000000..24db5bc
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/heure.common
@@ -0,0 +1,3 @@
+ common /heure/ hour(nh2),cohour(nh2),hour1(nh2),hour2(nh2),
+ & codelhour(nh2)
+ real*4 hour,cohour,hour1,hour2,codelhour
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/icyr.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/icyr.common
new file mode 100644
index 0000000..cea7fdb
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/icyr.common
@@ -0,0 +1,20 @@
+ common /icyr/ icyr_tem,icyr_dta,icyr_dtb,icyr_prc,icyr_shi,
+ 1 icyr_rhu,icyr_win,icyr_tclim,icyr_pclim,
+ 2 icyr_manag,icyr_light,icyr_landuse,icyr_lusp,
+ 3 icyr_sowd,icyr_mig,icyr_ref,icyr_cropvar,
+ 4 icyr_harvd,
+ 5 uc0_tem,uc0_dta,uc0_dtb,uc0_prc,uc0_shi,
+ 6 uc0_rhu,uc0_win,uc0_tclim,uc0_pclim,
+ 7 uc1_tem,uc1_dta,uc1_dtb,uc1_prc,uc1_shi,
+ 8 uc1_rhu,uc1_win,uc1_tclim,uc1_pclim
+ integer icyr_tem,icyr_dta,icyr_dtb,icyr_prc,icyr_shi,
+ 1 icyr_rhu,icyr_win,icyr_tclim,icyr_pclim,
+ 2 icyr_manag,icyr_light,icyr_landuse,icyr_lusp,
+ 3 icyr_sowd,icyr_mig,icyr_ref,icyr_cropvar,
+ 4 icyr_harvd
+ real*4 uc0_tem,uc0_dta,uc0_dtb,uc0_prc,uc0_shi,
+ 1 uc0_rhu,uc0_win,uc0_tclim,uc0_pclim,
+ 2 uc1_tem,uc1_dta,uc1_dtb,uc1_prc,uc1_shi,
+ 3 uc1_rhu,uc1_win,uc1_tclim,uc1_pclim
+
+
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/inidata.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/inidata.common
new file mode 100644
index 0000000..03921a2
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/inidata.common
@@ -0,0 +1,15 @@
+ common /inidata/ ycar_ini(nplant,npool,ngrid)
+ & ,ylit_ini(npool,ngrid)
+ & ,yhum_ini(ngrid)
+ & ,yrese_ini(nplant,ngrid)
+ & ,yfrac_ini(nplant,ngrid)
+ & ,ylaimin_ini(nplant,ngrid)
+ & ,ylaimax_ini(nplant,ngrid)
+ & ,ybinc_ini(nplant,ngrid)
+ & ,ywat_ini(nres,ngrid)
+ & ,gdd_ini(nplant,ngrid)
+ & ,ygppf_ini(nplant,ngrid)
+ & ,ynppf_ini(nplant,ngrid)
+ real*4 ycar_ini,ylit_ini,yhum_ini,yrese_ini,yfrac_ini
+ & ,ylaimin_ini,ylaimax_ini,ybinc_ini,ywat_ini
+ & ,gdd_ini,ygppf_ini,ynppf_ini
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/init.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/init.common
new file mode 100644
index 0000000..1a34726
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/init.common
@@ -0,0 +1,2 @@
+ common /init/ carb_init(nplant,npool)
+ real*4 carb_init
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/input_par.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/input_par.common
new file mode 100644
index 0000000..ca513da
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/input_par.common
@@ -0,0 +1,2 @@
+ common /input_par/ n_pix
+ integer n_pix
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/iprt.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/iprt.common
new file mode 100644
index 0000000..cd51ba2
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/iprt.common
@@ -0,0 +1,40 @@
+ common /iprt/ iprt_yr,iprt_frc,iprt_sw,iprt_swmm,iprt_rtr
+ 1 ,iprt_pet,iprt_aet,iprt_run,iprt_fsn,iprt_snd
+ 1 ,iprt_drn,iprt_sve,iprt_srun,iprt_eint,iprt_etr
+ 1 ,iprt_eso,iprt_rbl,iprt_alb,iprt_rn
+ 2 ,iprt_grf,iprt_ts,iprt_fgs,iprt_lai,iprt_fird
+ 3 ,iprt_xh,iprt_xle,iprt_sol,iprt_sf,iprt_sne,iprt_sml
+ 4 ,iprt_emi,iprt_biomm,iprt_gppm,iprt_nppm,iprt_nepm
+ 5 ,iprt_ram,iprt_rhm,iprt_laim,iprt_emifirem,iprt_nbpm
+ 6 ,iprt_emiblitm,iprt_harvm,iprt_raf,iprt_emifiref
+ 5 ,iprt_frac,iprt_nppf,iprt_Rmin,iprt_faparm
+ 6 ,iprt_laimin,iprt_gpp,iprt_Cveg,iprt_Csoil
+ 7 ,iprt_frcC13,iprt_laimoy,iprt_Tdmin,iprt_mat
+ 8 ,iprt_harv,iprt_yield,iprt_agbiom,iprt_bgbiom
+ 9 ,iprt_Tmmin,iprt_gdd,iprt_fire,iprt_fburn,iprt_aburn
+ 1 ,iprt_yfnoburn,iprt_ftomin,iprt_ftotw,iprt_ftot
+ 2 ,iprt_Fgdd5,iprt_FTmmin,iprt_Fwatmin
+ 3 ,iprt_prop,iprt_side,iprt_pres,iprt_zon
+ 4 ,iprt_tem,iprt_dte,iprt_prc,iprt_shr,iprt_rhu
+ 5 ,iprt_win,iprt_lucdfr,iprt_lucflx
+ 6 ,iprt_albsv,iprt_albs,iprt_albv,iprt_emins,iprt_z0
+ integer iprt_yr,iprt_frc,iprt_sw,iprt_swmm,iprt_rtr
+ 1 ,iprt_pet,iprt_aet,iprt_run,iprt_fsn,iprt_snd
+ 1 ,iprt_drn,iprt_sve,iprt_srun,iprt_eint,iprt_etr
+ 1 ,iprt_eso,iprt_rbl,iprt_alb,iprt_rn
+ 2 ,iprt_grf,iprt_ts,iprt_fgs,iprt_lai,iprt_fird
+ 3 ,iprt_xh,iprt_xle,iprt_sol,iprt_sf,iprt_sne,iprt_sml
+ 4 ,iprt_emi,iprt_biomm,iprt_gppm,iprt_nppm,iprt_nepm
+ 5 ,iprt_ram,iprt_rhm,iprt_laim,iprt_emifirem,iprt_nbpm
+ 6 ,iprt_emiblitm,iprt_harvm,iprt_raf,iprt_emifiref
+ 5 ,iprt_frac,iprt_nppf,iprt_Rmin,iprt_faparm
+ 6 ,iprt_laimin,iprt_gpp,iprt_Cveg,iprt_Csoil
+ 7 ,iprt_frcC13,iprt_laimoy,iprt_Tdmin,iprt_mat
+ 8 ,iprt_harv,iprt_yield,iprt_agbiom,iprt_bgbiom
+ 9 ,iprt_Tmmin,iprt_gdd,iprt_fire,iprt_fburn,iprt_aburn
+ 1 ,iprt_yfnoburn,iprt_ftomin,iprt_ftotw,iprt_ftot
+ 2 ,iprt_Fgdd5,iprt_FTmmin,iprt_Fwatmin
+ 3 ,iprt_prop,iprt_side,iprt_pres,iprt_zon
+ 4 ,iprt_tem,iprt_dte,iprt_prc,iprt_shr,iprt_rhu
+ 5 ,iprt_win,iprt_lucdfr,iprt_lucflx
+ 6 ,iprt_albsv,iprt_albs,iprt_albv,iprt_emins,iprt_z0
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/irep.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/irep.common
new file mode 100644
index 0000000..d671f44
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/irep.common
@@ -0,0 +1,6 @@
+ common /icyr/ icyr_tem,icyr_dt,icyr_prc,icyr_shi,icyr_rhu,
+ 1 icyr_win,icyr_manag,icyr_light,icyr_landuse,
+ 2 icyr_mig,icyr_ref,icyr_tclim,icyr_pclim
+ integer icyr_tem,icyr_dt,icyr_prc,icyr_shi,icyr_rhu,
+ 1 icyr_win,icyr_manag,icyr_light,icyr_landuse,
+ 2 icyr_mig,icyr_ref,icyr_tclim,icyr_pclim
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/kernel.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/kernel.common
new file mode 100644
index 0000000..2b769ca
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/kernel.common
@@ -0,0 +1,7 @@
+ common /kernel/ Xmin,Xmax,ynppf_mean,ynppf_max,
+ & spec_npp,
+ & midpoint_ab(100),probdenswind_ab(100),
+ & midpoint_pi(96),probdenswind_pi(96)
+ real*4 Xmin,Xmax,ynppf_mean,ynppf_max,spec_npp,
+ & midpoint_ab,probdenswind_ab,
+ & midpoint_pi,probdenswind_pi
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/lai.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/lai.common
new file mode 100644
index 0000000..0589fb7
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/lai.common
@@ -0,0 +1,2 @@
+ common /lai/ splai(nplant),xleaf_max(nplant)
+ real*4 splai,xleaf_max
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/laih2o.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/laih2o.common
new file mode 100644
index 0000000..fc46f59
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/laih2o.common
@@ -0,0 +1,6 @@
+ common /laih2o/ xlai_w(nplant,nm)
+ & ,cfh2o(nplant,nm),ylai_w(nplant)
+ & ,yvslai_w(nplant),yminlai_w(nplant)
+ real*4 xlai_w
+ & ,cfh2o,ylai_w
+ & ,yvslai_w,yminlai_w
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/lailim.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/lailim.common
new file mode 100644
index 0000000..8469238
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/lailim.common
@@ -0,0 +1,2 @@
+ common /lailim/ ylailim0(nplant,nm)
+ real*4 ylailim0
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/laiste.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/laiste.common
new file mode 100644
index 0000000..e481d41
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/laiste.common
@@ -0,0 +1,2 @@
+ common /laiste/ xlaimax
+ real*4 xlaimax
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/landuse.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/landuse.common
new file mode 100644
index 0000000..bfc7377
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/landuse.common
@@ -0,0 +1,5 @@
+ common /landuse/ frac_nat(ngrid),frac_crop(ngrid)
+ & ,frac_past(ngrid),frac_urb(ngrid)
+ & ,frac_rock(ngrid),frac_wat(ngrid)
+ real*4 frac_nat,frac_crop,frac_past,frac_urb,frac_rock
+ & ,frac_wat
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/landuse0.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/landuse0.common
new file mode 100644
index 0000000..e0db274
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/landuse0.common
@@ -0,0 +1,5 @@
+ common /landuse0/ frac_nat0(ngrid),frac_crop0(ngrid)
+ & ,frac_past0(ngrid),frac_urb0(ngrid)
+ & ,frac_rock0(ngrid),frac_wat0(ngrid)
+ real*4 frac_nat0,frac_crop0,frac_past0,frac_urb0,frac_rock0
+ & ,frac_wat0
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/litiere.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/litiere.common
new file mode 100644
index 0000000..212121e
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/litiere.common
@@ -0,0 +1,3 @@
+ common /litiere/ xlit_prod(nplant,npool,ndy),xhum_prod(2,ndy)
+ real*4 xlit_prod,xhum_prod
+
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/loop.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/loop.common
new file mode 100644
index 0000000..71c34d2
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/loop.common
@@ -0,0 +1,2 @@
+ common /loop/ ip,iday
+ integer ip,iday
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/lstcli.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/lstcli.common
new file mode 100644
index 0000000..d539c70
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/lstcli.common
@@ -0,0 +1,2 @@
+ common /lstcli/ climatslst
+ character*3 climatslst(34)
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/lstreg.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/lstreg.common
new file mode 100644
index 0000000..2f3bc33
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/lstreg.common
@@ -0,0 +1,2 @@
+ common /lstreg/ reg
+ character*1 reg(34)
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/lstz.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/lstz.common
new file mode 100644
index 0000000..edf84be
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/lstz.common
@@ -0,0 +1,2 @@
+ common /lstz/ listezone
+ character*8 listezone(nzone)
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/luc.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/luc.common
new file mode 100644
index 0000000..8aed177
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/luc.common
@@ -0,0 +1,5 @@
+ common /luc/ dfr_nat,dfr_crop,dfr_past,dfr_urb,dfr_rock,dfr_wat
+ & ,rdfr_nat,rdfr_crop,rdfr_past,rdfr_urb,rdfr_rock,rdfr_wat
+ real*4 dfr_nat,dfr_crop,dfr_past,dfr_urb,dfr_rock,dfr_wat
+ & ,rdfr_nat,rdfr_crop,rdfr_past,rdfr_urb,rdfr_rock,rdfr_wat
+
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/lucflx.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/lucflx.common
new file mode 100644
index 0000000..be57eba
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/lucflx.common
@@ -0,0 +1,3 @@
+ common /lucflx/ yemi_luc(nplant,npool),xlit_luc(nplant,npool)
+ & ,frac0(nplant),bg_bio(nplant),ag_bio(nplant,npool)
+ real*4 yemi_luc,xlit_luc,frac0,bg_bio,ag_bio
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/management.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/management.common
new file mode 100644
index 0000000..3b83aee
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/management.common
@@ -0,0 +1,5 @@
+ common /management/ iday_mg(ndy),imanag,mg_mode,mg_days,icut,ict
+ & ,cleft_mg(npool,ndy),fcut,ycharvest(nplant)
+ & ,charvest(nplant,npool,ndy)
+ integer iday_mg,imanag,mg_mode,mg_days,icut,ict
+ real*4 cleft_mg,fcut,ycharvest,charvest
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/memory.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/memory.common
new file mode 100644
index 0000000..a05b001
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/memory.common
@@ -0,0 +1,2 @@
+ common /memory/ olddrv(nequat), oldbdo(nequat,norder)
+ double precision olddrv,oldbdo
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/mois.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/mois.common
new file mode 100644
index 0000000..0306888
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/mois.common
@@ -0,0 +1,2 @@
+ common /mois/ month
+ integer month
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/monres.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/monres.common
new file mode 100644
index 0000000..050d8e6
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/monres.common
@@ -0,0 +1,5 @@
+ common /monres/ xmgpp(nm),xmnpp(nm),xmnep(nm),xmlai(nm),xmbiom(nm)
+ & ,xmfapar(nm),xmra(nm),xmrh(nm),xmemifire(nm)
+ & ,xmcharvest(nm),xmemiblit(nm),xmnbp(nm)
+ real*4 xmgpp,xmnpp,xmnep,xmlai,xmbiom,xmfapar,xmra,xmrh,xmemifire
+ & ,xmcharvest,xmemiblit,xmnbp
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/monthcst.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/monthcst.common
new file mode 100644
index 0000000..3fda54e
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/monthcst.common
@@ -0,0 +1,4 @@
+ common /monthcst/ imonth(ndy),mlength(nm),mondec(nm),numday(nm)
+ & ,ini(nm),ifin(nm)
+ integer imonth,mlength,mondec,numday
+ & ,ini,ifin
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/monthcst2.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/monthcst2.common
new file mode 100644
index 0000000..d0a5914
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/monthcst2.common
@@ -0,0 +1,3 @@
+ common /monthcst2/ xmfac(nm)
+ real*4 xmfac
+
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/monwat.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/monwat.common
new file mode 100644
index 0000000..687e431
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/monwat.common
@@ -0,0 +1,2 @@
+ common /monwat/ swcar(nm),rtrcar(nm),svecar(nm),fsncar(nm),aswmin
+ real*4 swcar,rtrcar,svecar,fsncar,aswmin
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/mort.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/mort.common
new file mode 100644
index 0000000..529aa6b
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/mort.common
@@ -0,0 +1,18 @@
+ common /mort/ tmin_inf(nplant),tmin_sup(nplant)
+ & ,tmax_inf(nplant),tmax_sup(nplant)
+ & ,wat_inf(nplant),wat_sup(nplant)
+ & ,xpar_inf(nplant),xpar_sup(nplant)
+ & ,ftmin(nplant),ftmax(nplant)
+ & ,fwat(nplant),fxpar(nplant),ftemp(nplant,ndy)
+ & ,ftot(nplant),fnat(nplant),ftotmin(nplant)
+ & ,ftotw(nplant)
+ real*4 tmin_inf,tmin_sup
+ & ,tmax_inf,tmax_sup
+ & ,wat_inf,wat_sup
+ & ,xpar_inf,xpar_sup
+ & ,ftmin,ftmax
+ & ,fwat,fxpar,ftemp
+ & ,ftot,fnat,ftotmin
+ & ,ftotw
+
+
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/netcdf_name.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/netcdf_name.common
new file mode 100644
index 0000000..c7fee70
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/netcdf_name.common
@@ -0,0 +1,6 @@
+ common /netcdf_name/ ncname_tclim,ncname_pclim
+ & ,ncname_tem,ncname_dta,ncname_dtb,ncname_prc
+ & ,ncname_shi,ncname_rhu,ncname_win
+ character*10 ncname_tclim,ncname_pclim
+ & ,ncname_tem,ncname_dta,ncname_dtb,ncname_prc
+ & ,ncname_shi,ncname_rhu,ncname_win
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/netcdf_par.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/netcdf_par.common
new file mode 100644
index 0000000..ff951c3
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/netcdf_par.common
@@ -0,0 +1,6 @@
+ common /netcdf_par/ num_ncdf,incdf_tclim,incdf_pclim
+ & ,incdf_tem,incdf_dta,incdf_dtb,incdf_prc
+ & ,incdf_shi,incdf_rhu,incdf_win
+ integer num_ncdf,incdf_tclim,incdf_pclim
+ & ,incdf_tem,incdf_dta,incdf_dtb,incdf_prc
+ & ,incdf_shi,incdf_rhu,incdf_win
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/newbdo.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/newbdo.common
new file mode 100644
index 0000000..3e73f77
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/newbdo.common
@@ -0,0 +1,2 @@
+ common /newbdo/ bdo(nequat,norder)
+ double precision bdo
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/npp.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/npp.common
new file mode 100644
index 0000000..2e0cf4b
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/npp.common
@@ -0,0 +1,2 @@
+ common /npp/ xnpp_year(nplant)
+ real*4 xnpp_year
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/nspc.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/nspc.common
new file mode 100644
index 0000000..e7ba2a5
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/nspc.common
@@ -0,0 +1,2 @@
+ common /nspc/ nherb,nbush,ntree,npft0,ncrop,npast,npft,ncropvar
+ integer nherb,nbush,ntree,npft0,ncrop,npast,npft,ncropvar
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/number_year.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/number_year.common
new file mode 100644
index 0000000..dd0badd
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/number_year.common
@@ -0,0 +1,2 @@
+ common /number_year/ iyear(nplant),max_year
+ integer iyear,max_year
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/old_cstmort.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/old_cstmort.common
new file mode 100644
index 0000000..f63d661
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/old_cstmort.common
@@ -0,0 +1,4 @@
+ common /cstmort/ xk_erf,delta_tmin,delta_watmin,
+ & delta_tmax,delta_watmax,delta_gdd5
+ real*4 xk_erf,delta_tmin,delta_watmin,
+ & delta_tmax,detla_wtmax,delta_gdd5
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/parameter.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/parameter.common
new file mode 100644
index 0000000..ec27aad
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/parameter.common
@@ -0,0 +1,12 @@
+ integer ndy,nde,nfmean,nfn,
+ 1 nres,nequat,nh2,nh,nlay,
+ 2 nm,nm2,norder,nplant,nclas_max,npool,
+ 3 nwa,nw,nzone,ngrid,n_nghmx,
+ 4 ny_tempo
+ parameter (ndy=366,nde=2,nfmean=10,nfn=2*nfmean,
+ 1 nres=2,nequat=nres,nh2=6,nh=2*nh2,nlay=16,
+ 2 nm=12,nm2=2*nm,norder=4,nplant=40,nclas_max=6,npool=2,
+ 3 nwa=20,nw=73,nzone=176,ngrid=100000,n_nghmx=8,
+ 4 ny_tempo=50)
+ common /ndays/ nd,idayct
+ integer nd,idayct
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/parameter2.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/parameter2.common
new file mode 100644
index 0000000..66eb47a
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/parameter2.common
@@ -0,0 +1,10 @@
+ integer ndy,nd,nde,nfmean,nfn,
+ 1 nres,nequat,nh2,nh,nlay,
+ 2 nm,nm2,norder,nplant,nclas_max,npool,
+ 3 nwa,nw,nzone,ngrid,n_nghmx,
+ 4 ny_tempo
+ parameter (ndy=365,nde=2,nfmean=10,nfn=2*nfmean,
+ 1 nres=2,nequat=nres,nh2=6,nh=2*nh2,nlay=16,
+ 2 nm=12,nm2=2*nm,norder=4,nplant=40,nclas_max=6,npool=2,
+ 3 nwa=20,nw=73,nzone=176,ngrid=4236,n_nghmx=8,
+ 4 ny_tempo=50)
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/parameter_orb.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/parameter_orb.common
new file mode 100644
index 0000000..4f6c037
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/parameter_orb.common
@@ -0,0 +1,10 @@
+ integer ORB_UNDEF_INT,ORB_NOT_YEAR_BASED
+ real ORB_ECCEN_MIN,ORB_ECCEN_MAX,ORB_OBLIQ_MIN,
+ 1 ORB_OBLIQ_MAX,ORB_MVELP_MIN,ORB_MVELP_MAX,
+ 2 ORB_UNDEF_REAL,ORB_DEFAULT
+ parameter (ORB_ECCEN_MIN=0.0,ORB_ECCEN_MAX=0.1,
+ 1 ORB_OBLIQ_MIN=-90.0,ORB_OBLIQ_MAX=90.0,
+ 2 ORB_MVELP_MIN=0.0,ORB_MVELP_MAX=360.0,
+ 3 ORB_UNDEF_REAL = 1.e36,ORB_DEFAULT=ORB_UNDEF_REAL,
+ 4 ORB_UNDEF_INT=2000000000,
+ 5 ORB_NOT_YEAR_BASED=ORB_UNDEF_INT)
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/pathg.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/pathg.common
new file mode 100644
index 0000000..a3e5985
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/pathg.common
@@ -0,0 +1,2 @@
+ common /pathg/ pathgene
+ character*120 pathgene
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/pheno.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/pheno.common
new file mode 100644
index 0000000..599266e
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/pheno.common
@@ -0,0 +1,2 @@
+ common /pheno/ iday_stress(nplant)
+ integer iday_stress
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/pho_sch.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/pho_sch.common
new file mode 100644
index 0000000..6b38575
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/pho_sch.common
@@ -0,0 +1,2 @@
+ common /pho_sch/ ic4(nplant),idec(nplant)
+ integer ic4,idec
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/pixdata.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/pixdata.common
new file mode 100644
index 0000000..e21c4aa
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/pixdata.common
@@ -0,0 +1,2 @@
+ common /pixdata/ kzone(ngrid)
+ integer kzone
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/plant_evol.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/plant_evol.common
new file mode 100644
index 0000000..65aa031
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/plant_evol.common
@@ -0,0 +1,3 @@
+ common /plant_evol/ xip(nplant,2),xkappa(nplant),rese_frac(nplant)
+ & ,rootf(nplant),rootsh(nplant)
+ real*4 xip,xkappa,rese_frac,rootf,rootsh
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/plant_pool.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/plant_pool.common
new file mode 100644
index 0000000..cae3e58
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/plant_pool.common
@@ -0,0 +1,4 @@
+ common /plant_pool/ carbon(nplant,npool,ndy),rese(nplant),
+ & root_biomass(nplant,ndy),ybinc(nplant),
+ & root_ini(nplant),carbon_ini(nplant,npool)
+ real*4 carbon,rese,root_biomass,ybinc,root_ini,carbon_ini
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/plheight.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/plheight.common
new file mode 100644
index 0000000..f0d23d3
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/plheight.common
@@ -0,0 +1,2 @@
+ common /plheight/ bag_h(nplant)
+ real*4 bag_h
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/pnpp.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/pnpp.common
new file mode 100644
index 0000000..0e5b2ce
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/pnpp.common
@@ -0,0 +1,7 @@
+ common /pnpp/ zgpp(nplant,ndy),znpp(nplant,ndy),
+ & zfract(nplant,ndy),zfh2o(nplant,ndy)
+ & ,zgpp_temp(nplant,ndy,ngrid)
+ & ,zfract_temp(nplant,ndy,ngrid)
+ & ,zfh2o_temp(nplant,ndy,ngrid)
+ real*4 zgpp,znpp,zfract,zfh2o
+ & ,zgpp_temp,zfract_temp,zfh2o_temp
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/pnpp2.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/pnpp2.common
new file mode 100644
index 0000000..241be8f
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/pnpp2.common
@@ -0,0 +1,7 @@
+ common /pnpp/ zgpp(nplant,ndy),znpp(nplant,ndy),
+ & zfract(nplant,ndy),zfh2o(nplant,ndy)
+c & ,zgpp_temp(nplant,ndy,ngrid)
+c & ,zfract_temp(nplant,ndy,ngrid)
+c & ,zfh2o_temp(nplant,ndy,ngrid)
+ real*4 zgpp,znpp,zfract,zfh2o
+c & ,zgpp_temp,zfract_temp,zfh2o_temp
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/prev_yr.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/prev_yr.common
new file mode 100644
index 0000000..600fdb3
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/prev_yr.common
@@ -0,0 +1,3 @@
+ common /prev_yr/ ybinc_prv(nplant),xlaimax_prv(nplant),ilgtree
+ real*4 ybinc_prv,xlaimax_prv
+ integer ilgtree
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/prt.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/prt.common
new file mode 100644
index 0000000..c7845b4
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/prt.common
@@ -0,0 +1,21 @@
+ common /prt/ swmth(ndy),swmmmth(ndy),petmth(ndy),aetmth(ndy)
+ 1 ,runmth(ndy),rblmth(ndy),albmth(ndy)
+ 2 ,drnmth(ndy),svemth(ndy),firdmth(ndy)
+ 3 ,rnmth(ndy),grfmth(ndy),tsmth(ndy)
+ 4 ,xhmth(ndy),xlemth(ndy),solmth(ndy)
+ 5 ,fgsmth(ndy),fsnmth(ndy),sndmth(ndy),tlamth(ndy)
+ 6 ,sfmth(ndy),snemth(ndy),smlmth(ndy)
+ 7 ,emimth(ndy),rtrmth(ndy),srunmth(ndy),eintmth(ndy)
+ 8 ,etrmth(ndy),esomth(ndy)
+ 8 ,runy,soey,pety,sney,prcy,svey
+ 9 ,mdur(ndy),nsmth(ndy),nsyr
+ 1 ,albsvmth(ndy),albsmth(ndy),albvmth(ndy)
+ 2 ,eminsmth(ndy),z0mth(ndy)
+ real*4 swmth,swmmmth,petmth,aetmth,runmth,rblmth,albmth,drnmth
+ 1 ,svemth,firdmth
+ 2 ,rnmth,grfmth,tsmth,xhmth,xlemth,solmth,fgsmth
+ 3 ,fsnmth,sndmth,tlamth,sfmth,snemth,smlmth,emimth,rtrmth
+ 4 ,srunmth,eintmth,etrmth,esomth
+ 5 ,runy,soey,pety,sney,prcy,svey
+ 6 ,albsvmth,albsmth,albvmth,eminsmth,z0mth
+ integer mdur,nsmth,nsyr
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/prt_ctrl.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/prt_ctrl.common
new file mode 100644
index 0000000..bfaa540
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/prt_ctrl.common
@@ -0,0 +1,2 @@
+ common /prt_ctrl/ iyprt,ipr_clim
+ integer iyprt,ipr_clim
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/prt_old.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/prt_old.common
new file mode 100644
index 0000000..7960090
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/prt_old.common
@@ -0,0 +1,17 @@
+ common /prt/ swmth(ndy),swmmmth(ndy),petmth(ndy),aetmth(ndy)
+ 1 ,runmth(ndy),rblmth(ndy),albmth(ndy)
+ 2 ,drnmth(ndy),svemth(ndy),firdmth(ndy)
+ 3 ,rnmth(ndy),grfmth(ndy),tsmth(ndy)
+ 4 ,xhmth(ndy),xlemth(ndy),solmth(ndy)
+ 5 ,fgsmth(ndy),fsnmth(ndy),sndmth(ndy),tlamth(ndy)
+ 6 ,sfmth(ndy),snemth(ndy),smlmth(ndy)
+ 7 ,emimth(ndy),rtrmth(ndy),srunmth(ndy),eintmth(ndy)
+ 8 ,etrmth(ndy),esomth(ndy)
+ 8 ,runy,soey,pety,sney,prcy,svey
+ 9 ,mdur(ndy),nsmth(ndy),nsyr
+ real*4 swmth,swmmmth,petmth,aetmth,runmth,rblmth,albmth,drnmth,svemth
+ 1 ,firdmth,rnmth,grfmth,tsmth,xhmth,xlemth,solmth,fgsmth
+ 2 ,fsnmth,sndmth,tlamth,sfmth,snemth,smlmth,emimth,rtrmth
+ 3 ,srunmth,eintmth,etrmth,esomth
+ 4 ,runy,soey,pety,sney,prcy,svey
+ integer mdur,nsmth,nsyr
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/pzone.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/pzone.common
new file mode 100644
index 0000000..f1f55fa
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/pzone.common
@@ -0,0 +1,2 @@
+ common /pzone/ izonepxl
+ integer izonepxl
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/radcst.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/radcst.common
new file mode 100644
index 0000000..dd7fdad
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/radcst.common
@@ -0,0 +1,2 @@
+ common /radcst/ ome,facome,rhoc0,radun,parun,clump_fac
+ real*4 ome,facome,rhoc0,radun,parun,clump_fac
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/rblcst1.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/rblcst1.common
new file mode 100644
index 0000000..0b9505e
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/rblcst1.common
@@ -0,0 +1,2 @@
+ common /rblcst1/ zzras,arbl,brbl,exrbl,unitfac,h2osurco2
+ real*4 zzras,arbl,brbl,exrbl,unitfac,h2osurco2
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/res_par.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/res_par.common
new file mode 100644
index 0000000..86082d5
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/res_par.common
@@ -0,0 +1,2 @@
+ common /res_par/ partoc(ndy)
+ real*4 partoc
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/res_temp.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/res_temp.common
new file mode 100644
index 0000000..418d693
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/res_temp.common
@@ -0,0 +1,4 @@
+ common /res_temp/ resp_fac(nplant,npool,ndy)
+ & ,resp_fac_temp(nplant,npool,ndy,ngrid)
+ real*4 resp_fac
+ & ,resp_fac_temp
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/res_temp2.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/res_temp2.common
new file mode 100644
index 0000000..315283c
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/res_temp2.common
@@ -0,0 +1,4 @@
+ common /res_temp/ resp_fac(nplant,npool,ndy)
+c & ,resp_fac_temp(nplant,npool,ndy,ngrid)
+ real*4 resp_fac
+c & ,resp_fac_temp
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/rk.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/rk.common
new file mode 100644
index 0000000..ca0573d
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/rk.common
@@ -0,0 +1,4 @@
+ common /rk/ yk1(nequat), yk2(nequat), yk3(nequat),
+ 1 drvk2(nequat), drvk3(nequat), drvk4(nequat)
+ double precision yk1, yk2, yk3, drvk2, drvk3, drvk4
+
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/smrd.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/smrd.common
new file mode 100644
index 0000000..06d7a24
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/smrd.common
@@ -0,0 +1,3 @@
+ common /smrd/ smfs,smfc,smwp,cla
+ 1 ,san,sil,acd,bcd
+ real*4 smfs,smfc,smwp,cla,san,sil,acd,bcd
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/snow.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/snow.common
new file mode 100644
index 0000000..9fd9532
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/snow.common
@@ -0,0 +1,2 @@
+ common /snow/ snow_frac(ndy)
+ real*4 snow_frac
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/soil_marie.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/soil_marie.common
new file mode 100644
index 0000000..029ee71
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/soil_marie.common
@@ -0,0 +1,3 @@
+ common /soil_marie/ xlit_burn(nplant,npool,ndy)
+ & ,xlit_newprod(nplant,npool,ndy)
+ real*4 xlit_burn,xlit_newprod
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/soil_pool.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/soil_pool.common
new file mode 100644
index 0000000..3ceb998
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/soil_pool.common
@@ -0,0 +1,2 @@
+ common /soil_pool/ xlit(npool,ndy),xhumus(ndy)
+ real*4 xlit,xhumus
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/soilin.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/soilin.common
new file mode 100644
index 0000000..72b734e
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/soilin.common
@@ -0,0 +1 @@
+ common /soilin/ watsat,watfc,watwp
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/sol_in.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/sol_in.common
new file mode 100644
index 0000000..3ad9a3e
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/sol_in.common
@@ -0,0 +1,2 @@
+ common /sol_in/ xmucar(ndy,nh2),par0(ndy,nh2,3),par1(ndy,nh2,3)
+ real*4 xmucar,par0,par1
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/solpar.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/solpar.common
new file mode 100644
index 0000000..fa865bc
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/solpar.common
@@ -0,0 +1,6 @@
+ common /solpar/ exc,exc4,exc5,exc6,exc7,xlsper,obl,sunea
+ 1 ,rearth,rearth2,hatrea,hatm,ftrmin,ftrmax
+ 2 ,oblr,xlsperp,lambm0
+ real*4 exc,exc4,exc5,exc6,exc7,xlsper,obl,sunea
+ 1 ,rearth,rearth2,hatrea,hatm,ftrmin,ftrmax
+ 2 ,oblr,xlsperp,lambm0
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/sr_par.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/sr_par.common
new file mode 100644
index 0000000..eeebdea
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/sr_par.common
@@ -0,0 +1,2 @@
+ common /sr_par/ cmoxm1,xm1,pssat
+ real*4 cmoxm1,xm1,pssat
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/sresp.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/sresp.common
new file mode 100644
index 0000000..a9ca749
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/sresp.common
@@ -0,0 +1,2 @@
+ common /sresp/ facgrnd,q10grnd,factree,q10tree
+ real*4 facgrnd,q10grnd,factree,q10tree
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/strate.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/strate.common
new file mode 100644
index 0000000..3e6fbb0
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/strate.common
@@ -0,0 +1,2 @@
+ common /strate/ nstrate
+ integer nstrate
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/temper.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/temper.common
new file mode 100644
index 0000000..6018e43
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/temper.common
@@ -0,0 +1,2 @@
+ common /temper/ temp0
+ real*4 temp0
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/test_conve.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/test_conve.common
new file mode 100644
index 0000000..3ec2420
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/test_conve.common
@@ -0,0 +1 @@
+ common /test_conve/test_conv(nplant,npool),test_conv_max
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/test_conver.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/test_conver.common
new file mode 100644
index 0000000..a869c05
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/test_conver.common
@@ -0,0 +1 @@
+ common /test_conver/testc(nplant,npool)
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/textcst1.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/textcst1.common
new file mode 100644
index 0000000..0671228
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/textcst1.common
@@ -0,0 +1,6 @@
+ common /textcst1/ cmoptcla,cmoptsil,cmoptsan,
+ & xm1cla,xm1sil,xm1san,
+ & psatcla,psatsil,psatsan
+ real*4 cmoptcla,cmoptsil,cmoptsan,
+ & xm1cla,xm1sil,xm1san,
+ & psatcla,psatsil,psatsan
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/textcst2.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/textcst2.common
new file mode 100644
index 0000000..eff78bd
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/textcst2.common
@@ -0,0 +1 @@
+ common /textcst2/ clay, silt, sand
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/tresh.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/tresh.common
new file mode 100644
index 0000000..b4a863f
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/tresh.common
@@ -0,0 +1,6 @@
+ common /tresh/ ttreshi1(nplant),ttresha1(nplant),wattresh1(nplant)
+ & ,xpar_tresh1(nplant),ttreshi2(nplant)
+ & ,ttresha2(nplant),wattresh2(nplant)
+ & ,xpar_tresh2(nplant)
+ real*4 ttreshi1,ttresha1,wattresh1,xpar_tresh1,ttreshi2
+ & ,ttresha2,wattresh2,xpar_tresh2
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/varday.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/varday.common
new file mode 100644
index 0000000..8661df0
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/varday.common
@@ -0,0 +1,6 @@
+ common /varday/ solday(ndy,0:nh2),ftrday(ndy,0:nh2)
+ 2 ,xmuday(ndy,0:nh2),tladay(ndy)
+ 3 ,aswday(ndy),rblday(ndy,nplant)
+ 4 ,gppday(ndy),ppnday(ndy),penday(ndy)
+ real*4 solday,ftrday,xmuday,tladay,aswday,rblday,gppday
+ 1 ,ppnday,penday
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/varnow.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/varnow.common
new file mode 100644
index 0000000..a2a644c
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/varnow.common
@@ -0,0 +1,14 @@
+ common /varnow/ temi,delti,preci,shi
+ 1 ,hai,windi,grflx,rnet,axle
+ 2 ,asw,ts,fgs,alb,rblwm
+ 3 ,rblcv(nplant),fsn,snd,fird,xh
+ 4 ,solg(0:nh),ftrs(0:nh),xmu(0:nh)
+ 5 ,rf,sf,sml,emisf,albsv,albsoil
+ 6 ,albvege,emisfns,z0tot
+ double precision temi,delti,preci,shi
+ 1 ,hai,windi,grflx,rnet,axle
+ 2 ,asw,ts,fgs,alb,rblwm
+ 3 ,rblcv,fsn,snd,fird,xh
+ 4 ,solg,ftrs,xmu
+ 5 ,rf,sf,sml,emisf,albsv,albsoil
+ 6 ,albvege,emisfns,z0tot
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/vegfr.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/vegfr.common
new file mode 100644
index 0000000..d921fb7
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/vegfr.common
@@ -0,0 +1,2 @@
+ common /vegfr/ frc(nplant),plai(nplant),fveg
+ real*4 frc,plai,fveg
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/veglab.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/veglab.common
new file mode 100644
index 0000000..b9b8295
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/veglab.common
@@ -0,0 +1,2 @@
+ common /veglab/ pft_name
+ character*50 pft_name(nplant)
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/waflux.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/waflux.common
new file mode 100644
index 0000000..ff45a55
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/waflux.common
@@ -0,0 +1,5 @@
+ common /waflux/ pet,soe,svevp,sne,aet
+ 1 ,drun,srun,rtrans
+ double precision pet,soe,svevp,sne,aet
+ 1 ,drun,srun,rtrans
+
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/watmin.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/watmin.common
new file mode 100644
index 0000000..d699f2d
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/watmin.common
@@ -0,0 +1 @@
+ common /watmin / watmin
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/xlaic.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/xlaic.common
new file mode 100644
index 0000000..7373bcc
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/xlaic.common
@@ -0,0 +1,3 @@
+ common /xlaic/ t1pft(nplant),t2pft(nplant),xlmin(nplant)
+ & ,xlmax(nplant),wai(nplant)
+ real*4 t1pft,t2pft,xlmin,xlmax,wai
diff --git a/couplage/CARAIB/ver01_Iv_couplage/com_18/xvalues.common b/couplage/CARAIB/ver01_Iv_couplage/com_18/xvalues.common
new file mode 100644
index 0000000..24d230c
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/com_18/xvalues.common
@@ -0,0 +1,5 @@
+ common /xvalues/ xgpp(nplant,ndy),xnpp(nplant,ndy),
+ & xlrm(nplant,ndy),xfract(nplant,ndy),
+ & xlai(nplant,ndy),xra(nplant,ndy),
+ & xemifire(nplant,ndy),xcharvest(nplant,ndy)
+ real*4 xgpp,xnpp,xlrm,xfract,xlai,xra,xemifire,xcharvest
diff --git a/couplage/CARAIB/ver01_Iv_couplage/compil_01_Iv.sh b/couplage/CARAIB/ver01_Iv_couplage/compil_01_Iv.sh
new file mode 100644
index 0000000..caf93fa
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/compil_01_Iv.sh
@@ -0,0 +1,4 @@
+START=$(date +%s%3N);
+ifort -vec-report=0 -parallel -O2 -ipo -par-threshold=100 mod_netcdfcaraib_09.f hydro_01_Iv.F carbon_01_Iv.F caraib_main_01_Iv.F -o caraib_01_Iv_par.out -lnetcdf -lnetcdff
+END=$(date +%s%3N);
+echo $((END-START)) | awk '{print "Compile en " $1/1000 " secondes."}'
diff --git a/couplage/CARAIB/ver01_Iv_couplage/hydro/hydro_01_Iv.F b/couplage/CARAIB/ver01_Iv_couplage/hydro/hydro_01_Iv.F
new file mode 100644
index 0000000..fa263c1
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/hydro/hydro_01_Iv.F
@@ -0,0 +1,45 @@
+
+
+
+
+c###########################################################################
+
+
+
+
+
+
+
+
+
+
+
+c###########################################################################
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+il n'y a plus rien ici
+
+
+
diff --git a/couplage/CARAIB/ver01_Iv_couplage/hydro_backdiff.f b/couplage/CARAIB/ver01_Iv_couplage/hydro_backdiff.f
new file mode 100644
index 0000000..fb4e9bb
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/hydro_backdiff.f
@@ -0,0 +1,35 @@
+c=======================================================================
+c***********************************************************************
+ subroutine backdiff (drv)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c the back differences of the derivatives are computed for present time.
+c=======================================================================
+
+c implicit double precision (a-h,o-z)
+ implicit none
+ include './com_18/parameter.common'
+ include './com_18/memory.common'
+ include './com_18/newbdo.common'
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer i,j
+ real*8 drv
+c
+c-----------------------------------------------
+ dimension drv(nequat)
+
+ do i = 1, nequat
+ bdo(i,1) = drv(i) - olddrv(i)
+ enddo
+
+ do j = 2, norder
+ do i = 1, nequat
+ bdo(i,j) = bdo(i,j-1) - oldbdo(i,j-1)
+ enddo
+ enddo
+ return
+ end subroutine backdiff
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/hydro_bashfor.f b/couplage/CARAIB/ver01_Iv_couplage/hydro_bashfor.f
new file mode 100644
index 0000000..0d42e26
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/hydro_bashfor.f
@@ -0,0 +1,37 @@
+c=======================================================================
+c***********************************************************************
+ subroutine bashfor(stept,drv,y,ynew)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c the explicit adams-bashforth prediction scheme estimates
+c the value "ynew" of the vector "y" for next time value.
+c=======================================================================
+
+c implicit double precision (a-h,o-z)
+ implicit none
+ include './com_18/parameter.common'
+ include './com_18/newbdo.common'
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer i,j
+ real*8 cstp,drv,y,ynew
+c
+c-----------------------------------------------
+ dimension cstp(6), drv(nequat), y(nequat), ynew(nequat)
+ real*4 stept
+
+ data cstp /0.5, 0.41667, 0.375, 0.34861, 0.32986, 0.31559/
+
+ do i = 1, nequat
+ ynew(i) = y(i) + stept*drv(i)
+ enddo
+ do j = 1, norder
+ do i = 1, nequat
+ ynew(i) = ynew(i) + stept*cstp(j)*bdo(i,j)
+ enddo
+ enddo
+ return
+ end subroutine bashfor
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/hydro_drainage.f b/couplage/CARAIB/ver01_Iv_couplage/hydro_drainage.f
new file mode 100644
index 0000000..8fb7fd5
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/hydro_drainage.f
@@ -0,0 +1,156 @@
+c=======================================================================
+c***********************************************************************
+ subroutine drainage(stept)
+c***********************************************************************
+c=======================================================================
+
+c IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+ implicit none
+ include './com_18/parameter.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/drain.common'
+ include './com_18/eco.common'
+ include './com_18/smrd.common'
+ real*4, intent(in) :: stept
+
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer j,kf,ks0,ni,num
+ real*8 aa,aj,bb,bj,cj,dfn,drai,drdf,drdfb,drdft,drk0,dsm,ermax
+ & ,err,facrun,fnet,fnt,rdep,sl,sm,sm0,sma,smb,smfsi,smpo,smwpi
+ & ,taua,taub,taucri,taum,taumax,xi,yi
+c
+c-----------------------------------------------
+
+ dimension xi(nfmean),yi(nfmean),fnt(0:nfn)
+ 1 ,aj(0:nde),bj(0:nde),cj(nde+1),sl(nde+1,nde+2)
+ 2 ,drai(0:nfn),drdf(nfn-1)
+
+ drk0 = 240.
+
+ dfn = 1.
+ fnt(nfmean) = 0.
+ do kf = 1,nfmean
+ if(kf.le.5)then
+ fnt(nfmean+kf) = dfn*(2.**kf)
+ else
+ fnt(nfmean+kf) = fnt(nfmean+kf-1) * 1.5
+ endif
+ fnt(nfmean-kf) = -fnt(nfmean+kf)
+ enddo
+ fntmax = fnt(nfn)
+
+ ni = 10
+ ermax = 1.d-3*stept
+ taumax = 1.5*stept
+ taucri = (taumax+stept)/2.
+
+ rdep = rootd
+ aa = acd
+ bb = bcd
+ smwpi = smwp
+ smfsi = smfs
+ dsm = 1./float(nwa)
+
+ do ks0 = 0,nwa
+
+ wa0(ks0) = float(ks0)*dsm
+ sm0 = smwpi+(smfsi-smwpi)*wa0(ks0)
+
+ do kf = 0,nfn
+
+ fnet = fnt(kf)
+ if(fnet.le.0.)then
+ smpo = 0.
+ else
+ smpo = bb/(dlog(fnet/drk0)-aa)
+ endif
+
+ sma = sm0
+ if (smpo.lt.smwpi) then
+ smb = smwpi
+ facrun = 0.
+ elseif (smpo.gt.smfsi) then
+ smb = smfsi
+ facrun = 1.
+ else
+ smb = smpo
+ facrun = 1.
+ endif
+ taua = 0.
+ call TAU(aa,bb,fnet,rdep,drk0,sm0,smb,taub,ni)
+ if(taub.gt.taumax)taub=taumax
+ if (taub.le.stept) then
+ sm = smb
+ drai(kf) = fnet*taub - rdep*(sm-sm0)
+ & + facrun*(stept-taub)*drk0*dexp(aa+bb/sm)
+ goto 2000
+ endif
+ taum = 0.
+ do num = 1,100
+ if(taum.le.taucri)then
+ sm = sma + (smb-sma)
+ & * dsqrt((stept-taua)/(taub-taua))
+ else
+ sm = sma + (smb-sma)
+ & * (((stept-taua)/(taub-taua))**2.)
+ endif
+ call TAU(aa,bb,fnet,rdep,drk0,sm0,sm,taum,ni)
+ if (taum.gt.taumax) taum=taumax
+ err = dabs(taum-stept)
+ if (err.le.ermax) then
+ drai(kf) = fnet*taum - rdep*(sm-sm0)
+ goto 2000
+ endif
+ if (taum.le.stept)then
+ sma = sm
+ taua = taum
+ else
+ smb = sm
+ taub = taum
+ endif
+ enddo
+
+ write(28,*)'SUBROUTINE drainage: too much iterations'
+ write(28,*)'num:',num
+ write(28,*)'sma:',sma,' taua:',taua
+ write(28,*)'smb:',smb,' taub:',taub
+ write(28,*)'sm:',sm,' taum:',taum
+ write(28,*)'Program stop'
+ stop
+
+2000 continue
+ if(drai(kf).lt.0.)drai(kf)=0.
+ enddo
+
+ do kf=1,nfn-1
+ drdfb=(drai(kf)-drai(kf-1))/(fnt(kf)-fnt(kf-1))
+ drdft=(drai(kf+1)-drai(kf))/(fnt(kf+1)-fnt(kf))
+ drdf(kf) = (drdfb+drdft)/2.
+ enddo
+
+ do kf=1,nfmean
+ xi(kf) = fnt(kf)
+ yi(kf) = drdf(kf)
+ enddo
+ call polfit(xi,yi,nfmean,aj,nde,err,cj,sl)
+
+ do kf=nfmean,nfn-1
+ xi(kf-nfmean+1) = fnt(kf)
+ yi(kf-nfmean+1) = drdf(kf)
+ enddo
+ call polfit(xi,yi,nfmean,bj,nde,err,cj,sl)
+
+ ajdr(0,ks0) = drai(nfmean)
+ bjdr(0,ks0) = drai(nfmean)
+ do j=1,nde+1
+ ajdr(j,ks0) = aj(j-1)/float(j)
+ bjdr(j,ks0) = bj(j-1)/float(j)
+ enddo
+
+ enddo
+
+ return
+ end subroutine drainage
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/hydro_esat.f b/couplage/CARAIB/ver01_Iv_couplage/hydro_esat.f
new file mode 100644
index 0000000..3f3e4ce
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/hydro_esat.f
@@ -0,0 +1,28 @@
+c=======================================================================
+c***********************************************************************
+ subroutine esat (tk,es)
+c***********************************************************************
+c=======================================================================
+
+c implicit double precision (a-h,o-z)
+ implicit none
+
+c=======================================================================
+c This subroutine calculates saturation vapour pressure of H2O.
+c INPUT : tk = temperature [K]
+c OUTPUT : es = saturated vapour pressure of H2O [Pa]
+c=======================================================================
+ include './com_18/parameter.common'
+ include './com_18/envi.common'
+ include './com_18/temper.common'
+ real*4, intent(in) :: tk
+ real*4, intent(out) :: es
+
+ if (tk.ge.temp0) then
+ es = 100.*exp(-asat/tk-bsat*alog(tk)+csat)
+ else
+ es = psat0*exp(eaice*(tk-temp0)/(rgas*tk*temp0))
+ endif
+
+ return
+ end subroutine esat
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/hydro_fgrn_calc.f b/couplage/CARAIB/ver01_Iv_couplage/hydro_fgrn_calc.f
new file mode 100644
index 0000000..eb56a87
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/hydro_fgrn_calc.f
@@ -0,0 +1,17 @@
+c=======================================================================
+c***********************************************************************
+ subroutine fgrn_calc(plant_lai,plant_fgrn)
+c***********************************************************************
+c=======================================================================
+ implicit none
+ include './com_18/parameter.common'
+ include './com_18/radcst.common'
+ real*4 , intent(in) :: plant_lai
+ real*4 , intent(out) :: plant_fgrn
+C real*4 plant_lai,plant_fgrn
+
+ plant_fgrn = 1-exp(-0.5*clump_fac*plant_lai)
+ if (plant_fgrn.lt.0.) plant_fgrn = 0.
+
+ return
+ end subroutine fgrn_calc
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/hydro_funcx.f b/couplage/CARAIB/ver01_Iv_couplage/hydro_funcx.f
new file mode 100644
index 0000000..63331f4
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/hydro_funcx.f
@@ -0,0 +1,101 @@
+c=======================================================================
+c***********************************************************************
+ subroutine funcx(x, fx)
+c***********************************************************************
+c=======================================================================
+c implicit double precision (a-h,o-z)
+ implicit none
+ include './com_18/cloud.common'
+ real*4, intent(in) :: x
+ real*4, intent(out) :: fx
+ real*4 :: ecld
+c=======================================================================
+c Subroutine funcx is designed by the user to define f(x).
+c x = at entry, contains the value of x at which f(x) is
+c evaluated; it cannot be changed by funcx
+c fx = at exit, fx contains the value of f(x)
+c Variables may be transferred from the main programme or
+c the subroutine calling "nonlineq" through user-defined commons.
+c=======================================================================
+
+ call esat(x,ecld)
+ fx = x - tk * ((ecld/eh2o)**rscp_air)
+
+ return
+ end
+
+
+c=======================================================================
+c***********************************************************************
+ subroutine check(stept,time,y,drv)
+c***********************************************************************
+c=======================================================================
+c implicit double precision (a-h,o-z)
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/climin.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/eco.common'
+ include './com_18/envi.common'
+ include './com_18/flux_w.common'
+ include './com_18/monthcst.common'
+ include './com_18/monwat.common'
+ include './com_18/snow.common'
+ include './com_18/temper.common'
+ include './com_18/varday.common'
+ include './com_18/varnow.common'
+ include './com_18/waflux.common'
+ real*4 stept
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer idn,ip,m,nr,ny0
+ real*8 dn,drv,time,y
+c
+c-----------------------------------------------
+
+ dimension y(nequat),drv(nequat)
+
+ ny0 = int(time/float(nd)+0.000001)+1
+ dn = time - float(ny0-1) * float(nd)
+ idn=int(dn+1.00001)
+
+ do nr =1,nres
+ sumnet(nr) = sumnet(nr) + drv(nr)*stept
+ enddo
+
+ aswday(idn) = asw
+ tladay(idn) = tlai
+
+ water(idn) = asw
+ snow_frac(idn) = fsn
+
+ if (asw.lt.aswmin) aswmin=asw
+
+c rblday: carbon aerodynamic resistance (mol-1 m2 s)
+c ----------------------------------------------------------------------
+ do ip=1,10
+ rblday(idn,ip) = 0.0244*((temi+temp0)/temp0)
+ & *(patm0/patm)*rblcv(ip)
+ enddo
+
+c sets monthly variables needed by CARAIB
+ if (idn.eq.1) then
+ do m = 1,nm
+ swcar(m) = 0.
+ rtrcar(m) = 0.
+ fsncar(m) = 0.
+ svecar(m) = 0.
+ end do
+ endif
+ m = imonth(idn)
+ swcar(m) = swcar(m) + asw / float(mlength(m))
+ rtrcar(m) = rtrcar(m) + max(rtrans,0.6d0) / float(mlength(m))
+ fsncar(m) = fsncar(m) + fsn / float(mlength(m))
+ svecar(m) = svecar(m) + svevp
+
+
+ return
+ end subroutine funcx
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/hydro_givedrv.f b/couplage/CARAIB/ver01_Iv_couplage/hydro_givedrv.f
new file mode 100644
index 0000000..fa8c4ef
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/hydro_givedrv.f
@@ -0,0 +1,811 @@
+c=======================================================================
+c***********************************************************************
+ subroutine givedrv(stept,time,y,drv)
+c***********************************************************************
+
+c=======================================================================
+c the system to be solved consists in "nequat" ordinary differential
+c equations of the form
+c .
+c y(1) = drv(1)
+c .
+c y(2) = drv(2)
+c .
+c .
+c .
+c .
+c y(nequat) = drv(nequat)
+c
+c where drv(i) depends on y(1), y(2), ..., y(nequat), and on time.
+c please give your vector "drv".
+c for example :
+c
+c --------------------------------------
+c ny0 : year number
+c dn : day number
+c --------------------------------------
+c nr=1 : snow (H2O)
+c nr=2 : soil water (H2O)
+c --------------------------------------
+c --------------------------------------
+c y(nres) : reservoirs (gC m-2) or (gN m-2) or mm H2O
+c drv(nres) : dy/dt (gC m-2 day-1) or (gN m-2 day-1)
+c or mm H2O day-1
+c --------------------------------------
+c fin_w(nres) : input flux of each reservoir (mm H2O day-1)
+c fout_w(nres) : output flux of each reservoir (mm H2O day-1)
+c --------------------------------------
+c=======================================================================
+
+c implicit double precision (a-h,o-z)
+ implicit none
+ include './com_18/parameter.common'
+ include './com_18/climin0.common'
+ include './com_18/cloud.common'
+ include './com_18/coord.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/drain.common'
+ include './com_18/eco.common'
+ include './com_18/ecoin.common'
+ include './com_18/ecopro.common'
+ include './com_18/envi.common'
+ include './com_18/fgr.common'
+ include './com_18/flux_w.common'
+ include './com_18/nspc.common'
+ include './com_18/radcst.common'
+ include './com_18/smrd.common'
+ include './com_18/solpar.common'
+ include './com_18/temper.common'
+ include './com_18/varnow.common'
+ include './com_18/vegfr.common'
+ include './com_18/waflux.common'
+ include './com_18/frac_change.common'
+ include './com_18/xlaic.common'
+ include './com_18/landuse.common'
+
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer imeth,ip,j,jbrac,jnum,k0w,k1w,k2w,kj,kw,nint,nitmax,nr
+ & ,num1,numc,numit,ny0
+
+ real*8 airmw,albs,albsn,alnlw,alnsw,avh2o,bts,cpair,delta,dn,dr
+ & ,drv,eint,eintpl,ej,ej1,ej2,emia,emidry,emis,emisn,emiwet
+ & ,ermax,err,err1,err2,esnmax,esnow,esoil,esomax,fgr_crop
+ & ,fgr_herb,fgr_past,fgr_tree,fgr_wood,fh2o,firdown,fnet,fnmax
+ & ,fnsw,fntj,frcso,frctr,fsnow,fwood,gama,pcdew,pcrain,prod
+ & ,qfrac,qh2o,qx,ra,rair,ram,rapso,rblws,rblwv,rbw,rbwm,rhoair
+ & ,rnfac,smlmax,solnet,t0dr,tatm,tca,tcb,time,tm3,tmfac,tr,tsf
+ & ,tsf1,tsf2,tsurf,us,usm,usmulm,usmulv,uss,was,x,x0,xii,xk
+ & ,xle,xleadi,xlice,xlog2,xlsml,xlw,xnn,xr,xrblwm,y,z0,zzlogm
+c
+c-----------------------------------------------
+
+ real*4 tc,ftc,psat
+ real*4 stept
+ real*4 tmax,tmin
+ real*4 cond_max,exces_run
+ real*4 plant_lai,plant_fgrn
+ real*4 plant_wai,wai_fgrn
+ real*4 frcini
+ integer indicmax
+
+ dimension y(nequat),drv(nequat),ej(0:nde+1)
+
+ ny0 = int(time/float(nd)+0.000001)+1
+ dn = time - float(ny0-1) * float(nd)
+
+ asw = (y(2)-wpi)/(fci-wpi)
+
+c relative water amount with respect to saturation
+c (used in emissivity and drainage calculations)
+c-----------------------------------------------------------------------
+ was = (y(2)-wpi)/(fsi-wpi)
+ if(was .lt. 0.) was = 0.
+ if(was .gt. 1.) was = 1.
+
+c=======================================================================
+c hydrological model
+c=======================================================================
+
+c bts: beta_Ts (Mintz and Walker, p. 1326)
+c-----------------------------------------------------------------------
+c bts = 1. - dexp(-6.8*asw)
+ bts = asw
+ if(bts.lt.0.)bts=0.
+ if(bts.gt.1.)bts=1.
+
+c diurnal tmin and tmax
+c-----------------------------------------------------------------------
+ if(idayt .eq. 1) then
+ tmax = temi + 0.5 * delti
+ tmin = temi - 0.5 * delti
+ elseif(idayt .eq. 2) then
+ tmax = temi
+ tmin = temi
+ endif
+
+c tk : surface air temperature in Kelvin
+c-----------------------------------------------------------------------
+ tk=temi+temp0
+
+c snd : snow depth in mm
+c-----------------------------------------------------------------------
+ snd = 10. * y(1)
+ if(snd.lt.0.)snd=0.
+
+c fsnow : snow cover
+c-----------------------------------------------------------------------
+ fsnow = sqrt(0.01*snd)
+ if(fsnow.gt.1.)fsnow=1.
+
+c fgreen: green cover
+c-----------------------------------------------------------------------
+c tlai = 0.
+c fgreen = 0.
+
+ do ip =1,npft
+c dlai = plai(ip) / 5000.
+c prob=dexp(5000.*dlog(1.-dlai))
+c fgrn(ip) = (1.-prob)
+ plant_lai = plai(ip)
+ call fgrn_calc(plant_lai,plant_fgrn)
+ fgrn(ip) = plant_fgrn
+
+c fgreen = fgreen+frc(ip)*fgrn(ip)
+ enddo
+c tlai = 5000.*(1.-dexp( (dlog(1.-fgreen))/5000. ))
+
+c Wood Area Index for albedo of forest only
+c only used in the total pixel albedo calculation
+c WAI only defined for trees, equal to 0 for other plant types
+c WAI defined as a fraction of LAIMAX (alpha(ip)*PAI, PAI '=' LAIMAX)
+c WAI is given as a constant for each tree in fileibm
+
+
+ fgr_tree = 0.
+ if(ntree.gt.0) then
+ do ip = nherb+nbush+1, npft0
+ fgr_tree = fgr_tree + fgrn(ip)*frac(ip)
+ end do
+ endif
+
+ fgr_herb = 0.
+ if(nherb+nbush.gt.0) then
+ do ip = 1, nherb+nbush
+ fgr_herb = fgr_herb + fgrn(ip)*frac(ip)
+ end do
+ endif
+
+ fgr_crop = 0.
+ if(ncrop.gt.0) then
+ do ip = npft0+1, npft0+ncrop
+ fgr_crop = fgr_crop + fgrn(ip)*frac(ip)
+ end do
+ endif
+
+ fgr_past = 0.
+ if(npast.gt.0) then
+ do ip = npft0+ncrop+1, npft
+ fgr_past = fgr_past + fgrn(ip)*frac(ip)
+ end do
+ endif
+
+ do ip = nherb+nbush+1, npft0
+ plant_wai = wai(ip)
+ call fgrn_calc(plant_wai,wai_fgrn)
+ woodfgrn(ip) = wai_fgrn
+ enddo
+
+ do ip = nherb+1, nherb+nbush
+ plant_wai = wai(ip)
+ call fgrn_calc(plant_wai,wai_fgrn)
+ woodfgrn(ip) = (frac_nat(igr)-fgr_tree)*wai_fgrn
+ enddo
+
+ fgr_wood = 0.
+c if(ntree.gt.0) then
+c do ip = nherb+nbush+1, npft0
+ do ip = nherb+1, npft0
+ fgr_wood = fgr_wood + woodfgrn(ip)*frac(ip)
+ end do
+c endif
+
+
+c Correct the fgreen calculation by using only frac_nat for the surface
+c covered by trees and herbs
+
+c fgreen = fgr_tree + (1.-fgr_tree)*fgr_herb +fgr_crop +fgr_past
+
+ fgreen = fgr_tree + (frac_nat(igr)-fgr_tree)
+ & *fgr_herb +fgr_crop +fgr_past
+
+c tlai = -alog(1.-fgreen)/(0.5*clump_fac)
+ tlai = 0.
+ do ip = 1, npft
+ tlai = tlai + frc(ip)*plai(ip)
+ end do
+
+c Fraction of pixel coeverd by wood for albedo calculation
+ fwood =(frac_nat(igr)-fgr_tree)*fgr_wood
+
+c fgs: snow-free green cover
+c-----------------------------------------------------------------------
+ fgs = fgreen * (1.-fsnow)
+ fsn = fsnow
+
+c=======================================================================
+c ALBEDO CALCULATION
+c=======================================================================
+
+c albs: soil albedo
+c-----------------------------------------------------------------------
+c additional coefficient 1.7*y(2)/fsi
+c for 0.1515 < soil albedo < 0.33 if colour =0.5
+c instead of 0.225 < soil albedo < 0.33
+ albs=1.5*(0.10+0.1*colour
+ & +0.07*(1.-1.7*y(2)/fsi))
+
+c albsn: snow albedo
+c-----------------------------------------------------------------------
+ if (temi.lt.0.) then
+ tmfac=0.1*(temi+10.)
+ if(tmfac.lt.0.001) tmfac=0.001
+ tm3 = tmfac*tmfac*tmfac
+ alnsw = 0.85 - 0.20 * tm3
+ alnlw = 0.65 - 0.16 * tm3
+ albsn = 0.5*(alnsw+alnlw)
+ else
+ albsn = 0.57
+ endif
+
+c alb: average (soil+veg+snow) albedo
+c-----------------------------------------------------------------------
+c alb = fsnow*albsn
+c 1 + (1.-fsnow)*(albv*fgreen+albs*(1.-fgreen))
+
+c Correction for bare soil fraction and wood
+ alb = fsnow*albsn
+ 1 + (1.-fsnow)*(albv*fgreen+albwd*fwood+albs*
+ & ((frac_nat(igr)+frac_crop(igr)+frac_past(igr))
+ & -fgreen-fwood))
+
+c albsv: average (soil+veg) albedo
+c-----------------------------------------------------------------------
+ albsv = albv*fgreen+albwd*fwood+albs*
+ & ((frac_nat(igr)+frac_crop(igr)+frac_past(igr))
+ & -fgreen-fwood)
+
+c albsoil: average soil albedo
+c-----------------------------------------------------------------------
+ albsoil = albs*
+ & ((frac_nat(igr)+frac_crop(igr)+frac_past(igr))
+ & -fgreen-fwood)
+
+c albvege: average vegetation albedo
+c-----------------------------------------------------------------------
+ albvege = albv*fgreen+albwd*fwood
+
+
+c=======================================================================
+c THERMODYNAMICAL QUANTITIES
+c psat: pression de vapeur saturante de H2O [Pa]
+c delta: s = d(psat)/dT [Pa K-1]
+c xlw: chaleur latente L d'evaporation de H2O [J kg-1]
+c=======================================================================
+ call esat(tk,psat)
+ if (tk.ge.temp0) then
+ delta=(psat/tk)*(asat/tk-bsat)
+ xlw=2.497d+6 - 2.31d+3*(tk-temp0)
+ else
+ delta=psat*eaice/(rgas*tk*tk)
+ xlw=eaice/h2omw
+ endif
+
+c eh2o: H2O vapour pressure (Pa)
+c fh2o: volume mixing ratio of H2O
+c qh2o: specific humidity (kg kg-1)
+c airmw: air molecular weight [kg mol-1]
+c rhoair: air density (perfect gas law) [kg m-3]
+c rair: gas constant of wet air (J K-1 kg-1)
+c-----------------------------------------------------------------------
+ eh2o = hai*psat
+ fh2o = eh2o/patm
+ qh2o = epsi*fh2o
+ airmw = (qh2o + (1.-fh2o)) * drymw
+ rair = rgas/airmw
+ rhoair = patm/(rair*tk)
+
+c cpair: specific heat cp of air at constant p [J kg-1 K-1]
+c-----------------------------------------------------------------------
+ cpair = cph2o*qh2o + cpdry*(1.-qh2o)
+
+c gama: psychrometric constant [Pa K-1]
+c-----------------------------------------------------------------------
+ gama = cpair*patm/(epsi*xlw)
+ rscp_air = rair/cpair
+
+c=======================================================================
+c EMISSIVITY CALCULATION
+c emisn: emissivity of snow
+c emiv: emissivity of vegetation
+c emis: soil emissivity
+c emisf: average surface emissivity
+c emia: atmospheric emissivity
+c=======================================================================
+
+c snow
+c-----------------------------------------------------------------------
+ emisn = 0.96
+
+c soil
+c-----------------------------------------------------------------------
+ emiwet = 0.01*(0.95*san+0.96*sil+0.97*cla)
+ emidry = 0.01*(0.87*san+0.93*sil+0.95*cla)
+ emis = emidry + was*(emiwet-emidry)
+
+c average emissivity of the surface
+c-----------------------------------------------------------------------
+c emisf = fsnow*emisn
+c 1 + (1.-fsnow)*(emiv*fgreen+emis*(1.-fgreen))
+
+c Emissivity calculation corrected for bare soil fraction
+c fwood not included here
+
+ emisf = fsnow*emisn
+ & + (1.-fsnow)*(emiv*fgreen+emis*
+ & ((frac_nat(igr)+frac_crop(igr)+frac_past(igr))
+ & -fgreen))
+
+c average emissivity of the surface without snow (no snow)
+c-----------------------------------------------------------------------
+ emisfns = emiv*fgreen + emis*
+ & ((frac_nat(igr)+frac_crop(igr)+frac_past(igr))
+ & -fgreen)
+
+c atmosphere
+c Staley & Jurica
+c aa = 0.67-0.04*(1.013d+5-patm)/0.303d+5
+c emia = aa*((eh2o/100.)**0.08)
+c Guyot
+c emia = 0.56+0.08*sqrt(eh2o/100.)
+c Brutsaert, 1975
+c emia = 1.24*((0.01*eh2o/tk)**0.142857)
+c Crawford & Duchon, 1999 (modified Brutsaert)
+c xmon=(dn+15.2)/30.416667
+c if (ylati.lt.0.) xmon = xmon+6.
+c aa = 1.22+0.06*dsin((xmon+2.)*pi/6.)
+c emia = aa*((0.01*eh2o/tk)**0.142857)
+c Anderson 1954
+c-----------------------------------------------------------------------
+ emia = 0.68+0.036*sqrt(0.01*eh2o)
+
+ if (emia.gt.1.) emia=1.
+
+c=======================================================================
+c AERODYNAMIC RESISTANCE
+c rblwm, rblcv: aerodynamic resistances [s m-1]
+c for water (averaged over vegetation and soil)
+c and carbon (for each vegetation type)
+c respectively
+c=======================================================================
+
+ if(windi.lt.0.1)windi=0.1
+ uss = usmuls*windi
+ rblws = windi/(uss*uss) + 6.2/(uss**0.67)
+ xrblwm = (1.-fveg)*dlog(rblws)
+c mean of log(zzra-disd)/z0
+ xlog2 = (1.-fveg)/(zzlogs*zzlogs)
+ do ip = 1, npft
+ z0 = z0vw(ip) + fgrn(ip) * (z0vs(ip)-z0vw(ip))
+ zzlog(ip) = dlog((zzra(ip)-disd(ip))/z0)
+ xlog2 = xlog2 + frc(ip)/(zzlog(ip)*zzlog(ip))
+ end do
+ if (xlog2.gt.1.d-10) then
+ zzlogm = dsqrt(1./xlog2)
+ else
+ zzlogm = 1.
+ endif
+
+c Determination of roughness length of the pixel
+c from drag coefficients approach (Claussen et al. (1991))
+c Use of dominant plant type for reference blending height
+c to be changed to use landuse type specific blending height
+
+ frcini=frc(1)
+ indicmax=1
+ do ip =1, npft
+ if (frc(ip). gt. frcini) then
+ indicmax=ip
+ frcini=frc(ip)
+ else
+ indicmax=indicmax
+ endif
+ end do
+
+c mean pixel roughness length
+ z0tot=(zzra(indicmax)-disd(indicmax))/exp(zzlogm)
+
+c mean aerodynamic and boundary layer resistances (for water)
+ usmulm = 0.40/zzlogm
+ usm = usmulm*windi
+ ram = windi/(usm*usm)
+ rbwm = 6.2/(usm**0.67)
+ rblwm = ram + rbwm
+c aerodynamic and boundary layer resistances of each plant type (for carbon)
+ do ip = 1, npft
+ usmulv = 0.40/zzlog(ip)
+ us = usmulv*windi
+ ra = windi/(us*us)
+ rbw = 6.2/(us**0.67)
+ rblwv = ra + rbw
+ rblcv(ip) = (ra+1.37*rbw)
+ enddo
+
+
+
+c snowmelt (sml), rainfall (rf), and snowfall (sf)
+c (mm day-1)
+c-----------------------------------------------------------------------
+ if(tmax.le.0.)then
+ sml = 0.
+ rf = 0.
+ sf = preci
+ else
+ if(tmin.ge.0.)then
+ sml= 4.57 * temi
+ rf = preci
+ sf = 0.
+ else
+ if((tmax-tmin).le.1.d-10)then
+ pcrain = 0.5
+ else
+ pcrain = tmax / (tmax-tmin)
+ endif
+ sml = 0.5*pcrain * 4.57*tmax
+ rf = pcrain * preci
+ sf = (1.-pcrain) * preci
+ endif
+ smlmax = y(1) / stept
+ if(sml.gt.smlmax)sml=smlmax
+ if(sml.lt.0.)sml=0.
+ endif
+
+c xlsml: Energy used for snow melt (W m-2)
+c xlice: Latent heat of ice melt (J kg-1)
+c-----------------------------------------------------------------------
+ xlice = 3.34d+5
+ xlsml = xlice*sml/86400.
+
+c input fluxes (fin)
+c (mm day-1)
+c-----------------------------------------------------------------------
+ fin_w(1) = sf
+ fin_w(2) = rf + sml
+ exces_run = 0.
+
+ cond_max = (12./12.) * 240.* exp(acd+bcd*rootd/fsi)
+ if (fin_w(2).gt.cond_max) then
+ exces_run = fin_w(2)-cond_max
+ fin_w(2) = cond_max
+ endif
+
+c=======================================================================
+c POTENTIAL EVAPOTRANSPIRATION (PENMAN)
+c pet (mm day-1)
+c=======================================================================
+
+c factors for Penman relationship
+c-----------------------------------------------------------------------
+
+ xleadi=(rhoair*cpair/(delta+gama))*psat*(1.-hai)/rblwm
+ rnfac = delta/(delta+gama)
+
+c tc = cloud (bottom) temperature (K)
+c-----------------------------------------------------------------------
+ tc = tk-11.
+
+ tcb = tk+5.
+ tca = tk-85.
+ nint=4
+ ermax = 0.01
+ nitmax =100
+ imeth = 1
+ call nonlineq(tca,tcb,nint,tc,ftc,ermax,nitmax,imeth,numc)
+
+c tatm = atmosphere (lower 1 km) temperature (K), i.e. average
+c temperature of the atmospheric layer contributing to the
+c downward infrared radiation during clear sky conditions
+c-----------------------------------------------------------------------
+
+ tatm = tk
+
+c firdown = downward infrared radiation (W m-2)
+c-----------------------------------------------------------------------
+ firdown = emia*sigma*tatm*tatm*tatm*tatm
+ 1 +(1.-shi)*(1.-emia)*sigma*tc*tc*tc*tc
+
+c solnet : net solar radiation flux [W m-2]
+c-----------------------------------------------------------------------
+ solnet = solg(0) * (1.-alb)
+
+c loop for the calculation of Tsurf
+c-----------------------------------------------------------------------
+ tsurf = tk
+ num1 = 10
+ jbrac = 1
+ numit = 0
+
+ do jnum = 1,100
+ numit = numit+1
+ tsf = tsurf
+c rnet : net radiation flux Rn [W m-2]
+c-----------------------------------------------------------------------
+ fird = firdown
+ rnet = solnet + emisf*firdown
+ & - emisf*sigma*tsf*tsf*tsf*tsf
+
+c xle : LE* from the surface (Penman) [W m-2]
+c-----------------------------------------------------------------------
+ xle = (rnet-grflx-xlsml)*rnfac + xleadi
+c if(xle.lt.0.)xle=0.
+c pet : potential evapotranspiration E* (Penman) [mm day-1]
+c-----------------------------------------------------------------------
+ pet = 86400.*xle/xlw
+
+
+c eint : intercepted precipitation directly re-evaporated [mm day-1]
+c esnow: snow evaporation from soil-vegetation [mm day-1]
+c esoil: evaporation from soil-vegetation [mm day-1]
+c-----------------------------------------------------------------------
+ if (pet.gt.0.) then
+ eint=0.
+ do ip=1,npft
+ if(fgrn(ip).eq.0.)then
+ eintpl=0.
+ else
+ x=preci/pet
+ xii=(stept*pet*fgrn(ip)/(0.2*plai(ip)))
+ x0=1./(0.84640+0.83842*xii)
+ xr=x0+1.
+ tr=0.7225-0.2529*exp(-xii/6.738)
+ xk=1./tr-1.
+ if(x.le.x0)then
+ qfrac=0.
+ else
+ if(x.le.xr)then
+ xnn=1.352
+ else
+ xnn=1.122
+ endif
+ qx=(x-x0)**xnn
+ qfrac=qx/(qx+xk)
+ endif
+ eintpl=preci*fgrn(ip)*(1.-qfrac)
+ if(eintpl.gt.pet)eintpl=pet
+ endif
+ eint=eint+eintpl*frc(ip)
+ enddo
+ esnow = fsnow * (pet-eint)
+ esnmax = y(1) / stept - sml
+ if (esnow.gt.esnmax) esnow = esnmax
+ if(esnow.lt.0.)esnow=0.
+ esoil = bts * (pet-eint-esnow)
+ esomax = (y(2)-wpi) / stept
+ if (esoil.gt.esomax) esoil = esomax
+ if(esoil.lt.0.)esoil=0.
+ else
+ eint = 0.
+ if(tmax.le.0.)then
+ esoil = 0.
+ esnow = pet
+ elseif(tmin.ge.0.)then
+ esoil = pet
+ esnow = 0.
+ else
+ if((tmax-tmin).le.1.d-10)then
+ pcdew = 0.5
+ else
+ pcdew = tmax / (tmax-tmin)
+ endif
+ esoil = pcdew * pet
+ esnow = (1.-pcdew) * pet
+ endif
+ endif
+
+
+c axle : (actual) latent heat LE from the surface [W m-2]
+c-----------------------------------------------------------------------
+ axle = (eint+esnow+esoil) * xlw / 86400.
+c if(axle.lt.0.)axle=0.
+
+c xh : (actual) sensible heat H from the surface [W m-2]
+c-----------------------------------------------------------------------
+ xh = rnet-grflx-xlsml-axle
+
+ tsurf = tk + xh*rblwm/(rhoair*cpair)
+
+ err = tsurf - tsf
+
+ if (dabs(tsurf).ge.1.d+10) numit=num1
+ if (dabs(err).lt.0.05) goto 340
+
+ if (numit.eq.1) then
+ tsf1=tsf
+ err1=err
+ elseif (numit.ge.num1) then
+
+ if (jbrac.eq.1)then
+ if (numit.eq.num1) then
+ tsurf = tk + 1.0
+ else
+ tsf2 = tsf
+ err2 = err
+ prod = err1*err2
+ if (prod.gt.0.) then
+ if (dabs(err1).lt.dabs(err2)) then
+ tsurf = tsf1+(tsf1-tsf2)*1.7
+ else
+ tsurf = tsf2+(tsf2-tsf1)*1.7
+ tsf1 = tsf2
+ err1 = err2
+ endif
+ else
+ tsurf = tsf1+(tsf2-tsf1)*dabs(err1)
+ & /dabs(err1-err2)
+ jbrac = 0
+ endif
+ endif
+ else
+ prod = err*err2
+ if (prod.gt.0) then
+ tsf2 = tsf
+ err2 = err
+ else
+ tsf1 = tsf
+ err1 = err
+ endif
+ tsurf = tsf1+(tsf2-tsf1)*dabs(err1)/dabs(err1-err2)
+ endif
+
+ endif
+ enddo
+ write(28,*)' CALCUL DE TS (SUB GIVEDRV)'
+ write(28,*) ylongi,ylati,igr,ny0,dn,
+ & ' numit=',numit
+ write(28,*)tsf1,err1
+ write(28,*)tsf2,err2
+ stop
+340 continue
+c ts : average surface (snow+soil+vegetation) temperature (C)
+c-----------------------------------------------------------------------
+ ts = tsurf - temp0
+
+c soil+vegetation actual evapotranspiration (soe)
+c snow actual evaporation (sne)
+c total actual evapotranspiration (aet)
+c (mm day-1)
+c-----------------------------------------------------------------------
+ if(preci.ne.0.)then
+ rapso = rf/preci
+ else
+ rapso = 0.
+ endif
+ soe = eint * rapso + esoil
+ sne = eint * (1.-rapso) + esnow
+ aet = soe + sne
+ svevp = esoil
+
+
+c rtrans = ratio of plant transpiration to soil+vegetation evapotr.
+ frctr = 1.-exp(-tlai)
+ if (tlai.le.1.) then
+ frcso = 1.-0.666*tlai
+ else
+ frcso = exp(-tlai)/1.1
+ endif
+ rtrans = frctr/(frctr+frcso)
+ if (rtrans.gt.1.) rtrans=1.
+c old if (rtrans.lt.0.6) rtrans=0.6
+ if (rtrans.lt.0.) rtrans=0.
+
+
+c drun : drainage (mm day-1)
+c condw : soil conductivity (mm day-1) (Saxton et al, 1986)
+c thw : soil water content (m3/m3)
+c ttl : drainage characteristic time (day)
+c if too short, re-evaluation of the drainage rate
+c to take the sharp variation of conductivity with
+c water content into account.
+c san, sil, cla: percent of sand, silt and clay
+c-----------------------------------------------------------------------
+
+
+c interpolation sur le contenu en eau
+c-----------------------------------------------------------------------
+
+ k1w = 0
+ if((k1w .lt. 1) .or. (k1w .ge. nwa)) k1w = 0
+ if(was .lt. wa0(k1w)) k1w = 0
+ k0w = k1w + 1
+ do kw = k0w, nwa-1
+ if(was .le. wa0(kw)) then
+ k2w = kw
+ goto 210
+ endif
+ enddo
+ k2w = nwa
+210 continue
+ k1w = k2w - 1
+
+c parametrisation interpolee pour dep. flux net
+c-----------------------------------------------------------------------
+
+ fnet = fin_w(2) - soe
+
+ if(fnet.lt.0.)then
+ if (dabs(fnet).ge.fntmax) fnet = -fntmax
+ do j=0,nde+1
+ ej1 = ajdr(j,k1w)
+ ej2 = ajdr(j,k2w)
+ ej(j) = ej1+(ej2-ej1)*(was-wa0(k1w))
+ & /(wa0(k2w)-wa0(k1w))
+ enddo
+ else
+ if (dabs(fnet).ge.fntmax) fnet = fntmax
+ do j=0,nde+1
+ ej1 = bjdr(j,k1w)
+ ej2 = bjdr(j,k2w)
+ ej(j) = ej1+(ej2-ej1)*(was-wa0(k1w))
+ & /(wa0(k2w)-wa0(k1w))
+ enddo
+ endif
+ dr = ej(0)
+ do j = 1,nde+1
+ fntj = 1.
+ do kj = 1,j
+ fntj = fntj*fnet
+ enddo
+ dr = dr + ej(j)*fntj
+ enddo
+
+ if (dr.lt.0.) dr=0.
+ avh2o = fnet * stept + (y(2)-wpi)
+ if (dr.gt.avh2o) dr=avh2o
+ drun = drn_fac * dr / stept
+
+ t0dr = -2.
+ if (tmax.le.t0dr) then
+ drun = 0.
+ elseif (tmax.lt.0.) then
+ drun = (t0dr-tmax)*drun/t0dr
+ endif
+
+
+c srun : surface runoff (mm day-1)
+c-----------------------------------------------------------------------
+ fnsw = fin_w(2) - soe - drun
+ fnmax = (fsi-y(2)) / stept
+ if (fnsw.gt.fnmax) then
+ srun = exces_run + fnsw - fnmax
+ else
+ srun = exces_run
+ endif
+
+c fout : output fluxes (mm day-1)
+c-----------------------------------------------------------------------
+ fout_w(1) = sml + sne
+ fout_w(2) = soe + drun + (srun - exces_run)
+
+
+c=======================================================================
+c derivatives dy/dt [ mm day-1]
+c=======================================================================
+
+ do nr=1,nres
+ drv(nr) = fin_w(nr) - fout_w(nr)
+ enddo
+
+ return
+ end subroutine givedrv
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/hydro_initbdo.f b/couplage/CARAIB/ver01_Iv_couplage/hydro_initbdo.f
new file mode 100644
index 0000000..7b70636
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/hydro_initbdo.f
@@ -0,0 +1,62 @@
+c=======================================================================
+c***********************************************************************
+ subroutine initbdo
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c a difference between columns (j) and (j+1) of "tbldrv" corresponds
+c to a back difference operation of order 1 on the derivatives between
+c time = (norder-j)*stept and time = (norder-j-1)*stept;
+c in the following k iterations,
+c a difference between columns (j) and (j+1) of "deldrv" corresponds
+c to a back difference operation of order k on the derivatives between
+c time = (norder-j)*stept and time = (norder-j-1)*stept;
+c
+c for example, we have with norder = 4 :
+c
+c --------+------------+------------+------------+----------------->
+c 0. stept 2.*stept 3.*stept t
+c
+c tbldrv(i,4) tbldrv(i,3) tbldrv(i,2) tbldrv(i,1)=olddrv(i)
+c
+c k=1 : - deldrv(i,3) deldrv(i,2) deldrv(i,1)=oldbdo(i,1)
+c k=2 : - - deldrv(i,2) deldrv(i,1)=oldbdo(i,2)
+c k=3 : - - - deldrv(i,1)=oldbdo(i,3)
+c=======================================================================
+
+c implicit double precision (a-h,o-z)
+ implicit none
+ include './com_18/parameter.common'
+ include './com_18/bkdf.common'
+ include './com_18/coldrv.common'
+ include './com_18/memory.common'
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer i,j,k
+c
+c-----------------------------------------------
+
+ do j = 1, norder-1
+ do i = 1, nequat
+ deldrv(i,j) = tbldrv(i,j) - tbldrv(i,j+1)
+ enddo
+ enddo
+ do i = 1, nequat
+ oldbdo(i,1) = deldrv(i,1)
+ olddrv(i) = tbldrv(i,1)
+ enddo
+
+ do k = 2, norder-1
+ do j = 1, norder-k
+ do i = 1, nequat
+ deldrv(i,j) = deldrv(i,j) - deldrv(i,j+1)
+ enddo
+ enddo
+ do i = 1, nequat
+ oldbdo(i,k) = deldrv(i,1)
+ enddo
+ enddo
+ return
+ end subroutine initbdo
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/hydro_moulton.f b/couplage/CARAIB/ver01_Iv_couplage/hydro_moulton.f
new file mode 100644
index 0000000..93979a1
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/hydro_moulton.f
@@ -0,0 +1,37 @@
+c=======================================================================
+c***********************************************************************
+ subroutine moulton(stept,drv,y,ynew)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c time has been incremented;
+c the value "ynew" of the vector "y" is estimated at present time step
+c with the implicit adams-moulton correction scheme.
+c=======================================================================
+c implicit double precision (a-h,o-z)
+ implicit none
+ include './com_18/parameter.common'
+ include './com_18/newbdo.common'
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer i,j
+ real*8 cstc,drv,y,ynew
+c
+c-----------------------------------------------
+ dimension cstc(6), drv(nequat), y(nequat), ynew(nequat)
+ real*4 stept
+
+ data cstc /-.5, -.083333, -.041667, -.026389, -.01875, -.014269/
+
+ do i = 1, nequat
+ ynew(i) = y(i) + stept*drv(i)
+ enddo
+ do j = 1, norder
+ do i = 1, nequat
+ ynew(i) = ynew(i) + stept*cstc(j)*bdo(i,j)
+ enddo
+ enddo
+ return
+ end subroutine moulton
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/hydro_nonlineq.f b/couplage/CARAIB/ver01_Iv_couplage/hydro_nonlineq.f
new file mode 100644
index 0000000..dbeb4c1
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/hydro_nonlineq.f
@@ -0,0 +1,188 @@
+c=======================================================================
+c***********************************************************************
+ subroutine nonlineq(xa,xb,nint,x,fx,ermax,nitmax,imeth,num)
+c***********************************************************************
+
+c=======================================================================
+c Subroutine nonlineq solves a non linear equation of the type:
+c f(x) = 0
+c by the bisection method or the "regula falsi" method.
+c It calls the user-defined subroutine "funcx(x,fx)" which
+c defines the f(x) function.
+c
+c xa = lower bound of interval in which the solution is
+c searched for
+c xb = upper bound of interval in which the solution is
+c searched for
+c nint = number of intervals into which [xa,xb] is divided
+c when searching for a (smaller) interval of changing
+c sign (e.g. 10)
+c x = - at entry, x is set to any value between a and b;
+c it may represent an "initial guess" of the solution
+c - at exit, x contains the estimated value of the zero
+c of the function
+c fx = at output, fx contains f(x), i.e. fx should be close to
+c 0, if x contains a good evaluation of the zero
+c ermax = maximum acceptable error on fx,
+c i.e., when (abs(fx).le.ermax) the zero is accepted
+c nitmax = maximum number of iterations allowed (e.g., 100)
+c imeth = flag to select resolution method. Set imeth to 0 for
+c bisection method and to 1 for "regula falsi"
+c num = at exit, contains total number of iterations performed
+c
+c The variable "precmc" below must be set to a small number
+c representing machine precision. The relative error on the
+c zero (x) cannot be smaller than precmc. With single precision
+c a value of precmc of 1.e-6 is recommended. For double precision
+c a value as small as 1.d-12 can be used.
+c=======================================================================
+c implicit double precision (a-h,o-z)
+ implicit none
+ real*4 x,fx
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer imeth,k,nint,nit,nitmax,num
+ real*8 delx,ermax,err,errx,fx1,fx2,precmc,prod,prod1,residu,x_old
+ & ,x1,x2,xa,xb
+c
+c-----------------------------------------------
+
+ precmc = 1.d-10
+
+ num = 0
+
+ delx = (xb-xa)/float(nint)
+
+c=======================================================================
+c initial try with previous value of x and values smaller or
+c larger by an amount delx
+c (sets values for x1 and x2 with fx1*fx2 < 0)
+c=======================================================================
+
+ call funcx(x, fx)
+
+ err = abs(fx)
+ if (err.le.ermax) goto 300
+
+ x1 = x
+ fx1 = fx
+
+ x = x1+delx
+ if (x.gt.xb) x=xb
+ if (x.lt.xa) x=xa
+
+ num = num + 1
+ call funcx(x, fx)
+
+ prod = fx*fx1
+ if (prod.gt.0) then
+ x = x1-delx
+ if (x.gt.xb) x=xb
+ if (x.lt.xa) x=xa
+ call funcx(x, fx)
+
+ prod1 = fx*fx1
+ if (prod1.le.0) then
+ x2 = x
+ fx2 = fx
+ goto 200
+ endif
+ else
+ x2 = x
+ fx2 = fx
+ goto 200
+ endif
+
+c=======================================================================
+c if initial try fails, search for the solution over the
+c entire range xa to xb
+c=======================================================================
+
+ x = xa
+
+ num = num + 1
+ call funcx(x, fx)
+
+ x1 = x
+ fx1 = fx
+
+ do k = 1, nint
+ x = xa+delx*float(k)
+ num = num + 1
+
+ call funcx(x, fx)
+
+ prod = fx1*fx
+ if (prod.gt.0.) then
+ x1 = x
+ fx1 = fx
+ else
+ x2 = x
+ fx2 = fx
+ goto 200
+ endif
+
+ enddo
+
+ write(*,*)'No solution found for x between xa and xb'
+ write(*,*)' x=',x,' fx=',fx
+ write(*,*)'program stop'
+ stop
+
+c=======================================================================
+c after finding two values of x with fx of different signs,
+c we solve the equation by bisection (imeth=0) or "regula falsi"
+c (imeth=1) method
+c=======================================================================
+
+ 200 continue
+
+c write(*,*)'Interval of changing sign found'
+
+ do nit = 1, nitmax
+
+ num = num + 1
+
+ x_old = x
+
+ if (imeth.eq.0) then
+ x = (x1+x2)/2.
+ else
+ residu = -fx1*(x2-x1)/(fx2-fx1)
+ x = x1 + residu
+ endif
+
+ call funcx(x, fx)
+
+ err=abs(fx)
+
+ if(x.ne.0.) then
+ errx = abs((x-x_old)/x)
+ else
+ errx = abs(x-x_old)
+ endif
+ if ((err.le.ermax).or.(errx.le.precmc)) goto 300
+
+ prod = fx*fx2
+ if (prod.gt.0) then
+ x2 = x
+ fx2 = fx
+ else
+ x1 = x
+ fx1 = fx
+ endif
+
+ enddo
+
+ write(*,*)'Too much iterations in subroutine nonlineq'
+ write(*,*)'num=',num,' x=',x
+ write(*,*)'fx=',fx
+ write(*,*)'program stop'
+ stop
+
+ 300 continue
+
+
+ return
+ end subroutine nonlineq
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/hydro_ode.f b/couplage/CARAIB/ver01_Iv_couplage/hydro_ode.f
new file mode 100644
index 0000000..8f85360
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/hydro_ode.f
@@ -0,0 +1,82 @@
+c=======================================================================
+c***********************************************************************
+ subroutine ode(tbegin,tend,y,stept,niter,ipr)
+c***********************************************************************
+c=======================================================================
+c implicit double precision (a-h,o-z)
+ implicit none
+ include './com_18/parameter.common'
+ include './com_18/coldrv.common'
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer i,ipr,iter,j,niter
+ real*8 drv,time,y,ynew
+c
+c-----------------------------------------------
+ real*4 tbegin,tend,stept
+ dimension y(nequat), ynew(nequat), drv(nequat)
+
+c reading of the control parameters :
+c stept : integration step (constant during the whole simulation)
+c niter : maximum number of correction iterations
+c tbegin : initial time
+c tend : final time
+c ipr : unite pour les impressions
+c ----------------------------------------------------------------------
+
+c initial conditions
+c ----------------------------------------------------------------------
+ time = tbegin
+ call timdep(stept,time)
+
+
+c the integration is performed with "runge-kutta" for the first
+c "norder" steps :
+c derivatives "drv" are computed at the current time value (givedrv)
+c and kept in "tbldrv" whose back differences will be computed in
+c "initbdo".
+c "runkut4" computes "y" for the next time value.
+c ----------------------------------------------------------------------
+
+ do j = norder,1,-1
+ call givedrv(stept,time,y,drv)
+ call check(stept,time,y,drv)
+ call printing(ipr,time,y,drv)
+ do i = 1, nequat
+ tbldrv(i,j) = drv(i)
+ enddo
+ call runkut4(stept,time,y,drv)
+ time = time + stept
+ call timdep(stept,time)
+ enddo
+ call initbdo
+
+c prediction-correction scheme begins :
+c ----------------------------------------------------------------------
+9990 continue
+ call givedrv(stept,time,y,drv)
+ call check(stept,time,y,drv)
+ call printing(ipr,time,y,drv)
+ call backdiff(drv)
+ call bashfor(stept,drv,y,ynew)
+ time = time + stept
+ call timdep(stept,time)
+ call remember(drv)
+ do iter = 1, niter
+ call givedrv(stept,time,ynew,drv)
+ call backdiff(drv)
+ call moulton(stept,drv,y,ynew)
+ enddo
+ do i = 1, nequat
+ y(i) = ynew(i)
+
+ enddo
+ if(time .lt. tend) goto 9990
+
+CVC call givedrv(stept,time,y,drv)
+CVC call check(stept,time,y,drv)
+ call printing(ipr,time,y,drv)
+
+ return
+ end subroutine ode
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/hydro_printing.f b/couplage/CARAIB/ver01_Iv_couplage/hydro_printing.f
new file mode 100644
index 0000000..868da52
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/hydro_printing.f
@@ -0,0 +1,363 @@
+c=======================================================================
+c***********************************************************************
+ subroutine printing(ipr,time,y,drv)
+c***********************************************************************
+c=======================================================================
+
+c implicit double precision (a-h,o-z)
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/coord.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/eco.common'
+ include './com_18/files_ibm.common'
+ include './com_18/flux_w.common'
+ include './com_18/iprt.common'
+ include './com_18/monthcst.common'
+ include './com_18/monwat.common'
+ include './com_18/nspc.common'
+ include './com_18/prt.common'
+ include './com_18/prt_ctrl.common'
+ include './com_18/smrd.common'
+ include './com_18/varnow.common'
+ include './com_18/vegfr.common'
+ include './com_18/waflux.common'
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer iday,idnn,ip,ipr,k,km,m,nr,ny0
+ real*8 dn,drv,eiry,time,wbudy,y
+c
+c-----------------------------------------------
+
+ integer npint,ijour
+ character*10 mois(nm)
+ character*100 formatw
+ dimension y(nequat),drv(nequat)
+
+
+ data mois /'JANUARY','FEBRUARY','MARCH','APRIL','MAY','JUNE'
+ 1 ,'JULY','AUGUST','SEPTEMBER','OCTOBER','NOVEMBER','DECEMBER'/
+
+
+ ny0 = int(time/float(nd)+0.000001)+1
+ dn = time - float(ny0-1) * float(nd)
+
+ if (idaily_out.eq.0) then
+ npint=nm
+ do m = 1, nm
+ mdur(m) = mlength(m)
+ end do
+ else
+ npint=nd
+ do iday = 1, nd
+ mdur(iday)=1
+ end do
+ endif
+
+c begins operations performed once a year (January 1st)
+ if (ny0.ne.ny0prv) then
+
+
+ open(29,file=filtim)
+ write(29,*)'igr:',igr
+ write(29,*)'ny0:',ny0,' nyear:',nyear
+ close(29)
+
+
+ nprt=nstprt-1
+
+ if (nsyr.gt.0) then
+
+ prcy = float(nd)*prcy/nsyr
+ runy = float(nd)*runy/nsyr
+ soey = float(nd)*soey/nsyr
+ svey = float(nd)*svey/nsyr
+ pety = float(nd)*pety/nsyr
+ sney = float(nd)*sney/nsyr
+
+ do k=1,npint
+ swmth(k) = swmth(k) / nsmth(k)
+ swmmmth(k) = swmmmth(k) / nsmth(k)
+ rtrmth(k) = rtrmth(k) / nsmth(k)
+ petmth(k) = petmth(k) * mdur(k) / nsmth(k)
+ aetmth(k) = aetmth(k) * mdur(k) / nsmth(k)
+ runmth(k) = runmth(k) * mdur(k) / nsmth(k)
+ srunmth(k) = srunmth(k) * mdur(k) / nsmth(k)
+ drnmth(k) = drnmth(k) * mdur(k) / nsmth(k)
+ svemth(k) = svemth(k) * mdur(k) / nsmth(k)
+ eintmth(k) = eintmth(k) * mdur(k) / nsmth(k)
+ etrmth(k) = etrmth(k) * mdur(k) / nsmth(k)
+ esomth(k) = esomth(k) * mdur(k) / nsmth(k)
+ rblmth(k) = rblmth(k) / nsmth(k)
+ albmth(k) = albmth(k) / nsmth(k)
+ albsvmth(k) = albsvmth(k) / nsmth(k)
+ albsmth(k) = albsmth(k) / nsmth(k)
+ albvmth(k) = albvmth(k) / nsmth(k)
+ emimth(k) = emimth(k) / nsmth(k)
+ eminsmth(k) = eminsmth(k) / nsmth(k)
+ z0mth(k) = z0mth(k) / nsmth(k)
+ rnmth(k) = rnmth(k) / nsmth(k)
+ firdmth(k) = firdmth(k) / nsmth(k)
+ xhmth(k) = xhmth(k) / nsmth(k)
+ xlemth(k) = xlemth(k) / nsmth(k)
+ solmth(k) = solmth(k) / nsmth(k)
+ sfmth(k) = sfmth(k) * mdur(k) / nsmth(k)
+ snemth(k) = snemth(k) * mdur(k) / nsmth(k)
+ smlmth(k) = smlmth(k) * mdur(k) / nsmth(k)
+ grfmth(k) = grfmth(k) / nsmth(k)
+ tsmth(k) = tsmth(k) / nsmth(k)
+ fgsmth(k) = fgsmth(k) / nsmth(k)
+ fsnmth(k) = fsnmth(k) / nsmth(k)
+ sndmth(k) = sndmth(k) / nsmth(k)
+ tlamth(k) = tlamth(k) / nsmth(k)
+ enddo
+
+ endif
+
+ if (ny0.eq.ny0max+1) then
+ if (iyprt.ge.1) then
+
+
+
+ if(iprt_sw.eq.1)
+ & write(31,131) ylongi,ylati,(swmth(k),k=1,npint)
+ if(iprt_swmm.eq.1)
+ & write(531,631) ylongi,ylati,(swmmmth(k),k=1,npint)
+ if(iprt_rtr.eq.1)
+ & write(532,131) ylongi,ylati,(rtrmth(k),k=1,npint)
+ if(iprt_pet.eq.1)
+ & write(32,401) ylongi,ylati,(petmth(k),k=1,npint)
+ if(iprt_aet.eq.1)
+ & write(33,401) ylongi,ylati,(aetmth(k),k=1,npint)
+ if(iprt_run.eq.1)
+ & write(34,401) ylongi,ylati,(runmth(k),k=1,npint)
+ if(iprt_fsn.eq.1)
+ & write(35,131) ylongi,ylati,(fsnmth(k),k=1,npint)
+ if(iprt_snd.eq.1)
+ & write(535,135) ylongi,ylati,(sndmth(k),k=1,npint)
+ if(iprt_srun.eq.1)
+ & write(536,401) ylongi,ylati,(srunmth(k),k=1,npint)
+ if(iprt_drn.eq.1)
+ & write(36,401) ylongi,ylati,(drnmth(k),k=1,npint)
+ if(iprt_sve.eq.1)
+ & write(37,401) ylongi,ylati,(svemth(k),k=1,npint)
+ if(iprt_eint.eq.1)
+ & write(537,401) ylongi,ylati,(eintmth(k),k=1,npint)
+ if(iprt_etr.eq.1)
+ & write(538,401) ylongi,ylati,(etrmth(k),k=1,npint)
+ if(iprt_eso.eq.1)
+ & write(539,401) ylongi,ylati,(esomth(k),k=1,npint)
+ if(iprt_rbl.eq.1)
+ & write(38,401) ylongi,ylati,(rblmth(k),k=1,npint)
+ if(iprt_alb.eq.1)
+ & write(39,131) ylongi,ylati,(albmth(k),k=1,npint)
+ if(iprt_albsv.eq.1)
+ & write(239,131) ylongi,ylati,(albsvmth(k),k=1,npint)
+ if(iprt_albs.eq.1)
+ & write(339,131) ylongi,ylati,(albsmth(k),k=1,npint)
+ if(iprt_albv.eq.1)
+ & write(439,131) ylongi,ylati,(albvmth(k),k=1,npint)
+ if(iprt_rn.eq.1)
+ & write(40,401) ylongi,ylati,(rnmth(k),k=1,npint)
+ if(iprt_grf.eq.1)
+ & write(41,401) ylongi,ylati,(grfmth(k),k=1,npint)
+ if(iprt_ts.eq.1)
+ & write(42,132) ylongi,ylati,(tsmth(k),k=1,npint)
+ if(iprt_fgs.eq.1)
+ & write(43,131) ylongi,ylati,(fgsmth(k),k=1,npint)
+ if(iprt_lai.eq.1)
+ & write(44,1200) ylongi,ylati,(tlamth(k),k=1,npint)
+ if(iprt_fird.eq.1)
+ & write(45,401) ylongi,ylati,(firdmth(k),k=1,npint)
+ if(iprt_xh.eq.1)
+ & write(46,401) ylongi,ylati,(xhmth(k),k=1,npint)
+ if(iprt_xle.eq.1)
+ & write(47,401) ylongi,ylati,(xlemth(k),k=1,npint)
+ if(iprt_sol.eq.1)
+ & write(48,401) ylongi,ylati,(solmth(k),k=1,npint)
+ if(iprt_sf.eq.1)
+ & write(49,401) ylongi,ylati,(sfmth(k),k=1,npint)
+ if(iprt_sne.eq.1)
+ & write(50,401) ylongi,ylati,(snemth(k),k=1,npint)
+ if(iprt_sml.eq.1)
+ & write(51,401) ylongi,ylati,(smlmth(k),k=1,npint)
+ if(iprt_emi.eq.1)
+ & write(52,131) ylongi,ylati,(emimth(k),k=1,npint)
+ if(iprt_emins.eq.1)
+ & write(152,131) ylongi,ylati,(eminsmth(k),k=1,npint)
+ if(iprt_z0.eq.1)
+ & write(252,131) ylongi,ylati,(z0mth(k),k=1,npint)
+
+
+c eiry = interception of rainfall by vegetation
+ eiry=soey-svey
+ wbudy = prcy-runy-soey-sney
+
+ if(iprt_yr.eq.1) write(30,125)igr,ylongi,ylati,
+ 1 fsi,fci,wpi,rootd,prcy,runy
+ 2 ,svey,eiry,sney,pety,wbudy,aswmin,fveg
+ if(iprt_frc.eq.1) then
+ write(formatw,*)'(f8.3,1x,f8.3,',npft,'(1x,f12.8))'
+ write(530,formatw),ylongi,ylati,(frc(ip),ip=1,npft)
+ endif
+ endif
+
+ endif
+
+ do nr = 1,nres
+ sumnet(nr) = 0.
+ enddo
+
+ nsyr = 0
+ do k=1,npint
+ nsmth(k) = 0
+ enddo
+
+ prcy=0.
+ runy=0.
+ soey=0.
+ svey=0.
+ pety=0.
+ sney=0.
+ do k=1,npint
+ swmth(k) = 0.
+ swmmmth(k) = 0.
+ rtrmth(k) = 0.
+ petmth(k) = 0.
+ aetmth(k) = 0.
+ runmth(k) = 0.
+ srunmth(k) = 0.
+ drnmth(k) = 0.
+ svemth(k) = 0.
+ eintmth(k) = 0.
+ etrmth(k) = 0.
+ esomth(k) = 0.
+ rblmth(k) = 0.
+ albmth(k) = 0.
+ albsvmth(k) = 0.
+ albsmth(k) = 0.
+ albvmth(k) = 0.
+ emimth(k) = 0.
+ eminsmth(k) = 0.
+ z0mth(k) = 0.
+ rnmth(k) = 0.
+ grfmth(k) = 0.
+ tsmth(k) = 0.
+ fgsmth(k) = 0.
+ fsnmth(k) = 0.
+ sndmth(k) = 0.
+ tlamth(k) = 0.
+ firdmth(k) = 0.
+ xhmth(k) = 0.
+ xlemth(k) = 0.
+ solmth(k) = 0.
+ sfmth(k) = 0.
+ snemth(k) = 0.
+ smlmth(k) = 0.
+ enddo
+
+ endif
+
+c begins operations performed every time step
+ ny0prv = ny0
+ nprt = nprt + 1
+
+ idnn = int(dn+1.00001)
+ km=0
+ 500 km=km+1
+ if(idnn.gt.mdur(km))then
+ idnn=idnn-mdur(km)
+ goto 500
+ endif
+
+ nsyr = nsyr+1
+ nsmth(km) = nsmth(km)+1
+
+ prcy = prcy + preci
+ runy = runy + drun+srun
+ soey = soey + soe
+ svey = svey + svevp
+ pety = pety + pet
+ sney = sney + sne
+
+ swmth(km) = swmth(km) + asw
+ swmmmth(km) = swmmmth(km) + (wpi + asw*(fci-wpi))
+ rtrmth(km) = rtrmth(km) + rtrans
+ petmth(km) = petmth(km) + pet
+ aetmth(km) = aetmth(km) + aet
+ runmth(km) = runmth(km) + drun+srun
+ srunmth(km) = srunmth(km) + srun
+ drnmth(km) = drnmth(km) + drun
+ svemth(km) = svemth(km) + svevp
+ eintmth(km) = eintmth(km) + (aet-svevp-sne)
+ etrmth(km) = etrmth(km) + rtrans*svevp
+ esomth(km) = esomth(km) + (1.-rtrans)*svevp
+ rblmth(km) = rblmth(km) + rblwm
+ albmth(km) = albmth(km) + alb
+ albsvmth(km) = albsvmth(km) + albsv
+ albsmth(km) = albsmth(km) + albsoil
+ albvmth(km) = albvmth(km) + albvege
+ emimth(km) = emimth(km) + emisf
+ eminsmth(km) = eminsmth(km) + emisfns
+ z0mth(km) = z0mth(km) + z0tot
+ rnmth(km) = rnmth(km) + rnet
+ grfmth(km) = grfmth(km) + grflx
+ tsmth(km) = tsmth(km) + ts
+ fgsmth(km) = fgsmth(km) + fgs
+ fsnmth(km) = fsnmth(km) + fsn
+ sndmth(km) = sndmth(km) + snd
+ tlamth(km) = tlamth(km) + tlai
+ firdmth(km) = firdmth(km) + fird
+ xhmth(km) = xhmth(km) + xh
+ xlemth(km) = xlemth(km) + axle
+ solmth(km) = solmth(km) + solg(0)
+ sfmth(km) = sfmth(km) + sf
+ snemth(km) = snemth(km) + sne
+ smlmth(km) = smlmth(km) + sml
+
+
+c begins full printing if ifull eq 1
+c operations are performed every nstprt time steps, but only over
+c the last ny0prt years
+
+ if (ifull.eq.1) then
+ if ((ny0.ge.(ny0max-ny0prt+1)).and.(nprt.eq.nstprt)) then
+ nprt = 0
+ write(ipr,100) ny0,dn,mois(km),idnn
+
+ write(ipr,1101) igr
+ write(ipr,101) ylongi,ylati,temi
+ & ,delti,preci,asw,solg(0)
+ write(ipr,102) (y(k),k=1,nres)
+ write(ipr,102) (drv(k),k=1,nres)
+ write(ipr,102) (fin_w(k),k=1,nres)
+ write(ipr,102) (fout_w(k),k=1,nres)
+ write(ipr,105) fsi,fci,wpi,pet,soe
+ & ,drun,srun,sne
+ write(ipr,106) ts,hai,windi,tlai,alb
+ & ,rnet,grflx,rblwm
+
+ endif
+ endif
+
+ 1101 format(1x,'STATION No',i6)
+ 100 format(1x,'YEAR=',I4,' DAY NUMBER=',F6.2,6X,A10,I2)
+ 101 format(1x,f6.1,1x,f6.1,1x,f5.1,1x,f6.2,1x,f7.3,1x,f7.4,1x,f7.2)
+ 102 format(2(1x,d12.5))
+ 105 format(1x,3(1x,f7.2),5(1x,f7.3),2(1x,i3))
+ 106 format(1x,f6.2,1x,f6.3,2(1x,f5.2),1x,f6.3,3(1x,f6.1))
+ 115 format(1x,i4,1x,f5.1,1x,f6.1,f7.1,2(1x,i3))
+ 125 format(i6,2(1x,f8.3),4(1x,f7.2),2(1x,f8.2),4(1x,f7.2)
+ & ,1x,f8.2,2(1x,f6.3))
+ 131 format(2(1x,f8.3),366(1x,f7.4))
+ 631 format(2(1x,f8.3),366(1x,f8.2))
+ 132 format(2(1x,f8.3),366(1x,f6.2))
+ 135 format(2(1x,f8.3),366(1x,f9.0))
+ 401 format(2(1x,f8.3),366(1x,1pe10.3))
+ 1200 format(2(1x,f8.3),366(1x,f4.1))
+
+ return
+ end
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/hydro_remember.f b/couplage/CARAIB/ver01_Iv_couplage/hydro_remember.f
new file mode 100644
index 0000000..001423d
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/hydro_remember.f
@@ -0,0 +1,34 @@
+c=======================================================================
+c***********************************************************************
+ subroutine remember(drv)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c the derivatives and their back differences at previous time are saved.
+c=======================================================================
+c implicit double precision (a-h,o-z)
+ implicit none
+ include './com_18/parameter.common'
+ include './com_18/memory.common'
+ include './com_18/newbdo.common'
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer i,j
+ real*8 drv
+c
+c-----------------------------------------------
+ dimension drv(nequat)
+
+ do i = 1, nequat
+ olddrv(i) = drv(i)
+ enddo
+
+ do j = 1, norder-1
+ do i = 1, nequat
+ oldbdo(i,j) = bdo(i,j)
+ enddo
+ enddo
+ return
+ end subroutine remember
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/hydro_runkut4.f b/couplage/CARAIB/ver01_Iv_couplage/hydro_runkut4.f
new file mode 100644
index 0000000..c9e7299
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/hydro_runkut4.f
@@ -0,0 +1,45 @@
+c=======================================================================
+c***********************************************************************
+ subroutine runkut4(stept,time,y,drv)
+c***********************************************************************
+c=======================================================================
+c
+c implicit double precision (a-h,o-z)
+ implicit none
+ include './com_18/parameter.common'
+ include './com_18/rk.common'
+ real*4 stept,stept2
+
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer i
+ real*8 drv,time,tk1,tk3,y
+c
+c-----------------------------------------------
+
+ dimension y(nequat), drv(nequat)
+
+ stept2 = 0.5*stept
+ tk1 = time + stept2
+ do i = 1, nequat
+ yk1(i) = y(i) + stept2*drv(i)
+ enddo
+ call timdep(stept,tk1)
+ call givedrv(stept,tk1,yk1,drvk2)
+ do i = 1, nequat
+ yk2(i) = y(i) + stept2*drvk2(i)
+ enddo
+ call timdep(stept,tk1)
+ call givedrv(stept,tk1,yk2,drvk3)
+ tk3 = time + stept
+ do i = 1, nequat
+ yk3(i) = y(i) + stept*drvk3(i)
+ enddo
+ call timdep(stept,tk3)
+ call givedrv(stept,tk3,yk3,drvk4)
+ do i = 1, nequat
+ y(i) = y(i) + stept*(drv(i)+2.*(drvk2(i)+drvk3(i))+drvk4(i))/6.
+ enddo
+ return
+ end subroutine runkut4
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/hydro_set_frac.f b/couplage/CARAIB/ver01_Iv_couplage/hydro_set_frac.f
new file mode 100644
index 0000000..7cfffd6
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/hydro_set_frac.f
@@ -0,0 +1,206 @@
+c=======================================================================
+c***********************************************************************
+ subroutine set_frac(ngt)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c This routine reads the different environmental inputs as well
+c as vegetation characteristics and sets them in the right form.
+c=======================================================================
+
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/annee.common'
+ include './com_18/climin0.common'
+ include './com_18/climkop.common'
+ include './com_18/coord.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/eco.common'
+ include './com_18/ecoin.common'
+ include './com_18/ecopro.common'
+ include './com_18/envi.common'
+ include './com_18/fgr.common'
+ include './com_18/frac_change.common'
+ include './com_18/gridclim.common'
+ include './com_18/griddata.common'
+ include './com_18/gridin2.common'
+ include './com_18/input_par.common'
+ include './com_18/inidata.common'
+ include './com_18/landuse.common'
+ include './com_18/nspc.common'
+ include './com_18/prev_yr.common'
+ include './com_18/radcst.common'
+ include './com_18/smrd.common'
+ include './com_18/sr_par.common'
+ include './com_18/temper.common'
+ include './com_18/vegfr.common'
+ include './com_18/xlaic.common'
+
+ real*4 plant_lai, plant_fgrn, frc_tree
+ real*4 frc_trbsh
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer , intent(in) :: ngt
+
+ integer ip,k
+ real*4 err,permdpt,ta_yr
+
+c------------------------------------------------
+
+c=======================================================================
+c This subroutine sets vegetation fraction, LAI, albedo and emissivity
+c parameters, rooting depth and fsi,fci,wpi for IBM
+c=======================================================================
+
+c=======================================================================
+c sets vegetation fraction cover and LAI
+c frac(ip): vegetation fraction in each storey
+c frc(ip): fractional cover of vegetation class ip
+c fveg: fractional vegetation cover
+c=======================================================================
+ do ip = 1, npft
+ frac(ip) = yfrac_ini(ip,ngt)
+ xlmin(ip) = ylaimin_ini(ip,ngt)
+ xlmax(ip) = ylaimax_ini(ip,ngt)
+ plant_lai = ylaimax_ini(ip,ngt)
+ call fgrn_calc(plant_lai,plant_fgrn)
+ fgrnmax(ip) = plant_fgrn
+ xlaimax_prv(ip) = ylaimax_ini(ip,ngt)
+ end do
+
+ do ip = npft0+1, npft
+ frc(ip) = fgrnmax(ip)*frac(ip)
+ end do
+
+ frc_tree = 0.
+ do ip = nherb+nbush+1, npft0
+ frc(ip) = fgrnmax(ip)*frac(ip)
+ frc_tree = frc_tree+frc(ip)
+ end do
+ if (frc_tree.gt.frac_nat(ngt)) frc_tree = frac_nat(ngt)
+
+ do ip = 1, nherb+nbush
+ frc(ip) = (frac_nat(ngt)-frc_tree)*fgrnmax(ip)*frac(ip)
+ end do
+
+ fveg=0.
+ do ip =1,npft
+ fveg = fveg+frc(ip)
+ enddo
+
+ frc_trbsh=0.
+ do ip =nherb+1,npft0
+ frc_trbsh = frc_trbsh+frc(ip)
+ enddo
+
+ if(fveg.gt.1.) then
+ err = fveg-1.
+ if(err.gt.0.03)then
+ write(61,*) 'Error fveg:', fveg,ylongi,ylati
+ stop
+ endif
+ do ip=1,npft
+ frc(ip) = frc(ip)/fveg
+ enddo
+ fveg=1.
+ elseif(fveg.lt.0.) then
+ write(61,*) 'Error fveg:', fveg,ylongi,ylati
+ stop
+ endif
+
+c albv: albedo of vegetation cover
+c emiv: emissivity of vegetation cover
+c ---------------------------------------------------------------------
+ albv=0.
+ albwd=0.
+ emiv=0.
+ if(fveg.gt.0.)then
+ do ip=1,npft
+ albv = albv + 0.5 * (alvsw(ip)+alvlw(ip))
+ 1 * frc(ip)/fveg
+
+ emiv = emiv + emv(ip)*frc(ip)/fveg
+ enddo
+c do ip = nherb+nbush+1, npft0
+c
+c albwd = albwd + alvwd(ip)*frc(ip)/frc_tree
+c
+c enddo
+ else
+ albv=0.20
+ emiv=0.97
+ endif
+
+c if(frc_tree.gt.0.)then
+ if(frc_trbsh.gt.0.)then
+c do ip = nherb+nbush+1, npft0
+ do ip = nherb+1, npft0
+
+
+c albwd = albwd + alvwd(ip)*frc(ip)/frc_tree
+ albwd = albwd + alvwd(ip)*frc(ip)/frc_trbsh
+
+ enddo
+ else
+ albwd=0.12
+ endif
+
+
+c=======================================================================
+c sdens : Density of soil mineral particles (g m-3) (not used)
+c rootd : Rooting depth (mm)
+c fsi : Water saturation (mm)
+c fci : Field capacity (mm)
+c wpi : Wilting point (mm)
+c=======================================================================
+
+c sdens=(cla*2.52+sil*2.60+san*2.8) * 1.d+6
+
+ if(isunit.eq.4)then
+c lithosol: by convention rootd = 100 mm
+c ---------------------------------------------------------------------
+ rootd=500.
+ else
+c rooting depth: calculated on vegetated fraction only
+c ---------------------------------------------------------------------
+ if(fveg.gt.0.)then
+ rootd = 0.
+ do ip = 1, npft
+ rootd = rootd+frc(ip)*rdveg(ip)/fveg
+ enddo
+ else
+ rootd = 500.
+ endif
+ endif
+
+c correction of rooting depth for permafrost
+c rooting depth set to 580 mm in permafrost regions
+c ---------------------------------------------------------------------
+
+ ta_yr = 0.
+ permdpt = 580.
+ do k =1,nm
+ ta_yr=ta_yr+tcelkop(k)/float(nm)
+ enddo
+
+ drn_fac = 1.
+ if (ta_yr.lt.0.) then
+ if (rootd.gt.permdpt) rootd=permdpt
+ drn_fac = 0.1
+ endif
+
+c=======================================================================
+c saturation, field capacity and wilting point (mm)
+c=======================================================================
+
+ fsi=smfs*rootd
+ fci=smfc*rootd
+ wpi=smwp*rootd
+
+
+ return
+ end subroutine set_frac
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/hydro_timdep.f b/couplage/CARAIB/ver01_Iv_couplage/hydro_timdep.f
new file mode 100644
index 0000000..0c6d811
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/hydro_timdep.f
@@ -0,0 +1,109 @@
+c=======================================================================
+c***********************************************************************
+ subroutine timdep(stept,time)
+c***********************************************************************
+c=======================================================================
+c implicit double precision (a-h,o-z)
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/climin0.common'
+ include './com_18/climin.common'
+ include './com_18/coord.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/eco.common'
+ include './com_18/nspc.common'
+ include './com_18/solpar.common'
+ include './com_18/varnow.common'
+ include './com_18/varday.common'
+ include './com_18/vegfr.common'
+ include './com_18/xlaic.common'
+ real*4, intent(in) :: stept
+
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer idn,idn1,idn2,ih,ip,j,jh,ngf,ngf2,ny0
+
+ real*8 dn,strfac,tcor,tem1,tem2,time,tmin10,tnmin1,tnmin2,wacor
+ & ,wat10
+c
+c-----------------------------------------------
+
+
+ ny0 = int(time/float(nd)+0.000001)+1
+ dn = time - float(ny0-1) * float(nd)
+ idn=int(dn+1.00001)
+
+ preci=prc(idn)
+ temi=tcel(idn)
+ delti=tdiff(idn)
+ shi=sunhour(idn)
+ hai=rhu(idn)
+ windi=win(idn)
+
+ do ih=0,nh2
+ solg(ih) = solday(idn,ih)
+ ftrs(ih) = ftrday(idn,ih)
+ xmu(ih) = xmuday(idn,ih)
+ enddo
+
+ do ih=nh2+1,nh
+ jh = nh+1-ih
+ solg(ih) = solday(idn,jh)
+ ftrs(ih) = ftrday(idn,jh)
+ xmu(ih) = xmuday(idn,jh)
+ enddo
+
+
+c tmin10: average min. temp. of the last 2*ngf2 days
+c wat10 : average soil water of the last 2*ngf2 days
+c wat10 : average soil water of the last 2*ngf2 days
+c tem1 : average temp. of the last period of ngf2 days
+c tem2 : average temp. of the last but one period of ngf2 days
+c ----------------------------------------------------------------------
+
+ tem1 = 0.
+ tem2 = 0.
+ tmin10 = 0.
+ wat10 = 0.
+ ngf2 = 7
+ ngf = 2*ngf2
+ do j = 1,ngf2
+ idn1 = idn-j
+ if (idn1.le.0) idn1=idn1+nd
+ idn2 = idn1-ngf2
+ if (idn2.le.0) idn2=idn2+nd
+ tem1 = tem1+tcel(idn1)/ngf2
+ tem2 = tem2+tcel(idn2)/ngf2
+ tnmin1=tcel(idn1)-tdiff(idn1)/2.
+ tnmin2=tcel(idn2)-tdiff(idn2)/2.
+ tmin10 = tmin10 + (tnmin1+tnmin2)/ngf
+ wat10 = wat10 + (aswday(idn1)+aswday(idn2))/ngf
+ enddo
+
+c grflx : heat flux into the ground H [W m-2]
+c (Mintz and Walker, J. Appl. Met., 32, p. 1313, 1993)
+c ----------------------------------------------------------------------
+
+ grflx = 48.426 * (tem1-tem2) / (ngf2*stept)
+
+c plai(ip) : lai of plant type ip over grid cell igr
+c [m2/m2]
+c ----------------------------------------------------------------------
+
+ wacor = wat10/0.25
+ if (wacor.ge.1.)wacor=1.
+ if (wacor.le.0.)wacor=0.
+
+ do ip=1,npft
+ tcor = (tmin10-t1pft(ip))/(t2pft(ip)-t1pft(ip))
+ if (tcor.ge.1.)tcor=1.
+ if (tcor.le.0.)tcor=0.
+ strfac = min(wacor,tcor)
+ plai(ip)=xlmin(ip)+strfac*(xlmax(ip)-xlmin(ip))
+ enddo
+
+ return
+ end subroutine timdep
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/hydro_utils.f b/couplage/CARAIB/ver01_Iv_couplage/hydro_utils.f
new file mode 100644
index 0000000..a3ce0f0
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/hydro_utils.f
@@ -0,0 +1,234 @@
+c=======================================================================
+c***********************************************************************
+ subroutine tau(aa,bb,fnet,rdep,drk0,X0,XN,TAUI,NI)
+c***********************************************************************
+c=======================================================================
+
+ implicit none
+c implicit double precision (a-h,o-z)
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer, intent(in) :: ni
+ integer i,k,li
+
+ real*8, intent(in) :: aa,bb,fnet,rdep,drk0,X0,XN
+ real*8, intent(out) :: TAUI
+
+ real*8 den,fac,fx,h,sum,x
+c
+c-----------------------------------------------
+ LI=2*NI
+ H=(XN-X0)/FLOAT(LI)
+ SUM=0.
+ DO I=0,LI
+ K=2*INT((FLOAT(I)+0.01)/2.)
+ IF(K.NE.I)THEN
+ FAC=4.
+ ELSEIF((I.EQ.0).OR.(I.EQ.LI))THEN
+ FAC=1.
+ ELSE
+ FAC=2.
+ ENDIF
+ X=X0+FLOAT(I)*H
+ den = fnet-drk0*dexp(aa+bb/x)
+ if(dabs(den).gt.1.d-10)then
+ fx = rdep/den
+ else
+ fx = rdep/1.d-10
+ endif
+ SUM=SUM+FAC*FX
+ enddo
+ TAUI=SUM*H/3.
+ TAUI=dabs(TAUI)
+ RETURN
+ END subroutine tau
+
+c=======================================================================
+c***********************************************************************
+ subroutine polfit(xi,yi,ni,aj,ndeg,err,cj,sl)
+c***********************************************************************
+c=======================================================================
+
+c implicit double precision (a-h,o-z)
+ implicit none
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer, intent(in) :: ni,ndeg
+ integer i,j,k,nc,ne
+
+ real*8 differ,sum,xij,xik,yical,aj,err,sl,xi,yi,cj
+c
+c-----------------------------------------------
+
+ dimension xi(ni),yi(ni),aj(0:ndeg),cj(ndeg+1),sl(ndeg+1,ndeg+2)
+ ne=ndeg+1
+ nc=ndeg+2
+ do 100 k=1,ne
+ sum=0.
+ do 200 i=1,ni
+ call puiss(xi(i),k-1,xik)
+ sum=sum+xik*yi(i)
+ 200 continue
+ sl(k,nc)=sum
+ 100 continue
+ do 300 k=1,ne
+ do 400 j=1,ne
+ sum=0.
+ do 500 i=1,ni
+ call puiss(xi(i),k-1,xik)
+ call puiss(xi(i),j-1,xij)
+ sum=sum+xik*xij
+ 500 continue
+ sl(k,j)=sum
+ 400 continue
+ 300 continue
+ call gauss(ne,sl,cj)
+ do 600 j=0,ndeg
+ aj(j)=cj(j+1)
+ 600 continue
+ err=0.
+ do 700 i=1,ni
+ yical=aj(0)
+ do 800 j=1,ndeg
+ call puiss(xi(i),j,xij)
+ yical=yical+aj(j)*xij
+ 800 continue
+ differ=yical-yi(i)
+ err=err+differ*differ
+ 700 continue
+ return
+ end subroutine polfit
+c=======================================================================
+c***********************************************************************
+ subroutine puiss(x,k,xk)
+c***********************************************************************
+c=======================================================================
+
+c implicit double precision (a-h,o-z)
+ implicit none
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer, intent(in) :: k
+ integer :: i
+
+ real*8, intent(in) :: x
+ real*8, intent(out) :: xk
+c
+c-----------------------------------------------
+
+ xk=1.
+ if(k.le.0)goto 200
+ do 100 i=1,k
+ xk=xk*x
+ 100 continue
+ goto 400
+ 200 if(k.eq.0)goto 400
+ do 300 i=1,-k
+ xk=xk/x
+ 300 continue
+ 400 continue
+ return
+ end subroutine puiss
+
+
+c=======================================================================
+c***********************************************************************
+ subroutine gauss(ne,sl,x)
+c***********************************************************************
+c=======================================================================
+
+c implicit double precision (a-h,o-z)
+ implicit none
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer, intent(in) :: ne
+ integer jc,je,jr,nc
+
+ real*8 coeff1,diag,rsum,sl,x
+c
+c-----------------------------------------------
+
+ dimension sl(ne,ne+1),x(ne)
+c=======================================================================
+c Subroutine Gauss solves a system of simultaneous linear algebraic
+c equations by Gaussian elimination and back substitution.
+c The number of equations (equal to the number of unknowns) is ne.
+c The coefficients are in array sl(ne,ne+1), where the last
+c column is the constants on the right sides of the equations.
+c The answers are returned in the array x(ne).
+c=======================================================================
+ nc=ne+1
+ do 100 je=1,ne
+ diag=sl(je,je)
+ if(diag.eq.0.)call exch(ne,nc,je,sl,diag)
+ do 200 jc=je,nc
+ sl(je,jc)=sl(je,jc)/diag
+ 200 continue
+ do 300 jr=je+1,ne
+ coeff1=sl(jr,je)
+ do 400 jc=je,nc
+ sl(jr,jc)=sl(jr,jc)-sl(je,jc)*coeff1
+ 400 continue
+ 300 continue
+ 100 continue
+ x(ne)=sl(ne,nc)
+ do 500 je=ne-1,1,-1
+ rsum=0.
+ do 600 jc=je+1,nc-1
+ rsum=rsum+x(jc)*sl(je,jc)
+ 600 continue
+ x(je)=sl(je,nc)-rsum
+ 500 continue
+ return
+ end subroutine gauss
+
+
+
+c=======================================================================
+c***********************************************************************
+ subroutine init_c (y,ngt)
+c***********************************************************************
+c=======================================================================
+c implicit double precision (a-h,o-z)
+ implicit none
+ include './com_18/parameter.common'
+ include './com_18/climin.common'
+ include './com_18/coord.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/eco.common'
+ include './com_18/inidata.common'
+ include './com_18/monwat.common'
+ include './com_18/varday.common'
+c-----------------------------------------------
+c JLP ajouté pour implicit none
+c
+ integer idn,j,ngt
+ real*8 y
+c
+c-----------------------------------------------
+
+ dimension y(nequat)
+
+c=====================================================================72
+c Initial values for every grid points and hydrological reservoirs
+c=====================================================================72
+ do j=1,nres
+ y(j) = ywat_ini(j,ngt)
+ end do
+ if (y(1).lt.0.) y(1)=0.
+ if (y(2).lt.wpi) y(2)=wpi
+ if (y(2).gt.fsi) y(2)=fsi
+
+ do idn=1,nd
+ aswday(idn)= (y(2)-wpi)/(fci-wpi)
+ enddo
+
+ aswmin = 999.
+
+ return
+ end subroutine init_c
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_TDT.f b/couplage/CARAIB/ver01_Iv_couplage/mod_TDT.f
new file mode 100644
index 0000000..e53566a
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_TDT.f
@@ -0,0 +1,139 @@
+c=======================================================================
+c***********************************************************************
+ subroutine TDT(mlength,mondec,flag,tabrT,tabrDT,zone,seed)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c Subroutine for random estimation for temperatures
+c=======================================================================
+ IMPLICIT NONE
+ include './com_18/parameter.common'
+ include './com_18/pathg.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer kf
+c
+c-----------------------------------------------
+ real*4 tabrT(ndy),tabrDT(ndy)
+ real*4 seed,frnd,step
+ real*4 r
+ real*4 FT(300,2),FDT(300,2),xT(300),xDT(300),
+ & T1(31),DT1(31),sT,sDT
+
+c=======================================================================
+c F(k,1)=Fs(k),F(k,2)=Fp(k)
+c=======================================================================
+
+ integer j,m,k,kx,nl,nj,fl,mth
+ integer flag(ndy),mlength(nm),mondec(nm)
+
+c=======================================================================
+c flag=1 ==> il pleut flag=0 ==> il pleut pas.
+c=======================================================================
+
+ character*8 zone
+ character*110 filename
+ character*2 ch
+
+ logical lo
+
+ step=1.28345
+
+ call givnletters(zone,nl)
+ call charlen(pathgene,kf)
+
+ nj=0
+
+ do m=1,nm
+ mth=mondec(m)
+ call itochar2(mth,ch)
+ filename=pathgene(1:kf)//'ALLSTAT/TEMPER/FT/fT'
+ & //zone(1:nl)//ch
+ inquire(file=filename,EXIST=lo)
+ if(lo)then
+ goto 6
+ else
+ goto 20
+ endif
+6 continue
+ open(12,file=filename,status='old')
+ read(12,*)
+ read(12,*)
+ do k=1,300
+ read(12,10) xT(k),FT(k,1),FT(k,2)
+10 format(3(f8.5,1x))
+ enddo
+ close(12)
+ filename=pathgene(1:kf)//'ALLSTAT/TEMPER/FDT/fDT'
+ & //zone(1:nl)//ch
+ open(12,file=filename,status='old')
+ read(12,*)
+ read(12,*)
+ do k=1,300
+ read(12,10) xDT(k),FDT(k,1),FDT(k,2)
+ enddo
+ close(12)
+
+ sT=0.
+ sDT=0.
+ do j=1,mlength(m)
+
+ fl=flag(nj+j)+1
+ call randnum(seed,frnd)
+ r=0.995*frnd
+
+ kx=-1
+
+ do k=2,300
+ if((r.gt.FT(k-1,fl)).and.
+ & (r.le.FT(k,fl)))then
+ kx=k-1
+ endif
+ enddo
+ if(kx.eq.-1) then
+ kx=1
+ T1(j)=xT(kx)
+ else
+ T1(j)=xT(kx)+(r-FT(kx,fl))*(xT(kx+1)-xT(kx))
+ & /(FT(kx+1,fl)-FT(kx,fl))
+ endif
+ sT=sT+T1(j)
+ seed=seed+step
+ call randnum(seed,frnd)
+ r=0.995*frnd
+
+ kx=-1
+
+ do k=2,300
+ if((r.gt.FDT(k-1,fl)).and.
+ & (r.le.FDT(k,fl)))then
+ kx=k-1
+ endif
+ enddo
+
+ if(kx.eq.-1) then
+ kx=1
+ DT1(j)=xDT(kx)
+ else
+ DT1(j)=xDT(kx)+(r-FDT(kx,fl))*(xDT(kx+1)-xDT(kx))
+ & /(FDT(kx+1,fl)-FDT(kx,fl))
+ endif
+ sDT=sDT+DT1(j)
+ enddo
+ sT=sT/mlength(m)
+ sDT=sDT/mlength(m)
+
+ do j=1,mlength(m)
+ nj=nj+1
+ tabrT(nj)=T1(j)/sT
+ tabrDT(nj)=DT1(j)/sDT
+ enddo
+
+20 continue
+
+ enddo
+
+ return
+ end subroutine TDT
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_calrapportprecip.f b/couplage/CARAIB/ver01_Iv_couplage/mod_calrapportprecip.f
new file mode 100644
index 0000000..4f44f0e
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_calrapportprecip.f
@@ -0,0 +1,78 @@
+c=======================================================================
+c***********************************************************************
+ subroutine calrapportprecip(zone,month,r,rapportprecip)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c This subroutine calculates the value of precipitation ratio
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/pathg.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer kf
+c
+c-----------------------------------------------
+ real*4 x(2),y(2),valref(101),valobs(101),r,rapportprecip,
+ & rk
+
+ integer i,j,month,k
+
+ character*3 ch
+ character*8 zone
+ character*110 filename
+
+ logical flag
+
+ rapportprecip=0.0
+ if ((r.ge.0.0).and.(r.le.1.0)) then
+ call itochar2(month,ch)
+ j=1
+90 continue
+ if (zone(j:j).ne.' ') then
+ j=j+1
+ if (j.le.8) goto 90
+ endif
+ j=j-1
+ call charlen(pathgene,kf)
+ filename=pathgene(1:kf)//'ALLSTAT/PRECIP/'//
+ & zone(1:j)//'.'//ch
+ inquire(file=filename,EXIST=flag)
+ if(flag)then
+ open(11,file=filename,status='old')
+ do i=1,101
+ read(11,95) valref(i),valobs(i)
+ enddo
+ close(11)
+ else
+ valref(1)=0.0
+ valobs(1)=0.0
+ rk=-0.005
+ do k=2,100
+ rk=rk+0.01
+ valref(k)=rk
+ valobs(k)=rk
+ enddo
+ valref(101)=1.0
+ valobs(101)=1.0
+ endif
+ i=1
+91 i=i+1
+ if ((r.ge.valobs(i-1)).and.(r.le.valobs(i))) then
+ do j=1,2
+ x(j)=valref(i-2+j)
+ y(j)=valobs(i-2+j)
+ enddo
+ rapportprecip=(x(1)*y(2)+(x(2)-x(1))*r
+ & -x(2)*y(1))/(y(2)-y(1))
+ else
+ goto 91
+ endif
+ endif
+95 format (f8.3,f8.3)
+ return
+ end subroutine calrapportprecip
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_check_and_open_files.f b/couplage/CARAIB/ver01_Iv_couplage/mod_check_and_open_files.f
new file mode 100644
index 0000000..0403edc
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_check_and_open_files.f
@@ -0,0 +1,85 @@
+ SUBROUTINE CHECK_AND_OPEN_FILE(
+ & incdf, iunit, icyr, str_filext, kext, str_ext,
+ & str_ncfile_name, str_descript,
+ & str_ncvar_name,
+ & ncfile_id, ncvar_id)
+ IMPLICIT NONE
+
+ INTEGER, INTENT(IN) :: incdf
+ INTEGER, INTENT(IN) :: iunit
+ INTEGER, INTENT(IN) :: icyr
+ CHARACTER(LEN=*), INTENT(IN) :: str_filext
+ INTEGER, INTENT(IN) :: kext
+ CHARACTER(LEN=*), INTENT(IN) :: str_ext
+ CHARACTER(LEN=*), INTENT(IN) :: str_ncfile_name
+ CHARACTER(LEN=*), INTENT(IN) :: str_descript
+ CHARACTER(LEN=*), INTENT(IN) :: str_ncvar_name
+ INTEGER, INTENT(OUT) :: ncfile_id
+ INTEGER, INTENT(OUT) :: ncvar_id
+
+ CHARACTER(LEN=245) :: filename
+ LOGICAL :: l_fileexists = .FALSE.
+ INTEGER :: istatus
+
+
+c write(*,*)'filext: ', str_filext(1:kext)
+c write(*,*)' kext: ', kext
+
+
+
+ l_fileexists=.FALSE.
+ IF (icyr == 0) THEN
+ filename = TRIM(str_ncfile_name)
+ INQUIRE(FILE=filename, EXIST=l_fileexists)
+ ELSE
+ IF (incdf == 1) THEN
+ filename = TRIM(str_ncfile_name)//str_filext(1:kext)//'.nc'
+ INQUIRE(FILE=filename, EXIST=l_fileexists)
+ IF(.NOT.l_fileexists) THEN
+ filename = TRIM(str_ncfile_name)//str_filext(1:kext)//'.nc4'
+ INQUIRE(FILE=filename, EXIST=l_fileexists)
+ ENDIF
+ ELSE
+ filename =
+ & TRIM(str_ncfile_name)//str_filext(1:kext)//TRIM(str_ext)
+ INQUIRE(FILE=filename, EXIST=l_fileexists)
+ ENDIF
+ ENDIF
+
+ IF (.NOT. l_fileexists) THEN
+
+ WRITE(*,*) 'No file found for ' // TRIM(str_descript) // '!'
+ WRITE(*,*) 'Requested: "' // TRIM(str_ncfile_name) //'"'
+ WRITE(*,*) 'Tested "' // TRIM(str_ncfile_name) // '"'
+ IF (incdf == 1) THEN
+ WRITE(*,*) ' "' // TRIM(str_ncfile_name) //
+ & str_filext(1:kext) // '.nc' // '"'
+ WRITE(*,*) ' "' // TRIM(str_ncfile_name) //
+ & str_filext(1:kext) // '.nc4' // '"'
+ ELSE
+ WRITE(*,*) ' "' // TRIM(str_ncfile_name) //
+ & str_filext(1:kext) //TRIM(str_ext)
+ ENDIF
+ WRITE(*,*) 'without success -- aborting!'
+ CALL ABORT()
+
+ ELSE
+
+ IF (incdf == 1) THEN
+ istatus = NF_OPEN(filename, NF_NOWRITE, ncfile_id)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+
+ istatus = NF_INQ_VARID(ncfile_id, TRIM(str_ncvar_name),
+ & ncvar_id)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+ ELSE
+ OPEN(iunit,FILE=filename,STATUS='old')
+ ENDIF
+
+ ENDIF
+
+
+
+ END SUBROUTINE CHECK_AND_OPEN_FILE
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_clasparam.f b/couplage/CARAIB/ver01_Iv_couplage/mod_clasparam.f
new file mode 100644
index 0000000..87dff8d
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_clasparam.f
@@ -0,0 +1,157 @@
+c=======================================================================
+c***********************************************************************
+ subroutine clasparam
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c reads or computes various age classes parameters
+c=======================================================================
+ IMPLICIT NONE
+
+ include './com_18/parameter.common'
+ include './com_18/ageclas.common'
+ include './com_18/files_car.common'
+ include './com_18/nspc.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer iclas,icyearplus,ip
+ real*4 frac_clas_tot
+c
+c-----------------------------------------------
+
+ character*50 title,pft_name(nplant)
+ character*132 sdata
+
+c=======================================================================
+c open reading file
+c=======================================================================
+
+ open(111,file=fileclaspar)
+ read(111,*)title
+
+c=======================================================================
+c loop over BAG's
+c=======================================================================
+
+ do ip = 1, npft
+
+c=======================================================================
+c initialisation:
+c icyear_min = minimum age of a plant for this class
+c icyear_max = maximum age of a plant for this class
+c icyear_mean = mean age of a plant for this class
+c icyearplus = maximum age of the last class
+c nclas = number of age classes for this BAG
+c nlcas_max = maximum number of age classes (6)
+c frac_clas0 = fraction of the pixel for each age class
+c (intital value, it will be calculated by CARAIB
+c for following years)
+c=======================================================================
+
+ do iclas = 1, nclas_max
+ icyear_min(ip,iclas) = -1
+ icyear_mean(ip,iclas) = -1
+ icyear_max(ip,iclas) = -1
+ end do
+ icyearplus = -1
+ nclas(ip) = 1
+
+ frac_clas0(ip,1) = 1.
+ do iclas = 2, nclas_max
+ frac_clas0(ip,iclas) = 0.
+ end do
+
+c=======================================================================
+c reading of data
+c=======================================================================
+
+ read(111,127) pft_name(ip),sdata
+ read(sdata,*) nclas(ip),(icyear_min(ip,iclas),iclas=1,nclas_max)
+ & ,icyearplus
+
+c=======================================================================
+c test the data readed:
+c icyear_min has to be greater than 0 for each of the existing
+c classes (nclas(ip))
+c icyearplus maximum age has to be greater than the minimum age
+c of the first class
+c=======================================================================
+
+ do iclas = 1,nclas(ip)
+ if(icyear_min(ip,iclas).le.0) then
+ write(61,*) 'error minimum year is nul or negative, bag:',ip,
+ & 'clas:',iclas,'value:',icyear_min(ip,iclas)
+ stop
+ endif
+ end do
+
+ if(icyearplus.lt.icyear_min(ip,1)) icyearplus = icyear_min(ip,1)
+
+c=======================================================================
+c calculating other data relative to age classes
+c=======================================================================
+
+ do iclas = 1, nclas(ip)-1
+ icyear_max(ip,iclas) = icyear_min(ip,iclas+1) - 1
+ end do
+ icyear_max(ip,nclas(ip)) = icyearplus
+
+ do iclas = 1, nclas(ip)
+ icyear_mean(ip,iclas) = icyear_min(ip,iclas)
+ & + int((icyear_max(ip,iclas)-icyear_min(ip,iclas))/2.)
+ end do
+
+c=======================================================================
+c test the calculated data:
+c icyear_mean have to be greater than 0
+c icyear_max have to be greater than 0 and than icyear_min
+c=======================================================================
+
+ do iclas = 1, nclas(ip)
+
+ if(icyear_max(ip,iclas).lt.icyear_min(ip,iclas)) then
+ write(61,*)'error, maximum age little than minimum age, ip:',
+ & ip,'iclas:',iclas,icyear_min(ip,iclas),icyear_max(ip,iclas)
+ stop
+ endif
+
+ if(icyear_max(ip,iclas).le.0) then
+ write(61,*) 'error maximum year is nul or negative, bag:',ip,
+ & 'clas:',iclas,'value:',icyear_max(ip,iclas)
+ stop
+ endif
+ if(icyear_mean(ip,iclas).le.0) then
+ write(61,*) 'error mean year is nul or negative, bag:',ip,
+ & 'clas:',iclas,'value:',icyear_mean(ip,iclas)
+ stop
+ endif
+ end do
+
+c=======================================================================
+c initial pixel faction: frac_clas0
+c=======================================================================
+
+ frac_clas_tot = 0.
+ do iclas = 1, nclas(ip)
+ frac_clas0(ip,iclas) =
+ & float(icyear_max(ip,iclas)-(icyear_min(ip,iclas)-1))
+ frac_clas_tot = frac_clas_tot + frac_clas0(ip,iclas)
+ end do
+
+ do iclas = 1, nclas(ip)
+ if(frac_clas_tot.le.0.) then
+ frac_clas0(ip,iclas) = 0.
+ else
+ frac_clas0(ip,iclas) = frac_clas0(ip,iclas) / frac_clas_tot
+ endif
+ end do
+ end do
+
+127 format(a50,a40)
+
+ close(111)
+
+ return
+ end subroutine clasparam
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_close_file.f b/couplage/CARAIB/ver01_Iv_couplage/mod_close_file.f
new file mode 100644
index 0000000..c1ff438
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_close_file.f
@@ -0,0 +1,339 @@
+c=======================================================================
+c***********************************************************************
+ subroutine close_file(iread)
+c***********************************************************************
+
+ USE MOD_NETCDFCARAIB
+
+c=======================================================================
+ IMPLICIT NONE
+ include './com_18/parameter.common'
+ include './com_18/annee.common'
+ include './com_18/cte.common'
+ include './com_18/fileunits.common'
+ include './com_18/icyr.common'
+ include './com_18/iprt.common'
+ include './com_18/management.common'
+ include './com_18/netcdf_par.common'
+ include './com_18/nspc.common'
+ include './com_18/prt_ctrl.common'
+
+c// BEGIN
+ CHARACTER(LEN=*), PARAMETER :: fn_caraib = __FILE__
+c// END
+
+ integer iread
+ INTEGER :: istatus
+
+ close(1)
+
+ CALL CLSFILE(incdf_tem, iunit_tema, ncid_filtema)
+c close(2)
+c// BEGIN
+cc istatus = NF_CLOSE(ncid_filtema)
+cc IF (istatus /= NF_NOERR)
+cc & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c// END
+ CALL CLSFILE(incdf_dta, iunit_dtaa, ncid_fildtaa)
+c close(3)
+c// BEGIN
+cc istatus = NF_CLOSE(ncid_fildtaa)
+cc IF (istatus /= NF_NOERR)
+cc & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c// END
+ CALL CLSFILE(incdf_dtb, iunit_dtba, ncid_fildtba)
+c// BEGIN
+cc istatus = NF_CLOSE(ncid_fildtba)
+cc IF (istatus /= NF_NOERR)
+cc & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c// END
+ CALL CLSFILE(incdf_prc, iunit_prca, ncid_filprca)
+c close(4)
+c// BEGIN
+cc istatus = NF_CLOSE(ncid_filprca)
+cc IF (istatus /= NF_NOERR)
+cc & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c// END
+ CALL CLSFILE(incdf_shi, iunit_shia, ncid_filshia)
+c close(7)
+c close(8)
+c// BEGIN
+cc istatus = NF_CLOSE(ncid_filshia)
+cc IF (istatus /= NF_NOERR)
+cc & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c// END
+ CALL CLSFILE(incdf_rhu, iunit_rhua, ncid_filrhua)
+c// BEGIN
+cc istatus = NF_CLOSE(ncid_filrhua)
+cc IF (istatus /= NF_NOERR)
+cc & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c// END
+ CALL CLSFILE(incdf_win, iunit_wina, ncid_filwina)
+c// BEGIN
+cc istatus = NF_CLOSE(ncid_filwina)
+cc IF (istatus /= NF_NOERR)
+cc & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c// END
+ close(10)
+
+ if(iclim_cal.eq.1) then
+
+ CALL CLSFILE(incdf_tem, iunit_temb, ncid_filtemb)
+c close(222)
+c// BEGIN
+cc istatus = NF_CLOSE(ncid_filtemb)
+cc IF (istatus /= NF_NOERR)
+cc & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c// END
+ CALL CLSFILE(incdf_dta, iunit_dtab, ncid_fildtab)
+c close(333)
+c// BEGIN
+cc istatus = NF_CLOSE(ncid_fildtab)
+cc IF (istatus /= NF_NOERR)
+cc & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c// END
+ CALL CLSFILE(incdf_dtb, iunit_dtbb, ncid_fildtbb)
+c// BEGIN
+cc istatus = NF_CLOSE(ncid_fildtbb)
+cc IF (istatus /= NF_NOERR)
+cc & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c// END
+ CALL CLSFILE(incdf_prc, iunit_prcb, ncid_filprcb)
+c close(444)
+c// BEGIN
+cc istatus = NF_CLOSE(ncid_filprcb)
+cc IF (istatus /= NF_NOERR)
+cc & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c// END
+ CALL CLSFILE(incdf_shi, iunit_shib, ncid_filshib)
+c close(777)
+c close(888)
+c// BEGIN
+cc istatus = NF_CLOSE(ncid_filshib)
+cc IF (istatus /= NF_NOERR)
+cc & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c// END
+ CALL CLSFILE(incdf_rhu, iunit_rhub, ncid_filrhub)
+c// BEGIN
+cc istatus = NF_CLOSE(ncid_filrhub)
+cc IF (istatus /= NF_NOERR)
+cc & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c// END
+ CALL CLSFILE(incdf_win, iunit_winb, ncid_filwinb)
+c// BEGIN
+c close(999)
+cc istatus = NF_CLOSE(ncid_filwinb)
+cc IF (istatus /= NF_NOERR)
+cc & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c// END
+ endif
+
+ if (nyear.eq.1) then
+ if (ifrac_rd.ge.1) close(20)
+ if (ilai_rd.ge.1) close(21)
+ if (imig_rd.eq.1) then
+ close(176)
+ close(177)
+ close(178)
+ endif
+ endif
+
+
+ close(23)
+ if (nyear.eq.1) then
+ if (iread.ge.1) then
+ close(25)
+ close(125)
+ if(ncrop.gt.0) close(525)
+ close(225)
+ close(325)
+ endif
+ if ((ifrac_rd.ge.1).and.(icyr_landuse.ne.0)) then
+ if (ilu.eq.1) close(425)
+ endif
+ endif
+
+
+ close(26)
+ close(126)
+ close(526)
+ close(226)
+ close(326)
+c if (ifrac.eq.1) then
+ if(iprt_frac .eq. 1) close(60)
+c endif
+ if(iprt_laimin .eq. 1) close(64)
+
+c beginning of if statement on iyprt
+ if (iyprt.ge.1) then
+
+ if(iprt_yr .eq. 1) close(30)
+ if(iprt_frc .eq. 1) close(530)
+ if(iprt_sw .eq. 1) close(31)
+ if(iprt_swmm .eq. 1) close(531)
+ if(iprt_rtr .eq. 1) close(532)
+ if(iprt_pet .eq. 1) close(32)
+ if(iprt_aet .eq. 1) close(33)
+ if(iprt_run .eq. 1) close(34)
+ if(iprt_fsn .eq. 1) close(35)
+ if(iprt_snd .eq. 1) close(535)
+ if(iprt_srun .eq. 1) close(536)
+ if(iprt_drn .eq. 1) close(36)
+ if(iprt_sve .eq. 1) close(37)
+ if(iprt_eint .eq. 1) close(537)
+ if(iprt_etr .eq. 1) close(538)
+ if(iprt_eso .eq. 1) close(539)
+ if(iprt_rbl .eq. 1) close(38)
+ if(iprt_alb .eq. 1) close(39)
+ if(iprt_albsv .eq. 1) close(239)
+ if(iprt_albs .eq. 1) close(339)
+ if(iprt_albv .eq. 1) close(439)
+ if(iprt_rn .eq. 1) close(40)
+ if(iprt_grf .eq. 1) close(41)
+ if(iprt_ts .eq. 1) close(42)
+ if(iprt_fgs .eq. 1) close(43)
+ if(iprt_lai .eq. 1) close(44)
+ if(iprt_fird .eq. 1) close(45)
+ if(iprt_xh .eq. 1) close(46)
+ if(iprt_xle .eq. 1) close(47)
+ if(iprt_sol .eq. 1) close(48)
+ if(iprt_sf .eq. 1) close(49)
+ if(iprt_sne .eq. 1) close(50)
+ if(iprt_sml .eq. 1) close(51)
+ if(iprt_emi .eq. 1) close(52)
+ if(iprt_emins .eq. 1) close(152)
+ if(iprt_z0 .eq. 1) close(252)
+
+ if(iprt_biomm .eq. 1) close(55)
+ if(iprt_gppm .eq. 1) close(56)
+ if(iprt_ram .eq. 1) close(556)
+ if(iprt_nppm .eq. 1) close(57)
+ if(iprt_nepm .eq. 1) close(58)
+ if(iprt_rhm .eq. 1) close(558)
+ if(iprt_laim .eq. 1) close(59)
+ if(iprt_emifirem .eq. 1) close(559)
+ if(iprt_emiblitm .eq. 1) close(560)
+ if(iprt_nbpm .eq. 1) close(561)
+ if ((imanag.eq.1).or.(ncrop.gt.0)) then
+ if(iprt_harvm .eq. 1) close(562)
+ endif
+
+ if(iprt_faparm .eq. 1) close(98)
+
+
+c if(iprt_nppf .eq. 1) close(62)
+ if(iprt_Rmin .eq. 1) close(63)
+ if(iprt_gpp .eq. 1) close(65)
+ if(iprt_raf .eq. 1) close(565)
+ if(iprt_emifiref .eq. 1) close(665)
+ if(iprt_Cveg .eq. 1) close(66)
+ if(iprt_Csoil .eq. 1) close(67)
+ if(iprt_frcC13 .eq. 1) close(68)
+ if(iprt_laimoy .eq. 1) close(69)
+ if(iprt_Tdmin .eq. 1) close(70)
+ if(iprt_Tmmin .eq. 1) close(71)
+ if(iprt_gdd .eq. 1) close(72)
+ if (ifire.eq.1) then
+ if(iprt_fire .eq. 1) close(73)
+ if(iprt_fburn .eq. 1) close(74)
+ if(iprt_aburn .eq. 1) close(75)
+ if(iprt_yfnoburn .eq. 1) close(83)
+ endif
+ if(iprt_ftomin .eq. 1) close(84)
+ if(iprt_ftotw .eq. 1) close(85)
+ if(iprt_ftot .eq. 1) close(86)
+
+ if (ifrac.eq.1) then
+ if(iprt_Fgdd5 .eq. 1) close(87)
+ if(iprt_FTmmin .eq. 1) close(88)
+ if(iprt_Fwatmin .eq. 1) close(89)
+ endif
+ if (imig.eq.1) then
+ if(iprt_prop .eq. 1) close(76)
+ if(iprt_side .eq. 1) close(77)
+ if(iprt_pres .eq. 1) close(78)
+ endif
+ if ((imanag.eq.1).or.(ncrop.gt.0)) then
+ if (iprt_harv.eq.1) close(79)
+ endif
+ if (ncrop.gt.0) then
+ if(iprt_yield .eq. 1) close(880)
+ endif
+ if(iprt_agbiom .eq. 1) close(881)
+ if(iprt_bgbiom .eq. 1) close(882)
+ if (ncrop.gt.0) then
+ if(iprt_mat .eq. 1) close(883)
+ endif
+ if (ilu.eq.1) then
+ if (iprt_lucdfr.eq.1) close(251)
+ if (iprt_lucflx.eq.1) close(252)
+ endif
+
+c end of if statement on iyprt
+ endif
+
+ if(iprt_nppf .eq. 1) close(62)
+
+c if (ifrac.eq.1) then
+c if(iprt_yfnoburn .eq. 1) close(83)
+c if(iprt_ftot .eq. 1) close(86)
+c endif
+
+cc if (imig.eq.1) then
+c if(iprt_Fgdd5 .eq. 1) close(87)
+c if(iprt_FTmmin .eq. 1) close(88)
+c if(iprt_Fwatmin .eq. 1) close(89)
+cc endif
+
+ if (imanag.eq.1) close(92)
+ if (ifire.eq.1) close(93)
+
+ if (ilu.eq.1) then
+ close(94)
+ if (ilusp_rd.eq.1)close(194)
+ if (isowd_rd.eq.1)close(294)
+ if (icvar_rd.eq.1)close(295)
+ endif
+
+ if (imig.eq.1) then
+ close(95)
+ close(96)
+ endif
+
+ if (igtyp.eq.1) close(97)
+
+ if (ipr_clim.ne.0) then
+ if (iprt_tem.ne.0)close(502)
+ if (iprt_dte.ne.0)close(503)
+ if (iprt_prc.ne.0)close(504)
+ if (iprt_shr.ne.0)close(507)
+ if (iprt_rhu.ne.0)close(508)
+ if (iprt_win.ne.0)close(509)
+ endif
+
+ return
+
+ CONTAINS
+
+ SUBROUTINE CLSFILE(incdf, iunit, ncfile_id)
+ IMPLICIT NONE
+
+ INTEGER, INTENT(IN) :: incdf
+ INTEGER, INTENT(IN) :: iunit
+ INTEGER, INTENT(IN) :: ncfile_id
+
+ INTEGER :: istatus
+
+ if (incdf.eq.1) then
+c// BEGIN
+ istatus = NF_CLOSE(ncfile_id)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c// END
+ else
+ close(iunit)
+ endif
+
+ END SUBROUTINE CLSFILE
+
+ end SUBROUTINE close_file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_close_mig.f b/couplage/CARAIB/ver01_Iv_couplage/mod_close_mig.f
new file mode 100644
index 0000000..73f499d
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_close_mig.f
@@ -0,0 +1,26 @@
+c=======================================================================
+c***********************************************************************
+ subroutine close_mig
+c***********************************************************************
+c=======================================================================
+ IMPLICIT NONE
+
+ include './com_18/annee.common'
+ include './com_18/cte.common'
+ include './com_18/iprt.common'
+ include './com_18/prt_ctrl.common'
+
+c close(14)
+c close(19)
+
+ if(iprt_nppf .eq. 1) close(62)
+
+ if(iprt_yfnoburn .eq. 1) close(83)
+ if(iprt_ftot .eq. 1) close(86)
+
+ if(iprt_Fgdd5 .eq. 1) close(87)
+ if(iprt_FTmmin .eq. 1) close(88)
+ if(iprt_Fwatmin .eq. 1) close(89)
+
+ return
+ end subroutine close_mig
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_crop_sowing_dates.f b/couplage/CARAIB/ver01_Iv_couplage/mod_crop_sowing_dates.f
new file mode 100644
index 0000000..1b953d2
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_crop_sowing_dates.f
@@ -0,0 +1,38 @@
+c=======================================================================
+c***********************************************************************
+ subroutine crop_sowing_dates
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c This routine reads or evaluates sowing dates for crops
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/climin0.common'
+ include './com_18/climin.common'
+ include './com_18/coord.common'
+ include './com_18/cte.common'
+ include './com_18/crops.common'
+ include './com_18/gddpix.common'
+ include './com_18/gene.common'
+ include './com_18/monthcst.common'
+ include './com_18/nspc.common'
+ include './com_18/prt_ctrl.common'
+ include './com_18/pzone.common'
+ include './com_18/snow.common'
+ include './com_18/temper.common'
+
+ integer i
+ real*4 aaa,bbb
+
+ if (isowd_rd.eq.1) then
+ do i = 1, npft
+ sow_date(i)=-999.
+ end do
+ read(294,*)aaa,bbb,(sow_date(i),i=npft0+1,npft0+ncrop)
+ endif
+
+ return
+ end subroutine crop_sowing_dates
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_crops_seas.f b/couplage/CARAIB/ver01_Iv_couplage/mod_crops_seas.f
new file mode 100644
index 0000000..5295d75
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_crops_seas.f
@@ -0,0 +1,74 @@
+c=======================================================================
+c***********************************************************************
+ subroutine crops_seas
+c***********************************************************************
+c=======================================================================
+ IMPLICIT NONE
+c=======================================================================
+c reads or computes various age classes parameters
+c=======================================================================
+
+ include './com_18/parameter.common'
+ include './com_18/files_car.common'
+ include './com_18/nspc.common'
+ include './com_18/crops.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer ip
+c
+c-----------------------------------------------
+
+ integer ivar
+ real carb_ratio(nplant)
+ character*50 title,pft_name(nplant)
+ character*132 sdata
+
+c=======================================================================
+c open reading file
+c=======================================================================
+
+ open(112,file=fileseas)
+ read(112,*)title
+
+c=======================================================================
+c loop over BAG's
+c=======================================================================
+
+ do ip = 1, npft
+
+c=======================================================================
+c reading of data
+c=======================================================================
+c write(*,*)'open crop_seas'
+ read(112,128) pft_name(ip),sdata
+ read(sdata,*) sow_date(ip),tbase(ip),gdd_germ(ip),gdd_harv(ip)
+ & ,gr_seas(ip),fL_harv(ip),fS_harv(ip),fR_harv(ip)
+ & ,harv_ind(ip),wc_harv(ip),carb_ratio(ip)
+c write (*,*)'read crop_seas',harv_ind(2)
+
+ if (fL_harv(ip).gt.1.) fL_harv(ip) = 1.
+ if (fL_harv(ip).lt.0.) fL_harv(ip) = 0.
+ if (fS_harv(ip).gt.1.) fS_harv(ip) = 1.
+ if (fS_harv(ip).lt.0.) fS_harv(ip) = 0.
+ if (fR_harv(ip).gt.1.) fR_harv(ip) = 1.
+ if (fR_harv(ip).lt.0.) fR_harv(ip) = 0.
+
+ yield_fac(ip) =
+ &(0.01*(carb_ratio(ip))*harv_ind(ip))/(1.-0.01*wc_harv(ip))
+
+ end do
+
+c do ivar = 2, ncropvar
+c read(112,128) pft_name(ip),sdata
+c read(sdata,*) sow_date(1),tbase(1),gdd_germ(1),gdd_harv(ivar)
+c & ,gr_seas(1),fL_harv(1),fS_harv(1),fR_harv(1)
+c & ,harv_ind(1),wc_harv(1)
+c end do
+
+128 format(a50,a110)
+
+ close(112)
+
+ return
+end subroutine crops_seas
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_ctgen.f b/couplage/CARAIB/ver01_Iv_couplage/mod_ctgen.f
new file mode 100644
index 0000000..70b0f27
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_ctgen.f
@@ -0,0 +1,69 @@
+c=======================================================================
+c***********************************************************************
+ subroutine ctgen
+c***********************************************************************
+c=======================================================================
+c=======================================================================
+c reads constants for weather generator and 'sets' them in commons
+c variables declaration
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/lstz.common'
+ include './com_18/lstcli.common'
+ include './com_18/lstreg.common'
+
+
+c=======================================================================
+c climatic zones lists
+c=======================================================================
+ data listezone/'A1Af', 'A2Af', 'A3Af', 'A4Af', 'A1Am',
+ & 'A2Am', 'A3Am', 'A4Am', 'A1Aw', 'A2Aw',
+ & 'A3Aw', 'A4Aw', 'A1As', 'A2As', 'A3As',
+ & 'A4As', 'B1Bwh','B2Bwhprh','B2Bwhprs','B3Bwhprh',
+ & 'B3Bwhprs', 'B4Bwh', 'B5Bwh', 'B6Bwh', 'B1Bwk',
+ & 'B2Bwkprh','B2Bwkprs','B3Bwkprh','B3Bwkprs', 'B4Bwk',
+ & 'B5Bwk', 'B6Bwk', 'B1Bsh','B2Bshprh','B2Bshprs',
+ & 'B3Bshprh','B3Bshprs', 'B4Bsh', 'B5Bsh', 'B6Bsh',
+ & 'B1Bsk','B2Bskprh','B2Bskprs','B3Bskprh','B3Bskprs',
+ & 'B4Bsk', 'B5Bsk', 'B6Bsk', 'C1Cfa', 'C2Cfa',
+ & 'C3Cfaprh','C3Cfaprs', 'C4Cfa', 'C5Cfa', 'C6Cfa',
+ & 'C1Cfb', 'C2Cfb','C3Cfbprh','C3Cfbprs', 'C4Cfb',
+ & 'C5Cfb', 'C6Cfb', 'C1Cfc', 'C2Cfc','C3Cfcprh',
+ & 'C3Cfcprs', 'C4Cfc', 'C5Cfc', 'C6Cfc', 'C1Cfd',
+ & 'C2Cfd','C3Cfdprh','C3Cfdprs', 'C4Cfd', 'C5Cfd',
+ & 'C6Cfd', 'C1Cwa', 'C2Cwa','C3Cwaprh','C3Cwaprs',
+ & 'C4Cwa', 'C5Cwa', 'C6Cwa', 'C1Cwb', 'C2Cwb',
+ & 'C3Cwbprh','C3Cwbprs', 'C4Cwb', 'C5Cwb', 'C6Cwb',
+ & 'C1Cwc', 'C2Cwc','C3Cwcprh','C3Cwcprs', 'C4Cwc',
+ & 'C5Cwc', 'C6Cwc', 'C1Cwd', 'C2Cwd','C3Cwdprh',
+ & 'C3Cwdprs', 'C4Cwd', 'C5Cwd', 'C6Cwd', 'C1Csa',
+ & 'C2Csa','C3Csaprh','C3Csaprs', 'C4Csa', 'C5Csa',
+ & 'C6Csa', 'C1Csb', 'C2Csb','C3Csbprh','C3Csbprs',
+ & 'C4Csb', 'C5Csb', 'C6Csb', 'C1Csc', 'C2Csc',
+ & 'C3Cscprh','C3Cscprs', 'C4Csc', 'C5Csc', 'C6Csc',
+ & 'C1Csd', 'C2Csd','C3Csdprh','C3Csdprs', 'C4Csd',
+ & 'C5Csd', 'C6Csd', 'D1Dfa', 'D2Dfa', 'D3Dfa',
+ & 'D1Dfb', 'D2Dfb', 'D3Dfb', 'D1Dfc', 'D2Dfc',
+ & 'D3Dfc', 'D1Dfd', 'D2Dfd', 'D3Dfd', 'D1Dwa',
+ & 'D2Dwa', 'D3Dwa', 'D1Dwb', 'D2Dwb', 'D3Dwb',
+ & 'D1Dwc', 'D2Dwc', 'D3Dwc', 'D1Dwd', 'D2Dwd',
+ & 'D3Dwd', 'D1Dsa', 'D2Dsa', 'D3Dsa', 'D1Dsb',
+ & 'D2Dsb', 'D3Dsb', 'D1Dsc', 'D2Dsc', 'D3Dsc',
+ & 'D1Dsd', 'D2Dsd', 'D3Dsd', 'E1ET', 'E2ET',
+ & 'E3ET', 'E4ET', 'E1EF', 'E2EF', 'E3EF',
+ & 'E4EF'/
+
+ data climatslst / 'Af', 'Am', 'Aw', 'As','Bwh','Bwk','Bsh','Bsk',
+ & 'Cfa','Cfb','Cfc','Cfd','Cwa','Cwb','Cwc','Cwd',
+ & 'Csa','Csb','Csc','Csd','Dfa','Dfb','Dfc','Dfd',
+ & 'Dwa','Dwb','Dwc','Dwd','Dsa','Dsb','Dsc','Dsd',
+ & 'ET', 'EF'/
+
+ data reg /'A','A','A','A','B','B','B','B','C','C','C','C','C','C',
+ & 'C','C','C','C','C','C','D','D','D','D','D','D','D','D',
+ & 'D','D','D','D','E','E'/
+
+ return
+ end subroutine ctgen
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_cth2o.f b/couplage/CARAIB/ver01_Iv_couplage/mod_cth2o.f
new file mode 100644
index 0000000..61eaa02
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_cth2o.f
@@ -0,0 +1,527 @@
+c=======================================================================
+c***********************************************************************
+ subroutine cth2o
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c reads constants and 'sets' them in commons
+c variables declaration
+c=======================================================================
+c implicit double precision (a-h,o-z)
+ IMPLICIT NONE
+ include './com_18/parameter.common'
+ include './com_18/climin0.common'
+ include './com_18/cte.common'
+ include './com_18/cstpi.common'
+ include './com_18/c3en.common'
+ include './com_18/c3cst.common'
+ include './com_18/c4cst.common'
+ include './com_18/cstmort.common'
+ include './com_18/deltac13.common'
+ include './com_18/down_reg.common'
+ include './com_18/ecopro.common'
+ include './com_18/envi.common'
+ include './com_18/estab.common'
+ include './com_18/files_car.common'
+ include './com_18/files_ibm.common'
+ include './com_18/firevpar.common'
+ include './com_18/gama.common'
+ include './com_18/gk.common'
+ include './com_18/griddata.common'
+ include './com_18/hcst.common'
+ include './com_18/h2ocst.common'
+ include './com_18/init.common'
+ include './com_18/input_par.common'
+ include './com_18/lai.common'
+ include './com_18/laiste.common'
+ include './com_18/monthcst.common'
+ include './com_18/monthcst2.common'
+ include './com_18/nspc.common'
+ include './com_18/pho_sch.common'
+ include './com_18/plant_evol.common'
+ include './com_18/plheight.common'
+ include './com_18/prt.common'
+ include './com_18/radcst.common'
+ include './com_18/rblcst1.common'
+ include './com_18/solpar.common'
+ include './com_18/sresp.common'
+ include './com_18/temper.common'
+ include './com_18/textcst1.common'
+ include './com_18/tresh.common'
+ include './com_18/veglab.common'
+ include './com_18/xlaic.common'
+
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer ip,ipft,iphen,ipool,k,m
+ real*4 csurn,disds,exc2,exc3,gkres,gkres0,rholeaf,steplai,tauleaf
+cIngrid201806-aNitr
+ & ,vcm0fac,xkainv,z0s,aNitr
+c
+c-----------------------------------------------
+
+ dimension csurn(nplant,npool)
+ character*50 title
+ character*132 sdata
+
+c data mdur /31,28,31,30,31,30,31,31,30,31,30,31/
+
+ nsyr = 0
+
+c=======================================================================
+c reads PFT parameters :
+c alvsw and alvlw : short and long wave albedos
+c zzra : reference height for wind measurements
+c rdveg : rooting depth of vegetation
+c t1 and t2 : temperatures for beginning and end of LAI increase
+c xlmin and xlmax : minimal and maximal LAI values before t1 and
+c after t2
+c=======================================================================
+
+ open(13,file=filbagibm,status='old')
+ read(13,*)title
+ do ip = 1, npft
+ read(13,133)pft_name(ip),sdata
+ read(sdata,*)alvsw(ip),alvlw(ip),rdveg(ip),t1pft(ip),t2pft(ip)
+ & ,xlmin(ip),xlmax(ip),z0vw(ip),z0vs(ip),disd(ip)
+ & ,zzra(ip),emv(ip),wai(ip),alvwd(ip)
+
+ enddo
+c133 format(a53,a80)
+133 format(a53,a132)
+ close(13)
+
+c=======================================================================
+c reads PFT tolerance parameters
+c=======================================================================
+ open(14,file=filebagtol)
+ read(14,*)title
+ do ip = 1, npft
+ read(14,125) pft_name(ip),sdata
+ read(sdata,*)ipft,ic4(ip),idec(ip),ttreshi1(ip),
+ & ttreshi2(ip),ttresha1(ip),ttresha2(ip),
+ & wattresh1(ip),wattresh2(ip),xpar_tresh1(ip),
+ & xpar_tresh2(ip),gdd_est(ip),tcmax_est(ip),
+ & watmax_est(ip),pgerm(ip),bag_h(ip)
+ if(watmax_est(ip).le.0.) then
+ write(61,*) 'attention this BAG will never exist',ip
+ stop
+ endif
+ enddo
+
+125 format(a50,a132)
+ close(14)
+
+c=======================================================================
+c reads or computes various PFT parameters
+c=======================================================================
+ open(15,file=filebagpar)
+ read(15,*)title
+ do ip = 1, npft
+ read(15,126) pft_name(ip),sdata
+ read(sdata,*)g0(ip),g1(ip),splai(ip),delc2(ip),
+ & xip(ip,1),xip(ip,2),rese_frac(ip),xkainv,
+ & rootf(ip),rvcm567(ip),rjm567(ip),rootsh(ip),
+ & phi_L(ip),phi_S(ip),phi_R(ip),phi_D(ip),
+ & psi_L(ip),psi_S(ip),psi_R(ip)
+ xkappa(ip) = 1./xkainv
+ enddo
+126 format(a50,a132)
+ close(15)
+
+c=======================================================================
+c reads C:N of PFT vegetation parts
+c=======================================================================
+ open(16,file=filecsurn)
+ read(16,*)title
+ do ip = 1, npft
+ read(16,126) pft_name(ip),sdata
+ read(sdata,*)(csurn(ip,k),k=1,npool)
+ enddo
+ close(16)
+
+c=======================================================================
+c reads residence times of plant parts
+c transform tau(yr) into gk_fall(day-1)
+c=======================================================================
+ open(17,file=filegkf)
+ read(17,*)title
+ do ip = 1, npft
+ read(17,126) pft_name(ip),sdata
+ read(sdata,*)(gk_fall(ip,k,1),k=1,npool),
+ & (gk_fall(ip,k,2),k=1,npool),
+ & (gk_fall(ip,k,3),k=1,npool),gkboom(ip),poro_crit(ip)
+ enddo
+ close(17)
+
+ do ip = 1, npft
+ gkboom(ip) = 1./(365.*gkboom(ip))
+ do ipool = 1, npool
+ do iphen = 1, 3
+ gk_fall(ip,ipool,iphen) =
+ & 1./(365.*gk_fall(ip,ipool,iphen))
+ enddo
+ enddo
+ enddo
+
+c=======================================================================
+c reads gama1, gama2 parameters (litter, soil C deg) (yr -1 ????)
+c=======================================================================
+
+ open(18,file=filegama)
+ read(18,126)title,sdata
+ read(sdata,*)gama1(1),gama1(2),gama2
+ close(18)
+
+c gama1(1) = 20.
+c gama1(2) = 5.
+c gama2 = 0.2 !previous standard value for CARAIB
+cc gama2 = 0.1
+
+c=======================================================================
+c reads initial values of carbon pools
+c=======================================================================
+ open(19,file=filecinit)
+ read(19,*)title
+ do ip = 1, npft
+ read(19,126) pft_name(ip),sdata
+ read(sdata,*)(carb_init(ip,k),k=1,npool)
+ enddo
+ close(19)
+
+c=======================================================================
+c fractionation linked to diffusion through stomatal cavities
+c=======================================================================
+ delc1 = 4.4
+
+c=======================================================================
+c timeday = factor use to calculate all parameters only for
+c the first half of the day.
+c=======================================================================
+
+ timeday = 2.
+
+ do m = 1, nm
+c xmfac(m) = 365. / (12. * float(mlength(m)))
+ xmfac(m) = 1.
+ enddo
+
+c=======================================================================
+c first hour, last hour, hourstep
+c=======================================================================
+
+ xhstep = float(2)
+ pi = 3.141592654
+ h_step = xhstep * pi / 12.
+
+c=======================================================================
+c steplai = leaf area index layers thickness;
+c nlmin = initial value of the minimum LAI;
+c transfo = factor to transform the co2 assimilation in gc m-2 d-1:
+c 1.e-6: micro moles --> moles;
+c 12. : moles --> g of carbon;
+c 3600 : s-1 --> h-1;
+c timeday * xhstep: --> d-1
+c steplai: --> 1 lai layer value.
+c=======================================================================
+ xlaimax = 6.
+ steplai = xlaimax/float(nlay)
+CLAI transfw = 3600. * steplai * timeday * xhstep
+CLAI transfo = 1.e-6 * 12. * transfw
+ transfw = 3600. * timeday * xhstep
+ transfo = 1.e-6 * 12. * transfw
+c=======================================================================
+c ome = reflection + scattering factor (dimensionless);
+c facome = radiative transfer factor;
+c radun = transformation from solar irradiance (w m-2) to
+c absorbed irradiance (micromol m-2 s-1):
+c 1 - 0.23 : light absorbed by other than Chloroplast
+c 1 - ome : non reflected ligth;
+c 3.6 e-19: energy of APAR photon (J);
+c 6.022e+17: Avogadro number.
+c parun = unit transformation of par: J s-1 m-2 ==> MJ day-1 m-2
+c 3600: s ==> hour
+c xhstep: to take into account the time step
+c timeday: to count a.m and p.m.
+c 10-6 : j ==> MJ
+c clump_fac = clumping factor
+c=======================================================================
+ rholeaf = 0.10
+ tauleaf = 0.10
+ ome = rholeaf + tauleaf
+ facome = sqrt((1. -tauleaf)*(1.-tauleaf) - rholeaf*rholeaf)
+ rhoc0 = (1. - tauleaf - facome) / rholeaf
+ radun = (1.-0.23) / (3.6e-19*6.022e+17)
+ parun = 3600. * xhstep * timeday / 1000000.
+ clump_fac = 0.8
+
+c=======================================================================
+c c3 species constants at 25 c:
+c
+c g0 = intercept for the stomatal conductance;
+c g1 = slope for the stomatal conductance;
+c gkc3 = michaelis constant for co2 (mubar);
+c gko3 = michaelis constant for o2 (mbar);
+c pkc3 = turnover number of rup2 carboxylase (s-1);
+c pkcko = ratio between the turnover number of rup2 carboxylase
+c and the turnover of rup2 oxygenase;
+c vcm0 = maximum RUBISCO capacity for C3 species (mumol m-2 s-1);
+c gjm0 = maximum electron transport rate for C3 species
+c (muE m-2 s-1).
+c=======================================================================
+ gkc3 = 460.
+ gko3 = 330.
+ pkc3 = 2.5
+ pkcko = 0.21
+c gkres0 = 0.0130
+ gkres0 = 0.0117
+c gkres0 = 0.01037
+ gkres = gkres0 * timeday * xhstep
+
+c=======================================================================
+c Dark respiration is directly related to Vcmax, to give consistency
+c between the dark respiration used in the GPP calculation from
+c Farquhar and the present calculation vcmax is related to gkres0.
+c The value of vcm0fac obtained here is close to the one (30) from
+c Nys (measurements).
+c
+c 12.: is the weigth of one mole of carbon
+c 1.e-6: gives vcmax in micromolC
+c 3600: transform hours in seconds
+c 0.01: is the ratio rd / vcmax
+c
+c In fact to be coherent with measurements, gkres0 / rdsurvc0
+c have to be so that vcm0fac = 30, and since gkres0 = 0.013
+c form measurements....
+c vcm0 = 80.,80.,120.,120.,40.,50.,40.,50.
+c======================================================================
+c rdsurvc0 = 0.010
+ rdsurvc0 = 0.009
+c rdsurvc0 = 0.008
+ vcm0fac = gkres0 / (12. * 3600 * 1.e-6 * rdsurvc0)
+ do ip = 1, npft
+c Ingrid201806 / Louis
+c old parameterisation from CARAIB
+c vcm0(ip) = vcm0fac / (csurn(ip,1) * splai(ip))
+c vcm0(ip) = vcm0fac / (csurn(ip,1) * 0.025)
+c vcm0(ip) = vcm0fac / (csurn(ip,1) * 0.0225)
+c vcm0(ip) = vcm0fac / (csurn(ip,1) * 0.020)
+
+c parameterisation of Vcmax from:
+c Walker et al. 2014. Ecol & Evol., 4(16):3218-3235
+c aNitr = leaf nitrogen per unit area (g N /m2)
+
+ aNitr = 1/((12.*csurn(ip,1)/14.)*splai(ip))
+ vcm0(ip)=exp(1.993+2.555*alog(aNitr)-0.372*alog(splai(ip))
+ & +0.422*alog(aNitr)*alog(splai(ip)))
+
+ do ipool = 1, npool
+ gk1_25(ip,ipool) = gkres
+ & / csurn(ip,ipool)
+ enddo
+ enddo
+
+ h_grow = 0.20
+
+c=======================================================================
+c other c3 constants, energy:
+c
+c rgas = gas constant (j k-1 mol-1);
+c ejm = energy ... (j mol-);
+c sjm = .... (j k-1 mol-1);
+c hjm = .... (j mol-1).
+c eagkc = activation energy for gkc (j);
+c eagko = activation energy for gko (j);
+c eapkc = activation energy for pkc (j).
+c=======================================================================
+ rgas = 8.314
+ rgas_v = rgas/0.018
+ ejm = 37000. / (298.15 * rgas)
+ sjm = 710. / rgas
+ hjm = 220000. / rgas
+ eagkc = 59000. / (298.15 * rgas)
+ eagko = 36000. / (298.15 * rgas)
+ eapkc = 59000. / (298.15 * rgas)
+
+c=======================================================================
+c constants for c4:
+c
+c alpc4 = quantum efficiency (mol mol-1);
+c xkc4 = initial slope of the photosynthesis co2 response
+c (micromol m-2 s-1);
+c q10 = proportional increase in a parameter value for a 10
+c degrees increase.
+c=======================================================================
+ alpc4 = 0.04
+ xkc4 = 0.7
+ q10 = 2.
+ fact0 = 0.3 * 286.15
+ fact1 = 0.3 * 309.15
+ fact2 = 1.3 * 328.15
+
+c=======================================================================
+c temp0 = temperature of 0 degree Celsius (K).
+c=======================================================================
+
+ temp0 = 273.15
+
+c======================================================================
+c coefficient to calculation the atmospheric water partial pressure
+c======================================================================
+ ah2o = -2937.4
+ bh2o = -4.9283
+ ch2o = 23.5518
+ dh2o = 6.180178
+ eh2o = 51012. / (rgas * temp0)
+
+c=======================================================================
+c pi = trigonometric constant (dimensionless);
+c sunea = solar constant (W m-2);
+c rearth = earth radius (km);
+c hatm = atmosphere thickness (km) (dense part);
+c ftrmax = maximum transmittance of the atmosphere (dimensionless).
+c sigma = Stefan-Boltzmann constant
+c sunea = solar constant (wm-2 ?);
+c rearth = earth radius (km);
+c hatm = atmosphere height (km) (dense part);
+c ftrmin = minimum transmittance of the atmosphere (dimensionless);
+c ftrmax = maximum transmittance of the atmosphere (dimensionless).
+c=======================================================================
+
+ pi = 3.1415926535
+ pi2 = 2. * pi
+ pi180 = pi / 180.
+
+ if (ileap.eq.1) then
+ pi365 = pi2 / 365.2425
+ else
+ pi365 = pi2 / 365.
+ endif
+
+ sunea = 1368.
+ rearth = 6370.
+ hatm = 10.
+
+c CARAIB original values
+ ftrmin = 0.251
+ ftrmax = 0.760
+c Oensingen site
+c ftrmin = 0.251
+c ftrmax = 0.650
+c Vielsalm site
+c ftrmin = 0.050
+c ftrmax = 0.810
+c ftrmin = 0.150
+c ftrmax = 0.800
+
+ sigma = 5.67d-8
+
+ if(ipar.eq.0) then
+ xlsper = xlsper * pi / 180.
+ obl = obl * pi / 180.
+
+ exc2 = exc * exc
+ exc3 = exc2 * exc
+ exc4 = 2. * exc
+ exc5 = 2.5 * exc2
+ endif
+
+ rearth2 = rearth * rearth
+ hatrea = hatm * ( hatm + 2. * rearth)
+
+c=======================================================================
+c psat0: saturated partial pressure of H2O at t=O C (Pa)
+c eaice: chaleur latente L d'evaporation de H2O [J mol-1]
+c cpdry: specific heat cp of dry air at constant p [J kg-1 K-1]
+c cph2o: specific heat of water vapour at constant p [J kg-1 K-1]
+c patm0: sea level pressure (Pa)
+c h2omw = water molecular weight (kg mol-1)
+c drymw = dry air molecular weight (kg mol-1)
+c epsi = ratio of water to air molecular weight
+c rdry = gas constant of dry air Rdry = Rgas/drymw (J K-1 kg-1)
+c rh2o = gas constant of water vapour Rh2o = Rgas/h2omw (J K-1 kg-1)
+c=======================================================================
+ asat=6763.6
+ bsat=4.9283
+ csat=54.233
+ psat0=100.*exp(-asat/temp0-bsat*alog(temp0)+csat)
+ eaice = 51012.
+ cpdry = 1004.
+ cph2o = 1952.
+ patm0 = 1.013d+5
+ drymw = 28.964d-3
+ h2omw = 18.016d-3
+ epsi = h2omw/drymw
+ rdry = rgas/drymw
+ rh2o = rgas/h2omw
+
+c======================================================================
+c aerodynamic + boundary layer resistance constants
+c======================================================================
+ zzras = 100.00
+ z0s = 0.0006
+ disds = 0.004
+ zzlogs = log((zzras-disds)/z0s)
+ usmuls = 0.40/zzlogs
+ arbl = 0.40
+ brbl = 6.2
+ exrbl = 0.67
+ unitfac = rgas*temp0/patm0
+ h2osurco2 = 1.37
+
+c======================================================================
+c coefficient for different soil textures
+c======================================================================
+ cmoptcla = 0.73
+ cmoptsil = 0.68
+ cmoptsan = 0.59
+ xm1cla = -1.883
+ xm1sil = 0.140
+ xm1san = 0.356
+ psatcla = 0.75
+ psatsil = 0.625
+ psatsan = 0.5
+
+c=======================================================================
+c coefficient for the calculation of soil respiration
+c alpha = proportion of litter decomposition carbon flux transferred
+c to humus pool (dimensionless)
+c (1-alpha is transferred to atmosphere as CO2)
+c q10grnd = q10 for decomposition of metabolic (leaf) litter
+c q10tree = q10 for decomposition of structural (wood) litter and humus
+c facgrnd = proportionality factor for decomposition of metabolic
+c (leaf) litter
+c factree = proportionality factor for decomposition of structural
+c (wood) litter and humus
+c=======================================================================
+ q10tree = 1.74
+ factree = (1. - 0.33) * 0.00555 * 12. / 365.
+ q10grnd = 2.03
+ facgrnd = (1. - 0.33) * 0.00343 * 12. / 365.
+ alpha = 0.18
+
+c=======================================================================
+c parameters used to smooth the mortality function with a normal law
+c for min temperature, soil water content and GDD5
+c=======================================================================
+ xk_erf = 2.33
+
+ delta_tmin = 3.
+ delta_watmin = 5./100.
+
+ delta_tmax = 3.
+ delta_watmax = 5./100.
+ delta_gdd5 = 5./100.
+
+ if(delta_watmin .gt. 1. .or.
+ & delta_watmax .gt. 1. .or.
+ & delta_gdd5 .gt. 1.) then
+ write(61,*) 'error input delta',delta_watmin,delta_watmax,
+ & delta_gdd5
+ stop
+ endif
+
+ return
+end subroutine cth2o
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_daily_weather.f b/couplage/CARAIB/ver01_Iv_couplage/mod_daily_weather.f
new file mode 100644
index 0000000..14932ee
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_daily_weather.f
@@ -0,0 +1,247 @@
+c=======================================================================
+c***********************************************************************
+ subroutine daily_weather(ngt,iread)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c This routine estimates daily weather data from monthly values.
+c=======================================================================
+ IMPLICIT NONE
+
+ include './com_18/parameter.common'
+ include './com_18/acclim.common'
+ include './com_18/burned.common'
+ include './com_18/climin0.common'
+ include './com_18/climin.common'
+ include './com_18/coord.common'
+ include './com_18/cte.common'
+ include './com_18/crops.common'
+ include './com_18/gddpix.common'
+ include './com_18/gene.common'
+ include './com_18/iprt.common'
+ include './com_18/monthcst.common'
+ include './com_18/nspc.common'
+ include './com_18/prt_ctrl.common'
+ include './com_18/pzone.common'
+ include './com_18/snow.common'
+ include './com_18/temper.common'
+
+ integer ngt,iread
+ integer m2,iy_past
+ real*4 ytem
+
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer iday,im,jday,m,num2
+ real*4 ccd,cci,ccm,ccw,had,ham,haw,omcc,omha,ppmth,regres,tddmax
+ & ,tdmax,tdnmin,tmmax,tnight,tnoon
+c
+c-----------------------------------------------
+
+ omcc = 0.8
+ omha = 0.8
+
+c=======================================================================
+c calculation of daily values:
+c
+c * precipitation, temperature and temperature daily range are
+c stochasticaly generated;
+c * sunshine hours and relative humidity variate between 2
+c values; one for raining days and one for the other days;
+c * wind speed, soil water content and snow cover fraction are
+c linearly related to monthly data.
+c=======================================================================
+
+ Tdmin = 100.
+ Tdmax = -100.
+ Tdnmin = 100.
+ Tddmax = -100.
+c Tc = 100.
+c Tc01 = 100.
+c Tc02 = 100.
+c Tc03 = 100.
+c Tc04 = 100.
+c Tc05 = 100.
+c Tc06 = 100.
+c Tc07 = 100.
+c Tc08 = 100.
+c Tc09 = 100.
+c Tc10 = 100.
+c Tc11 = 100.
+c Tc12 = 100.
+ gdd0 = 0.
+ gdd5 = 0.
+
+ ytem = 0.
+
+
+ do iday = 1, nd
+ m = imonth(iday)
+
+c in southern hemisphere a dephasing of six months is applied,
+c i.e. the statistics of July is adopted for January, that of
+c August for February, etc
+c----------------------------------------------------------------------
+
+ jday = iday
+ if(ylati.lt.0.)then
+ if(iday.le.181)then
+ jday=iday+184
+ else
+ jday=iday-181
+ endif
+ endif
+ if (idaily_in.eq.0) then
+ prc(iday) = prc0(m) * rapportP(izonepxl,jday)
+ tcel(iday) = (tcel0(m)+temp0)* rapportT(izonepxl,jday)-temp0
+ tdiff(iday) = tdiff0(m) * rapportDT(izonepxl,jday)
+ endif
+
+ if (tcel(iday).lt.Tdmin) Tdmin = tcel(iday)
+ if (tcel(iday).gt.Tdmax) Tdmax = tcel(iday)
+ if ((tcel(iday)-tdiff(iday)/2.).lt.Tdnmin)
+ & Tdnmin = tcel(iday)-tdiff(iday)/2.
+ if ((tcel(iday)+tdiff(iday)/2.).gt.Tddmax)
+ & Tddmax = tcel(iday)+tdiff(iday)/2.
+
+
+ if (tcel(iday).gt.0.) gdd0 = gdd0 + tcel(iday)
+ if (tcel(iday).gt.5.) gdd5 = gdd5 + (tcel(iday)-5.)
+
+
+c=======================================================================
+c Traitement de la couverture nuageuse et de l'humidite relative
+c Ces variables sont plus elevees les jours de pluie que les
+c jours secs. La moyenne mensuelle est respectee
+c=======================================================================
+
+ if (idaily_in.eq.0) then
+
+ ccm = 1.-sunhour0(m)
+ ham = rhu0(m)
+
+ if(ylati.ge.0.)then
+ ppmth = float(nombrejp(izonepxl,m))/float(mlength(m))
+ else
+ ppmth = float(nombrejpS(izonepxl,m))/float(mlength(m))
+ endif
+
+ if (ppmth.ne.0.) then
+
+ ccd = (ccm-ppmth*omcc)/(1.-ppmth*omcc)
+ if(ccd.lt.0.)ccd=0.
+ if(ccd.gt.1.)ccd=1.
+ ccw = (ccm - (1.-ppmth)*ccd)/ppmth
+ had = (ham-ppmth*omha)/(1.-ppmth*omha)
+ if(had.lt.0.1)then
+ had=0.1
+ if(had.gt.ham)ham=had
+ endif
+ if(had.gt.1.)had=1.
+ haw = (ham - (1.-ppmth)*had)/ppmth
+
+ else
+
+ ccd = ccm
+ ccw = ccm
+ had = ham
+ haw = ham
+
+ endif
+
+ if(prc(iday).gt.1.e-20)then
+ cci = ccw
+ rhu(iday) = haw
+ else
+ cci = ccd
+ rhu(iday) = had
+ endif
+
+ sunhour(iday) = 1.-cci
+ if(sunhour(iday).lt.0.)sunhour(iday)=0.
+ if(sunhour(iday).gt.1.)sunhour(iday)=1.
+
+ endif
+
+c=======================================================================
+
+ if(iday.eq.numday(m)) then
+ if (idaily_in.eq.0) win(iday) = win0(m)
+ xl_flash(iday) = xmflash(m)
+ else
+ if(iday.lt.numday(m)) m2 = m - 1
+ if(iday.gt.numday(m)) m2 = m + 1
+ if(m2.eq.0) then
+ m2 = nm
+ num2 = numday(m2) - nd
+ elseif(m2.eq.nm+1) then
+ m2 = 1
+ num2 = numday(m2) + nd
+ else
+ num2 = numday(m2)
+ endif
+ regres = float(iday - numday(m)) / float(num2 - numday(m))
+ if (idaily_in.eq.0) then
+ win(iday) = win0(m) + (win0(m2) - win0(m)) * regres
+ endif
+ if (ifire.eq.1) then
+ xl_flash(iday)=xmflash(m)+(xmflash(m2)-xmflash(m))*regres
+ endif
+ endif
+c----------------------------------------------------------------------
+c Annual mean temperature (for acclimation)
+ ytem = ytem+tcel(iday)/float(nd)
+
+
+ enddo
+
+c records annual mean temperature in ytem_prev
+c
+ if ((nyear.eq.1).and.(iread.eq.0)) then
+ do iy_past = 1, 5
+ ytem_prev(ngt,iy_past) = ytem
+ end do
+ do im = 1, nm
+ py_mtem(ngt,im) = tcel0(im)
+ end do
+ else
+ do iy_past = 5, 2, -1
+ ytem_prev(ngt,iy_past) = ytem_prev(ngt,iy_past-1)
+ end do
+ ytem_prev(ngt,1) = ytem
+ endif
+c----------------------------------------------------------------------
+
+
+ Tmmin = 1000.
+ Tmmax = -1000.
+ do im = 1, nm
+c Attention: night temperature for Tmmin (standard version)
+c daily mean temperature for this version
+c----------------------------------------------------------------------
+c Tnight=tcel0(im)-0.5*tdiff0(im)
+ Tnight=tcel0(im)
+ Tnoon=tcel0(im)+0.5*tdiff0(im)
+ if (Tnight.le.Tmmin) then
+ Tmmin = Tnight
+ endif
+ if (Tnoon.ge.Tmmax) then
+ Tmmax = Tnoon
+ endif
+ enddo
+
+
+ if (iyprt.ge.1) then
+ if(iprt_Tdmin.eq.1)
+ & write(70,100) ylongi,ylati,Tdmin,Tdmax,Tdnmin,Tddmax
+ if(iprt_Tmmin.eq.1) write(71,100) ylongi,ylati,Tmmin,Tmmax
+ if(iprt_gdd.eq.1) write(72,200) ylongi,ylati,gdd0,gdd5
+ endif
+
+ 100 format(2(f8.3,1x),4(f8.2,1x))
+ 200 format(2(f8.3,1x),2(f8.2,1x))
+
+ return
+ end subroutine daily_weather
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_dispersion.f b/couplage/CARAIB/ver01_Iv_couplage/mod_dispersion.f
new file mode 100644
index 0000000..910065b
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_dispersion.f
@@ -0,0 +1,520 @@
+c=======================================================================
+c***********************************************************************
+ subroutine dispersion
+c***********************************************************************
+c=======================================================================
+ use ifport
+c Propagation direction
+
+c 1 = Sud-Ouest
+c 2 = Sud
+c 3 = Sud-Est
+c 4 = Ouest
+c 5 = Est
+c 6 = Nord-Ouest
+c 7 = Nord
+c 8 = Nord-Est
+
+c implicit double precision (a-h,o-z)
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/annppf.common'
+ include './com_18/coord.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/disper.common'
+ include './com_18/ecoin.common'
+ include './com_18/griddata.common'
+ include './com_18/input_par.common'
+ include './com_18/inidata.common'
+ include './com_18/kernel.common'
+ include './com_18/nspc.common'
+ include './com_18/solpar.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ real*4 xde0st
+c
+c-----------------------------------------------
+
+ double precision xlg1,xlt1,xlg2,xlt2,distan
+ integer i,j,k,l,ip,ngt,ngt1,ngt2
+ integer ngt_temp1,ngt_temp2,nint,nitmax,imeth,num,nshot
+ real*4 rayon,rad,deg,delta_phi,delta_lambda,xa,xb,R_compet,
+ & diag,ermax,erfi,sig,mu,xdest,ydest,z
+c JLP real*4 seed
+ real*4 new_seed
+ real*4 frnd,rand1,rand2,dir_rand,dist_rand,delta1
+ real*4 xlo_min,xlo_max,xla_min,xla_max,
+ & xlo_min2,xlo_max2,xla_min2,xla_max2
+ real*8 x,fx
+
+
+ if(isp.eq.6) ynppf_max = 450.
+ if(isp.eq.8) ynppf_max = 450.
+
+ do ngt = 1, n_pix
+ ylongi = xlg(ngt)
+ ylati = xlt(ngt)
+ do ip = 1, npft
+ ynppf(ip)=ynppf_grd(ip,ngt)
+ end do
+
+ ynppf_mean = 0.
+
+ do ip = 1,npft
+ if(ip.ne.1) ynppf_mean = ynppf_mean +
+ & yfrac_ini(ip,ngt)*ynppf(ip)
+ enddo
+
+ ngt_temp1 = 0
+ ngt_temp2 = 0
+
+ rayon = rearth*1000. ! (en m)
+
+ rad = pi/180.
+ deg = 180./pi
+
+ delta_phi = (rayon*rad*declat) !/2. MARIE
+ delta_lambda = (rayon*cos(rad*ylati)*(rad*declg)) !/2. MARIE
+ diag = ((delta_phi*delta_phi)+(delta_lambda*delta_lambda))**0.5 ! MARIE
+
+ do ip = 1, npft0
+
+ if(ip.eq.isp) then
+
+ if(ynppf(ip).ge.ynppf_max) ynppf(ip) = ynppf_max
+ spec_npp = ynppf(ip)*yfrac_ini(ip,ngt)
+
+ if(spec_npp.ne.0.) then
+
+ if(isp.eq.6) Xmax = 65.*mig_rate(ip,ngt)
+ if(isp.eq.8) Xmax = 45.*mig_rate(ip,ngt)
+ Xmin = 0.
+
+ xa = Xmax
+ xb = Xmin
+ nint = 5
+ x = Xmax
+ ermax = 1.e-25 !1.e-9
+ nitmax = 100
+ imeth = 0
+
+ call nonlineq2(xa,xb,nint,x,fx,ermax,nitmax,imeth,num,ngt) ! ermsax dans fagus???
+c if(ngt.eq.3463) write(*,*) 'Number of iterations:',num
+c if(ngt.eq.3463) write(*,*) 'x = ',x,' f(x) = ',fx
+
+ if(x.eq.-999999.) then
+c if(ngt.eq.3463) write(*,*) 'iter2'
+ nint = 125
+ x = Xmax
+ call nonlineq2(xa,xb,nint,x,fx,ermax,nitmax,imeth,num,ngt)
+ else
+ go to 900
+ endif
+
+ if(x.eq.-999999.) then
+c if(ngt.eq.3463) write(*,*) 'iter3'
+ nint = 1250
+ x = Xmax
+ call nonlineq2(xa,xb,nint,x,fx,ermax,nitmax,imeth,num,ngt)
+ else
+ go to 900
+ endif
+
+ if(x.eq.-999999.) then
+ mig_rate(ip,ngt) = 0.
+c if(ngt.eq.3463) write(*,*) 'iter4'
+ go to 800
+ endif
+
+ 900 continue
+
+ R_compet = x/Xmax
+
+ mig_rate(ip,ngt) = R_compet*mig_rate(ip,ngt)
+
+ else
+
+ mig_rate(ip,ngt) = 0.
+
+ endif
+
+ 800 continue
+
+c=======================================================================
+c short-distance dispersal
+c=======================================================================
+
+ if(pres(ip,ngt).eq.1) pres_new(ip,ngt) = 1
+
+ do k = 1, n_nghmx
+ if(pres_side(ip,k,ngt).eq.1) then
+ if(prop(ip,k,ngt).lt.diag) then !90000.
+ prop(ip,k,ngt)= prop(ip,k,ngt)
+ & +mig_rate(ip,ngt)
+ endif
+ preside_new(ip,k,ngt) = 1
+ endif
+ enddo
+
+ if(suc_est(ip,ngt).ne.0.
+ & .and.mig_rate(ip,ngt).ne.0.) then
+
+ do k = 1, n_nghmx
+ ngt1 = neighbor(k,ngt)
+ l = 9-k
+
+ if(pres_side(ip,k,ngt).eq.0) then
+
+ if(ngt1.eq.0) then
+ go to 100
+ endif
+
+ if(pres_side(ip,l,ngt1).eq.1) then
+ prop(ip,k,ngt) = mig_rate(ip,ngt)
+ pres_new(ip,ngt) = 1
+ preside_new(ip,k,ngt) = 1
+ go to 700
+ endif
+
+ 100 continue
+
+ if(k.eq.1) then
+ ngt_temp1 = neighbor(2,ngt)
+ if(ngt_temp1.eq.0) then
+ go to 200
+ endif
+ if(pres_side(ip,6,ngt_temp1).eq.1) then
+ prop(ip,k,ngt) = mig_rate(ip,ngt)
+ pres_new(ip,ngt) = 1
+ preside_new(ip,k,ngt) = 1
+ go to 700
+ endif
+ 200 continue
+ ngt_temp2 = neighbor(4,ngt)
+ if(ngt_temp2.eq.0) then
+ go to 700
+ endif
+ if(pres_side(ip,3,ngt_temp2).eq.1) then
+ prop(ip,k,ngt) = mig_rate(ip,ngt)
+ pres_new(ip,ngt) = 1
+ preside_new(ip,k,ngt) = 1
+ go to 700
+ endif
+ endif
+
+ if(k.eq.3) then
+ ngt_temp1 = neighbor(2,ngt)
+ if(ngt_temp1.eq.0) then
+ go to 300
+ endif
+ if(pres_side(ip,8,ngt_temp1).eq.1) then
+ prop(ip,k,ngt) = mig_rate(ip,ngt)
+ pres_new(ip,ngt) = 1
+ preside_new(ip,k,ngt) = 1
+ go to 700
+ endif
+ 300 continue
+ ngt_temp2 = neighbor(5,ngt)
+ if(ngt_temp2.eq.0) then
+ go to 700
+ endif
+ if(pres_side(ip,1,ngt_temp2).eq.1) then
+ prop(ip,k,ngt) = mig_rate(ip,ngt)
+ pres_new(ip,ngt) = 1
+ preside_new(ip,k,ngt) = 1
+ go to 700
+ endif
+ endif
+
+ if(k.eq.6) then
+ ngt_temp1 = neighbor(4,ngt)
+ if(ngt_temp1.eq.0) then
+ go to 400
+ endif
+ if(pres_side(ip,8,ngt_temp1).eq.1) then
+ prop(ip,k,ngt) = mig_rate(ip,ngt)
+ pres_new(ip,ngt) = 1
+ preside_new(ip,k,ngt) = 1
+ go to 700
+ endif
+ 400 continue
+ ngt_temp2 = neighbor(7,ngt)
+ if(ngt_temp2.eq.0) then
+ go to 700
+ endif
+ if(pres_side(ip,1,ngt_temp2).eq.1) then
+ prop(ip,k,ngt) = mig_rate(ip,ngt)
+ pres_new(ip,ngt) = 1
+ preside_new(ip,k,ngt) = 1
+ go to 700
+ endif
+ endif
+
+ if(k.eq.8) then
+ ngt_temp1 = neighbor(5,ngt)
+ if(ngt_temp1.eq.0) then
+ go to 500
+ endif
+ if(pres_side(ip,6,ngt_temp1).eq.1) then
+ prop(ip,k,ngt) = mig_rate(ip,ngt)
+ pres_new(ip,ngt) = 1
+ preside_new(ip,k,ngt) = 1
+ go to 700
+ endif
+ 500 continue
+ ngt_temp2 = neighbor(7,ngt)
+ if(ngt_temp2.eq.0) then
+ go to 700
+ endif
+ if(pres_side(ip,3,ngt_temp2).eq.1) then
+ prop(ip,k,ngt) = mig_rate(ip,ngt)
+ pres_new(ip,ngt) = 1
+ preside_new(ip,k,ngt) = 1
+ go to 700
+ endif
+ endif
+
+ endif
+ 700 continue
+ enddo
+ endif
+
+ do k = 1, n_nghmx
+
+c yphi0 = ylat(k,ngt)
+c ylamda0 = ylon(k,ngt)
+ xlt1 = ylat(k,ngt)
+ xlg1 = ylon(k,ngt)
+
+ if(preside_new(ip,k,ngt).eq.1) then
+
+ if(prop(ip,k,ngt).gt.0..and.
+ & prop(ip,k,ngt).le.diag) then !90000.
+
+ count(ip,k,ngt) = count(ip,k,ngt) + 1 ! MARIE
+
+ do j = 1, n_nghmx
+
+c cos(alpha) = sin(phi0)*sin(phi)+cos(phi0)*cos(phi)*cos(delta_lambda)
+c avec alpha = longueur de l'arc de grand cercle s�parant les 2 points
+c et phi et phi0 les latitudes des 2 points
+
+c delta_lon = abs(ylon(j,ngt)-ylamda0)
+c dist(k,j) = rayon*acos(sin(rad*yphi0)
+c & *sin(rad*ylat(j,ngt))
+c & +cos(rad*yphi0)*cos(rad*ylat(j,ngt))
+c & *cos(rad*delta_lon))
+
+ xlt2 = ylat(j,ngt)
+ xlg2 = ylon(j,ngt)
+ call distance(xlg1,xlt1,xlg2,xlt2,distan)
+ dist(k,j)=distan*1000.
+
+ if(prop(ip,k,ngt).ge.dist(k,j)) then
+ preside_new(ip,j,ngt) = 1
+ endif
+ enddo
+
+ endif
+
+ if(prop(ip,k,ngt).le.diag)
+ & prop_time(ip,k,ngt) = count(ip,k,ngt) ! MARIE
+c write(*,*) ngt,prop(ip,k,ngt)
+ endif
+ enddo
+
+c write(*,'(2(1x,f8.3),8(1x,f12.3),8(1x,i10))')
+c & ylongi,ylati,(prop(ip,k,ngt),k=1,n_nghmx),
+c & (prop_time(ip,k,ngt),k=1,n_nghmx) ! MARIE
+c write(*,*) isp,n_nghmx
+
+c=======================================================================
+c long-distance dispersal
+c=======================================================================
+
+c nombre de tirs proportionels � la npp
+
+ if(ip.eq.21.or.ip.eq.27.or.ip.eq.29) then
+
+ if(pres(ip,ngt).eq.1) then
+
+ nshot = 10
+
+ do i = 1, nshot
+
+ new_seed = 1.26*nyear + ngt*0.47 + i
+ call randnum(new_seed,frnd)
+ rand1 = frnd
+c rand1 = rand(0.)*(0.+1.) !direction = azimuth de ce grand cercle par rapport au m�ridien de la source
+
+ new_seed = rand(0)*(0.+i)*new_seed
+ call randnum(new_seed,frnd)
+ rand2 = frnd
+c rand2 = rand(0.)*(0.+1.) !distance = longueur de l'arc de grand cercle s�parant les 2 points
+
+c Wind normal distribution
+c Cumulative distribution function: 1./2. * (1. + erf((x-mu)/(sig*(2.)**0.5)))
+
+ z = 2.*rand1-1.
+ erfi = 1./2.*(pi)**0.5*(z+1./12.*pi*(z)**3.
+ & +7./480.*(pi)**2.*(z)**5.
+ & +127./40320.*(pi)**3.*(z)**7.
+ & +4369./5806080.*(pi)**4.*(z)**9.
+ & +34807./182476800.*(pi)**5.*(z)**11.)
+
+ dir_rand = 87.837*(2.)**0.5*erfi+90.
+ if(dir_rand.ge.360.) dir_rand = dir_rand-360.
+ if(dir_rand.lt.0.) dir_rand = dir_rand+360.
+
+c Fagus dispersal kernel: log-normal distribution
+c Cumulative distribution function: 1./2. + 1./2. * erf((ln(x) - mu)/((2.*(sig)**2.)**0.5))
+
+ sig = 2.9
+ mu = 5.1
+
+cWC if(probd .le. 0.5) then
+cWC sig=0.02 !0.375 !0.61 !3.121
+cWC mu=2.7
+cWC elseif(probd .gt. 0.5) then
+cWC sig=0.375
+cWC mu=2.7
+cWC endif
+
+
+ z = 2.*(rand2-1./2.)
+ erfi = 1./2.*(pi)**0.5*(z+1./12.*pi*(z)**3.
+ & +7./480.*(pi)**2.*(z)**5.
+ & +127./40320.*(pi)**3.*(z)**7.
+ & +4369./5806080.*(pi)**4.*(z)**9.
+ & +34807./182476800.*(pi)**5.*(z)**11.)
+
+ dist_rand = exp((2.*(sig)**2.)**0.5*erfi+mu)
+cWC dist_rand=10**((sig)*(2**0.5)*erfi+mu)
+
+c Exponentielle d�croissante
+c y = y0*exp(-x/tau) avec tau = dur�e de vie
+c y = a.exp(bt)+c
+c t = 1/b * log((y-c)/a)
+
+c tau = 1./1. !4000.
+
+c dist_rand = -1./tau*log(-(rand2-1.))
+c dist_rand = dist_rand/rayon !radians
+c dist_rand = (180.*(dist_rand/r))/pi !degr�s
+
+ ydest = deg
+c & *(dasin(sin((pi*xla)/180.)*cos((pi*dist_rand)/180.)
+ & *(asin(sin(rad*ylati)*cos(dist_rand)
+c & + cos((pi*xla)/180.)*sin((pi*dist_rand)/180.)
+ & + cos(rad*ylati)*sin(dist_rand)
+ & * cos(rad*dir_rand)))
+ xdest = ylongi
+ & +deg
+ & *(acos((cos(dist_rand)-sin(rad*ylati)
+ & *sin(rad*ydest))/(cos(rad*ylati)*cos(rad*ydest))))
+
+cc dist_rand = rayon*dist_rand
+
+ if(dir_rand.le.45.or.dir_rand.ge.315) then
+ delta1 = delta_phi
+ elseif(dir_rand.ge.45.and.dir_rand.le.135) then
+ delta1 = delta_lambda
+ elseif(dir_rand.ge.135.and.dir_rand.le.225) then
+ delta1 = delta_phi
+ elseif(dir_rand.ge.225.and.dir_rand.le.315) then
+ delta1 = delta_lambda
+ endif
+
+ if(dist_rand.ge.delta1) then !ou distance qu'il reste � parcourir
+
+ do ngt2 = 1, n_pix
+
+ xlo_min = xlg(ngt2)-(declg/2.)
+ xlo_max = xlg(ngt2)+(declg/2.)
+ xla_min = xlt(ngt2)-(declat/2.)
+ xla_max = xlt(ngt2)+(declat/2.)
+
+ xlo_min2 = xlg(ngt2)-(declg/4.)
+ xlo_max2 = xlg(ngt2)+(declg/4.)
+ xla_min2 = xlt(ngt2)-(declat/4.)
+ xla_max2 = xlt(ngt2)+(declat/4.)
+
+ if(xdest.ge.xlo_min.and.xdest.le.xlo_max.and.
+ & ydest.ge.xla_min.and.ydest.le.xla_max) then
+
+ if(suc_est(ip,ngt2).gt.1.e-5) then
+ pres_new(ip,ngt2) = 1
+ if(xdest.ge.xlo_min.and.xdest.le.xlo_min2.and.
+ & ydest.ge.xla_min.and.ydest.le.xla_min2.and.
+ & prop(ip,1,ngt2).eq.0) then
+ prop(ip,1,ngt2) = mig_rate(ip,ngt2)
+ preside_new(ip,1,ngt2) = 1
+ endif
+ if(xdest.ge.xlo_min2.and.xdest.le.xlo_max2.and.
+ & ydest.ge.xla_min.and.ydest.le.xla_min2.and.
+ & prop(ip,2,ngt2).eq.0) then
+ prop(ip,2,ngt2) = mig_rate(ip,ngt2)
+ preside_new(ip,2,ngt2) = 1
+ endif
+ if(xdest.ge.xlo_max2.and.xdest.le.xlo_max.and.
+ & ydest.ge.xla_min.and.ydest.le.xla_min2.and.
+ & prop(ip,3,ngt2).eq.0) then
+ prop(ip,3,ngt2) = mig_rate(ip,ngt2)
+ preside_new(ip,3,ngt2) = 1
+ endif
+ if(xdest.ge.xlo_min.and.xdest.le.xlg(ngt2).and.
+ & ydest.ge.xla_min2.and.ydest.le.xla_max2.and.
+ & prop(ip,4,ngt2).eq.0) then
+ prop(ip,4,ngt2) = mig_rate(ip,ngt2)
+ preside_new(ip,4,ngt2) = 1
+ endif
+ if(xdest.ge.xlg(ngt2).and.xdest.le.xlo_max.and.
+ & ydest.ge.xla_min2.and.ydest.le.xla_max2.and.
+ & prop(ip,5,ngt2).eq.0) then
+ prop(ip,5,ngt2) = mig_rate(ip,ngt2)
+ preside_new(ip,5,ngt2) = 1
+ endif
+ if(xdest.ge.xlo_min.and.xdest.le.xlo_min2.and.
+ & ydest.ge.xla_max2.and.ydest.le.xla_max.and.
+ & prop(ip,6,ngt2).eq.0) then
+ prop(ip,6,ngt2) = mig_rate(ip,ngt2)
+ preside_new(ip,6,ngt2) = 1
+ endif
+ if(xde0st.ge.xlo_min2.and.xdest.le.xlo_max2.and.
+ & ydest.ge.xla_max2.and.ydest.le.xla_max.and.
+ & prop(ip,7,ngt2).eq.0) then
+ prop(ip,7,ngt2) = mig_rate(ip,ngt2)
+ preside_new(ip,7,ngt2) = 1
+ endif
+ if(xdest.ge.xlo_max2.and.xdest.le.xlo_max.and.
+ & ydest.ge.xla_max2.and.ydest.le.xla_max.and.
+ & prop(ip,8,ngt2).eq.0) then
+ prop(ip,8,ngt2) = mig_rate(ip,ngt2)
+ preside_new(ip,8,ngt2) = 1
+ endif
+ endif
+ go to 600
+ endif
+ enddo
+
+ 600 continue
+
+ endif
+
+ enddo
+
+ endif
+
+ endif
+
+c=======================================================================
+ endif
+
+ enddo
+ enddo
+
+ return
+ end subroutine dispersion
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_dryseas.f b/couplage/CARAIB/ver01_Iv_couplage/mod_dryseas.f
new file mode 100644
index 0000000..ceb4b99
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_dryseas.f
@@ -0,0 +1,46 @@
+c=======================================================================
+c***********************************************************************
+ subroutine dryseas(p,mdry)
+c***********************************************************************
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer m,mb,mdry,mth
+ real*4 p,pmax,ppt,sum
+c
+c-----------------------------------------------
+ dimension p(nm), mdry(3)
+ dimension ppt(nm2), mth(nm2)
+
+ do m = 1, nm
+ mth(m ) = m
+ mth(m+nm) = m
+ ppt(m ) = p(m)
+ ppt(m+nm) = p(m)
+ enddo
+
+ sum = 0.
+ do m = 1, 3
+ sum = sum + ppt(m)
+ enddo
+ pmax = sum
+ mb = 0
+
+ do m = 1, 11
+ sum = sum + ppt(m+3) - ppt(m)
+ if(sum .lt. pmax) then
+ pmax = sum
+ mb = m
+ endif
+ enddo
+
+ do m = 1, 3
+ mdry(m) = mth(mb+m)
+ enddo
+
+ return
+ end subroutine dryseas
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_exch.f b/couplage/CARAIB/ver01_Iv_couplage/mod_exch.f
new file mode 100644
index 0000000..7bd87be
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_exch.f
@@ -0,0 +1,36 @@
+c=======================================================================
+c***********************************************************************
+ subroutine exch(ne,nc,je,sl,diag)
+c***********************************************************************
+
+c=======================================================================
+c This subroutine exchanges rows to get a zero coefficient off the
+c diagonal.
+c=======================================================================
+
+C --- JLP implicit double precision (a-h,o-z)
+ IMPLICIT NONE
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer jc,je,jr,nc,ne
+ real*8 diag,sl,temp
+c
+c-----------------------------------------------
+ dimension sl(ne,ne+1)
+ do 100 jr=je+1,ne
+ if(sl(jr,je).eq.0.)goto 100
+ do 200 jc=je,nc
+ temp=sl(jr,jc)
+ sl(jr,jc)=sl(je,jc)
+ sl(je,jc)=temp
+ 200 continue
+ diag=sl(je,je)
+ goto 1000
+ 100 continue
+ write(28,*) 'Zero element on the diagonal.'
+ write(28,*) 'Can not solve simultaneous equations.'
+ stop
+1000 continue
+ return
+ end subroutine exch
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_fraction_luc.f b/couplage/CARAIB/ver01_Iv_couplage/mod_fraction_luc.f
new file mode 100644
index 0000000..bb515c2
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_fraction_luc.f
@@ -0,0 +1,266 @@
+c=======================================================================
+c***********************************************************************
+ subroutine fraction_luc(ngt)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c This routine calculates carbon emission and litter production fluxes
+c from land use change
+c=======================================================================
+
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/coord.common'
+ include './com_18/cte.common'
+ include './com_18/ecoin.common'
+ include './com_18/icyr.common'
+ include './com_18/inidata.common'
+ include './com_18/landuse.common'
+ include './com_18/landuse0.common'
+ include './com_18/luc.common'
+ include './com_18/lucflx.common'
+ include './com_18/nspc.common'
+ include './com_18/plant_pool.common'
+ include './com_18/plant_evol.common'
+ include './com_18/soil_pool.common'
+
+ integer ip,ipool,ngt
+ real*4 rbmax
+
+c=======================================================================
+c calculates (absolute and relative) changes in land use fractions
+c with respect to the previous year
+c=======================================================================
+
+ if ((ilu.eq.1).and.(icyr_landuse.ne.0)) then
+
+ dfr_nat = (frac_nat(ngt)-frac_nat0(ngt))
+ if (frac_nat0(ngt).gt.1.e-10) then
+ rdfr_nat = dfr_nat/frac_nat0(ngt)
+ if (rdfr_nat.lt.-1) rdfr_nat = -1
+ else
+ rdfr_nat = 0.
+ endif
+
+ dfr_crop = (frac_crop(ngt)-frac_crop0(ngt))
+ if (frac_crop0(ngt).gt.1.e-10) then
+ rdfr_crop = dfr_crop/frac_crop0(ngt)
+ if (rdfr_crop.lt.-1) rdfr_crop = -1
+ else
+ rdfr_crop = 0.
+ endif
+
+ dfr_past = (frac_past(ngt)-frac_past0(ngt))
+ if (frac_past0(ngt).gt.1.e-10) then
+ rdfr_past = dfr_past/frac_past0(ngt)
+ if (rdfr_past.lt.-1) rdfr_past = -1
+ else
+ rdfr_past = 0.
+ endif
+
+ dfr_urb = (frac_urb(ngt)-frac_urb0(ngt))
+ if (frac_urb0(ngt).gt.1.e-10) then
+ rdfr_urb = dfr_urb/frac_urb0(ngt)
+ if (rdfr_urb.lt.-1) rdfr_urb = -1
+ else
+ rdfr_urb = 0.
+ endif
+
+ dfr_rock = (frac_rock(ngt)-frac_rock0(ngt))
+ if (frac_rock0(ngt).gt.1.e-10) then
+ rdfr_rock = dfr_rock/frac_rock0(ngt)
+ if (rdfr_rock.lt.-1) rdfr_rock = -1
+ else
+ rdfr_rock = 0.
+ endif
+
+ dfr_wat = (frac_wat(ngt)-frac_wat0(ngt))
+ if (frac_wat0(ngt).gt.1.e-10) then
+ rdfr_wat = dfr_wat/frac_wat0(ngt)
+ if (rdfr_wat.lt.-1) rdfr_wat = -1
+ else
+ rdfr_wat = 0.
+ endif
+
+ else
+
+ dfr_nat = 0.
+ dfr_crop = 0.
+ dfr_past = 0.
+ dfr_urb = 0.
+ dfr_rock = 0.
+ dfr_wat = 0.
+ rdfr_nat = 0.
+ rdfr_crop = 0.
+ rdfr_past = 0.
+ rdfr_urb = 0.
+ rdfr_rock = 0.
+ rdfr_wat = 0.
+
+ endif
+
+
+c=======================================================================
+c Stores previous year PFT fractions into frac0 vector
+c=======================================================================
+ do ip = 1, npft
+ frac0(ip) = yfrac_ini(ip,ngt)
+ end do
+
+c=======================================================================
+c Estimation of PFT biomass per m2 of presence (g C m-2) at end of
+c previous year (iday = nd)
+c rootsh = root:shoot ratio (from Mokani et al., Global Change Biol
+c 12, 84-96, 2006)
+c bg_bio = belowground (root) biomass (gC m-2)
+c ag_bio = aboveground (branches and stems) biomass (gC m-2)
+c=======================================================================
+ do ip = 1, npft
+ rbmax = (rootsh(ip)/(1.+rootsh(ip)))
+ & *(ycar_ini(ip,1,ngt)+ycar_ini(ip,2,ngt))
+ bg_bio(ip) = min(ycar_ini(ip,2,ngt),rbmax)
+ if (bg_bio(ip).lt.0.) bg_bio(ip) = 0.
+ ag_bio(ip,1) = max(ycar_ini(ip,1,ngt),0.)
+ ag_bio(ip,2) = ycar_ini(ip,2,ngt)-bg_bio(ip)
+
+ end do
+
+c=======================================================================
+c Total carbon emission to the atmosphere due to land use change
+c (gC m-2 yr-1)
+c Total carbon transfer to the litter due to land use change
+c (gC m-2 yr-1)
+c=======================================================================
+
+c Natural vegetation
+ do ip = 1, npft0
+ if (frac_nat0(ngt).gt.1.e-10) then
+ if (rdfr_nat.lt.0) then
+ yemi_luc(ip,1) = -frac0(ip)*ag_bio(ip,1)*rdfr_nat
+ yemi_luc(ip,2) = -frac0(ip)*ag_bio(ip,2)*rdfr_nat
+ xlit_luc(ip,1) = 0.
+ xlit_luc(ip,2) = -frac0(ip)*bg_bio(ip)*rdfr_nat
+ yfrac_ini(ip,ngt) = frac0(ip) * (1.+rdfr_nat)
+ do ipool = 1, npool
+ ylit_ini(ipool,ngt) = ylit_ini(ipool,ngt)
+ & + xlit_luc(ip,ipool)
+ end do
+ else
+ yemi_luc(ip,1) = 0.
+ yemi_luc(ip,2) = 0.
+ xlit_luc(ip,1) = 0.
+ xlit_luc(ip,2) = 0.
+ yfrac_ini(ip,ngt) = frac0(ip) * (1.+rdfr_nat)
+ do ipool = 1, npool
+ ycar_ini(ip,ipool,ngt)=ycar_ini(ip,ipool,ngt)/(1.+rdfr_nat)
+ end do
+ ylaimin_ini(ip,ngt)=ylaimin_ini(ip,ngt)/(1.+rdfr_nat)
+ ylaimax_ini(ip,ngt)=ylaimax_ini(ip,ngt)/(1.+rdfr_nat)
+ ybinc_ini(ip,ngt)=ybinc_ini(ip,ngt)/(1.+rdfr_nat)
+ endif
+ else
+ yemi_luc(ip,1) = 0.
+ yemi_luc(ip,2) = 0.
+ xlit_luc(ip,1) = 0.
+ xlit_luc(ip,2) = 0.
+ if (ip.le.(nherb+nbush)) then
+ yfrac_ini(ip,ngt) = dfr_nat/float(nherb+nbush)
+ else
+ yfrac_ini(ip,ngt) = dfr_nat/float(ntree)
+ endif
+ do ipool = 1, npool
+ ycar_ini(ip,ipool,ngt)=0.
+ end do
+ ylaimin_ini(ip,ngt)=0.
+ ylaimax_ini(ip,ngt)=0.
+ ybinc_ini(ip,ngt)=0.
+ endif
+ end do
+
+c Crops
+ do ip = npft0+1, npft0+ncrop
+ if (frac_crop0(ngt).gt.1.e-10) then
+ if (rdfr_crop.lt.0) then
+ yemi_luc(ip,1) = -frac0(ip)*ag_bio(ip,1)*rdfr_crop
+ yemi_luc(ip,2) = -frac0(ip)*ag_bio(ip,2)*rdfr_crop
+ xlit_luc(ip,1) = 0.
+ xlit_luc(ip,2) = -frac0(ip)*bg_bio(ip)*rdfr_crop
+ yfrac_ini(ip,ngt) = frac0(ip) * (1.+rdfr_crop)
+ do ipool = 1, npool
+ ylit_ini(ipool,ngt) = ylit_ini(ipool,ngt)
+ & + xlit_luc(ip,ipool)
+ end do
+ else
+ yemi_luc(ip,1) = 0.
+ yemi_luc(ip,2) = 0.
+ xlit_luc(ip,1) = 0.
+ xlit_luc(ip,2) = 0.
+ yfrac_ini(ip,ngt) = frac0(ip) * (1.+rdfr_crop)
+ do ipool = 1, npool
+ ycar_ini(ip,ipool,ngt)=ycar_ini(ip,ipool,ngt)/(1.+rdfr_crop)
+ end do
+ ylaimin_ini(ip,ngt)=ylaimin_ini(ip,ngt)/(1.+rdfr_crop)
+ ylaimax_ini(ip,ngt)=ylaimax_ini(ip,ngt)/(1.+rdfr_crop)
+ ybinc_ini(ip,ngt)=ybinc_ini(ip,ngt)/(1.+rdfr_crop)
+ endif
+ else
+ yemi_luc(ip,1) = 0.
+ yemi_luc(ip,2) = 0.
+ xlit_luc(ip,1) = 0.
+ xlit_luc(ip,2) = 0.
+ yfrac_ini(ip,ngt) = dfr_nat/float(ncrop)
+ do ipool = 1, npool
+ ycar_ini(ip,ipool,ngt)=0.
+ end do
+ ylaimin_ini(ip,ngt)=0.
+ ylaimax_ini(ip,ngt)=0.
+ ybinc_ini(ip,ngt)=0.
+ endif
+ end do
+
+c Pastures
+ do ip = npft0+ncrop+1, npft
+ if (frac_past0(ngt).gt.1.e-10) then
+ if (rdfr_past.lt.0) then
+ yemi_luc(ip,1) = -frac0(ip)*ag_bio(ip,1)*rdfr_past
+ yemi_luc(ip,2) = -frac0(ip)*ag_bio(ip,2)*rdfr_past
+ xlit_luc(ip,1) = 0.
+ xlit_luc(ip,2) = -frac0(ip)*bg_bio(ip)*rdfr_past
+ yfrac_ini(ip,ngt) = frac0(ip) * (1.+rdfr_past)
+ do ipool = 1, npool
+ ylit_ini(ipool,ngt) = ylit_ini(ipool,ngt)
+ & + xlit_luc(ip,ipool)
+ end do
+ else
+ yemi_luc(ip,1) = 0.
+ yemi_luc(ip,2) = 0.
+ xlit_luc(ip,1) = 0.
+ xlit_luc(ip,2) = 0.
+ yfrac_ini(ip,ngt) = frac0(ip) * (1.+rdfr_past)
+ do ipool = 1, npool
+ ycar_ini(ip,ipool,ngt)=ycar_ini(ip,ipool,ngt)/(1.+rdfr_past)
+ end do
+ ylaimin_ini(ip,ngt)=ylaimin_ini(ip,ngt)/(1.+rdfr_past)
+ ylaimax_ini(ip,ngt)=ylaimax_ini(ip,ngt)/(1.+rdfr_past)
+ ybinc_ini(ip,ngt)=ybinc_ini(ip,ngt)/(1.+rdfr_past)
+ endif
+ else
+ yemi_luc(ip,1) = 0.
+ yemi_luc(ip,2) = 0.
+ xlit_luc(ip,1) = 0.
+ xlit_luc(ip,2) = 0.
+ yfrac_ini(ip,ngt) = dfr_nat/float(npast)
+ do ipool = 1, npool
+ ycar_ini(ip,ipool,ngt)=0.
+ end do
+ ylaimin_ini(ip,ngt)=0.
+ ylaimax_ini(ip,ngt)=0.
+ ybinc_ini(ip,ngt)=0.
+ endif
+ end do
+
+
+ return
+ end subroutine fraction_luc
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_funcx2.f b/couplage/CARAIB/ver01_Iv_couplage/mod_funcx2.f
new file mode 100644
index 0000000..0b87a23
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_funcx2.f
@@ -0,0 +1,96 @@
+c=======================================================================
+c***********************************************************************
+ subroutine funcx2(x, fx)
+c***********************************************************************
+c=======================================================================
+c jlp implicit double precision (a-h,o-z)
+ implicit none
+ include './com_18/parameter.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/kernel.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer i
+c
+c-----------------------------------------------
+
+ real*4 :: zref,Karm,Co,hv,d,z0,vt,H0_rh,zm,alph,
+ & scalefactor,sigm,
+ & wald,wald_max,my,lambda,
+ & sum_wald,sum_wald_max,U,mu,sig
+ real*8 x,fx
+
+c-------------------------------------------------------------------
+c Subroutine funcx is designed by the user to define f(x).
+c x = at entry, contains the value of x at which f(x) is
+c evaluated; it cannot be changed by funcx
+c fx = at exit, fx contains the value of f(x)
+c Variables may be transferred from the main programme or
+c the subroutine calling "nonlineq" through user-defined commons.
+c--------------------------------------------------------------------
+
+ zref = 10. ! H�he der ZAMG Windgeschwindigkeitsmessungen
+ Karm = 0.6 ! von Karman constant (0.6 f�r Waldinneres (siehe Thompson & Katul 2008), 0.4 f�r offene Vegetation (Katul et al. 2005))
+ Co = 3.125 ! Kolmogorov constant (after Skarpaas et al. 2007)
+ hv = 30. ! vegetation height
+ d = 0.7 * hv ! following Soons et al. (2004), see also Skarpaas et al.(2007)
+ z0 = 0.1 * hv ! following Soons et al. (2004), see also Skarpaas et al.(2007)
+ vt = 0.57 ! terminal velocity
+ H0_rh = 25. ! release height
+ zm = hv + zref ! angenommene H�he der Windgeschwindigkeitsmessung - standardisiert als zref (der Messh�he der empirischen Daten der ZAMG) �ber der canopy height h, cf. Thompson & Katul (2008)
+ alph = 0.1
+
+
+ if(isp.eq.8) then
+
+ scalefactor = (1-exp(-alph))/alph
+ sigm = (2*(1.3**2))*Karm
+ & *((H0_rh-d)/(Co*scalefactor*log((zm-d)/z0)))**0.5
+
+ sum_wald = 0.
+ sum_wald_max = 0.
+
+
+ do i = 1, 96
+
+ U = midpoint_pi(i) * scalefactor
+ my = (H0_rh*U)/vt
+ lambda = (H0_rh/sigm)**2.
+
+ wald = ((lambda/(2.*pi*(x)**3.))**0.5
+ & *exp((-lambda*(x-my)**2.)/(2.*my**2.*x)))
+
+ wald_max = ((lambda/(2.*pi*(Xmax)**3.))**0.5
+ & *exp((-lambda*(Xmax-my)**2.)/(2.*my**2.*Xmax)))
+
+ sum_wald = sum_wald + wald*probdenswind_pi(i)
+ sum_wald_max =
+ & sum_wald_max + wald_max*probdenswind_pi(i)
+
+ enddo
+
+ fx = spec_npp*sum_wald/(2.*pi*(x+1./2.))
+ & - ynppf_max*sum_wald_max/(2.*pi*(Xmax+1./2.))
+
+c fx = spec_npp*sum_wald - ynppf_mean*sum_wald_max
+
+ endif
+
+ if(isp.eq.6) then
+
+ sig = 2.9
+ mu = 5.1
+
+ fx = ((spec_npp*(1./((2.*pi)**0.5*sig*x))
+ & *exp(-(((log(x)-mu))**2./(2.*(sig)**2.))))
+ & /(2.*pi*(x+1./2.)))
+ & -((ynppf_max*(1./((2.*pi)**0.5*sig*Xmax))
+ & *exp(-(((log(Xmax)-mu))**2./(2.*(sig)**2.))))
+ & /(2.*pi*(Xmax+1./2.)))
+
+ endif
+
+ return
+ end subroutine funcx2
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_generator.f b/couplage/CARAIB/ver01_Iv_couplage/mod_generator.f
new file mode 100644
index 0000000..49bb798
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_generator.f
@@ -0,0 +1,260 @@
+c=======================================================================
+c***********************************************************************
+ subroutine generator (graine,iprint)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c!!!!!Routine de generation des annees de pluie et de temperatures.!!!!!
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c routine generant une annee de pluie pour chaque climat:
+c tire 365 nombres au hasard entre 0 et 1,compare avec la
+c proba apropriee en fonction du resultat precedent puis
+c calcule le nombre de jours de pluie pour chaque mois.
+c !!!!!!Ce tirage au sort convient dans l'hemisphere nord.
+c Dans l'hemisphere sud,il faut decaler de six mois, c.a.d
+c prendre les 181 premiers jours et les placer aux 181 dernieres
+c positions puis prendre les 184 derniers jours et les placer
+c aux 184 premieres cases du tableau (meme principe pour les
+c nombres de jours de pluie).!!!!!!
+c
+c Si on l'utilise comme routine,on a interet a la lancer en
+c demandant de sortir les tablaux occurrence (suite des jours
+c d'une annee pour les 176 categories) , nombrejp(nombre de
+c jours de pluie des 12 mois de l'anne pour les 176 categories)
+c et listezone (liste des 176 categories en question)
+c pour chaque pixel,il faudra commencer par en etablir
+c la categorie et memoriser en quelle position arrive
+c cette categorie dans le tableau listezone
+c
+c INPUTS: (1) At input, the user must supply the "seed" for
+c generation and his choice for printing generator outputs:
+c - graine: seed for generation (any real*4 value)
+c Changing graine from one call to the other allows
+c to change the calculated distribution at random,
+c while keeping consistency with the climate statistics.
+c - iprint=1/0 to print (1) or not print (0) outputs from
+c weather generator, i.e., contents of common /gene/
+c (see below) on unit 23 (binary file to be opened by
+c user). This is useful to avoid call to generator
+c in later applications using the same characteristics.
+c No other input needs to be supplied by the user.
+c (2) The necessary data (weather statistics for every
+c climatic zone) are read by "generator" or its subroutines
+c into data files_ibm stored in /ALLSTAT/... directories.
+c (3) subroutine "ctgen" must be called prior to the call to
+c "generator" to set a series of constants, including the
+c names of the 176 geoclimatic zones (vector listzone)
+c (4) "pathgene" a character*80 variable in common "pathg"
+c must contain the name of the directory in which /ALLSTAT
+c can be found
+c
+c OUTPUTS: The outputs of "generator" are returned in common /gene/.
+c These outputs provides the relative distribution over 1 year
+c of daily precipitation (P), daily temperature (T), and
+c daily amplitude of diurnal temperature signal Tmax-Tmin (DT)
+c - rapportP(izon,iday): ratio of daily precipitation at day
+c "iday" to monthly precipitation in geoclimatic
+c zone "izon". The sum of rapportP over a given
+c month is equal to 1.
+c - rapportT(izon,iday): ratio of daily temperature in Kelvin
+c at day "iday" to monthly mean temperature (K) in
+c geoclimatic zone "izon". The mean of rapportT
+c over a given month is equal to 1.
+c - rapportDT(izon,iday): ratio of daily amplitude of diurnal
+c temperature signal (i.e. Tmax-Tmin) at day "iday"
+c to its monthly mean average in geoclimatic zone
+c "izon". The mean of rapportDT over a given
+c month is equal to 1.
+c - ioccu(izon): occurrence of precipitation at day "iday" in
+c geoclimatic zone "izon". "ioccu" is equal to 1 if
+c precipitation occurs at days and 0 otherwise.
+c - nombrejp(izon,im): number of rainy days in month "im" and
+c geoclimatic zone "izon" for northern hemisphere.
+c - nombrejpS(izon,im): number of rainy days in month "im" and
+c geoclimatic zone "izon" for southern hemisphere.
+c The outputs may be printed on unit 23 at the end of the
+c subroutine to be read and used by another application. This
+c avoids the call to "generator" and reduces compting time.
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/gene.common'
+ include './com_18/lstz.common'
+ include './com_18/monthcst.common'
+ include './com_18/pathg.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer i,iday,iprint,izone,j,jm,k,kdays,kf,knorm1,knorm2,m,mth,n
+ & ,nbrstat
+c
+c-----------------------------------------------
+
+ real*4 p(nm),pp(nm),ss(nm),pm(nm),ppm(nm),ssm(nm),proba,hasard
+ real*4 graine,ampligraine,rampli,rap
+ real*4 alpha1
+ real*4 tabrT(ndy),tabrDT(ndy)
+
+ integer l
+ integer flag(ndy)
+
+ character*110 filename
+
+ do i=1,nzone
+ do j=1,nd
+ ioccu(i,j)=1
+ rapportP(i,j)=0.0
+ rapportT(i,j)=0.0
+ rapportDT(i,j)=0.0
+ enddo
+ enddo
+
+ call charlen(pathgene,kf)
+
+ ampligraine=graine+0.23
+ do i=1,nzone
+ filename=pathgene(1:kf)//'ALLSTAT/MOYENNES/moy'
+ 1 //listezone(i)
+ open(11,file=filename,status='old')
+ read(11,20)nbrstat
+20 format(19x,i5)
+
+c=======================================================================
+c p(j) : probability of rain during a given day of month j
+c pp(j): probability of rain during a given day of month j
+c when the previous day has been rainy
+c ss(j): probability of drought during a given day of month j
+c when the previous day has been dry
+c In average, there should exists the following relationship
+c between these three probabilities:
+c (1-p(j))*(1-ss(j)) + p(j)*pp(j) = p(j)
+c i.e. p(j) = (1-ss(j))/(2-pp(j)-ss(j))
+c=======================================================================
+
+ do jm=1,nm
+ read(11,30)pm(jm),ppm(jm),ssm(jm)
+30 format(8x,f8.6,2(9x,f8.6))
+ enddo
+ do j=1,nm
+ mth=mondec(j)
+ p(j)=pm(mth)
+ pp(j)=ppm(mth)
+ ss(j)=ssm(mth)
+ nombrejp(i,j)=0
+ enddo
+ close(11)
+ l=0
+ if(p(1).gt.0.5)then
+ l=1
+ endif
+ k=0
+ knorm1=0
+ knorm2=0
+ do j=1,nm
+ mth=mondec(j)
+ do n=1,mlength(j)
+ k=k+1
+ graine=graine+1.14
+ call randnum(graine,hasard)
+ if(l.eq.1)then
+ proba=pp(j)
+ else
+ proba=1.-ss(j)
+ endif
+ if(hasard.le.proba)then
+ ioccu(i,k)=1
+ l=1
+ call randnum(ampligraine,rampli)
+ call calrapportprecip(listezone(i),mth,rampli,
+ & rap)
+ rapportP(i,k)=rap
+ if (rapportP(i,k).le.0.0)then
+ rapportP(i,k)=0.00001
+ endif
+ ampligraine=ampligraine+1.26
+ nombrejp(i,j)=nombrejp(i,j)+1
+ else
+ ioccu(i,k)=0
+ rapportP(i,k)=0.
+ l=0
+ endif
+ enddo
+
+ if (nombrejp(i,j).eq.0) then
+ kdays=numday(j)
+ ioccu(i,kdays)=1
+ rapportP(i,kdays)=1.0
+ nombrejp(i,j)=1
+ endif
+
+c=======================================================================
+c normalisation des rapports de precipitation a l'unite.
+c=======================================================================
+
+ alpha1=0.0
+ do n=1,mlength(j)
+ knorm1=knorm1+1
+ alpha1=alpha1+rapportP(i,knorm1)
+ enddo
+ do n=1,mlength(j)
+ knorm2=knorm2+1
+ if(alpha1.gt.0.0)then
+ rapportP(i,knorm2)=rapportP(i,knorm2)/alpha1
+ endif
+ enddo
+ enddo
+
+c=======================================================================
+c appel a la routine qui calcule les rapports pour T
+c=======================================================================
+
+ do j=1,nd
+ flag(j)=ioccu(i,j)
+ enddo
+ call TDT(mlength,mondec,flag,tabrT,tabrDT,listezone(i)
+ & ,ampligraine)
+
+c=======================================================================
+c !!! dans TDT, ampligraine est placee dans seed (= graine) !!!
+c=======================================================================
+
+ do j=1,nd
+ rapportT(i,j)=tabrT(j)
+ rapportDT(i,j)=tabrDT(j)
+ enddo
+ enddo
+
+c=======================================================================
+c calcul du nombre de jours de pluie dans l'hemisphere Sud
+c=======================================================================
+
+ do izone=1,nzone
+ do m=1,nm
+ nombrejpS(izone,m)=0
+ enddo
+ do iday=1,nd
+ m = imonth(iday)
+ if(iday.le.181)then
+ nombrejpS(izone,m)=nombrejpS(izone,m)
+ & +ioccu(izone,iday+184)
+ else
+ nombrejpS(izone,m)=nombrejpS(izone,m)
+ & +ioccu(izone,iday-181)
+ endif
+ enddo
+ enddo
+
+ if (iprint.eq.1) then
+ write(23) rapportP
+ write(23) rapportT
+ write(23) rapportDT
+ write(23) ioccu
+ write(23) nombrejp
+ write(23) nombrejpS
+ endif
+
+ return
+ end subroutine generator
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_hourly.f b/couplage/CARAIB/ver01_Iv_couplage/mod_hourly.f
new file mode 100644
index 0000000..4b37b87
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_hourly.f
@@ -0,0 +1,32 @@
+c=======================================================================
+c***********************************************************************
+ subroutine hourly
+c***********************************************************************
+c=======================================================================
+ IMPLICIT NONE
+
+ include './com_18/parameter.common'
+ include './com_18/cstpi.common'
+ include './com_18/hcst.common'
+ include './com_18/heure.common'
+ include './com_18/nspc.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer ih
+ real*4 h
+c
+c-----------------------------------------------
+
+ do ih = 1, nh2
+ h = (float(ih)-0.5)*xhstep/12.
+ hour(ih) = pi*(h - 1.)
+ hour1(ih) = hour(ih) - (xhstep/2.) * (pi/12.)
+ hour2(ih) = hour(ih) + (xhstep/2.) * (pi/12.)
+ cohour(ih) = cos(hour(ih))
+ codelhour(ih) = (sin(hour2(ih)) - sin(hour1(ih)))
+ & / (hour2(ih) - hour1(ih))
+ enddo
+
+ return
+ end subroutine hourly
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_humiseas.f b/couplage/CARAIB/ver01_Iv_couplage/mod_humiseas.f
new file mode 100644
index 0000000..5dbfad0
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_humiseas.f
@@ -0,0 +1,47 @@
+c=======================================================================
+c***********************************************************************
+ subroutine humiseas(p,mwet)
+c***********************************************************************
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer m,mb,mth,mwet
+ real*4 p,pmax,ppt,sum
+c
+c-----------------------------------------------
+
+ dimension p(nm), mwet(5)
+ dimension ppt(nm2), mth(nm2)
+
+ do m = 1, nm
+ mth(m ) = m
+ mth(m+nm) = m
+ ppt(m ) = p(m)
+ ppt(m+nm) = p(m)
+ enddo
+
+ sum = 0.
+ do m = 1, 5
+ sum = sum + ppt(m)
+ enddo
+ pmax = sum
+ mb = 0
+
+ do m = 1, 11
+ sum = sum + ppt(m+5) - ppt(m)
+ if(sum .gt. pmax) then
+ pmax = sum
+ mb = m
+ endif
+ enddo
+
+ do m = 1, 5
+ mwet(m) = mth(mb+m)
+ enddo
+
+ return
+ end subroutine humiseas
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_koppen2.f b/couplage/CARAIB/ver01_Iv_couplage/mod_koppen2.f
new file mode 100644
index 0000000..c8c1498
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_koppen2.f
@@ -0,0 +1,274 @@
+c=======================================================================
+c***********************************************************************
+ subroutine koppen2(climate)
+c***********************************************************************
+c=======================================================================
+ implicit none
+ include './com_18/parameter.common'
+ include './com_18/climkop.common'
+ include './com_18/coord.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer j,m,md,mdry,msummer,mtest1,mtest2,mwet,mwinter,n,ns,nwi
+ real*4 g,pa,pmin,psmax,psmin,psummer,ptest1,ptest2,ptest3,pwinter
+ & ,pwmax,pwmin,ta,tmax,tmin
+c
+c-----------------------------------------------
+
+ dimension msummer(3),mwinter(3), mwet(3), mdry(5)
+ character*1 q
+ character*2 u
+ character*3 climate
+
+ q = ' '
+ u = ' '
+ climate = '???'
+
+ if(ylati .ge. 0.) then
+ mwinter(1) = 1
+ msummer(1) = 7
+ else
+ mwinter(1) = 7
+ msummer(1) = 1
+ endif
+
+ do j=1,2
+ mwinter(1+j) = mwinter(1) + j
+ msummer(1+j) = msummer(1) + j
+ enddo
+
+ pa = 0.
+ ta = 0.
+ do m = 1, nm
+ pa = pa + prckop(m)
+ ta = ta + tcelkop(m)
+ enddo
+ ta = ta/12.
+
+c=======================================================================
+c B : Dry Climates
+c Bw : Desert Climate
+c Bs : Steppes Climate
+c=======================================================================
+
+ 1020 continue
+ pwinter = 0.
+ psummer = 0.
+ do j = 1, 3
+ pwinter = pwinter + prckop(mwinter(j))
+ psummer = psummer + prckop(msummer(j))
+ enddo
+
+ ptest1 = 2*ta
+ ptest2 = 2*ta + 14.
+ ptest3 = 2*ta + 28.
+ if( (0.1*pa .le. ptest1) .and. (pwinter .ge. 0.7*pa) ) then
+ g = ptest1
+ elseif( (0.1*pa .le. ptest3) .and. (psummer .ge. 0.7*pa) ) then
+ g = ptest3
+ elseif( 0.1*pa .le. ptest2) then
+ g = ptest2
+ else
+ goto 1010
+ endif
+
+ if(pa .le. 0.5*g) then
+ u = 'Bw'
+ else
+ u = 'Bs'
+ endif
+ if(ta .ge. 18.) then
+ climate = u//'h'
+ else
+ climate = u//'k'
+ endif
+ return
+
+c=======================================================================
+c A : Tropical Climates
+c Af : Tropical Rainy Climate
+c Am : Tropical Wet Climate
+c Aw : Dry Monsoon Climate
+c As : Dry Monsoon Climate
+c=======================================================================
+
+ 1010 continue
+
+ pmin = prckop(1)
+ tmin = tcelkop(1)
+ do m = 2, nm
+ if( prckop(m) .lt. pmin) pmin = prckop(m)
+ if(tcelkop(m) .lt. tmin) tmin = tcelkop(m)
+ enddo
+
+ if(tmin .lt. 18.) goto 1034
+
+ if(pmin .ge. 60.) then
+ climate = 'Af'
+ return
+ endif
+
+ if(pmin .gt. 100.-pa/25.) then
+ climate = 'Am'
+ return
+ endif
+
+ call dryseas(prckop,mwet)
+
+ do j = 1, 3
+ if(mwinter(j) .eq. mwet(1) .or.
+ & mwinter(j) .eq. mwet(3)) then
+ climate = 'Aw'
+ return
+ endif
+ enddo
+
+ do j = 1, 3
+ mtest2 = msummer(j) + 1
+ if(mtest2 .eq. 13) mtest2 = 1
+ if(msummer(j) .eq. mwet(1) .or.
+ & msummer(j) .eq. mwet(3) .or.
+ & mtest2 .eq. mwet(1) .or.
+ & mtest2 .eq. mwet(3)) then
+ climate = 'As'
+ return
+ endif
+ enddo
+
+ do j = 1, 3
+ mtest1 = mwinter(j) + 1
+ if(mtest1 .eq. 13) mtest1 = 1
+ if(mtest1 .eq. mwet(1) .or.
+ & mtest1 .eq. mwet(3)) then
+ climate = 'Aw'
+ return
+ endif
+ enddo
+
+ call humiseas(prckop,mdry)
+
+ nwi = 0
+ ns = 0
+ do md = 1, 5
+ do j = 1, 3
+ if(mdry(md) .eq. mwinter(j)) nwi = nwi + 1
+ if(mdry(md) .eq. msummer(j)) ns = ns + 1
+ enddo
+ enddo
+
+ if(nwi .gt. ns) then
+ climate = 'Aw'
+ return
+ endif
+
+ if(nwi .lt. ns) then
+ climate = 'As'
+ return
+ endif
+
+c=======================================================================
+c C : Mid-Latitude Rainy Climate
+c Cs : with dry summer
+c Cw : with dry winter
+c Cf : precipitation in all seasons
+c D : Continental Climate
+c (Ds : with dry summer)
+c Dw : with dry winter
+c Df : precipitation in all seasons
+c=======================================================================
+
+ 1034 continue
+
+ tmax = tcelkop(1)
+ do m = 2, nm
+ if(tcelkop(m) .gt. tmax) tmax = tcelkop(m)
+ enddo
+
+ if(tmax .ge. 10.) then
+ if( (tmin .ge. -3.) .and. (tmin .lt. 18.) ) then
+ q = 'C'
+ elseif(tmin .lt. -3.) then
+ q = 'D'
+ else
+ goto 1050
+ endif
+ else
+ goto 1050
+ endif
+
+ if(pmin .gt. 30.) then
+ u = q//'f'
+ else
+ pwmin = prckop(mwinter(1))
+ pwmax = prckop(mwinter(1))
+ psmin = prckop(msummer(1))
+ psmax = prckop(msummer(1))
+ do j = mwinter(2), mwinter(3)
+ if(prckop(j) .lt. pwmin) pwmin = prckop(j)
+ if(prckop(j) .gt. pwmax) pwmax = prckop(j)
+ enddo
+ do j = msummer(2), msummer(3)
+ if(prckop(j) .lt. psmin) psmin = prckop(j)
+ if(prckop(j) .gt. psmax) psmax = prckop(j)
+ enddo
+
+ if( psmax .gt. 10*pwmin) then
+ u = q//'w'
+ elseif(pwmax .gt. 3*psmin .and. pmin .le. 30.) then
+ u = q//'s'
+ else
+ u = q//'f'
+ endif
+ endif
+
+ if(tmax .ge. 22.) then
+ climate = u//'a'
+ return
+ endif
+
+ n = 0
+ do m = 1, nm
+ if(tcelkop(m) .gt. 10.) n = n + 1
+ enddo
+
+ if(n .ge. 4) then
+ climate = u//'b'
+ return
+ endif
+
+ if((n .ge. 1) .and. (n .le. 3)) then
+ climate = u//'c'
+ return
+ endif
+
+ if(tmin .lt. -38.) then
+ climate = u//'d'
+ return
+ endif
+
+c=======================================================================
+c E : Polar Climates
+c ET : Tundra climate
+c EF : Snow climate
+c=======================================================================
+
+ 1050 continue
+ if(tmax .le. 10.) then
+ if(tmax .gt. 0.) then
+ climate = 'ET'
+ else
+ climate = 'EF'
+ endif
+ else
+ write(*,*) ' '
+ write(*,*) ' problem in koppen2 : climate = ', climate
+ write(*,*) ' x, y = ', ylongi, ylati
+ write(*,*) ' tmp = ', tcelkop
+ write(*,*) ' ppt = ', prckop
+ write(*,*) ' '
+ stop
+ endif
+
+ return
+ end subroutine koppen2
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_monthparam.f b/couplage/CARAIB/ver01_Iv_couplage/mod_monthparam.f
new file mode 100644
index 0000000..a7aafd4
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_monthparam.f
@@ -0,0 +1,68 @@
+c=======================================================================
+c***********************************************************************
+ subroutine monthparam
+c***********************************************************************
+c=======================================================================
+c=======================================================================
+c reads constants for weather generator and 'sets' them in commons
+c variables declaration
+c=======================================================================
+ implicit none
+ include './com_18/parameter.common'
+ include './com_18/monthcst.common'
+
+ integer m,iday
+
+c=======================================================================
+c reference times for the seasonal cycle modeling:
+c
+c imonth = month corresponding to each day;
+c mlength = length of each month;
+c numday = representative day for each month.
+c=======================================================================
+
+ if (nd.eq.360) then
+ do m = 1, 12
+ mlength(m) = 30
+ end do
+ else
+ mlength(1) = 31
+ if (nd.eq.365) then
+ mlength(2) = 28
+ else
+ mlength(2) = 29
+ endif
+ mlength(3) = 31
+ mlength(4) = 30
+ mlength(5) = 31
+ mlength(6) = 30
+ mlength(7) = 31
+ mlength(8) = 31
+ mlength(9) = 30
+ mlength(10) = 31
+ mlength(11) = 30
+ mlength(12) = 31
+ endif
+
+
+ do iday = 1, nd
+ imonth(iday) = 1
+ enddo
+
+ ini(1) = 1
+ ifin(1) = mlength(1)
+ do m = 2, nm
+ ini(m) = ini(m-1) + mlength(m-1)
+ ifin(m) = ifin(m-1) + mlength(m)
+ do iday = ini(m), ifin(m)
+ imonth(iday) = m
+ enddo
+ enddo
+
+ do m = 1, nm
+ mondec(m) = m
+ numday(m) = (ini(m)+ifin(m))/2
+ end do
+
+ return
+ end subroutine monthparam
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_neighborhood.f b/couplage/CARAIB/ver01_Iv_couplage/mod_neighborhood.f
new file mode 100644
index 0000000..e8d2bf8
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_neighborhood.f
@@ -0,0 +1,77 @@
+c=======================================================================
+c***********************************************************************
+ subroutine neighborhood(ngt)
+c***********************************************************************
+c=======================================================================
+
+ IMPLICIT NONE
+c-- JLP implicit double precision (a-h,o-z)
+
+ include './com_18/parameter.common'
+ include './com_18/coord.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/disper.common'
+ include './com_18/griddata.common'
+ include './com_18/input_par.common'
+
+ integer i,j,k,ngt
+ double precision xlg1,xlt1,xlg2,xlt2,distan
+
+
+ ylongi = xlg(ngt)
+ ylati = xlt(ngt)
+
+ do k = 1, n_nghmx
+ neighbor(k,ngt) = 0
+ end do
+
+ n_nghi = 0
+
+ do i = 1, n_pix
+ if (i.ne.ngt) then
+ do j = 1, ncor(ngt)
+ do k = 1, ncor(i)
+ if (abs(xlgcor(k,i)-xlgcor(j,ngt)).lt.prec_co) then
+ if (abs(xltcor(k,i)-xltcor(j,ngt)).lt.prec_co) then
+ n_nghi = n_nghi+1
+ if (n_nghi.gt.n_nghmx) then
+ write(*,*)'Maximum number of neighbors n_nghmx=',n_nghmx,
+ & ' not large enough',
+ & ' Increase its value in parameter.common - Program Stop'
+ write(61,*)'Maximum number of neighbors n_nghmx=',n_nghmx,
+ & ' not large enough',
+ & ' Increase its value in parameter.common - Program Stop'
+ stop
+ endif
+ neighbor(n_nghi,ngt)=i
+ go to 100
+ endif
+ endif
+ end do
+ end do
+ 100 continue
+ endif
+ end do
+
+ n_ngh(ngt) = n_nghi
+
+ do k = 1, n_ngh(ngt)
+ i = neighbor(k,ngt)
+ xlg1 = xlg(i)
+ xlt1 = xlt(i)
+ xlg2 = ylongi
+ xlt2 = ylati
+ ylon(k,ngt)= (xlg1+xlg2)/2.
+ ylat(k,ngt)= (xlt1+xlt2)/2.
+ call distance(xlg1,xlt1,xlg2,xlt2,distan)
+ dist_ngh(k,ngt)=distan
+ end do
+
+ write(61,'(3x,i7,2(1x,f9.4),8(3x,i7))')
+ & ngt,ylongi,ylati,(neighbor(k,ngt),k=1,n_nghi)
+ write(61,'(30x,8(1x,f9.4))') (ylon(k,ngt),k=1,n_nghi)
+ write(61,'(30x,8(1x,f9.4))') (ylat(k,ngt),k=1,n_nghi)
+
+ return
+ end subroutine neighborhood
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_neighborhood_old.f b/couplage/CARAIB/ver01_Iv_couplage/mod_neighborhood_old.f
new file mode 100644
index 0000000..c38cb80
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_neighborhood_old.f
@@ -0,0 +1,124 @@
+c=======================================================================
+c***********************************************************************
+ subroutine neighborhood_old(ngt)
+c***********************************************************************
+c=======================================================================
+
+c implicit double precision (a-h,o-z)
+ IMPLICIT NONE
+
+ include './com_18/parameter.common'
+ include './com_18/coord.common'
+ include './com_18/cte.common'
+ include './com_18/disper.common'
+ include './com_18/griddata.common'
+ include './com_18/input_par.common'
+
+ integer i,j,k,l,m,n,ngt,ngt2
+ real*4 xlo_inf,xla_inf,xlo,xla,aaa,bbb
+
+ n_nghi = 8
+
+ n = 3
+ m = n-1
+ l = m/2
+
+ ylongi = xlg(ngt)
+ ylati = xlt(ngt)
+
+ if(ngt.eq.1) then
+
+ open(unit=600,
+ &file='./neighbor_t.dat')
+ open(unit=601,
+ &file='./neighborlon_t.dat')
+ open(unit=602,
+ &file='./neighborlat_t.dat')
+
+ endif
+
+c// NOTE: ce qui suit ne fonctionnera pas correctement
+c// pour des grilles irr�guli�res, comme p.ex., les T21, T42
+
+ ylon(1,ngt) = ylongi-declg/2.
+ ylon(2,ngt) = ylongi
+ ylon(3,ngt) = ylongi+declg/2.
+ ylon(4,ngt) = ylongi-declg/2.
+ ylon(5,ngt) = ylongi+declg/2.
+ ylon(6,ngt) = ylongi-declg/2.
+ ylon(7,ngt) = ylongi
+ ylon(8,ngt) = ylongi+declg/2.
+
+ ylat(1,ngt) = ylati-declat/2.
+ ylat(2,ngt) = ylati-declat/2.
+ ylat(3,ngt) = ylati-declat/2.
+ ylat(4,ngt) = ylati
+ ylat(5,ngt) = ylati
+ ylat(6,ngt) = ylati+declat/2.
+ ylat(7,ngt) = ylati+declat/2.
+ ylat(8,ngt) = ylati+declat/2.
+
+ xlo_inf = ylongi-l*declg
+ xla_inf = ylati-l*declat
+
+ do k = 1, n_nghi
+ neighbor(k,ngt) = 0
+ enddo
+
+ k = 1
+
+ do i = 0, m
+ do j = 0, m
+ if(i.eq.1.and.j.eq.1) go to 200
+ do ngt2 = 1, n_pix
+ xlo = xlo_inf+j*declg
+ xla = xla_inf+i*declat
+ if(xlg(ngt2).eq.xlo.and.xlt(ngt2).eq.xla) then
+ neighbor(k,ngt) = ngt2
+ k = k+1
+ go to 200
+ endif
+ if(ylongi.eq.12.250.and.ylati.eq.55.750) then !connexion between Europe and Scandinavia
+ if(k.eq.5.and.xlg(ngt2).eq.13.250
+ & .and.xlt(ngt2).eq.55.750)
+ & neighbor(k,ngt) = ngt2
+ if(k.eq.8.and.xlg(ngt2).eq.13.250
+ & .and.xlt(ngt2).eq.56.250)
+ & neighbor(k,ngt) = ngt2
+ endif
+ if(ylongi.eq.13.250.and.ylati.eq.55.750) then !connexion between Europe and Scandinavia
+ if(k.eq.4.and.xlg(ngt2).eq.12.250
+ & .and.xlt(ngt2).eq.55.750)
+ & neighbor(k,ngt) = ngt2
+ endif
+ if(ylongi.eq.13.250.and.ylati.eq.56.250) then !connexion between Europe and Scandinavia
+ if(k.eq.1.and.xlg(ngt2).eq.12.250
+ & .and.xlt(ngt2).eq.55.750)
+ & neighbor(k,ngt) = ngt2
+ endif
+ enddo
+
+ k = k+1
+
+ 200 continue
+
+ enddo
+ enddo
+
+ write(600,'(2(1x,f8.3),8(1x,i6))')
+ & ylongi,ylati,(neighbor(k,ngt),k=1,n_nghi)
+ write(601,'(8(1x,f8.3))') (ylon(k,ngt),k=1,n_nghi)
+ write(602,'(8(1x,f8.3))') (ylat(k,ngt),k=1,n_nghi)
+
+ if(ngt.eq.n_pix) then
+
+ close(600)
+ close(601)
+ close(602)
+
+ endif
+
+ if(imig.eq.1) read(96,*)aaa,bbb,irfg(ngt)
+
+ return
+ end subroutine neighborhood_old
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_netcdfcaraib.mod b/couplage/CARAIB/ver01_Iv_couplage/mod_netcdfcaraib.mod
new file mode 100644
index 0000000000000000000000000000000000000000..3100e2fe85d2ace9dee77a134623b6f59bd79454
GIT binary patch
literal 64175
zcmdU2378bswJua#h`RxmL>)y?QE?V#WJpAMdTM4Gda8$BMwqDW22qS?jJTj8F1VoL
ziVH?!Oi)AO5)DQ%8Z|);CTdJDibj(dG$DyG3nq{EqVJq@>sH@WT{ZNrImFNYV7mMM
z=luV<OWmz*cW>tma$bMZasEBXaZVoBSl?9N>U_#^oHbj(AOF!<-`Fsw0sg`JzfPDp
z9h1=pAK<o0A47chQ%*ghJZt(H$Dc6c_+w8$_N3#=^{r!OINiDSvga1l?H%b<K9y;6
zwqwEU$lmq$MrC8r&Rd0y1_3b0NYvTY&)U2psqkjR5H0L%O5x4>5su2S3RLIUaT=56
zST(HZ97hSOKr6ycNreaZljEqO78BmGAK|DR8<!q=j!l|l)qZL(YE?p&qHazqymdc0
zjw)&~;cfa6jw)(ZHI*E<B+aqvr)n>1<I*PeLz4=tj<|MVRW+3yk4q}Ntz}WGs;LOK
zCKXnG8_%)svGfq4r5oy#DsNw7mbJ1TBm?Ed!^93T$~69l+Y;Db_>p>O<)k@QBWQJ5
zZ))A0V)7d|9_xJS=fqXKbBu6Yh6l})Dd=53Cf!fl>N*bPSQm8ChBegJ4fhIE!A9aR
zE#$m^UhooLw2o<QX>F`;ZEYFXG_GY_OKZJ*U{m7WTd54%*$`Io;q=c){O?4wtJ2;%
z+;LIa7>Si=&|yg@xxt_6vS}Yc+3ZHN)m^|QzZ7@36c(G454RL1bK_6q&gV0h!eSG}
z&squ_nWdMBbG%25!ogfTRLPCaiLd!RYm^QOIe4LR-%#I}cw)Ynt#)YE)>uC_@w~0B
zM(v=;^=w9E+i7k{y!6|<Mrp06LiKgwsVTAYKK&@03le$d5&bAftw<`lRj(3XTKmQb
z$IWE?8RJJffTSb)$Qa$Y@gj6ZJBjDWqb!AWUF!@dZe08IBWyM<ol`O4{reG)YFlE<
z>;w7{j>@r^@aTSoqjDVTH=V@2=7BW|>$(kZJvJmBrw*!7S+_1SH~u8<Ko0)6gvZn<
z91O_83zhAGjLe7FYS$@E{dZhLYvO*S{$td}y?t2gY;*%Wm=%PY+W;nFjr~ZQok>v3
z!3%P922$Nk{b)z^CrYvMH}S<aHbyvZbbiYpp0#w+(Ye`D_t!$YEta}(2<aYbsr$N+
z?l?=`HA1?rmb$MA>5jM5eN{;JbC$Zl64L#=rS2<2x`$cnt`^drV5$2{A>G3*b$=nG
zJJC}2Wg*>^rS8v#blWU-UlP(yTk5_jq}y((`+|_JYpMG)A>9s3-Jc5Ss!i$Yd1c%@
z=XoLBF3bF`64K3B>i$GXcao*<b3(e4Ep?w2(#=}xJ|m>tZK=CbNY}H}{jrd4&QkYB
zLb^Scx=#z~PO;Q|N=P?vsr#gmZXrf@lke6RErs>Q8o9xrMzvFeZ|A{(*l!E(^&u4T
zC{fzxTdNj^Z`84lq<p=?d`I|vm0b>%^`!Alt>RPXMUwJO6Xxp^=KF#$-;u(6M+x&C
zEzDOI<~v51?^t2J<AnK+7v?)bm~Xl;-wa{CFADRWD9m?~FyBmJzLSOdz9h_diZI_S
zVZKv^`A!q&`?4_K>B4+p5#~EXm~XZ)-<iUEX9@G2EzEb0Fy9<uzH^27)Ungex30{`
z2R45`UpT(G!h9D9^UV|HyHJ?#B4NIZh50TK=9@3fcd0PnWx{-y3-ete%(p<8?@D35
ztAzQk7Uo+h%y*42-?hSg*9r4oFU)s?FyD>Be2awnZW89ZS(xt@VZK|1`4$WF-6qWU
zRbjr{h542U^L<U2?+#(UuM6|tDa`i`VZLt)^DPzTyGxkwZehNAg!#TD%(qOK@7uzB
z-x21!SD5cUVZQr?`5qAF`>rtGgTj0d3G;nVm~Xi--^0Ru-xub4M40bUVZIf@e2)q9
z{Xm%SabdnEg!z6b%=e@)-&4YTPYd(?NSN=(!h9=*`JNHxdsdk5Ibpt^2=lEH=6hb4
z@2A3iKNIGAL74AFVZN7y`F<|U_p&hGFNFDiDa^N8nC}%~zF!IRy(-N2nlRrQVZPU6
z__m{T{bxu0Vx!M*kVW+;7{VuHH}jdc4KXJFx{P02D)SsVPDA3aN_^8&dHZml6Mr+x
zTb9Z@gq0J2XW?%wmBTG4`6v8;Tch&keqKNFpY>B?bK*?@u14v>S~{fN(%jsXSp4l8
z#RvJ~I{*G#Cvo%sy`}ILTG4+_+`8A+C>#ie8rj(T*2Lc<@lK7}K`HBE_cJ|!Px!xE
zqjX5o7j~S)pR)ghrEoZa#NS2pM@wNnc<3xA{tk(Cmcm+4KPN8gKUoTk74@Gjg~f{c
zFP6f(i1l;gqJGa(Sgff3YAGyM)bCpg>mt_AiHrJgmcn91{dY@Yom2gsILH666c)?z
zKP`oWG1AX+;z4<Rjl#M$*ZG3_Dfze3eNdxvkkyd%K)!6~Uo~p$nV&O}9D+X$EluMR
z7x}+!#peaO^rETp(3Zqs<@G-`iicaa4k7WSwZT$296;jP$p6L&$9)L@HlYuf{-34p
zVj<oCSnA#?r2C<z?kz&PYEf3bMG;rOHw)<!f5exD#p&K8q>EcGQD0UTr@Kf<cQZ@f
z8-;W?x758sNOucM-Rp&P2V3f1C#1WjrS7#tx?5T5UL&NtwWaPtA>C~(b*~oE9b&0_
zm5}bIEOoCG(%sflcY%=Zc9yzV2<dKbse8GQ?hcl^mkH_aXsLUtknT>Fy7Pr}ced2M
zL`ZiROWlh@x`)ub5dX}B|FEaKHNM{X<I|)o_tC?l!hFMo`F0iN+fA5ncVWKa!hD|*
z=KHKL-yXtzdkXXICCpbR%(u5N-#)^8BZT?(73Lc$%r{DyZ$Dwa{e}4s5at^#%y*zL
z-$BBB2MhC!5#~EYn6F-#uR)lvQJAkum~X5wU$Zb@i!k4z!hGX|`C5hf#tZX(PMGiW
z!hDAb^Gy)uJ6xD=qA*`dn6FKkFD=a1F3jf&^K}UGbqe!!3G-!y`6dbTO%~?M3iEXf
z^LfI2IbpsYVZJHCe0gEMf-qlEn6D(v*DK6-gfQP!VZLd?e0{=vUl8UyQkd^3VZNh<
z`O3n4#|ZNsE6jJCFyHaQd?&>4@ejI$&dB$3TV*=&RiBf=^CVHf_D1FgU*ZE;Gc1Mm
zQA4er_&E3%Ero-VhQ4y*6MiRJ3Wx8AB|hDEQjNm8h{LTX`Nw!>S}ND++V!84pCdil
zQh8!Xxg~Kmf2l@g{h^Y1A?1d~#1(x?jncsZ){ypq&XCTkQJl;|dB(Si&yb$lkFfb;
znOays>lhMuVW(LNYeD^-ILBYM6c+2kPVYxJYP8Tf)z67@{FRSO_>3Bb_0>%0Ep>L`
zc>o^~n_Z){?zSfyviLH27j|Zi%0asdUZ@ZT^7FH2*=pA*P5pNu9{@P}W7IyUM(s_|
z(B||bZFZnREe9_KUft)`s7+?Nj*aKUJ<548!gK*|WhnSB-wGXIN;=^_-%|ItLb`J;
zb)|mg_yS8^sb4vsXQ?aoE5{dF>Pr2}@kN%pQonM1v8ArmuN+@usVns>$MY?9rGDl3
zQcGQ_Upc<aQdjC%jxV>=mHL(AD=c-Te&u+9rLNSk(Ozk(EA{KjS6S*x{krnimby~E
zuDsAvSL)Z5ud&pX`gP@NV|2qCi+c4^7n*V<-}<>OMmcU~CpE*mK1Mg3V={x>>Svwt
z#QP98SPJVR*TRXnQg4hAjw@-YU$R~lqr1sV`X)<Zv68;oQaD&8`gNT6dx37T6b>y7
zoy6Oyw^|AZdzyZZ6MqHMVoTvI^=0HgC;m2~+bo4cy2&?CzZxSPcNt$Ov?RSfMmO#<
z7R&IG7~!}K51OZPtOH28_Wzo#E_^x)l?SSOhp)ShCi0)DppC>~0sj7Z!Ap42I;ORy
zwXwdnwPjq>xR!A(t@ZAKO^Mt2*ZpXQm=f@sqA?OH(V*dyPHi3?P0|mP-AU0@f1u2$
z<1L&m!nee9EY;87P`TShZy_b+`KA!hQX!tZgm~^2;<+cD$FZreZ}~j>GBE1Pif36o
zk5&8mc6`39c)laVbFUE3eepb2<$S--Gtl~aAfCsnoWC2NFDsr0g?Jtk;`v@Yk5zpw
z_jv|dUk}IgSe5hl<MU<3^N0}7qe46@;(4s<>oK2ap!M~Gcpj^Aemp*3Ry<D#@%&JT
z=gD{;tNMD%=NV{yJsr<uRn9+(&zBX?kA-+v3h_J>&tp|z&-y$At*__ed92F$C-M2R
z;#noc^SltxPvd#4>g#7d&p_+zg?JvTa(*#BUsgOX#q(H|&(DSO^>TbXR{8oxJdahr
zekqi%)jp5j3N+RiR{46RKOX!7l^P$viZ377yQ`h&RUw|&gm~5n@w_g?^G1kAe=Gmi
z4ivM+e!{PP9(sa0)~AAp=mfvsHv`^LgTmXdj<Y%H#XOS6^yVgvDe3j`mLJnV_g#Jy
z&tp|@zx8?ahL({pE1uuQ^H^Q4Z^!4$is$!2JZnQdN!#K(J`X)XJD0pZj5@RGtKaP}
zZx(&*A3}N4SMpYRF!8VJxNAQyz2-i_BGx~~#i}c2Be8CZnAZKbVzTJZ{}dC`Hvg?U
zwTSi4pP*R(@(GIdy-!fAfBgi-`u-;<*1vrWv5pAlffLoM-GYREU;JIg%6`%clSX6;
z#Z<9WaQ*@BK3k#KtlimhV&!fBuh17}M8OTSq(S~OB1k+2F~W~=J>Vmb=t>nkGFjL8
zK)=goJlFXbyffk-GSMP_<fZuO*>OIDZ`EV7Eli#reFKe#o-rci2_-uXFsV0Vvst8J
zzRcM0mg*hwA8(f8cr#<xh#9jSYy~gE|8w9!KD>@{+q9xf>0Q8Jq-VTh1Eu4(qmiEO
zO68s1!FN2+8tH|uT)s#S4{-p98l7Fi;UK6Z!vWHXXDLta$mUXtXHS>}8TNTMm34*#
z&&@o&Jy&XjYQ~UugrgybM~U)=E?0zrO0b*3p$^kUM|Ccw&jC+-Kq*0T%UDuh&w-Lc
z_5ia}VL@^>Igkr9zN{);1mBGS!L`9bunbdKBM9=Oa^4fbR{;#us`$~h2X?E%DDXB?
zLwYV6bdYu;ELRr7Gd>`Lq^ZgtX<vvysRH%_@W@Y9yZW_&m&7`Njof&-Bk~z&W4i-%
zJp4YO0Vx1|-rztwn`>)x^Hew`n423uUQUD9m|x%^=7MUe6MC?70mldA&dU*k9!~?J
zk30a9&7~((XcJ&rVx$+KnY&IMIIIA`plTW0mMNBV9UTR?NCnvpJ1Is>QFwc*n4*i}
zevYQwJDQz+f%Sl$Sgs10KDP_%t=#T*q)OSMgXMfD*cf%2%4Ryfa=NSJO?LJHc=*nY
zq9d2@P8G}PY^qSmq$%_pA}uIFXFp)r7P=s#Xnh8j!;xS%zaKNoC<gmsq!Hy8`?Rw@
z&7|5hg~?gBP@pn;A26c?ySr08RP!^3GM|!{&2&RcYNr~0n}eOuVxWIOsUxB9GitIs
zHMQKH=`IlEtJPSlSj-p5u?W3X$gwx&V=n<_v;rjcQr)VBOonz<?WaVs)jtckQOsV>
z&F3i(69F|U*lkO-XH@PU2_f!O7=X#A9{MxWC*$=(zES3$5Ypr3yQvw}!4+n@c)4Q6
zgNBCVAztjagzx~Y18_$uQq!6A(z#r|T@~8pAskAEN*ntaWH)`W#4=u~;L^}}b{NgU
z6r)Hr@qP#bQh=1;iNI`<LZKC>^(e~URAUefWpXMsQqzrEQ%_EDz7zsMk7^zY#_6i#
zj!=4lQ4XFAL4G5IdT_?=UFGGaskJ{4LJEGq_J?cQ3=m?V76#?(+!4b3OM&{I-C!DJ
z`gys$o2KZoQCu5BgW-E?=!Hx-x4l!9;k*z~DCRTmE>+9FLl6`_g@_qG4SEWbFQ4*&
z5RpHG5HHv5b`#$*qqq-74ILq2uZA#eREQyC4|HCpRxw|K!o}=92go__j1L^upc~Fo
zRi*Z4K(Cu`%RxKDo@)g_J>)??8E;BCn`r|J)i#D4z+fm2xO{VY3bK!5nL=S&0WWT(
zT^7QCwk=g~%g|I2-oRlPO#&FRIB7IfO~c>|V<@)A#T+U75MFQVBB6434>i2;2QtcB
zkLyvHE#T>80<hJsi2#rcvC#)HG7O)FSg18;PBrEaYh^XWknAdMm3P60YIpd-jN0|u
z5y7m_<Ve|vb^~YyhYHjD1~Fs|BTKd6EEQWy9|vGk0nGtRei;Ya-K+~Gj}zDp9D#;H
zMKKBH*rE2*lPY#mud}!s^Mb)>T?9xME_TY}>#JBj>I3TlTu=>Cmw=reHiR|RxL@*E
zjH4SEHIy!nRTS?W4&k)`5DZG_w<;2();zqCQTl$=Ibb|9BjGGGKtxw?H1DDxg@md@
znyRRAn7}gXi-aIry8a?T8Y)n9LnMqLq4T7%QKCVAyqLr3T+g&J28G1yIOgXDQOwQw
zW=0IHiyZ3!TEL;6QW2qY(VbePVSEk8JK>UJ_~;f!t^H}0f&6nguKfdi6~_(#M$#XC
zDC0N$8>!4@a@_DIcm;<IcLzp9XUI6lZg|7O3k~|Xf#DAZn7?J*Kr_&?1@R3W*93&)
ze0oxAWCZ@o1}zqI3(a7zeYgc)T6(fDemtYcO9UZo#|t7Mza6iM1gR-vOC9~WC|YXf
zbpX$agjFAe_^L=;UGs<!|9lj^>WS#e=D6S5F=IGNtl%hJCx{{Qki!@=Ru@2(=HAC~
zENq4^<GA(@n)3#ZYySYBG$B$SaMj!wbKLM(&3zrm4Sj0v;}2)_hCAhc0f)7B&{)@S
zT)PL2b@W6=ul<e2I)__m2Hyg&s8!s;=V(w>fCj@;OvI-!3}$kJfPo4b8CGzEfFUp#
z(#9lAhDLSSa|4q>)zdO=U@|y$5W)tIn*<~<DIFaF6*cBzF*gVZ$N;9-&N^-oMBo=S
znv8E}A_0d{8w<FJ&yuRt#u{$ma~KArT_zGR1cg0^8w3o2!76TGGN{@Z-oYeH22~p~
zxq-<*wXuTZCV?6TI+;M=AJj%4HwXxV+E~U70tTZtHgJ=G!>El(T~ToqDz&kg8~7ZC
z!8&f>$5Fto#0JXh_zaT>7y^R@+`wc|wXud9m<*~mMo(fACIi*R9FCg=6yhq52mV2A
z44=#d0)n76W^#jo!KjTD+$7*IYGX*2$@nbYmD=dz20n*ju#6i73_)RU;06IhU@)mW
zItDOMwXv8Rm<*~m)^P(f2C9wm9#b$0s5TaGJn#={V+}V52!h%eons0CgHaoExJkg_
zo9qLf*(z@0vo!dd<Y+M*)<f`*9<U7eEmDTX%t#BmI$%1794jI%x_u7pn1@V>QZYpO
zxPhM+Gtgy`7G|IuA}!27C*@ffL5V@b@TabeBQ5+uam~374CYX2(G~=5xp<wlXg{IA
zkX~G%pvRj$J=c?(Qd0MEV6|X!xn4<aw!F;K)4A@RT*+&vHA}X{b~ou}fVz8vQ_N=p
zJ--s2Le(t@tf=;0wzcB#B71HTHh;%DuqEL<-k(LVV~xwBmLu3!swTnOeh{E@;Ta#$
zru=>Ga(52aP&A7^cq)s7Hp<HdcM5@bMS`U^nyc+KEy@#in+kN@-NIqmb;zVV*#0eM
zdR;QusgL>l2H8xp2sfs1mb@U+pe@r$Yr@UHz}zWt*yTpY^FmP0D`q-NIk*vvrL{hc
zcK4*xY85)`NX7|wO}gCl<N~w>q<xp89k9g#c)qET%IcV-LcWErQU}<O=4%|((0;(0
zKbrX!`Z7IbHx2tq#Z1mCcc%)I>8```U}iRUH1j-WwmY!7W!4nBdor0EEh?S@z-W#D
zz&37XDn&Qp7>4zz21J$o7(nL$FFv6C;3hZhfVI1D8xo6T?6C|^=dxKhO*M=qeJ`MA
zqbEGT+3jlYz<s_w;O)rcIFwF#utk_s^>=#&sP1~<g*Ei}YFB?d51FqH!EoWZ-7ef%
z!ll*V6Syxd*#hkR5C+=>0k%Gb!J3LNjOUc;oD*7&*-NYq!9Yv*B~)WPYDU<(=%vR}
z*{%*j*uSL#ZK68s{$hk<6ZLW{tDqi#WqH_%+zHY%UPf&TEe~O^P2HLAf#oz7>cJ;*
zM|JzaUu!Q7fv}8*B|O|GQNDZ3tn%&1xLE}*ss^c#qT1T-WbO&KxM+!v5zP-_S=i~N
zy;Q8`|3rYe9g2>#zr;zQ2^7*PxK43^_)7@%a!>|T8`Do=<CSV~WnHk#If|RXgkeuV
zcoy@-<v6&NQ|UC`%ENF=+yXZ_yfhRpVoR$r2&q69=lV#DHaYeMSNBvVjI`iN+k_n@
zxaEsWtVQuQIA~)0Ya>lC57-OTfkpFaQ9>#YBLSZujbjkX2)mNi)kaWM8MtAF=*TZu
zNzitSx{79V6gQA`y{+Vsztw^$W`F4EjMm?I!u!eCp2%c6H}Q9%0+TvmS<X!~3wGsH
zK7+r)R5S(Qqrkt!aqVvmFle=uTWJ=<3M+j*x6)iRJmU0-8paus@dP$?z_W<kXdb%6
z5MRsjAR0VNfUTx^Hq+4lYLq97`P@P?7#6F!h30@5ig3&URYso4R5XWgfxYwWY76W`
zbh}y^2h+tj^sFj+>VWnJ;_1~G+@po9IJ~V|2L{Wz0Y)DT4A}Mt!_Ww`b$Zay3f^!M
zL602=08olFN#*mYX%)jdFkBiooKnH@3S1wLt2^>&<ibGD0;-Ud=`P~_V6><oBaiy^
zf`hGfZ9jIZ`^PzMGfZjXB*}_8vjf3${>ChEYBJS12uxRR%+x=Jf&q*?cOwB%bz%Us
zH)g4}hYtbMl^ZjKu8T@kb^k-pV=+)O$IchK|LGi~296kxWXn0$k$2rPEp^aw@cC7w
zw5Y*rqQtR`M=dW{^DGU+Q{bK<%z?4du8+pbaB~`u9^p0V&SlCNGP;-Hez-qtT*NIf
z!~RkXyZW^pMSmZ~Ic4(&j2#!rFr%U=(R>c!l2SvfIpi;`sf0()t0IJPr-889k(ioF
zu8hRgcr^4v#_2C^RfR@EN^W^1=FeO&ilQt~e_o2fpplf}CTusBIrjNWxeb+oX+xFE
zZSeNAS`VgEu+X9UcQ39A!!*GK%_44sEI8*0o2}($ei<>dVZhdWi6NMVX_tek^I2-H
z$D>=#t63`D07v7I^GymoEVL`6&St5-&<KfnB~SK^hhAz@zyehXPG`vl7<PzyIV1;*
zrgXmjh&=5|jJeEArWque-_6q9sp%}4*IjO!)A1rozZKG<hogs=_UNYlZt!lGE6nt+
z;AZ~SEFF5Od~q7x%-?E(u{V(JQUDgsMF7BcP7f~)CxF#qzmFifk}Y*Yks><#N)u2k
zHRSmlOUDz4q&xE}(_9@*B;aiZ_~(L<=*X*051NDQ4#}$_8M<0}KuJ`NEA}j`6a}6L
zf?H@LunN+l)1(KbLq|+N$2B1UI}Vh1It)NlCSby~6>Xw|k&1vv0WdUraeYCh)O?+p
z33Z+gCGLZC7@q0jrTyb<2#mU(0WiA4Dg}Wh98kyH5Eym?^H8VUux%{l03C8ehb?bp
z4s^ziB<6BJwLbLtfCF@<jXY*8VpLEjFm*@mcQ`;JIx-!76Law31hXphS2zGnaJCse
zyqlQ^Eka4+nJPeC;}dRS4tQt`c^>A;bO?liF}E^%Q0`S8cX0quv#D!(&&A9G+bl8N
z#M8mSKU%Z>ZI!0!r8{zP08=%n%K<nWg2RWG_K!qi`8i)T+l@M$g}FF~rK_`9r2TgQ
zDoii{<Z`NCnt8j)MCZKm>Ux_c(^)svJ#vX@t#&Tad^JnY=KMWZ?`x*HIuwmzKFiYm
z4RPe3c!%krDgo0Ug>)T0H2L7DeZ$u)_K+T&$y)~LhJEFf`aX9ufFi|+7DGC81oQx+
z%Gvq-zrg^Em3As0hIC_=iX&P!*ICZGz5XWZmfwUEk3J)=-0@TwTp1~vmUs-Lp%9@x
z!2Tu%DZe8!p7MK>f#^pN`i)vztp{Km>CIxG@8@TPK@emXj=`2(MZ7l<e;9AjMiF=1
zRjr)wDyfJUG7yys!iZmCkjg25D&jrwHc5Ry74ZxPRU#&0jQGBI0~PTH%s?p@x-u%_
z3HOAR3BrgkWl-R!B7T8^7%}*%h=+a4q^v|t#2E3>@dhg5yO@De?#ZWB#P2Z>l?lR#
zTb7y1fuD+aE(3i(74b6+szgl081eSsHi?;minx~<DCPEIN=3Ycfv8LnM*I$g0zVb;
znD3aXzMqQtOa@f~B4UjAiFgAQ@s{_R<XX8+MeH$9DFcKN-^8H6PeuGD1ARXg@u>Su
zJu_k;#)xOd8>omMW(G>R=yt1!KV%>(6NC|W+;1ueek$UH4D|g}#IG=@5-|~D#Ctwq
z5;FsJgJ=db@ReaY2{B_}_c55X6*vOG4;W~WE0evzWWsk%eMR3>p}&;DNbiG4{{jOm
z^u9?Qm<)TcLZ5~0#7sMGm6zLdaQ+|hqZwYz;30jD4+s1%1NYLn;)el<Hkse6Mqq-2
zJ}nPbG-2WmOE~Q_w;J(%o?!^)Q~PZHJ(G<P@EHm^y@0?xjvjqzj*077qR&2exyb>y
zi~{y&suA$P@pb!$D?WXARudHv=&b_40~hs63_z6?mM1~)FbInzfW~~kqT}J=eFY5z
z!ZQI1G8i}vdBk+U%n*c)F%J;*8T9Zvi(@ko^CZ{<rno-@P_rR07Ay$3{?Q76)&yWh
zj#^QnE2iCS!!#GBd6?CgO$09AsTFAMV}_I4o$(Ze;f?-51uB%hu3RavKrGf*3=qb}
z3UJZm6))(_E5Mj1DgewI6oApK0pKWj#z$AmYtOo6ykm!#%%MM2g?B82M(U5a)<N<G
zV4`PYzBepr@Z5ia?qU9`nnL3v{ZFAD05pd`={QArHk1Oh-~*~?cmo*Xv@6b#KD+w=
Dyulty
literal 0
HcmV?d00001
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_netcdfcaraib_09.f b/couplage/CARAIB/ver01_Iv_couplage/mod_netcdfcaraib_09.f
new file mode 100644
index 0000000..44f12e6
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_netcdfcaraib_09.f
@@ -0,0 +1,137 @@
+!=======================================================================
+ MODULE MOD_NETCDFCARAIB
+!=======================================================================
+
+ IMPLICIT NONE
+
+ INCLUDE 'netcdf.inc'
+
+ ! *cooa for reading coordinates
+ INTEGER, SAVE :: ncid_filcooa=0, ncvar_cooa=0
+
+ ! *wina corresponds to former unit 9
+ INTEGER, SAVE :: ncid_filwina=0, ncvar_wina=0
+ ! *winb corresponds to former unit 999
+ INTEGER, SAVE :: ncid_filwinb=0, ncvar_winb=0
+ REAL, SAVE :: ncfillvalue_wina, ncfillvalue_winb
+
+ ! *rhua corresponds to former unit 8
+ INTEGER, SAVE :: ncid_filrhua=0, ncvar_rhua=0
+ ! *rhub corresponds to former unit 888
+ INTEGER, SAVE :: ncid_filrhub=0, ncvar_rhub=0
+ REAL, SAVE :: ncfillvalue_rhua, ncfillvalue_rhub
+
+ ! *shra corresponds to former unit 7
+ INTEGER, SAVE :: ncid_filshia=0, ncvar_shia=0
+ ! *shrb corresponds to former unit 777
+ INTEGER, SAVE :: ncid_filshib=0, ncvar_shib=0
+ REAL, SAVE :: ncfillvalue_shia, ncfillvalue_shib
+
+ ! *prca corresponds to former unit 4
+ INTEGER, SAVE :: ncid_filprca=0, ncvar_prca=0
+ ! *prcb corresponds to former unit 444
+ INTEGER, SAVE :: ncid_filprcb=0, ncvar_prcb=0
+ REAL, SAVE :: ncfillvalue_prca, ncfillvalue_prcb
+
+ ! *dt1a corresponds to former unit 3 Tmax
+ INTEGER, SAVE :: ncid_fildtaa=0, ncvar_dtaa=0
+ ! *dt2b corresponds to former unit 333
+ INTEGER, SAVE :: ncid_fildtab=0, ncvar_dtab=0
+ REAL, SAVE :: ncfillvalue_dtaa, ncfillvalue_dtab
+ ! *dt2a corresponds to former unit 3 Tmin
+ INTEGER, SAVE :: ncid_fildtba=0, ncvar_dtba=0
+ ! *dt2b corresponds to former unit 333
+ INTEGER, SAVE :: ncid_fildtbb=0, ncvar_dtbb=0
+ REAL, SAVE :: ncfillvalue_dtba, ncfillvalue_dtbb
+
+ ! *tema corresponds to former unit 2
+ INTEGER, SAVE :: ncid_filtema=0, ncvar_tema=0
+ ! *temb corresponds to former unit 222
+ INTEGER, SAVE :: ncid_filtemb=0, ncvar_temb=0
+ REAL, SAVE :: ncfillvalue_tema, ncfillvalue_temb
+
+ ! *tclima corresponds to former unit 81
+ INTEGER, SAVE :: ncid_filtclima=0, ncvar_tclima=0
+ REAL, SAVE :: ncfillvalue_tclima
+ ! *pclima corresponds to former unit 82
+ INTEGER, SAVE :: ncid_filpclima=0, ncvar_pclima=0
+ REAL, SAVE :: ncfillvalue_pclima
+
+ LOGICAL, SAVE :: l_gridinit_done = .FALSE.
+ LOGICAL, SAVE :: l_timeinit_done = .FALSE.
+
+ INTEGER :: ncdim_lon=0, ncdim_lat=0
+ INTEGER :: nclen_lon=0, nclen_lat=0
+ INTEGER :: ncvar_lon=0, ncvar_lat=0
+ DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:), SAVE :: zlon, zlat
+ INTEGER, SAVE :: ncpos_lon=0, ncpos_lat=0
+ DOUBLE PRECISION, SAVE :: zdel_lon, zdel_lat
+ INTEGER :: ncdim_time=0
+ INTEGER :: nclen_time=0
+ INTEGER :: ncvar_time=0
+ DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:), SAVE :: ztime
+ INTEGER, SAVE :: ncpos_time=0
+
+ INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ngt4ilonjlat
+ INTEGER, ALLOCATABLE, DIMENSION(:) :: ilon4ngt, jlat4ngt
+
+ REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: tcel1year
+ REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: temax1year
+ REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: temin1year
+ REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: sunhour1year
+ REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: rhu1year
+ REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: prc1year
+ REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: win1year
+
+
+!-----------------------------------------------------------------------
+ CONTAINS
+!-----------------------------------------------------------------------
+
+ SUBROUTINE HANDLE_ERR(istatus)
+
+ IMPLICIT NONE
+
+ INCLUDE 'netcdf.inc'
+
+ INTEGER :: istatus
+
+ IF (istatus /= NF_NOERR) THEN
+ PRINT *, NF_STRERROR(istatus)
+ PRINT *, 'NetCDF error detected; aborting.'
+ CALL ABORT()
+ ENDIF
+
+ END SUBROUTINE HANDLE_ERR
+
+
+ !*******************************************************
+ SUBROUTINE HANDLE_NCERRORS(status, whatfile, whatline)
+ !*******************************************************
+!
+ IMPLICIT NONE
+
+ INCLUDE 'netcdf.inc'
+
+ INTEGER, INTENT(IN) :: status
+ CHARACTER(LEN=*) :: whatfile
+ INTEGER, INTENT(IN) :: whatline
+
+ IF (STATUS /= NF_NOERR) THEN
+ IF(whatline > 0) THEN
+ WRITE(*,'("[",A,":",I0,"]: ", A)')
+ > TRIM(whatfile), whatline, TRIM(NF_STRERROR(STATUS))
+ ELSE
+ WRITE(*,'("[",A,":???]: ", A)')
+ > TRIM(whatfile), TRIM(NF_STRERROR(STATUS))
+ ENDIF
+ PRINT *, 'NetCDF error detected; aborting.'
+ CALL ABORT()
+ ENDIF
+ END SUBROUTINE HANDLE_NCERRORS
+!
+
+!=======================================================================
+ END MODULE MOD_NETCDFCARAIB
+!=======================================================================
+
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_new_frac2.f b/couplage/CARAIB/ver01_Iv_couplage/mod_new_frac2.f
new file mode 100644
index 0000000..37e9573
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_new_frac2.f
@@ -0,0 +1,233 @@
+c=======================================================================
+c***********************************************************************
+ subroutine new_frac2
+c***********************************************************************
+c=======================================================================
+c implicit double precision (a-h,o-z)
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/annee.common'
+ include './com_18/annppf.common'
+ include './com_18/burned.common'
+ include './com_18/coord.common'
+ include './com_18/cte.common'
+ include './com_18/disper.common'
+ include './com_18/ecoin.common'
+ include './com_18/estab.common'
+ include './com_18/files_car.common'
+ include './com_18/frac_change.common'
+ include './com_18/gddpix.common'
+ include './com_18/griddata.common'
+ include './com_18/inidata.common'
+ include './com_18/init.common'
+ include './com_18/input_par.common'
+ include './com_18/landuse.common'
+ include './com_18/mort.common'
+ include './com_18/npp.common'
+ include './com_18/nspc.common'
+ include './com_18/pho_sch.common'
+ include './com_18/plheight.common'
+ include './com_18/tresh.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ real*4 aaa,bbb
+c
+c-----------------------------------------------
+
+ character*50 title,pft_name(nplant)
+ character*132 sdata
+ character*100 formatw
+ integer k,ip,ngt,ipft
+ real*4 herb_seed,tree_seed
+
+c=======================================================================
+c reads PFT tolerance parameters
+c=======================================================================
+ open(14,file=filebagtol)
+ read(14,*)title
+ do ip = 1, npft
+ read(14,125) pft_name(ip),sdata
+ read(sdata,*)ipft,ic4(ip),idec(ip),ttreshi1(ip),
+ & ttreshi2(ip),ttresha1(ip),ttresha2(ip),
+ & wattresh1(ip),wattresh2(ip),xpar_tresh1(ip),
+ & xpar_tresh2(ip),gdd_est(ip),tcmax_est(ip),
+ & watmax_est(ip),pgerm(ip),bag_h(ip)
+ enddo
+
+125 format(a50,a132)
+ close(14)
+
+c=======================================================================
+c reads initial values of carbon pools
+c=======================================================================
+ open(19,file=filecinit)
+ read(19,*)title
+ do ip = 1, npft
+ read(19,126) pft_name(ip),sdata
+ read(sdata,*)(carb_init(ip,k),k=1,npool)
+ enddo
+
+126 format(a50,a70)
+ close(19)
+
+ do ngt = 1, n_pix
+ ylongi = xlg(ngt)
+ ylati = xlt(ngt)
+ do ip = 1, npft
+ ynppf(ip)=ynppf_grd(ip,ngt)
+ end do
+
+ read(83,*)aaa,bbb,yfnoburn
+ read(86,*)aaa,bbb,(ftot(ip),ip=1,npft)
+
+ read(87,*)aaa,bbb,(Fgdd5(ip),ip=1,npft)
+ read(88,*)aaa,bbb,(FTmmin(ip),ip=1,npft)
+ read(89,*)aaa,bbb,(Fwatmin(ip),ip=1,npft)
+
+c=======================================================================
+c initialization
+c=======================================================================
+
+ hole_herb = 0.
+ hole_tree = 0.
+ strat_herb = 0.
+ strat_tree = 0.
+ stratnew1 = 0.
+ stratnew2 = 0.
+
+ do ip = 1, npft0
+
+ frac(ip) = yfrac_ini(ip,ngt)
+
+ if(ip.le.nherb+nbush) then
+ strat_herb = strat_herb + frac(ip)
+ else
+ strat_tree = strat_tree + frac(ip)
+ endif
+
+ enddo
+
+c=======================================================================
+c loss fraction
+c=======================================================================
+
+ do ip = 1, npft0
+
+ fracnew(ip) = ftot(ip)*frac(ip)
+
+ enddo
+
+ do ip = 1, nherb+nbush
+ stratnew1 = stratnew1 + fracnew(ip)
+ enddo
+
+ do ip = 1+nherb+nbush, npft0
+ stratnew2 = stratnew2 + fracnew(ip)
+ enddo
+
+ do ip = 1, npft0
+ perte(ip) = frac(ip)-fracnew(ip)
+ enddo
+
+
+c hole_herb = strat_herb-stratnew1
+ hole_herb = frac_nat(ngt)-stratnew1
+ if(hole_herb.lt.0.) hole_herb = 0.
+
+c hole_tree = strat_tree-stratnew2
+ hole_tree = frac_nat(ngt)-stratnew2
+ if(hole_tree.lt.0.) hole_tree = 0.
+
+c=======================================================================
+c seed production
+c=======================================================================
+
+ do ip = 1, npft0
+ seed_prod(ip) = 0.
+ seed_estab(ip) = 0.
+ dispin(ip) = 0.
+ dispout(ip) = 0.
+ frac_seed(ip) = 0.
+ density(ip) = 0.
+ if(suc_est(ip,ngt).gt.1.e-5) then
+ density(ip) = 1.
+ dispin(ip) = carb_init(ip,2)
+ if(ip.ne.isp) pres_new(ip,ngt) = 1
+ if(ip.eq.isp.and.pres_new(ip,ngt).eq.0) then
+ density(ip) = 0.
+ dispin(ip) = 0.
+ endif
+ endif
+
+ end do
+
+ do ip = 1, npft0
+
+ seed_prod(ip) =
+ & Fgdd5(ip)*frac(ip)*ynppf(ip)+dispin(ip)-dispout(ip)
+ seed_estab(ip) =
+ & FTmmin(ip)*Fwatmin(ip)*pgerm(ip)*seed_prod(ip)
+
+ enddo
+
+ herb_seed = 0.
+ tree_seed = 0.
+ do ip = 1, nherb+nbush
+ herb_seed = herb_seed + density(ip)*seed_estab(ip)
+ enddo
+
+ do ip = nherb+nbush+1, npft0
+ tree_seed = tree_seed + density(ip)*seed_estab(ip)
+ enddo
+
+ if(herb_seed.gt.0.) then
+ do ip = 1, nherb+nbush
+ frac_seed(ip) = hole_herb
+ & *(density(ip)*seed_estab(ip)/herb_seed)
+ enddo
+ endif
+
+ if(tree_seed.gt.0.) then
+ do ip = nherb+nbush+1, npft0
+ frac_seed(ip) = hole_tree
+ & *(density(ip)*seed_estab(ip)/tree_seed)
+ enddo
+ endif
+
+ do ip = 1, npft0
+ frac(ip) = fracnew(ip) + frac_seed(ip)
+ enddo
+
+c=======================================================================
+c write migration
+c=======================================================================
+
+ do ip = 1, npft0
+ pres(ip,ngt) = pres_new(ip,ngt)
+ yfrac_ini(ip,ngt) = frac(ip)
+ enddo
+ write(formatw,*)'(f8.3,1x,f8.3,',npft,'(1x,i1))'
+ write(78,formatw)
+ & ylongi,ylati,(pres(ip,ngt),ip=1,npft0)
+ do ip = 1, npft0
+ do k = 1, n_nghmx
+ pres_side(ip,k,ngt) = preside_new(ip,k,ngt)
+ enddo
+ if(ip.eq.isp) then
+ write(76,'(2(1x,f8.3),8(1x,f12.3),8(1x,i10))')
+ & ylongi,ylati,(prop(ip,k,ngt),k=1,n_nghmx),
+ & (prop_time(ip,k,ngt),k=1,n_nghmx) ! MARIE
+ write(77,'(2(1x,f8.3),8(1x,i6))')
+ & ylongi,ylati,(pres_side(ip,k,ngt),k=1,n_nghmx)
+ endif
+ enddo
+
+ write(formatw,*)'(f8.3,1x,f8.3,',npft,'(1x,f10.8))'
+ write(60,formatw) ylongi,ylati,(frac(ip),ip=1,npft)
+
+ enddo
+
+ return
+ end subroutine new_frac2
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_nonlineq2.f b/couplage/CARAIB/ver01_Iv_couplage/mod_nonlineq2.f
new file mode 100644
index 0000000..936b6e2
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_nonlineq2.f
@@ -0,0 +1,219 @@
+c=======================================================================
+c***********************************************************************
+ subroutine nonlineq2(xa,xb,nint,x,fx,ermax,nitmax,imeth,num,ngt)
+c***********************************************************************
+c=======================================================================
+
+c Subroutine nonlineq solves a non linear equation of the type:
+c f(x) = 0
+c by the bisection method or the "regula falsi" method.
+c It calls the user-defined subroutine "funcx(x,fx)" which
+c define the f(x) function.
+c
+c xa = lower bound of interval in which the solution is
+c searched for
+c xb = upper bound of interval in which the solution is
+c searched for
+c nint = number of intervals into which [xa,xb] is divided
+c when searching for a (smaller) interval of changing
+c sign (e.g. 10)
+c x = - at entry, x is set to any value between a and b;
+c it may represent an "initial guess" of the solution
+c - at exit, x contains the estimated value of the zero
+c of the function
+c fx = at output, fx contains f(x), i.e. fx should be close to
+c 0, if x contains a good evaluation of the zero
+c ermax = maximum acceptable error on fx,
+c i.e., when (abs(fx).le.ermax) the zero is accepted
+c nitmax = maximum number of iterations allowed (e.g., 100)
+c imeth = flag to select resolution method. Set imeth to 0 for
+c bisection method and to 1 for "regula falsi"
+c num = at exit, contains total number of iterations performed
+c
+c The variable "precmc" below must be set to a small number
+c representing machine precision. The relative error on the
+c zero (x) cannot be smaller than precmc. With single precision
+c a value of precmc of 1.e-6 is recommended. For double precision
+c a value as small as 1.d-12 can be used.
+c-------------------------------------------------------------------
+c -- JLP implicit double precision (a-h,o-z)
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/cte.common'
+ include './com_18/kernel.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer k,nit
+ real*8 delx,err,errx,fx1,fx2,precmc,prod,prod1,residu,x_old,x1,x2
+c
+c-----------------------------------------------
+ integer nint,nitmax,imeth,num,ngt
+ real*4 xa,xb,ermax
+ real*8 x,fx
+
+ precmc = 1.d-12
+
+ num = 0
+
+ delx = (xb-xa)/float(nint)
+
+c--------------------------------------------------------------
+c initial try with previous value of x and values smaller or
+c larger by an amount delx
+c (sets values for x1 and x2 with fx1*fx2 < 0)
+c--------------------------------------------------------------
+
+ call funcx2(x, fx)
+C write(*,*)'x:',x,' fx:',fx
+
+ if(x.ge.-1.e-2.and.x.le.1.e-2) go to 400
+c if(x.ge.-1.e-3.and.x.le.1.e-3) go to 400 !picea
+
+ err = abs(fx)
+ if (err.le.ermax) go to 300
+
+ x1 = x
+ fx1 = fx
+
+ x = x1+delx
+ if (x.gt.xb) x=xb
+ if (x.lt.xa) x=xa
+
+ num = num + 1
+ call funcx2(x, fx)
+c write(*,*)'x:',x,' fx:',fx
+
+ if(x.ge.-1.e-2.and.x.le.1.e-2) go to 400
+c if(x.ge.-1.e-3.and.x.le.1.e-3) go to 400
+
+ prod = fx*fx1
+ if (prod.gt.0) then
+ x = x1-delx
+ if (x.gt.xb) x=xb
+ if (x.lt.xa) x=xa
+ call funcx2(x, fx)
+c write(*,*)'x:',x,' fx:',fx
+
+ if(x.ge.-1.e-2.and.x.le.1.e-2) go to 400
+c if(x.ge.-1.e-3.and.x.le.1.e-3) go to 400
+ prod1 = fx*fx1
+ if (prod1.le.0) then
+ x2 = x
+ fx2 = fx
+ go to 200
+ endif
+ else
+ x2 = x
+ fx2 = fx
+ go to 200
+ endif
+
+c--------------------------------------------------------------
+c if initial try fails, search for the solution over the
+c entire range xa to xb
+c--------------------------------------------------------------
+
+ x = xa
+
+ num = num + 1
+ call funcx2(x, fx)
+c write(*,*)num,' x:',x,' fx:',fx
+ if(x.ge.-1.e-2.and.x.le.1.e-2) go to 400
+c if(x.ge.-1.e-3.and.x.le.1.e-3) go to 400
+
+ x1 = x
+ fx1 = fx
+
+
+ do k = 1, nint
+ x = xa+delx*float(k)
+ num = num + 1
+
+ call funcx2(x, fx)
+c write(*,*)'x:',x,' fx:',fx
+
+ if(x.ge.-1.e-2.and.x.le.1.e-2) go to 400
+c if(x.ge.-1.e-3.and.x.le.1.e-3) go to 400
+
+ prod = fx1*fx
+ if (prod.gt.0.) then
+ x1 = x
+ fx1 = fx
+ else
+ x2 = x
+ fx2 = fx
+ go to 200
+ endif
+
+ end do
+
+c write(*,*)'No solution found for x between xa and xb'
+C write(*,*)' x=',x,' fx=',fx
+C write(*,*)'program stop'
+ go to 400 !pas dans fagus ???
+C stop
+
+c--------------------------------------------------------------
+c after finding two values of x with fx of different signs,
+c we solve the equation by bisection (imeth=0) or "regula falsi"
+c (imeth=1) method
+c--------------------------------------------------------------
+
+ 200 continue
+
+
+c write(*,*)'Interval of changing sign found'
+
+ do nit = 1, nitmax
+
+ num = num + 1
+
+ x_old = x
+
+ if (imeth.eq.0) then
+ x = (x1+x2)/2.
+ else
+ residu = -fx1*(x2-x1)/(fx2-fx1)
+ x = x1 + residu
+ endif
+
+ call funcx2(x, fx)
+
+ err=abs(fx)
+c write(*,*)num,' x:',x,' fx:',fx
+
+ if(x.ne.0.) then
+ errx = abs((x-x_old)/x)
+ else
+ errx = abs(x-x_old)
+ endif
+ if ((err.le.ermax).or.(errx.le.precmc)) go to 300
+
+ prod = fx*fx2
+ if (prod.gt.0) then
+ x2 = x
+ fx2 = fx
+ else
+ x1 = x
+ fx1 = fx
+ endif
+
+ end do
+
+ write(*,*)'Too much iterations in subroutine nonlineq'
+ write(*,*)'num=',num,' x=',x
+ write(*,*)'fx=',fx
+ write(*,*)'program stop'
+ stop
+
+ 400 continue
+
+ x = -999999.
+
+ 300 continue
+
+
+ return
+ end subroutine nonlineq2
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_open_file.f b/couplage/CARAIB/ver01_Iv_couplage/mod_open_file.f
new file mode 100644
index 0000000..b6722f2
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_open_file.f
@@ -0,0 +1,1355 @@
+c=======================================================================
+c***********************************************************************
+ subroutine open_file(iread)
+c***********************************************************************
+c=======================================================================
+
+ USE MOD_NETCDFCARAIB
+ IMPLICIT NONE
+
+ include './com_18/parameter.common'
+ include './com_18/annee.common'
+ include './com_18/climin0.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/files_car.common'
+ include './com_18/files_ext.common'
+ include './com_18/files_ibm.common'
+ include './com_18/fileunits.common'
+ include './com_18/input_par.common'
+ include './com_18/icyr.common'
+ include './com_18/iprt.common'
+ include './com_18/management.common'
+ include './com_18/netcdf_name.common'
+ include './com_18/netcdf_par.common'
+ include './com_18/nspc.common'
+ include './com_18/co2.common'
+ include './com_18/prt_ctrl.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer i,incdf_winb,ncpos_i,ncpos_j
+ integer kexta,kextb,kexti,kexto,kextlu,kf
+c
+c-----------------------------------------------
+
+c// BEGIN
+ CHARACTER(LEN=*), PARAMETER :: fn_caraib = __FILE__
+c// END
+ character*30 ydat
+c character*20 filext
+ character*245 filename
+ character*5 filexta,filextb
+ character*6 dndata
+ integer iread
+ integer r100,r4,icentury
+
+c// BEGIN
+ INTEGER :: istatus
+ LOGICAL :: l_fileexists
+
+ ncpos_i = 0 ! Initialise Netcdf positions
+ ncpos_j = 0
+c// END
+
+
+ if (num_ncdf.ge.1) then
+ read(5,'(a30,a16,1x,a16,1x,a120,1x,a6)')
+ & ydat,filexto,filextlu,filexti,dndata
+ read(dndata,*)idayct
+ else
+ read(5,'(a30,a16,1x,a16,1x,a120)')ydat,filexto,filextlu,filexti
+ endif
+
+
+ call charlen(filexti,kexti)
+ call charlen(filexto,kexto)
+ call charlen(filextlu,kextlu)
+
+ read(ydat,*)myear,pco2_rd,nys,ipr_clim,iyprt
+c write(*,*)'Reading year: ',myear
+
+ nyear2 = myear
+
+c Determination of leap years according to year number myear
+c -----------------------------------------------------------
+c If ileap = 1, myear must be set to the year number in the Gregorian
+c calendar, otherwise myear can be set to any integer value
+c nd = number of days in the current year
+
+ if (ileap.eq.1) then
+ r100 = mod(myear,100)
+ if (r100.eq.0) then
+ icentury = myear/100
+ r4 = mod(icentury,4)
+ else
+ r4 = mod(myear,4)
+ endif
+ if (r4.eq.0) then
+ nd = 366
+ else
+ nd = 365
+ endif
+ call monthparam
+ endif
+
+c Cumulated day number since a given date (e.g., 1/1/1860)
+c --------------------------------------------------------
+c idayct = cumulated day number on the 31st of December
+c of the previous year (initiated in subroutine open_input5
+c and calculated in main program)
+c idayct + 1 -> cumulated day number on the 1st of January
+c of the current year
+c idayct + nd -> cumulated day number on the 31st of December
+c of the current year
+
+c write(*,*)'Year: ',myear,' idayct:',idayct
+
+ open(1,file=filtxt,status='old')
+
+ if (nyear.eq.1.and.iclim.eq.1) then
+ open(666,file=filclim,status='old')
+ endif
+
+ if(iclim.eq.0) then
+ iclim_cal = 0
+ else
+ if(nyear.eq.1.or.nyear2.eq.ibb) then
+ read(666,*) iaa,ibb,filexta,filextb
+ iclim_cal = 0
+ else
+ iclim_cal = 1
+ endif
+ call charlen(filexta,kexta)
+ call charlen(filextb,kextb)
+ endif
+
+ if(iclim_cal.eq.0) then
+
+! Temperature -- unit 2
+ iunit_tema = 2
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_tem, iunit_tema, icyr_tem, filexti, kexti, extin,
+ & filtem, 'temperature climatology (i)',
+ & ncname_tem,
+ & ncid_filtema, ncvar_tema)
+
+
+! Temperature difference -- former unit 3
+c
+c Open 2 files: Tmax and Tmin and calculate the difference Tmax-Tmin (idtem = 1)
+c Open twice DTEM = Tmax-Tmin.
+c The temperature difference has been calculated externally (idtem = 0)
+
+! TMAX OR DTEM
+ iunit_dtaa = 3
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_dta, iunit_dtaa, icyr_dta, filexti, kexti, extin,
+ & fildta, 'TMAX or temperature difference climatology (i.a)',
+ & ncname_dta,
+ & ncid_fildtaa, ncvar_dtaa)
+
+! TMIN
+ IF (idtem.eq.1) then
+ iunit_dtba = 301
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_dtb, iunit_dtba, icyr_dtb, filexti, kexti, extin,
+ & fildtb, 'TMIN climatology (i.b)',
+ & ncname_dtb,
+ & ncid_fildtba, ncvar_dtba)
+ ENDIF
+
+! Precipitation -- former unit 4
+ iunit_prca = 4
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_prc, iunit_prca, icyr_prc, filexti, kexti, extin,
+ & filprc, 'precipitation climatology (i)',
+ & ncname_prc,
+ & ncid_filprca, ncvar_prca)
+
+! Sunshine Relative Hours -- former unit 7
+ iunit_shia = 7
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_shi, iunit_shia, icyr_shi, filexti, kexti, extin,
+ & filshi, 'sunshine relative hours climatology (i)',
+ & ncname_shi,
+ & ncid_filshia, ncvar_shia)
+
+! Relative Humidity -- former unit 8
+ iunit_rhua = 8
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_rhu, iunit_rhua, icyr_rhu, filexti, kexti, extin,
+ & filrhu, 'relative humidity climatology (i)',
+ & ncname_rhu,
+ & ncid_filrhua, ncvar_rhua)
+
+! Wind -- former unit 9
+ iunit_wina = 9
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_win, iunit_wina, icyr_win, filexti, kexti, extin,
+ & filwin, 'wind climatology (i)',
+ & ncname_win,
+ & ncid_filwina, ncvar_wina)
+
+
+ ELSE
+
+
+! Temperature -- former unit 2
+ iunit_tema = 2
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_tem, iunit_tema, icyr_tem, filexta, kexta, extin,
+ & filtem, 'temperature climatology (i)',
+ & ncname_tem,
+ & ncid_filtema, ncvar_tema)
+
+! Temperature difference -- former unit 3
+c Open 2 files: Tmax and Tmin and calculate the difference Tmax-Tmin (idtem = 1)
+c Open twice DTEM = Tmax-Tmin.
+c The temperature difference has been calculated externally (idtem = 0)
+
+! TMAX
+ iunit_dtaa = 3
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_dta, iunit_dtaa, icyr_dta, filexta, kexta, extin,
+ & fildta, 'temperature difference climatology (i)',
+ & ncname_dta,
+ & ncid_fildtaa, ncvar_dtaa)
+
+! TMIN
+ IF (idtem.eq.1) then
+ iunit_dtba = 301
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_dtb, iunit_dtba, icyr_dtb, filexta, kexta, extin,
+ & fildtb, 'temperature difference climatology (i)',
+ & ncname_dtb,
+ & ncid_fildtba, ncvar_dtba)
+ ENDIF
+
+! Precipitation -- former unit 4
+ iunit_prca = 4
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_prc, iunit_prca, icyr_prc, filexta, kexta, extin,
+ & filprc, 'precipitation climatology (i)',
+ & ncname_prc,
+ & ncid_filprca, ncvar_prca)
+
+! Sunshine Relative Hours -- former unit 7
+ iunit_shia = 7
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_shi, iunit_shia, icyr_shi, filexta, kexta, extin,
+ & filshi, 'sunshine relative hours climatology (i)',
+ & ncname_shi,
+ & ncid_filshia, ncvar_shia)
+
+! Relative Humidity -- former unit 8
+ iunit_rhua = 8
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_rhu, iunit_rhua, icyr_rhu, filexta, kexta, extin,
+ & filrhu, 'relative humidity climatology (i)',
+ & ncname_rhu,
+ & ncid_filrhua, ncvar_rhua)
+
+! Former unit 9
+ iunit_wina = 9
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_win, iunit_wina, icyr_win, filexta, kexta, extin,
+ & filwin, 'wind climatology (a)',
+ & ncname_win,
+ & ncid_filwina, ncvar_wina)
+
+
+! Former unit 222
+ iunit_temb = 222
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_tem, iunit_temb, icyr_tem, filextb, kextb, extin,
+ & filtem, 'temperature climatology (b)',
+ & ncname_tem,
+ & ncid_filtemb, ncvar_temb)
+
+! Former unit 333
+c Open 2 files: Tmax and Tmin and calculate the difference Tmax-Tmin (idtem = 1)
+c Open twice DTEM = Tmax-Tmin.
+c The temperature difference has been calculated externally (idtem = 0)
+
+! TMAX
+ iunit_dtab = 333
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_dta, iunit_dtab, icyr_dta, filextb, kextb, extin,
+ & fildta, 'temperature difference climatology (a.b)',
+ & ncname_dta,
+ & ncid_fildtab, ncvar_dtab)
+
+! TMIN
+ IF (idtem.eq.1) then
+ iunit_dtbb = 311
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_dtb, iunit_dtbb, icyr_dtb, filextb, kextb, extin,
+ & fildtb, 'temperature difference climatology (b.b)',
+ & ncname_dtb,
+ & ncid_fildtbb, ncvar_dtbb)
+ ENDIF
+
+! Former unit 444
+ iunit_prcb = 444
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_prc, iunit_prcb, icyr_prc, filextb, kextb, extin,
+ & filprc, 'precipitation climatology (b)',
+ & ncname_prc,
+ & ncid_filprcb, ncvar_prcb)
+
+! Former unit 777
+ iunit_shib = 777
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_shi, iunit_shib, icyr_shi, filextb, kextb, extin,
+ & filshi, 'sunshine relative hours climatology (b)',
+ & ncname_shi,
+ & ncid_filshib, ncvar_shib)
+
+! Former unit 888
+ iunit_rhub = 888
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_rhu, iunit_rhub, icyr_rhu, filextb, kextb, extin,
+ & filrhu, 'relative humidity climatology (b)',
+ & ncname_rhu,
+ & ncid_filrhub, ncvar_rhub)
+
+! Former unit 999
+ iunit_winb = 999
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_winb, iunit_winb, icyr_win, filextb, kextb, extin,
+ & filwin, 'wind climatology (b)',
+ & ncname_win,
+ & ncid_filwinb, ncvar_winb)
+
+ endif
+
+ if (num_ncdf.ge.1) then
+
+ if (incdf_win.eq.1) then
+ ncid_filcooa = ncid_filwina
+ ncvar_cooa = ncvar_wina
+ elseif (incdf_tem.eq.1) then
+ ncid_filcooa = ncid_filtema
+ ncvar_cooa = ncvar_tema
+ elseif (incdf_dta.eq.1) then
+ ncid_filcooa = ncid_fildtaa
+ ncvar_cooa = ncvar_dtaa
+ elseif (incdf_prc.eq.1) then
+ ncid_filcooa = ncid_filprca
+ ncvar_cooa = ncvar_prca
+ elseif (incdf_shi.eq.1) then
+ ncid_filcooa = ncid_filshia
+ ncvar_cooa = ncvar_shia
+ elseif (incdf_rhu.eq.1) then
+ ncid_filcooa = ncid_filrhua
+ ncvar_cooa = ncvar_rhua
+ elseif ((idtem.eq.1).and.(incdf_dtb.eq.1)) then
+ ncid_filcooa = ncid_fildtba
+ ncvar_cooa = ncvar_dtba
+ elseif (incdf_tclim.eq.1) then
+ ncid_filcooa = ncid_filtclima
+ ncvar_cooa = ncvar_tclima
+ elseif (incdf_pclim.eq.1) then
+ ncid_filcooa = ncid_filpclima
+ ncvar_cooa = ncvar_pclima
+ else
+ write (*,*) 'Wrong value of netcdf parameters incdf_xxxx'
+ write (*,*) 'Aborting'
+ endif
+
+c// BEGIN
+c// provisional code, to be discarded once all will have been
+c// converted to NetCDF
+c// Now that at least one NetCDF file is open, we can read in the lon/lat,
+c// data; if this has not been done before.
+
+
+
+ IF (.NOT. l_gridinit_done) THEN
+
+ ! Inquire for id of dimension 'lon'
+ istatus = NF_INQ_DIMID(ncid_filcooa, 'lon', ncdim_lon)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+
+ ! Inquire for length of dimension 'lon'
+ istatus = NF_INQ_DIMLEN(ncid_filcooa, ncdim_lon, nclen_lon)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+
+ ! Inquire for id of variable 'lon'
+ istatus = NF_INQ_VARID(ncid_filcooa, 'lon', ncvar_lon)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+
+ ! Allocate space for dimension variable
+ ALLOCATE(zlon(nclen_lon))
+ ! Read in values for dimension 'lon' variable
+ istatus = NF_GET_VAR_DOUBLE(ncid_filcooa, ncvar_lon, zlon)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+
+ ! Set typical maximum uncertainty for longitude spacing
+ zdel_lon = ABS(zlon(2)-zlon(1))/100D0
+ ncpos_lon = 1
+ ! Inquire for id of dimension 'lat'
+ istatus = NF_INQ_DIMID(ncid_filcooa, 'lat', ncdim_lat)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+
+ ! Inquire for length of dimension 'lat'
+ istatus = NF_INQ_DIMLEN(ncid_filcooa, ncdim_lat, nclen_lat)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+
+ ! Inquire for id of variable 'lat'
+ istatus = NF_INQ_VARID(ncid_filcooa, 'lat', ncvar_lat)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+ ! Allocate space for dimension variable
+ ALLOCATE(zlat(nclen_lat))
+ ! Read in values for dimension 'lat' variable
+ istatus = NF_GET_VAR_DOUBLE(ncid_filcooa, ncvar_lat, zlat)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+
+ ! Set typical maximum uncertainty for latitude spacing
+ zdel_lat = ABS(zlon(2)-zlon(1))/100D0
+ ncpos_lat = 1
+
+ l_gridinit_done = .TRUE.
+
+ ENDIF
+
+c IF (.NOT. l_timeinit_done) THEN
+ IF (idaily_in /= 0) THEN
+
+ ! Inquire for id of dimension 'time'
+ istatus = NF_INQ_DIMID(ncid_filcooa, 'time', ncdim_time)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+
+ ! Inquire for length of dimension 'time'
+ istatus = NF_INQ_DIMLEN(ncid_filcooa, ncdim_time, nclen_time)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+
+ ! Inquire for id of variable 'time'
+ istatus = NF_INQ_VARID(ncid_filcooa, 'time', ncvar_time)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+ ! Allocate space for dimension variable
+ ALLOCATE(ztime(nclen_time))
+ ! Read in values for dimension 'time' variable
+ istatus = NF_GET_VAR_DOUBLE(ncid_filcooa, ncvar_time, ztime)
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+
+c Search for idayct
+ ncpos_time = 0
+c write(*,*)'myear= ',myear,' idayct= ',idayct
+
+ DO i=1,nclen_time
+
+ ztime(i) = int(ztime(i))
+
+ IF (ztime(i) == idayct) THEN
+ ncpos_time = i
+ EXIT
+ ENDIF
+
+ ENDDO
+
+
+ IF (ncpos_time == 0) THEN
+
+ WRITE(*,*) 'idayct =', idayct,
+ & ' cannot be found in file, ABORTING'
+ CALL ABORT()
+
+ ENDIF
+
+ DEALLOCATE(ztime)
+ ncdim_time = 0
+ nclen_time = 0
+ ncvar_time = 0
+
+ ELSE
+
+ ncpos_time = 1
+
+ ENDIF
+
+c l_timeinit_done = .TRUE.
+
+c ENDIF
+c// END
+
+ endif !(num_ncdf.ge.1)
+
+ if (ipr_clim.ne.0) then
+ if (iprt_tem.ne.0) then
+ filename = TRIM(filotem)//filexto(1:kexto)//extin(1:kextin)
+ open(502,file=filename)
+ endif
+ if (iprt_dte.ne.0) then
+ filename = TRIM(filodte)//filexto(1:kexto)//extin(1:kextin)
+ open(503,file=filename)
+ endif
+ if (iprt_prc.ne.0) then
+ filename = TRIM(filoprc)//filexto(1:kexto)//extin(1:kextin)
+ open(504,file=filename)
+ endif
+ if (iprt_shr.ne.0) then
+ filename = TRIM(filoshr)//filexto(1:kexto)//extin(1:kextin)
+ open(507,file=filename)
+ endif
+ if (iprt_rhu.ne.0) then
+ filename = TRIM(filorhu)//filexto(1:kexto)//extin(1:kextin)
+ open(508,file=filename)
+ endif
+ if (iprt_win.ne.0) then
+ filename = TRIM(filowin)//filexto(1:kexto)//extin(1:kextin)
+ open(509,file=filename)
+ endif
+ endif
+
+c --- CAUTION: time extension (year) is filexto or filextlu for management, fire,
+c land use, LU species, sowing dates and cultivar files, depending on icyr
+c ------------------------------------------------------------------------------
+
+ if (imanag.eq.1) then
+ call charlen(filemanag,kf)
+ if (icyr_manag.eq.0) then
+ filename=filemanag(1:kf)
+ elseif (icyr_manag.eq.1) then
+ filename=filemanag(1:kf)//filexto(1:kexto)//extin(1:kextin)
+ else
+ filename=filemanag(1:kf)//filextlu(1:kextlu)//extin(1:kextin)
+ endif
+ open(92,file=filename,status='old')
+ endif
+
+ if (ifire.eq.1) then
+ call charlen(fillight,kf)
+ if (icyr_light.eq.0) then
+ filename=fillight(1:kf)
+ elseif (icyr_light.eq.1) then
+ filename=fillight(1:kf)//filexto(1:kexto)//extin(1:kextin)
+ else
+ filename=fillight(1:kf)//filextlu(1:kextlu)//extin(1:kextin)
+ endif
+ open(93,file=filename,status='old')
+ endif
+
+ if (ilu.eq.1) then
+ call charlen(fillanduse,kf)
+ if (icyr_landuse.eq.0) then
+ filename=fillanduse(1:kf)
+ elseif (icyr_landuse.eq.1) then
+ filename=fillanduse(1:kf)//filexto(1:kexto)//extin(1:kextin)
+ else
+ filename=fillanduse(1:kf)//filextlu(1:kextlu)//extin(1:kextin)
+ endif
+ open(94,file=filename,status='old')
+
+ if (ilusp_rd.eq.1) then
+ call charlen(fillusp,kf)
+ if (icyr_lusp.eq.0) then
+ filename=fillusp(1:kf)
+ elseif (icyr_lusp.eq.1) then
+ filename=fillusp(1:kf)//filexto(1:kexto)//extin(1:kextin)
+ else
+ filename=fillusp(1:kf)//filextlu(1:kextlu)//extin(1:kextin)
+ endif
+ open(194,file=filename,status='old')
+ endif
+
+ if (isowd_rd.eq.1) then
+ call charlen(filsowd,kf)
+ if (icyr_sowd.eq.0) then
+ filename=filsowd(1:kf)
+ elseif (icyr_sowd.eq.1) then
+ filename=filsowd(1:kf)//filexto(1:kexto)//extin(1:kextin)
+ else
+ filename=filsowd(1:kf)//filextlu(1:kextlu)//extin(1:kextin)
+ endif
+ open(294,file=filename,status='old')
+ endif
+
+ if (icvar_rd.eq.1) then
+ call charlen(filcropvar,kf)
+ if (icyr_cropvar.eq.0) then
+ filename=filcropvar(1:kf)
+ elseif (icyr_cropvar.eq.1) then
+ filename=filcropvar(1:kf)//filexto(1:kexto)//extin(1:kextin)
+ else
+ filename=filcropvar(1:kf)//filextlu(1:kextlu)//extin(1:kextin)
+ endif
+ open(295,file=filename,status='old')
+ endif
+ endif
+
+ if (imig.eq.1) then
+ call charlen(filmig,kf)
+ if (icyr_mig.eq.0) then
+ filename = filmig(1:kf)
+ else
+ filename = filmig(1:kf)//filexti(1:kexti)//extin(1:kextin)
+ endif
+ open(95,file=filename,status='old')
+
+ call charlen(filref,kf)
+ if (icyr_ref.eq.0) then
+ filename = filref(1:kf)
+ else
+ filename = filref(1:kf)//filexti(1:kexti)//extin(1:kextin)
+ endif
+ open(96,file=filename,status='old')
+ endif
+
+ if (igtyp.eq.1) then
+ call charlen(filpixcorners,kf)
+ filename = filpixcorners(1:kf)
+ open(97,file=filename,status='old')
+ endif
+
+c unit=5 input5 file
+c unit=6 standard output
+
+c unit=11 weather generator precipitation
+c unit=12 weather generator temperature
+c unit=13 BAG parameter for IBM
+c unit=14 BAG climatic tolerances for CARAIB
+c unit=15 BAG parameter for CARAIB
+c unit=16 BAG C/N
+c unit=17 BAG gkfall
+c unit=18 BAG gama
+c unit=19 BAG initial carbon values
+
+ if (nyear.eq.1) then
+ if (ifrac_rd.ge.1)open(20,file=filveg_in,status='old')
+ if (ilai_rd.ge.1)open(21,file=fillai_in,status='old')
+c open(22,file=filzon)
+ endif
+
+ call charlen(filzon,kf)
+ if (iprt_zon.eq.0) then
+ filename = filzon(1:kf)
+ else
+ filename = filzon(1:kf)//filexti(1:kexti)//extin(1:kextin)
+ endif
+ open(22,file=filename)
+
+c unit=23 stochastic fields
+ open(23,file=filgen,form='unformatted')
+c unit=24 water.res : daily results if ifull.eq.1
+
+ if (nyear.eq.1) then
+ if (iread.ge.1) then
+ open(25,file=filini,form='unformatted')
+
+ call charlen(filelailimi,kf)
+ filename = filelailimi(1:kf)
+ open(125,file=filename,form='unformatted')
+ if(ncrop.gt.0) then
+ call charlen(filecropini,kf)
+ filename = filecropini(1:kf)
+ open(525,file=filename,form='unformatted')
+ endif
+ open(225,file=filetemprev)
+ open(325,file=fileco2prev)
+ endif
+ if ((ifrac_rd.ge.1).and.(icyr_landuse.ne.0)) then
+ if (ilu.eq.1) open(425,file=fileluprev)
+ endif
+
+ open(28,file=filtes)
+ open(61,file=filetest)
+
+ if (imig_rd.eq.1) then
+ open(176,file=fileprop_in,status='old')
+ open(177,file=fileside_in,status='old')
+ open(178,file=filepres_in,status='old')
+ endif
+ endif
+
+c unit=29 reinitialize annual net budget
+
+
+ call charlen(filinn,kf)
+ filename = filinn(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(26,file=filename,form='unformatted')
+c rewind (26)
+
+ call charlen(filelailimo,kf)
+ filename = filelailimo(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(126,file=filename,form='unformatted')
+c rewind (126)
+
+ call charlen(filecropino,kf)
+ filename = filecropino(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(526,file=filename,form='unformatted')
+c rewind (526)
+
+ call charlen(filetemprevo,kf)
+ filename = filetemprevo(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(226,file=filename)
+c rewind (226)
+
+ call charlen(fileco2prevo,kf)
+ filename = fileco2prevo(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(326,file=filename)
+c rewind (326)
+
+c if (ifrac.eq.1) then
+ if (iprt_frac.eq.1) then
+ call charlen(filefrac,kf)
+ filename = filefrac(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(60,file=filename)
+ endif
+c endif
+
+ if(iprt_laimin.eq.1)then
+ call charlen(filelaimin,kf)
+ filename = filelaimin(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(64,file=filename)
+ endif
+c write(*,*)filename
+
+c beginning of if statement on iyprt
+ if (iyprt.ge.1) then
+
+ if(iprt_yr.eq.1) then
+ call charlen(filyr,kf)
+ filename = filyr(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(30,file=filename)
+ endif
+
+ if(iprt_frc.eq.1) then
+ call charlen(filfrc,kf)
+ filename = filfrc(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(530,file=filename)
+ endif
+
+ if(iprt_sw.eq.1) then
+ call charlen(filsw,kf)
+ filename = filsw(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(31,file=filename)
+ endif
+
+ if(iprt_swmm.eq.1) then
+ call charlen(filswmm,kf)
+ filename = filswmm(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(531,file=filename)
+ endif
+
+ if(iprt_rtr.eq.1) then
+ call charlen(filrtr,kf)
+ filename = filrtr(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(532,file=filename)
+ endif
+
+ if(iprt_pet.eq.1) then
+ call charlen(filpet,kf)
+ filename = filpet(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(32,file=filename)
+ endif
+
+ if(iprt_aet.eq.1) then
+ call charlen(filaet,kf)
+ filename = filaet(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(33,file=filename)
+ endif
+
+ if(iprt_run.eq.1) then
+ call charlen(filrun,kf)
+ filename = filrun(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(34,file=filename)
+ endif
+
+ if(iprt_fsn.eq.1) then
+ call charlen(filfsn,kf)
+ filename = filfsn(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(35,file=filename)
+ endif
+
+ if(iprt_snd.eq.1) then
+ call charlen(filsnd,kf)
+ filename = filsnd(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(535,file=filename)
+ endif
+
+ if(iprt_srun.eq.1) then
+ call charlen(filsrun,kf)
+ filename = filsrun(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(536,file=filename)
+ endif
+
+ if(iprt_drn.eq.1) then
+ call charlen(fildrn,kf)
+ filename = fildrn(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(36,file=filename)
+ endif
+
+ if(iprt_sve.eq.1) then
+ call charlen(filsve,kf)
+ filename = filsve(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(37,file=filename)
+ endif
+
+ if(iprt_eint.eq.1) then
+ call charlen(fileint,kf)
+ filename = fileint(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(537,file=filename)
+ endif
+
+ if(iprt_etr.eq.1) then
+ call charlen(filetr,kf)
+ filename = filetr(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(538,file=filename)
+ endif
+
+ if(iprt_eso.eq.1) then
+ call charlen(fileso,kf)
+ filename = fileso(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(539,file=filename)
+ endif
+
+ if(iprt_rbl.eq.1) then
+ call charlen(filrbl,kf)
+ filename = filrbl(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(38,file=filename)
+ endif
+
+ if(iprt_alb.eq.1) then
+ call charlen(filalb,kf)
+ filename = filalb(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(39,file=filename)
+ endif
+
+ if(iprt_albsv.eq.1) then
+ call charlen(filalbsv,kf)
+ filename = filalbsv(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(239,file=filename)
+ endif
+
+ if(iprt_albs.eq.1) then
+ call charlen(filalbs,kf)
+ filename = filalbs(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(339,file=filename)
+ endif
+
+ if(iprt_albv.eq.1) then
+ call charlen(filalbv,kf)
+ filename = filalbv(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(439,file=filename)
+ endif
+
+ if(iprt_rn.eq.1) then
+ call charlen(filrn,kf)
+ filename = filrn(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(40,file=filename)
+ endif
+
+ if(iprt_grf.eq.1) then
+ call charlen(filgrf,kf)
+ filename = filgrf(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(41,file=filename)
+ endif
+
+ if(iprt_ts.eq.1) then
+ call charlen(filts,kf)
+ filename = filts(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(42,file=filename)
+ endif
+
+ if(iprt_fgs.eq.1) then
+ call charlen(filfgs,kf)
+ filename = filfgs(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(43,file=filename)
+ endif
+
+ if(iprt_lai.eq.1) then
+ call charlen(fillai,kf)
+ filename = fillai(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(44,file=filename)
+ endif
+
+ if(iprt_fird.eq.1) then
+ call charlen(filfird,kf)
+ filename = filfird(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(45,file=filename)
+ endif
+
+ if(iprt_xh.eq.1) then
+ call charlen(filxh,kf)
+ filename = filxh(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(46,file=filename)
+ endif
+
+ if(iprt_xle.eq.1) then
+ call charlen(filxle,kf)
+ filename = filxle(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(47,file=filename)
+ endif
+
+ if(iprt_sol.eq.1) then
+ call charlen(filsol,kf)
+ filename = filsol(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(48,file=filename)
+ endif
+
+ if(iprt_sf.eq.1) then
+ call charlen(filsf,kf)
+ filename = filsf(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(49,file=filename)
+ endif
+
+ if(iprt_sne.eq.1) then
+ call charlen(filsne,kf)
+ filename = filsne(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(50,file=filename)
+ endif
+
+ if(iprt_sml.eq.1) then
+ call charlen(filsml,kf)
+ filename = filsml(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(51,file=filename)
+ endif
+
+ if(iprt_emi.eq.1) then
+ call charlen(filemi,kf)
+ filename = filemi(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(52,file=filename)
+ endif
+
+ if(iprt_emins.eq.1) then
+ call charlen(filemins,kf)
+ filename = filemins(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(152,file=filename)
+ endif
+
+ if(iprt_z0.eq.1) then
+ call charlen(filez0,kf)
+ filename = filez0(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(252,file=filename)
+ endif
+
+c units 53 to 59 for other eventual ibm outputs
+
+ if(iprt_biomm.eq.1)then
+ call charlen(filebiomm,kf)
+ filename = filebiomm(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(55,file=filename)
+ endif
+
+ if(iprt_gppm.eq.1)then
+ call charlen(filegppm,kf)
+ filename = filegppm(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(56,file=filename)
+ endif
+
+ if(iprt_ram.eq.1)then
+ call charlen(fileram,kf)
+ filename = fileram(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(556,file=filename)
+ endif
+
+ if(iprt_nppm.eq.1)then
+ call charlen(filenppm,kf)
+ filename = filenppm(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(57,file=filename)
+ endif
+
+ if(iprt_nepm.eq.1)then
+ call charlen(filenepm,kf)
+ filename = filenepm(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(58,file=filename)
+ endif
+
+ if(iprt_rhm.eq.1)then
+ call charlen(filerhm,kf)
+ filename = filerhm(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(558,file=filename)
+ endif
+
+ if(iprt_laim.eq.1)then
+ call charlen(filelaim,kf)
+ filename = filelaim(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(59,file=filename)
+ endif
+
+ if(iprt_emifirem.eq.1)then
+ call charlen(fileemifirem,kf)
+ filename=fileemifirem(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(559,file=filename)
+ endif
+
+ if(iprt_emiblitm.eq.1)then
+ call charlen(fileemiblitm,kf)
+ filename=fileemiblitm(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(560,file=filename)
+ endif
+
+ if(iprt_nbpm.eq.1)then
+ call charlen(filenbpm,kf)
+ filename = filenbpm(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(561,file=filename)
+ endif
+
+ if ((imanag.eq.1).or.(ncrop.gt.0)) then
+ if(iprt_harvm .eq. 1) then
+ call charlen(fileharvm,kf)
+ filename = fileharvm(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(562,file=filename)
+ endif
+ endif
+
+ if(iprt_faparm.eq.1)then
+ call charlen(filefaparm,kf)
+ filename = filefaparm(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(98,file=filename)
+ endif
+
+
+ if(iprt_Rmin.eq.1)then
+ call charlen(fileRmin,kf)
+ filename = fileRmin(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(63,file=filename)
+ endif
+
+ if(iprt_gpp.eq.1)then
+ call charlen(filegpp,kf)
+ filename = filegpp(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(65,file=filename)
+ endif
+
+ if(iprt_raf.eq.1)then
+ call charlen(fileraf,kf)
+ filename = fileraf(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(565,file=filename)
+ endif
+
+ if(iprt_emifiref.eq.1)then
+ call charlen(fileemifiref,kf)
+ filename=fileemifiref(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(665,file=filename)
+ endif
+
+ if(iprt_Cveg.eq.1)then
+ call charlen(fileCveg,kf)
+ filename = fileCveg(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(66,file=filename)
+ endif
+
+ if(iprt_Csoil.eq.1)then
+ call charlen(fileCsoil,kf)
+ filename = fileCsoil(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(67,file=filename)
+ endif
+
+ if(iprt_frcC13.eq.1)then
+ call charlen(filefrcC13,kf)
+ filename = filefrcC13(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(68,file=filename)
+ endif
+
+ if(iprt_laimoy.eq.1)then
+ call charlen(filelaimoy,kf)
+ filename = filelaimoy(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(69,file=filename)
+ endif
+
+ if(iprt_Tdmin.eq.1)then
+ call charlen(fileTdmin,kf)
+ filename = fileTdmin(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(70,file=filename)
+ endif
+
+ if(iprt_Tmmin.eq.1)then
+ call charlen(fileTmmin,kf)
+ filename = fileTmmin(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(71,file=filename)
+ endif
+
+ if(iprt_gdd.eq.1)then
+ call charlen(filegdd,kf)
+ filename = filegdd(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(72,file=filename)
+ endif
+
+ if (ifire.eq.1) then
+
+ if(iprt_fire.eq.1) then
+ call charlen(filepfire,kf)
+ filename = filepfire(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(73,file=filename)
+ endif
+
+ if(iprt_fburn.eq.1) then
+ call charlen(filefburn,kf)
+ filename = filefburn(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(74,file=filename)
+ endif
+
+ if(iprt_aburn.eq.1) then
+ call charlen(fileaburn,kf)
+ filename = fileaburn(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(75,file=filename)
+ endif
+
+ if(iprt_yfnoburn.eq.1) then
+ call charlen(fileyfnoburn,kf)
+ filename=fileyfnoburn(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(83,file=filename)
+ endif
+
+ endif
+
+ if(iprt_ftomin.eq.1) then
+ call charlen(fileftomin,kf)
+ filename = fileftomin(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(84,file=filename)
+ endif
+
+ if(iprt_ftotw.eq.1) then
+ call charlen(fileftotw,kf)
+ filename = fileftotw(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(85,file=filename)
+ endif
+
+ if(iprt_ftot.eq.1) then
+ call charlen(fileftot,kf)
+ filename = fileftot(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(86,file=filename)
+ endif
+
+
+ if (ifrac.eq.1) then
+
+ if(iprt_Fgdd5.eq.1) then
+ call charlen(fileFgdd5,kf)
+ filename = fileFgdd5(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(87,file=filename)
+ endif
+
+ if(iprt_FTmmin.eq.1) then
+ call charlen(fileFTmmin,kf)
+ filename = fileFTmmin(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(88,file=filename)
+ endif
+
+ if(iprt_Fwatmin.eq.1) then
+ call charlen(fileFwatmin,kf)
+ filename = fileFwatmin(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(89,file=filename)
+ endif
+
+ endif
+
+ if (imig.eq.1) then
+ if(iprt_prop.eq.1) then
+ call charlen(fileprop,kf)
+ filename = fileprop(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(76,file=filename)
+ endif
+
+ if(iprt_side.eq.1) then
+ call charlen(fileside,kf)
+ filename = fileside(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(77,file=filename)
+ endif
+
+ if(iprt_pres.eq.1) then
+ call charlen(filepres,kf)
+ filename = filepres(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(78,file=filename)
+ endif
+ endif
+
+ if ((imanag.eq.1).or.(ncrop.gt.0)) then
+ if(iprt_harv.eq.1)then
+ call charlen(fileharvest,kf)
+ filename = fileharvest(1:kf)//filexto(1:kexto)
+ & //extout(1:kextout)
+ open(79,file=filename)
+ endif
+ endif
+
+ if(ncrop.gt.0) then
+ if(iprt_yield.eq.1) then
+ call charlen(fileyield,kf)
+ filename = fileyield(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(880,file=filename)
+ endif
+ endif
+
+ if(iprt_agbiom.eq.1) then
+ call charlen(fileagbiom,kf)
+ filename = fileagbiom(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(881,file=filename)
+ endif
+
+ if(iprt_bgbiom.eq.1) then
+ call charlen(filebgbiom,kf)
+ filename = filebgbiom(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(882,file=filename)
+ endif
+
+ if(ncrop.gt.0) then
+ if(iprt_mat.eq.1) then
+ call charlen(filemat,kf)
+ filename = filemat(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(883,file=filename)
+ endif
+ endif
+
+ if (ilu.eq.1) then
+ if(iprt_lucdfr.eq.1)then
+ call charlen(filelucdfr,kf)
+ filename = filelucdfr(1:kf)//filexto(1:kexto)
+ & //extout(1:kextout)
+ open(251,file=filename)
+ endif
+ if(iprt_lucflx.eq.1)then
+ call charlen(filelucflx,kf)
+ filename = filelucflx(1:kf)//filexto(1:kexto)
+ & //extout(1:kextout)
+ open(252,file=filename)
+ endif
+ endif
+
+c end of if statement on iyprt
+ endif
+
+ if(iprt_nppf.eq.1)then
+ call charlen(filenppf,kf)
+ filename = filenppf(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(62,file=filename)
+ endif
+
+c if (ifrac.eq.1) then
+
+c if(iprt_yfnoburn.eq.1) then
+c call charlen(fileyfnoburn,kf)
+c filename =
+c & fileyfnoburn(1:kf)//filexto(1:kexto)//extout(1:kextout)
+c open(83,file=filename)
+c endif
+
+c if(iprt_ftot.eq.1) then
+c call charlen(fileftot,kf)
+c filename = fileftot(1:kf)//filexto(1:kexto)//extout(1:kextout)
+c open(86,file=filename)
+c endif
+
+c endif
+
+cc if (imig.eq.1) then
+
+c if(iprt_Fgdd5.eq.1) then
+c call charlen(fileFgdd5,kf)
+c filename = fileFgdd5(1:kf)//filexto(1:kexto)//extout(1:kextout)
+c open(87,file=filename)
+c endif
+
+c if(iprt_FTmmin.eq.1) then
+c call charlen(fileFTmmin,kf)
+c filename = fileFTmmin(1:kf)//filexto(1:kexto)//extout(1:kextout)
+c open(88,file=filename)
+c endif
+
+c if(iprt_Fwatmin.eq.1) then
+c call charlen(fileFwatmin,kf)
+c filename = fileFwatmin(1:kf)//filexto(1:kexto)//extout(1:kextout)
+c open(89,file=filename)
+c endif
+
+c endif
+
+c unit 80 for time elapsed
+
+ if (idaily_in.eq.0) then
+
+c call charlen(filtclim,kf)
+c if (icyr_tclim.eq.0) then
+c filename = filtclim(1:kf)
+c open(81,file=filename,status='old')
+c else
+c filename = filtclim(1:kf)//filexti(1:kexti)//extin(1:kextin)
+c open(81,file=filename,status='old')
+c endif
+c// BEGIN
+! Mean Temperature -- former unit 81
+ iunit_tclim = 81
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_tclim, iunit_tclim, icyr_tclim, filexti, kexti, extin,
+ & filtclim, 'mean temperature climatology (i)',
+ & ncname_tclim,
+ & ncid_filtclima, ncvar_tclima )
+
+c// END
+
+c call charlen(filpclim,kf)
+c if (icyr_pclim.eq.0) then
+c filename = filpclim(1:kf)
+c open(82,file=filename,status='old')
+c else
+c filename = filpclim(1:kf)//filexti(1:kexti)//extin(1:kextin)
+c open(82,file=filename,status='old')
+c endif
+c// BEGIN
+! Mean Precipitation -- former unit 82
+ iunit_pclim = 82
+ CALL CHECK_AND_OPEN_FILE(
+ & incdf_pclim, iunit_pclim, icyr_pclim, filexti, kexti, extin,
+ & filpclim, 'mean precipitation climatology (i)',
+ & ncname_pclim,
+ & ncid_filpclima, ncvar_pclima )
+
+
+c if (nyear.eq.1)then
+c open(81,file=filtclim)
+c open(82,file=filpclim)
+c endif
+
+ endif ! endif(idaily_in)
+
+ if ((npft.le.0).or.(npft.gt.nplant)) then
+
+ write(61,*) 'Number of PFTs (',npft,') ' //
+ & 'not between 1 and nplant (',nplant,')'
+ write(61,*) 'Change number of PFTs or increase nplant'
+ write(61,*) ' in parameter.common file'
+ write(61,*) 'PROGRAM STOP'
+ write(*,*) 'Number of PFTs (',npft,') ' //
+ & 'not between 1 and nplant (',nplant,')'
+ write(*,*) 'Change number of PFTs or increase nplant'
+ write(*,*) ' in parameter.common file'
+ write(*,*) 'PROGRAM STOP'
+ stop
+ endif
+
+ if ((n_pix.le.0).or.(n_pix.gt.ngrid)) then
+
+ write(61,*) 'Number of grid cells (',n_pix,') ' //
+ & 'not between 1 and ngrid (',ngrid,')'
+ write(61,*) 'Change number of grid cells or increase ngrid'
+ write(61,*) ' in parameter.common file'
+ write(61,*) 'PROGRAM STOP'
+ write(*,*) 'Number of grid cells (',n_pix,') ' //
+ & 'not between 1 and ngrid (',ngrid,')'
+ write(*,*) 'Change number of grid cells or increase ngrid'
+ write(*,*) ' in parameter.common file'
+ write(*,*) 'PROGRAM STOP'
+ stop
+ endif
+
+ return
+
+ CONTAINS
+
+
+ end SUBROUTINE open_file
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_open_input5.f b/couplage/CARAIB/ver01_Iv_couplage/mod_open_input5.f
new file mode 100644
index 0000000..c181846
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_open_input5.f
@@ -0,0 +1,407 @@
+c=======================================================================
+c***********************************************************************
+ subroutine open_input5(nyrmax,itmt,stept,iread)
+c***********************************************************************
+c=======================================================================
+ IMPLICIT NONE
+
+ include './com_18/parameter.common'
+ include './com_18/annee.common'
+ include './com_18/acclim.common'
+ include './com_18/coord.common'
+ include './com_18/cte.common'
+ include './com_18/envi.common'
+ include './com_18/files_ibm.common'
+ include './com_18/files_ext.common'
+ include './com_18/files_car.common'
+ include './com_18/input_par.common'
+ include './com_18/icyr.common'
+ include './com_18/iprt.common'
+ include './com_18/management.common'
+ include './com_18/netcdf_name.common'
+ include './com_18/netcdf_par.common'
+ include './com_18/nspc.common'
+ include './com_18/pathg.common'
+ include './com_18/prev_yr.common'
+ include './com_18/solpar.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer kf
+c
+c-----------------------------------------------
+ integer iread,nyrmax,itmt,idummy
+ real*4 stept
+ character*120 sdat
+ character*120 fileinput5
+ character*245 filename
+ character*25 sdat1
+
+
+ write(*,*) 'Enter name of control input file (unit 5):'
+ read(*,'(a120)') fileinput5
+ call charlen(fileinput5,kf)
+ filename = fileinput5(1:kf)
+ write(*,*)'Open file: ',filename
+ open(5,file=filename)
+
+c open(5,file='./caraib_5.dat')
+
+ read(5,'(20x,a120)') sdat
+ read(sdat,*) isteady,ny0max
+ read(5,'(20x,a120)')sdat
+ read(sdat,*) readsteady,coupling
+ read(5,'(20x,a120)')sdat
+ read(sdat,*)ngener
+ read(5,'(20x,a120)') sdat
+ read(sdat,*) ifrac
+ read(5,'(20x,a120)')sdat
+ read(sdat,*) ifrac_rd,ilai_rd
+ read(5,'(20x,a120)')sdat
+c jclonly = allows printing climatic files without running the model (jclonly)
+c jclonly = 0 performs all calculations
+c jclonly = 1 prints climatic fields, do not perform calculations
+ read(sdat,*)idayt,ifull,jclonly
+ read(5,'(20x,a120)')sdat
+ read(sdat,*)ilu,imanag
+ read(5,'(20x,a120)')sdat
+ read(sdat,*)ilusp_rd,isowd_rd
+ read(5,'(20x,a120)')sdat
+ read(sdat,*)ncropvar,icvar_rd
+c jdwnCO2 = controls downregulation at high CO2
+c jdwnCO2 = 0 no downregulation
+c jdwnCO2 = 1 downregulation of Vcmax, Jmax and Rd
+c jdwnCO2 = 2 downregulation of Vcmax, Jmax, but not Rd
+ read(5,'(20x,a120)')sdat
+ read(sdat,*)ifire,iclim,ilgtree
+ read(5,'(20x,a120)')sdat
+ read(sdat,*)jdwnCO2,jrd_accl
+ read(5,'(20x,a120)')sdat
+ read(sdat,*)imig,isp,imig_rd
+c ileap: flag to take leap year into account
+c ileap=0 no leap year (nd=365, default value)
+c ileap=1 leap year taken into account depending on the year
+c number defined in "myear" variable (subroutine
+c open_file)
+ read(5,'(20x,a120)')sdat
+ read(sdat,*)nyrmax,ileap !,idayct
+ read(5,'(20x,a120)')sdat
+ read(sdat,*)itmt
+ read(5,'(20x,a120)')sdat
+ read(sdat,*)ny0prt,nstprt
+c iread: controls reading of initialization files
+c iread = 0 initialiszation files are not read (default init.)
+c iread = 1 reading of initialization files for all pfts (nat+agr)
+c iread = 2 reading of initialization files for natural pfts only
+ read(5,'(20x,a120)')sdat
+ read(sdat,*)iread,iczon
+ read(5,'(20x,a120)')sdat
+ read(sdat,*)idaily_in,idaily_out
+
+c Tmin Tmax, solar flux
+ read(5,'(20x,a120)')sdat
+ read(sdat,*)idtem,isol
+
+ if ((isol.eq.1).and.(idaily_in.eq.0)) then
+ write(*,*)'Incompatible values for isol and idaily_in:'
+ write(*,*)'with monthly input fields, relative sunshine hours'
+ write(*,*)'should be provided rather than solar fluxes'
+ write(*,*)'Program stop'
+ stop
+ endif
+
+ read(5,'(20x,a120)')sdat
+ read(sdat,*)n_pix
+ read(5,'(20x,a120)')sdat
+ read(sdat,*)igtyp
+ if (igtyp.eq.0) read(sdat,*)idummy,declg,declat
+ read(5,'(20x,a120)')sdat
+ read(sdat,*)prec_co
+ write(*,*)'igtyp:',igtyp,declg,declat,prec_co
+
+ read(5,'(20x,a120)')sdat
+ read(sdat,*)ipar,exc,obl,xlsper
+
+ read(5,'(20x,a120)') sdat
+ read(sdat,*) nherb,nbush,ntree,ncrop,npast
+
+ if (ilu.ne.1) then
+ if ((ncrop.ne.0).or.(npast.ne.0)) then
+ write(*,*)'Inconsistent values of ilu and ncrop, npast: '
+ write(*,*)'when land use is not considered (ilu.ne.1),'
+ write(*,*)'the number of crop (ncrop) and pasture (npast) '
+ write(*,*)'species/pfts must be set to 0'
+ write(*,*)'ilu= ',ilu
+ write(*,*)'ncrop= ',ncrop,' npast= ',npast
+ write(*,*)'Program stop'
+ stop
+ endif
+ else
+ if ((ncrop.eq.0).and.(npast.eq.0)) then
+ write(*,*)'Inconsistent values of ilu and ncrop, npast: '
+ write(*,*)'when land use is considered (ilu.eq.1), at least '
+ write(*,*)'one crop (ncrop>=1) or one pasture (npast>=1) '
+ write(*,*)'species/pfts must be defined'
+ write(*,*)'ilu= ',ilu
+ write(*,*)'ncrop= ',ncrop,' npast= ',npast
+ write(*,*)'Program stop'
+ stop
+ endif
+ endif
+
+ npft0 = nherb+nbush+ntree
+ npft = npft0+ncrop+npast
+ if(npft.gt.nplant) then
+ write(*,*) 'error, number of pft:',npft,'nherb:',nherb,
+ & 'nbush:',nbush,'ntree:',ntree,'ncrop:',ncrop,
+ & 'npast:',npast
+ write(61,*) 'error, number of pft:',npft,'nherb:',nherb,
+ & 'nbush:',nbush,'ntree:',ntree,'ncrop:',ncrop,
+ & 'npast:',npast
+ write(*,*)'Increase the value of nplant in parameter.common'
+ write(*,*)'file or decrease the number of pfts'
+ stop
+ endif
+
+ read(5,'(20x,a120)')extin
+ call charlen(extin,kextin)
+ read(5,'(20x,a120)')extout
+ call charlen(extout,kextout)
+ write(*,*)'in:',extin
+ write(*,*)'out:',extout
+
+ read(5,'(20x,a120)')filtxt
+ read(5,'(20x,a120)')filpixcorners
+ read(5,'(20x,a120)')filclim
+
+
+c Air temperature (climatological)
+ read(5,'(20x,i1,1x,a120)')icyr_tclim,filtclim
+ read(5,'(20x,a25,1x,a10)')sdat1,ncname_tclim
+ read(sdat1,*)uc0_tclim,uc1_tclim,incdf_tclim
+
+c Precipitation (climatological)
+ read(5,'(20x,i1,1x,a120)')icyr_pclim,filpclim
+ read(5,'(20x,a25,1x,a10)')sdat1,ncname_pclim
+ read(sdat1,*)uc0_pclim,uc1_pclim,incdf_pclim
+
+c Air temperature
+ read(5,'(20x,i1,1x,a120)')icyr_tem,filtem
+ read(5,'(20x,a25,1x,a10)')sdat1,ncname_tem
+ read(sdat1,*)uc0_tem,uc1_tem,incdf_tem
+
+c Tmax
+ read(5,'(20x,i1,1x,a120)')icyr_dta,fildta
+ read(5,'(20x,a25,1x,a10)')sdat1,ncname_dta
+ read(sdat1,*)uc0_dta,uc1_dta,incdf_dta
+
+c Tmin
+ read(5,'(20x,i1,1x,a120)')icyr_dtb,fildtb
+ read(5,'(20x,a25,1x,a10)')sdat1,ncname_dtb
+ read(sdat1,*)uc0_dtb,uc1_dtb,incdf_dtb
+
+c Precipitation
+ read(5,'(20x,i1,1x,a120)')icyr_prc,filprc
+ read(5,'(20x,a25,1x,a10)')sdat1,ncname_prc
+ read(sdat1,*)uc0_prc,uc1_prc,incdf_prc
+
+c Relative sunshine hours (isol = 0) or solar flux (isol = 1)
+ read(5,'(20x,i1,1x,a120)')icyr_shi,filshi
+ read(5,'(20x,a25,1x,a10)')sdat1,ncname_shi
+ read(sdat1,*)uc0_shi,uc1_shi,incdf_shi
+
+c Relative air humidity
+ read(5,'(20x,i1,1x,a120)')icyr_rhu,filrhu
+ read(5,'(20x,a25,1x,a10)')sdat1,ncname_rhu
+ read(sdat1,*)uc0_rhu,uc1_rhu,incdf_rhu
+
+c Wind speed
+ read(5,'(20x,i1,1x,a120)')icyr_win,filwin
+ read(5,'(20x,a25,1x,a10)')sdat1,ncname_win
+ read(sdat1,*)uc0_win,uc1_win,incdf_win
+
+c Other files
+ read(5,'(20x,i1,1x,a120)')icyr_manag,filemanag
+ read(5,'(20x,i1,1x,a120)')icyr_light,fillight
+ read(5,'(20x,i1,1x,a120)')icyr_landuse,fillanduse
+ read(5,'(20x,i1,1x,a120)')icyr_lusp,fillusp
+ read(5,'(20x,i1,1x,a120)')icyr_sowd,filsowd
+ read(5,'(20x,i1,1x,a120)')icyr_cropvar,filcropvar
+ read(5,'(20x,i1,1x,a120)')icyr_mig,filmig
+ read(5,'(20x,i1,1x,a120)')icyr_ref,filref
+
+ num_ncdf = incdf_tem + incdf_dta + incdf_prc + incdf_shi
+ & + incdf_rhu + incdf_win
+ if (idtem.eq.1) num_ncdf = num_ncdf + incdf_dtb
+
+c print out file names for verif
+ write(*,*),'Texture file: ',filtxt
+ write(*,*),'Temperature file (climatology): ',filtclim
+ write(*,*),'Precipitation file (climatology):',filpclim
+ write(*,*),'Temperature file: ',filtem
+ write(*,*),'Temp max file: ',fildta
+ write(*,*),'Temp min file: ',fildtb
+ write(*,*),'Precipitation file: ',filprc
+ write(*,*),'Shunshine file: ',filshi
+ write(*,*),'Rel humidity file: ',filrhu
+ write(*,*),'Wind speed file: ',filwin
+ write(*,*),'Lightning file: ',fillight
+
+ read(5,'(20x,a120)')pathgene
+ write(*,*),'pathgene: '
+
+ read(5,'(20x,a120)')filbagibm
+ read(5,'(20x,a120)')filebagtol
+ read(5,'(20x,a120)')filebagpar
+ read(5,'(20x,a120)')fileclaspar
+ read(5,'(20x,a120)')filecsurn
+ read(5,'(20x,a120)')filegkf
+ read(5,'(20x,a120)')filegama
+ read(5,'(20x,a120)')filecinit
+ read(5,'(20x,a120)')fileseas
+ write(*,*),'plantparam read: '
+
+
+ read(5,'(20x,i1,1x,a120)')iprt_tem,filotem
+ read(5,'(20x,i1,1x,a120)')iprt_dte,filodte
+ read(5,'(20x,i1,1x,a120)')iprt_prc,filoprc
+ read(5,'(20x,i1,1x,a120)')iprt_shr,filoshr
+ read(5,'(20x,i1,1x,a120)')iprt_rhu,filorhu
+ read(5,'(20x,i1,1x,a120)')iprt_win,filowin
+ write(*,*),'print clim: '
+
+
+c initialization files
+ read(5,'(20x,a120)')filveg_in
+ read(5,'(20x,a120)')fillai_in
+ read(5,'(20x,a120)')filini
+ read(5,'(20x,a120)')filelailimi
+ read(5,'(20x,a120)')filecropini
+ read(5,'(20x,a120)')fileco2prev
+ read(5,'(20x,a120)')filetemprev
+ read(5,'(20x,a120)')fileluprev
+ write(*,*),'ini files 1: ',fileluprev
+
+
+ read(5,'(20x,a120)')fileprop_in
+ read(5,'(20x,a120)')fileside_in
+ read(5,'(20x,a120)')filepres_in
+ read(5,'(20x,i1,1x,a120)')iprt_zon,filzon
+ read(5,'(20x,a120)')filgen
+ write(*,*),'ini files 2: ',filgen
+
+
+ read(5,'(20x,a120)')filres
+ read(5,'(20x,a120)')filinn
+ read(5,'(20x,a120)')filelailimo
+ read(5,'(20x,a120)')filecropino
+ read(5,'(20x,a120)')fileco2prevo
+ read(5,'(20x,a120)')filetemprevo
+ read(5,'(20x,a120)')filtes
+ read(5,'(20x,a120)')filetest
+ read(5,'(20x,a120)')filtim
+ write(*,*),'ini files 3: ',filtim
+
+
+ read(5,'(20x,i1,1x,a120)') iprt_yr,filyr
+ read(5,'(20x,i1,1x,a120)') iprt_frc,filfrc
+ read(5,'(20x,i1,1x,a120)') iprt_sw,filsw
+ read(5,'(20x,i1,1x,a120)') iprt_swmm,filswmm
+ read(5,'(20x,i1,1x,a120)') iprt_rtr,filrtr
+ read(5,'(20x,i1,1x,a120)') iprt_pet,filpet
+ read(5,'(20x,i1,1x,a120)') iprt_aet,filaet
+ read(5,'(20x,i1,1x,a120)') iprt_run,filrun
+ read(5,'(20x,i1,1x,a120)') iprt_fsn,filfsn
+ read(5,'(20x,i1,1x,a120)') iprt_snd,filsnd
+ read(5,'(20x,i1,1x,a120)') iprt_srun,filsrun
+ read(5,'(20x,i1,1x,a120)') iprt_drn,fildrn
+ read(5,'(20x,i1,1x,a120)') iprt_sve,filsve
+ read(5,'(20x,i1,1x,a120)') iprt_eint,fileint
+ read(5,'(20x,i1,1x,a120)') iprt_etr,filetr
+ read(5,'(20x,i1,1x,a120)') iprt_eso,fileso
+ write(*,*),'output 1: ',fileso
+
+
+c following ibm outputs are optional
+ read(5,'(20x,i1,1x,a120)') iprt_rbl,filrbl
+ read(5,'(20x,i1,1x,a120)') iprt_alb,filalb
+ read(5,'(20x,i1,1x,a120)') iprt_albsv,filalbsv
+ read(5,'(20x,i1,1x,a120)') iprt_albs,filalbs
+ read(5,'(20x,i1,1x,a120)') iprt_albv,filalbv
+ read(5,'(20x,i1,1x,a120)') iprt_rn,filrn
+ read(5,'(20x,i1,1x,a120)') iprt_grf,filgrf
+ read(5,'(20x,i1,1x,a120)') iprt_ts,filts
+ read(5,'(20x,i1,1x,a120)') iprt_fgs,filfgs
+ read(5,'(20x,i1,1x,a120)') iprt_lai,fillai
+ read(5,'(20x,i1,1x,a120)') iprt_fird,filfird
+ read(5,'(20x,i1,1x,a120)') iprt_xh,filxh
+ read(5,'(20x,i1,1x,a120)') iprt_xle,filxle
+ read(5,'(20x,i1,1x,a120)') iprt_sol,filsol
+ read(5,'(20x,i1,1x,a120)') iprt_sf,filsf
+ read(5,'(20x,i1,1x,a120)') iprt_sne,filsne
+ read(5,'(20x,i1,1x,a120)') iprt_sml,filsml
+ read(5,'(20x,i1,1x,a120)') iprt_emi,filemi
+ read(5,'(20x,i1,1x,a120)') iprt_emins,filemins
+ read(5,'(20x,i1,1x,a120)') iprt_z0,filez0
+ write(*,*),'hydro files: ',filez0
+
+
+ read(5,'(20x,i1,1x,a120)') iprt_biomm,filebiomm
+ read(5,'(20x,i1,1x,a120)') iprt_gppm,filegppm
+ read(5,'(20x,i1,1x,a120)') iprt_ram,fileram
+ read(5,'(20x,i1,1x,a120)') iprt_nppm,filenppm
+ read(5,'(20x,i1,1x,a120)') iprt_nepm,filenepm
+ read(5,'(20x,i1,1x,a120)') iprt_rhm,filerhm
+ read(5,'(20x,i1,1x,a120)') iprt_laim,filelaim
+ read(5,'(20x,i1,1x,a120)') iprt_emifirem,fileemifirem
+ read(5,'(20x,i1,1x,a120)') iprt_emiblitm,fileemiblitm
+ read(5,'(20x,i1,1x,a120)') iprt_nbpm,filenbpm
+ read(5,'(20x,i1,1x,a120)') iprt_harvm,fileharvm
+ read(5,'(20x,i1,1x,a120)') iprt_faparm,filefaparm
+
+ read(5,'(20x,i1,1x,a120)') iprt_frac,filefrac
+ read(5,'(20x,i1,1x,a120)') iprt_nppf,filenppf
+ read(5,'(20x,i1,1x,a120)') iprt_Rmin,fileRmin
+ read(5,'(20x,i1,1x,a120)') iprt_laimin,filelaimin
+ read(5,'(20x,i1,1x,a120)') iprt_gpp,filegpp
+ read(5,'(20x,i1,1x,a120)') iprt_raf,fileraf
+ read(5,'(20x,i1,1x,a120)') iprt_emifiref,fileemifiref
+ read(5,'(20x,i1,1x,a120)') iprt_Cveg,fileCveg
+ read(5,'(20x,i1,1x,a120)') iprt_Csoil,fileCsoil
+ read(5,'(20x,i1,1x,a120)') iprt_frcC13,filefrcC13
+ read(5,'(20x,i1,1x,a120)') iprt_laimoy,filelaimoy
+ read(5,'(20x,i1,1x,a120)') iprt_Tdmin,fileTdmin
+ read(5,'(20x,i1,1x,a120)') iprt_Tmmin,fileTmmin
+ read(5,'(20x,i1,1x,a120)') iprt_gdd,filegdd
+ read(5,'(20x,i1,1x,a120)') iprt_fire,filepfire
+ read(5,'(20x,i1,1x,a120)') iprt_fburn,filefburn
+ read(5,'(20x,i1,1x,a120)') iprt_aburn,fileaburn
+ read(5,'(20x,i1,1x,a120)') iprt_harv,fileharvest
+ read(5,'(20x,i1,1x,a120)') iprt_yield,fileyield
+ read(5,'(20x,i1,1x,a120)') iprt_agbiom,fileagbiom
+ read(5,'(20x,i1,1x,a120)') iprt_bgbiom,filebgbiom
+ read(5,'(20x,i1,1x,a120)') iprt_mat,filemat
+ read(5,'(20x,i1,1x,a120)') iprt_lucdfr,filelucdfr
+ read(5,'(20x,i1,1x,a120)') iprt_lucflx,filelucflx
+
+ read(5,'(20x,i1,1x,a120)') iprt_yfnoburn,fileyfnoburn
+ read(5,'(20x,i1,1x,a120)') iprt_ftomin,fileftomin
+ read(5,'(20x,i1,1x,a120)') iprt_ftotw,fileftotw
+ read(5,'(20x,i1,1x,a120)') iprt_ftot,fileftot
+ read(5,'(20x,i1,1x,a120)') iprt_Fgdd5,fileFgdd5
+ read(5,'(20x,i1,1x,a120)') iprt_FTmmin,fileFTmmin
+ read(5,'(20x,i1,1x,a120)') iprt_Fwatmin,fileFwatmin
+ read(5,'(20x,i1,1x,a120)') iprt_prop,fileprop
+ read(5,'(20x,i1,1x,a120)') iprt_side,fileside
+ read(5,'(20x,i1,1x,a120)') iprt_pres,filepres
+ write(*,*),'outputs end: ',filepres
+
+
+c reads comment line
+
+ read(5,'(a120)') sdat
+ write(*,*) sdat
+ write(*,*) 'End of CTRL file reading'
+
+ return
+ end subroutine open_input5
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_open_mig.f b/couplage/CARAIB/ver01_Iv_couplage/mod_open_mig.f
new file mode 100644
index 0000000..a546249
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_open_mig.f
@@ -0,0 +1,71 @@
+c=======================================================================
+c***********************************************************************
+ subroutine open_mig
+c***********************************************************************
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/annee.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/files_car.common'
+ include './com_18/files_ext.common'
+ include './com_18/files_ibm.common'
+ include './com_18/input_par.common'
+ include './com_18/iprt.common'
+ include './com_18/nspc.common'
+ include './com_18/prt_ctrl.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer kexti,kexto,kf
+c
+c-----------------------------------------------
+c character*20 ydat,filext
+c character*6 filexti,filexto
+ character*245 filename
+
+Ctest call charlen(filext,kext)
+ call charlen(filexti,kexti)
+ call charlen(filexto,kexto)
+
+ if(iprt_nppf.eq.1)then
+ call charlen(filenppf,kf)
+ filename = filenppf(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(62,file=filename)
+ endif
+
+ if(iprt_yfnoburn.eq.1) then
+ call charlen(fileyfnoburn,kf)
+ filename =
+ & fileyfnoburn(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(83,file=filename)
+ endif
+
+ if(iprt_ftot.eq.1) then
+ call charlen(fileftot,kf)
+ filename = fileftot(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(86,file=filename)
+ endif
+
+ if(iprt_Fgdd5.eq.1) then
+ call charlen(fileFgdd5,kf)
+ filename = fileFgdd5(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(87,file=filename)
+ endif
+
+ if(iprt_FTmmin.eq.1) then
+ call charlen(fileFTmmin,kf)
+ filename = fileFTmmin(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(88,file=filename)
+ endif
+
+ if(iprt_Fwatmin.eq.1) then
+ call charlen(fileFwatmin,kf)
+ filename = fileFwatmin(1:kf)//filexto(1:kexto)//extout(1:kextout)
+ open(89,file=filename)
+ endif
+
+ return
+ end subroutine open_mig
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_orb_params.f b/couplage/CARAIB/ver01_Iv_couplage/mod_orb_params.f
new file mode 100644
index 0000000..962239c
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_orb_params.f
@@ -0,0 +1,496 @@
+c=======================================================================
+c***********************************************************************
+ subroutine orb_params
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c Calculate earth's orbital parameters using Dave Threshers
+c formula which came from Berger, Andre. 1978
+c "A Simple Algorithm to Compute Long-Term Variations
+c of Daily Insolation". Contribution 18, Institute of Astronomy and
+c Geophysics, Universite Catholique de Louvain, Louvain-la-Neuve,
+c Belgium.
+
+c Original Author: Erik Kluzek
+c Date: Oct/97
+c=======================================================================
+ IMPLICIT NONE
+
+ include './com_18/parameter.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/solpar.common'
+#include "./com_18/parameter_orb.common"
+
+CC exc = 0.016715 !ECCEN_EARTH ! Earth's orbital eccentricity
+CC obl = 23.441 !OBLIQ_EARTH ! Earth's obliquity in degree's
+CC xlsper = 102.7 !LOPER_EARTH ! Earth's moving vernal equinox longitude
+CC real :: oblr ! Earth's obliquity in radians
+CC real :: lambm0 ! Mean longitude of perihelion at the
+ ! vernal equinox (radians)
+CC real :: xlsperp ! Earth's moving vernal equinox longitude
+ ! of perihelion plus pi (radians)
+ real :: eccf ! Earth-sun distance factor ( i.e. (1/r)**2 )
+ integer :: nfixorb = 0 ! 1: fixed orbit parameter
+ integer :: iyrad,i_AD ! Year AD to calculate orbit for
+ logical, parameter :: lg_p = .true.
+ ! Flag to print-out status information or not.
+ ! (This turns off ALL status printing including)
+ ! (error messages.)
+
+c Input Arguments
+c ---------------
+CC real :: exc ! Earth's orbital eccentricity
+CC real :: obl ! Earth's obliquity in degree's
+CC real :: xlsper ! Earth's moving vernal equinox longitude
+
+c Output Arguments
+c ----------------
+CC real :: oblr ! Earth's obliquity in radians
+CC real :: lambm0 ! Mean longitude of perihelion at the
+c ! vernal equinox (radians)
+CC real :: xlsperp ! Earth's moving vernal equinox longitude
+c ! of perihelion plus pi (radians)
+
+c Parameters for calculating earth's orbital characteristics
+c ----------
+ integer, parameter :: poblen = 47 ! number of elements in the series to calc obliquity
+ integer, parameter :: pecclen = 19 ! number of elements in the series to calc eccentricity
+ integer, parameter :: pmvelen = 78 ! number of elements in the series to calc vernal equinox
+ real :: degrad ! degrees to radians conversion factor
+ real :: obamp(poblen) ! amplitudes for obliquity cosine series
+ real :: obrate(poblen) ! rates for obliquity cosine series
+ real :: obphas(poblen) ! phases for obliquity cosine series
+ real :: ecamp(pecclen) ! amplitudes for eccentricity/fvelp cosine/sine series
+ real :: ecrate(pecclen) ! rates for eccentricity/fvelp cosine/sine series
+ real :: ecphas(pecclen) ! phases for eccentricity/fvelp cosine/sine series
+ real :: mvamp(pmvelen) ! amplitudes for mvelp sine series
+ real :: mvrate(pmvelen) ! rates for mvelp sine series
+ real :: mvphas(pmvelen) ! phases for mvelp sine series
+ real :: yb4_1950AD ! number of years before 1950 AD
+
+ real, parameter :: psecdeg = 1./3600. ! arc seconds to degrees conversion
+
+c Cosine series data for computation of obliquity:
+c amplitude (arc seconds), rate (arc seconds/year), phase (degrees).
+
+ data obamp /-2462.2214466D0, -857.3232075D0, -629.3231835D0, &
+ & -414.2804924D0, -311.7632587D0, 308.9408604D0, &
+ & -162.5533601D0, -116.1077911D0, 101.1189923D0, &
+ & -67.6856209D0, 24.9079067D0, 22.5811241D0, &
+ & -21.1648355D0, -15.6549876D0, 15.3936813D0, &
+ & 14.6660938D0, -11.7273029D0, 10.2742696D0, &
+ & 6.4914588D0, 5.8539148D0, -5.4872205D0, &
+ & -5.4290191D0, 5.1609570D0, 5.0786314D0, &
+ & -4.0735782D0, 3.7227167D0, 3.3971932D0, &
+ & -2.8347004D0, -2.6550721D0, -2.5717867D0, &
+ & -2.4712188D0, 2.4625410D0, 2.2464112D0, &
+ & -2.0755511D0, -1.9713669D0, -1.8813061D0, &
+ & -1.8468785D0, 1.8186742D0, 1.7601888D0, &
+ & -1.5428851D0, 1.4738838D0, -1.4593669D0, &
+ & 1.4192259D0, -1.1818980D0, 1.1756474D0, &
+ & -1.1316126D0, 1.0896928D0/
+
+ data obrate /31.609974D0, 32.620504D0, 24.172203D0, &
+ & 31.983787D0, 44.828336D0, 30.973257D0, &
+ & 43.668246D0, 32.246691D0, 30.599444D0, &
+ & 42.681324D0, 43.836462D0, 47.439436D0, &
+ & 63.219948D0, 64.230478D0, 1.010530D0, &
+ & 7.437771D0, 55.782177D0, 0.373813D0, &
+ & 13.218362D0, 62.583231D0, 63.593761D0, &
+ & 76.438310D0, 45.815258D0, 8.448301D0, &
+ & 56.792707D0, 49.747842D0, 12.058272D0, &
+ & 75.278220D0, 65.241008D0, 64.604291D0, &
+ & 1.647247D0, 7.811584D0, 12.207832D0, &
+ & 63.856665D0, 56.155990D0, 77.448840D0, &
+ & 6.801054D0, 62.209418D0, 20.656133D0, &
+ & 48.344406D0, 55.145460D0, 69.000539D0, &
+ & 11.071350D0, 74.291298D0, 11.047742D0, &
+ & 0.636717D0, 12.844549D0/
+
+ data obphas /251.9025D0, 280.8325D0, 128.3057D0, &
+ & 292.7252D0, 15.3747D0, 263.7951D0, &
+ & 308.4258D0, 240.0099D0, 222.9725D0, &
+ & 268.7809D0, 316.7998D0, 319.6024D0, &
+ & 143.8050D0, 172.7351D0, 28.9300D0, &
+ & 123.5968D0, 20.2082D0, 40.8226D0, &
+ & 123.4722D0, 155.6977D0, 184.6277D0, &
+ & 267.2772D0, 55.0196D0, 152.5268D0, &
+ & 49.1382D0, 204.6609D0, 56.5233D0, &
+ & 200.3284D0, 201.6651D0, 213.5577D0, &
+ & 17.0374D0, 164.4194D0, 94.5422D0, &
+ & 131.9124D0, 61.0309D0, 296.2073D0, &
+ & 135.4894D0, 114.8750D0, 247.0691D0, &
+ & 256.6114D0, 32.1008D0, 143.6804D0, &
+ & 16.8784D0, 160.6835D0, 27.5932D0, &
+ & 348.1074D0, 82.6496D0/
+
+c Cosine/sine series data for computation of eccentricity and
+c fixed vernal equinox longitude of perihelion (fvelp):
+c amplitude, rate (arc seconds/year), phase (degrees).
+
+ data ecamp /0.01860798D0, 0.01627522D0, -0.01300660D0, &
+ & 0.00988829D0, -0.00336700D0, 0.00333077D0, &
+ & -0.00235400D0, 0.00140015D0, 0.00100700D0, &
+ & 0.00085700D0, 0.00064990D0, 0.00059900D0, &
+ & 0.00037800D0, -0.00033700D0, 0.00027600D0, &
+ & 0.00018200D0, -0.00017400D0, -0.00012400D0, &
+ & 0.00001250D0/
+
+ data ecrate /4.2072050D0, 7.3460910D0, 17.8572630D0, &
+ & 17.2205460D0, 16.8467330D0, 5.1990790D0, &
+ & 18.2310760D0, 26.2167580D0, 6.3591690D0, &
+ & 16.2100160D0, 3.0651810D0, 16.5838290D0, &
+ & 18.4939800D0, 6.1909530D0, 18.8677930D0, &
+ & 17.4255670D0, 6.1860010D0, 18.4174410D0, &
+ & 0.6678630D0/
+
+ data ecphas /28.620089D0, 193.788772D0, 308.307024D0, &
+ & 320.199637D0, 279.376984D0, 87.195000D0, &
+ & 349.129677D0, 128.443387D0, 154.143880D0, &
+ & 291.269597D0, 114.860583D0, 332.092251D0, &
+ & 296.414411D0, 145.769910D0, 337.237063D0, &
+ & 152.092288D0, 126.839891D0, 210.667199D0, &
+ & 72.108838D0/
+
+c Sine series data for computation of moving vernal equinox
+c longitude of perihelion:
+c amplitude (arc seconds), rate (arc seconds/year), phase (degrees).
+
+ data mvamp /7391.0225890D0, 2555.1526947D0, 2022.7629188D0, &
+ & -1973.6517951D0, 1240.2321818D0, 953.8679112D0, &
+ & -931.7537108D0, 872.3795383D0, 606.3544732D0, &
+ & -496.0274038D0, 456.9608039D0, 346.9462320D0, &
+ & -305.8412902D0, 249.6173246D0, -199.1027200D0, &
+ & 191.0560889D0, -175.2936572D0, 165.9068833D0, &
+ & 161.1285917D0, 139.7878093D0, -133.5228399D0, &
+ & 117.0673811D0, 104.6907281D0, 95.3227476D0, &
+ & 86.7824524D0, 86.0857729D0, 70.5893698D0, &
+ & -69.9719343D0, -62.5817473D0, 61.5450059D0, &
+ & -57.9364011D0, 57.1899832D0, -57.0236109D0, &
+ & -54.2119253D0, 53.2834147D0, 52.1223575D0, &
+ & -49.0059908D0, -48.3118757D0, -45.4191685D0, &
+ & -42.2357920D0, -34.7971099D0, 34.4623613D0, &
+ & -33.8356643D0, 33.6689362D0, -31.2521586D0, &
+ & -30.8798701D0, 28.4640769D0, -27.1960802D0, &
+ & 27.0860736D0, -26.3437456D0, 24.7253740D0, &
+ & 24.6732126D0, 24.4272733D0, 24.0127327D0, &
+ & 21.7150294D0, -21.5375347D0, 18.1148363D0, &
+ & -16.9603104D0, -16.1765215D0, 15.5567653D0, &
+ & 15.4846529D0, 15.2150632D0, 14.5047426D0, &
+ & -14.3873316D0, 13.1351419D0, 12.8776311D0, &
+ & 11.9867234D0, 11.9385578D0, 11.7030822D0, &
+ & 11.6018181D0, -11.2617293D0, -10.4664199D0, &
+ & 10.4333970D0, -10.2377466D0, 10.1934446D0, &
+ & -10.1280191D0, 10.0289441D0, -10.0034259D0/
+
+ data mvrate /31.609974D0, 32.620504D0, 24.172203D0, &
+ & 0.636717D0, 31.983787D0, 3.138886D0, &
+ & 30.973257D0, 44.828336D0, 0.991874D0, &
+ & 0.373813D0, 43.668246D0, 32.246691D0, &
+ & 30.599444D0, 2.147012D0, 10.511172D0, &
+ & 42.681324D0, 13.650058D0, 0.986922D0, &
+ & 9.874455D0, 13.013341D0, 0.262904D0, &
+ & 0.004952D0, 1.142024D0, 63.219948D0, &
+ & 0.205021D0, 2.151964D0, 64.230478D0, &
+ & 43.836462D0, 47.439436D0, 1.384343D0, &
+ & 7.437771D0, 18.829299D0, 9.500642D0, &
+ & 0.431696D0, 1.160090D0, 55.782177D0, &
+ & 12.639528D0, 1.155138D0, 0.168216D0, &
+ & 1.647247D0, 10.884985D0, 5.610937D0, &
+ & 12.658184D0, 1.010530D0, 1.983748D0, &
+ & 14.023871D0, 0.560178D0, 1.273434D0, &
+ & 12.021467D0, 62.583231D0, 63.593761D0, &
+ & 76.438310D0, 4.280910D0, 13.218362D0, &
+ & 17.818769D0, 8.359495D0, 56.792707D0, &
+ & 8.448301D0, 1.978796D0, 8.863925D0, &
+ & 0.186365D0, 8.996212D0, 6.771027D0, &
+ & 45.815258D0, 12.002811D0, 75.278220D0, &
+ & 65.241008D0, 18.870667D0, 22.009553D0, &
+ & 64.604291D0, 11.498094D0, 0.578834D0, &
+ & 9.237738D0, 49.747842D0, 2.147012D0, &
+ & 1.196895D0, 2.133898D0, 0.173168D0/
+
+ data mvphas /251.9025D0, 280.8325D0, 128.3057D0, &
+ & 348.1074D0, 292.7252D0, 165.1686D0, &
+ & 263.7951D0, 15.3747D0, 58.5749D0, &
+ & 40.8226D0, 308.4258D0, 240.0099D0, &
+ & 222.9725D0, 106.5937D0, 114.5182D0, &
+ & 268.7809D0, 279.6869D0, 39.6448D0, &
+ & 126.4108D0, 291.5795D0, 307.2848D0, &
+ & 18.9300D0, 273.7596D0, 143.8050D0, &
+ & 191.8927D0, 125.5237D0, 172.7351D0, &
+ & 316.7998D0, 319.6024D0, 69.7526D0, &
+ & 123.5968D0, 217.6432D0, 85.5882D0, &
+ & 156.2147D0, 66.9489D0, 20.2082D0, &
+ & 250.7568D0, 48.0188D0, 8.3739D0, &
+ & 17.0374D0, 155.3409D0, 94.1709D0, &
+ & 221.1120D0, 28.9300D0, 117.1498D0, &
+ & 320.5095D0, 262.3602D0, 336.2148D0, &
+ & 233.0046D0, 155.6977D0, 184.6277D0, &
+ & 267.2772D0, 78.9281D0, 123.4722D0, &
+ & 188.7132D0, 180.1364D0, 49.1382D0, &
+ & 152.5268D0, 98.2198D0, 97.4808D0, &
+ & 221.5376D0, 168.2438D0, 161.1199D0, &
+ & 55.0196D0, 262.6495D0, 200.3284D0, &
+ & 201.6651D0, 294.6547D0, 99.8233D0, &
+ & 213.5577D0, 154.1631D0, 232.7153D0, &
+ & 138.3034D0, 204.6609D0, 106.5938D0, &
+ & 250.4676D0, 332.3345D0, 27.3039D0/
+
+c Local variables
+c ---------------
+ integer i ! Index for series summations
+ real :: obsum ! Obliquity series summation
+ real :: cossum ! Cosine series summation for eccentricity/fvelp
+ real :: sinsum ! Sine series summation for eccentricity/fvelp
+ real :: fvelp ! Fixed vernal equinox longitude of perihelion
+ real :: mvsum ! mvelp series summation
+ real :: beta ! Intermediate argument for lambm0
+ real :: years ! Years to time of interest (negative = past;
+c ! positive = future)
+ real :: exc2 ! eccentricity squared
+ real :: exc3 ! eccentricity cubed
+CC real :: pi ! pi
+
+c radinp and algorithms below will need a degrees to radians conversion
+c factor.
+
+CC pi = 4.*atan(1.)
+ degrad = pi/180.
+
+c Check for flag to use input orbit parameters
+ i_AD = myear !!!!!! REMPLACER PAR nyear2 si Holocene
+ if(imig.eq.1) i_AD = 1950 - nyear2
+
+ if ( i_AD .eq. ORB_NOT_YEAR_BASED ) then
+
+c Check input obliq, eccen, and mvelp to ensure reasonable
+
+ if( obl .eq. ORB_UNDEF_REAL )then
+ if ( lg_p ) then
+ write(*,*)'(orb_params) Have to specify orbital parameters:'
+ write(*,*) 'Either set: ' &
+ & ,'i_AD, OR [obl, exc, and xlsper]:'
+ write(*,*)'i_AD is the year to simulate the orbit for '
+ & ,'(ie. 1950): '
+ write(*,*)'obl, exc, xlsper specify the orbit directly:'
+ write(*,*)'The AMIP II settings (for a 1995 orbit) are: '
+ write(*,*)' obl = 23.4441'
+ write(*,*)' exc = 0.016715'
+ write(*,*)' xlsper = 102.7'
+ end if
+ stop 999
+ else if ( lg_p ) then
+ write(*,*)'(orb_params) Use input orbital parameters: '
+ end if
+ if( (obl.lt.ORB_OBLIQ_MIN).or.(obl.gt.ORB_OBLIQ_MAX) ) then
+ if ( lg_p ) then
+ write(*,*) '(orb_params): Input obliquity unreasonable: ' &
+ & ,obl
+ end if
+ stop 999
+ end if
+ if( (exc.lt.ORB_ECCEN_MIN).or.(exc.gt.ORB_ECCEN_MAX) ) then
+ if ( lg_p ) then
+ write(*,*) '(orb_params): Input eccentricity unreasonable: '&
+ & ,exc
+ end if
+ stop 999
+ end if
+ if( (xlsper.lt.ORB_MVELP_MIN).or.
+ & (xlsper.gt.ORB_MVELP_MAX) ) then
+ if ( lg_p ) then
+ write(*,*)'(orb_params): Input mvelp unreasonable: ',xlsper
+ end if
+ stop 999
+ end if
+ exc2 = exc*exc
+ exc3 = exc2*exc
+ else
+
+c Otherwise calculate based on years before present
+
+ yb4_1950AD = 1950.0 - float(i_AD)
+ if ( abs(yb4_1950AD) .gt. 1000000.0 )then
+ if ( lg_p ) then
+ write(*,*)'(orb_params) orbit only valid for years+-1000000'
+ write(*,*)'(orb_params) Relative to 1950 AD'
+ write(*,*)'(orb_params) # of years before 1950: ',yb4_1950AD
+ write(*,*)'(orb_params) Year to simulate was : ',i_AD
+ end if
+ stop 999
+ end if
+
+
+c The following calculates the earth's obliquity, orbital eccentricity
+c (and various powers of it) and vernal equinox mean longitude of
+c perihelion for years in the past (future = negative of years past),
+c using constants (see parameter section) given in the program of:
+
+c Berger, Andre. 1978 A Simple Algorithm to Compute Long-Term Variations
+c of Daily Insolation. Contribution 18, Institute of Astronomy and
+c Geophysics, Universite Catholique de Louvain, Louvain-la-Neuve, Belgium.
+
+c and formulas given in the paper (where less precise constants are also
+c given):
+
+c Berger, Andre. 1978. Long-Term Variations of Daily Insolation and
+c Quaternary Climatic Changes. J. of the Atmo. Sci. 35:2362-2367
+
+c The algorithm is valid only to 1,000,000 years past or hence.
+c For a solution valid to 5-10 million years past see the above author.
+c Algorithm below is better for years closer to present than is the
+c 5-10 million year solution.
+
+c Years to time of interest must be negative of years before present
+c (1950) in formulas that follow.
+
+ years = - yb4_1950AD
+
+c In the summations below, cosine or sine arguments, which end up in
+c degrees, must be converted to radians via multiplication by degrad.
+
+c Summation of cosine series for obliquity (epsilon in Berger 1978) in
+c degrees. Convert the amplitudes and rates, which are in arc seconds, into
+c degrees via multiplication by psecdeg (arc seconds to degrees conversion
+c factor). For obliq, first term is Berger 1978's epsilon star; second
+c term is series summation in degrees.
+c
+ obsum = 0.0
+ do i = 1, poblen
+ obsum = obsum + &
+ & obamp(i)*psecdeg*cos((obrate(i)*psecdeg*years + &
+ & obphas(i))*degrad)
+ end do
+ obl = 23.320556 + obsum
+
+c Summation of cosine and sine series for computation of eccentricity
+c (eccen; e in Berger 1978) and fixed vernal equinox longitude of perihelion
+c (fvelp; pi in Berger 1978), which is used for computation of moving vernal
+c equinox longitude of perihelion. Convert the rates, which are in arc
+c seconds, into degrees via multiplication by psecdeg.
+
+ cossum = 0.0
+ do i = 1, pecclen
+ cossum = cossum + &
+ & ecamp(i)*cos((ecrate(i)*psecdeg*years + &
+ & ecphas(i))*degrad)
+ end do
+
+ sinsum = 0.0
+ do i = 1, pecclen
+ sinsum = sinsum + &
+ & ecamp(i)*sin((ecrate(i)*psecdeg*years + &
+ & ecphas(i))*degrad)
+ end do
+
+c Use summations to calculate eccentricity
+
+ exc2 = cossum*cossum + sinsum*sinsum
+ exc = sqrt(exc2)
+ exc3 = exc2*exc
+
+c A series of cases for fvelp, which is in radians.
+
+ if (abs(cossum) .le. 1.0E-8) then
+ if (sinsum .eq. 0.0) then
+ fvelp = 0.0
+ else if (sinsum .lt. 0.0) then
+ fvelp = 1.5*pi
+ else if (sinsum .gt. 0.0) then
+ fvelp = .5*pi
+ endif
+ else if (cossum .lt. 0.0) then
+ fvelp = atan(sinsum/cossum) + pi
+ else if (cossum .gt. 0.0) then
+ if (sinsum .lt. 0.0) then
+ fvelp = atan(sinsum/cossum) + 2.0*pi
+ else
+ fvelp = atan(sinsum/cossum)
+ endif
+ endif
+
+c Summation of sine series for computation of moving vernal equinox longitude
+c of perihelion (mvelp; omega bar in Berger 1978) in degrees. For mvelp,
+c first term is fvelp in degrees; second term is Berger 1978's psi bar times
+c years and in degrees; third term is Berger 1978's zeta; fourth term is
+c series summation in degrees. Convert the amplitudes and rates, which are
+c in arc seconds, into degrees via multiplication by psecdeg. Series summation
+c plus second and third terms constitute Berger 1978's psi, which is the
+c general precession.
+
+ mvsum = 0.0
+ do i = 1, pmvelen
+ mvsum = mvsum + &
+ & mvamp(i)*psecdeg*sin((mvrate(i)*psecdeg*years + &
+ & mvphas(i))*degrad)
+ end do
+ xlsper = fvelp/degrad + 50.439273*psecdeg*years + 3.392506 &
+ & + mvsum
+
+c Cases to make sure mvelp is between 0 and 360.
+
+ do while (xlsper .lt. 0.0)
+ xlsper = xlsper + 360.0
+ end do
+ do while (xlsper .ge. 360.0)
+ xlsper = xlsper - 360.0
+ end do
+ end if ! end of test on whether to calculate or use input orbital params
+
+c Orbit needs the obliquity in radians
+
+ oblr = obl*degrad
+
+c 180 degrees must be added to mvelp since observations are made from the
+c earth and the sun is considered (wrongly for the algorithm) to go around
+c the earth. For a more graphic explanation see Appendix B in:
+
+c A. Berger, M. Loutre and C. Tricot. 1993. Insolation and Earth's Orbital
+c Periods. J. of Geophysical Research 98:10,341-10,362.
+
+c Additionally, orbit will need this value in radians. So mvelp becomes
+c mvelpp (mvelp plus pi)
+
+ xlsperp = (xlsper + 180.)*degrad
+
+c Set up an argument used several times in lambm0 calculation ahead.
+
+ beta = sqrt(1. - exc2)
+
+c The mean longitude at the vernal equinox (lambda m nought in Berger
+c 1978; in radians) is calculated from the following formula given in
+c Berger 1978. At the vernal equinox the true longitude (lambda in Berger
+c 1978) is 0.
+
+ lambm0 = 2.*((.5*exc + .125*exc3)*(1. + beta)*sin(xlsperp)
+ & - .25*exc2*(.5 + beta)*sin(2.*xlsperp)
+ & + .125*exc3*(1./3. + beta)*sin(3.*xlsperp))
+
+ if ( lg_p ) then
+c write(*,*) exc,obl,xlsper
+CC write(*,'(/," ****************************************")')
+CC write(*,'(" * Computed Orbital Parameters *")')
+CC write(*,'(" ****************************************")')
+CC write(*,'(" * Year AD = ",i16 ," *")') i_AD
+CC write(*,'(" * Eccentricity = ",f16.6," *")') exc
+CC write(*,'(" * Obliquity (deg) = ",f16.6," *")') obl
+CC write(*,'(" * Obliquity (rad) = ",f16.6," *")') oblr
+CC write(*,'(" * Long of perh(deg) = ",f16.6," *")') xlsper
+CC write(*,'(" * Long of perh(rad) = ",f16.6," *")') xlsperp
+CC write(*,'(" * Long at v.e.(rad) = ",f16.6," *")') lambm0
+CC write(*,'(" ****************************************")')
+ end if
+
+ xlsper = xlsperp
+ obl = oblr
+
+ exc4 = exc * exc
+ exc5 = exc4 * exc
+ exc6 = 2. * exc
+ exc7 = 2.5 * exc4
+
+ return
+ end subroutine orb_params
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_pixel_corners.f b/couplage/CARAIB/ver01_Iv_couplage/mod_pixel_corners.f
new file mode 100644
index 0000000..574e8cc
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_pixel_corners.f
@@ -0,0 +1,61 @@
+c=======================================================================
+c***********************************************************************
+ subroutine pixel_corners(ngt)
+c***********************************************************************
+c=======================================================================
+
+c implicit double precision (a-h,o-z)
+ IMPLICIT NONE
+
+ include './com_18/parameter.common'
+ include './com_18/coord.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/disper.common'
+ include './com_18/griddata.common'
+ include './com_18/input_par.common'
+
+ integer ngt,k,ncr
+ real*4 aaa,bbb
+ double precision xlgvec(n_nghmx),xltvec(n_nghmx)
+
+ ylongi = xlg(ngt)
+ ylati = xlt(ngt)
+
+ if (igtyp.eq.0) then
+ ncor(ngt) = 4
+ xlgcor(1,ngt)=ylongi-declg/2.
+ xlgcor(2,ngt)=ylongi+declg/2.
+ xlgcor(3,ngt)=ylongi+declg/2.
+ xlgcor(4,ngt)=ylongi-declg/2.
+ xltcor(1,ngt)=ylati-declat/2.
+ xltcor(2,ngt)=ylati-declat/2.
+ xltcor(3,ngt)=ylati+declat/2.
+ xltcor(4,ngt)=ylati+declat/2.
+c area: pixel area (m2)
+c 1.23604116d+10 = (2*pi*r/360)**2 with r=6370000 m (earth radius)
+c ---------------------------------------------------------------------
+ areapix(ngt) = 1.23604116d+10*declg*declat*cos(ylati*pi/180.)
+ else
+ read(97,*)aaa,bbb,area,ncr,(xlgvec(k),k=1,ncr)
+ & ,(xltvec(k),k=1,ncr)
+ ncor(ngt)=ncr
+ do k = 1, ncr
+ xlgcor(k,ngt)=xlgvec(k)
+ xltcor(k,ngt)=xltvec(k)
+ end do
+ areapix(ngt) = area
+ endif
+
+ if (ncor(ngt).gt.n_nghmx) then
+ write(*,*)'Maximum number of neighbors n_nghmx=',n_nghmx,
+ & ' not large enough',
+ & ' Increase its value in parameter.common - Program Stop'
+ write(61,*)'Maximum number of neighbors n_nghmx=',n_nghmx,
+ & ' not large enough',
+ & ' Increase its value in parameter.common - Program Stop'
+ stop
+ endif
+
+ return
+ end subroutine pixel_corners
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_printparam.f b/couplage/CARAIB/ver01_Iv_couplage/mod_printparam.f
new file mode 100644
index 0000000..6c997fa
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_printparam.f
@@ -0,0 +1,36 @@
+c=======================================================================
+c***********************************************************************
+ subroutine printparam(ngt,label)
+c***********************************************************************
+c=======================================================================
+
+ implicit none
+ include './com_18/parameter.common'
+ include './com_18/cte.common'
+ include './com_18/ecoin.common'
+ include './com_18/inidata.common'
+ include './com_18/landuse.common'
+ include './com_18/loop.common'
+ include './com_18/nspc.common'
+
+ real*4 frac_tree_tot,ytot
+ integer ngt,ipl
+ character*100 label
+
+c if (ngt.eq.5) then
+ frac_tree_tot = 0.
+ ytot=0.
+ if(frac_nat(ngt).gt.0.) then
+ do ipl = nherb+nbush+1,npft0
+ frac_tree_tot = frac_tree_tot + frac(ipl)
+ ytot=ytot+yfrac_ini(ipl,ngt)
+ end do
+ endif
+c if(frac_tree_tot.gt.1.001*frac_nat(ngt)) then
+
+ write(61,'(a40,i6,3(1x,f10.7))') trim(label),ngt,frac_tree_tot
+ & ,ytot,frac_nat(ngt)
+c endif
+
+ return
+ end subroutine printparam
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_randnum.F b/couplage/CARAIB/ver01_Iv_couplage/mod_randnum.F
new file mode 100644
index 0000000..cec66b0
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_randnum.F
@@ -0,0 +1,31 @@
+c=======================================================================
+c***********************************************************************
+ subroutine randnum(seed,frnd)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c This subroutine returns a random number frnd between 0 and 1.
+c through two successive calls to the rand function. If the rand
+c function requires an integer argument on your machine, igrn must
+c be declared as an integer, otherwise it should be declared as
+c real*4 igrn
+c and the line "integer igrn" should be dropped.
+c INPUT
+c seed = real*4 number used as seed for the random generation
+c OUTPUT
+c frnd = generated random number in the interval [0,1]
+c=======================================================================
+ implicit none
+ real*4 seed,frnd
+ real*4 rand,gr1
+
+ integer igrn
+
+ igrn = int(100000.*seed)
+ gr1 = rand(igrn)
+ igrn = int(100000.*(seed+gr1)/(gr1+10.0))
+ frnd = rand(igrn)
+
+ return
+ end subroutine randnum
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_read_eco.f b/couplage/CARAIB/ver01_Iv_couplage/mod_read_eco.f
new file mode 100644
index 0000000..609d3f0
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_read_eco.f
@@ -0,0 +1,69 @@
+c=======================================================================
+c***********************************************************************
+ subroutine read_eco(ngt)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c This routine reads the different environmental inputs as well
+c as vegetation characteristics and set them in the right form.
+c=======================================================================
+
+c implicit double precision (a-h,o-z)
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/annee.common'
+ include './com_18/climin0.common'
+ include './com_18/climkop.common'
+ include './com_18/coord.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/eco.common'
+ include './com_18/ecoin.common'
+ include './com_18/ecopro.common'
+ include './com_18/envi.common'
+ include './com_18/estab.common'
+ include './com_18/gridclim.common'
+ include './com_18/griddata.common'
+ include './com_18/gridin2.common'
+ include './com_18/input_par.common'
+ include './com_18/inidata.common'
+ include './com_18/landuse.common'
+ include './com_18/nspc.common'
+ include './com_18/smrd.common'
+ include './com_18/sr_par.common'
+ include './com_18/temper.common'
+ include './com_18/vegfr.common'
+ include './com_18/xlaic.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer igrr,ngt
+ real*4 elv
+c
+c-----------------------------------------------
+c=======================================================================
+c reads soil characteristic and elevation
+c igrr: pixel number
+c xlg, xlt: longitude, latitude (degrees)
+c isu: soil unit (FAO, Zobler classification)
+c clay, silt, sand: clay, silt, sand contents of soils (%)
+c elev: land elevation (m)
+c xcolor: soil color (0=dark, 0.5=medium, 1=clear)
+c=======================================================================
+ read(1,*)igrr,ylongi,ylati,isunit,cla,sil,san,elv,colour
+ if(elv.lt.0.)elv=0.
+
+ xlg(ngt) = ylongi
+ xlt(ngt) = ylati
+ isu(ngt) = isunit
+ sand(ngt) = san
+ silt(ngt) = sil
+ clay(ngt) = cla
+ elev(ngt) = elv
+ xcolor(ngt) = colour
+
+
+ return
+ end subroutine read_eco
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_read_in.f b/couplage/CARAIB/ver01_Iv_couplage/mod_read_in.f
new file mode 100644
index 0000000..7bae9a8
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_read_in.f
@@ -0,0 +1,710 @@
+c=======================================================================
+c***********************************************************************
+ subroutine read_in(ngt,iread)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c This routine reads the different environmental inputs as well
+c as vegetation characteristics and set them in the right form.
+c=======================================================================
+
+ USE MOD_NETCDFCARAIB
+ IMPLICIT NONE
+
+c implicit double precision (a-h,o-z)
+
+ include './com_18/parameter.common'
+ include './com_18/annee.common'
+ include './com_18/burned.common'
+ include './com_18/climin0.common'
+ include './com_18/climin.common'
+ include './com_18/climkop.common'
+ include './com_18/co2.common'
+ include './com_18/coord.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/eco.common'
+ include './com_18/ecoin.common'
+ include './com_18/ecopro.common'
+ include './com_18/envi.common'
+ include './com_18/fgr.common'
+ include './com_18/fileunits.common'
+ include './com_18/gridclim.common'
+ include './com_18/griddata.common'
+ include './com_18/gridin2.common'
+ include './com_18/icyr.common'
+ include './com_18/inidata.common'
+ include './com_18/iprt.common'
+ include './com_18/landuse.common'
+ include './com_18/management.common'
+ include './com_18/monthcst.common'
+ include './com_18/netcdf_par.common'
+ include './com_18/nspc.common'
+ include './com_18/prt_ctrl.common'
+ include './com_18/radcst.common'
+ include './com_18/smrd.common'
+ include './com_18/sr_par.common'
+ include './com_18/temper.common'
+ include './com_18/vegfr.common'
+ include './com_18/xlaic.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer iday,istatus,k,m,m1,m2
+ real*4 aa,aaa,bb,bbb,elv,xltr2
+c
+c-----------------------------------------------
+
+c// BEGIN
+ CHARACTER(LEN=*), PARAMETER :: fn_caraib = __FILE__
+c// END
+
+ integer ngt,iread
+
+ real*4 tem_a(nm),dte_a(nm),prc_a(nm),rhu_a(nm),shr_a(nm)
+ & ,wnd_a(nm),temax_a(nm),temin_a(nm)
+ real*4 tem_b(nm),dte_b(nm),prc_b(nm),rhu_b(nm),shr_b(nm),
+ & wnd_b(nm),temax_b(nm),temin_b(nm)
+ real*4 diff_t(nm),diff_d(nm),diff_p(nm),diff_r(nm),diff_s(nm),
+ & diff_w(nm)
+ integer j,x
+
+ integer nprt_clim,iy_past
+ character*100 prtform
+
+c// BEGIN
+ ! Starting indices and counters for NetCDF reads
+ INTEGER, DIMENSION(3), SAVE :: istart = 0, ncount = 0
+ ! Temporary indices for searching purposes
+ INTEGER :: ncpos_lon_save, ncpos_lat_save
+c// END
+
+c=======================================================================
+c reads soil characteristic and elevation
+c igrr: pixel number
+c ylongi, ylati: longitude, latitude (degrees)
+c isuni: soil unit (FAO, Zobler classification)
+c cla, sil, san: clay, silt, sand contents of soils (%)
+c elv: land elevation (m)
+c colour: soil color (0=dark, 0.5=medium, 1=clear)
+c=======================================================================
+
+ ylongi = xlg(ngt) ! from griddata.common, initialised in read_eco,
+ ylati = xlt(ngt) ! read in from filtxt (soil texture, unit 1)
+ isunit = isu(ngt)
+ cla = clay(ngt)
+ sil = silt(ngt)
+ san = sand(ngt)
+ elv = elev(ngt)
+
+ if (num_ncdf.ge.1) then
+ ncpos_lon = ilon4ngt(ngt)
+ ncpos_lat = jlat4ngt(ngt)
+ endif
+
+ xltr2= ylati * pi180
+ clati = cos(xltr2)
+ if(clati .le. 1.e-20) clati = 1.e-20
+ slati = sin(xltr2)
+
+
+c calculates volumetric fraction of water at saturation, field capacity
+c and wilting point for each texture class from Saxton et al.'s
+c parameterization
+c ---------------------------------------------------------------------
+ smfs = 0.332-7.251d-4*san + 0.1276*alog10(cla)
+ if(cla.le.60.)then
+ aa = dexp( - 4.396 - 0.0715*cla - 4.88d-4*san*san
+ 1 - 4.285d-5*san*san*cla ) * 100.
+ bb = - 3.14-0.00222*cla*cla-3.484d-5*san*san*cla
+ else
+ aa = dexp( - 4.396 - 0.0715*60. - 4.88d-4*san*san
+ 1 - 4.285d-5*san*san*60. ) * 100.
+ bb = - 3.14 - 0.00222*60.*60. - 3.484d-5*san*san*60.
+ endif
+ smfc = (33./aa)**(1./bb)
+ smwp = (1500./aa)**(1./bb)
+ acd=12.012-0.0755*san
+ bcd=-3.8950+0.03671*san-0.1103*cla+8.7546d-4*cla*cla
+
+
+c patm: surface pressure (Pa)
+c ---------------------------------------------------------------------
+ patm = patm0 - 11.5*elv + 5.44d-4*elv*elv
+
+c co2a: atmospheric partial pressure of CO2(mubar)
+c ---------------------------------------------------------------------
+
+ co2a = pco2_rd*patm/patm0
+
+ if ((nyear.eq.1).and.(iread.eq.0)) then
+ do iy_past = 1, 20
+ co2_prev(iy_past) = co2a
+ end do
+ elseif (ngt.eq.1) then
+ do iy_past = 20, 2, -1
+ co2_prev(iy_past) = co2_prev(iy_past-1)
+ end do
+ co2_prev(1) = co2a
+ endif
+
+
+
+c o2cl: atmospheric partial pressure of O2 (mubar)
+c ---------------------------------------------------------------------
+ o2cl = 0.21*patm/100.
+
+c colour: soil colour (0:dark - 1:light)
+c ---------------------------------------------------------------------
+ colour = xcolor(ngt)
+
+c area: pixel area (m2)
+c ---------------------------------------------------------------------
+ area = areapix(ngt)
+
+
+c=======================================================================
+c reads monthly meteorological data
+c tcel0 : temperature (deg.),
+c tdiff0 : amplitude of diurnal temperature variation (deg.),
+c prc0 : precipitation (mm/mo),
+c sunhour0 : relative sunshine hour with respect to possible (0:1),
+c rhu0 : relative humidity (0:1),
+c win0 : horizontal wind speed (m s-1).
+c=======================================================================
+
+
+ if (idaily_in.eq.0) then
+
+ if (num_ncdf.ge.1) then
+
+ istart = (/ ncpos_lon, ncpos_lat, 1 /)
+ ncount = (/ 1, 1, nm /)
+
+ endif
+
+
+ if(iclim_cal.eq.0) then
+c~ c read(2,*)aaa,bbb,(tcel0(m),m=1,nm)
+c~ c// BEGIN
+c~ istatus = NF_GET_VARA_REAL(ncid_filtema, ncvar_tema,
+c~ & istart, ncount, tcel0(1:nm))
+c~ IF (istatus /= NF_NOERR)
+c~ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c~ c// END
+c~ c read(3,*)aaa,bbb,(tdiff0(m),m=1,nm)
+c~ c// BEGIN
+c~ istatus = NF_GET_VARA_REAL(ncid_fildtaa, ncvar_dtaa,
+c~ & istart, ncount, temax0(1:nm))
+c~ IF (istatus /= NF_NOERR)
+c~ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c~ c// END
+c~ c// BEGIN
+c~ istatus = NF_GET_VARA_REAL(ncid_fildtba, ncvar_dtba,
+c~ & istart, ncount, temin0(1:nm))
+c~ IF (istatus /= NF_NOERR)
+c~ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c~ c// END
+c~
+c~ c read(4,*)aaa,bbb,(prc0(m),m=1,nm)
+c~ c// BEGIN
+c~ istatus = NF_GET_VARA_REAL(ncid_filprca, ncvar_prca,
+c~ & istart, ncount, prc0(1:nm))
+c~ IF (istatus /= NF_NOERR)
+c~ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c~ c// END
+c~ c read(7,*)aaa,bbb,(sunhour0(m),m=1,nm)
+c~ c read(8,*)aaa,bbb,(rhu0(m),m=1,nm)
+c~ c// BEGIN
+c~ istatus = NF_GET_VARA_REAL(ncid_filshia, ncvar_shia,
+c~ & istart, ncount, sunhour0(1:nm))
+c~ IF (istatus /= NF_NOERR)
+c~ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c~ c// END
+c~
+c~ c// BEGIN
+c~ istatus = NF_GET_VARA_REAL(ncid_filrhua, ncvar_rhua,
+c~ & istart, ncount, rhu0(1:nm))
+c~ IF (istatus /= NF_NOERR)
+c~ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c~ c// END
+c~
+c~ c// BEGIN
+c~ c// DEL read(9,*)aaa,bbb,(win0(m),m=1,nm)
+c~ istatus = NF_GET_VARA_REAL(ncid_filwina, ncvar_wina,
+c~ & istart, ncount, win0(1:nm))
+c~ IF (istatus /= NF_NOERR)
+c~ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c~ c// END
+c~
+c~ c UNIT CONVERSION (monthly)
+c~ do m = 1, nm
+c~ tcel0(m) = uc0_tem + uc1_tem * tcel0(m)
+c~ temax0(m) = uc0_dta + uc1_dta * temax0(m)
+c~ temin0(m) = uc0_dtb + uc1_dtb * temin0(m)
+c~ prc0(m) = uc0_prc + uc1_prc * prc0(m)
+c~ sunhour0(m) = uc0_shi + uc1_shi * sunhour0(m)
+c~ rhu0(m) = uc0_rhu + uc1_rhu * rhu0(m)
+c~ win0(m) = uc0_win + uc1_win * win0(m)
+c~ end do
+c~
+c~ c END OF UNIT CONVERSION (monthly)
+
+! Get monthly mean climate forcing data into the xxx0(:) arrays from
+! the xxx1year(:,:) arrays and convert units
+ tcel0(1:nm) = uc0_tem + uc1_tem * tcel1year(1:nm, ngt)
+ temax0(1:nm) = uc0_dta + uc1_dta * temax1year(1:nm, ngt)
+ temin0(1:nm) = uc0_dtb + uc1_dtb * temin1year(1:nm, ngt)
+ prc0(1:nm) = uc0_prc + uc1_prc * prc1year(1:nm, ngt)
+ sunhour0(1:nm) = uc0_shi + uc1_shi * sunhour1year(1:nm, ngt)
+ rhu0(1:nm) = uc0_rhu + uc1_rhu * rhu1year(1:nm, ngt)
+ win0(1:nm) = uc0_win + uc1_win * win1year(1:nm, ngt)
+
+ do m = 1,nm
+ if (idtem.eq.0) then
+ tdiff0(m)= temax0(m)
+ else
+ tdiff0(m)= temax0(m) - temin0(m)
+ endif
+ if (tdiff0(m).lt.0.) tdiff0(m)=0.
+ end do
+
+ else ! iclim_cal
+
+
+c~ c read(2,*)aaa,bbb,(tem_a(m),m=1,nm)
+c~ c// BEGIN
+c~ istatus = NF_GET_VARA_REAL(ncid_filtema, ncvar_tema,
+c~ & istart, ncount, tem_a(1:nm))
+c~ IF (istatus /= NF_NOERR)
+c~ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-3))
+c~ c// END
+c~ c read(3,*)aaa,bbb,(dte_a(m),m=1,nm)
+c~ c// BEGIN
+c~ istatus = NF_GET_VARA_REAL(ncid_fildtaa, ncvar_dtaa,
+c~ & istart, ncount, temax_a(1:nm))
+c~ IF (istatus /= NF_NOERR)
+c~ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c~ c// END
+c~ c// BEGIN
+c~ istatus = NF_GET_VARA_REAL(ncid_fildtba, ncvar_dtba,
+c~ & istart, ncount, temin_a(1:nm))
+c~ IF (istatus /= NF_NOERR)
+c~ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c~ c// END
+c~
+c~ c read(4,*)aaa,bbb,(prc_a(m),m=1,nm)
+c~ c// BEGIN
+c~ istatus = NF_GET_VARA_REAL(ncid_filprca, ncvar_prca,
+c~ & istart, ncount, prc_a(1:nm))
+c~ IF (istatus /= NF_NOERR)
+c~ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-3))
+c~ c// END
+c~ c read(7,*)aaa,bbb,(shr_a(m),m=1,nm)
+c~ c read(8,*)aaa,bbb,(rhu_a(m),m=1,nm)
+c~ c// BEGIN
+c~ istatus = NF_GET_VARA_REAL(ncid_filshia, ncvar_shia,
+c~ & istart, ncount, shr_a(1:nm))
+c~ IF (istatus /= NF_NOERR)
+c~ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-3))
+c~ c// END
+c~
+c~ c// BEGIN
+c~ istatus = NF_GET_VARA_REAL(ncid_filrhua, ncvar_rhua,
+c~ & istart, ncount, rhu_a(1:nm))
+c~ IF (istatus /= NF_NOERR)
+c~ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-3))
+c~ c// END
+c~
+c~ c// BEGIN
+c~ c// DEL read(9,*)aaa,bbb,(wnd_a(m),m=1,nm)
+c~ istatus = NF_GET_VARA_REAL(ncid_filwina, ncvar_wina,
+c~ & istart, ncount, wnd_a(1:nm))
+c~ IF (istatus /= NF_NOERR)
+c~ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-3))
+c~ c// END
+c~
+c~ c UNIT CONVERSION (monthly)
+c~ do m = 1, nm
+c~ tem_a(m) = uc0_tem + uc1_tem * tem_a(m)
+c~ temax_a(m) = uc0_dta + uc1_dta * temax_a(m)
+c~ temin_a(m) = uc0_dtb + uc1_dtb * temin_a(m)
+c~ prc_a(m) = uc0_prc + uc1_prc * prc_a(m)
+c~ shr_a(m) = uc0_shi + uc1_shi * shr_a(m)
+c~ rhu_a(m) = uc0_rhu + uc1_rhu * rhu_a(m)
+c~ wnd_a(m) = uc0_win + uc1_win * wnd_a(m)
+c~ end do
+c~
+c~ c END OF UNIT CONVERSION (monthly)
+
+! Get monthly mean climate forcing data into the xxx_a(:) arrays from
+! the xxx1year(:,:) arrays and convert units
+
+ tem_a(1:nm) = uc0_tem + uc1_tem * tcel1year(1:nm, ngt)
+ temax_a(1:nm) = uc0_dta + uc1_dta * temax1year(1:nm, ngt)
+ temin_a(1:nm) = uc0_dtb + uc1_dtb * temin1year(1:nm, ngt)
+ prc_a(1:nm) = uc0_prc + uc1_prc * prc1year(1:nm, ngt)
+ shr_a(1:nm) = uc0_shi + uc1_shi * sunhour1year(1:nm, ngt)
+ rhu_a(1:nm) = uc0_rhu + uc1_rhu * rhu1year(1:nm, ngt)
+ wnd_a(1:nm) = uc0_win + uc1_win * win1year(1:nm, ngt)
+
+
+! Get monthly mean climate forcing data into the xxx_b(:) by reading
+! them provisionally directly from the file
+ if (incdf_tem.eq.1) then
+c// BEGIN
+ istatus = NF_GET_VARA_REAL(ncid_filtemb, ncvar_temb,
+ & istart, ncount, tem_b(1:nm))
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-3))
+c// END
+ else
+ read(iunit_temb,*)aaa,bbb,(tem_b(m),m=1,nm)
+ endif
+
+ if (incdf_dta.eq.1) then
+c// BEGIN
+ istatus = NF_GET_VARA_REAL(ncid_fildtab, ncvar_dtab,
+ & istart, ncount, temax_b(1:nm))
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c// END
+ else
+ read(iunit_dtab,*)aaa,bbb,(temax_b(m),m=1,nm)
+ endif
+
+ if (idtem.eq.1) then
+ if (incdf_dtb.eq.1) then
+c// BEGIN
+ istatus = NF_GET_VARA_REAL(ncid_fildtbb, ncvar_dtbb,
+ & istart, ncount, temin_b(1:nm))
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-2))
+c// END
+ else
+ read(iunit_dtbb,*)aaa,bbb,(temin_b(m),m=1,nm)
+ endif
+ endif
+
+ if (incdf_prc.eq.1) then
+c// BEGIN
+ istatus = NF_GET_VARA_REAL(ncid_filprcb, ncvar_prcb,
+ & istart, ncount, prc_b(1:nm))
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-3))
+c// END
+ else
+ read(iunit_prcb,*)aaa,bbb,(prc_b(m),m=1,nm)
+ endif
+
+ if (incdf_shi.eq.1) then
+c// BEGIN
+ istatus = NF_GET_VARA_REAL(ncid_filshib, ncvar_shib,
+ & istart, ncount, shr_b(1:nm))
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-3))
+c// END
+ else
+ read(iunit_shib,*)aaa,bbb,(shr_b(m),m=1,nm)
+ endif
+
+ if (incdf_rhu.eq.1) then
+c// BEGIN
+ istatus = NF_GET_VARA_REAL(ncid_filrhub, ncvar_rhub,
+ & istart, ncount, rhu_b(1:nm))
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-3))
+c// END
+ else
+ read(iunit_rhub,*)aaa,bbb,(rhu_b(m),m=1,nm)
+ endif
+
+ if (incdf_win.eq.1) then
+c// BEGIN
+ istatus = NF_GET_VARA_REAL(ncid_filwinb, ncvar_winb,
+ & istart, ncount, wnd_b(1:nm))
+ IF (istatus /= NF_NOERR)
+ & CALL HANDLE_NCERRORS(istatus, fn_caraib, (__LINE__-3))
+c// END
+ else
+ read(iunit_winb,*)aaa,bbb,(wnd_b(m),m=1,nm)
+ endif
+
+c UNIT CONVERSION (monthly)
+ do m = 1, nm
+ tem_b(m) = uc0_tem + uc1_tem * tem_b(m)
+ temax_b(m) = uc0_dta + uc1_dta * temax_b(m)
+ temin_b(m) = uc0_dtb + uc1_dtb * temin_b(m)
+ prc_b(m) = uc0_prc + uc1_prc * prc_b(m)
+ shr_b(m) = uc0_shi + uc1_shi * shr_b(m)
+ rhu_b(m) = uc0_rhu + uc1_rhu * rhu_b(m)
+ wnd_b(m) = uc0_win + uc1_win * wnd_b(m)
+ end do
+
+c END OF UNIT CONVERSION (monthly)
+
+
+ do m = 1,nm
+ if (idtem.eq.0) then
+ tdiff0(m)= temax0(m)
+ dte_a(m) = temax_a(m)
+ dte_b(m) = temax_b(m)
+ else
+ tdiff0(m)= temax0(m) - temin0(m)
+ dte_a(m) = temax_a(m) - temin_a(m)
+ dte_b(m) = temax_b(m) - temin_b(m)
+ endif
+
+ if (tdiff0(m).lt.0.) tdiff0(m)=0.
+ if (dte_a(m).lt.0.) dte_a(m)=0.
+ if (dte_b(m).lt.0.) dte_b(m)=0.
+ end do
+
+
+
+ x = ibb-iaa
+ j = nyear2-iaa
+
+ do m = 1,nm
+ diff_t(m) = tem_b(m) - tem_a(m)
+ diff_d(m) = dte_b(m) - dte_a(m)
+ diff_p(m) = prc_b(m) - prc_a(m)
+ diff_s(m) = shr_b(m) - shr_a(m)
+ diff_r(m) = rhu_b(m) - rhu_a(m)
+ diff_w(m) = wnd_b(m) - wnd_a(m)
+
+ tcel0(m) = tem_a(m) + j*(diff_t(m)/x)
+ tdiff0(m) = dte_a(m) + j*(diff_d(m)/x)
+ prc0(m) = prc_a(m) + j*(diff_p(m)/x)
+ sunhour0(m) = shr_a(m) + j*(diff_s(m)/x)
+ rhu0(m) = rhu_a(m) + j*(diff_r(m)/x)
+ win0(m) = wnd_a(m) + j*(diff_w(m)/x)
+ enddo
+
+ endif ! iclim_cal
+
+ do k=1,nm
+ sunhour0(k)=sunhour0(k)/100.
+ if (sunhour0(k).lt.0.) sunhour0(k)=0.
+ if (sunhour0(k).gt.1.) sunhour0(k)=1.
+ enddo
+
+ do k=1,nm
+ rhu0(k)=rhu0(k)/100.
+ if (rhu0(k).lt.0.) rhu0(k)=0.
+ if (rhu0(k).gt.1.) rhu0(k)=1.
+ enddo
+
+ else ! i.e., if (idaily_in /= 0) then
+
+c~ c// istart in the following will have to be changed in case daily data
+c~ c// would have to be read in fomr some other starting point than the
+c~ c// first day in the file.
+c~
+c~ istart = (/ ncpos_lon, ncpos_lat, ncpos_time /)
+c~ ncount = (/ 1, 1, nd /)
+
+
+! Load the data into the xxx(:) arrays from the xxx1year(:,:) arrays
+! and convert units; sanity check and limit them.
+ tcel(1:nd) = uc0_tem + uc1_tem * tcel1year(1:nd, ngt)
+
+ temax(1:nd) = uc0_dta + uc1_dta * temax1year(1:nd, ngt)
+ temin(1:nd) = uc0_dtb + uc1_dtb * temin1year(1:nd, ngt)
+
+ do iday = 1,nd
+ if (idtem.eq.0) then
+ tdiff(iday)= temax(iday)
+ else
+ tdiff(iday)= temax(iday) - temin(iday)
+ endif
+ if (tdiff(iday).lt.0.) tdiff(iday)=0.
+ enddo
+
+ prc(1:nd) = uc0_prc + uc1_prc * prc1year(1:nd, ngt)
+
+ sunhour(1:nd) = uc0_shi + uc1_shi * sunhour1year(1:nd, ngt)
+
+ if (isol.eq.0) then
+ do iday=1,nd
+ sunhour(iday) = sunhour(iday)/100.
+ if (sunhour(iday).lt.0.) sunhour(iday)=0.
+ if (sunhour(iday).gt.1.) sunhour(iday)=1.
+ enddo
+ else
+ do iday = 1, nd
+ fsol(iday) = sunhour(iday)
+ end do
+ endif
+
+ rhu(1:nd) = uc0_rhu + uc1_rhu * rhu1year(1:nd, ngt)
+
+ do iday=1,nd
+ rhu(iday)=rhu(iday)/100.
+ if (rhu(iday).lt.0.1) rhu(iday)=0.1
+ if (rhu(iday).gt.1.) rhu(iday)=1.
+ enddo
+
+ win(1:nd) = uc0_win + uc1_win * win1year(1:nd, ngt)
+
+ do m=1,nm
+ tcel0(m) = 0.
+ tdiff0(m) = 0.
+ prc0(m) = 0.
+ if (isol.eq.0) then
+ sunhour0(m) = 0.
+ else
+ fsol0(m) = 0.
+ endif
+
+ rhu0(m) = 0.
+ win0(m) = 0.
+ end do
+
+ do iday = 1, nd
+ m = imonth(iday)
+ tcel0(m) = tcel0(m) + tcel(iday)/float(mlength(m))
+ tdiff0(m) = tdiff0(m) + tdiff(iday)/float(mlength(m))
+ prc0(m) = prc0(m) + prc(iday)
+ if (isol.eq.0) then
+ sunhour0(m) = sunhour0(m)+sunhour(iday)/float(mlength(m))
+ else
+ fsol0(m) = fsol0(m)+fsol(iday)/float(mlength(m))
+ endif
+ rhu0(m) = rhu0(m)+rhu(iday)/float(mlength(m))
+ win0(m) = win0(m)+win(iday)/float(mlength(m))
+ end do
+
+ endif
+
+c=======================================================================
+c prints climate data if ipr_clim is not equal to 0
+c=======================================================================
+
+ if (ipr_clim.ne.0)then
+
+ if (ipr_clim.eq.1)then
+ if (iprt_tem.eq.1) then
+ write(prtform,*)'(f8.3,1x,f8.3,',nm,'(1x,f6.2))'
+ write(502,prtform)ylongi,ylati,(tcel0(m),m=1,nm)
+ endif
+ if (iprt_dte.eq.1) then
+ write(prtform,*)'(f8.3,1x,f8.3,',nm,'(1x,f6.2))'
+ write(503,prtform)ylongi,ylati,(tdiff0(m),m=1,nm)
+ endif
+ if (iprt_prc.eq.1) then
+ write(prtform,*)'(f8.3,1x,f8.3,',nm,'(1x,f7.2))'
+ write(504,prtform)ylongi,ylati,(prc0(m),m=1,nm)
+ endif
+ if (iprt_shr.eq.1) then
+ if (isol.eq.0) then
+ write(prtform,*)'(f8.3,1x,f8.3,',nm,'(1x,f6.2))'
+ write(507,prtform)ylongi,ylati,(100.*sunhour0(m),m=1,nm)
+ else
+ write(prtform,*)'(f8.3,1x,f8.3,',nm,'(1x,f7.2))'
+ write(507,prtform)ylongi,ylati,(fsol0(m),m=1,nm)
+ endif
+ endif
+ if (iprt_rhu.eq.1) then
+ write(prtform,*)'(f8.3,1x,f8.3,',nm,'(1x,f6.2))'
+ write(508,prtform)ylongi,ylati,(100.*rhu0(m),m=1,nm)
+ endif
+ if (iprt_win.eq.1) then
+ write(prtform,*)'(f8.3,1x,f8.3,',nm,'(1x,f6.2))'
+ write(509,prtform)ylongi,ylati,(win0(m),m=1,nm)
+ endif
+ else
+ if (iprt_tem.eq.1) then
+ write(prtform,*)'(f8.3,1x,f8.3,',nd,'(1x,f6.2))'
+ write(502,prtform)ylongi,ylati,(tcel(iday),iday=1,nd)
+ endif
+ if (iprt_dte.eq.1) then
+ write(prtform,*)'(f8.3,1x,f8.3,',nd,'(1x,f6.2))'
+ write(503,prtform)ylongi,ylati,(tdiff(iday),iday=1,nd)
+ endif
+ if (iprt_prc.eq.1) then
+ write(prtform,*)'(f8.3,1x,f8.3,',nd,'(1x,f7.2))'
+ write(504,prtform)ylongi,ylati,(prc(iday),iday=1,nd)
+ endif
+ if (iprt_shr.eq.1) then
+ if (isol.eq.0) then
+ write(prtform,*)'(f8.3,1x,f8.3,',nd,'(1x,f6.2))'
+ write(507,prtform)ylongi,ylati,(100.*sunhour(iday),iday=1,nd)
+ else
+ write(prtform,*)'(f8.3,1x,f8.3,',nd,'(1x,f7.2))'
+ write(507,prtform)ylongi,ylati,(fsol(iday),iday=1,nd)
+ endif
+ endif
+ if (iprt_rhu.eq.1) then
+ write(prtform,*)'(f8.3,1x,f8.3,',nd,'(1x,f6.2))'
+ write(508,prtform)ylongi,ylati,(100.*rhu(iday),iday=1,nd)
+ endif
+ if (iprt_win.eq.1) then
+ write(prtform,*)'(f8.3,1x,f8.3,',nd,'(1x,f6.2))'
+ write(509,prtform)ylongi,ylati,(win(iday),iday=1,nd)
+ endif
+ endif
+
+ endif
+
+c=======================================================================
+c reads management data
+c mg_mode: type of management (1 = provide LAI and aboveground
+c structural carbon left after cutting)
+c mg_days: numbers of days where management is operated over the
+c year (= management days)
+c iday_mg: day number of management days (mg_days values must be
+c provided)
+c cleft(1,*): LAI, carbon content or biomass proportion (depending
+c on mg_mode) of reservoir 1 left after cutting
+c (mg_days values must be provided)
+c cleft(2,*): aboveground carbon or biomass proportion (depending
+c on mg_mode) of reservoir 2 left after cutting
+c (mg_days values must be provided)
+c=======================================================================
+
+ if (imanag.eq.1) read(92,*)aaa,bbb,mg_mode,mg_days
+ & ,(iday_mg(m),m=1,mg_days),(cleft_mg(1,m1),m1=1,mg_days)
+ & ,(cleft_mg(2,m2),m2=1,mg_days)
+
+c write(*,*)mg_mode,mg_days
+c write(*,*)(iday_mg(m),m=1,mg_days)
+c write(*,*)(cleft_mg(1,m1),m1=1,mg_days)
+c write(*,*)(cleft_mg(2,m2),m2=1,mg_days)
+
+c=======================================================================
+c reads monthly lightning data
+c xmflash : flash frequency (flashes km-2 mo-1)
+c=======================================================================
+
+ if (ifire.eq.1) read(93,*)aaa,bbb,(xmflash(m),m=1,nm)
+
+c=======================================================================
+c Climatological means of temperature (�C) and precipitation (mm/mo)
+c used to calculate Koppen's climatic zones
+c (here taken to be equal to monthly weather)
+c=======================================================================
+ if (idaily_in.eq.0) then
+ do m = 1, nm
+ tcelkop(m)=tcel_clim(m,ngt)
+ prckop(m)=prc_clim(m,ngt)
+ enddo
+ else
+ do m = 1, nm
+ tcelkop(m)=tcel0(m)
+ prckop(m)=prc0(m)
+ enddo
+ endif
+
+c=======================================================================
+c soil respiration parameters
+c=======================================================================
+
+ pssat=0.01*(0.75*cla+0.625*sil+0.500*san)
+ xm1=0.01*(-1.883*cla+0.140*sil+0.356*san)
+ cmoxm1=(0.01*(0.73*cla+0.68*sil+0.59*san))**xm1
+
+
+ return
+ end subroutine read_in
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_read_init.f b/couplage/CARAIB/ver01_Iv_couplage/mod_read_init.f
new file mode 100644
index 0000000..2fdfdf2
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_read_init.f
@@ -0,0 +1,108 @@
+c=======================================================================
+c***********************************************************************
+ subroutine read_init(iread,ngt)
+c***********************************************************************
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/acclim.common'
+ include './com_18/climkop.common'
+ include './com_18/eco.common'
+ include './com_18/inidata.common'
+ include './com_18/init.common'
+ include './com_18/lailim.common'
+ include './com_18/nspc.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer ipool
+c
+c-----------------------------------------------
+ real*4 zdn,zlong,zlat,aaa,bbb
+ integer iread,kyr,ngt,j,ip,kpool,m
+
+
+ if (iread.ge.1) then
+ read(25) kyr,zdn,zlong,zlat
+ read(25) (ywat_ini(j,ngt),j=1,nres)
+
+ if (iread.eq.1) then
+ do ipool = 1, npool
+ read(25) (ycar_ini(ip,ipool,ngt),ip=1,npft)
+ enddo
+ read(25) (yrese_ini(ip,ngt),ip=1,npft)
+ read(25) (ybinc_ini(ip,ngt),ip=1,npft)
+ else
+ do ipool = 1, npool
+ read(25) (ycar_ini(ip,ipool,ngt),ip=1,npft0)
+ enddo
+ read(25) (yrese_ini(ip,ngt),ip=1,npft0)
+ read(25) (ybinc_ini(ip,ngt),ip=1,npft0)
+ do ip = npft0+1, npft
+ do ipool = 1, npool
+ ycar_ini(ip,ipool,ngt) = 0.
+ enddo
+ yrese_ini(ip,ngt) = 0.
+ ybinc_ini(ip,ngt) = 0.
+ enddo
+ endif
+
+ read(25) (ylit_ini(kpool,ngt),kpool = 1,2)
+ read(25) yhum_ini(ngt)
+
+ if (iread.eq.1) then
+ do ip = 1, npft
+ read(125) (ylailim0(ip,m), m = 1, nm)
+ end do
+ else
+ do ip = 1, npft0
+ read(125) (ylailim0(ip,m), m = 1, nm)
+ end do
+ endif
+
+ read(225,*)aaa,bbb,(ytem_prev(ngt,j),j=1,5)
+ & ,(py_mtem(ngt,m),m=1,nm)
+
+
+c read(525) (gdd_ini(ip,ngt),ip=1,npft)
+
+c read(525) (ygppf_ini(ip,ngt),ip=1,npft)
+c read(525) (ynppf_ini(ip,ngt),ip=1,npft)
+
+ else
+ do j = 1,nres
+ ywat_ini(j,ngt) = 0.
+ end do
+ if (tcelkop(nm).lt.0.) ywat_ini(1,ngt) = 50.
+ ywat_ini(2,ngt) = fci
+
+ do ip = 1, npft
+ do ipool = 1, npool
+ ycar_ini(ip,ipool,ngt) = 0.
+ enddo
+ yrese_ini(ip,ngt) = 0.
+ ybinc_ini(ip,ngt) = 0.
+ gdd_ini(ip,ngt) = 0.
+ ygppf_ini(ip,ngt) = 0.
+ ynppf_ini(ip,ngt) = 0.
+ enddo
+ yhum_ini(ngt) = 0.
+ do kpool = 1, npool
+ ylit_ini(kpool,ngt) = 0.
+ end do
+
+ do j = 1, 5
+ ytem_prev(ngt,j) = 25.
+ end do
+
+ do m = 1, nm
+ py_mtem(ngt,m) = 25.
+ end do
+
+ endif
+
+
+
+ return
+ end subroutine read_init
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_read_lu.f b/couplage/CARAIB/ver01_Iv_couplage/mod_read_lu.f
new file mode 100644
index 0000000..b566ad4
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_read_lu.f
@@ -0,0 +1,139 @@
+c=======================================================================
+c***********************************************************************
+ subroutine read_lu(ngt,iread)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c This routine reads land use data
+c=======================================================================
+
+c implicit double precision (a-h,o-z)
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/annee.common'
+ include './com_18/coord.common'
+ include './com_18/cte.common'
+ include './com_18/griddata.common'
+ include './com_18/icyr.common'
+ include './com_18/landuse.common'
+ include './com_18/landuse0.common'
+ include './com_18/nspc.common'
+
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ real*4 a8,b8
+c
+c-----------------------------------------------
+
+ integer ngt,iread
+ real*4 frac_tot, frac_tot0
+
+c=======================================================================
+c longitude and latitude of pixel
+c=======================================================================
+
+ ylongi = xlg(ngt)
+ ylati = xlt(ngt)
+
+c=======================================================================
+c records previous year land use fractions
+c=======================================================================
+ if (nyear.ne.1) then
+ frac_nat0(ngt) = frac_nat(ngt)
+ frac_crop0(ngt) = frac_crop(ngt)
+ frac_past0(ngt) = frac_past(ngt)
+ frac_urb0(ngt) = frac_urb(ngt)
+ frac_rock0(ngt) = frac_rock(ngt)
+ frac_wat0(ngt) = frac_wat(ngt)
+ endif
+
+c=======================================================================
+c reads land use fractions (natural vegetation, crops, pastures,
+c urban, bare rocks, water)
+c=======================================================================
+ if (ilu.eq.1) then
+ read(94,*) a8,b8,frac_nat(ngt),frac_crop(ngt),frac_past(ngt)
+ & ,frac_urb(ngt),frac_rock(ngt),frac_wat(ngt)
+ else
+ frac_nat(ngt) = 1.
+ frac_crop(ngt) = 0.
+ frac_past(ngt) = 0.
+ frac_urb(ngt) = 0.
+ frac_rock(ngt) = 0.
+ frac_wat(ngt) = 0.
+ endif
+
+ frac_tot = frac_nat(ngt)+frac_crop(ngt)+frac_past(ngt)
+ & +frac_urb(ngt)+frac_rock(ngt)+frac_wat(ngt)
+
+ if (abs(frac_tot-1.).ge.2.e-3) then
+
+ if((frac_tot.lt.0.).or.(frac_tot.gt.1.)) then
+ write(61,*) 'error, incorrect input cover fractions',frac_tot,
+ & frac_nat(ngt),frac_crop(ngt),frac_past(ngt),frac_urb(ngt),
+ & frac_rock(ngt),frac_wat(ngt)
+ stop
+ endif
+
+ if(frac_tot.gt.0. .and. frac_tot.lt.1.) then
+ write(61,*) 'your input cover fractions do not cover the pixel',
+ & frac_nat(ngt),frac_crop(ngt),frac_past(ngt),frac_urb(ngt),
+ & frac_rock(ngt),frac_wat(ngt)
+
+ endif
+ endif
+
+c=======================================================================
+c initializes previous year land use fractions on first year
+c=======================================================================
+ if (nyear.eq.1) then
+ if ((ifrac_rd.ge.1).and.(icyr_landuse.ne.0)) then
+ if (ilu.eq.1) then
+ read(425,*) a8,b8,frac_nat0(ngt),frac_crop0(ngt),
+ & frac_past0(ngt),frac_urb0(ngt),frac_rock0(ngt),frac_wat0(ngt)
+
+ frac_tot0 = frac_nat0(ngt)+frac_crop0(ngt)+frac_past0(ngt)
+ & +frac_urb0(ngt)+frac_rock0(ngt)+frac_wat0(ngt)
+
+ if (abs(frac_tot0 - 1.).ge.2.e-3) then
+
+ if((frac_tot0.lt.0.).or.(frac_tot0.gt.1.)) then
+ write(61,*) 'error, incorrect input cover fractions',
+ & ' of the previous year :',
+ & frac_tot0,frac_nat0(ngt),frac_crop0(ngt),frac_past0(ngt),
+ & frac_urb0(ngt),frac_rock0(ngt),frac_wat0(ngt)
+ stop
+ endif
+
+ if(frac_tot0.gt.0. .and. frac_tot0.lt.1.) then
+ write(61,*) 'your input cover fractions of previous year',
+ & ' do not cover the pixel',
+ & frac_tot0,frac_nat0(ngt),frac_crop0(ngt),frac_past0(ngt),
+ & frac_urb0(ngt),frac_rock0(ngt),frac_wat0(ngt)
+
+ endif
+ endif
+
+ else
+ frac_nat0(ngt) = 1.
+ frac_crop0(ngt) = 0.
+ frac_past0(ngt) = 0.
+ frac_urb0(ngt) = 0.
+ frac_rock0(ngt) = 0.
+ frac_wat0(ngt) = 0.
+ endif
+ else
+ frac_nat0(ngt) = frac_nat(ngt)
+ frac_crop0(ngt) = frac_crop(ngt)
+ frac_past0(ngt) = frac_past(ngt)
+ frac_urb0(ngt) = frac_urb(ngt)
+ frac_rock0(ngt) = frac_rock(ngt)
+ frac_wat0(ngt) = frac_wat(ngt)
+ endif
+ endif
+
+ return
+ end subroutine read_lu
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_read_luspecies.f b/couplage/CARAIB/ver01_Iv_couplage/mod_read_luspecies.f
new file mode 100644
index 0000000..d7caacd
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_read_luspecies.f
@@ -0,0 +1,53 @@
+c=======================================================================
+c***********************************************************************
+ subroutine read_luspecies(ngt)
+c***********************************************************************
+c=======================================================================
+
+ implicit none
+ include './com_18/parameter.common'
+ include './com_18/cte.common'
+ include './com_18/ecoin.common'
+ include './com_18/inidata.common'
+ include './com_18/landuse.common'
+ include './com_18/nspc.common'
+ real*4 aaa,bbb,rf_crop(nplant),rf_past(nplant)
+ integer ip,ngt,i,j
+
+
+ if (ilusp_rd.eq.1) then
+
+ read(194,*)aaa,bbb,(rf_crop(i),i=1,ncrop)
+ & ,(rf_past(j),j=1,npast)
+
+ do ip = npft0+1,npft0+ncrop
+ frac(ip) = frac_crop(ngt) * rf_crop(ip-npft0)
+ end do
+
+ do ip = npft0+ncrop+1,npft
+ frac(ip) = frac_past(ngt) * rf_past(ip-npft0-ncrop)
+ end do
+
+ else
+
+ if(ncrop.gt.0) then
+ do ip = npft0+1,npft0+ncrop
+ frac(ip) = frac_crop(ngt) / ncrop
+ end do
+ endif
+
+ if(npast.gt.0) then
+ do ip = npft0+ncrop+1,npft
+ frac(ip) = frac_past(ngt) / npast
+ end do
+ endif
+
+ endif
+
+ do ip = npft0+1, npft
+ yfrac_ini(ip,ngt) = frac(ip)
+ end do
+
+
+ return
+ end subroutine read_luspecies
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_read_mig.f b/couplage/CARAIB/ver01_Iv_couplage/mod_read_mig.f
new file mode 100644
index 0000000..1876e18
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_read_mig.f
@@ -0,0 +1,157 @@
+c=======================================================================
+c***********************************************************************
+ subroutine read_mig
+c***********************************************************************
+c=======================================================================
+c implicit double precision (a-h,o-z)
+ IMPLICIT NONE
+
+ include './com_18/parameter.common'
+ include './com_18/annee.common'
+ include './com_18/coord.common'
+ include './com_18/cte.common'
+ include './com_18/disper.common'
+ include './com_18/ecoin.common'
+ include './com_18/icyr.common'
+ include './com_18/inidata.common'
+ include './com_18/input_par.common'
+ include './com_18/kernel.common'
+ include './com_18/nspc.common'
+
+ real*8 x,fx
+ real*4 aaa,bbb
+ integer ip,k,ngt_mig,ihetero
+
+ do ngt_mig = 1, n_pix
+
+ if(icyr_mig.eq.1) then
+
+ read(95,*)aaa,bbb,mig_rate(2,ngt_mig),mig_rate(6,ngt_mig),
+ & mig_rate(8,ngt_mig)
+ else
+ read(95,*)aaa,bbb,ihetero
+ if(isp.eq.6) then
+ if(ihetero.eq.1) mig_rate(6,ngt_mig) = 381.106
+ if(ihetero.eq.3) mig_rate(6,ngt_mig) = 362.802
+ if(ihetero.eq.5) mig_rate(6,ngt_mig) = 353.635
+ endif
+ if(isp.eq.8) then
+ if(ihetero.eq.1) mig_rate(8,ngt_mig) = 450.118
+ if(ihetero.eq.3) mig_rate(8,ngt_mig) = 441.491
+ if(ihetero.eq.5) mig_rate(8,ngt_mig) = 436.541
+ endif
+ endif
+
+c Xmax = 45.*mig_rate(8,ngt_mig) !Xmax = 68.10
+c Xmin(ngt_mig) = 0.
+
+ do ip = 1, npft0
+
+ if(ip.eq.isp) then
+
+c if(yfrac_ini(ip,ngt_mig).ge.1.e-5) then
+ if(
+ & (isteady.eq.1.and.yfrac_ini(ip,ngt_mig).ge.1.e-5.and.nyear.eq.2)
+ & .or.
+ & (isteady.eq.0.and.yfrac_ini(ip,ngt_mig).ge.1.e-5.and.nyear.eq.1)
+ & .or.
+ & (isteady.eq.1.and.yfrac_ini(ip,ngt_mig).ge.1.e-7.and.nyear.gt.2)
+ & .or.
+ & (isteady.eq.0.and.yfrac_ini(ip,ngt_mig).ge.1.e-7
+ & .and.nyear.gt.1)) then
+
+ pres(ip,ngt_mig) = 1
+ if((isteady.eq.1.and.nyear.eq.2).or.
+ & (isteady.eq.0.and.nyear.eq.1)) then
+ do k = 1, n_nghmx
+ pres_side(ip,k,ngt_mig) = 1
+ prop(ip,k,ngt_mig) = 90000.
+ count(ip,k,ngt_mig) = 0 ! MARIE
+ prop_time(ip,k,ngt_mig) = 0
+ enddo
+ seed_persistence(ngt_mig) = 0
+ endif
+ else
+ if(nyear.eq.1) then
+ pres(ip,ngt_mig) = 0
+ do k = 1, n_nghmx
+ pres_side(ip,k,ngt_mig) = 0
+ prop(ip,k,ngt_mig) = 0.
+ count(ip,k,ngt_mig) = 0 ! MARIE
+ prop_time(ip,k,ngt_mig) = 0
+ enddo
+ seed_persistence(ngt_mig) = 0
+ else
+ if(pres(ip,ngt_mig).eq.1) then ! MARIE
+ seed_persistence(ngt_mig) = seed_persistence(ngt_mig) + 1
+ if(seed_persistence(ngt_mig).le.3) then
+ pres(ip,ngt_mig) = 1
+ else
+ pres(ip,ngt_mig) = 0
+ do k = 1, n_nghmx
+ pres_side(ip,k,ngt_mig) = 0
+ prop(ip,k,ngt_mig) = 0.
+ count(ip,k,ngt_mig) = 0 ! MARIE
+ prop_time(ip,k,ngt_mig) = 0
+ enddo
+ seed_persistence(ngt_mig) = 0
+ endif
+ else
+ pres(ip,ngt_mig) = 0
+ do k = 1, n_nghmx
+ pres_side(ip,k,ngt_mig) = 0
+ prop(ip,k,ngt_mig) = 0.
+ count(ip,k,ngt_mig) = 0 ! MARIE
+ prop_time(ip,k,ngt_mig) = 0
+ enddo
+ endif
+ endif
+ endif
+
+ pres_new(ip,ngt_mig) = 0
+
+ do k = 1, n_nghmx
+ preside_new(ip,k,ngt_mig) = 0
+ enddo
+
+ else
+
+ if(
+ & (isteady.eq.1.and.yfrac_ini(ip,ngt_mig).ge.1.e-5.and.nyear.eq.2)
+ & .or.
+ & (isteady.eq.0.and.yfrac_ini(ip,ngt_mig).ge.1.e-5.and.nyear.eq.1)
+ & .or.
+ & (isteady.eq.1.and.yfrac_ini(ip,ngt_mig).ge.1.e-7.and.nyear.gt.2)
+ & .or.
+ & (isteady.eq.0.and.yfrac_ini(ip,ngt_mig).ge.1.e-7
+ & .and.nyear.gt.1)) then
+
+ pres(ip,ngt_mig) = 1
+ pres_new(ip,ngt_mig) = 1
+
+ else
+ pres(ip,ngt_mig) = 0
+ pres_new(ip,ngt_mig) = 0
+ endif
+
+ endif
+
+ enddo
+
+ if(nyear.eq.1.and.imig_rd.eq.1) then
+
+ read(176,*)aaa,bbb,(prop(isp,k,ngt_mig),k=1,n_nghmx),
+ & (prop_time(isp,k,ngt_mig),k=1,n_nghmx)
+ do k = 1, n_nghmx
+ count(isp,k,ngt_mig) = prop_time(isp,k,ngt_mig)
+ enddo
+
+ read(177,*)aaa,bbb,(pres_side(isp,k,ngt_mig),k=1,n_nghmx)
+ read(178,*)(pres(ip,ngt_mig),ip=1,npft0)
+
+ endif
+
+ enddo
+
+ return
+ end subroutine read_mig
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_record_grid.f b/couplage/CARAIB/ver01_Iv_couplage/mod_record_grid.f
new file mode 100644
index 0000000..6b9c691
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_record_grid.f
@@ -0,0 +1,72 @@
+c=======================================================================
+c***********************************************************************
+ subroutine record_grid(y,ngt)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c This routine records soil water, biomass, soil carbon and leaf area
+c index in vectors for initialisation at the beginning of the next
+c year
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/acclim.common'
+ include './com_18/annee.common'
+ include './com_18/cmoiRmin.common'
+ include './com_18/climin0.common'
+ include './com_18/climin.common'
+ include './com_18/cte.common'
+ include './com_18/ecoin.common'
+ include './com_18/inidata.common'
+ include './com_18/nspc.common'
+ include './com_18/plant_pool.common'
+ include './com_18/prev_yr.common'
+ include './com_18/soil_pool.common'
+ include './com_18/frac_change.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer ip,ipool,kpool,ngt
+c
+c-----------------------------------------------
+ double precision y
+ dimension y(nequat)
+ integer j,m
+
+c=======================================================================
+c records values of water and carbon pools.
+c=======================================================================
+ do j = 1, nres
+ ywat_ini(j,ngt) = y(j)
+ end do
+
+ do ip = 1, npft
+
+ do ipool = 1, npool
+ ycar_ini(ip,ipool,ngt) = carbon(ip,ipool,nd)
+ enddo
+ yrese_ini(ip,ngt) = rese(ip)
+ ybinc_ini(ip,ngt) = ybinc(ip)
+ if((imig.eq.0).or.(imig.eq.1.and.nyr_t.eq.0)) then ! marie
+ yfrac_ini(ip,ngt) = frac(ip)
+ endif
+ if(ip.le.npft0) ylaimin_ini(ip,ngt) = xlai_min(ip)
+ if(ip.le.npft0) ylaimax_ini(ip,ngt) = xlai_max(ip)
+ enddo
+ do kpool = 1, 2
+ ylit_ini(kpool,ngt) = xlit(kpool,nd)
+ end do
+ yhum_ini(ngt) = xhumus(nd)
+
+c=======================================================================
+c records monthly temperatures for next year acclimation
+c=======================================================================
+
+ do m = 1, nm
+ py_mtem(ngt,m)= tcel0(m)
+ end do
+
+ return
+ end subroutine record_grid
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_solar.f b/couplage/CARAIB/ver01_Iv_couplage/mod_solar.f
new file mode 100644
index 0000000..783358b
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_solar.f
@@ -0,0 +1,132 @@
+c=======================================================================
+c***********************************************************************
+ subroutine solar
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c calculates the solar irradiance at the earth surface
+c
+c inputs: idn = day number (dimensionless);
+c ylati = latitude of the grid point studied (degrees)
+c shi = relative sunshine hours (dimensionless);
+c nh = number of hours in one day.
+c
+c outputs: solday = hourly value of the surface solar irradiance
+c for the grid point studied (w m-2);
+c ftrday = hourly value of the atmospheric transmit-
+c tance for the grid point studied
+c (dimensionless);
+c xmuday = cosine of the solar zenithal angle , one
+c value at each hour (dimensionless) + mean
+c values (ih =0.).
+c=======================================================================
+
+C -- JLP implicit double precision (a-h,o-z)
+ IMPLICIT NONE
+
+ include './com_18/parameter.common'
+ include './com_18/climin.common'
+ include './com_18/coord.common'
+ include './com_18/cstpi.common'
+ include './com_18/cte.common'
+ include './com_18/solpar.common'
+ include './com_18/varday.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer i,idn
+ real*8 cdel,ch0,cte,cxlt,cz,cz0,dn,h,h0,heure,qfac,rm,sdel,slg
+ & ,sth,sxlt,th,theta,xls
+c
+c-----------------------------------------------
+
+ qfac = float(nh) / 24.
+
+ do idn = 1,nd
+
+ dn = float(idn-1)
+
+c=======================================================================
+c calculates necessary angles:
+c sdel = sinus of solar declination;
+c h0 = solar hour angle at sunset
+c=======================================================================
+
+ slg = pi365 * (dn - 79.092)
+ if(slg .lt. 0.) slg = 2. * pi + slg
+ th = slg - xlsper
+ sth = dsin(th)
+ xls = slg + 2.*sth*exc + 2.5*sth*dcos(th)*exc*exc
+ & + (3.*sth - 13.*sth*sth*sth/3.) * exc * exc * exc
+ theta = xls - xlsper
+ rm = (1. - exc*exc) / (1. + exc*dcos(theta))
+ sdel = sin(obl) * sin(xls)
+ cdel = dsqrt(1.-sdel*sdel)
+ cte = sunea / (rm * rm)
+
+ sxlt = sin(ylati * pi / 180.)
+ cxlt = cos(ylati * pi / 180.)
+ if(cxlt .le. 1.d-20) cxlt = 1.d-20
+
+ ch0 = -sxlt * sdel / (cxlt * cdel)
+ if(ch0 .ge. 1.) then
+ h0 = 0.
+ else
+ if(ch0 .le. -1) then
+ h0 = pi
+ else
+ h0 = acos(ch0)
+ endif
+ endif
+
+c=======================================================================
+c calculates the mean cosine of the solar zenith angle.
+c=======================================================================
+
+ cz0 = (h0 * sxlt * sdel + cxlt * cdel * dsin(h0)) / pi
+ xmuday(idn,0) = 0.
+ if(h0 .ne. 0.) then
+ xmuday(idn,0) = cz0 * pi / h0
+ endif
+
+ if (isol.eq.1) then
+ if (h0 .ne. 0) then
+ sunhour(idn)=(fsol(idn)/(cte*cz0)-ftrmin)/(ftrmax-ftrmin)
+ if (sunhour(idn).le.0.) sunhour(idn)=0.
+ if (sunhour(idn).ge.1.) sunhour(idn)=1.
+ else
+ sunhour(idn)=0.5
+ endif
+ endif
+
+ ftrday(idn,0) = ftrmin + (ftrmax-ftrmin) * sunhour(idn)
+ solday(idn,0) = cte*cz0*ftrday(idn,0)
+
+
+
+c=======================================================================
+c loops over the hours
+c=======================================================================
+
+ do i = 1, nh2
+
+ heure = (float(i) - 0.5) / qfac
+ h = pi * (heure - 12.)/12.
+
+ cz = sxlt*sdel+cxlt*cdel*dcos(h)
+ ftrday(idn,i) = ftrmin + (ftrmax-ftrmin) * sunhour(idn)
+
+ if(dabs(h) .ge. h0) then
+ xmuday(idn,i) = 0.
+ solday(idn,i) = 0.
+ else
+ xmuday(idn,i) = cz
+ solday(idn,i) = cte*cz*ftrday(idn,i)
+ endif
+
+ enddo
+ enddo
+
+ return
+ end subroutine solar
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_utils.f b/couplage/CARAIB/ver01_Iv_couplage/mod_utils.f
new file mode 100644
index 0000000..4e4ed86
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_utils.f
@@ -0,0 +1,104 @@
+c=======================================================================
+c***********************************************************************
+ subroutine itochar2(i,ch)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c Subroutine to convert an integer into a character
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ real r
+ integer i,k
+ character*2 ch
+ r=i/10.0
+ k=r
+ ch=char(k+48)//char(i-10*k+48)
+
+ return
+ end subroutine itochar2
+
+
+c=======================================================================
+c***********************************************************************
+ subroutine givnletters(z,nlet)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c Subroutine for counting the number of letters in a character*8
+c variable
+c=======================================================================
+ implicit none
+ include './com_18/parameter.common'
+ integer nlet
+ character*8 z,zzone
+
+ zzone=z
+ nlet=1
+52 continue
+ if (zzone(nlet:nlet).ne.' ') then
+ nlet=nlet+1
+ if (nlet.le.8) goto 52
+ endif
+ nlet=nlet-1
+
+ return
+ end subroutine givnletters
+
+
+c=======================================================================
+c***********************************************************************
+ subroutine charlen(name,kn)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c Subroutine for counting the number of letters in a character*80
+c variable
+c=======================================================================
+ implicit none
+ integer kn
+ character*120 name
+ kn = 0
+ 1 continue
+ kn = kn + 1
+ if(name(kn:kn) .ne. ' ') goto 1
+ kn = kn - 1
+ return
+ end subroutine charlen
+
+
+c=======================================================================
+c***********************************************************************
+ subroutine distance(xlg1,xlt1,xlg2,xlt2,distan)
+c***********************************************************************
+c=======================================================================
+
+ implicit none
+ include './com_18/parameter.common'
+ include './com_18/solpar.common'
+ include './com_18/cstpi.common'
+ double precision xlg1,xlt1,xlg2,xlt2,distan
+ double precision c1,c2,s1,s2,cdlg,argum
+c
+c xlg1,xlt1 = long, lat of first point (deg)
+c xlg2,xlt2 = long, lat of second point (deg)
+c rearth = Earth radius (km) - in solpar.common
+c distan = distance (km)
+
+c pi180 = 3.1415926535/180. - in common cstpi
+ c1 = dcos(xlt1*pi180)
+ c2 = dcos(xlt2*pi180)
+ s1 = dsin(xlt1*pi180)
+ s2 = dsin(xlt2*pi180)
+ cdlg = dcos((xlg2-xlg1)*pi180)
+ argum = s1*s2+c1*c2*cdlg
+ if (argum.le.-0.9999999999999d+0) argum = -0.9999999999999d+0
+ if (argum.ge. 0.9999999999999d+0) argum = 0.9999999999999d+0
+ distan = rearth*dacos(argum)
+
+ return
+ end subroutine distance
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_veg_phases.f b/couplage/CARAIB/ver01_Iv_couplage/mod_veg_phases.f
new file mode 100644
index 0000000..2812345
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_veg_phases.f
@@ -0,0 +1,171 @@
+c=======================================================================
+c***********************************************************************
+ subroutine veg_phases(ngt)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c This routine determines crop growing phases
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/burned.common'
+ include './com_18/climin0.common'
+ include './com_18/climin.common'
+ include './com_18/coord.common'
+ include './com_18/cte.common'
+ include './com_18/crops.common'
+ include './com_18/eco.common'
+ include './com_18/gddpix.common'
+ include './com_18/gene.common'
+ include './com_18/inidata.common'
+ include './com_18/init.common'
+ include './com_18/iprt.common'
+ include './com_18/monthcst.common'
+ include './com_18/nspc.common'
+ include './com_18/plant_pool.common'
+ include './com_18/prt_ctrl.common'
+ include './com_18/pzone.common'
+ include './com_18/snow.common'
+ include './com_18/temper.common'
+ include './com_18/tresh.common'
+
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer iday,iday1,iday2,ip,ngt
+c
+c-----------------------------------------------
+
+ integer iday_sow,lim,gr_length,i,ivar,igerm,isow
+ real*4 aaa,bbb,gdd_seas,wat_germ
+
+c=======================================================================
+c read crop cultivars
+c=======================================================================
+
+ if (icvar_rd.eq.1) then
+ do i = 1, npft
+ icvar(i) = 0
+ end do
+ read(295,*)aaa,bbb,(icvar(i),i=npft0+1,npft0+ncrop)
+ endif
+
+c=======================================================================
+c growing phases for crops:
+c 0 = dormancy
+c 1 = growing season
+c 2 = harvesting
+c=======================================================================
+c specific for natural vegetation
+c
+c do ip = 1, npft0
+c do iday = 1, nd
+c iday2=iday-1
+c iphase(ip,iday) = 1
+c if(iday.eq.1) then
+c iday2 = nd
+c iphase(ip,iday2) = 1
+c endif
+c enddo
+c enddo
+
+cc specific for crops and pastures
+ do ip = 1, npft
+cc do ip = npft0+1, npft
+
+c iday_sow = int(sow_date(ip))
+c if (iday_sow.ge. 0) then
+
+
+cc Correction for crops only
+ if ((ip .ge.(npft0+1)) .and. (ip .le. (npft0+ncrop))) then
+c ivar = icvar(ip)
+ maturity(ip) = -999
+ wat_germ = wattresh2(ip) + 0.1*wattresh2(ip)
+ gdd_seas = gdd_ini(ip,ngt)
+ iday_sow = int(sow_date(ip))
+
+
+ isow = 0
+ igerm = 0
+ if(gdd_ini(ip,ngt).gt.0.) isow = 1
+ do iday = 1, nd
+ iday2=iday-1
+ iphase(ip,iday) = 1
+ if(iday.eq.1) then
+ iday2 = nd
+ if(carbon(ip,2,iday2).gt.0.) igerm = 1
+ iphase(ip,iday2) = 1
+ endif
+ if(iday.eq.iday_sow) then
+ isow = 1
+ gdd_seas = 0.
+ iday_germ(ip,ngt) = -999
+ igerm = 0
+ endif
+ if(isow.eq.1) then
+ if(tcel(iday).gt.tbase(ip)) then
+ gdd_seas = gdd_seas + (tcel(iday) - tbase(ip))
+ endif
+ if(gdd_seas .lt. gdd_germ(ip)) iphase(ip,iday) = 0
+ if(igerm.eq.0.and.gdd_seas.ge.gdd_germ(ip)) then
+ if(water(iday).lt.wat_germ) then
+ iphase(ip,iday) = 0
+ else
+ igerm = 1
+ iday_germ(ip,ngt) = iday
+ gdd_seas = gdd_germ(ip)
+ endif
+ endif
+ if(iday_germ(ip,ngt).gt.iday) then
+c gr_length = nd - iday_germ(ip,ngt) + iday
+ gr_length = nd - iday_sow + iday
+ else
+c gr_length = iday - iday_germ(ip,ngt)
+ gr_length = iday - iday_sow
+ if(iday_germ(ip,ngt).le.0) gr_length = 0
+ endif
+ if(gr_length.gt.gr_seas(ip)) then
+ iphase(ip,iday) = 0
+ gdd_seas = 0.
+ isow = 0
+ igerm = 0
+ endif
+
+ if(gdd_seas .gt. gdd_harv(ip) .and.
+ & gr_length .le. gr_seas(ip) .and. igerm .eq. 1) then
+ iphase(ip,iday) = 2
+ gdd_seas = 0.
+ isow = 0
+ igerm = 0
+ endif
+ if(iphase(ip,iday2).eq.1.and.iphase(ip,iday).eq.2) then
+ maturity(ip)=iday
+ endif
+ else
+ iphase(ip,iday) = 0
+ gdd_seas = 0.
+ iday_germ(ip,ngt) = -999
+ endif
+ if(iday.eq.nd) then
+ gdd_ini(ip,ngt) = gdd_seas
+ endif
+ enddo
+
+ else
+ do iday = 1, nd
+ iday2=iday-1
+ iphase(ip,iday) = 1
+ if(iday.eq.1) then
+ iday2 = nd
+ iphase(ip,iday2) = 1
+ endif
+ enddo
+
+ endif
+ enddo
+
+ return
+ end subroutine veg_phases
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_wri_1st.f b/couplage/CARAIB/ver01_Iv_couplage/mod_wri_1st.f
new file mode 100644
index 0000000..4e6b815
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_wri_1st.f
@@ -0,0 +1,58 @@
+c=======================================================================
+c***********************************************************************
+ subroutine wri_1st(y,nyear,ngt)
+c***********************************************************************
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/acclim.common'
+ include './com_18/climkop.common'
+ include './com_18/eco.common'
+ include './com_18/griddata.common'
+ include './com_18/inidata.common'
+ include './com_18/init.common'
+ include './com_18/lailim.common'
+ include './com_18/nspc.common'
+ include './com_18/plant_pool.common'
+ include './com_18/prt_ctrl.common'
+ include './com_18/soil_pool.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer ip,ipool,kpool
+ real*4 dn
+c
+c-----------------------------------------------
+
+ double precision y
+ dimension y(nequat)
+ integer nyear,ngt,j,m
+
+CDC rewind (26)
+c if(iyprt.ge.1) then
+ dn=float(nd)
+ write(26) nyear,dn,xlg(ngt),xlt(ngt)
+ write(26) (sngl(y(j)),j=1,nres)
+ do ipool = 1, npool
+ write(26) (carbon(ip,ipool,nd),ip=1,npft)
+ enddo
+ write(26) (rese(ip),ip=1,npft)
+ write(26) (ybinc(ip),ip=1,npft)
+ write(26) (xlit(kpool,nd),kpool = 1, 2)
+ write(26) xhumus(nd)
+
+ do ip = 1, npft
+ write(126) (ylailim0(ip,m), m = 1, nm)
+ end do
+
+ write(226,'(2(1x,f9.4),17(1x,f6.2))')xlg(ngt),xlt(ngt),
+ & (ytem_prev(ngt,j),j=1,5),(py_mtem(ngt,m),m=1,nm)
+
+ write(526) (gdd_ini(ip,ngt),ip=1,npft)
+ write(526) (ygppf_ini(ip,ngt),ip=1,npft)
+ write(526) (ynppf_ini(ip,ngt),ip=1,npft)
+c endif
+
+ return
+ end subroutine wri_1st
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_write_luc.f b/couplage/CARAIB/ver01_Iv_couplage/mod_write_luc.f
new file mode 100644
index 0000000..01aed60
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_write_luc.f
@@ -0,0 +1,52 @@
+c=======================================================================
+c***********************************************************************
+ subroutine write_luc(ngt)
+c***********************************************************************
+c=======================================================================
+
+c=======================================================================
+c This routine prints carbon emission and litter production fluxes
+c from land use change
+c=======================================================================
+
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/coord.common'
+ include './com_18/cte.common'
+ include './com_18/ecoin.common'
+ include './com_18/icyr.common'
+ include './com_18/inidata.common'
+ include './com_18/landuse.common'
+ include './com_18/landuse0.common'
+ include './com_18/luc.common'
+ include './com_18/lucflx.common'
+ include './com_18/iprt.common'
+ include './com_18/nspc.common'
+ include './com_18/plant_pool.common'
+ include './com_18/plant_evol.common'
+ include './com_18/soil_pool.common'
+
+ integer ip,ipool,ngt
+ real*4 tyemi_luc,txlit_luc
+ character*100 formatw
+
+ write(formatw,*)'(f8.3,1x,f8.3,6(1x,f8.5))'
+ if(iprt_lucdfr.eq.1)write(251,formatw)ylongi,ylati,dfr_nat
+ & ,dfr_crop,dfr_past,dfr_urb,dfr_rock,dfr_wat
+
+ tyemi_luc = 0.
+ txlit_luc = 0.
+ do ip = 1, npft
+ do ipool = 1, npool
+ tyemi_luc = tyemi_luc + yemi_luc(ip,ipool)
+ txlit_luc = txlit_luc + xlit_luc(ip,ipool)
+ end do
+ end do
+
+ write(formatw,*)'(f8.3,1x,f8.3,2(1x,f10.3))'
+ if (iprt_lucflx.eq.1) write(252,formatw)ylongi,ylati,tyemi_luc
+ & ,txlit_luc
+
+ return
+ end subroutine write_luc
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_zone2.f b/couplage/CARAIB/ver01_Iv_couplage/mod_zone2.f
new file mode 100644
index 0000000..42c0087
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_zone2.f
@@ -0,0 +1,134 @@
+c=======================================================================
+c***********************************************************************
+ subroutine zone2(reg,region)
+c***********************************************************************
+c=======================================================================
+c Determines region from reg
+c reg is a climate zone (A, B, C, D. E)
+c region is a geographical area (A1, A2, A3, A4,
+c B1, B2, B3, B4, B5, B6,
+c C1, C2, C3, C4, C5, C6,
+c D1, D2, D3,
+c E1, E2, E3, E4)
+c ======================================================================
+ implicit none
+ include './com_18/parameter.common'
+ include './com_18/coord.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ real*4 a,b,x,y
+c
+c-----------------------------------------------
+ character*1 reg
+ character*2 region
+
+ x = ylongi
+ y = ylati
+ if(reg .eq. 'A') then
+ if(x .lt. -30.) then
+ region = 'A1'
+ elseif(x .lt. 60.) then
+ region = 'A2'
+ elseif(y .gt. -10.5) then
+ region = 'A3'
+ else
+ region = 'A4'
+ endif
+ return
+ endif
+
+ if(reg .eq. 'B') then
+ if(y .lt. -3.7) then
+ if(x .lt. -30.) then
+ region = 'B4'
+ elseif(x .lt. 60.) then
+ region = 'B5'
+ else
+ region = 'B6'
+ endif
+ elseif(x .lt. -30.) then
+ region = 'B1'
+ elseif(y .lt. 22.5) then
+ if(x .lt. 60.) then
+ region = 'B2'
+ else
+ region = 'B3'
+ endif
+ elseif(y .lt. 28.5) then
+ if(x .le. 51.) then
+ region = 'B2'
+ else
+ a = (28.5 - 22.5)/(51. - 60.)
+ b = 28.5 - 51.*a
+ if(y .lt. (a*x+b)) then
+ region = 'B2'
+ else
+ region = 'B3'
+ endif
+ endif
+ else
+ if(x .le. 25.) then
+ region = 'B2'
+ else
+ a = (90. - 28.5)/(25. - 51.)
+ b = 90. - 25.*a
+ if(y .lt. (a*x+b)) then
+ region = 'B2'
+ else
+ region = 'B3'
+ endif
+ endif
+ endif
+ return
+ endif
+
+ if(reg .eq. 'C') then
+ if(x .lt. -30.) then
+ if(y .gt. 12.) then
+ region = 'C1'
+ else
+ region = 'C4'
+ endif
+ elseif(x .lt. 60.) then
+ if(y .gt. 18.) then
+ region = 'C2'
+ else
+ region = 'C5'
+ endif
+ elseif(y .gt. 0.) then
+ region = 'C3'
+ else
+ region = 'C6'
+ endif
+ return
+ endif
+
+ if(reg .eq. 'D') then
+ if(x .lt. -30.) then
+ region = 'D1'
+ elseif(x .lt. 60.) then
+ region = 'D2'
+ else
+ region = 'D3'
+ endif
+ return
+ endif
+
+ if(reg .eq. 'E') then
+ if(x .lt. 0.) then
+ if(y .gt. 0.) then
+ region = 'E1'
+ else
+ region = 'E4'
+ endif
+ elseif(x .lt. 50.) then
+ region = 'E2'
+ else
+ region = 'E3'
+ endif
+ return
+ endif
+
+
+ end subroutine zone2
\ No newline at end of file
diff --git a/couplage/CARAIB/ver01_Iv_couplage/mod_zonepxl2.f b/couplage/CARAIB/ver01_Iv_couplage/mod_zonepxl2.f
new file mode 100644
index 0000000..a363659
--- /dev/null
+++ b/couplage/CARAIB/ver01_Iv_couplage/mod_zonepxl2.f
@@ -0,0 +1,124 @@
+c=======================================================================
+c***********************************************************************
+ subroutine zonepxl2(iprint)
+c***********************************************************************
+c=======================================================================
+c Determines the geoclimatic zone corresponding to the studied region
+c (or grid element in the case of gridded data). This subroutine should
+c be called for each region or grid element studied with climatological
+c means of the regions as inputs
+c
+c INPUTS: (1) User must supply avererage climatology of the region,
+c common block /climkop/ must be filled prior to the call:
+c - tcelkop(nm): 12 monthly climatological means of
+c temperature in °C
+c - prckop(nm): 12 monthly climatological means of
+c precipitation in mm/mo
+c (2) subroutine "ctgen" must be called prior to the call to
+c "zonepxl2" to set a series of constants, including the
+c names of the 176 geoclimatic zones (vector listzone)
+c (3) iprint= 1 or 0 to print or not the number and name of
+c of the Koppen climatic zone in unit 22 (to be opened by the
+c user before the call to "zonepxl2")
+c (4) longitude and latitude of the studied pixel must be set
+c in ylongi and ylati
+c
+c OUTPUTS: The output of "zonepxl2" is returned in common /pzone/:
+c - izonepxl: geoclimatic zone number (1-176) of the
+c studied region.
+c The local variable "zon" contains the name of the
+c geoclimatic zone.
+c The same information can also be obtained as the component
+c "izonepxl" of vector listezone:
+c - listezone(izonepxl): name of the geoclimatic zone
+c We refer to Hubert et al. (1998) for the full classification
+c of climatic zones. It is based on the following Koppen's
+c climatic zones with additional geographic subdivision.
+c-----------------------------------------------------------------------
+c A : Tropical Climates
+c Af : Tropical Rainy Climate
+c Am : Tropical Wet Climate
+c Aw : Dry Monsoon Climate
+c As : Dry Monsoon Climate
+c B : Dry Climates
+c Bw : Desert Climate
+c Bs : Steppes Climate
+c C : Mid-Latitude Rainy Climate
+c Cs : with dry summer
+c Cw : with dry winter
+c Cf : precipitation in all seasons
+c D : Continental Climate
+c (Ds : with dry summer)
+c Dw : with dry winter
+c Df : precipitation in all seasons
+c E : Polar Climates
+c ET : Tundra climate
+c EF : Snow climate
+c=======================================================================
+ implicit none
+
+ include './com_18/parameter.common'
+ include './com_18/climkop.common'
+ include './com_18/coord.common'
+ include './com_18/iprt.common'
+ include './com_18/lstz.common'
+ include './com_18/lstcli.common'
+ include './com_18/lstreg.common'
+ include './com_18/pzone.common'
+c-----------------------------------------------
+c JLP ajout� pour implicit none
+c
+ integer i,iprint,izone,m
+ real*4 p12,p6
+c
+c-----------------------------------------------
+
+ character*1 regpxl
+ character*2 zonepixl
+ character*3 climpxl
+ character*8 zon
+
+ call koppen2(climpxl)
+
+ do i = 1, 34
+ if(climpxl .eq. climatslst(i)) regpxl=reg(i)
+ enddo
+
+ call zone2(regpxl,zonepixl)
+
+ if(zonepixl .eq. 'B2' .or.
+ & zonepixl .eq. 'B3' .or.
+ & zonepixl .eq. 'C3' )then
+c All these grid elements belong to the northern hemisphere.
+
+ p12 = 0.
+ p6 = 0.
+ do m = 1, nm
+ p12 = p12 + prckop(m)
+ enddo
+ do m = 4, 9
+ p6 = p6 + prckop(m)
+ enddo
+ if(p6 .ge. 0.5*p12)then
+ zon = zonepixl//climpxl//'prh'
+ else
+ zon = zonepixl//climpxl//'prs'
+ endif
+ else
+ zon = zonepixl//climpxl
+ endif
+
+ izonepxl=200
+ do izone = 1, nzone
+ if(zon .eq. listezone(izone)) then
+ izonepxl = izone
+ if(iprint.eq.1)write(22,250)ylongi,ylati
+ & ,izonepxl,zon
+ return
+ endif
+ enddo
+
+250 format(2(1x,f8.3),1x,i3,1x,a8)
+
+ return
+ end subroutine zonepxl2
\ No newline at end of file
--
GitLab