source: lmdz_wrf/WRFV3/lmdz/fonte_neige_mod.F90 @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

  • Property svn:executable set to *
File size: 13.2 KB
Line 
1! $Header$
2!
3MODULE fonte_neige_mod
4!
5! This module will treat the process of snow, melting, accumulating, calving, in
6! case of simplified soil model.
7!
8!****************************************************************************************
9  USE dimphy, ONLY : klon
10  USE indice_sol_mod
11
12  IMPLICIT NONE
13  SAVE
14
15! run_off_ter and run_off_lic are the runoff at the compressed grid knon for
16! land and land-ice respectively
17! Note: run_off_lic is used in mod_landice and therfore not private
18!L. Fita, LMD. November 2013
19! Removing all the PRIVATE, I removed startphy.nc and limit.nc
20!  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE    :: run_off_ter
21  REAL, ALLOCATABLE, DIMENSION(:), SAVE             :: run_off_ter
22  !$OMP THREADPRIVATE(run_off_ter)
23  REAL, ALLOCATABLE, DIMENSION(:), SAVE             :: run_off_lic
24  !$OMP THREADPRIVATE(run_off_lic)
25
26! run_off_lic_0 is the runoff at land-ice a time-step earlier, on the global 1D array grid
27  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE    :: run_off_lic_0
28!  REAL, ALLOCATABLE, DIMENSION(:),SAVE    :: run_off_lic_0
29  !$OMP THREADPRIVATE(run_off_lic_0)
30 
31  REAL, PRIVATE                               :: tau_calv 
32  !$OMP THREADPRIVATE(tau_calv)
33!  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: ffonte_global
34  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE                :: ffonte_global
35  !$OMP THREADPRIVATE(ffonte_global)
36!  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: fqfonte_global
37  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE                :: fqfonte_global
38  !$OMP THREADPRIVATE(fqfonte_global)
39!  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: fqcalving_global
40  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE                :: fqcalving_global
41  !$OMP THREADPRIVATE(fqcalving_global)
42
43CONTAINS
44!
45!****************************************************************************************
46!
47  SUBROUTINE fonte_neige_init(restart_runoff)
48
49! This subroutine allocates and initialize variables in the module.
50! The variable run_off_lic_0 is initialized to the field read from
51! restart file. The other variables are initialized to zero.
52!
53!****************************************************************************************
54! Input argument
55    REAL, DIMENSION(klon), INTENT(IN) :: restart_runoff
56
57! Local variables
58    INTEGER                           :: error
59    CHARACTER (len = 80)              :: abort_message
60    CHARACTER (len = 20)              :: modname = 'fonte_neige_init'
61
62
63!****************************************************************************************
64! Allocate run-off at landice and initilize with field read from restart
65!
66!****************************************************************************************
67
68    PRINT *,'Lluis in fonte_neige_init'
69    PRINT *,'restart_runoff:',UBOUND(restart_runoff)
70
71    ALLOCATE(run_off_lic_0(klon), stat = error)
72    PRINT *,'run_off_lic_0:',UBOUND(run_off_lic_0),' stat: ',error
73    IF (error /= 0) THEN
74       abort_message='Pb allocation run_off_lic'
75       CALL abort_gcm(modname,abort_message,1)
76    ENDIF
77    run_off_lic_0(:) = restart_runoff(:)
78
79!****************************************************************************************
80! Allocate other variables and initilize to zero
81!
82!****************************************************************************************
83    ALLOCATE(run_off_ter(klon), stat = error)
84    IF (error /= 0) THEN
85       abort_message='Pb allocation run_off_ter'
86       CALL abort_gcm(modname,abort_message,1)
87    ENDIF
88    run_off_ter(:) = 0.
89   
90    ALLOCATE(run_off_lic(klon), stat = error)
91    IF (error /= 0) THEN
92       abort_message='Pb allocation run_off_lic'
93       CALL abort_gcm(modname,abort_message,1)
94    ENDIF
95    run_off_lic(:) = 0.
96   
97    ALLOCATE(ffonte_global(klon,nbsrf))
98    IF (error /= 0) THEN
99       abort_message='Pb allocation ffonte_global'
100       CALL abort_gcm(modname,abort_message,1)
101    ENDIF
102    ffonte_global(:,:) = 0.0
103
104    ALLOCATE(fqfonte_global(klon,nbsrf))
105    IF (error /= 0) THEN
106       abort_message='Pb allocation fqfonte_global'
107       CALL abort_gcm(modname,abort_message,1)
108    ENDIF
109    fqfonte_global(:,:) = 0.0
110
111    ALLOCATE(fqcalving_global(klon,nbsrf))
112    IF (error /= 0) THEN
113       abort_message='Pb allocation fqcalving_global'
114       CALL abort_gcm(modname,abort_message,1)
115    ENDIF
116    fqcalving_global(:,:) = 0.0
117
118!****************************************************************************************
119! Read tau_calv
120!
121!****************************************************************************************
122    CALL conf_interface(tau_calv)
123
124
125  END SUBROUTINE fonte_neige_init
126!
127!****************************************************************************************
128!
129  SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, &
130       tsurf, precip_rain, precip_snow, &
131       snow, qsol, tsurf_new, evap)
132
133  USE indice_sol_mod
134       
135! Routine de traitement de la fonte de la neige dans le cas du traitement
136! de sol simplifie!
137! LF 03/2001
138! input:
139!   knon         nombre de points a traiter
140!   nisurf       surface a traiter
141!   knindex      index des mailles valables pour surface a traiter
142!   dtime       
143!   tsurf        temperature de surface
144!   precip_rain  precipitations liquides
145!   precip_snow  precipitations solides
146!
147! input/output:
148!   snow         champs hauteur de neige
149!   qsol         hauteur d'eau contenu dans le sol
150!   tsurf_new    temperature au sol
151!   evap
152!
153  INCLUDE "dimensions.h"
154  INCLUDE "YOETHF.h"
155  INCLUDE "YOMCST.h"
156  INCLUDE "FCTTRE.h"
157  INCLUDE "clesphys.h"
158
159! Input variables
160!****************************************************************************************
161    INTEGER, INTENT(IN)                  :: knon
162    INTEGER, INTENT(IN)                  :: nisurf
163    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
164    REAL   , INTENT(IN)                  :: dtime
165    REAL, DIMENSION(klon), INTENT(IN)    :: tsurf
166    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain
167    REAL, DIMENSION(klon), INTENT(IN)    :: precip_snow
168   
169! Input/Output variables
170!****************************************************************************************
171
172    REAL, DIMENSION(klon), INTENT(INOUT) :: snow
173    REAL, DIMENSION(klon), INTENT(INOUT) :: qsol
174    REAL, DIMENSION(klon), INTENT(INOUT) :: tsurf_new
175    REAL, DIMENSION(klon), INTENT(INOUT) :: evap
176
177! Local variables
178!****************************************************************************************
179
180    INTEGER               :: i, j
181    REAL                  :: fq_fonte
182    REAL                  :: coeff_rel
183    REAL, PARAMETER       :: snow_max=3000.
184    REAL, PARAMETER       :: max_eau_sol = 150.0
185!! PB temporaire en attendant mieux pour le modele de neige
186! REAL, parameter :: chasno = RLMLT/(2.3867E+06*0.15)
187    REAL, PARAMETER       :: chasno = 3.334E+05/(2.3867E+06*0.15)
188!IM cf JLD/ GKtest
189    REAL, PARAMETER       :: chaice = 3.334E+05/(2.3867E+06*0.15)
190! fin GKtest
191    REAL, DIMENSION(klon) :: ffonte
192    REAL, DIMENSION(klon) :: fqcalving, fqfonte
193    REAL, DIMENSION(klon) :: d_ts
194    REAL, DIMENSION(klon) :: bil_eau_s, snow_evap
195
196    LOGICAL               :: neige_fond
197
198!****************************************************************************************
199! Start calculation
200! - Initialization
201!
202!****************************************************************************************
203    coeff_rel = dtime/(tau_calv * rday)
204   
205    bil_eau_s(:) = 0.
206
207!****************************************************************************************
208! - Increment snow due to precipitation and evaporation
209! - Calculate the water balance due to precipitation and evaporation (bil_eau_s)
210!
211!****************************************************************************************
212    WHERE (precip_snow > 0.)
213       snow = snow + (precip_snow * dtime)
214    END WHERE
215
216    snow_evap = 0.
217    WHERE (evap > 0. )
218       snow_evap = MIN (snow / dtime, evap)
219       snow = snow - snow_evap * dtime
220       snow = MAX(0.0, snow)
221    END WHERE
222   
223    bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime
224
225
226!****************************************************************************************
227! - Calculate melting snow
228! - Calculate calving and decrement snow, if there are to much snow
229! - Update temperature at surface
230!
231!****************************************************************************************
232
233    ffonte(:) = 0.0
234    fqcalving(:) = 0.0
235    fqfonte(:) = 0.0
236    DO i = 1, knon
237       ! Y'a-t-il fonte de neige?
238       neige_fond = ((snow(i) > epsfra .OR. nisurf == is_sic .OR. nisurf == is_lic) &
239            .AND. tsurf_new(i) >= RTT)
240       IF (neige_fond) THEN
241          fq_fonte     = MIN( MAX((tsurf_new(i)-RTT )/chasno,0.0),snow(i))
242          ffonte(i)    = fq_fonte * RLMLT/dtime
243          fqfonte(i)   = fq_fonte/dtime
244          snow(i)      = MAX(0., snow(i) - fq_fonte)
245          bil_eau_s(i) = bil_eau_s(i) + fq_fonte
246          tsurf_new(i) = tsurf_new(i) - fq_fonte * chasno 
247
248!IM cf JLD OK     
249!IM cf JLD/ GKtest fonte aussi pour la glace
250          IF (nisurf == is_sic .OR. nisurf == is_lic ) THEN
251             fq_fonte = MAX((tsurf_new(i)-RTT )/chaice,0.0)
252             ffonte(i) = ffonte(i) + fq_fonte * RLMLT/dtime
253             IF ( ok_lic_melt ) THEN
254                fqfonte(i) = fqfonte(i) + fq_fonte/dtime
255                bil_eau_s(i) = bil_eau_s(i) + fq_fonte
256             ENDIF
257             tsurf_new(i) = RTT
258          ENDIF
259          d_ts(i) = tsurf_new(i) - tsurf(i)
260       ENDIF
261
262       ! s'il y a une hauteur trop importante de neige, elle s'coule
263       fqcalving(i) = MAX(0., snow(i) - snow_max)/dtime
264       snow(i)=MIN(snow(i),snow_max)
265    END DO
266
267    IF (nisurf == is_ter) THEN
268       DO i = 1, knon
269          qsol(i) = qsol(i) + bil_eau_s(i)
270! L. Fita, LMD. March 2014
271!   'run_off_ter' is not used anymore. Not need to worry about!
272!          run_off_ter(i) = run_off_ter(i) + MAX(qsol(i) - max_eau_sol, 0.0)
273          qsol(i) = MIN(qsol(i), max_eau_sol)
274       END DO
275    ELSE IF (nisurf == is_lic) THEN
276       DO i = 1, knon
277          j = knindex(i)
278          run_off_lic(i)   = (coeff_rel *  fqcalving(i)) + &
279               (1. - coeff_rel) * run_off_lic_0(j)
280          run_off_lic_0(j) = run_off_lic(i)
281          run_off_lic(i)   = run_off_lic(i) + fqfonte(i) + precip_rain(i)
282       END DO
283    ENDIF
284   
285!****************************************************************************************
286! Save ffonte, fqfonte and fqcalving in global arrays for each
287! sub-surface separately
288!
289!****************************************************************************************
290    PRINT *,'  Lluis in fonte_neige: ffonte_global: ',ALLOCATED(ffonte_global)
291    PRINT *,'    fqfonte_global: ',ALLOCATED(fqfonte_global)
292    PRINT *,'    fqcalving_global: ',ALLOCATED(fqcalving_global)
293    DO i = 1, knon
294       ffonte_global(knindex(i),nisurf)    = ffonte(i)
295       fqfonte_global(knindex(i),nisurf)   = fqfonte(i)
296       fqcalving_global(knindex(i),nisurf) = fqcalving(i)
297    ENDDO
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    PRINT *,'    Lluis: Ei, ei, ei !!!!! DEALLOCATING!!!!!!!'
319
320    IF (ALLOCATED(run_off_lic_0)) DEALLOCATE(run_off_lic_0)
321    IF (ALLOCATED(run_off_ter)) DEALLOCATE(run_off_ter)
322    IF (ALLOCATED(run_off_lic)) DEALLOCATE(run_off_lic)
323    IF (ALLOCATED(ffonte_global)) DEALLOCATE(ffonte_global)
324    IF (ALLOCATED(fqfonte_global)) DEALLOCATE(fqfonte_global)
325    IF (ALLOCATED(fqcalving_global)) DEALLOCATE(fqcalving_global)
326
327  END SUBROUTINE fonte_neige_final
328!
329!****************************************************************************************
330!
331  SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, &
332       fqfonte_out, ffonte_out)
333
334
335
336! Cumulate ffonte, fqfonte and fqcalving respectively for
337! all type of surfaces according to their fraction.
338!
339! This routine is called from physiq.F before histwrite.
340!****************************************************************************************
341
342  USE indice_sol_mod
343
344    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
345
346    REAL, DIMENSION(klon), INTENT(OUT)      :: fqcalving_out
347    REAL, DIMENSION(klon), INTENT(OUT)      :: fqfonte_out
348    REAL, DIMENSION(klon), INTENT(OUT)      :: ffonte_out
349
350    INTEGER   :: nisurf
351!****************************************************************************************
352
353    ffonte_out(:)    = 0.0
354    fqfonte_out(:)   = 0.0
355    fqcalving_out(:) = 0.0
356
357    DO nisurf = 1, nbsrf
358       ffonte_out(:) = ffonte_out(:) + ffonte_global(:,nisurf)*pctsrf(:,nisurf)
359       fqfonte_out(:) = fqfonte_out(:) + fqfonte_global(:,nisurf)*pctsrf(:,nisurf)
360       fqcalving_out(:) = fqcalving_out(:) + fqcalving_global(:,nisurf)*pctsrf(:,nisurf)
361    ENDDO
362
363  END SUBROUTINE fonte_neige_get_vars
364!
365!****************************************************************************************
366!
367END MODULE fonte_neige_mod
368
369
370
Note: See TracBrowser for help on using the repository browser.