source: LMDZ5/branches/testing/libf/phylmd/fonte_neige_mod.F90 @ 5423

Last change on this file since 5423 was 2641, checked in by Laurent Fairhead, 8 years ago

Merged trunk changes r2593:2640 into testing branch
  • 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: 12.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  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    WHERE (evap > 0. )
216       snow_evap = MIN (snow / dtime, evap)
217       snow = snow - snow_evap * dtime
218       snow = MAX(0.0, snow)
219    END WHERE
220   
221    bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime
222
223
224!****************************************************************************************
225! - Calculate melting snow
226! - Calculate calving and decrement snow, if there are to much snow
227! - Update temperature at surface
228!
229!****************************************************************************************
230
231    ffonte(:) = 0.0
232    fqcalving(:) = 0.0
233    fqfonte(:) = 0.0
234    DO i = 1, knon
235       ! Y'a-t-il fonte de neige?
236       neige_fond = ((snow(i) > epsfra .OR. nisurf == is_sic .OR. nisurf == is_lic) &
237            .AND. tsurf_new(i) >= RTT)
238       IF (neige_fond) THEN
239          fq_fonte     = MIN( MAX((tsurf_new(i)-RTT )/chasno,0.0),snow(i))
240          ffonte(i)    = fq_fonte * RLMLT/dtime
241          fqfonte(i)   = fq_fonte/dtime
242          snow(i)      = MAX(0., snow(i) - fq_fonte)
243          bil_eau_s(i) = bil_eau_s(i) + fq_fonte
244          tsurf_new(i) = tsurf_new(i) - fq_fonte * chasno 
245
246!IM cf JLD OK     
247!IM cf JLD/ GKtest fonte aussi pour la glace
248          IF (nisurf == is_sic .OR. nisurf == is_lic ) THEN
249             fq_fonte = MAX((tsurf_new(i)-RTT )/chaice,0.0)
250             ffonte(i) = ffonte(i) + fq_fonte * RLMLT/dtime
251             IF ( ok_lic_melt ) THEN
252                fqfonte(i) = fqfonte(i) + fq_fonte/dtime
253                bil_eau_s(i) = bil_eau_s(i) + fq_fonte
254             ENDIF
255             tsurf_new(i) = RTT
256          ENDIF
257          d_ts(i) = tsurf_new(i) - tsurf(i)
258       ENDIF
259
260       ! s'il y a une hauteur trop importante de neige, elle s'coule
261       fqcalving(i) = MAX(0., snow(i) - snow_max)/dtime
262       snow(i)=MIN(snow(i),snow_max)
263    END DO
264
265
266    IF (nisurf == is_ter) THEN
267       DO i = 1, knon
268          qsol(i) = qsol(i) + bil_eau_s(i)
269          run_off_ter(i) = run_off_ter(i) + MAX(qsol(i) - max_eau_sol, 0.0)
270          qsol(i) = MIN(qsol(i), max_eau_sol)
271       END DO
272    ELSE IF (nisurf == is_lic) THEN
273       DO i = 1, knon
274          j = knindex(i)
275          run_off_lic(i)   = (coeff_rel *  fqcalving(i)) + &
276               (1. - coeff_rel) * run_off_lic_0(j)
277          run_off_lic_0(j) = run_off_lic(i)
278          run_off_lic(i)   = run_off_lic(i) + fqfonte(i) + precip_rain(i)
279       END DO
280    ENDIF
281   
282!****************************************************************************************
283! Save ffonte, fqfonte and fqcalving in global arrays for each
284! sub-surface separately
285!
286!****************************************************************************************
287    DO i = 1, knon
288       ffonte_global(knindex(i),nisurf)    = ffonte(i)
289       fqfonte_global(knindex(i),nisurf)   = fqfonte(i)
290       fqcalving_global(knindex(i),nisurf) = fqcalving(i)
291    ENDDO
292
293    IF (nisurf == is_lic) THEN
294    DO i = 1, knon
295       runofflic_global(knindex(i)) = run_off_lic(i)
296    ENDDO
297    ENDIF
298
299  END SUBROUTINE fonte_neige
300!
301!****************************************************************************************
302!
303  SUBROUTINE fonte_neige_final(restart_runoff)
304!
305! This subroutine returns run_off_lic_0 for later writing to restart file.
306!
307!****************************************************************************************
308    REAL, DIMENSION(klon), INTENT(OUT) :: restart_runoff
309
310!****************************************************************************************
311! Set the output variables
312    restart_runoff(:) = run_off_lic_0(:)
313
314! Deallocation of all varaibles in the module
315!   DEALLOCATE(run_off_lic_0, run_off_ter, run_off_lic, ffonte_global, &
316!        fqfonte_global, fqcalving_global)
317
318    IF (ALLOCATED(run_off_lic_0)) DEALLOCATE(run_off_lic_0)
319    IF (ALLOCATED(run_off_ter)) DEALLOCATE(run_off_ter)
320    IF (ALLOCATED(run_off_lic)) DEALLOCATE(run_off_lic)
321    IF (ALLOCATED(ffonte_global)) DEALLOCATE(ffonte_global)
322    IF (ALLOCATED(fqfonte_global)) DEALLOCATE(fqfonte_global)
323    IF (ALLOCATED(fqcalving_global)) DEALLOCATE(fqcalving_global)
324    IF (ALLOCATED(runofflic_global)) DEALLOCATE(runofflic_global)
325
326  END SUBROUTINE fonte_neige_final
327!
328!****************************************************************************************
329!
330  SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, &
331       fqfonte_out, ffonte_out, run_off_lic_out)
332
333
334! Cumulate ffonte, fqfonte and fqcalving respectively for
335! all type of surfaces according to their fraction.
336!
337! This routine is called from physiq.F before histwrite.
338!****************************************************************************************
339
340  USE indice_sol_mod
341
342    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
343
344    REAL, DIMENSION(klon), INTENT(OUT)      :: fqcalving_out
345    REAL, DIMENSION(klon), INTENT(OUT)      :: fqfonte_out
346    REAL, DIMENSION(klon), INTENT(OUT)      :: ffonte_out
347    REAL, DIMENSION(klon), INTENT(OUT)      :: run_off_lic_out
348
349    INTEGER   :: nisurf
350!****************************************************************************************
351
352    ffonte_out(:)    = 0.0
353    fqfonte_out(:)   = 0.0
354    fqcalving_out(:) = 0.0
355
356    DO nisurf = 1, nbsrf
357       ffonte_out(:) = ffonte_out(:) + ffonte_global(:,nisurf)*pctsrf(:,nisurf)
358       fqfonte_out(:) = fqfonte_out(:) + fqfonte_global(:,nisurf)*pctsrf(:,nisurf)
359       fqcalving_out(:) = fqcalving_out(:) + fqcalving_global(:,nisurf)*pctsrf(:,nisurf)
360    ENDDO
361
362    run_off_lic_out(:)=runofflic_global(:)
363
364  END SUBROUTINE fonte_neige_get_vars
365!
366!****************************************************************************************
367!
368END MODULE fonte_neige_mod
Note: See TracBrowser for help on using the repository browser.