!! This module computes continental processes SECHIBA !! !! See also this graph

!! !! @author Marie-Alice Foujols and Jan Polcher !! @Version : $Revision$, $Date$ !! !< $HeadURL$ !< $Date$ !< $Author$ !< $Revision$ !! IPSL (2006) !! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC !! MODULE sechiba ! routines called : diffuco_main, enerbil_main, hydrolc_main, enrbil_fusion, condveg_main, thermosoil_main ! USE ioipsl ! ! modules used : USE constantes USE constantes_veg USE constantes_co2 USE diffuco USE condveg USE enerbil USE hydrol USE hydrolc USE thermosoil USE sechiba_io USE slowproc USE routing ! USE write_field_p, only : WriteFieldI_p IMPLICIT NONE ! public routines : ! sechiba_main ! sechiba_clear PRIVATE PUBLIC sechiba_main,sechiba_clear ! Index arrays we need internaly INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexveg !! indexing array for the 3D fields of vegetation INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexnobio !! indexing array for the 3D fields of other surfaces (ice, lakes, ...) INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexsoil !! indexing array for the 3D fields of soil types INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexgrnd !! indexing array for the 3D ground heat profiles INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexlayer !! indexing array for the 3D fields of soil layers INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexalb !! indexing array for the 2 fields of albedo ! three dimensions array allocated, computed, saved and got in sechiba module REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:):: assim_param !! min+max+opt temps, vcmax, vjmax for photosynthesis ! two dimensions array allocated, computed, saved and got in sechiba module REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: veget !! Fraction of vegetation type REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: veget_max !! Max. fraction of vegetation type (LAI -> infty) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: height !! Vegetation Height (m) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: lai !! Surface foliere REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: gpp !! STOMATE: GPP. gC/m**2 of total area REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: humrel !! Relative humidity REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: vegstress !! Vegetation moisture stress (only for vegetation growth) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: soiltype !! Map of soil types, created in slowproc in the !! order : silt, sand and clay. ! ! one dimension array allocated, computed and used in sechiba module and passed to other ! modules called REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: vbeta1 !! Snow resistance REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: vbeta4 !! Bare soil resistance REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: soilcap !! Soil calorific capacity REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: soilflx !! Soil flux REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: temp_sol !! Soil temperature REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: qsurf !! near soil air moisture REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: snow !! Snow mass [Kg/m^2] REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: snow_age !! Snow age REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: drysoil_frac !! Fraction of visibly (albedo) Dry soil (Between 0 and 1) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: rsol !! resistance to bare soil evaporation REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: evap_bare_lim !! Bare soil stress REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: evapot !! Soil Potential Evaporation REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: evapot_corr !! Soil Potential Evaporation Correction (Milly 1992) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: vevapsno !! Snow evaporation REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: vevapnu !! Bare soil evaporation REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: t2mdiag !! 2 meter temperature REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tot_melt !! Total melt REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: vbeta !! Resistance coefficient REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: valpha !! Resistance coefficient REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: fusion !! REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: rau !! Density REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: deadleaf_cover !! Fraction of soil covered by dead leaves REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: co2_flux !! CO2 flux (gC/m**2 of average ground/s) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: totfrac_nobio !! Total fraction of continental ice+lakes+cities+... REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: runoff !! Surface runoff generated by hydrol REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: drainage !! Deep drainage generated by hydrol REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: returnflow !! Routed water which returns into the soil REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: irrigation !! irrigation going back into the soils REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: emis !! Surface emissivity REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: z0 !! Surface roughness REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: roughheight !! Effective height for roughness ! ! Arrays which are diagnostics from the physical processes for ! for the biological processes. They are not saved in the restart file because at the first time step, ! they are recalculated. However, they must be saved in memory as they are in slowproc which is called ! before the modules which calculate them. ! REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: shumdiag !! Relative soil moisture REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: litterhumdiag!! litter humidity REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: stempdiag !! Temperature which controls canopy evolution ! two dimensions array allocated, computed and used in sechiba module and passed to other ! modules called REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: qsintveg !! Water on vegetation due to interception REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: vbeta2 !! Interception resistance REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: vbeta3 !! Vegetation resistance REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: vbetaco2 !! STOMATE: Vegetation resistance to CO2 REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: cimean !! STOMATE: Mean ci REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: vevapwet !! Interception REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: transpir !! Transpiration REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: qsintmax !! Maximum water on vegetation for interception REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: rveget !! Vegetation resistance REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: snow_nobio !! Water balance over other surface types (that is snow !) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: snow_nobio_age !! Snow age on other surface types REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: frac_nobio !! Fraction of continental ice, lakes, ... REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: albedo !! Surface albedo for visible and NIR ! ! variables used inside sechiba module : declaration and initialisation ! LOGICAL, SAVE :: l_first_sechiba = .TRUE.!! Initialisation has to be done one time CHARACTER(LEN=80) , SAVE :: var_name !! To store variables names for I/O LOGICAL, SAVE :: river_routing !! Flag that decides if we route. LOGICAL, SAVE :: hydrol_cwrr !! Selects the CWRR hydrology. LOGICAL, SAVE :: myfalse=.FALSE. LOGICAL, SAVE :: mytrue=.TRUE. CONTAINS !! Main routine for *sechiba* module. !! !! Should be called two times: !! - first time to have initial values !! - second time to have complete algorithm !! !! Algorithm: !! 3 series of called SECHIBA processes !! - initialisation (first time only) !! - time step evolution (every time step) !! - prepares output and storage of restart arrays (last time only) !! !! One serie consists of: !! - call sechiba_var_init to do some initialisation !! - call slowproc_main to do some daily initialisation !! - call diffuco_main for diffusion coefficient calculation !! - call enerbil_main for energy bilan calculation !! - call hydrolc_main for hydrologic processes calculation !! - call enerbil_fusion : last part with fusion !! - call condveg_main for surface conditions such as roughness, albedo, and emmisivity !! - call thermosoil_main for soil thermodynamic calculation !! - call sechiba_end to swap new fields to previous !! !! @call sechiba_var_init !! @call slowproc_main !! @call diffuco_main !! @call enerbil_main !! @call hydrolc_main !! @call enerbil_fusion !! @call condveg_main !! @call thermosoil_main !! @call sechiba_end !! SUBROUTINE sechiba_main (kjit, kjpij, kjpindex, index, dtradia, date0, & & ldrestart_read, ldrestart_write, control_in, & & lalo, contfrac, neighbours, resolution,& ! First level conditions ! Ajout Nathalie - Juin 2006 - passage q2m/t2m pour calcul Rveget ! & zlev, u, v, qair, temp_air, epot_air, ccanopy, & & zlev, u, v, qair, q2m, t2m, temp_air, epot_air, ccanopy, & ! Variables for the implicit coupling & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, & ! Rain, snow, radiation and surface pressure & precip_rain, precip_snow, lwdown, swnet, swdown, pb, & ! Output : Fluxes & vevapp, fluxsens, fluxlat, coastalflow, riverflow, & ! Surface temperatures and surface properties & tsol_rad, temp_sol_new, qsurf_out, albedo_out, emis_out, z0_out, & ! File ids & rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC) ! interface description for dummy arguments ! input scalar INTEGER(i_std), INTENT(in) :: kjit !! Time step number INTEGER(i_std), INTENT(in) :: kjpij !! Total size of size. This is the un-compressed grid INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size INTEGER(i_std),INTENT (in) :: rest_id !! _Restart_ file identifier INTEGER(i_std),INTENT (in) :: hist_id !! _History_ file identifier INTEGER(i_std),INTENT (in) :: hist2_id !! _History_ file 2 identifier INTEGER(i_std),INTENT (in) :: rest_id_stom !! STOMATE's _Restart_ file identifier INTEGER(i_std),INTENT (in) :: hist_id_stom !! STOMATE's _History_ file identifier INTEGER(i_std),INTENT(in) :: hist_id_stom_IPCC !! STOMATE's IPCC _history_ file file identifier REAL(r_std), INTENT (in) :: dtradia !! Time step in seconds REAL(r_std), INTENT (in) :: date0 !! initial date LOGICAL, INTENT(in) :: ldrestart_read !! Logical for _restart_ file to read LOGICAL, INTENT(in) :: ldrestart_write !! Logical for _restart_ file to write TYPE(control_type), INTENT(in) :: control_in !! Flags that (de)activate parts of the model ! input fields REAL(r_std),DIMENSION (kjpindex,2), INTENT (in) :: lalo !! Geographical coordinates REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: contfrac !! Fraction of continent in the grid INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index !! Indeces of the points on the map ! INTEGER(i_std), DIMENSION (kjpindex,8), INTENT(in) :: neighbours !! neighoring grid points if land REAL(r_std), DIMENSION (kjpindex,2), INTENT(in) :: resolution !! size in x an y of the grid (m) ! REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: u !! Lowest level wind speed REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: v !! Lowest level wind speed REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: zlev !! Height of first layer REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: qair !! Lowest level specific humidity ! Ajout Nathalie - Juin 2006 - Q2M/t2m pour calcul Rveget REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: q2m !! 2m specific humidity REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: t2m !! 2m air temperature REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: precip_rain !! Rain precipitation REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: precip_snow !! Snow precipitation REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: lwdown !! Down-welling long-wave flux REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: swnet !! Net surface short-wave flux REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: swdown !! Down-welling surface short-wave flux REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: temp_air !! Air temperature in Kelvin REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: epot_air !! Air potential energy REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: ccanopy !! CO2 concentration in the canopy REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: petAcoef !! Coeficients A from the PBL resolution REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: peqAcoef !! One for T and another for q REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: petBcoef !! Coeficients B from the PBL resolution REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: peqBcoef !! One for T and another for q REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: tq_cdrag !! This is the cdrag without the wind multiplied REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: pb !! Lowest level pressure ! output fields REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: coastalflow !! Diffuse water flow to the oceans REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: riverflow !! River outflow to the oceans REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: tsol_rad !! Radiative surface temperature REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: vevapp !! Total of evaporation REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: temp_sol_new !! New soil temperature REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: qsurf_out !! Surface specific humidity REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: z0_out !! Surface roughness (output diagnostic) REAL(r_std),DIMENSION (kjpindex,2), INTENT (out) :: albedo_out !! Albedo (output diagnostic) REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: fluxsens !! Sensible chaleur flux REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: fluxlat !! Latent chaleur flux REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: emis_out !! Emissivity REAL(r_std), ALLOCATABLE, DIMENSION (:) :: runoff1,drainage1, soilcap1,soilflx1 REAL(r_std), ALLOCATABLE, DIMENSION (:,:) :: shumdiag1 REAL(r_std), DIMENSION(kjpindex) :: histvar !! computations for history files IF (long_print) WRITE(numout,*) ' kjpindex =',kjpindex ! do SECHIBA'S first call initialisation IF (l_first_sechiba) THEN CALL sechiba_init (kjit, ldrestart_read, kjpij, kjpindex, index, rest_id, control_in, lalo) ALLOCATE(runoff1 (kjpindex),drainage1 (kjpindex), soilcap1 (kjpindex),soilflx1 (kjpindex)) ALLOCATE(shumdiag1(kjpindex,nbdl)) ! ! computes initialisation of energy bilan ! IF (ldrestart_read) THEN IF (long_print) WRITE (numout,*) ' we have to read a restart file for SECHIBA variables' var_name='soilcap' ; CALL ioconf_setatt('UNITS', '-') CALL ioconf_setatt('LONG_NAME','Soil calorific capacity') soilcap1=val_exp IF ( ok_var(var_name) ) THEN CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., soilcap1, "gather", nbp_glo, index_g) IF (MINVAL(soilcap1) < MAXVAL(soilcap1) .OR. MAXVAL(soilcap1) < val_exp) THEN soilcap(:) = soilcap1(:) ENDIF ENDIF ! var_name='soilflx' ; CALL ioconf_setatt('UNITS', '-') CALL ioconf_setatt('LONG_NAME','Soil flux') soilflx1=val_exp IF ( ok_var(var_name) ) THEN CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., soilflx1, "gather", nbp_glo, index_g) IF (MINVAL(soilflx1) < MAXVAL(soilflx1) .OR. MAXVAL(soilflx1) < val_exp) THEN soilflx(:) = soilflx1(:) ENDIF ENDIF ! var_name='shumdiag' ; CALL ioconf_setatt('UNITS', '-') CALL ioconf_setatt('LONG_NAME','Relative soil moisture') shumdiag1=val_exp IF ( ok_var(var_name) ) THEN CALL restget_p (rest_id, var_name, nbp_glo, nbdl, 1, kjit, .TRUE., shumdiag1, "gather", nbp_glo, index_g) IF (MINVAL(shumdiag1) < MAXVAL(shumdiag1) .OR. MAXVAL(shumdiag1) < val_exp) THEN shumdiag(:,:) = shumdiag1(:,:) ENDIF ENDIF ENDIF ! ! computes slow variables ! CALL slowproc_main (kjit, kjpij, kjpindex, dtradia, date0, & ldrestart_read, ldrestart_write, control%ok_co2, control%ok_stomate, & index, indexveg, lalo, neighbours, resolution, contfrac, soiltype, & t2mdiag, t2mdiag, temp_sol, stempdiag, & vegstress, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, & deadleaf_cover, & assim_param, & lai, height, veget, frac_nobio, veget_max, totfrac_nobio, qsintmax, & rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & co2_flux) ! ! computes initialisation of diffusion coeff ! CALL diffuco_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, indexveg, u, v, & ! Ajout Nathalie - Juin 2006 - passage q2m/t2m pour calcul Rveget ! & zlev, z0, roughheight, temp_sol, temp_air, rau, tq_cdrag, qsurf, qair, pb , & & zlev, z0, roughheight, temp_sol, temp_air, rau, tq_cdrag, qsurf, qair, q2m, t2m, pb , & & rsol, evap_bare_lim, evapot, snow, frac_nobio, snow_nobio, totfrac_nobio, & & swnet, swdown, ccanopy, humrel, veget, veget_max, lai, qsintveg, qsintmax, assim_param, & & vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta4, vbetaco2, rveget, cimean, rest_id, hist_id, hist2_id) ! ! computes initialisation of energy bilan ! CALL enerbil_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, & & index, zlev, lwdown, swnet, epot_air, temp_air, u, v, petAcoef, petBcoef,& & qair, peqAcoef, peqBcoef, pb, rau, vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta4, vbetaco2, & & cimean, ccanopy, emis, soilflx, soilcap, tq_cdrag, humrel, fluxsens, fluxlat, & & vevapp, transpir, gpp, vevapnu, vevapwet, vevapsno, t2mdiag, temp_sol, tsol_rad, & & temp_sol_new, qsurf, evapot, evapot_corr, rest_id, hist_id, hist2_id) ! ! computes initialisation of hydrologie ! IF (ldrestart_read) THEN var_name='runoff' ; CALL ioconf_setatt('UNITS', 'mm/d') CALL ioconf_setatt('LONG_NAME','Complete runoff') runoff1=val_exp IF ( ok_var(var_name) ) THEN CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., runoff1, "gather", nbp_glo, index_g) IF (MINVAL(runoff1) < MAXVAL(runoff1) .OR. MAXVAL(runoff1) < val_exp) THEN runoff(:) = runoff1(:) ENDIF ENDIF var_name='drainage' ; CALL ioconf_setatt('UNITS', 'mm/d') CALL ioconf_setatt('LONG_NAME','Deep drainage') drainage1=val_exp IF ( ok_var(var_name) ) THEN CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., drainage1, "gather", nbp_glo, index_g) IF (MINVAL(drainage1) < MAXVAL(drainage1) .OR. MAXVAL(drainage1) < val_exp) THEN drainage(:) = drainage1(:) ENDIF ENDIF IF ( ok_var("shumdiag") ) THEN IF (MINVAL(shumdiag1) < MAXVAL(shumdiag1) .OR. MAXVAL(shumdiag1) < val_exp) THEN shumdiag(:,:) = shumdiag1(:,:) ENDIF ENDIF ENDIF ! IF ( .NOT. hydrol_cwrr ) THEN CALL hydrolc_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, indexveg, & & temp_sol_new, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,& & qsintmax, qsintveg, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age,& & tot_melt, transpir, precip_rain, precip_snow, returnflow, irrigation, humrel, & & vegstress, rsol, drysoil_frac, evapot, evapot_corr, shumdiag, litterhumdiag, soilcap, rest_id, hist_id, hist2_id) evap_bare_lim(:) = -un ELSE CALL hydrol_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, indexveg, indexsoil, indexlayer, & & temp_sol_new, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,& & qsintmax, qsintveg, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age,& & tot_melt, transpir, precip_rain, precip_snow, returnflow, irrigation, humrel, & & vegstress, drysoil_frac, evapot, evapot_corr, evap_bare_lim, & & shumdiag, litterhumdiag, soilcap, soiltype, rest_id, hist_id, hist2_id) ENDIF IF (ldrestart_read) THEN IF ( ok_var("runoff") ) THEN IF (MINVAL(runoff1) < MAXVAL(runoff1) .OR. MAXVAL(runoff1) < val_exp) THEN runoff(:) = runoff1(:) ENDIF ENDIF IF ( ok_var("drainage") ) THEN IF (MINVAL(drainage1) < MAXVAL(drainage1) .OR. MAXVAL(drainage1) < val_exp) THEN drainage(:) = drainage1(:) ENDIF ENDIF IF ( ok_var("shumdiag") ) THEN IF (MINVAL(shumdiag1) < MAXVAL(shumdiag1) .OR. MAXVAL(shumdiag1) < val_exp) THEN shumdiag(:,:) = shumdiag1(:,:) ENDIF ENDIF ENDIF ! ! computes initialisation of condveg ! CALL condveg_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, & & lalo, neighbours, resolution, contfrac, veget, veget_max, frac_nobio, totfrac_nobio, & & zlev, snow, snow_age, snow_nobio, snow_nobio_age, & & drysoil_frac, height, deadleaf_cover, emis, albedo, z0, roughheight, soiltype, rest_id, hist_id, hist2_id) ! ! computes initialisation of Soil Thermodynamic ! CALL thermosoil_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, & & index, indexgrnd, temp_sol_new, snow, soilcap, soilflx, shumdiag, stempdiag, rest_id, hist_id, hist2_id) IF (ldrestart_read) THEN IF ( ok_var("soilcap") ) THEN IF (MINVAL(soilcap1) < MAXVAL(soilcap1) .OR. MAXVAL(soilcap1) < val_exp) THEN soilcap(:) = soilcap1(:) ENDIF ENDIF ! IF ( ok_var("soilflx") ) THEN IF (MINVAL(soilflx1) < MAXVAL(soilflx1) .OR. MAXVAL(soilflx1) < val_exp) THEN soilflx(:) = soilflx1(:) ENDIF ENDIF ENDIF ! ! If we chose to route the water then we call the module. Else variables ! are set to zero. ! ! IF ( river_routing .AND. nbp_glo .GT. 1) THEN CALL routing_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, & & lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, runoff, & & drainage, evapot_corr, precip_rain, humrel, & & stempdiag, returnflow, irrigation, riverflow, coastalflow, rest_id, hist_id, hist2_id) ELSE riverflow(:) = zero coastalflow(:) = zero returnflow(:) = zero irrigation(:) = zero ENDIF ! ! Write the internal variables into the output fields ! z0_out(:) = z0(:) emis_out(:) = emis(:) albedo_out(:,:) = albedo(:,:) qsurf_out(:) = qsurf(:) DEALLOCATE(runoff1,drainage1,soilcap1,soilflx1) DEALLOCATE(shumdiag1) ! ! This line should remain last as it ends the initialisation and returns to the caling ! routine. ! RETURN ! ENDIF ! ! computes some initialisation every SECHIBA's call ! CALL sechiba_var_init (kjpindex, rau, pb, temp_air) ! ! computes diffusion coeff ! CALL diffuco_main (kjit, kjpindex, dtradia, ldrestart_read, myfalse, index, indexveg, u, v, & ! Ajout Nathalie - Juin 2006 - passage q2m/t2m pour calcul Rveget ! & zlev, z0, roughheight, temp_sol, temp_air, rau, tq_cdrag, qsurf, qair, pb , & & zlev, z0, roughheight, temp_sol, temp_air, rau, tq_cdrag, qsurf, qair, q2m, t2m, pb , & & rsol, evap_bare_lim, evapot, snow, frac_nobio, snow_nobio, totfrac_nobio, & & swnet, swdown, ccanopy, humrel, veget, veget_max, lai, qsintveg, qsintmax, assim_param, & & vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta4, vbetaco2, rveget, cimean, rest_id, hist_id, hist2_id) ! ! computes energy bilan ! CALL enerbil_main (kjit, kjpindex, dtradia, ldrestart_read, myfalse, & & index, zlev, lwdown, swnet, epot_air, temp_air, u, v, petAcoef, petBcoef, & & qair, peqAcoef, peqBcoef, pb, rau, vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta4, vbetaco2, & & cimean, ccanopy, emis, soilflx, soilcap, tq_cdrag, humrel, fluxsens, fluxlat, & & vevapp, transpir, gpp, vevapnu, vevapwet, vevapsno, t2mdiag, temp_sol, tsol_rad, & & temp_sol_new, qsurf, evapot, evapot_corr, rest_id, hist_id, hist2_id) ! ! computes hydrologie ! IF ( .NOT. hydrol_cwrr ) THEN CALL hydrolc_main (kjit, kjpindex, dtradia, ldrestart_read, myfalse, index, indexveg, & & temp_sol_new, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,& & qsintmax, qsintveg, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age,& & tot_melt, transpir, precip_rain, precip_snow, returnflow, irrigation, humrel, & & vegstress, rsol, drysoil_frac, evapot, evapot_corr, shumdiag, litterhumdiag, soilcap, rest_id, hist_id, hist2_id) evap_bare_lim(:) = -un ELSE CALL hydrol_main (kjit, kjpindex, dtradia, ldrestart_read, myfalse, index, indexveg, indexsoil, indexlayer, & & temp_sol_new, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,& & qsintmax, qsintveg, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age,& & tot_melt, transpir, precip_rain, precip_snow, returnflow, irrigation, humrel, & & vegstress, drysoil_frac, evapot, evapot_corr, evap_bare_lim, & & shumdiag, litterhumdiag, soilcap, soiltype, rest_id, hist_id, hist2_id) ENDIF ! ! computes last part of energy bilan ! CALL enerbil_fusion (kjpindex, dtradia, tot_melt, soilcap, temp_sol_new, fusion) ! ! computes condveg ! CALL condveg_main (kjit, kjpindex, dtradia, ldrestart_read, myfalse, index,& & lalo, neighbours, resolution, contfrac, veget, veget_max, frac_nobio, totfrac_nobio, & & zlev, snow, snow_age, snow_nobio, snow_nobio_age, & & drysoil_frac, height, deadleaf_cover, emis, albedo, z0, roughheight, soiltype, rest_id, hist_id, hist2_id) ! ! computes Soil Thermodynamic ! CALL thermosoil_main (kjit, kjpindex, dtradia, ldrestart_read, myfalse, index, indexgrnd, & & temp_sol_new, snow, soilcap, soilflx, shumdiag, stempdiag, rest_id, hist_id, hist2_id) ! ! If we chose to route the water then we call the module. Else variables ! are set to zero. ! ! IF ( river_routing .AND. nbp_glo .GT. 1) THEN CALL routing_main (kjit, kjpindex, dtradia, ldrestart_read, myfalse, index, & & lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, runoff, & & drainage, evapot_corr, precip_rain, humrel, & & stempdiag, returnflow, irrigation, riverflow, coastalflow, rest_id, hist_id, hist2_id) ! returnflow(:) = returnflow(:) * 100. ELSE riverflow(:) = zero coastalflow(:) = zero returnflow(:) = zero irrigation(:) = zero ENDIF ! ! computes slow variables ! ok_co2 and ok_stomate are interpreted as flags that determine whether the ! forcing files are written. ! CALL slowproc_main (kjit, kjpij, kjpindex, dtradia, date0, & ldrestart_read, myfalse, control%ok_co2, control%ok_stomate, & index, indexveg, lalo, neighbours, resolution, contfrac, soiltype, & t2mdiag, t2mdiag, temp_sol, stempdiag, & vegstress, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, & deadleaf_cover, & assim_param, & lai, height, veget, frac_nobio, veget_max, totfrac_nobio, qsintmax, & rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & co2_flux) ! ! call swap from new computed variables ! CALL sechiba_end (kjpindex, dtradia, temp_sol, temp_sol_new) ! ! Write the internal variables into the output fields ! z0_out(:) = z0(:) emis_out(:) = emis(:) albedo_out(:,:) = albedo(:,:) qsurf_out(:) = qsurf(:) ! ! Writing the global variables on the history tape ! ! IF ( .NOT. almaoutput ) THEN CALL histwrite(hist_id, 'beta', kjit, vbeta, kjpindex, index) CALL histwrite(hist_id, 'z0', kjit, z0, kjpindex, index) CALL histwrite(hist_id, 'roughheight', kjit, roughheight, kjpindex, index) CALL histwrite(hist_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg) CALL histwrite(hist_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg) CALL histwrite(hist_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio) CALL histwrite(hist_id, 'lai', kjit, lai, kjpindex*nvm, indexveg) CALL histwrite(hist_id, 'subli', kjit, vevapsno, kjpindex, index) CALL histwrite(hist_id, 'evapnu', kjit, vevapnu, kjpindex, index) CALL histwrite(hist_id, 'transpir', kjit, transpir, kjpindex*nvm, indexveg) CALL histwrite(hist_id, 'inter', kjit, vevapwet, kjpindex*nvm, indexveg) CALL histwrite(hist_id, 'vbeta1', kjit, vbeta1, kjpindex, index) CALL histwrite(hist_id, 'vbeta2', kjit, vbeta2, kjpindex*nvm, indexveg) CALL histwrite(hist_id, 'vbeta3', kjit, vbeta3, kjpindex*nvm, indexveg) CALL histwrite(hist_id, 'vbeta4', kjit, vbeta4, kjpindex, index) CALL histwrite(hist_id, 'drysoil_frac', kjit, drysoil_frac, kjpindex, index) CALL histwrite(hist_id, 'rveget', kjit, rveget, kjpindex*nvm, indexveg) CALL histwrite(hist_id, 'rsol', kjit, rsol, kjpindex, index) CALL histwrite(hist_id, 'snow', kjit, snow, kjpindex, index) CALL histwrite(hist_id, 'snowage', kjit, snow_age, kjpindex, index) CALL histwrite(hist_id, 'snownobio', kjit, snow_nobio, kjpindex*nnobio, indexnobio) CALL histwrite(hist_id, 'snownobioage', kjit, snow_nobio_age, kjpindex*nnobio, indexnobio) CALL histwrite(hist_id, 'soiltype', kjit, soiltype, kjpindex*nstm, indexsoil) IF ( control%ok_co2 ) THEN CALL histwrite(hist_id, 'vbetaco2', kjit, vbetaco2, kjpindex*nvm, indexveg) CALL histwrite(hist_id, 'gpp', kjit, gpp, kjpindex*nvm, indexveg) CALL histwrite(hist_id, 'cimean', kjit, cimean, kjpindex*nvm, indexveg) ENDIF IF ( control%ok_stomate ) THEN CALL histwrite(hist_id, 'nee', kjit, co2_flux, kjpindex*nvm, indexveg) ENDIF histvar(:)=SUM(vevapwet(:,:),dim=2)/one_day CALL histwrite(hist_id, 'evspsblveg', kjit, histvar, kjpindex, index) histvar(:)=(vevapnu(:)+vevapsno(:))/one_day CALL histwrite(hist_id, 'evspsblsoi', kjit, histvar, kjpindex, index) histvar(:)=SUM(transpir(:,:),dim=2)/one_day CALL histwrite(hist_id, 'tran', kjit, histvar, kjpindex, index) histvar(:)=SUM(veget_max(:,2:9),dim=2)*100*contfrac(:) CALL histwrite(hist_id, 'treeFrac', kjit, histvar, kjpindex, index) histvar(:)=SUM(veget_max(:,10:11),dim=2)*100*contfrac(:) CALL histwrite(hist_id, 'grassFrac', kjit, histvar, kjpindex, index) histvar(:)=SUM(veget_max(:,12:13),dim=2)*100*contfrac(:) CALL histwrite(hist_id, 'cropFrac', kjit, histvar, kjpindex, index) histvar(:)=veget_max(:,1)*100*contfrac(:) CALL histwrite(hist_id, 'baresoilFrac', kjit, histvar, kjpindex, index) histvar(:)=SUM(frac_nobio(:,1:nnobio),dim=2)*100*contfrac(:) CALL histwrite(hist_id, 'residualFrac', kjit, histvar, kjpindex, index) ELSE CALL histwrite(hist_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg) CALL histwrite(hist_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg) CALL histwrite(hist_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio) CALL histwrite(hist_id, 'Qf', kjit, fusion, kjpindex, index) CALL histwrite(hist_id, 'SWE', kjit, snow, kjpindex, index) CALL histwrite(hist_id, 'ESoil', kjit, vevapnu, kjpindex, index) CALL histwrite(hist_id, 'TVeg', kjit, transpir, kjpindex*nvm, indexveg) CALL histwrite(hist_id, 'ECanop', kjit, vevapwet, kjpindex*nvm, indexveg) CALL histwrite(hist_id, 'ACond', kjit, tq_cdrag, kjpindex, index) CALL histwrite(hist_id, 'SnowFrac', kjit, vbeta1, kjpindex, index) IF ( control%ok_co2 ) THEN CALL histwrite(hist_id, 'GPP', kjit, gpp, kjpindex*nvm, indexveg) ENDIF IF ( control%ok_stomate ) THEN CALL histwrite(hist_id, 'NEE', kjit, co2_flux, kjpindex*nvm, indexveg) ENDIF ENDIF ! IF ( hist2_id > 0 ) THEN IF ( .NOT. almaoutput ) THEN CALL histwrite(hist2_id, 'tsol_rad', kjit, tsol_rad, kjpindex, index) CALL histwrite(hist2_id, 'qsurf', kjit, qsurf, kjpindex, index) CALL histwrite(hist2_id, 'albedo', kjit, albedo, kjpindex*2, indexalb) CALL histwrite(hist2_id, 'emis', kjit, emis, kjpindex, index) ! CALL histwrite(hist2_id, 'beta', kjit, vbeta, kjpindex, index) CALL histwrite(hist2_id, 'z0', kjit, z0, kjpindex, index) CALL histwrite(hist2_id, 'roughheight', kjit, roughheight, kjpindex, index) CALL histwrite(hist2_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg) CALL histwrite(hist2_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg) CALL histwrite(hist2_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio) CALL histwrite(hist2_id, 'lai', kjit, lai, kjpindex*nvm, indexveg) CALL histwrite(hist2_id, 'subli', kjit, vevapsno, kjpindex, index) CALL histwrite(hist2_id, 'vevapnu', kjit, vevapnu, kjpindex, index) CALL histwrite(hist2_id, 'transpir', kjit, transpir, kjpindex*nvm, indexveg) CALL histwrite(hist2_id, 'inter', kjit, vevapwet, kjpindex*nvm, indexveg) CALL histwrite(hist2_id, 'vbeta1', kjit, vbeta1, kjpindex, index) CALL histwrite(hist2_id, 'vbeta2', kjit, vbeta2, kjpindex*nvm, indexveg) CALL histwrite(hist2_id, 'vbeta3', kjit, vbeta3, kjpindex*nvm, indexveg) CALL histwrite(hist2_id, 'vbeta4', kjit, vbeta4, kjpindex, index) CALL histwrite(hist2_id, 'drysoil_frac', kjit, drysoil_frac, kjpindex, index) CALL histwrite(hist2_id, 'rveget', kjit, rveget, kjpindex*nvm, indexveg) CALL histwrite(hist2_id, 'rsol', kjit, rsol, kjpindex, index) CALL histwrite(hist2_id, 'snow', kjit, snow, kjpindex, index) CALL histwrite(hist2_id, 'snowage', kjit, snow_age, kjpindex, index) CALL histwrite(hist2_id, 'snownobio', kjit, snow_nobio, kjpindex*nnobio, indexnobio) CALL histwrite(hist2_id, 'snownobioage', kjit, snow_nobio_age, kjpindex*nnobio, indexnobio) CALL histwrite(hist2_id, 'soiltype', kjit, soiltype, kjpindex*nstm, indexsoil) IF ( control%ok_co2 ) THEN CALL histwrite(hist2_id, 'vbetaco2', kjit, vbetaco2, kjpindex*nvm, indexveg) CALL histwrite(hist2_id, 'gpp', kjit, gpp, kjpindex*nvm, indexveg) CALL histwrite(hist2_id, 'cimean', kjit, cimean, kjpindex*nvm, indexveg) ENDIF IF ( control%ok_stomate ) THEN CALL histwrite(hist2_id, 'nee', kjit, co2_flux, kjpindex*nvm, indexveg) ENDIF ELSE CALL histwrite(hist2_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg) CALL histwrite(hist2_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg) CALL histwrite(hist2_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio) CALL histwrite(hist2_id, 'Qf', kjit, fusion, kjpindex, index) CALL histwrite(hist2_id, 'SWE', kjit, snow, kjpindex, index) CALL histwrite(hist2_id, 'ESoil', kjit, vevapnu, kjpindex, index) CALL histwrite(hist2_id, 'TVeg', kjit, transpir, kjpindex*nvm, indexveg) CALL histwrite(hist2_id, 'ECanop', kjit, vevapwet, kjpindex*nvm, indexveg) CALL histwrite(hist2_id, 'ACond', kjit, tq_cdrag, kjpindex, index) CALL histwrite(hist2_id, 'SnowFrac', kjit, vbeta1, kjpindex, index) IF ( control%ok_co2 ) THEN CALL histwrite(hist2_id, 'GPP', kjit, gpp, kjpindex*nvm, indexveg) ENDIF IF ( control%ok_stomate ) THEN CALL histwrite(hist2_id, 'NEE', kjit, co2_flux, kjpindex*nvm, indexveg) ENDIF ENDIF ENDIF ! ! prepares restart file for the next simulation from SECHIBA and from other modules ! IF (ldrestart_write) THEN IF (long_print) WRITE (numout,*) ' we have to write a restart file ' ! ! call diffuco_main to write restart files ! CALL diffuco_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, indexveg, u, v, & ! Ajout Nathalie - Juin 2006 - passage q2m/t2m pour calcul Rveget ! & zlev, z0, roughheight, temp_sol, temp_air, rau, tq_cdrag, qsurf, qair, pb , & & zlev, z0, roughheight, temp_sol, temp_air, rau, tq_cdrag, qsurf, qair, q2m, t2m, pb , & & rsol, evap_bare_lim, evapot, snow, frac_nobio, snow_nobio, totfrac_nobio, & & swnet, swdown, ccanopy, humrel, veget, veget_max, lai, qsintveg, qsintmax, assim_param, & & vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta4, vbetaco2, rveget, cimean, rest_id, hist_id, hist2_id) ! ! call energy bilan to write restart files ! CALL enerbil_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, & & index, zlev, lwdown, swnet, epot_air, temp_air, u, v, petAcoef, petBcoef,& & qair, peqAcoef, peqBcoef, pb, rau, vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta4, vbetaco2, & & cimean, ccanopy, emis, soilflx, soilcap, tq_cdrag, humrel, fluxsens, fluxlat, & & vevapp, transpir, gpp, vevapnu, vevapwet, vevapsno, t2mdiag, temp_sol, tsol_rad, & & temp_sol_new, qsurf, evapot, evapot_corr, rest_id, hist_id, hist2_id) ! ! call hydrologie to write restart files ! IF ( .NOT. hydrol_cwrr ) THEN CALL hydrolc_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, indexveg, & & temp_sol_new, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,& & qsintmax, qsintveg, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age,& & tot_melt, transpir, precip_rain, precip_snow, returnflow, irrigation, & & humrel, vegstress, rsol, drysoil_frac, evapot, evapot_corr, shumdiag, litterhumdiag, soilcap, & & rest_id, hist_id, hist2_id) evap_bare_lim(:) = -un ELSE CALL hydrol_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, indexveg, indexsoil, indexlayer, & & temp_sol_new, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,& & qsintmax, qsintveg, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age,& & tot_melt, transpir, precip_rain, precip_snow, returnflow, irrigation, humrel, & & vegstress, drysoil_frac, evapot, evapot_corr, evap_bare_lim, & & shumdiag, litterhumdiag, soilcap, soiltype, rest_id, hist_id, hist2_id) rsol(:) = -un ENDIF ! ! call condveg to write restart files ! CALL condveg_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, & & lalo, neighbours, resolution, contfrac, veget, veget_max, frac_nobio, totfrac_nobio, & & zlev, snow, snow_age, snow_nobio, snow_nobio_age, & & drysoil_frac, height, deadleaf_cover, emis, albedo, z0, roughheight, soiltype, rest_id, hist_id, hist2_id) ! ! call Soil Thermodynamic to write restart files ! CALL thermosoil_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, indexgrnd, & & temp_sol_new, snow, soilcap, soilflx, shumdiag, stempdiag, rest_id, hist_id, hist2_id) ! ! If we chose to route the water then we call the module. Else variables ! are set to zero. ! ! IF ( river_routing .AND. nbp_glo .GT. 1) THEN CALL routing_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, & & lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, runoff, & & drainage, evapot_corr, precip_rain, humrel, & & stempdiag, returnflow, irrigation, riverflow, coastalflow, rest_id, hist_id, hist2_id) ELSE riverflow(:) = zero coastalflow(:) = zero returnflow(:) = zero irrigation(:) = zero ENDIF ! ! call slowproc_main to write restart files ! CALL slowproc_main (kjit, kjpij, kjpindex, dtradia, date0, & ldrestart_read, ldrestart_write, control%ok_co2, control%ok_stomate, & index, indexveg, lalo, neighbours, resolution, contfrac, soiltype, & t2mdiag, t2mdiag, temp_sol, stempdiag, & vegstress, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, & deadleaf_cover, & assim_param, & lai, height, veget, frac_nobio, veget_max, totfrac_nobio, qsintmax, & rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & co2_flux) var_name= 'shumdiag' CALL restput_p(rest_id, var_name, nbp_glo, nbdl, 1, kjit, shumdiag, 'scatter', nbp_glo, index_g) var_name= 'runoff' CALL restput_p(rest_id, var_name, nbp_glo, 1, 1, kjit, runoff, 'scatter', nbp_glo, index_g) var_name= 'drainage' CALL restput_p(rest_id, var_name, nbp_glo, 1, 1, kjit, drainage, 'scatter', nbp_glo, index_g) END IF IF (long_print) WRITE (numout,*) ' sechiba_main done ' END SUBROUTINE sechiba_main !! Initialisation for SECHIBA processes !! - does dynamic allocation for local arrays !! - reads _restart_ file or set initial values to a raisonable value !! - reads initial map !! SUBROUTINE sechiba_init (kjit, ldrestart_read, kjpij, kjpindex, index, rest_id, control_in, lalo) ! interface description ! input scalar INTEGER(i_std), INTENT (in) :: kjit !! Time step number LOGICAL,INTENT (in) :: ldrestart_read !! Logical for restart file to read INTEGER(i_std), INTENT (in) :: kjpij !! Size of full domaine INTEGER(i_std), INTENT (in) :: kjpindex !! Domain size INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index !! Indeces of the points on the map INTEGER(i_std), INTENT (in) :: rest_id !! _Restart_ file identifier TYPE(control_type), INTENT(in) :: control_in !! Flags that (de)activate parts of the model ! input fields REAL(r_std),DIMENSION (kjpindex,2), INTENT (in) :: lalo !! Geographical coordinates ! output scalar ! output fields ! local declaration INTEGER(i_std) :: ier, ji, jv ! ! initialisation ! IF (l_first_sechiba) THEN l_first_sechiba=.FALSE. ELSE WRITE (numout,*) ' l_first_sechiba false . we stop ' STOP 'sechiba_init' ENDIF ! 1. make dynamic allocation with good dimension ! 1.0 The 3D vegetation indexation table ALLOCATE (indexveg(kjpindex*nvm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in indexveg allocation. We stop. We need kjpindex words = ',kjpindex*nvm STOP 'sechiba_init' END IF ALLOCATE (indexsoil(kjpindex*nstm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in indexsoil allocation. We stop. We need kjpindex words = ',kjpindex*nstm STOP 'sechiba_init' END IF ALLOCATE (indexnobio(kjpindex*nnobio),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in indexnobio allocation. We stop. We need kjpindex words = ',kjpindex*nnobio STOP 'sechiba_init' END IF ALLOCATE (indexgrnd(kjpindex*ngrnd),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in indexgrnd allocation. We stop. We need kjpindex words = ',kjpindex*ngrnd STOP 'sechiba_init' END IF ALLOCATE (indexlayer(kjpindex*nslm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in indexlayer allocation. We stop. We need kjpindex words = ',kjpindex*nslm STOP 'sechiba_init' END IF ALLOCATE (indexalb(kjpindex*2),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in indexalb allocation. We stop. We need kjpindex words = ',kjpindex*2 STOP 'sechiba_init' END IF ! 1.1 one dimension array allocation with restartable value IF (long_print) WRITE (numout,*) 'Allocation of 1D variables. We need for each kjpindex words = ',kjpindex ALLOCATE (snow(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in snow allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF snow(:) = undef_sechiba ALLOCATE (snow_age(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in snow_age allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF snow_age(:) = undef_sechiba ALLOCATE (drysoil_frac(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in drysoil_frac allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF drysoil_frac(:) = zero ALLOCATE (rsol(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in rsol allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (evap_bare_lim(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in evap_bare_lim allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (evapot(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in evapot allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF evapot(:) = undef_sechiba ALLOCATE (evapot_corr(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in evapot_corr allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (humrel(kjpindex,nvm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in humrel allocation. We stop. we need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF humrel(:,:) = undef_sechiba ALLOCATE (vegstress(kjpindex,nvm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in vegstress allocation. We stop. we need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF vegstress(:,:) = undef_sechiba ALLOCATE (soiltype(kjpindex,nstm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in soiltype allocation. We stop. we need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF soiltype(:,:)=undef_sechiba ALLOCATE (vbeta1(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in vbeta1 allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (vbeta4(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in vbeta4 allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (soilcap(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in soilcap allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (soilflx(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in soilflx allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (temp_sol(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in temp_sol allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF temp_sol(:) = undef_sechiba ALLOCATE (qsurf(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in qsurf allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF qsurf(:) = undef_sechiba ! 1.2 two dimensions array allocation with restartable value ALLOCATE (qsintveg(kjpindex,nvm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in qsintveg allocation. We stop. We need kjpindex x nvm words = ',& & kjpindex,' x ' ,nvm,' = ',kjpindex*nvm STOP 'sechiba_init' END IF qsintveg(:,:) = undef_sechiba ALLOCATE (vbeta2(kjpindex,nvm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in vbeta2 allocation. We stop. We need kjpindex x nvm words = ',& & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm STOP 'sechiba_init' END IF ALLOCATE (vbeta3(kjpindex,nvm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in vbeta3 allocation. We stop.We need kjpindex x nvm words = ',& & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm STOP 'sechiba_init' END IF ALLOCATE (vbetaco2(kjpindex,nvm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in vbetaco2 allocation. We stop.We need kjpindex x nvm words = ',& & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm STOP 'sechiba_init' END IF ALLOCATE (cimean(kjpindex,nvm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in cimean allocation. We stop.We need kjpindex x nvm words = ',& & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm STOP 'sechiba_init' END IF ALLOCATE (gpp(kjpindex,nvm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in gpp allocation. We stop.We need kjpindex x nvm words = ',& & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm STOP 'sechiba_init' END IF gpp(:,:) = undef_sechiba ALLOCATE (veget(kjpindex,nvm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in veget allocation. We stop. We need kjpindex x nvm words = ',& & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm STOP 'sechiba_init' END IF veget(:,:)=undef_sechiba ALLOCATE (veget_max(kjpindex,nvm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in veget_max allocation. We stop. We need kjpindex x nvm words = ',& & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm STOP 'sechiba_init' END IF veget_max(:,:)=undef_sechiba ALLOCATE (lai(kjpindex,nvm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in lai allocation. We stop. We need kjpindex x nvm words = ',& & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm STOP 'sechiba_init' END IF lai(:,:)=undef_sechiba ALLOCATE (height(kjpindex,nvm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in height allocation. We stop. We need kjpindex x nvm words = ',& & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm STOP 'sechiba_init' END IF height(:,:)=undef_sechiba ALLOCATE (frac_nobio(kjpindex,nnobio),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in frac_nobio allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF frac_nobio(:,:) = undef_sechiba ALLOCATE (albedo(kjpindex,2),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in albedo allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (snow_nobio(kjpindex,nnobio),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in snow_nobio allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF snow_nobio(:,:) = undef_sechiba ALLOCATE (snow_nobio_age(kjpindex,nnobio),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in snow_nobio_age allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF snow_nobio_age(:,:) = undef_sechiba ALLOCATE (assim_param(kjpindex,nvm,npco2),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in assim_param allocation. We stop. We need kjpindex x nvm x npco2 words = ',& & kjpindex,' x ' ,nvm,' x ',npco2, ' = ',kjpindex*nvm*npco2 STOP 'sechiba_init' END IF ! 1.3 one dimension array allocation ALLOCATE (vevapsno(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in vevapsno allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (vevapnu(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in vevapnu allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (t2mdiag(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in t2mdiag allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (totfrac_nobio(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in totfrac_nobio allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (runoff(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in runoff allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (drainage(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in drainage allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (returnflow(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in returnflow allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF returnflow(:) = zero ALLOCATE (irrigation(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in irrigation allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF irrigation(:) = zero ALLOCATE (z0(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in z0 allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (roughheight(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in roughheight allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (emis(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in emis allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (tot_melt(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in tot_melt allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (valpha(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in valpha allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (vbeta(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in vbeta allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (fusion(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in fusion allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (rau(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in rau allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (deadleaf_cover(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in deadleaf_cover allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ALLOCATE (stempdiag(kjpindex, nbdl),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in stempdiag allocation. We stop. We need kjpindex*nbdl words = ',& & kjpindex*nbdl STOP 'sechiba_init' END IF ALLOCATE (co2_flux(kjpindex,nvm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in co2_flux allocation. We stop. We need kjpindex*nvm words = ' ,kjpindex*nvm STOP 'sechiba_init' END IF co2_flux(:,:)=zero ALLOCATE (shumdiag(kjpindex,nbdl),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in shumdiag allocation. We stop. We need kjpindex*nbdl words = ',& & kjpindex*nbdl STOP 'sechiba_init' END IF ALLOCATE (litterhumdiag(kjpindex),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in litterhumdiag allocation. We stop. We need kjpindex words = ',kjpindex STOP 'sechiba_init' END IF ! 1.4 two dimensions array allocation ALLOCATE (vevapwet(kjpindex,nvm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in vevapwet allocation. We stop. We need kjpindex x nvm words = ',& & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm STOP 'sechiba_init' END IF ALLOCATE (transpir(kjpindex,nvm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in transpir allocation. We stop. We need kjpindex x nvm words = ',& & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm STOP 'sechiba_init' END IF ALLOCATE (qsintmax(kjpindex,nvm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in qsintmax allocation. We stop. We need kjpindex x nvm words = ',& & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm STOP 'sechiba_init' END IF ALLOCATE (rveget(kjpindex,nvm),stat=ier) IF (ier.NE.0) THEN WRITE (numout,*) ' error in rveget allocation. We stop. We need kjpindex x nvm words = ',& & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm STOP 'sechiba_init' END IF ! ! 1.5 Get the indexing table for the vegetation fields. In SECHIBA we work on reduced grids but to store in the ! full 3D filed vegetation variable we need another index table : indexveg, indexsoil, indexnobio and ! indexgrnd ! DO ji = 1, kjpindex ! DO jv = 1, nvm indexveg((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij ENDDO ! DO jv = 1, nstm indexsoil((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij ENDDO ! DO jv = 1, nnobio indexnobio((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij ENDDO ! DO jv = 1, ngrnd indexgrnd((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij ENDDO ! DO jv = 1, nslm indexlayer((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij ENDDO ! DO jv = 1, 2 indexalb((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij ENDDO ! ENDDO ! ! 2. restart value ! ! open restart input file if needed ! and read data from restart input file ! IF (ldrestart_read) THEN IF (long_print) WRITE (numout,*) ' we have to read a restart file for SECHIBA variables' ! ! Read the default value that will be put into variable which are not in the restart file ! CALL ioget_expval(val_exp) ENDIF ! river_routing = control_in%river_routing hydrol_cwrr = control_in%hydrol_cwrr ! ! 4. run control: store flags in a common variable ! control%river_routing = control_in%river_routing control%hydrol_cwrr = control_in%hydrol_cwrr control%ok_co2 = control_in%ok_co2 control%ok_sechiba = control_in%ok_sechiba control%ok_stomate = control_in%ok_stomate control%ok_dgvm = control_in%ok_dgvm control%ok_pheno = control_in%ok_pheno control%stomate_watchout = control_in%stomate_watchout IF (long_print) WRITE (numout,*) ' sechiba_init done ' END SUBROUTINE sechiba_init ! !------------------------------------------------------------------ ! SUBROUTINE sechiba_clear (forcing_name,cforcing_name) CHARACTER(LEN=100), INTENT(in) :: forcing_name CHARACTER(LEN=100), INTENT(in) :: cforcing_name ! ! initialisation ! l_first_sechiba=.TRUE. ! 1. Deallocate all dynamic variables IF ( ALLOCATED (indexveg)) DEALLOCATE (indexveg) IF ( ALLOCATED (indexsoil)) DEALLOCATE (indexsoil) IF ( ALLOCATED (indexnobio)) DEALLOCATE (indexnobio) IF ( ALLOCATED (indexgrnd)) DEALLOCATE (indexgrnd) IF ( ALLOCATED (indexlayer)) DEALLOCATE (indexlayer) IF ( ALLOCATED (indexalb)) DEALLOCATE (indexalb) IF ( ALLOCATED (snow)) DEALLOCATE (snow) IF ( ALLOCATED (snow_age)) DEALLOCATE (snow_age) IF ( ALLOCATED (drysoil_frac)) DEALLOCATE (drysoil_frac) IF ( ALLOCATED (rsol)) DEALLOCATE (rsol) IF ( ALLOCATED (evap_bare_lim)) DEALLOCATE (evap_bare_lim) IF ( ALLOCATED (evapot)) DEALLOCATE (evapot) IF ( ALLOCATED (evapot_corr)) DEALLOCATE (evapot_corr) IF ( ALLOCATED (humrel)) DEALLOCATE (humrel) IF ( ALLOCATED (vegstress)) DEALLOCATE (vegstress) IF ( ALLOCATED (soiltype)) DEALLOCATE (soiltype) IF ( ALLOCATED (vbeta1)) DEALLOCATE (vbeta1) IF ( ALLOCATED (vbeta4)) DEALLOCATE (vbeta4) IF ( ALLOCATED (soilcap)) DEALLOCATE (soilcap) IF ( ALLOCATED (soilflx)) DEALLOCATE (soilflx) IF ( ALLOCATED (temp_sol)) DEALLOCATE (temp_sol) IF ( ALLOCATED (qsurf)) DEALLOCATE (qsurf) IF ( ALLOCATED (qsintveg)) DEALLOCATE (qsintveg) IF ( ALLOCATED (vbeta2)) DEALLOCATE (vbeta2) IF ( ALLOCATED (vbeta3)) DEALLOCATE (vbeta3) IF ( ALLOCATED (vbetaco2)) DEALLOCATE (vbetaco2) IF ( ALLOCATED (cimean)) DEALLOCATE (cimean) IF ( ALLOCATED (gpp)) DEALLOCATE (gpp) IF ( ALLOCATED (veget)) DEALLOCATE (veget) IF ( ALLOCATED (veget_max)) DEALLOCATE (veget_max) IF ( ALLOCATED (lai)) DEALLOCATE (lai) IF ( ALLOCATED (height)) DEALLOCATE (height) IF ( ALLOCATED (roughheight)) DEALLOCATE (roughheight) IF ( ALLOCATED (frac_nobio)) DEALLOCATE (frac_nobio) IF ( ALLOCATED (snow_nobio)) DEALLOCATE (snow_nobio) IF ( ALLOCATED (snow_nobio_age)) DEALLOCATE (snow_nobio_age) IF ( ALLOCATED (assim_param)) DEALLOCATE (assim_param) IF ( ALLOCATED (vevapsno)) DEALLOCATE (vevapsno) IF ( ALLOCATED (vevapnu)) DEALLOCATE (vevapnu) IF ( ALLOCATED (t2mdiag)) DEALLOCATE (t2mdiag) IF ( ALLOCATED (totfrac_nobio)) DEALLOCATE (totfrac_nobio) IF ( ALLOCATED (runoff)) DEALLOCATE (runoff) IF ( ALLOCATED (drainage)) DEALLOCATE (drainage) IF ( ALLOCATED (returnflow)) DEALLOCATE (returnflow) IF ( ALLOCATED (irrigation)) DEALLOCATE (irrigation) IF ( ALLOCATED (tot_melt)) DEALLOCATE (tot_melt) IF ( ALLOCATED (valpha)) DEALLOCATE (valpha) IF ( ALLOCATED (vbeta)) DEALLOCATE (vbeta) IF ( ALLOCATED (fusion)) DEALLOCATE (fusion) IF ( ALLOCATED (rau)) DEALLOCATE (rau) IF ( ALLOCATED (deadleaf_cover)) DEALLOCATE (deadleaf_cover) IF ( ALLOCATED (stempdiag)) DEALLOCATE (stempdiag) IF ( ALLOCATED (co2_flux)) DEALLOCATE (co2_flux) IF ( ALLOCATED (shumdiag)) DEALLOCATE (shumdiag) IF ( ALLOCATED (litterhumdiag)) DEALLOCATE (litterhumdiag) IF ( ALLOCATED (vevapwet)) DEALLOCATE (vevapwet) IF ( ALLOCATED (transpir)) DEALLOCATE (transpir) IF ( ALLOCATED (qsintmax)) DEALLOCATE (qsintmax) IF ( ALLOCATED (rveget)) DEALLOCATE (rveget) ! 2. clear all modules CALL slowproc_clear CALL diffuco_clear CALL enerbil_clear IF ( hydrol_cwrr ) THEN CALL hydrol_clear ELSE CALL hydrolc_clear ENDIF CALL condveg_clear CALL thermosoil_clear CALL routing_clear !3. give name to next block stomate_forcing_name=forcing_name stomate_Cforcing_name=Cforcing_name END SUBROUTINE sechiba_clear !! SECHIBA's variables initialisation !! called every time step !! SUBROUTINE sechiba_var_init (kjpindex, rau, pb, temp_air) ! interface description ! input scalar INTEGER(i_std), INTENT (in) :: kjpindex !! Domain dimension ! input fields REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: pb !! Lowest level pressure REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: temp_air !! Air temperature ! output fields REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: rau !! Density ! local declaration INTEGER(i_std) :: ji ! ! initialisation ! ! ! 1. calcul of rau: air density ! DO ji = 1,kjpindex rau(ji) = pa_par_hpa * pb(ji) / (cte_molr*temp_air(ji)) END DO IF (long_print) WRITE (numout,*) ' sechiba_var_init done ' END SUBROUTINE sechiba_var_init !! !! Swap new fields to previous fields !! SUBROUTINE sechiba_end (kjpindex, dtradia, temp_sol, temp_sol_new) ! interface description ! input scalar INTEGER(i_std), INTENT (in) :: kjpindex !! Domain dimension REAL(r_std),INTENT (in) :: dtradia !! Time step in seconds ! input fields REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: temp_sol_new !! New soil temperature ! output fields REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: temp_sol !! Soil temperature ! ! swap ! temp_sol(:) = temp_sol_new(:) IF (long_print) WRITE (numout,*) ' sechiba_end done ' END SUBROUTINE sechiba_end END MODULE sechiba