source: CONFIG/UNIFORM/v6/IPSLCM5A2/SOURCES/LMDZ/PALEO/fonte_neige_mod.F90 @ 5879

Last change on this file since 5879 was 5879, checked in by snguyen, 3 years ago

Modified Makefile to add configuration PALEOIPSLCM5A2-VLR while retaining IPSLCM5A2-VLR as default configuration for compilation. Moved NEMO SOURCES of IPSLCM5A2-VLR to SOURCES/NEMO/STANDARD and created SOURCES/NEMO/PALEO for PALEOIPSLCM5A2-VLR configuration. Created paleolmdz in Makefile to compile LMDZ sources in SOURCES/LMDZ/PALEO. Added experiments IPSLCM/paleo and LMDZOR/paleo. Added file_def_nemo-lim2_paleo.xml file_def_histmth_lmdz_paleo.xml file_def_nemo-opa_paleo.xml file_def_nemo-pisces_rivers_paleo.xml file_def_nemo-pisces_paleo.xml file_def_orchidee_paleo.xml namelist_ORCA2_cfg_paleo namelist_pisces_ORCA2_cfg_paleo to GENERAL/PARAM for paleo configurations. Set day_step=720 in GENERAL/PARAM/gcm.def_96x95 for paleo configurations. Modified GENERAL/DRIVER/opa9.driver to use namelist_ORCA2_cfg_paleo for paleo configurations.
  • Property svn:executable set to *
File size: 13.2 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! Modif for simulations with no land ice. Because we have a landice point
249! on the South Pole (otherwise ORCHIDEE crashes), we alter some of the
250! properties to simulate a bare soil point even though it is land ice.
251! (ie comment line below) -- JBL 08.02.2017
252          !IF (nisurf == is_sic .OR. nisurf == is_lic ) THEN
253          IF (nisurf == is_sic ) THEN
254             fq_fonte = MAX((tsurf_new(i)-RTT )/chaice,0.0)
255             ffonte(i) = ffonte(i) + fq_fonte * RLMLT/dtime
256             IF ( ok_lic_melt ) THEN
257                fqfonte(i) = fqfonte(i) + fq_fonte/dtime
258                bil_eau_s(i) = bil_eau_s(i) + fq_fonte
259             ENDIF
260             tsurf_new(i) = RTT
261          ENDIF
262          d_ts(i) = tsurf_new(i) - tsurf(i)
263       ENDIF
264
265       ! s'il y a une hauteur trop importante de neige, elle s'coule
266       fqcalving(i) = MAX(0., snow(i) - snow_max)/dtime
267       snow(i)=MIN(snow(i),snow_max)
268    END DO
269
270
271    IF (nisurf == is_ter) THEN
272       DO i = 1, knon
273          qsol(i) = qsol(i) + bil_eau_s(i)
274          run_off_ter(i) = run_off_ter(i) + MAX(qsol(i) - max_eau_sol, 0.0)
275          qsol(i) = MIN(qsol(i), max_eau_sol) 
276       END DO
277    ELSE IF (nisurf == is_lic) THEN
278       DO i = 1, knon
279          j = knindex(i)
280          run_off_lic(i)   = (coeff_rel *  fqcalving(i)) + &
281               (1. - coeff_rel) * run_off_lic_0(j)
282          run_off_lic_0(j) = run_off_lic(i)
283          run_off_lic(i)   = run_off_lic(i) + fqfonte(i) + precip_rain(i)
284       END DO
285    ENDIF
286   
287!****************************************************************************************
288! Save ffonte, fqfonte and fqcalving in global arrays for each
289! sub-surface separately
290!
291!****************************************************************************************
292    DO i = 1, knon
293       ffonte_global(knindex(i),nisurf)    = ffonte(i)
294       fqfonte_global(knindex(i),nisurf)   = fqfonte(i)
295       fqcalving_global(knindex(i),nisurf) = fqcalving(i)
296    ENDDO
297
298    IF (nisurf == is_lic) THEN
299    DO i = 1, knon
300       runofflic_global(knindex(i)) = run_off_lic(i)
301    ENDDO
302    ENDIF
303
304  END SUBROUTINE fonte_neige
305!
306!****************************************************************************************
307!
308  SUBROUTINE fonte_neige_final(restart_runoff)
309!
310! This subroutine returns run_off_lic_0 for later writing to restart file.
311!
312!****************************************************************************************
313    REAL, DIMENSION(klon), INTENT(OUT) :: restart_runoff
314
315!****************************************************************************************
316! Set the output variables
317    restart_runoff(:) = run_off_lic_0(:)
318
319! Deallocation of all varaibles in the module
320!   DEALLOCATE(run_off_lic_0, run_off_ter, run_off_lic, ffonte_global, &
321!        fqfonte_global, fqcalving_global)
322
323    IF (ALLOCATED(run_off_lic_0)) DEALLOCATE(run_off_lic_0)
324    IF (ALLOCATED(run_off_ter)) DEALLOCATE(run_off_ter)
325    IF (ALLOCATED(run_off_lic)) DEALLOCATE(run_off_lic)
326    IF (ALLOCATED(ffonte_global)) DEALLOCATE(ffonte_global)
327    IF (ALLOCATED(fqfonte_global)) DEALLOCATE(fqfonte_global)
328    IF (ALLOCATED(fqcalving_global)) DEALLOCATE(fqcalving_global)
329    IF (ALLOCATED(runofflic_global)) DEALLOCATE(runofflic_global)
330
331  END SUBROUTINE fonte_neige_final
332!
333!****************************************************************************************
334!
335  SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, &
336       fqfonte_out, ffonte_out, run_off_lic_out)
337
338
339! Cumulate ffonte, fqfonte and fqcalving respectively for
340! all type of surfaces according to their fraction.
341!
342! This routine is called from physiq.F before histwrite.
343!****************************************************************************************
344
345  USE indice_sol_mod
346
347    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
348
349    REAL, DIMENSION(klon), INTENT(OUT)      :: fqcalving_out
350    REAL, DIMENSION(klon), INTENT(OUT)      :: fqfonte_out
351    REAL, DIMENSION(klon), INTENT(OUT)      :: ffonte_out
352    REAL, DIMENSION(klon), INTENT(OUT)      :: run_off_lic_out
353
354    INTEGER   :: nisurf
355!****************************************************************************************
356
357    ffonte_out(:)    = 0.0
358    fqfonte_out(:)   = 0.0
359    fqcalving_out(:) = 0.0
360
361    DO nisurf = 1, nbsrf
362       ffonte_out(:) = ffonte_out(:) + ffonte_global(:,nisurf)*pctsrf(:,nisurf)
363       fqfonte_out(:) = fqfonte_out(:) + fqfonte_global(:,nisurf)*pctsrf(:,nisurf)
364       fqcalving_out(:) = fqcalving_out(:) + fqcalving_global(:,nisurf)*pctsrf(:,nisurf)
365    ENDDO
366
367    run_off_lic_out(:)=runofflic_global(:)
368
369  END SUBROUTINE fonte_neige_get_vars
370!
371!****************************************************************************************
372!
373END MODULE fonte_neige_mod
Note: See TracBrowser for help on using the repository browser.