source: LMDZ6/trunk/libf/phylmd/fonte_neige_mod.F90 @ 5394

Last change on this file since 5394 was 5285, checked in by abarral, 7 weeks ago

As discussed internally, remove generic ONLY: ... for new _mod_h modules

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