Head

GCC Code Coverage Report

Directory:	./		Exec	Total	Coverage
File:	phylmd/fonte_neige_mod.F90	Lines:	98	115	85.2 %
Date:	2023-06-30 12:51:15	Branches:	126	190	66.3 %


!
! $Header$
!
MODULE fonte_neige_mod
!
! This module will treat the process of snow, melting, accumulating, calving, in
! case of simplified soil model.
!
!****************************************************************************************
  USE dimphy, ONLY : klon
  USE indice_sol_mod

  IMPLICIT NONE
  SAVE

! run_off_ter and run_off_lic are the runoff at the compressed grid knon for
! land and land-ice respectively
! Note: run_off_lic is used in mod_landice and therfore not private
  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE    :: run_off_ter
  !$OMP THREADPRIVATE(run_off_ter)
  REAL, ALLOCATABLE, DIMENSION(:)             :: run_off_lic
  !$OMP THREADPRIVATE(run_off_lic)

! run_off_lic_0 is the runoff at land-ice a time-step earlier, on the global 1D array grid
  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE    :: run_off_lic_0
  !$OMP THREADPRIVATE(run_off_lic_0)

  REAL, PRIVATE                               :: tau_calv
  !$OMP THREADPRIVATE(tau_calv)
  REAL, ALLOCATABLE, DIMENSION(:,:)           :: ffonte_global
  !$OMP THREADPRIVATE(ffonte_global)
  REAL, ALLOCATABLE, DIMENSION(:,:)           :: fqfonte_global
  !$OMP THREADPRIVATE(fqfonte_global)
  REAL, ALLOCATABLE, DIMENSION(:,:)           :: fqcalving_global
  !$OMP THREADPRIVATE(fqcalving_global)
  REAL, ALLOCATABLE, DIMENSION(:)             :: runofflic_global
  !$OMP THREADPRIVATE(runofflic_global)

CONTAINS
!
!****************************************************************************************
!
  SUBROUTINE fonte_neige_init(restart_runoff)

! This subroutine allocates and initialize variables in the module.
! The variable run_off_lic_0 is initialized to the field read from
! restart file. The other variables are initialized to zero.
!
!****************************************************************************************
! Input argument
    REAL, DIMENSION(klon), INTENT(IN) :: restart_runoff

! Local variables
    INTEGER                           :: error
    CHARACTER (len = 80)              :: abort_message
    CHARACTER (len = 20)              :: modname = 'fonte_neige_init'


!****************************************************************************************
! Allocate run-off at landice and initilize with field read from restart
!
!****************************************************************************************

    ALLOCATE(run_off_lic_0(klon), stat = error)
    IF (error /= 0) THEN
       abort_message='Pb allocation run_off_lic'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    run_off_lic_0(:) = restart_runoff(:)

!****************************************************************************************
! Allocate other variables and initilize to zero
!
!****************************************************************************************
    ALLOCATE(run_off_ter(klon), stat = error)
    IF (error /= 0) THEN
       abort_message='Pb allocation run_off_ter'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    run_off_ter(:) = 0.

    ALLOCATE(run_off_lic(klon), stat = error)
    IF (error /= 0) THEN
       abort_message='Pb allocation run_off_lic'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    run_off_lic(:) = 0.

    ALLOCATE(ffonte_global(klon,nbsrf))
    IF (error /= 0) THEN
       abort_message='Pb allocation ffonte_global'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    ffonte_global(:,:) = 0.0

    ALLOCATE(fqfonte_global(klon,nbsrf))
    IF (error /= 0) THEN
       abort_message='Pb allocation fqfonte_global'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    fqfonte_global(:,:) = 0.0

    ALLOCATE(fqcalving_global(klon,nbsrf))
    IF (error /= 0) THEN
       abort_message='Pb allocation fqcalving_global'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    fqcalving_global(:,:) = 0.0

    ALLOCATE(runofflic_global(klon))
    IF (error /= 0) THEN
       abort_message='Pb allocation runofflic_global'
       CALL abort_physic(modname,abort_message,1)
    ENDIF
    runofflic_global(:) = 0.0

!****************************************************************************************
! Read tau_calv
!
!****************************************************************************************
    CALL conf_interface(tau_calv)


  END SUBROUTINE fonte_neige_init
!
!****************************************************************************************
!
  SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, &
       tsurf, precip_rain, precip_snow, &
       snow, qsol, tsurf_new, evap)

  USE indice_sol_mod

! Routine de traitement de la fonte de la neige dans le cas du traitement
! de sol simplifie!
! LF 03/2001
! input:
!   knon         nombre de points a traiter
!   nisurf       surface a traiter
!   knindex      index des mailles valables pour surface a traiter
!   dtime
!   tsurf        temperature de surface
!   precip_rain  precipitations liquides
!   precip_snow  precipitations solides
!
! input/output:
!   snow         champs hauteur de neige
!   qsol         hauteur d'eau contenu dans le sol
!   tsurf_new    temperature au sol
!   evap
!
  INCLUDE "YOETHF.h"
  INCLUDE "YOMCST.h"
  INCLUDE "FCTTRE.h"
  INCLUDE "clesphys.h"

! Input variables
!****************************************************************************************
    INTEGER, INTENT(IN)                  :: knon
    INTEGER, INTENT(IN)                  :: nisurf
    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
    REAL   , INTENT(IN)                  :: dtime
    REAL, DIMENSION(klon), INTENT(IN)    :: tsurf
    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain
    REAL, DIMENSION(klon), INTENT(IN)    :: precip_snow

    ! Input/Output variables
!****************************************************************************************

    REAL, DIMENSION(klon), INTENT(INOUT) :: snow
    REAL, DIMENSION(klon), INTENT(INOUT) :: qsol
    REAL, DIMENSION(klon), INTENT(INOUT) :: tsurf_new
    REAL, DIMENSION(klon), INTENT(INOUT) :: evap

! Local variables
!****************************************************************************************

    INTEGER               :: i, j
    REAL                  :: fq_fonte
    REAL                  :: coeff_rel
    REAL, PARAMETER       :: snow_max=3000.
    REAL, PARAMETER       :: max_eau_sol = 150.0
!! PB temporaire en attendant mieux pour le modele de neige
! REAL, parameter :: chasno = RLMLT/(2.3867E+06*0.15)
    REAL, PARAMETER       :: chasno = 3.334E+05/(2.3867E+06*0.15)
!IM cf JLD/ GKtest
    REAL, PARAMETER       :: chaice = 3.334E+05/(2.3867E+06*0.15)
! fin GKtest
    REAL, DIMENSION(klon) :: ffonte
    REAL, DIMENSION(klon) :: fqcalving, fqfonte
    REAL, DIMENSION(klon) :: d_ts
    REAL, DIMENSION(klon) :: bil_eau_s, snow_evap

    LOGICAL               :: neige_fond

!****************************************************************************************
! Start calculation
! - Initialization
!
!****************************************************************************************
    coeff_rel = dtime/(tau_calv * rday)

    bil_eau_s(:) = 0.

!****************************************************************************************
! - Increment snow due to precipitation and evaporation
! - Calculate the water balance due to precipitation and evaporation (bil_eau_s)
!
!****************************************************************************************
    WHERE (precip_snow > 0.)
       snow = snow + (precip_snow * dtime)
    END WHERE

    snow_evap = 0.

    IF (.NOT. ok_lic_cond) THEN
!---only positive evaporation has an impact on snow
!---note that this could create a bit of water
!---this was the default until CMIP6
      WHERE (evap > 0. )
         snow_evap = MIN (snow / dtime, evap)    !---one cannot evaporate more than the amount of snow
         snow = snow - snow_evap * dtime         !---snow that remains on the ground
         snow = MAX(0.0, snow)                   !---just in case
      END WHERE
    ELSE
!--now considers both positive and negative evaporation in the budget of snow
      snow_evap = MIN (snow / dtime, evap)    !---one cannot evaporate more than the amount of snow
      snow = snow - snow_evap * dtime         !---snow that remains or deposits on the ground
      snow = MAX(0.0, snow)                   !---just in case
   ENDIF

    bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime


!****************************************************************************************
! - Calculate melting snow
! - Calculate calving and decrement snow, if there are to much snow
! - Update temperature at surface
!
!****************************************************************************************

    ffonte(:) = 0.0
    fqcalving(:) = 0.0
    fqfonte(:) = 0.0

    DO i = 1, knon
       ! Y'a-t-il fonte de neige?
       neige_fond = (snow(i)>epsfra .OR. nisurf==is_sic .OR. nisurf==is_lic) .AND. tsurf_new(i)>=RTT
       IF (neige_fond) THEN
          fq_fonte     = MIN( MAX((tsurf_new(i)-RTT )/chasno,0.0),snow(i))
          ffonte(i)    = fq_fonte * RLMLT/dtime
          fqfonte(i)   = fq_fonte/dtime
          snow(i)      = MAX(0., snow(i) - fq_fonte)
          bil_eau_s(i) = bil_eau_s(i) + fq_fonte
          tsurf_new(i) = tsurf_new(i) - fq_fonte * chasno

!IM cf JLD OK
!IM cf JLD/ GKtest fonte aussi pour la glace
          IF (nisurf == is_sic .OR. nisurf == is_lic ) THEN
             fq_fonte = MAX((tsurf_new(i)-RTT )/chaice,0.0)
             ffonte(i) = ffonte(i) + fq_fonte * RLMLT/dtime
             IF ( ok_lic_melt ) THEN
                fqfonte(i) = fqfonte(i) + fq_fonte/dtime
                bil_eau_s(i) = bil_eau_s(i) + fq_fonte
             ENDIF
             tsurf_new(i) = RTT
          ENDIF
          d_ts(i) = tsurf_new(i) - tsurf(i)
       ENDIF

       ! s'il y a une hauteur trop importante de neige, elle est ecretee
       fqcalving(i) = MAX(0., snow(i) - snow_max)/dtime
       snow(i)=MIN(snow(i),snow_max)
    ENDDO

    IF (nisurf == is_ter) THEN
       DO i = 1, knon
          qsol(i) = qsol(i) + bil_eau_s(i)
          run_off_ter(i) = run_off_ter(i) + MAX(qsol(i) - max_eau_sol, 0.0)
          qsol(i) = MIN(qsol(i), max_eau_sol)
       ENDDO
    ELSE IF (nisurf == is_lic) THEN
       DO i = 1, knon
          j = knindex(i)
          !--temporal filtering
          run_off_lic(i)   = coeff_rel*fqcalving(i) + (1.-coeff_rel)*run_off_lic_0(j)
          run_off_lic_0(j) = run_off_lic(i)
          !--add melting snow and liquid precip to runoff of ice cap
          run_off_lic(i)   = run_off_lic(i) + fqfonte(i) + precip_rain(i)
       ENDDO
    ENDIF

!****************************************************************************************
! Save ffonte, fqfonte and fqcalving in global arrays for each
! sub-surface separately
!
!****************************************************************************************
    DO i = 1, knon
       ffonte_global(knindex(i),nisurf)    = ffonte(i)
       fqfonte_global(knindex(i),nisurf)   = fqfonte(i)
       fqcalving_global(knindex(i),nisurf) = fqcalving(i)
    ENDDO

    IF (nisurf == is_lic) THEN
    DO i = 1, knon
       runofflic_global(knindex(i)) = run_off_lic(i)
    ENDDO
    ENDIF

  END SUBROUTINE fonte_neige
!
!****************************************************************************************
!
  SUBROUTINE fonte_neige_final(restart_runoff)
!
! This subroutine returns run_off_lic_0 for later writing to restart file.
!
!****************************************************************************************
    REAL, DIMENSION(klon), INTENT(OUT) :: restart_runoff

!****************************************************************************************
! Set the output variables
    restart_runoff(:) = run_off_lic_0(:)

! Deallocation of all varaibles in the module
!   DEALLOCATE(run_off_lic_0, run_off_ter, run_off_lic, ffonte_global, &
!        fqfonte_global, fqcalving_global)

    IF (ALLOCATED(run_off_lic_0)) DEALLOCATE(run_off_lic_0)
    IF (ALLOCATED(run_off_ter)) DEALLOCATE(run_off_ter)
    IF (ALLOCATED(run_off_lic)) DEALLOCATE(run_off_lic)
    IF (ALLOCATED(ffonte_global)) DEALLOCATE(ffonte_global)
    IF (ALLOCATED(fqfonte_global)) DEALLOCATE(fqfonte_global)
    IF (ALLOCATED(fqcalving_global)) DEALLOCATE(fqcalving_global)
    IF (ALLOCATED(runofflic_global)) DEALLOCATE(runofflic_global)

  END SUBROUTINE fonte_neige_final
!
!****************************************************************************************
!
  SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, &
       fqfonte_out, ffonte_out, run_off_lic_out)


! Cumulate ffonte, fqfonte and fqcalving respectively for
! all type of surfaces according to their fraction.
!
! This routine is called from physiq.F before histwrite.
!****************************************************************************************

  USE indice_sol_mod

    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf

    REAL, DIMENSION(klon), INTENT(OUT)      :: fqcalving_out
    REAL, DIMENSION(klon), INTENT(OUT)      :: fqfonte_out
    REAL, DIMENSION(klon), INTENT(OUT)      :: ffonte_out
    REAL, DIMENSION(klon), INTENT(OUT)      :: run_off_lic_out

    INTEGER   :: nisurf
!****************************************************************************************

    ffonte_out(:)    = 0.0
    fqfonte_out(:)   = 0.0
    fqcalving_out(:) = 0.0

    DO nisurf = 1, nbsrf
       ffonte_out(:) = ffonte_out(:) + ffonte_global(:,nisurf)*pctsrf(:,nisurf)
       fqfonte_out(:) = fqfonte_out(:) + fqfonte_global(:,nisurf)*pctsrf(:,nisurf)
       fqcalving_out(:) = fqcalving_out(:) + fqcalving_global(:,nisurf)*pctsrf(:,nisurf)
    ENDDO

    run_off_lic_out(:)=runofflic_global(:)

  END SUBROUTINE fonte_neige_get_vars
!
!****************************************************************************************
!
END MODULE fonte_neige_mod


Generated by: GCOVR (Version 4.2)

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	✓✗✓✗ ✗✓✓✗	1	ALLOCATE(run_off_lic_0(klon), stat = error)
65	✗✓	1	IF (error /= 0) THEN
66			abort_message='Pb allocation run_off_lic'
67			CALL abort_physic(modname,abort_message,1)
68			ENDIF
69	✓✓	995	run_off_lic_0(:) = restart_runoff(:)
70
71			!****************************************************************************************
72			! Allocate other variables and initilize to zero
73			!
74			!****************************************************************************************
75	✓✗✓✗ ✗✓✓✗	1	ALLOCATE(run_off_ter(klon), stat = error)
76	✗✓	1	IF (error /= 0) THEN
77			abort_message='Pb allocation run_off_ter'
78			CALL abort_physic(modname,abort_message,1)
79			ENDIF
80	✓✓	995	run_off_ter(:) = 0.
81
82	✓✗✓✗ ✗✓✓✗	1	ALLOCATE(run_off_lic(klon), stat = error)
83	✗✓	1	IF (error /= 0) THEN
84			abort_message='Pb allocation run_off_lic'
85			CALL abort_physic(modname,abort_message,1)
86			ENDIF
87	✓✓	995	run_off_lic(:) = 0.
88
89	✓✗✗✓ ✗✓	1	ALLOCATE(ffonte_global(klon,nbsrf))
90	✗✓	1	IF (error /= 0) THEN
91			abort_message='Pb allocation ffonte_global'
92			CALL abort_physic(modname,abort_message,1)
93			ENDIF
94	✓✓✓✓	3981	ffonte_global(:,:) = 0.0
95
96	✓✗✗✓ ✗✓	1	ALLOCATE(fqfonte_global(klon,nbsrf))
97	✗✓	1	IF (error /= 0) THEN
98			abort_message='Pb allocation fqfonte_global'
99			CALL abort_physic(modname,abort_message,1)
100			ENDIF
101	✓✓✓✓	3981	fqfonte_global(:,:) = 0.0
102
103	✓✗✗✓ ✗✓	1	ALLOCATE(fqcalving_global(klon,nbsrf))
104	✗✓	1	IF (error /= 0) THEN
105			abort_message='Pb allocation fqcalving_global'
106			CALL abort_physic(modname,abort_message,1)
107			ENDIF
108	✓✓✓✓	3981	fqcalving_global(:,:) = 0.0
109
110	✓✗✗✓ ✗✓	1	ALLOCATE(runofflic_global(klon))
111	✗✓	1	IF (error /= 0) THEN
112			abort_message='Pb allocation runofflic_global'
113			CALL abort_physic(modname,abort_message,1)
114			ENDIF
115	✓✓	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		864	SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, &
129		864	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		1728	REAL, DIMENSION(klon) :: ffonte
190		1728	REAL, DIMENSION(klon) :: fqcalving, fqfonte
191		1728	REAL, DIMENSION(klon) :: d_ts
192		1728	REAL, DIMENSION(klon) :: bil_eau_s, snow_evap
193
194			LOGICAL :: neige_fond
195
196			!****************************************************************************************
197			! Start calculation
198			! - Initialization
199			!
200			!****************************************************************************************
201		864	coeff_rel = dtime/(tau_calv * rday)
202
203	✓✓	859680	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	✓✓✓✓	859680	WHERE (precip_snow > 0.)
211			snow = snow + (precip_snow * dtime)
212			END WHERE
213
214	✓✓	859680	snow_evap = 0.
215
216		864	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	✓✓	859680	snow_evap = MIN (snow / dtime, evap) !---one cannot evaporate more than the amount of snow
228	✓✓	859680	snow = snow - snow_evap * dtime !---snow that remains or deposits on the ground
229	✓✓	859680	snow = MAX(0.0, snow) !---just in case
230			ENDIF
231
232	✓✓	859680	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	✓✓	859680	ffonte(:) = 0.0
243	✓✓	859680	fqcalving(:) = 0.0
244	✓✓	859680	fqfonte(:) = 0.0
245
246	✓✓	255938	DO i = 1, knon
247			! Y'a-t-il fonte de neige?
248	✓✓✓✓ ✓✓	255074	neige_fond = (snow(i)>epsfra .OR. nisurf==is_sic .OR. nisurf==is_lic) .AND. tsurf_new(i)>=RTT
249			IF (neige_fond) THEN
250		23137	fq_fonte = MIN( MAX((tsurf_new(i)-RTT )/chasno,0.0),snow(i))
251		23137	ffonte(i) = fq_fonte * RLMLT/dtime
252		23137	fqfonte(i) = fq_fonte/dtime
253		23137	snow(i) = MAX(0., snow(i) - fq_fonte)
254		23137	bil_eau_s(i) = bil_eau_s(i) + fq_fonte
255		23137	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		23137	IF (nisurf == is_sic .OR. nisurf == is_lic ) THEN
260		12402	fq_fonte = MAX((tsurf_new(i)-RTT )/chaice,0.0)
261		12402	ffonte(i) = ffonte(i) + fq_fonte * RLMLT/dtime
262		12402	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		12402	tsurf_new(i) = RTT
267			ENDIF
268		23137	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		255074	fqcalving(i) = MAX(0., snow(i) - snow_max)/dtime
273		255938	snow(i)=MIN(snow(i),snow_max)
274			ENDDO
275
276	✓✓	864	IF (nisurf == is_ter) THEN
277	✓✓	148896	DO i = 1, knon
278		148608	qsol(i) = qsol(i) + bil_eau_s(i)
279		148608	run_off_ter(i) = run_off_ter(i) + MAX(qsol(i) - max_eau_sol, 0.0)
280		148896	qsol(i) = MIN(qsol(i), max_eau_sol)
281			ENDDO
282	✓✓	576	ELSE IF (nisurf == is_lic) THEN
283	✓✓	44064	DO i = 1, knon
284		43776	j = knindex(i)
285			!--temporal filtering
286		43776	run_off_lic(i) = coeff_relfqcalving(i) + (1.-coeff_rel)run_off_lic_0(j)
287		43776	run_off_lic_0(j) = run_off_lic(i)
288			!--add melting snow and liquid precip to runoff of ice cap
289		44064	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	✓✓	255938	DO i = 1, knon
299		255074	ffonte_global(knindex(i),nisurf) = ffonte(i)
300		255074	fqfonte_global(knindex(i),nisurf) = fqfonte(i)
301		255938	fqcalving_global(knindex(i),nisurf) = fqcalving(i)
302			ENDDO
303
304	✓✓	864	IF (nisurf == is_lic) THEN
305	✓✓	44064	DO i = 1, knon
306		44064	runofflic_global(knindex(i)) = run_off_lic(i)
307			ENDDO
308			ENDIF
309
310		864	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	✓✓	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	IF (ALLOCATED(run_off_lic_0)) DEALLOCATE(run_off_lic_0)
330	✓✗	1	IF (ALLOCATED(run_off_ter)) DEALLOCATE(run_off_ter)
331	✓✗	1	IF (ALLOCATED(run_off_lic)) DEALLOCATE(run_off_lic)
332	✓✗	1	IF (ALLOCATED(ffonte_global)) DEALLOCATE(ffonte_global)
333	✓✗	1	IF (ALLOCATED(fqfonte_global)) DEALLOCATE(fqfonte_global)
334	✓✗	1	IF (ALLOCATED(fqcalving_global)) DEALLOCATE(fqcalving_global)
335	✓✗	1	IF (ALLOCATED(runofflic_global)) DEALLOCATE(runofflic_global)
336
337	✓✗✓✓ ✓✓✗✓	159357	END SUBROUTINE fonte_neige_final
338			!
339			!****************************************************************************************
340			!
341		288	SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, &
342		288	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	✓✓	286560	ffonte_out(:) = 0.0
364	✓✓	286560	fqfonte_out(:) = 0.0
365	✓✓	286560	fqcalving_out(:) = 0.0
366
367	✓✓	1440	DO nisurf = 1, nbsrf
368	✓✓	1146240	ffonte_out(:) = ffonte_out(:) + ffonte_global(:,nisurf)*pctsrf(:,nisurf)
369	✓✓	1146240	fqfonte_out(:) = fqfonte_out(:) + fqfonte_global(:,nisurf)*pctsrf(:,nisurf)
370	✓✓	1146528	fqcalving_out(:) = fqcalving_out(:) + fqcalving_global(:,nisurf)*pctsrf(:,nisurf)
371			ENDDO
372
373	✓✓	286560	run_off_lic_out(:)=runofflic_global(:)
374
375		288	END SUBROUTINE fonte_neige_get_vars
376			!
377			!****************************************************************************************
378			!
379			END MODULE fonte_neige_mod