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

Last change on this file since 4056 was 3900, checked in by evignon, 4 years ago

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