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

Last change on this file since 3006 was 2946, checked in by oboucher, 7 years ago

Put under the ok_lic_cond flag the option of depositing water vapour
onto snow, especially over ice sheets (lic). The default for the flag is
FALSE in order to keep backward compatibility, but should be turned to TRUE
in order to close the water budget. Tested in CM6.0.11.

  • 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:executable set to *
  • 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(:,:), PRIVATE  :: ffonte_global
31  !$OMP THREADPRIVATE(ffonte_global)
32  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: fqfonte_global
33  !$OMP THREADPRIVATE(fqfonte_global)
34  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: fqcalving_global
35  !$OMP THREADPRIVATE(fqcalving_global)
36  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE  :: 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.