source: LMDZ6/branches/Amaury_dev/libf/phylmd/fonte_neige_mod.F90 @ 5157

Last change on this file since 5157 was 5153, checked in by abarral, 3 months ago

Revert FCTTRE to INCLUDE to assess impact of inlining

  • 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
4MODULE 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
54CONTAINS
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  USE lmdz_clesphys
243  USE lmdz_yoethf
244#ifdef ISO
245    USE infotrac_phy, ONLY: niso
246    !use isotopes_mod, ONLY: ridicule_snow,iso_eau,iso_HDO
247#ifdef ISOVERIF
248    USE isotopes_verif_mod
249#endif
250#endif
251
252  USE lmdz_yomcst
253
254  IMPLICIT NONE
255 INCLUDE "FCTTRE.h"
256       
257! Routine de traitement de la fonte de la neige dans le cas du traitement
258! de sol simplifie!
259! LF 03/2001
260! input:
261!   knon         nombre de points a traiter
262!   nisurf       surface a traiter
263!   knindex      index des mailles valables pour surface a traiter
264!   dtime       
265!   tsurf        temperature de surface
266!   precip_rain  precipitations liquides
267!   precip_snow  precipitations solides
268
269! input/output:
270!   snow         champs hauteur de neige
271!   qsol         hauteur d'eau contenu dans le sol
272!   tsurf_new    temperature au sol
273!   evap
274
275! Input variables
276!****************************************************************************************
277    INTEGER, INTENT(IN)                  :: knon
278    INTEGER, INTENT(IN)                  :: nisurf
279    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
280    REAL   , INTENT(IN)                  :: dtime
281    REAL, DIMENSION(klon), INTENT(IN)    :: tsurf
282    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain
283    REAL, DIMENSION(klon), INTENT(IN)    :: precip_snow
284
285    ! Input/Output variables
286!****************************************************************************************
287
288    REAL, DIMENSION(klon), INTENT(INOUT) :: snow
289    REAL, DIMENSION(klon), INTENT(INOUT) :: qsol
290    REAL, DIMENSION(klon), INTENT(INOUT) :: tsurf_new
291    REAL, DIMENSION(klon), INTENT(INOUT) :: evap
292
293#ifdef ISO   
294        ! sortie de quelques diagnostiques
295    REAL, DIMENSION(klon), INTENT(OUT) :: fq_fonte_diag
296    REAL, DIMENSION(klon), INTENT(OUT) :: fqfonte_diag
297    REAL, DIMENSION(klon), INTENT(OUT) ::  snow_evap_diag
298    REAL, DIMENSION(klon), INTENT(OUT) ::  fqcalving_diag 
299    REAL,                  INTENT(OUT) :: max_eau_sol_diag 
300    REAL, DIMENSION(klon), INTENT(OUT) ::  runoff_diag   
301    REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_diag 
302    REAL,                  INTENT(OUT) :: coeff_rel_diag
303#endif
304
305! Local variables
306!****************************************************************************************
307
308    INTEGER               :: i, j
309    REAL                  :: fq_fonte
310    REAL                  :: coeff_rel
311    REAL, PARAMETER       :: snow_max=3000.
312    REAL, PARAMETER       :: max_eau_sol = 150.0
313!! PB temporaire en attendant mieux pour le modele de neige
314! REAL, parameter :: chasno = RLMLT/(2.3867E+06*0.15)
315    REAL, PARAMETER       :: chasno = 3.334E+05/(2.3867E+06*0.15)
316!IM cf JLD/ GKtest
317    REAL, PARAMETER       :: chaice = 3.334E+05/(2.3867E+06*0.15)
318! fin GKtest
319    REAL, DIMENSION(klon) :: ffonte
320    REAL, DIMENSION(klon) :: fqcalving, fqfonte
321    REAL, DIMENSION(klon) :: d_ts
322    REAL, DIMENSION(klon) :: bil_eau_s, snow_evap
323
324    LOGICAL               :: neige_fond
325
326#ifdef ISO
327        max_eau_sol_diag=max_eau_sol
328#endif
329
330
331!****************************************************************************************
332! Start calculation
333! - Initialization
334
335!****************************************************************************************
336    coeff_rel = dtime/(tau_calv * rday)
337   
338    bil_eau_s(:) = 0.
339
340!****************************************************************************************
341! - Increment snow due to precipitation and evaporation
342! - Calculate the water balance due to precipitation and evaporation (bil_eau_s)
343
344!****************************************************************************************
345    WHERE (precip_snow > 0.)
346       snow = snow + (precip_snow * dtime)
347    END WHERE
348
349    snow_evap = 0.
350 
351    IF (.NOT. ok_lic_cond) THEN
352!---only positive evaporation has an impact on snow
353!---note that this could create a bit of water
354!---this was the default until CMIP6
355      WHERE (evap > 0. )
356         snow_evap = MIN (snow / dtime, evap)    !---one cannot evaporate more than the amount of snow
357         snow = snow - snow_evap * dtime         !---snow that remains on the ground
358         snow = MAX(0.0, snow)                   !---just in case
359      END WHERE
360    ELSE
361!--now considers both positive and negative evaporation in the budget of snow
362      snow_evap = MIN (snow / dtime, evap)    !---one cannot evaporate more than the amount of snow
363      snow = snow - snow_evap * dtime         !---snow that remains or deposits on the ground
364      snow = MAX(0.0, snow)                   !---just in case
365   ENDIF
366   
367    bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime
368#ifdef ISO
369    snow_evap_diag(:) = snow_evap(:)
370    coeff_rel_diag    = coeff_rel
371#endif
372
373
374
375!****************************************************************************************
376! - Calculate melting snow
377! - Calculate calving and decrement snow, if there are to much snow
378! - Update temperature at surface
379
380!****************************************************************************************
381
382    ffonte(:) = 0.0
383    fqcalving(:) = 0.0
384    fqfonte(:) = 0.0
385
386    DO i = 1, knon
387       ! Y'a-t-il fonte de neige?
388       neige_fond = (snow(i)>epsfra .OR. nisurf==is_sic .OR. nisurf==is_lic) .AND. tsurf_new(i)>=RTT
389       IF (neige_fond) THEN
390          fq_fonte     = MIN( MAX((tsurf_new(i)-RTT )/chasno,0.0),snow(i))
391          ffonte(i)    = fq_fonte * RLMLT/dtime
392          fqfonte(i)   = fq_fonte/dtime
393          snow(i)      = MAX(0., snow(i) - fq_fonte)
394          bil_eau_s(i) = bil_eau_s(i) + fq_fonte
395          tsurf_new(i) = tsurf_new(i) - fq_fonte * chasno 
396#ifdef ISO
397          fq_fonte_diag(i) = fq_fonte
398#endif
399
400
401!IM cf JLD OK     
402!IM cf JLD/ GKtest fonte aussi pour la glace
403          IF (nisurf == is_sic .OR. nisurf == is_lic ) THEN
404             fq_fonte = MAX((tsurf_new(i)-RTT )/chaice,0.0)
405             ffonte(i) = ffonte(i) + fq_fonte * RLMLT/dtime
406             IF ( ok_lic_melt ) THEN
407                fqfonte(i) = fqfonte(i) + fq_fonte/dtime
408                bil_eau_s(i) = bil_eau_s(i) + fq_fonte
409             ENDIF
410             tsurf_new(i) = RTT
411          ENDIF
412          d_ts(i) = tsurf_new(i) - tsurf(i)
413       ENDIF
414
415       ! s'il y a une hauteur trop importante de neige, elle est ecretee
416       fqcalving(i) = MAX(0., snow(i) - snow_max)/dtime
417       snow(i)=MIN(snow(i),snow_max)
418    ENDDO
419#ifdef ISO
420    DO i = 1, knon
421       fqcalving_diag(i) = fqcalving(i)
422       fqfonte_diag(i)   = fqfonte(i)
423    ENDDO !DO i = 1, knon
424#endif
425
426
427    IF (nisurf == is_ter) THEN
428       DO i = 1, knon
429          qsol(i) = qsol(i) + bil_eau_s(i)
430          run_off_ter(i) = run_off_ter(i) + MAX(qsol(i) - max_eau_sol, 0.0)
431#ifdef ISO
432          runoff_diag(i) = MAX(qsol(i) - max_eau_sol, 0.0)
433#endif
434          qsol(i) = MIN(qsol(i), max_eau_sol)
435       ENDDO
436    ELSE IF (nisurf == is_lic) THEN
437       DO i = 1, knon
438          j = knindex(i)
439          !--temporal filtering
440          run_off_lic(i)   = coeff_rel*fqcalving(i) + (1.-coeff_rel)*run_off_lic_0(j)
441          run_off_lic_0(j) = run_off_lic(i)
442          !--add melting snow and liquid precip to runoff of ice cap
443          run_off_lic(i)   = run_off_lic(i) + fqfonte(i) + precip_rain(i)
444       ENDDO
445    ENDIF
446
447#ifdef ISO
448    DO i = 1, klon   
449      run_off_lic_diag(i) = run_off_lic(i)
450    ENDDO ! DO i = 1, knon   
451#endif
452   
453!****************************************************************************************
454! Save ffonte, fqfonte and fqcalving in global arrays for each
455! sub-surface separately
456
457!****************************************************************************************
458    DO i = 1, knon
459       ffonte_global(knindex(i),nisurf)    = ffonte(i)
460       fqfonte_global(knindex(i),nisurf)   = fqfonte(i)
461       fqcalving_global(knindex(i),nisurf) = fqcalving(i)
462    ENDDO
463
464    IF (nisurf == is_lic) THEN
465    DO i = 1, knon
466       runofflic_global(knindex(i)) = run_off_lic(i)
467    ENDDO
468    ENDIF
469
470  END SUBROUTINE fonte_neige
471
472!****************************************************************************************
473
474  SUBROUTINE fonte_neige_final(restart_runoff &
475#ifdef ISO     
476                          ,xtrestart_runoff &
477#endif   
478                          )
479
480! This SUBROUTINE returns run_off_lic_0 for later writing to restart file.
481
482#ifdef ISO
483    USE infotrac_phy, ONLY: niso
484#ifdef ISOVERIF
485    USE isotopes_mod, ONLY: iso_eau
486    USE isotopes_verif_mod
487#endif
488#endif
489
490!****************************************************************************************
491    REAL, DIMENSION(klon), INTENT(OUT) :: restart_runoff
492#ifdef ISO     
493    REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrestart_runoff
494#ifdef ISOVERIF
495    INTEGER :: i
496#endif 
497#endif
498
499
500
501!****************************************************************************************
502! Set the output variables
503    restart_runoff(:) = run_off_lic_0(:)
504#ifdef ISO
505    xtrestart_runoff(:,:) = xtrun_off_lic_0(:,:)
506#ifdef ISOVERIF
507    IF (iso_eau > 0) THEN   
508      DO i=1,klon
509        IF (iso_verif_egalite_nostop(run_off_lic_0(i) &
510                                ,xtrun_off_lic_0(iso_eau,i) &
511                                ,'fonte_neige 413') &
512        == 1) THEN
513          WRITE(*,*) 'i=',i
514          STOP
515        ENDIF
516      ENDDO !DO i=1,klon
517    ENDIF !IF (iso_eau > 0) THEN
518#endif   
519#endif
520
521
522
523! Deallocation of all varaibles in the module
524!   DEALLOCATE(run_off_lic_0, run_off_ter, run_off_lic, ffonte_global, &
525!        fqfonte_global, fqcalving_global)
526
527    IF (ALLOCATED(run_off_lic_0)) DEALLOCATE(run_off_lic_0)
528    IF (ALLOCATED(run_off_ter)) DEALLOCATE(run_off_ter)
529    IF (ALLOCATED(run_off_lic)) DEALLOCATE(run_off_lic)
530    IF (ALLOCATED(ffonte_global)) DEALLOCATE(ffonte_global)
531    IF (ALLOCATED(fqfonte_global)) DEALLOCATE(fqfonte_global)
532    IF (ALLOCATED(fqcalving_global)) DEALLOCATE(fqcalving_global)
533    IF (ALLOCATED(runofflic_global)) DEALLOCATE(runofflic_global)
534#ifdef ISO
535    IF (ALLOCATED(xtrun_off_lic_0)) DEALLOCATE(xtrun_off_lic_0)
536    IF (ALLOCATED(xtrun_off_ter)) DEALLOCATE(xtrun_off_ter)
537    IF (ALLOCATED(xtrun_off_lic)) DEALLOCATE(xtrun_off_lic)
538    IF (ALLOCATED(fxtfonte_global)) DEALLOCATE(fxtfonte_global)
539    IF (ALLOCATED(fxtcalving_global)) DEALLOCATE(fxtcalving_global)
540    IF (ALLOCATED(xtrunofflic_global)) DEALLOCATE(xtrunofflic_global)
541#endif
542
543
544  END SUBROUTINE fonte_neige_final
545
546!****************************************************************************************
547
548  SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, &
549              fqfonte_out, ffonte_out, run_off_lic_out &
550#ifdef ISO     
551         ,fxtcalving_out, fxtfonte_out,xtrun_off_lic_out &
552#endif     
553         )
554
555
556! Cumulate ffonte, fqfonte and fqcalving respectively for
557! all type of surfaces according to their fraction.
558
559! This routine is called from physiq.F before histwrite.
560!****************************************************************************************
561
562    USE indice_sol_mod
563#ifdef ISO
564    USE infotrac_phy, ONLY: niso
565#endif
566
567    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
568
569    REAL, DIMENSION(klon), INTENT(OUT)      :: fqcalving_out
570    REAL, DIMENSION(klon), INTENT(OUT)      :: fqfonte_out
571    REAL, DIMENSION(klon), INTENT(OUT)      :: ffonte_out
572    REAL, DIMENSION(klon), INTENT(OUT)      :: run_off_lic_out
573
574#ifdef ISO
575    REAL, DIMENSION(niso,klon), INTENT(OUT) :: fxtcalving_out
576    REAL, DIMENSION(niso,klon), INTENT(OUT) :: fxtfonte_out
577    REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrun_off_lic_out
578    INTEGER   :: i,ixt
579#endif
580 
581    INTEGER   :: nisurf
582!****************************************************************************************
583
584    ffonte_out(:)    = 0.0
585    fqfonte_out(:)   = 0.0
586    fqcalving_out(:) = 0.0
587#ifdef ISO       
588    fxtfonte_out(:,:)   = 0.0
589    fxtcalving_out(:,:) = 0.0
590#endif
591
592    DO nisurf = 1, nbsrf
593       ffonte_out(:) = ffonte_out(:) + ffonte_global(:,nisurf)*pctsrf(:,nisurf)
594       fqfonte_out(:) = fqfonte_out(:) + fqfonte_global(:,nisurf)*pctsrf(:,nisurf)
595       fqcalving_out(:) = fqcalving_out(:) + fqcalving_global(:,nisurf)*pctsrf(:,nisurf)
596    ENDDO
597
598    run_off_lic_out(:)=runofflic_global(:)
599
600#ifdef ISO
601    DO nisurf = 1, nbsrf
602      DO i=1,klon
603        DO ixt=1,niso
604          fxtfonte_out(ixt,i) = fxtfonte_out(ixt,i) + fxtfonte_global(ixt,i,nisurf)*pctsrf(i,nisurf)
605          fxtcalving_out(ixt,i) = fxtcalving_out(ixt,i) + fxtcalving_global(ixt,i,nisurf)*pctsrf(i,nisurf)
606        ENDDO !DO ixt=1,niso
607      ENDDO !DO i=1,klon
608    ENDDO !DO nisurf = 1, nbsrf
609    xtrun_off_lic_out(:,:) = xtrunofflic_global(:,:)
610#endif
611
612  END SUBROUTINE fonte_neige_get_vars
613
614!****************************************************************************************
615
616!#ifdef ISO
617!  SUBROUTINE fonte_neige_export_xtrun_off_lic_0(knon,xtrun_off_lic_0_diag)
618!    use infotrac_phy, ONLY: niso
619
620!    ! inputs
621!    INTEGER, INTENT(IN)                      :: knon
622!    REAL, INTENT(IN), DIMENSION(niso,klon)   :: xtrun_off_lic_0_diag
623
624!    xtrun_off_lic_0(:,:)=xtrun_off_lic_0_diag(:,:)
625
626!  END SUBROUTINE  fonte_neige_export_xtrun_off_lic_0
627!#endif
628
629#ifdef ISO
630  SUBROUTINE gestion_neige_besoin_varglob_fonte_neige(klon,knon, &
631             xtprecip_snow,xtprecip_rain, &
632             fxtfonte_neige,fxtcalving, &
633             knindex,nisurf,run_off_lic_diag,coeff_rel_diag)
634
635        ! dans cette routine, on a besoin des variables globales de
636        ! fonte_neige_mod. Il faut donc la mettre dans fonte_neige_mod
637        ! le reste de gestion_neige est dans isotopes_routines_mod car sinon pb
638        ! de dépendance circulaire.
639
640    USE infotrac_phy, ONLY: ntiso,niso
641    USE isotopes_mod, ONLY: iso_eau   
642    USE indice_sol_mod   
643#ifdef ISOVERIF
644    USE isotopes_verif_mod
645#endif
646    IMPLICIT NONE
647
648    ! inputs
649    INTEGER, INTENT(IN)                     :: klon,knon
650    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_snow, xtprecip_rain
651    REAL, DIMENSION(niso,klon), INTENT(IN)  :: fxtfonte_neige,fxtcalving
652    INTEGER, INTENT(IN)                     :: nisurf
653    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
654    REAL, DIMENSION(klon), INTENT(IN)       :: run_off_lic_diag 
655    REAL, INTENT(IN)                        :: coeff_rel_diag 
656
657    ! locals
658    INTEGER :: i,ixt,j
659       
660#ifdef ISOVERIF
661    IF (nisurf == is_lic) THEN
662      IF (iso_eau > 0) THEN 
663        DO i = 1, knon
664           j = knindex(i)
665           CALL iso_verif_egalite(xtrun_off_lic_0(iso_eau,j), &
666               run_off_lic_0(j),'gestion_neige_besoin_varglob_fonte_neige 625')
667        ENDDO
668      ENDIF
669    ENDIF
670#endif
671
672! calcul de run_off_lic
673
674    IF (nisurf == is_lic) THEN
675!         coeff_rel = dtime/(tau_calv * rday)
676
677      DO i = 1, knon
678        j = knindex(i)
679        DO ixt = 1, niso
680          xtrun_off_lic(ixt,i)   = (coeff_rel_diag *  fxtcalving(ixt,i)) &
681                              +(1. - coeff_rel_diag) * xtrun_off_lic_0(ixt,j)
682          xtrun_off_lic_0(ixt,j) = xtrun_off_lic(ixt,i)
683          xtrun_off_lic(ixt,i)   = xtrun_off_lic(ixt,i) + fxtfonte_neige(ixt,i) + xtprecip_rain(ixt,i)
684        ENDDO !DO ixt=1,niso
685#ifdef ISOVERIF
686          IF (iso_eau > 0) THEN             
687            IF (iso_verif_egalite_choix_nostop(xtrun_off_lic(iso_eau,i), &
688                    run_off_lic_diag(i),'gestion_neige_besoin_varglob_fonte_neige 1201a', &
689                    errmax,errmaxrel) == 1) THEN
690               WRITE(*,*) 'i,j=',i,j   
691               WRITE(*,*) 'coeff_rel_diag=',coeff_rel_diag
692               STOP
693            ENDIF
694          ENDIF
695#endif
696      ENDDO
697    ENDIF !IF (nisurf == is_lic) THEN 
698
699! Save ffonte, fqfonte and fqcalving in global arrays for each
700! sub-surface separately
701    DO i = 1, knon
702      DO ixt = 1, niso
703        fxtfonte_global(ixt,knindex(i),nisurf)   = fxtfonte_neige(ixt,i)
704        fxtcalving_global(ixt,knindex(i),nisurf) = fxtcalving(ixt,i)
705      ENDDO !do ixt=1,niso
706    ENDDO   
707
708    IF (nisurf == is_lic) THEN
709      DO i = 1, knon   
710        DO ixt = 1, niso   
711        xtrunofflic_global(ixt,knindex(i)) = xtrun_off_lic(ixt,i)
712        ENDDO ! DO ixt=1,niso   
713      ENDDO
714    ENDIF
715       
716  END SUBROUTINE gestion_neige_besoin_varglob_fonte_neige
717#endif
718
719
720END MODULE fonte_neige_mod
Note: See TracBrowser for help on using the repository browser.