source: LMDZ5/branches/LF-private/libf/phylmd/fonte_neige_mod.F90 @ 5456

Last change on this file since 5456 was 1785, checked in by Ehouarn Millour, 11 years ago

Transformation de l'include indicesol.h en un module indice_sol_mod et modification des appels dans tous les fichiers concernés.
Aucun changement des résultats ni des sorties du modèle vs 1784.
UG

...................................................

Replacement of the indicesol.h include by a module named indice_sol_mod. Modification of the calls in every affected files.
Results and outputs of simulations are unchanged in comparison with rev 1784.
UG
  • 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
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
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)
122
123  USE indice_sol_mod
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!
143  INCLUDE "dimensions.h"
144  INCLUDE "YOETHF.h"
145  INCLUDE "YOMCST.h"
146  INCLUDE "FCTTRE.h"
147  INCLUDE "clesphys.h"
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)
270          run_off_lic(i)   = run_off_lic(i) + fqfonte(i) + precip_rain(i)
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
301!   DEALLOCATE(run_off_lic_0, run_off_ter, run_off_lic, ffonte_global, &
302!        fqfonte_global, fqcalving_global)
303
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
311  END SUBROUTINE fonte_neige_final
312!
313!****************************************************************************************
314!
315  SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, &
316       fqfonte_out, ffonte_out)
317
318
319
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.
324!****************************************************************************************
325
326  USE indice_sol_mod
327
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.