Context Navigation

fonte_neige_mod.F90 @ 5133

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

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

Download in other formats:

Original Format