Context Navigation

fonte_neige_mod.F90 @ 5282

Last change on this file since 5282 was 5282, checked in by abarral, 6 hours ago
Turn iniprint.h clesphys.h into modules Remove unused description.h
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:keywords set to `Author Date Id Revision`
File size: 24.7 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(:,:) :: ffonte_global
31	!$OMP THREADPRIVATE(ffonte_global)
32	REAL, ALLOCATABLE, DIMENSION(:,:) :: fqfonte_global
33	!$OMP THREADPRIVATE(fqfonte_global)
34	REAL, ALLOCATABLE, DIMENSION(:,:) :: fqcalving_global
35	!$OMP THREADPRIVATE(fqcalving_global)
36	REAL, ALLOCATABLE, DIMENSION(:) :: runofflic_global
37	!$OMP THREADPRIVATE(runofflic_global)
38	#ifdef ISO
39	REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE :: xtrun_off_ter
40	!$OMP THREADPRIVATE(xtrun_off_ter)
41	REAL, ALLOCATABLE, DIMENSION(:,:) :: xtrun_off_lic
42	!$OMP THREADPRIVATE(xtrun_off_lic)
43	REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE :: xtrun_off_lic_0
44	!$OMP THREADPRIVATE(xtrun_off_lic_0)
45	REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE:: fxtfonte_global
46	!$OMP THREADPRIVATE(fxtfonte_global)
47	REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE:: fxtcalving_global
48	!$OMP THREADPRIVATE(fxtcalving_global)
49	REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE :: xtrunofflic_global
50	!$OMP THREADPRIVATE(xtrunofflic_global)
51	#endif
52
53	CONTAINS
54	!
55	!****************************************************************************************
56	!
57	SUBROUTINE fonte_neige_init(restart_runoff)
58
59	! This subroutine allocates and initialize variables in the module.
60	! The variable run_off_lic_0 is initialized to the field read from
61	! restart file. The other variables are initialized to zero.
62	!
63	!****************************************************************************************
64	! Input argument
65	REAL, DIMENSION(klon), INTENT(IN) :: restart_runoff
66
67	! Local variables
68	INTEGER :: error
69	CHARACTER (len = 80) :: abort_message
70	CHARACTER (len = 20) :: modname = 'fonte_neige_init'
71
72
73	!****************************************************************************************
74	! Allocate run-off at landice and initilize with field read from restart
75	!
76	!****************************************************************************************
77
78	ALLOCATE(run_off_lic_0(klon), stat = error)
79	IF (error /= 0) THEN
80	abort_message='Pb allocation run_off_lic'
81	CALL abort_physic(modname,abort_message,1)
82	ENDIF
83	run_off_lic_0(:) = restart_runoff(:)
84
85	!****************************************************************************************
86	! Allocate other variables and initilize to zero
87	!
88	!****************************************************************************************
89	ALLOCATE(run_off_ter(klon), stat = error)
90	IF (error /= 0) THEN
91	abort_message='Pb allocation run_off_ter'
92	CALL abort_physic(modname,abort_message,1)
93	ENDIF
94	run_off_ter(:) = 0.
95
96	ALLOCATE(run_off_lic(klon), stat = error)
97	IF (error /= 0) THEN
98	abort_message='Pb allocation run_off_lic'
99	CALL abort_physic(modname,abort_message,1)
100	ENDIF
101	run_off_lic(:) = 0.
102
103	ALLOCATE(ffonte_global(klon,nbsrf))
104	IF (error /= 0) THEN
105	abort_message='Pb allocation ffonte_global'
106	CALL abort_physic(modname,abort_message,1)
107	ENDIF
108	ffonte_global(:,:) = 0.0
109
110	ALLOCATE(fqfonte_global(klon,nbsrf))
111	IF (error /= 0) THEN
112	abort_message='Pb allocation fqfonte_global'
113	CALL abort_physic(modname,abort_message,1)
114	ENDIF
115	fqfonte_global(:,:) = 0.0
116
117	ALLOCATE(fqcalving_global(klon,nbsrf))
118	IF (error /= 0) THEN
119	abort_message='Pb allocation fqcalving_global'
120	CALL abort_physic(modname,abort_message,1)
121	ENDIF
122	fqcalving_global(:,:) = 0.0
123
124	ALLOCATE(runofflic_global(klon))
125	IF (error /= 0) THEN
126	abort_message='Pb allocation runofflic_global'
127	CALL abort_physic(modname,abort_message,1)
128	ENDIF
129	runofflic_global(:) = 0.0
130
131	!****************************************************************************************
132	! Read tau_calv
133	!
134	!****************************************************************************************
135	CALL conf_interface(tau_calv)
136
137
138	END SUBROUTINE fonte_neige_init
139
140	#ifdef ISO
141	SUBROUTINE fonte_neige_init_iso(xtrestart_runoff)
142
143	! This subroutine allocates and initialize variables in the module.
144	! The variable run_off_lic_0 is initialized to the field read from
145	! restart file. The other variables are initialized to zero.
146
147	USE infotrac_phy, ONLY: niso
148	#ifdef ISOVERIF
149	USE isotopes_mod, ONLY: iso_eau,iso_HDO
150	USE isotopes_verif_mod
151	#endif
152	!
153	!****************************************************************************************
154	! Input argument
155	REAL, DIMENSION(niso,klon), INTENT(IN) :: xtrestart_runoff
156
157	! Local variables
158	INTEGER :: error
159	CHARACTER (len = 80) :: abort_message
160	CHARACTER (len = 20) :: modname = 'fonte_neige_init'
161	INTEGER :: i
162
163
164	!****************************************************************************************
165	! Allocate run-off at landice and initilize with field read from restart
166	!
167	!****************************************************************************************
168
169	ALLOCATE(xtrun_off_lic_0(niso,klon), stat = error)
170	IF (error /= 0) THEN
171	abort_message='Pb allocation run_off_lic'
172	CALL abort_physic(modname,abort_message,1)
173	ENDIF
174
175	xtrun_off_lic_0(:,:) = xtrestart_runoff(:,:)
176
177	#ifdef ISOVERIF
178	IF (iso_eau > 0) THEN
179	CALL iso_verif_egalite_vect1D( &
180	& xtrun_off_lic_0,run_off_lic_0,'fonte_neige 100', &
181	& niso,klon)
182	ENDIF !IF (iso_eau > 0) THEN
183	#endif
184
185	!****************************************************************************************
186	! Allocate other variables and initilize to zero
187	!
188	!****************************************************************************************
189
190	ALLOCATE(xtrun_off_ter(niso,klon), stat = error)
191	IF (error /= 0) THEN
192	abort_message='Pb allocation xtrun_off_ter'
193	CALL abort_physic(modname,abort_message,1)
194	ENDIF
195	xtrun_off_ter(:,:) = 0.
196
197	ALLOCATE(xtrun_off_lic(niso,klon), stat = error)
198	IF (error /= 0) THEN
199	abort_message='Pb allocation xtrun_off_lic'
200	CALL abort_physic(modname,abort_message,1)
201	ENDIF
202	xtrun_off_lic(:,:) = 0.
203
204	ALLOCATE(fxtfonte_global(niso,klon,nbsrf))
205	IF (error /= 0) THEN
206	abort_message='Pb allocation fxtfonte_global'
207	CALL abort_physic(modname,abort_message,1)
208	ENDIF
209	fxtfonte_global(:,:,:) = 0.0
210
211	ALLOCATE(fxtcalving_global(niso,klon,nbsrf))
212	IF (error /= 0) THEN
213	abort_message='Pb allocation fxtcalving_global'
214	CALL abort_physic(modname,abort_message,1)
215	ENDIF
216	fxtcalving_global(:,:,:) = 0.0
217
218	ALLOCATE(xtrunofflic_global(niso,klon))
219	IF (error /= 0) THEN
220	abort_message='Pb allocation xtrunofflic_global'
221	CALL abort_physic(modname,abort_message,1)
222	ENDIF
223	xtrunofflic_global(:,:) = 0.0
224
225	END SUBROUTINE fonte_neige_init_iso
226	#endif
227
228	!
229	!****************************************************************************************
230	!
231	SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, &
232	tsurf, precip_rain, precip_snow, &
233	snow, qsol, tsurf_new, evap &
234	#ifdef ISO
235	& ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag &
236	& ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag &
237	#endif
238	& )
239
240	USE indice_sol_mod
241	#ifdef ISO
242	USE infotrac_phy, ONLY: niso
243	!use isotopes_mod, ONLY: ridicule_snow,iso_eau,iso_HDO
244	#ifdef ISOVERIF
245	USE isotopes_verif_mod
246	#endif
247	#endif
248	USE clesphys_mod_h
249	USE yomcst_mod_h, ONLY: RPI, RCLUM, RHPLA, RKBOL, RNAVO &
250	, RDAY, REA, REPSM, RSIYEA, RSIDAY, ROMEGA &
251	, R_ecc, R_peri, R_incl &
252	, RA, RG, R1SA &
253	, RSIGMA &
254	, R, RMD, RMV, RD, RV, RCPD &
255	, RMO3, RMCO2, RMC, RMCH4, RMN2O, RMCFC11, RMCFC12 &
256	, RCPV, RCVD, RCVV, RKAPPA, RETV, eps_w &
257	, RCW, RCS &
258	, RLVTT, RLSTT, RLMLT, RTT, RATM &
259	, RESTT, RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS &
260	, RALPD, RBETD, RGAMD
261
262	! Routine de traitement de la fonte de la neige dans le cas du traitement
263	! de sol simplifie!
264	! LF 03/2001
265	! input:
266	! knon nombre de points a traiter
267	! nisurf surface a traiter
268	! knindex index des mailles valables pour surface a traiter
269	! dtime
270	! tsurf temperature de surface
271	! precip_rain precipitations liquides
272	! precip_snow precipitations solides
273	!
274	! input/output:
275	! snow champs hauteur de neige
276	! qsol hauteur d'eau contenu dans le sol
277	! tsurf_new temperature au sol
278	! evap
279	!
280	INCLUDE "YOETHF.h"
281	INCLUDE "FCTTRE.h"
282
283	! Input variables
284	!****************************************************************************************
285	INTEGER, INTENT(IN) :: knon
286	INTEGER, INTENT(IN) :: nisurf
287	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
288	REAL , INTENT(IN) :: dtime
289	REAL, DIMENSION(klon), INTENT(IN) :: tsurf
290	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain
291	REAL, DIMENSION(klon), INTENT(IN) :: precip_snow
292
293	! Input/Output variables
294	!****************************************************************************************
295
296	REAL, DIMENSION(klon), INTENT(INOUT) :: snow
297	REAL, DIMENSION(klon), INTENT(INOUT) :: qsol
298	REAL, DIMENSION(klon), INTENT(INOUT) :: tsurf_new
299	REAL, DIMENSION(klon), INTENT(INOUT) :: evap
300
301	#ifdef ISO
302	! sortie de quelques diagnostiques
303	REAL, DIMENSION(klon), INTENT(OUT) :: fq_fonte_diag
304	REAL, DIMENSION(klon), INTENT(OUT) :: fqfonte_diag
305	REAL, DIMENSION(klon), INTENT(OUT) :: snow_evap_diag
306	REAL, DIMENSION(klon), INTENT(OUT) :: fqcalving_diag
307	REAL, INTENT(OUT) :: max_eau_sol_diag
308	REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag
309	REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_diag
310	REAL, INTENT(OUT) :: coeff_rel_diag
311	#endif
312
313	! Local variables
314	!****************************************************************************************
315
316	INTEGER :: i, j
317	REAL :: fq_fonte
318	REAL :: coeff_rel
319	REAL, PARAMETER :: snow_max=3000.
320	REAL, PARAMETER :: max_eau_sol = 150.0
321	!! PB temporaire en attendant mieux pour le modele de neige
322	! REAL, parameter :: chasno = RLMLT/(2.3867E+06*0.15)
323	REAL, PARAMETER :: chasno = 3.334E+05/(2.3867E+06*0.15)
324	!IM cf JLD/ GKtest
325	REAL, PARAMETER :: chaice = 3.334E+05/(2.3867E+06*0.15)
326	! fin GKtest
327	REAL, DIMENSION(klon) :: ffonte
328	REAL, DIMENSION(klon) :: fqcalving, fqfonte
329	REAL, DIMENSION(klon) :: d_ts
330	REAL, DIMENSION(klon) :: bil_eau_s, snow_evap
331
332	LOGICAL :: neige_fond
333
334	#ifdef ISO
335	max_eau_sol_diag=max_eau_sol
336	#endif
337
338
339	!****************************************************************************************
340	! Start calculation
341	! - Initialization
342	!
343	!****************************************************************************************
344	coeff_rel = dtime/(tau_calv * rday)
345
346	bil_eau_s(:) = 0.
347
348	!****************************************************************************************
349	! - Increment snow due to precipitation and evaporation
350	! - Calculate the water balance due to precipitation and evaporation (bil_eau_s)
351	!
352	!****************************************************************************************
353	WHERE (precip_snow > 0.)
354	snow = snow + (precip_snow * dtime)
355	END WHERE
356
357	snow_evap = 0.
358
359	IF (.NOT. ok_lic_cond) THEN
360	!---only positive evaporation has an impact on snow
361	!---note that this could create a bit of water
362	!---this was the default until CMIP6
363	WHERE (evap > 0. )
364	snow_evap = MIN (snow / dtime, evap) !---one cannot evaporate more than the amount of snow
365	snow = snow - snow_evap * dtime !---snow that remains on the ground
366	snow = MAX(0.0, snow) !---just in case
367	END WHERE
368	ELSE
369	!--now considers both positive and negative evaporation in the budget of snow
370	snow_evap = MIN (snow / dtime, evap) !---one cannot evaporate more than the amount of snow
371	snow = snow - snow_evap * dtime !---snow that remains or deposits on the ground
372	snow = MAX(0.0, snow) !---just in case
373	ENDIF
374
375	bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime
376	#ifdef ISO
377	snow_evap_diag(:) = snow_evap(:)
378	coeff_rel_diag = coeff_rel
379	#endif
380
381
382
383	!****************************************************************************************
384	! - Calculate melting snow
385	! - Calculate calving and decrement snow, if there are to much snow
386	! - Update temperature at surface
387	!
388	!****************************************************************************************
389
390	ffonte(:) = 0.0
391	fqcalving(:) = 0.0
392	fqfonte(:) = 0.0
393
394	DO i = 1, knon
395	! Y'a-t-il fonte de neige?
396	neige_fond = (snow(i)>epsfra .OR. nisurf==is_sic .OR. nisurf==is_lic) .AND. tsurf_new(i)>=RTT
397	IF (neige_fond) THEN
398	fq_fonte = MIN( MAX((tsurf_new(i)-RTT )/chasno,0.0),snow(i))
399	ffonte(i) = fq_fonte * RLMLT/dtime
400	fqfonte(i) = fq_fonte/dtime
401	snow(i) = MAX(0., snow(i) - fq_fonte)
402	bil_eau_s(i) = bil_eau_s(i) + fq_fonte
403	tsurf_new(i) = tsurf_new(i) - fq_fonte * chasno
404	#ifdef ISO
405	fq_fonte_diag(i) = fq_fonte
406	#endif
407
408
409	!IM cf JLD OK
410	!IM cf JLD/ GKtest fonte aussi pour la glace
411	IF (nisurf == is_sic .OR. nisurf == is_lic ) THEN
412	fq_fonte = MAX((tsurf_new(i)-RTT )/chaice,0.0)
413	ffonte(i) = ffonte(i) + fq_fonte * RLMLT/dtime
414	IF ( ok_lic_melt ) THEN
415	fqfonte(i) = fqfonte(i) + fq_fonte/dtime
416	bil_eau_s(i) = bil_eau_s(i) + fq_fonte
417	ENDIF
418	tsurf_new(i) = RTT
419	ENDIF
420	d_ts(i) = tsurf_new(i) - tsurf(i)
421	ENDIF
422
423	! s'il y a une hauteur trop importante de neige, elle est ecretee
424	fqcalving(i) = MAX(0., snow(i) - snow_max)/dtime
425	snow(i)=MIN(snow(i),snow_max)
426	ENDDO
427	#ifdef ISO
428	DO i = 1, knon
429	fqcalving_diag(i) = fqcalving(i)
430	fqfonte_diag(i) = fqfonte(i)
431	ENDDO !DO i = 1, knon
432	#endif
433
434
435	IF (nisurf == is_ter) THEN
436	DO i = 1, knon
437	qsol(i) = qsol(i) + bil_eau_s(i)
438	run_off_ter(i) = run_off_ter(i) + MAX(qsol(i) - max_eau_sol, 0.0)
439	#ifdef ISO
440	runoff_diag(i) = MAX(qsol(i) - max_eau_sol, 0.0)
441	#endif
442	qsol(i) = MIN(qsol(i), max_eau_sol)
443	ENDDO
444	ELSE IF (nisurf == is_lic) THEN
445	DO i = 1, knon
446	j = knindex(i)
447	!--temporal filtering
448	run_off_lic(i) = coeff_relfqcalving(i) + (1.-coeff_rel)run_off_lic_0(j)
449	run_off_lic_0(j) = run_off_lic(i)
450	!--add melting snow and liquid precip to runoff of ice cap
451	run_off_lic(i) = run_off_lic(i) + fqfonte(i) + precip_rain(i)
452	ENDDO
453	ENDIF
454
455	#ifdef ISO
456	DO i = 1, klon
457	run_off_lic_diag(i) = run_off_lic(i)
458	ENDDO ! DO i = 1, knon
459	#endif
460
461	!****************************************************************************************
462	! Save ffonte, fqfonte and fqcalving in global arrays for each
463	! sub-surface separately
464	!
465	!****************************************************************************************
466	DO i = 1, knon
467	ffonte_global(knindex(i),nisurf) = ffonte(i)
468	fqfonte_global(knindex(i),nisurf) = fqfonte(i)
469	fqcalving_global(knindex(i),nisurf) = fqcalving(i)
470	ENDDO
471
472	IF (nisurf == is_lic) THEN
473	DO i = 1, knon
474	runofflic_global(knindex(i)) = run_off_lic(i)
475	ENDDO
476	ENDIF
477
478	END SUBROUTINE fonte_neige
479	!
480	!****************************************************************************************
481	!
482	SUBROUTINE fonte_neige_final(restart_runoff &
483	#ifdef ISO
484	& ,xtrestart_runoff &
485	#endif
486	& )
487	!
488	! This subroutine returns run_off_lic_0 for later writing to restart file.
489	!
490	#ifdef ISO
491	USE infotrac_phy, ONLY: niso
492	#ifdef ISOVERIF
493	USE isotopes_mod, ONLY: iso_eau
494	USE isotopes_verif_mod
495	#endif
496	#endif
497	!
498	!****************************************************************************************
499	REAL, DIMENSION(klon), INTENT(OUT) :: restart_runoff
500	#ifdef ISO
501	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrestart_runoff
502	#ifdef ISOVERIF
503	INTEGER :: i
504	#endif
505	#endif
506
507
508
509	!****************************************************************************************
510	! Set the output variables
511	restart_runoff(:) = run_off_lic_0(:)
512	#ifdef ISO
513	xtrestart_runoff(:,:) = xtrun_off_lic_0(:,:)
514	#ifdef ISOVERIF
515	IF (iso_eau > 0) THEN
516	DO i=1,klon
517	IF (iso_verif_egalite_nostop(run_off_lic_0(i) &
518	& ,xtrun_off_lic_0(iso_eau,i) &
519	& ,'fonte_neige 413') &
520	& == 1) then
521	WRITE(,) 'i=',i
522	STOP
523	ENDIF
524	ENDDO !DO i=1,klon
525	ENDIF !IF (iso_eau > 0) then
526	#endif
527	#endif
528
529
530
531	! Deallocation of all varaibles in the module
532	! DEALLOCATE(run_off_lic_0, run_off_ter, run_off_lic, ffonte_global, &
533	! fqfonte_global, fqcalving_global)
534
535	IF (ALLOCATED(run_off_lic_0)) DEALLOCATE(run_off_lic_0)
536	IF (ALLOCATED(run_off_ter)) DEALLOCATE(run_off_ter)
537	IF (ALLOCATED(run_off_lic)) DEALLOCATE(run_off_lic)
538	IF (ALLOCATED(ffonte_global)) DEALLOCATE(ffonte_global)
539	IF (ALLOCATED(fqfonte_global)) DEALLOCATE(fqfonte_global)
540	IF (ALLOCATED(fqcalving_global)) DEALLOCATE(fqcalving_global)
541	IF (ALLOCATED(runofflic_global)) DEALLOCATE(runofflic_global)
542	#ifdef ISO
543	IF (ALLOCATED(xtrun_off_lic_0)) DEALLOCATE(xtrun_off_lic_0)
544	IF (ALLOCATED(xtrun_off_ter)) DEALLOCATE(xtrun_off_ter)
545	IF (ALLOCATED(xtrun_off_lic)) DEALLOCATE(xtrun_off_lic)
546	IF (ALLOCATED(fxtfonte_global)) DEALLOCATE(fxtfonte_global)
547	IF (ALLOCATED(fxtcalving_global)) DEALLOCATE(fxtcalving_global)
548	IF (ALLOCATED(xtrunofflic_global)) DEALLOCATE(xtrunofflic_global)
549	#endif
550
551
552	END SUBROUTINE fonte_neige_final
553	!
554	!****************************************************************************************
555	!
556	SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, &
557	fqfonte_out, ffonte_out, run_off_lic_out &
558	#ifdef ISO
559	& ,fxtcalving_out, fxtfonte_out,xtrun_off_lic_out &
560	#endif
561	& )
562
563
564	! Cumulate ffonte, fqfonte and fqcalving respectively for
565	! all type of surfaces according to their fraction.
566	!
567	! This routine is called from physiq.F before histwrite.
568	!****************************************************************************************
569
570	USE indice_sol_mod
571	#ifdef ISO
572	USE infotrac_phy, ONLY: niso
573	#endif
574
575	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
576
577	REAL, DIMENSION(klon), INTENT(OUT) :: fqcalving_out
578	REAL, DIMENSION(klon), INTENT(OUT) :: fqfonte_out
579	REAL, DIMENSION(klon), INTENT(OUT) :: ffonte_out
580	REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_out
581
582	#ifdef ISO
583	REAL, DIMENSION(niso,klon), INTENT(OUT) :: fxtcalving_out
584	REAL, DIMENSION(niso,klon), INTENT(OUT) :: fxtfonte_out
585	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrun_off_lic_out
586	INTEGER :: i,ixt
587	#endif
588
589	INTEGER :: nisurf
590	!****************************************************************************************
591
592	ffonte_out(:) = 0.0
593	fqfonte_out(:) = 0.0
594	fqcalving_out(:) = 0.0
595	#ifdef ISO
596	fxtfonte_out(:,:) = 0.0
597	fxtcalving_out(:,:) = 0.0
598	#endif
599
600	DO nisurf = 1, nbsrf
601	ffonte_out(:) = ffonte_out(:) + ffonte_global(:,nisurf)*pctsrf(:,nisurf)
602	fqfonte_out(:) = fqfonte_out(:) + fqfonte_global(:,nisurf)*pctsrf(:,nisurf)
603	fqcalving_out(:) = fqcalving_out(:) + fqcalving_global(:,nisurf)*pctsrf(:,nisurf)
604	ENDDO
605
606	run_off_lic_out(:)=runofflic_global(:)
607
608	#ifdef ISO
609	DO nisurf = 1, nbsrf
610	DO i=1,klon
611	DO ixt=1,niso
612	fxtfonte_out(ixt,i) = fxtfonte_out(ixt,i) + fxtfonte_global(ixt,i,nisurf)*pctsrf(i,nisurf)
613	fxtcalving_out(ixt,i) = fxtcalving_out(ixt,i) + fxtcalving_global(ixt,i,nisurf)*pctsrf(i,nisurf)
614	ENDDO !DO ixt=1,niso
615	ENDDO !DO i=1,klon
616	ENDDO !DO nisurf = 1, nbsrf
617	xtrun_off_lic_out(:,:) = xtrunofflic_global(:,:)
618	#endif
619
620	END SUBROUTINE fonte_neige_get_vars
621	!
622	!****************************************************************************************
623	!
624	!#ifdef ISO
625	! subroutine fonte_neige_export_xtrun_off_lic_0(knon,xtrun_off_lic_0_diag)
626	! use infotrac_phy, ONLY: niso
627	!
628	! ! inputs
629	! INTEGER, INTENT(IN) :: knon
630	! real, INTENT(IN), DIMENSION(niso,klon) :: xtrun_off_lic_0_diag
631	!
632	! xtrun_off_lic_0(:,:)=xtrun_off_lic_0_diag(:,:)
633	!
634	! end subroutine fonte_neige_export_xtrun_off_lic_0
635	!#endif
636
637	#ifdef ISO
638	SUBROUTINE gestion_neige_besoin_varglob_fonte_neige(klon,knon, &
639	& xtprecip_snow,xtprecip_rain, &
640	& fxtfonte_neige,fxtcalving, &
641	& knindex,nisurf,run_off_lic_diag,coeff_rel_diag)
642
643	! dans cette routine, on a besoin des variables globales de
644	! fonte_neige_mod. Il faut donc la mettre dans fonte_neige_mod
645	! le reste de gestion_neige est dans isotopes_routines_mod car sinon pb
646	! de dépendance circulaire.
647
648	USE infotrac_phy, ONLY: ntiso,niso
649	USE isotopes_mod, ONLY: iso_eau
650	USE indice_sol_mod
651	#ifdef ISOVERIF
652	USE isotopes_verif_mod
653	#endif
654	IMPLICIT NONE
655
656	! inputs
657	INTEGER, INTENT(IN) :: klon,knon
658	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_snow, xtprecip_rain
659	REAL, DIMENSION(niso,klon), INTENT(IN) :: fxtfonte_neige,fxtcalving
660	INTEGER, INTENT(IN) :: nisurf
661	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
662	REAL, DIMENSION(klon), INTENT(IN) :: run_off_lic_diag
663	REAL, INTENT(IN) :: coeff_rel_diag
664
665	! locals
666	INTEGER :: i,ixt,j
667
668	#ifdef ISOVERIF
669	IF (nisurf == is_lic) THEN
670	IF (iso_eau > 0) THEN
671	DO i = 1, knon
672	j = knindex(i)
673	CALL iso_verif_egalite(xtrun_off_lic_0(iso_eau,j), &
674	& run_off_lic_0(j),'gestion_neige_besoin_varglob_fonte_neige 625')
675	ENDDO
676	ENDIF
677	ENDIF
678	#endif
679
680	! calcul de run_off_lic
681
682	IF (nisurf == is_lic) THEN
683	! coeff_rel = dtime/(tau_calv * rday)
684
685	DO i = 1, knon
686	j = knindex(i)
687	DO ixt = 1, niso
688	xtrun_off_lic(ixt,i) = (coeff_rel_diag * fxtcalving(ixt,i)) &
689	& +(1. - coeff_rel_diag) * xtrun_off_lic_0(ixt,j)
690	xtrun_off_lic_0(ixt,j) = xtrun_off_lic(ixt,i)
691	xtrun_off_lic(ixt,i) = xtrun_off_lic(ixt,i) + fxtfonte_neige(ixt,i) + xtprecip_rain(ixt,i)
692	ENDDO !DO ixt=1,niso
693	#ifdef ISOVERIF
694	IF (iso_eau > 0) THEN
695	IF (iso_verif_egalite_choix_nostop(xtrun_off_lic(iso_eau,i), &
696	& run_off_lic_diag(i),'gestion_neige_besoin_varglob_fonte_neige 1201a', &
697	& errmax,errmaxrel) == 1) THEN
698	WRITE(,) 'i,j=',i,j
699	WRITE(,) 'coeff_rel_diag=',coeff_rel_diag
700	STOP
701	ENDIF
702	ENDIF
703	#endif
704	ENDDO
705	ENDIF !IF (nisurf == is_lic) THEN
706
707	! Save ffonte, fqfonte and fqcalving in global arrays for each
708	! sub-surface separately
709	DO i = 1, knon
710	DO ixt = 1, niso
711	fxtfonte_global(ixt,knindex(i),nisurf) = fxtfonte_neige(ixt,i)
712	fxtcalving_global(ixt,knindex(i),nisurf) = fxtcalving(ixt,i)
713	ENDDO !do ixt=1,niso
714	ENDDO
715
716	IF (nisurf == is_lic) THEN
717	DO i = 1, knon
718	DO ixt = 1, niso
719	xtrunofflic_global(ixt,knindex(i)) = xtrun_off_lic(ixt,i)
720	ENDDO ! DO ixt=1,niso
721	ENDDO
722	ENDIF
723
724	END SUBROUTINE gestion_neige_besoin_varglob_fonte_neige
725	#endif
726
727
728	END MODULE fonte_neige_mod

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

Download in other formats:

Original Format