Context Navigation

source: branches/ORCHIDEE_2_2/ORCHIDEE/src_sechiba/routing_native.f90 @ 8504

Last change on this file since 8504 was 8504, checked in by josefine.ghattas, 2 months ago
Integrated correction done in the trunk [8503] for compilation without XIOS.
File size: 27.4 KB

Line
1	! =================================================================================================================================
2	! MODULE : routing_simple
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 This module routes the water over the continents into the oceans and computes the water
10	!! stored in floodplains or taken for irrigation.
11	!!
12	!!\n DESCRIPTION: The subroutines in this subroutine is only called when ROUTING_METHOD=simple is set in run.def.
13	!! The method can be used for regular latitude-longitude grid or for unstructured grid.
14	!!
15	!! RECENT CHANGE(S): None
16	!!
17	!! REFERENCE(S) :
18	!!
19	!! SVN :
20	!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/perso/pedro.arboleda/ORCHIDEE/src_sechiba/routing_simple.f90 $
21	!! $Date: 2022-06-07 19:03:47 +0200 (Tue, 07 Jun 2022) $
22	!! $Revision: 7644 $
23	!! \n
24	!_ ================================================================================================================================
25
26
27
28	! Histoire Salee
29	!---------------
30	! La douce riviere
31	! Sortant de son lit
32	! S'est jetee ma chere
33	! dans les bras mais oui
34	! du beau fleuve
35	!
36	! L'eau coule sous les ponts
37	! Et puis les flots s'emeuvent
38	! - N'etes vous pas au courant ?
39	! Il parait que la riviere
40	! Va devenir mer
41	! Roland Bacri
42	!
43
44
45	MODULE routing_native_mod
46	#ifdef XIOS
47	USE ioipsl
48	USE xios_orchidee
49	USE ioipsl_para
50	USE constantes
51	USE constantes_soil
52	USE pft_parameters
53	USE sechiba_io_p
54	USE interpol_help
55	USE grid
56	USE mod_orchidee_para
57
58
59	IMPLICIT NONE
60	PRIVATE
61	PUBLIC :: routing_native_main, routing_native_xios_initialize
62	PUBLIC :: routing_native_initialize, routing_native_finalize, routing_native_clear
63
64	REAL,SAVE :: dt_routing
65	!$OMP THREADPRIVATE(dt_routing)
66
67	INTEGER,SAVE :: nbpt
68	!$OMP THREADPRIVATE(nbpt)
69
70	INTEGER,SAVE :: nbpt_r
71	!$OMP THREADPRIVATE(nbpt_r)
72
73	LOGICAL,SAVE :: dofloodinfilt
74	!$OMP THREADPRIVATE(dofloodinfilt)
75
76	LOGICAL,SAVE :: doswamps
77	!$OMP THREADPRIVATE(doswamps)
78
79	LOGICAL,SAVE :: doponds
80	!$OMP THREADPRIVATE(doponds)
81
82
83	REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: returnflow_mean !! Mean water flow from lakes and swamps which returns to the grid box.
84	!$OMP THREADPRIVATE(returnflow_mean)
85
86	REAL, SAVE :: time_counter = 0
87	!$OMP THREADPRIVATE(time_counter)
88
89	CONTAINS
90
91	!! =============================================================================================================================
92	!! SUBROUTINE: routing_native_xios_initialize
93	!!
94	!>\BRIEF Initialize xios dependant defintion before closing context defintion
95	!!
96	!! DESCRIPTION: Initialize xios dependant defintion before closing context defintion.
97	!! This subroutine is called before the xios context is closed.
98	!!
99	!! RECENT CHANGE(S): None
100	!!
101	!! REFERENCE(S): None
102	!!
103	!! FLOWCHART: None
104	!! \n
105	!_ ==============================================================================================================================
106
107	SUBROUTINE routing_native_xios_initialize
108	USE xios
109	USE routing_native_flow_mod
110	IMPLICIT NONE
111
112	CALL xios_set_field_attr("basinmap",enabled=.FALSE.)
113	CALL xios_set_field_attr("nbrivers",enabled=.FALSE.)
114	CALL xios_set_field_attr("riversret",enabled=.FALSE.)
115	CALL xios_set_field_attr("hydrographs",enabled=.TRUE.)
116	CALL xios_set_field_attr("htuhgmon",enabled=.FALSE.)
117	CALL xios_set_field_attr("fastr",enabled=.TRUE.)
118	CALL xios_set_field_attr("slowr",enabled=.TRUE.)
119	CALL xios_set_field_attr("streamr",enabled=.TRUE.)
120	CALL xios_set_field_attr("laker",enabled=.FALSE.)
121	CALL xios_set_field_attr("lake_overflow",enabled=.FALSE.)
122	CALL xios_set_field_attr("mask_coast",enabled=.FALSE.)
123	CALL xios_set_field_attr("pondr",enabled=.FALSE.)
124	CALL xios_set_field_attr("floodr",enabled=.FALSE.)
125	CALL xios_set_field_attr("slowflow",enabled=.FALSE.)
126	CALL xios_set_field_attr("delfastr",enabled=.FALSE.)
127	CALL xios_set_field_attr("delslowr",enabled=.FALSE.)
128	CALL xios_set_field_attr("delstreamr",enabled=.FALSE.)
129	CALL xios_set_field_attr("dellaker",enabled=.FALSE.)
130	CALL xios_set_field_attr("delpondr",enabled=.FALSE.)
131	CALL xios_set_field_attr("delfloodr",enabled=.FALSE.)
132	CALL xios_set_field_attr("irrigmap",enabled=.FALSE.)
133	CALL xios_set_field_attr("swampmap",enabled=.FALSE.)
134	CALL xios_set_field_attr("wbr_stream",enabled=.FALSE.)
135	CALL xios_set_field_attr("wbr_fast",enabled=.FALSE.)
136	CALL xios_set_field_attr("wbr_slow",enabled=.FALSE.)
137	CALL xios_set_field_attr("wbr_lake",enabled=.FALSE.)
138	CALL xios_set_field_attr("reinfiltration",enabled=.FALSE.)
139	CALL xios_set_field_attr("irrigation",enabled=.FALSE.)
140	CALL xios_set_field_attr("netirrig",enabled=.FALSE.)
141	CALL xios_set_field_attr("SurfStor",enabled=.FALSE.)
142	CALL xios_set_field_attr("htutempmon",enabled=.FALSE.)
143	CALL xios_set_field_attr("streamlimit",enabled=.FALSE.)
144	CALL xios_set_field_attr("StreamT_TotTend",enabled=.FALSE.)
145	CALL xios_set_field_attr("StreamT_AdvTend",enabled=.FALSE.)
146	CALL xios_set_field_attr("StreamT_RelTend",enabled=.FALSE.)
147
148	CALL routing_flow_xios_initialize
149
150
151	END SUBROUTINE routing_native_xios_initialize
152
153
154
155
156
157
158
159	!! =============================================================================================================================
160	!! SUBROUTINE: routing_simple_initialize
161	!!
162	!>\BRIEF Initialize the routing_simple module
163	!!
164	!! DESCRIPTION: Initialize the routing_simple module. Read from restart file or read the routing.nc file to initialize the
165	!! routing scheme.
166	!!
167	!! RECENT CHANGE(S)
168	!!
169	!! REFERENCE(S)
170	!!
171	!! FLOWCHART
172	!! \n
173	!_ ==============================================================================================================================
174
175	SUBROUTINE routing_native_initialize( kjit, nbpt, index, &
176	rest_id, hist_id, hist2_id, lalo, &
177	neighbours, resolution, contfrac, stempdiag, &
178	returnflow, reinfiltration, irrigation, riverflow, &
179	coastalflow, flood_frac, flood_res , irrigated_next)
180
181	USE routing_native_flow_mod, ONLY : routing_flow_initialize
182	USE routing_native_irrig_mod, ONLY : irrigation_initialize
183	USE routing_native_lake_mod, ONLY : routing_lake_initialize
184	USE routing_native_para, ONLY: routing_para_initialize
185	IMPLICIT NONE
186
187	!! 0 Variable and parameter description
188	!! 0.1 Input variables
189	INTEGER(i_std), INTENT(in) :: kjit !! Time step number (unitless)
190	INTEGER(i_std), INTENT(in) :: nbpt !! Domain size (unitless)
191	INTEGER(i_std), INTENT(in) :: index(nbpt) !! Indices of the points on the map (unitless)
192	INTEGER(i_std),INTENT(in) :: rest_id !! Restart file identifier (unitless)
193	INTEGER(i_std),INTENT(in) :: hist_id !! Access to history file (unitless)
194	INTEGER(i_std),INTENT(in) :: hist2_id !! Access to history file 2 (unitless)
195	REAL(r_std), INTENT(in) :: lalo(nbpt,2) !! Vector of latitude and longitudes (beware of the order !)
196
197	INTEGER(i_std), INTENT(in) :: neighbours(nbpt,8) !! Vector of neighbours for each grid point
198	!! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) (unitless)
199	REAL(r_std), INTENT(in) :: resolution(nbpt,2) !! The size of each grid box in X and Y (m)
200	REAL(r_std), INTENT(in) :: contfrac(nbpt) !! Fraction of land in each grid box (unitless;0-1)
201	REAL(r_std), INTENT(in) :: stempdiag(nbpt,nslm) !! Diagnostic soil temperature profile
202
203	!! 0.2 Output variables
204	REAL(r_std), INTENT(out) :: returnflow(nbpt) !! The water flow from lakes and swamps which returns to the grid box.
205	!! This water will go back into the hydrol or hydrolc module to allow re-evaporation (kg/m^2/dt)
206	REAL(r_std), INTENT(out) :: reinfiltration(nbpt) !! Water flow from ponds and floodplains which returns to the grid box (kg/m^2/dt)
207	REAL(r_std), INTENT(out) :: irrigation(nbpt) !! Irrigation flux. This is the water taken from the reservoirs and beeing put into the upper layers of the soil (kg/m^2/dt)
208	REAL(r_std), INTENT(out) :: riverflow(nbpt) !! Outflow of the major rivers. The flux will be located on the continental grid but this should be a coastal point (kg/dt)
209
210	REAL(r_std), INTENT(out) :: coastalflow(nbpt) !! Outflow on coastal points by small basins. This is the water which flows in a disperse way into the ocean (kg/dt)
211	REAL(r_std), INTENT(out) :: flood_frac(nbpt) !! Flooded fraction of the grid box (unitless;0-1)
212	REAL(r_std), INTENT(out) :: flood_res(nbpt) !! Diagnostic of water amount in the floodplains reservoir (kg)
213	REAL(r_std), INTENT(in) :: irrigated_next (nbpt) !! Dynamic irrig. area, calculated in slowproc and passed to routing!
214
215	!_ ================================================================================================================================
216
217
218	CALL routing_para_initialize
219	CALL routing_native_init_local(kjit, rest_id, nbpt, contfrac)
220	CALL routing_flow_initialize(kjit, rest_id, nbpt, dt_routing, contfrac, nbpt_r, riverflow, coastalflow)
221	CALL routing_lake_initialize(kjit, rest_id, nbpt, contfrac)
222	CALL irrigation_initialize(kjit, rest_id, nbpt, nbpt_r,irrigated_next )
223
224	reinfiltration(:)=0
225	irrigation(:)=0
226	flood_frac(:)=0
227	flood_res(:)=0
228	returnflow(:)=returnflow_mean(:)
229
230	END SUBROUTINE routing_native_initialize
231
232
233	!! ================================================================================================================================
234	!! SUBROUTINE : routing_simple_initialize
235	!!
236	!>\BRIEF This subroutine allocates the memory and get the fixed fields from the restart file.
237	!!
238	!! DESCRIPTION: Privat subroutine to the module routing_simple. This subroutine is called in the begining
239	!! of routing_simple_initialize
240	!!
241	!! RECENT CHANGE(S): None
242	!!
243	!! MAIN OUTPUT VARIABLE(S):
244	!!
245	!! REFERENCES : None
246	!!
247	!! FLOWCHART :None
248	!! \n
249	!_ ================================================================================================================================
250
251	SUBROUTINE routing_native_init_local(kjit, rest_id, nbpt_, contfrac)
252	USE time, ONLY : dt_sechiba
253	USE routing_native_flow_mod
254	IMPLICIT NONE
255	INTEGER(i_std),INTENT(in) :: kjit
256	INTEGER(i_std),INTENT(in) :: rest_id !! Restart file identifier (unitless)
257	INTEGER,INTENT(in) :: nbpt_ !! nb points native grid
258	REAL,INTENT(in) :: contfrac(nbpt) !! fraction of land
259
260	INTEGER :: ier
261	CHARACTER(LEN=80) :: var_name !! To store variables names for I/O (unitless)
262
263	REAL(r_std) ::ratio
264
265	nbpt = nbpt_
266
267	ALLOCATE (returnflow_mean(nbpt), stat=ier)
268	IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for returnflow_mean','','')
269	var_name = 'returnflow'
270	CALL ioconf_setatt_p('UNITS', 'Kg/m^2/dt')
271	CALL ioconf_setatt_p('LONG_NAME','Deep return flux')
272	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., returnflow_mean, "gather", nbp_glo, index_g)
273	CALL setvar_p (returnflow_mean, val_exp, 'NO_KEYWORD', zero)
274
275	!_ ================================================================================================================================
276	!
277	!
278	! These variables will require the configuration infrastructure
279	!
280	!Config Key = DT_ROUTING
281	!Config If = RIVER_ROUTING
282	!Config Desc = Time step of the routing scheme
283	!Config Def = one_day
284	!Config Help = This values gives the time step in seconds of the routing scheme.
285	!Config It should be multiple of the main time step of ORCHIDEE. One day
286	!Config is a good value.
287	!Config Units = [seconds]
288	!
289	dt_routing = one_day
290	CALL getin_p('DT_ROUTING', dt_routing)
291
292	!
293	!Config Key = DO_FLOODINFILT
294	!Config Desc = Should floodplains reinfiltrate into the soil
295	!Config If = RIVER_ROUTING
296	!Config Def = n
297	!Config Help = This parameters allows the user to ask the model
298	!Config to take into account the flood plains reinfiltration
299	!Config into the soil moisture. It then can go
300	!Config back to the slow and fast reservoirs
301	!Config Units = [FLAG]
302	!
303	dofloodinfilt = .FALSE.
304	CALL getin_p('DO_FLOODINFILT', dofloodinfilt)
305	!
306	!Config Key = DO_SWAMPS
307	!Config Desc = Should we include swamp parameterization
308	!Config If = RIVER_ROUTING
309	!Config Def = n
310	!Config Help = This parameters allows the user to ask the model
311	!Config to take into account the swamps and return
312	!Config the water into the bottom of the soil. It then can go
313	!Config back to the atmopshere. This tried to simulate
314	!Config internal deltas of rivers.
315	!Config Units = [FLAG]
316	!
317	doswamps = .FALSE.
318	CALL getin_p('DO_SWAMPS', doswamps)
319	!
320	!Config Key = DO_PONDS
321	!Config Desc = Should we include ponds
322	!Config If = RIVER_ROUTING
323	!Config Def = n
324	!Config Help = This parameters allows the user to ask the model
325	!Config to take into account the ponds and return
326	!Config the water into the soil moisture. It then can go
327	!Config back to the atmopshere. This tried to simulate
328	!Config little ponds especially in West Africa.
329	!Config Units = [FLAG]
330	!
331	doponds = .FALSE.
332	CALL getin_p('DO_PONDS', doponds)
333
334	ratio = dt_routing/dt_sechiba
335	IF ( ABS(NINT(ratio) - ratio) .GT. 10*EPSILON(ratio)) THEN
336	WRITE(numout,*) 'WARNING -- WARNING -- WARNING -- WARNING'
337	WRITE(numout,*) "The chosen time step for the routing is not a multiple of the"
338	WRITE(numout,*) "main time step of the model. We will change dt_routing so that"
339	WRITE(numout,*) "this condition os fulfilled"
340	dt_routing = NINT(ratio) * dt_sechiba
341	WRITE(numout,*) 'THE NEW DT_ROUTING IS : ', dt_routing
342	ENDIF
343	!
344	IF ( dt_routing .LT. dt_sechiba) THEN
345	WRITE(numout,*) 'WARNING -- WARNING -- WARNING -- WARNING'
346	WRITE(numout,*) 'The routing timestep can not be smaller than the one'
347	WRITE(numout,*) 'of the model. We reset its value to the model''s timestep.'
348	WRITE(numout,*) 'The old DT_ROUTING is : ', dt_routing
349	dt_routing = dt_sechiba
350	WRITE(numout,*) 'THE NEW DT_ROUTING IS : ', dt_routing
351	ENDIF
352
353	END SUBROUTINE routing_native_init_local
354
355
356
357	!! ================================================================================================================================
358	!! SUBROUTINE : routing_simple_main
359	!!
360	!>\BRIEF This module routes the water over the continents (runoff and
361	!! drainage produced by the hydrolc or hydrol module) into the oceans.
362	!!
363	!! DESCRIPTION (definitions, functional, design, flags):
364	!! The routing scheme (Polcher, 2003) carries the water from the runoff and drainage simulated by SECHIBA
365	!! to the ocean through reservoirs, with some delay. The routing scheme is based on
366	!! a parametrization of the water flow on a global scale (Miller et al., 1994; Hagemann
367	!! and Dumenil, 1998). Given the global map of the main watersheds (Oki et al., 1999;
368	!! Fekete et al., 1999; Vorosmarty et al., 2000) which delineates the boundaries of subbasins
369	!! and gives the eight possible directions of water flow within the pixel, the surface
370	!! runoff and the deep drainage are routed to the ocean. The time-step of the routing is one day.
371	!! The scheme also diagnoses how much water is retained in the foodplains and thus return to soil
372	!! moisture or is taken out of the rivers for irrigation. \n
373	!!
374	!! RECENT CHANGE(S): None
375	!!
376	!! MAIN OUTPUT VARIABLE(S):
377	!! The result of the routing are 3 fluxes :
378	!! - riverflow : The water which flows out from the major rivers. The flux will be located
379	!! on the continental grid but this should be a coastal point.
380	!! - coastalflow : This is the water which flows in a disperse way into the ocean. Essentially these
381	!! are the outflows from all of the small rivers.
382	!! - returnflow : This is the water which flows into a land-point - typically rivers which end in
383	!! the desert. This water will go back into the hydrol module to allow re-evaporation.
384	!! - irrigation : This is water taken from the reservoir and is being put into the upper
385	!! layers of the soil.
386	!! The two first fluxes are in kg/dt and the last two fluxes are in kg/(m^2dt).\n
387	!!
388	!! REFERENCE(S) :
389	!! - Miller JR, Russell GL, Caliri G (1994)
390	!! Continental-scale river flow in climate models.
391	!! J. Clim., 7:914-928
392	!! - Hagemann S and Dumenil L. (1998)
393	!! A parametrization of the lateral waterflow for the global scale.
394	!! Clim. Dyn., 14:17-31
395	!! - Oki, T., T. Nishimura, and P. Dirmeyer (1999)
396	!! Assessment of annual runoff from land surface models using total runoff integrating pathways (TRIP)
397	!! J. Meteorol. Soc. Jpn., 77, 235-255
398	!! - Fekete BM, Charles V, Grabs W (2000)
399	!! Global, composite runoff fields based on observed river discharge and simulated water balances.
400	!! Technical report, UNH/GRDC, Global Runoff Data Centre, Koblenz
401	!! - Vorosmarty, C., B. Fekete, B. Meybeck, and R. Lammers (2000)
402	!! Global system of rivers: Its role in organizing continental land mass and defining land-to-ocean linkages
403	!! Global Biogeochem. Cycles, 14, 599-621
404	!! - Vivant, A-C. (?? 2002)
405	!! DÃ©veloppement du schÃ©ma de routage et des plaines d'inondation, MSc Thesis, Paris VI University
406	!! - J. Polcher (2003)
407	!! Les processus de surface a l'echelle globale et leurs interactions avec l'atmosphere
408	!! Habilitation a diriger les recherches, Paris VI University, 67pp.
409	!!
410	!! FLOWCHART :
411	!! \latexonly
412	!! \includegraphics[scale=0.75]{routing_main_flowchart.png}
413	!! \endlatexonly
414	!! \n
415	!_ ================================================================================================================================
416
417
418	SUBROUTINE routing_native_main(kjit, nbpt, index, &
419	lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, floodout, runoff, &
420	drainage, transpot, precip_rain, humrel, k_litt, flood_frac, flood_res, &
421	stempdiag, reinf_slope, returnflow, reinfiltration, irrigation, riverflow, coastalflow, &
422	rest_id, hist_id, hist2_id ,&
423	soiltile, root_deficit, irrigated_next, irrig_frac, fraction_aeirrig_sw)
424
425	USE routing_native_flow_mod,ONLY : routing_flow_make_mean, routing_flow_main, riverflow_mean, coastalflow_mean, lakeinflow_mean, &
426	routing_flow_get, routing_flow_set, routing_flow_diags
427	USE routing_native_irrig_mod, ONLY: irrigation_mean_make, irrigation_main, irrigation_get
428	USE routing_native_lake_mod, ONLY: routing_lake_mean_make, routing_lake_route_coast, routing_lake_main
429	USE routing_native_para, ONLY: routing_para_initialize
430	USE xios
431	IMPLICIT NONE
432
433	!! 0 Variable and parameter description
434	!! 0.1 Input variables
435
436	INTEGER(i_std), INTENT(in) :: kjit !! Time step number (unitless)
437	INTEGER(i_std), INTENT(in) :: nbpt !! Domain size (unitless)
438	INTEGER(i_std),INTENT(in) :: rest_id !! Restart file identifier (unitless)
439	INTEGER(i_std),INTENT(in) :: hist_id !! Access to history file (unitless)
440	INTEGER(i_std),INTENT(in) :: hist2_id !! Access to history file 2 (unitless)
441	INTEGER(i_std), INTENT(in) :: index(nbpt) !! Indices of the points on the map (unitless)
442	REAL(r_std), INTENT(in) :: lalo(nbpt,2) !! Vector of latitude and longitudes (beware of the order !)
443	INTEGER(i_std), INTENT(in) :: neighbours(nbpt,8) !! Vector of neighbours for each grid point (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) (unitless)
444	REAL(r_std), INTENT(in) :: resolution(nbpt,2) !! The size of each grid box in X and Y (m)
445	REAL(r_std), INTENT(in) :: contfrac(nbpt) !! Fraction of land in each grid box (unitless;0-1)
446	REAL(r_std), INTENT(in) :: totfrac_nobio(nbpt) !! Total fraction of no-vegetation (continental ice, lakes ...) (unitless;0-1)
447	REAL(r_std), INTENT(in) :: veget_max(nbpt,nvm) !! Maximal fraction of vegetation (unitless;0-1)
448	REAL(r_std), INTENT(in) :: floodout(nbpt) !! Grid-point flow out of floodplains (kg/m^2/dt)
449	REAL(r_std), INTENT(in) :: runoff(nbpt) !! Grid-point runoff (kg/m^2/dt)
450	REAL(r_std), INTENT(in) :: drainage(nbpt) !! Grid-point drainage (kg/m^2/dt)
451	REAL(r_std), INTENT(in) :: transpot(nbpt,nvm) !! Potential transpiration of the vegetation (kg/m^2/dt)
452	REAL(r_std), INTENT(in) :: precip_rain(nbpt) !! Rainfall (kg/m^2/dt)
453	REAL(r_std), INTENT(in) :: k_litt(nbpt) !! Averaged conductivity for saturated infiltration in the 'litter' layer (kg/m^2/dt)
454	REAL(r_std), INTENT(in) :: humrel(nbpt,nvm) !! Soil moisture stress, root extraction potential (unitless)
455	REAL(r_std), INTENT(in) :: stempdiag(nbpt,nslm) !! Diagnostic soil temperature profile
456	REAL(r_std), INTENT(in) :: reinf_slope(nbpt) !! Coefficient which determines the reinfiltration ratio in the grid box due to flat areas (unitless;0-1)
457	REAL(r_std), INTENT(in) :: root_deficit(nbpt) !! soil water deficit
458	REAL(r_std), INTENT(in) :: soiltile(nbpt,nstm) !! Fraction of each soil tile within vegtot (0-1, unitless)
459	REAL(r_std), INTENT(in) :: irrig_frac(nbpt) !! Irrig. fraction interpolated in routing, and saved to pass to slowproc if irrigated_soiltile = .TRUE.
460	REAL(r_std), INTENT(in) :: irrigated_next (nbpt)!! Dynamic irrig. area, calculated in slowproc and passed to routing
461	REAL(r_std), INTENT(in) :: fraction_aeirrig_sw(nbpt) !! Fraction of area equipped for irrigation from surface water, of irrig_frac
462
463	!! 0.2 Output variables
464	REAL(r_std), INTENT(out) :: returnflow(nbpt) !! The water flow from lakes and swamps which returns to the grid box.
465	!! This water will go back into the hydrol or hydrolc module to allow re-evaporation (kg/m^2/dt)
466	REAL(r_std), INTENT(out) :: reinfiltration(nbpt) !! Water flow from ponds and floodplains which returns to the grid box (kg/m^2/dt)
467	REAL(r_std), INTENT(out) :: irrigation(nbpt) !! Irrigation flux. This is the water taken from the reservoirs and beeing put into the upper layers of the soil (kg/m^2/dt)
468	REAL(r_std), INTENT(out) :: riverflow(nbpt) !! Outflow of the major rivers. The flux will be located on the continental grid but this should be a coastal point (kg/dt)
469	REAL(r_std), INTENT(out) :: coastalflow(nbpt) !! Outflow on coastal points by small basins. This is the water which flows in a disperse way into the ocean (kg/dt)
470	REAL(r_std), INTENT(out) :: flood_frac(nbpt) !! Flooded fraction of the grid box (unitless;0-1)
471	REAL(r_std), INTENT(out) :: flood_res(nbpt) !! Diagnostic of water amount in the floodplains reservoir (kg)
472
473	!! 0.3 Local variables
474	REAL(r_std), DIMENSION(nbpt) :: return_lakes !! Water from lakes flowing back into soil moisture (kg/m^2/dt)
475	REAL(r_std) :: lakeinflow(nbpt)
476
477
478	CALL routing_flow_make_mean(runoff, drainage)
479	CALL irrigation_mean_make(dt_routing, veget_max, humrel, transpot, runoff , precip_rain)
480	CALL routing_lake_mean_make(dt_routing, humrel, veget_max)
481
482	time_counter = time_counter + dt_sechiba
483
484	reinfiltration(:)= 0 ! for now
485
486	! If the time has come we do the routing.
487	IF ( NINT(time_counter) .GE. NINT(dt_routing) ) THEN
488	returnflow_mean(:)=0
489
490	CALL routing_flow_main(dt_routing, contfrac)
491
492	CALL routing_flow_get(coastalflow_mean=coastalflow)
493	CALL routing_lake_route_coast(contfrac,coastalflow)
494	CALL routing_flow_set(coastalflow_mean=coastalflow)
495
496	CALL irrigation_main( dt_routing, contfrac, reinfiltration, irrigated_next, irrig_frac, root_deficit, soiltile, &
497	fraction_aeirrig_sw )
498
499	CALL routing_flow_get(lakeinflow_mean=lakeinflow)
500	CALL routing_lake_main(dt_routing, contfrac, lakeinflow, return_lakes)
501	CALL routing_flow_set(lakeinflow_mean=lakeinflow)
502
503	returnflow_mean(:)=returnflow_mean(:)+return_lakes(:)
504
505	time_counter = 0
506	ENDIF
507
508	CALL routing_flow_get(riverflow_mean=riverflow, coastalflow_mean=coastalflow, lakeinflow_mean=lakeinflow)
509	CALL irrigation_get(irrigation_mean=irrigation)
510
511
512	CALL routing_flow_diags(dt_sechiba) ! output routing flow diagnostics on orchidee grid
513
514	returnflow = returnflow/dt_routing*dt_sechiba
515	riverflow = riverflow/dt_routing*dt_sechiba
516	coastalflow = coastalflow/dt_routing*dt_sechiba
517	irrigation = irrigation/dt_routing*dt_sechiba
518
519	CALL xios_orchidee_send_field("irrigation", irrigation/dt_sechiba)
520
521	returnflow(:) = 0
522	reinfiltration(:) =0
523	flood_frac(:) = 0
524	flood_res(:) = 0
525
526	END SUBROUTINE routing_native_main
527
528	!! =============================================================================================================================
529	!! SUBROUTINE: routing_simple_finalize
530	!!
531	!>\BRIEF Write to restart file
532	!!
533	!! DESCRIPTION: Write module variables to restart file
534	!!
535	!! RECENT CHANGE(S)
536	!!
537	!! REFERENCE(S)
538	!!
539	!! FLOWCHART
540	!! \n
541	!_ ==============================================================================================================================
542
543	SUBROUTINE routing_native_finalize(kjit, nbpt_, rest_id, flood_frac, flood_res )
544	USE routing_native_flow_mod
545	USE routing_native_lake_mod
546	USE routing_native_irrig_mod
547	IMPLICIT NONE
548	INTEGER, INTENT(IN) :: kjit
549	INTEGER,INTENT(IN) :: nbpt_
550	INTEGER, INTENT(IN) :: rest_id
551	REAL(r_std), INTENT(in) :: flood_frac(nbpt) !! Flooded fraction of the grid box (unitless;0-1)
552	REAL(r_std), INTENT(in) :: flood_res(nbpt) !! Diagnostic of water amount in the floodplains reservoir (kg)
553
554	CALL routing_native_local_finalize(kjit, rest_id)
555	CALL routing_flow_finalize(kjit, rest_id)
556	CALL routing_lake_finalize(kjit, rest_id)
557	CALL irrigation_finalize(kjit, rest_id)
558
559	END SUBROUTINE routing_native_finalize
560
561	SUBROUTINE routing_native_local_finalize(kjit,rest_id)
562	USE ioipsl_para
563	USE grid
564	IMPLICIT NONE
565	INTEGER, INTENT(IN) :: kjit
566	INTEGER, INTENT(IN) :: rest_id
567
568	CALL restput_p (rest_id, 'returnflow', nbp_glo, 1, 1, kjit, returnflow_mean, 'scatter', nbp_glo, index_g)
569	DEALLOCATE(returnflow_mean)
570
571	END SUBROUTINE routing_native_local_finalize
572
573
574	SUBROUTINE routing_native_clear
575	USE xios
576	IMPLICIT NONE
577
578
579
580	END SUBROUTINE routing_native_clear
581	#endif
582	END MODULE routing_native_mod

Note: See TracBrowser for help on using the repository browser.

Download in other formats: