Context Navigation

fonte_neige_mod.F90 @ 4559

Last change on this file since 4559 was 2946, checked in by oboucher, 7 years ago
Put under the ok_lic_cond flag the option of depositing water vapour onto snow, especially over ice sheets (lic). The default for the flag is FALSE in order to keep backward compatibility, but should be turned to TRUE in order to close the water budget. Tested in CM6.0.11.
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 13.6 KB

Line
1	!
2	! $Header$
3	!
4	MODULE fonte_neige_mod
5	!
6	! This module will treat the process of snow, melting, accumulating, calving, in
7	! case of simplified soil model.
8	!
9	!****************************************************************************************
10	USE dimphy, ONLY : klon
11	USE indice_sol_mod
12
13	IMPLICIT NONE
14	SAVE
15
16	! run_off_ter and run_off_lic are the runoff at the compressed grid knon for
17	! land and land-ice respectively
18	! Note: run_off_lic is used in mod_landice and therfore not private
19	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE :: run_off_ter
20	!$OMP THREADPRIVATE(run_off_ter)
21	REAL, ALLOCATABLE, DIMENSION(:) :: run_off_lic
22	!$OMP THREADPRIVATE(run_off_lic)
23
24	! run_off_lic_0 is the runoff at land-ice a time-step earlier, on the global 1D array grid
25	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE :: run_off_lic_0
26	!$OMP THREADPRIVATE(run_off_lic_0)
27
28	REAL, PRIVATE :: tau_calv
29	!$OMP THREADPRIVATE(tau_calv)
30	REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE :: ffonte_global
31	!$OMP THREADPRIVATE(ffonte_global)
32	REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE :: fqfonte_global
33	!$OMP THREADPRIVATE(fqfonte_global)
34	REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE :: fqcalving_global
35	!$OMP THREADPRIVATE(fqcalving_global)
36	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE :: runofflic_global
37	!$OMP THREADPRIVATE(runofflic_global)
38
39	CONTAINS
40	!
41	!****************************************************************************************
42	!
43	SUBROUTINE fonte_neige_init(restart_runoff)
44
45	! This subroutine allocates and initialize variables in the module.
46	! The variable run_off_lic_0 is initialized to the field read from
47	! restart file. The other variables are initialized to zero.
48	!
49	!****************************************************************************************
50	! Input argument
51	REAL, DIMENSION(klon), INTENT(IN) :: restart_runoff
52
53	! Local variables
54	INTEGER :: error
55	CHARACTER (len = 80) :: abort_message
56	CHARACTER (len = 20) :: modname = 'fonte_neige_init'
57
58
59	!****************************************************************************************
60	! Allocate run-off at landice and initilize with field read from restart
61	!
62	!****************************************************************************************
63
64	ALLOCATE(run_off_lic_0(klon), stat = error)
65	IF (error /= 0) THEN
66	abort_message='Pb allocation run_off_lic'
67	CALL abort_physic(modname,abort_message,1)
68	ENDIF
69	run_off_lic_0(:) = restart_runoff(:)
70
71	!****************************************************************************************
72	! Allocate other variables and initilize to zero
73	!
74	!****************************************************************************************
75	ALLOCATE(run_off_ter(klon), stat = error)
76	IF (error /= 0) THEN
77	abort_message='Pb allocation run_off_ter'
78	CALL abort_physic(modname,abort_message,1)
79	ENDIF
80	run_off_ter(:) = 0.
81
82	ALLOCATE(run_off_lic(klon), stat = error)
83	IF (error /= 0) THEN
84	abort_message='Pb allocation run_off_lic'
85	CALL abort_physic(modname,abort_message,1)
86	ENDIF
87	run_off_lic(:) = 0.
88
89	ALLOCATE(ffonte_global(klon,nbsrf))
90	IF (error /= 0) THEN
91	abort_message='Pb allocation ffonte_global'
92	CALL abort_physic(modname,abort_message,1)
93	ENDIF
94	ffonte_global(:,:) = 0.0
95
96	ALLOCATE(fqfonte_global(klon,nbsrf))
97	IF (error /= 0) THEN
98	abort_message='Pb allocation fqfonte_global'
99	CALL abort_physic(modname,abort_message,1)
100	ENDIF
101	fqfonte_global(:,:) = 0.0
102
103	ALLOCATE(fqcalving_global(klon,nbsrf))
104	IF (error /= 0) THEN
105	abort_message='Pb allocation fqcalving_global'
106	CALL abort_physic(modname,abort_message,1)
107	ENDIF
108	fqcalving_global(:,:) = 0.0
109
110	ALLOCATE(runofflic_global(klon))
111	IF (error /= 0) THEN
112	abort_message='Pb allocation runofflic_global'
113	CALL abort_physic(modname,abort_message,1)
114	ENDIF
115	runofflic_global(:) = 0.0
116
117	!****************************************************************************************
118	! Read tau_calv
119	!
120	!****************************************************************************************
121	CALL conf_interface(tau_calv)
122
123
124	END SUBROUTINE fonte_neige_init
125	!
126	!****************************************************************************************
127	!
128	SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, &
129	tsurf, precip_rain, precip_snow, &
130	snow, qsol, tsurf_new, evap)
131
132	USE indice_sol_mod
133
134	! Routine de traitement de la fonte de la neige dans le cas du traitement
135	! de sol simplifie!
136	! LF 03/2001
137	! input:
138	! knon nombre de points a traiter
139	! nisurf surface a traiter
140	! knindex index des mailles valables pour surface a traiter
141	! dtime
142	! tsurf temperature de surface
143	! precip_rain precipitations liquides
144	! precip_snow precipitations solides
145	!
146	! input/output:
147	! snow champs hauteur de neige
148	! qsol hauteur d'eau contenu dans le sol
149	! tsurf_new temperature au sol
150	! evap
151	!
152	INCLUDE "YOETHF.h"
153	INCLUDE "YOMCST.h"
154	INCLUDE "FCTTRE.h"
155	INCLUDE "clesphys.h"
156
157	! Input variables
158	!****************************************************************************************
159	INTEGER, INTENT(IN) :: knon
160	INTEGER, INTENT(IN) :: nisurf
161	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
162	REAL , INTENT(IN) :: dtime
163	REAL, DIMENSION(klon), INTENT(IN) :: tsurf
164	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain
165	REAL, DIMENSION(klon), INTENT(IN) :: precip_snow
166
167	! Input/Output variables
168	!****************************************************************************************
169
170	REAL, DIMENSION(klon), INTENT(INOUT) :: snow
171	REAL, DIMENSION(klon), INTENT(INOUT) :: qsol
172	REAL, DIMENSION(klon), INTENT(INOUT) :: tsurf_new
173	REAL, DIMENSION(klon), INTENT(INOUT) :: evap
174
175	! Local variables
176	!****************************************************************************************
177
178	INTEGER :: i, j
179	REAL :: fq_fonte
180	REAL :: coeff_rel
181	REAL, PARAMETER :: snow_max=3000.
182	REAL, PARAMETER :: max_eau_sol = 150.0
183	!! PB temporaire en attendant mieux pour le modele de neige
184	! REAL, parameter :: chasno = RLMLT/(2.3867E+06*0.15)
185	REAL, PARAMETER :: chasno = 3.334E+05/(2.3867E+06*0.15)
186	!IM cf JLD/ GKtest
187	REAL, PARAMETER :: chaice = 3.334E+05/(2.3867E+06*0.15)
188	! fin GKtest
189	REAL, DIMENSION(klon) :: ffonte
190	REAL, DIMENSION(klon) :: fqcalving, fqfonte
191	REAL, DIMENSION(klon) :: d_ts
192	REAL, DIMENSION(klon) :: bil_eau_s, snow_evap
193
194	LOGICAL :: neige_fond
195
196	!****************************************************************************************
197	! Start calculation
198	! - Initialization
199	!
200	!****************************************************************************************
201	coeff_rel = dtime/(tau_calv * rday)
202
203	bil_eau_s(:) = 0.
204
205	!****************************************************************************************
206	! - Increment snow due to precipitation and evaporation
207	! - Calculate the water balance due to precipitation and evaporation (bil_eau_s)
208	!
209	!****************************************************************************************
210	WHERE (precip_snow > 0.)
211	snow = snow + (precip_snow * dtime)
212	END WHERE
213
214	snow_evap = 0.
215
216	IF (.NOT. ok_lic_cond) THEN
217	!---only positive evaporation has an impact on snow
218	!---note that this could create a bit of water
219	!---this was the default until CMIP6
220	WHERE (evap > 0. )
221	snow_evap = MIN (snow / dtime, evap) !---one cannot evaporate more than the amount of snow
222	snow = snow - snow_evap * dtime !---snow that remains on the ground
223	snow = MAX(0.0, snow) !---just in case
224	END WHERE
225	ELSE
226	!--now considers both positive and negative evaporation in the budget of snow
227	snow_evap = MIN (snow / dtime, evap) !---one cannot evaporate more than the amount of snow
228	snow = snow - snow_evap * dtime !---snow that remains or deposits on the ground
229	snow = MAX(0.0, snow) !---just in case
230	ENDIF
231
232	bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime
233
234
235	!****************************************************************************************
236	! - Calculate melting snow
237	! - Calculate calving and decrement snow, if there are to much snow
238	! - Update temperature at surface
239	!
240	!****************************************************************************************
241
242	ffonte(:) = 0.0
243	fqcalving(:) = 0.0
244	fqfonte(:) = 0.0
245
246	DO i = 1, knon
247	! Y'a-t-il fonte de neige?
248	neige_fond = (snow(i)>epsfra .OR. nisurf==is_sic .OR. nisurf==is_lic) .AND. tsurf_new(i)>=RTT
249	IF (neige_fond) THEN
250	fq_fonte = MIN( MAX((tsurf_new(i)-RTT )/chasno,0.0),snow(i))
251	ffonte(i) = fq_fonte * RLMLT/dtime
252	fqfonte(i) = fq_fonte/dtime
253	snow(i) = MAX(0., snow(i) - fq_fonte)
254	bil_eau_s(i) = bil_eau_s(i) + fq_fonte
255	tsurf_new(i) = tsurf_new(i) - fq_fonte * chasno
256
257	!IM cf JLD OK
258	!IM cf JLD/ GKtest fonte aussi pour la glace
259	IF (nisurf == is_sic .OR. nisurf == is_lic ) THEN
260	fq_fonte = MAX((tsurf_new(i)-RTT )/chaice,0.0)
261	ffonte(i) = ffonte(i) + fq_fonte * RLMLT/dtime
262	IF ( ok_lic_melt ) THEN
263	fqfonte(i) = fqfonte(i) + fq_fonte/dtime
264	bil_eau_s(i) = bil_eau_s(i) + fq_fonte
265	ENDIF
266	tsurf_new(i) = RTT
267	ENDIF
268	d_ts(i) = tsurf_new(i) - tsurf(i)
269	ENDIF
270
271	! s'il y a une hauteur trop importante de neige, elle est ecretee
272	fqcalving(i) = MAX(0., snow(i) - snow_max)/dtime
273	snow(i)=MIN(snow(i),snow_max)
274	ENDDO
275
276	IF (nisurf == is_ter) THEN
277	DO i = 1, knon
278	qsol(i) = qsol(i) + bil_eau_s(i)
279	run_off_ter(i) = run_off_ter(i) + MAX(qsol(i) - max_eau_sol, 0.0)
280	qsol(i) = MIN(qsol(i), max_eau_sol)
281	ENDDO
282	ELSE IF (nisurf == is_lic) THEN
283	DO i = 1, knon
284	j = knindex(i)
285	!--temporal filtering
286	run_off_lic(i) = coeff_relfqcalving(i) + (1.-coeff_rel)run_off_lic_0(j)
287	run_off_lic_0(j) = run_off_lic(i)
288	!--add melting snow and liquid precip to runoff of ice cap
289	run_off_lic(i) = run_off_lic(i) + fqfonte(i) + precip_rain(i)
290	ENDDO
291	ENDIF
292
293	!****************************************************************************************
294	! Save ffonte, fqfonte and fqcalving in global arrays for each
295	! sub-surface separately
296	!
297	!****************************************************************************************
298	DO i = 1, knon
299	ffonte_global(knindex(i),nisurf) = ffonte(i)
300	fqfonte_global(knindex(i),nisurf) = fqfonte(i)
301	fqcalving_global(knindex(i),nisurf) = fqcalving(i)
302	ENDDO
303
304	IF (nisurf == is_lic) THEN
305	DO i = 1, knon
306	runofflic_global(knindex(i)) = run_off_lic(i)
307	ENDDO
308	ENDIF
309
310	END SUBROUTINE fonte_neige
311	!
312	!****************************************************************************************
313	!
314	SUBROUTINE fonte_neige_final(restart_runoff)
315	!
316	! This subroutine returns run_off_lic_0 for later writing to restart file.
317	!
318	!****************************************************************************************
319	REAL, DIMENSION(klon), INTENT(OUT) :: restart_runoff
320
321	!****************************************************************************************
322	! Set the output variables
323	restart_runoff(:) = run_off_lic_0(:)
324
325	! Deallocation of all varaibles in the module
326	! DEALLOCATE(run_off_lic_0, run_off_ter, run_off_lic, ffonte_global, &
327	! fqfonte_global, fqcalving_global)
328
329	IF (ALLOCATED(run_off_lic_0)) DEALLOCATE(run_off_lic_0)
330	IF (ALLOCATED(run_off_ter)) DEALLOCATE(run_off_ter)
331	IF (ALLOCATED(run_off_lic)) DEALLOCATE(run_off_lic)
332	IF (ALLOCATED(ffonte_global)) DEALLOCATE(ffonte_global)
333	IF (ALLOCATED(fqfonte_global)) DEALLOCATE(fqfonte_global)
334	IF (ALLOCATED(fqcalving_global)) DEALLOCATE(fqcalving_global)
335	IF (ALLOCATED(runofflic_global)) DEALLOCATE(runofflic_global)
336
337	END SUBROUTINE fonte_neige_final
338	!
339	!****************************************************************************************
340	!
341	SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, &
342	fqfonte_out, ffonte_out, run_off_lic_out)
343
344
345	! Cumulate ffonte, fqfonte and fqcalving respectively for
346	! all type of surfaces according to their fraction.
347	!
348	! This routine is called from physiq.F before histwrite.
349	!****************************************************************************************
350
351	USE indice_sol_mod
352
353	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
354
355	REAL, DIMENSION(klon), INTENT(OUT) :: fqcalving_out
356	REAL, DIMENSION(klon), INTENT(OUT) :: fqfonte_out
357	REAL, DIMENSION(klon), INTENT(OUT) :: ffonte_out
358	REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_out
359
360	INTEGER :: nisurf
361	!****************************************************************************************
362
363	ffonte_out(:) = 0.0
364	fqfonte_out(:) = 0.0
365	fqcalving_out(:) = 0.0
366
367	DO nisurf = 1, nbsrf
368	ffonte_out(:) = ffonte_out(:) + ffonte_global(:,nisurf)*pctsrf(:,nisurf)
369	fqfonte_out(:) = fqfonte_out(:) + fqfonte_global(:,nisurf)*pctsrf(:,nisurf)
370	fqcalving_out(:) = fqcalving_out(:) + fqcalving_global(:,nisurf)*pctsrf(:,nisurf)
371	ENDDO
372
373	run_off_lic_out(:)=runofflic_global(:)
374
375	END SUBROUTINE fonte_neige_get_vars
376	!
377	!****************************************************************************************
378	!
379	END MODULE fonte_neige_mod

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

Download in other formats:

Original Format