source: lmdz_wrf/trunk/WRFV3/lmdz/fonte_neige_mod.F90 @ 354

Last change on this file since 354 was 7, checked in by lfita, 10 years ago

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