GCC Code Coverage Report


Directory: ./
File: phys/fonte_neige_mod.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 98 115 85.2%
Branches: 126 190 66.3%

Line Branch Exec Source
1 !
2 ! $Header$
3 !
4 MODULE 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(:,:) :: ffonte_global
31 !$OMP THREADPRIVATE(ffonte_global)
32 REAL, ALLOCATABLE, DIMENSION(:,:) :: fqfonte_global
33 !$OMP THREADPRIVATE(fqfonte_global)
34 REAL, ALLOCATABLE, DIMENSION(:,:) :: fqcalving_global
35 !$OMP THREADPRIVATE(fqcalving_global)
36 REAL, ALLOCATABLE, DIMENSION(:) :: runofflic_global
37 !$OMP THREADPRIVATE(runofflic_global)
38
39 CONTAINS
40 !
41 !****************************************************************************************
42 !
43 1 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
4/8
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
1 ALLOCATE(run_off_lic_0(klon), stat = error)
65
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (error /= 0) THEN
66 abort_message='Pb allocation run_off_lic'
67 CALL abort_physic(modname,abort_message,1)
68 ENDIF
69
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 run_off_lic_0(:) = restart_runoff(:)
70
71 !****************************************************************************************
72 ! Allocate other variables and initilize to zero
73 !
74 !****************************************************************************************
75
4/8
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
1 ALLOCATE(run_off_ter(klon), stat = error)
76
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (error /= 0) THEN
77 abort_message='Pb allocation run_off_ter'
78 CALL abort_physic(modname,abort_message,1)
79 ENDIF
80
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 run_off_ter(:) = 0.
81
82
4/8
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
1 ALLOCATE(run_off_lic(klon), stat = error)
83
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (error /= 0) THEN
84 abort_message='Pb allocation run_off_lic'
85 CALL abort_physic(modname,abort_message,1)
86 ENDIF
87
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 run_off_lic(:) = 0.
88
89
3/6
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
1 ALLOCATE(ffonte_global(klon,nbsrf))
90
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (error /= 0) THEN
91 abort_message='Pb allocation ffonte_global'
92 CALL abort_physic(modname,abort_message,1)
93 ENDIF
94
4/4
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 3976 times.
✓ Branch 3 taken 4 times.
3981 ffonte_global(:,:) = 0.0
95
96
3/6
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
1 ALLOCATE(fqfonte_global(klon,nbsrf))
97
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (error /= 0) THEN
98 abort_message='Pb allocation fqfonte_global'
99 CALL abort_physic(modname,abort_message,1)
100 ENDIF
101
4/4
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 3976 times.
✓ Branch 3 taken 4 times.
3981 fqfonte_global(:,:) = 0.0
102
103
3/6
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
1 ALLOCATE(fqcalving_global(klon,nbsrf))
104
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (error /= 0) THEN
105 abort_message='Pb allocation fqcalving_global'
106 CALL abort_physic(modname,abort_message,1)
107 ENDIF
108
4/4
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 3976 times.
✓ Branch 3 taken 4 times.
3981 fqcalving_global(:,:) = 0.0
109
110
3/6
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
1 ALLOCATE(runofflic_global(klon))
111
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (error /= 0) THEN
112 abort_message='Pb allocation runofflic_global'
113 CALL abort_physic(modname,abort_message,1)
114 ENDIF
115
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 runofflic_global(:) = 0.0
116
117 !****************************************************************************************
118 ! Read tau_calv
119 !
120 !****************************************************************************************
121 1 CALL conf_interface(tau_calv)
122
123
124 1 END SUBROUTINE fonte_neige_init
125 !
126 !****************************************************************************************
127 !
128 1440 SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, &
129 1440 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 2880 REAL, DIMENSION(klon) :: ffonte
190 2880 REAL, DIMENSION(klon) :: fqcalving, fqfonte
191 2880 REAL, DIMENSION(klon) :: d_ts
192 2880 REAL, DIMENSION(klon) :: bil_eau_s, snow_evap
193
194 LOGICAL :: neige_fond
195
196 !****************************************************************************************
197 ! Start calculation
198 ! - Initialization
199 !
200 !****************************************************************************************
201 1440 coeff_rel = dtime/(tau_calv * rday)
202
203
2/2
✓ Branch 0 taken 1440 times.
✓ Branch 1 taken 1431360 times.
1432800 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
4/4
✓ Branch 0 taken 1440 times.
✓ Branch 1 taken 1431360 times.
✓ Branch 2 taken 287051 times.
✓ Branch 3 taken 1144309 times.
1432800 WHERE (precip_snow > 0.)
211 snow = snow + (precip_snow * dtime)
212 END WHERE
213
214
2/2
✓ Branch 0 taken 1431360 times.
✓ Branch 1 taken 1440 times.
1432800 snow_evap = 0.
215
216 1440 IF (.NOT. ok_lic_cond) THEN
217 !---only positive evaporation has an impact on snow
218 !---note that this could create a bit of water
219 !---this was the default until CMIP6
220 WHERE (evap > 0. )
221 snow_evap = MIN (snow / dtime, evap) !---one cannot evaporate more than the amount of snow
222 snow = snow - snow_evap * dtime !---snow that remains on the ground
223 snow = MAX(0.0, snow) !---just in case
224 END WHERE
225 ELSE
226 !--now considers both positive and negative evaporation in the budget of snow
227
2/2
✓ Branch 0 taken 1440 times.
✓ Branch 1 taken 1431360 times.
1432800 snow_evap = MIN (snow / dtime, evap) !---one cannot evaporate more than the amount of snow
228
2/2
✓ Branch 0 taken 1440 times.
✓ Branch 1 taken 1431360 times.
1432800 snow = snow - snow_evap * dtime !---snow that remains or deposits on the ground
229
2/2
✓ Branch 0 taken 1440 times.
✓ Branch 1 taken 1431360 times.
1432800 snow = MAX(0.0, snow) !---just in case
230 ENDIF
231
232
2/2
✓ Branch 0 taken 1440 times.
✓ Branch 1 taken 1431360 times.
1432800 bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime
233
234
235 !****************************************************************************************
236 ! - Calculate melting snow
237 ! - Calculate calving and decrement snow, if there are to much snow
238 ! - Update temperature at surface
239 !
240 !****************************************************************************************
241
242
2/2
✓ Branch 0 taken 1440 times.
✓ Branch 1 taken 1431360 times.
1432800 ffonte(:) = 0.0
243
2/2
✓ Branch 0 taken 1440 times.
✓ Branch 1 taken 1431360 times.
1432800 fqcalving(:) = 0.0
244
2/2
✓ Branch 0 taken 1431360 times.
✓ Branch 1 taken 1440 times.
1432800 fqfonte(:) = 0.0
245
246
2/2
✓ Branch 0 taken 425475 times.
✓ Branch 1 taken 1440 times.
426915 DO i = 1, knon
247 ! Y'a-t-il fonte de neige?
248
6/6
✓ Branch 0 taken 190163 times.
✓ Branch 1 taken 235312 times.
✓ Branch 2 taken 174984 times.
✓ Branch 3 taken 15179 times.
✓ Branch 4 taken 14683 times.
✓ Branch 5 taken 160301 times.
425475 neige_fond = (snow(i)>epsfra .OR. nisurf==is_sic .OR. nisurf==is_lic) .AND. tsurf_new(i)>=RTT
249 IF (neige_fond) THEN
250 45382 fq_fonte = MIN( MAX((tsurf_new(i)-RTT )/chasno,0.0),snow(i))
251 45382 ffonte(i) = fq_fonte * RLMLT/dtime
252 45382 fqfonte(i) = fq_fonte/dtime
253 45382 snow(i) = MAX(0., snow(i) - fq_fonte)
254 45382 bil_eau_s(i) = bil_eau_s(i) + fq_fonte
255 45382 tsurf_new(i) = tsurf_new(i) - fq_fonte * chasno
256
257 !IM cf JLD OK
258 !IM cf JLD/ GKtest fonte aussi pour la glace
259 45382 IF (nisurf == is_sic .OR. nisurf == is_lic ) THEN
260 23968 fq_fonte = MAX((tsurf_new(i)-RTT )/chaice,0.0)
261 23968 ffonte(i) = ffonte(i) + fq_fonte * RLMLT/dtime
262 23968 IF ( ok_lic_melt ) THEN
263 fqfonte(i) = fqfonte(i) + fq_fonte/dtime
264 bil_eau_s(i) = bil_eau_s(i) + fq_fonte
265 ENDIF
266 23968 tsurf_new(i) = RTT
267 ENDIF
268 45382 d_ts(i) = tsurf_new(i) - tsurf(i)
269 ENDIF
270
271 ! s'il y a une hauteur trop importante de neige, elle est ecretee
272 425475 fqcalving(i) = MAX(0., snow(i) - snow_max)/dtime
273 426915 snow(i)=MIN(snow(i),snow_max)
274 ENDDO
275
276
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 960 times.
1440 IF (nisurf == is_ter) THEN
277
2/2
✓ Branch 0 taken 247680 times.
✓ Branch 1 taken 480 times.
248160 DO i = 1, knon
278 247680 qsol(i) = qsol(i) + bil_eau_s(i)
279 247680 run_off_ter(i) = run_off_ter(i) + MAX(qsol(i) - max_eau_sol, 0.0)
280 248160 qsol(i) = MIN(qsol(i), max_eau_sol)
281 ENDDO
282
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 480 times.
960 ELSE IF (nisurf == is_lic) THEN
283
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 72960 times.
73440 DO i = 1, knon
284 72960 j = knindex(i)
285 !--temporal filtering
286 72960 run_off_lic(i) = coeff_rel*fqcalving(i) + (1.-coeff_rel)*run_off_lic_0(j)
287 72960 run_off_lic_0(j) = run_off_lic(i)
288 !--add melting snow and liquid precip to runoff of ice cap
289 73440 run_off_lic(i) = run_off_lic(i) + fqfonte(i) + precip_rain(i)
290 ENDDO
291 ENDIF
292
293 !****************************************************************************************
294 ! Save ffonte, fqfonte and fqcalving in global arrays for each
295 ! sub-surface separately
296 !
297 !****************************************************************************************
298
2/2
✓ Branch 0 taken 425475 times.
✓ Branch 1 taken 1440 times.
426915 DO i = 1, knon
299 425475 ffonte_global(knindex(i),nisurf) = ffonte(i)
300 425475 fqfonte_global(knindex(i),nisurf) = fqfonte(i)
301 426915 fqcalving_global(knindex(i),nisurf) = fqcalving(i)
302 ENDDO
303
304
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 960 times.
1440 IF (nisurf == is_lic) THEN
305
2/2
✓ Branch 0 taken 72960 times.
✓ Branch 1 taken 480 times.
73440 DO i = 1, knon
306 73440 runofflic_global(knindex(i)) = run_off_lic(i)
307 ENDDO
308 ENDIF
309
310 1440 END SUBROUTINE fonte_neige
311 !
312 !****************************************************************************************
313 !
314 1 SUBROUTINE fonte_neige_final(restart_runoff)
315 !
316 ! This subroutine returns run_off_lic_0 for later writing to restart file.
317 !
318 !****************************************************************************************
319 REAL, DIMENSION(klon), INTENT(OUT) :: restart_runoff
320
321 !****************************************************************************************
322 ! Set the output variables
323
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 restart_runoff(:) = run_off_lic_0(:)
324
325 ! Deallocation of all varaibles in the module
326 ! DEALLOCATE(run_off_lic_0, run_off_ter, run_off_lic, ffonte_global, &
327 ! fqfonte_global, fqcalving_global)
328
329
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (ALLOCATED(run_off_lic_0)) DEALLOCATE(run_off_lic_0)
330
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (ALLOCATED(run_off_ter)) DEALLOCATE(run_off_ter)
331
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (ALLOCATED(run_off_lic)) DEALLOCATE(run_off_lic)
332
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (ALLOCATED(ffonte_global)) DEALLOCATE(ffonte_global)
333
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (ALLOCATED(fqfonte_global)) DEALLOCATE(fqfonte_global)
334
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (ALLOCATED(fqcalving_global)) DEALLOCATE(fqcalving_global)
335
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (ALLOCATED(runofflic_global)) DEALLOCATE(runofflic_global)
336
337
6/8
✓ Branch 0 taken 1440 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 45382 times.
✓ Branch 3 taken 219792 times.
✓ Branch 4 taken 23968 times.
✓ Branch 5 taken 21414 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 23968 times.
268054 END SUBROUTINE fonte_neige_final
338 !
339 !****************************************************************************************
340 !
341 480 SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, &
342 480 fqfonte_out, ffonte_out, run_off_lic_out)
343
344
345 ! Cumulate ffonte, fqfonte and fqcalving respectively for
346 ! all type of surfaces according to their fraction.
347 !
348 ! This routine is called from physiq.F before histwrite.
349 !****************************************************************************************
350
351 USE indice_sol_mod
352
353 REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
354
355 REAL, DIMENSION(klon), INTENT(OUT) :: fqcalving_out
356 REAL, DIMENSION(klon), INTENT(OUT) :: fqfonte_out
357 REAL, DIMENSION(klon), INTENT(OUT) :: ffonte_out
358 REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_out
359
360 INTEGER :: nisurf
361 !****************************************************************************************
362
363
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
477600 ffonte_out(:) = 0.0
364
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
477600 fqfonte_out(:) = 0.0
365
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
477600 fqcalving_out(:) = 0.0
366
367
2/2
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
2400 DO nisurf = 1, nbsrf
368
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910400 ffonte_out(:) = ffonte_out(:) + ffonte_global(:,nisurf)*pctsrf(:,nisurf)
369
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910400 fqfonte_out(:) = fqfonte_out(:) + fqfonte_global(:,nisurf)*pctsrf(:,nisurf)
370
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910880 fqcalving_out(:) = fqcalving_out(:) + fqcalving_global(:,nisurf)*pctsrf(:,nisurf)
371 ENDDO
372
373
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 run_off_lic_out(:)=runofflic_global(:)
374
375 480 END SUBROUTINE fonte_neige_get_vars
376 !
377 !****************************************************************************************
378 !
379 END MODULE fonte_neige_mod
380