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

Last change on this file since 2283 was 1910, checked in by Laurent Fairhead, 11 years ago

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