source: CONFIG_DEVT/LMDZOR_V6.2_work_ENSEMBLES/modeles/ORCHIDEE/src_parameters/constantes_soil.f90 @ 5477

Last change on this file since 5477 was 5477, checked in by aclsce, 4 years ago
  • Created CONFIG_DEVT directory
  • First import of LMDZOR_V6.2_work_ENSEMBLES working configuration
File size: 12.0 KB
Line 
1! =================================================================================================================================
2! MODULE        : constantes_soil
3!
4! CONTACT       : orchidee-help _at_ listes.ipsl.fr
5!
6! LICENCE       : IPSL (2006)
7! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8!
9!>\BRIEF         "constantes_soil" module contains subroutine to initialize the parameters related to soil and hydrology.
10!!
11!!\n DESCRIPTION : "constantes_soil" module contains subroutine to initialize the parameters related to soil and hydrology.
12!!                 This module alos USE constates_soil and can therfor be used to acces the subroutines and the constantes.
13!!                 The constantes declarations can also be used seperatly with "USE constantes_soil_var".
14!!
15!! RECENT CHANGE(S):
16!!
17!! REFERENCE(S) :
18!!
19!! SVN          :
20!! $HeadURL: $
21!! $Date: $
22!! $Revision: $
23!! \n
24!_ ================================================================================================================================
25
26MODULE constantes_soil
27
28  USE constantes_soil_var
29  USE constantes
30  USE ioipsl_para 
31
32  IMPLICIT NONE
33
34CONTAINS
35
36
37!! ================================================================================================================================
38!! SUBROUTINE   : config_soil_parameters
39!!
40!>\BRIEF        This subroutine reads in the configuration file all the parameters related to soil and hydrology.
41!!
42!! DESCRIPTION  : None
43!!
44!! RECENT CHANGE(S): None
45!!
46!! MAIN OUTPUT VARIABLE(S):
47!!
48!! REFERENCE(S) :
49!!
50!! FLOWCHART    :
51!! \n
52!_ ================================================================================================================================
53
54  SUBROUTINE config_soil_parameters()
55
56    USE ioipsl
57
58    IMPLICIT NONE
59
60    !! 0. Variables and parameters declaration
61
62    !! 0.4 Local variables
63
64    INTEGER(i_std), PARAMETER      :: error_level = 3         !! Switch to 2 to turn fatal errors into warnings.(1-3, unitless)
65    LOGICAL                        :: ok_freeze               !! Local variable used to set default values for all flags
66    !! controling the soil freezing scheme
67
68    !_ ================================================================================================================================
69
70    ! Following initializations are only done for option impose_param
71    IF ( ok_sechiba .AND. impose_param ) THEN
72
73       !Config Key   = DRY_SOIL_HEAT_CAPACITY
74       !Config Desc  = Dry soil Heat capacity of soils
75       !Config If    = OK_SECHIBA
76       !Config Def   = 1.80e+6
77       !Config Help  = Values taken from : PIELKE,'MESOSCALE METEOROLOGICAL MODELING',P.384.
78       !Config Units = [J.m^{-3}.K^{-1}]
79       CALL getin_p("DRY_SOIL_HEAT_CAPACITY",so_capa_dry)
80
81       !! Check parameter value (correct range)
82       IF ( so_capa_dry <= zero ) THEN
83          CALL ipslerr_p(error_level, "config_soil_parameters.", &
84               &     "Wrong parameter value for DRY_SOIL_HEAT_CAPACITY.", &
85               &     "This parameter should be positive. ", &
86               &     "Please, check parameter value in run.def. ")
87       END IF
88
89
90       !Config Key   = DRY_SOIL_HEAT_COND
91       !Config Desc  = Dry soil Thermal Conductivity of soils
92       !Config If    = OK_SECHIBA
93       !Config Def   = 0.40
94       !Config Help  = Values taken from : PIELKE,'MESOSCALE METEOROLOGICAL MODELING',P.384.
95       !Config Units = [W.m^{-2}.K^{-1}]
96       CALL getin_p("DRY_SOIL_HEAT_COND",so_cond_dry)
97
98       !! Check parameter value (correct range)
99       IF ( so_cond_dry <= zero ) THEN
100          CALL ipslerr_p(error_level, "config_soil_parameters.", &
101               &     "Wrong parameter value for DRY_SOIL_HEAT_COND.", &
102               &     "This parameter should be positive. ", &
103               &     "Please, check parameter value in run.def. ")
104       END IF
105
106
107       !Config Key   = WET_SOIL_HEAT_CAPACITY
108       !Config Desc  = Wet soil Heat capacity of soils
109       !Config If    = OK_SECHIBA
110       !Config Def   = 3.03e+6
111       !Config Help  =
112       !Config Units = [J.m^{-3}.K^{-1}]
113       CALL getin_p("WET_SOIL_HEAT_CAPACITY",so_capa_wet)
114
115       !! Check parameter value (correct range)
116       IF ( so_capa_wet <= zero ) THEN
117          CALL ipslerr_p(error_level, "config_soil_parameters.", &
118               &     "Wrong parameter value for WET_SOIL_HEAT_CAPACITY.", &
119               &     "This parameter should be positive. ", &
120               &     "Please, check parameter value in run.def. ")
121       END IF
122
123
124       !Config Key   = WET_SOIL_HEAT_COND
125       !Config Desc  = Wet soil Thermal Conductivity of soils
126       !Config If    = OK_SECHIBA
127       !Config Def   = 1.89
128       !Config Help  =
129       !Config Units = [W.m^{-2}.K^{-1}]
130       CALL getin_p("WET_SOIL_HEAT_COND",so_cond_wet)
131
132       !! Check parameter value (correct range)
133       IF ( so_cond_wet <= zero ) THEN
134          CALL ipslerr_p(error_level, "config_soil_parameters.", &
135               &     "Wrong parameter value for WET_SOIL_HEAT_COND.", &
136               &     "This parameter should be positive. ", &
137               &     "Please, check parameter value in run.def. ")
138       END IF
139
140
141       !Config Key   = SNOW_HEAT_COND
142       !Config Desc  = Thermal Conductivity of snow
143       !Config If    = OK_SECHIBA 
144       !Config Def   = 0.3
145       !Config Help  =
146       !Config Units = [W.m^{-2}.K^{-1}]
147       CALL getin_p("SNOW_HEAT_COND",sn_cond)
148
149       !! Check
150       IF ( sn_cond <= zero ) THEN
151          CALL ipslerr_p(error_level, "config_soil_parameters.", &
152               &     "Wrong parameter value for SNOW_HEAT_COND.", &
153               &     "This parameter should be positive. ", &
154               &     "Please, check parameter value in run.def. ")
155       END IF
156
157
158       !Config Key   = SNOW_DENSITY
159       !Config Desc  = Snow density for the soil thermodynamics
160       !Config If    = OK_SECHIBA
161       !Config Def   = 330.0
162       !Config Help  =
163       !Config Units = [-]
164       CALL getin_p("SNOW_DENSITY",sn_dens)
165
166       !! Check parameter value (correct range)
167       IF ( sn_dens <= zero ) THEN
168          CALL ipslerr_p(error_level, "config_soil_parameters.", &
169               &     "Wrong parameter value for SNOW_DENSITY.", &
170               &     "This parameter should be positive. ", &
171               &     "Please, check parameter value in run.def. ")
172       END IF
173
174
175       !! Calculation of snow capacity
176       !! If sn_dens is redefined by the user, sn_capa needs to be reset
177       sn_capa = 2100.0_r_std*sn_dens
178
179
180       !Config Key   = NOBIO_WATER_CAPAC_VOLUMETRI
181       !Config Desc  =
182       !Config If    =
183       !Config Def   = 150.
184       !Config Help  =
185       !Config Units = [s/m^2]
186       CALL getin_p('NOBIO_WATER_CAPAC_VOLUMETRI',mx_eau_nobio)
187
188       !! Check parameter value (correct range)
189       IF ( mx_eau_nobio <= zero ) THEN
190          CALL ipslerr_p(error_level, "config_soil_parameters.", &
191               &     "Wrong parameter value for NOBIO_WATER_CAPAC_VOLUMETRI.", &
192               &     "This parameter should be positive. ", &
193               &     "Please, check parameter value in run.def. ")
194       END IF
195
196
197       !Config Key   = SECHIBA_QSINT
198       !Config Desc  = Interception reservoir coefficient
199       !Config If    = OK_SECHIBA
200       !Config Def   = 0.02
201       !Config Help  = Transforms leaf area index into size of interception reservoir
202       !Config         for slowproc_derivvar or stomate
203       !Config Units = [m]
204       CALL getin_p('SECHIBA_QSINT',qsintcst)
205
206       !! Check parameter value (correct range)
207       IF ( qsintcst <= zero ) THEN
208          CALL ipslerr_p(error_level, "config_soil_parameters.", &
209               &     "Wrong parameter value for SECHIBA_QSINT.", &
210               &     "This parameter should be positive. ", &
211               &     "Please, check parameter value in run.def. ")
212       END IF
213
214
215    END IF ! IF ( ok_sechiba .AND. impose_param ) THEN
216
217
218
219    !! Variables related to soil freezing in thermosoil module
220    !
221    !Config Key  = OK_FREEZE
222    !Config Desc = Activate the complet soil freezing scheme
223    !Config If   = OK_SECHIBA
224    !Config Def  = TRUE
225    !Config Help = Activate soil freezing thermal effects. Activates soil freezing hydrological effects in CWRR scheme.
226    !Config Units= [FLAG]
227
228    ! ok_freeze is a flag that controls the default values for several flags controling
229    ! the different soil freezing processes
230    ! Set ok_freeze=true for the complete soil freezing scheme
231    ! ok_freeze is a local variable only used in this subroutine
232    ok_freeze = .TRUE.
233    CALL getin_p('OK_FREEZE',ok_freeze)
234
235
236    !Config Key  = READ_REFTEMP
237    !Config Desc = Initialize soil temperature using climatological temperature
238    !Config If   =
239    !Config Def  = True/False depening on OK_FREEZE
240    !Config Help =
241    !Config Units= [FLAG]
242
243    IF (ok_freeze) THEN
244       read_reftemp = .TRUE.
245    ELSE
246       read_reftemp = .FALSE.
247    END IF
248    CALL getin_p ('READ_REFTEMP',read_reftemp)
249
250    !Config Key  = OK_FREEZE_THERMIX
251    !Config Desc = Activate thermal part of the soil freezing scheme
252    !Config If   =
253    !Config Def  = True if OK_FREEZE else false
254    !Config Help =
255    !Config Units= [FLAG]
256
257    IF (ok_freeze) THEN
258       ok_freeze_thermix = .TRUE.
259    ELSE
260       ok_freeze_thermix = .FALSE.
261    END IF
262    CALL getin_p ('OK_FREEZE_THERMIX',ok_freeze_thermix)
263
264
265    !Config Key  = OK_ECORR
266    !Config Desc = Energy correction for freezing
267    !Config If   = OK_FREEZE_THERMIX
268    !Config Def  = True if OK_FREEZE else false
269    !Config Help = Energy conservation : Correction to make sure that the same latent heat is
270    !Config        released and consumed during freezing and thawing
271    !Config Units= [FLAG]
272    IF (ok_freeze) THEN
273       ok_Ecorr = .TRUE.
274    ELSE
275       ok_Ecorr = .FALSE.
276    END IF
277    CALL getin_p ('OK_ECORR',ok_Ecorr)
278    IF (ok_Ecorr .AND. .NOT. ok_freeze_thermix) THEN
279       CALL ipslerr_p(3,'thermosoil_init','OK_ECORR cannot be activated without OK_FREEZE_THERMIX', &
280            'Adapt run parameters with OK_FREEZE_THERMIX=y','')
281    END IF
282
283    !Config Key  = OK_FREEZE_THAW_LATENT_HEAT
284    !Config Desc = Activate latent heat part of the soil freezing scheme
285    !Config If   =
286    !Config Def  = FALSE
287    !Config Help =
288    !Config Units= [FLAG]
289
290    ok_freeze_thaw_latent_heat = .FALSE.
291    CALL getin_p ('OK_FREEZE_THAW_LATENT_HEAT',ok_freeze_thaw_latent_heat)
292
293
294    !Config Key = POROS
295    !Config Desc = Soil porosity
296    !Config If = OK_SECHIBA
297    !Config Def = 0.41
298    !Config Help = From USDA classification, mean value
299    !Config Units = [-]
300    poros=0.41
301    CALL getin_p('POROS',poros)
302
303
304    !Config Key = fr_dT
305    !Config Desc = Freezing window   
306    !Config If = OK_SECHIBA
307    !Config Def = 2.0
308    !Config Help =
309    !Config Units = [K]
310    fr_dT=2.0
311    CALL getin_p('FR_DT',fr_dT)
312
313
314    !! Variables related to soil Freezing in hydrol module
315
316    !Config Key  = OK_FREEZE_CWRR
317    !Config Desc = CWRR freezing scheme by I. Gouttevin
318    !Config If   =
319    !Config Def  = True if OK_FREEZE else false
320    !Config Help =
321    !Config Units= [FLAG]
322
323    IF (ok_freeze) THEN
324       ok_freeze_cwrr = .TRUE.
325    ELSE
326       ok_freeze_cwrr = .FALSE.
327    END IF
328    CALL getin_p('OK_FREEZE_CWRR',ok_freeze_cwrr)
329
330
331    IF (ok_freeze_cwrr) THEN
332       !Config Key  = OK_THERMODYNAMICAL_FREEZING
333       !Config Desc = Calculate frozen fraction thermodynamically
334       !Config If   = OK_FREEZE_CWRR
335       !Config Def  = True
336       !Config Help = Calculate frozen fraction thermodynamically if true,
337       !Config      = else calculate frozen fraction linearly
338       !Config Units= [FLAG]
339       ok_thermodynamical_freezing = .TRUE.
340       CALL getin_p('OK_THERMODYNAMICAL_FREEZING',ok_thermodynamical_freezing)
341    END IF
342
343
344    !Config Key   = CHECK_CWRR
345    !Config Desc  = Calculate diagnostics to check CWRR water balance
346    !Config Def   = n
347    !Config If    =
348    !Config Help  = Diagnostics from module hydrol. The verifictaions are done in post-treatement
349    !Config Units = [FLAG]
350    check_cwrr = .FALSE.
351    CALL getin_p('CHECK_CWRR', check_cwrr)
352
353  END SUBROUTINE config_soil_parameters
354
355
356END MODULE constantes_soil
Note: See TracBrowser for help on using the repository browser.