[782] | 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 |
---|
[1785] | 11 | USE indice_sol_mod |
---|
[782] | 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) |
---|
[4013] | 30 | REAL, ALLOCATABLE, DIMENSION(:,:) :: ffonte_global |
---|
[782] | 31 | !$OMP THREADPRIVATE(ffonte_global) |
---|
[4013] | 32 | REAL, ALLOCATABLE, DIMENSION(:,:) :: fqfonte_global |
---|
[782] | 33 | !$OMP THREADPRIVATE(fqfonte_global) |
---|
[4013] | 34 | REAL, ALLOCATABLE, DIMENSION(:,:) :: fqcalving_global |
---|
[782] | 35 | !$OMP THREADPRIVATE(fqcalving_global) |
---|
[4013] | 36 | REAL, ALLOCATABLE, DIMENSION(:) :: runofflic_global |
---|
[2617] | 37 | !$OMP THREADPRIVATE(runofflic_global) |
---|
[782] | 38 | |
---|
| 39 | CONTAINS |
---|
| 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' |
---|
[2311] | 67 | CALL abort_physic(modname,abort_message,1) |
---|
[782] | 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' |
---|
[2311] | 78 | CALL abort_physic(modname,abort_message,1) |
---|
[782] | 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' |
---|
[2311] | 85 | CALL abort_physic(modname,abort_message,1) |
---|
[782] | 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' |
---|
[2311] | 92 | CALL abort_physic(modname,abort_message,1) |
---|
[782] | 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' |
---|
[2311] | 99 | CALL abort_physic(modname,abort_message,1) |
---|
[782] | 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' |
---|
[2311] | 106 | CALL abort_physic(modname,abort_message,1) |
---|
[782] | 107 | ENDIF |
---|
| 108 | fqcalving_global(:,:) = 0.0 |
---|
| 109 | |
---|
[2617] | 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 | |
---|
[782] | 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) |
---|
[1785] | 131 | |
---|
| 132 | USE indice_sol_mod |
---|
[782] | 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 | ! |
---|
[793] | 152 | INCLUDE "YOETHF.h" |
---|
| 153 | INCLUDE "YOMCST.h" |
---|
| 154 | INCLUDE "FCTTRE.h" |
---|
| 155 | INCLUDE "clesphys.h" |
---|
[782] | 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. |
---|
[2946] | 215 | |
---|
| 216 | 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 | snow_evap = MIN (snow / dtime, evap) !---one cannot evaporate more than the amount of snow |
---|
| 228 | snow = snow - snow_evap * dtime !---snow that remains or deposits on the ground |
---|
| 229 | snow = MAX(0.0, snow) !---just in case |
---|
| 230 | ENDIF |
---|
[782] | 231 | |
---|
| 232 | 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 | ffonte(:) = 0.0 |
---|
| 243 | fqcalving(:) = 0.0 |
---|
| 244 | fqfonte(:) = 0.0 |
---|
[2946] | 245 | |
---|
[782] | 246 | DO i = 1, knon |
---|
| 247 | ! Y'a-t-il fonte de neige? |
---|
[2946] | 248 | neige_fond = (snow(i)>epsfra .OR. nisurf==is_sic .OR. nisurf==is_lic) .AND. tsurf_new(i)>=RTT |
---|
[782] | 249 | IF (neige_fond) THEN |
---|
| 250 | fq_fonte = MIN( MAX((tsurf_new(i)-RTT )/chasno,0.0),snow(i)) |
---|
| 251 | ffonte(i) = fq_fonte * RLMLT/dtime |
---|
| 252 | fqfonte(i) = fq_fonte/dtime |
---|
| 253 | snow(i) = MAX(0., snow(i) - fq_fonte) |
---|
| 254 | bil_eau_s(i) = bil_eau_s(i) + fq_fonte |
---|
| 255 | 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 | IF (nisurf == is_sic .OR. nisurf == is_lic ) THEN |
---|
| 260 | fq_fonte = MAX((tsurf_new(i)-RTT )/chaice,0.0) |
---|
| 261 | ffonte(i) = ffonte(i) + fq_fonte * RLMLT/dtime |
---|
| 262 | 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 | tsurf_new(i) = RTT |
---|
| 267 | ENDIF |
---|
| 268 | d_ts(i) = tsurf_new(i) - tsurf(i) |
---|
| 269 | ENDIF |
---|
| 270 | |
---|
[2946] | 271 | ! s'il y a une hauteur trop importante de neige, elle est ecretee |
---|
[782] | 272 | fqcalving(i) = MAX(0., snow(i) - snow_max)/dtime |
---|
| 273 | snow(i)=MIN(snow(i),snow_max) |
---|
[2946] | 274 | ENDDO |
---|
[782] | 275 | |
---|
| 276 | IF (nisurf == is_ter) THEN |
---|
| 277 | DO i = 1, knon |
---|
| 278 | qsol(i) = qsol(i) + bil_eau_s(i) |
---|
| 279 | run_off_ter(i) = run_off_ter(i) + MAX(qsol(i) - max_eau_sol, 0.0) |
---|
| 280 | qsol(i) = MIN(qsol(i), max_eau_sol) |
---|
[2946] | 281 | ENDDO |
---|
[782] | 282 | ELSE IF (nisurf == is_lic) THEN |
---|
| 283 | DO i = 1, knon |
---|
| 284 | j = knindex(i) |
---|
[2946] | 285 | !--temporal filtering |
---|
| 286 | run_off_lic(i) = coeff_rel*fqcalving(i) + (1.-coeff_rel)*run_off_lic_0(j) |
---|
[782] | 287 | run_off_lic_0(j) = run_off_lic(i) |
---|
[2946] | 288 | !--add melting snow and liquid precip to runoff of ice cap |
---|
[1504] | 289 | run_off_lic(i) = run_off_lic(i) + fqfonte(i) + precip_rain(i) |
---|
[2946] | 290 | ENDDO |
---|
[782] | 291 | ENDIF |
---|
| 292 | |
---|
| 293 | !**************************************************************************************** |
---|
| 294 | ! Save ffonte, fqfonte and fqcalving in global arrays for each |
---|
| 295 | ! sub-surface separately |
---|
| 296 | ! |
---|
| 297 | !**************************************************************************************** |
---|
| 298 | DO i = 1, knon |
---|
| 299 | ffonte_global(knindex(i),nisurf) = ffonte(i) |
---|
| 300 | fqfonte_global(knindex(i),nisurf) = fqfonte(i) |
---|
| 301 | fqcalving_global(knindex(i),nisurf) = fqcalving(i) |
---|
| 302 | ENDDO |
---|
| 303 | |
---|
[2617] | 304 | IF (nisurf == is_lic) THEN |
---|
| 305 | DO i = 1, knon |
---|
| 306 | runofflic_global(knindex(i)) = run_off_lic(i) |
---|
| 307 | ENDDO |
---|
| 308 | ENDIF |
---|
| 309 | |
---|
[782] | 310 | END SUBROUTINE fonte_neige |
---|
| 311 | ! |
---|
| 312 | !**************************************************************************************** |
---|
| 313 | ! |
---|
| 314 | 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 | restart_runoff(:) = run_off_lic_0(:) |
---|
| 324 | |
---|
| 325 | ! Deallocation of all varaibles in the module |
---|
[1413] | 326 | ! DEALLOCATE(run_off_lic_0, run_off_ter, run_off_lic, ffonte_global, & |
---|
| 327 | ! fqfonte_global, fqcalving_global) |
---|
[782] | 328 | |
---|
[1413] | 329 | IF (ALLOCATED(run_off_lic_0)) DEALLOCATE(run_off_lic_0) |
---|
| 330 | IF (ALLOCATED(run_off_ter)) DEALLOCATE(run_off_ter) |
---|
| 331 | IF (ALLOCATED(run_off_lic)) DEALLOCATE(run_off_lic) |
---|
| 332 | IF (ALLOCATED(ffonte_global)) DEALLOCATE(ffonte_global) |
---|
| 333 | IF (ALLOCATED(fqfonte_global)) DEALLOCATE(fqfonte_global) |
---|
| 334 | IF (ALLOCATED(fqcalving_global)) DEALLOCATE(fqcalving_global) |
---|
[2619] | 335 | IF (ALLOCATED(runofflic_global)) DEALLOCATE(runofflic_global) |
---|
[1413] | 336 | |
---|
[782] | 337 | END SUBROUTINE fonte_neige_final |
---|
| 338 | ! |
---|
| 339 | !**************************************************************************************** |
---|
| 340 | ! |
---|
| 341 | SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, & |
---|
[2517] | 342 | fqfonte_out, ffonte_out, run_off_lic_out) |
---|
[782] | 343 | |
---|
[1785] | 344 | |
---|
[782] | 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. |
---|
[1785] | 349 | !**************************************************************************************** |
---|
[782] | 350 | |
---|
[1785] | 351 | USE indice_sol_mod |
---|
| 352 | |
---|
[782] | 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 |
---|
[2517] | 358 | REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_out |
---|
[782] | 359 | |
---|
| 360 | INTEGER :: nisurf |
---|
| 361 | !**************************************************************************************** |
---|
| 362 | |
---|
| 363 | ffonte_out(:) = 0.0 |
---|
| 364 | fqfonte_out(:) = 0.0 |
---|
| 365 | fqcalving_out(:) = 0.0 |
---|
| 366 | |
---|
| 367 | DO nisurf = 1, nbsrf |
---|
| 368 | ffonte_out(:) = ffonte_out(:) + ffonte_global(:,nisurf)*pctsrf(:,nisurf) |
---|
| 369 | fqfonte_out(:) = fqfonte_out(:) + fqfonte_global(:,nisurf)*pctsrf(:,nisurf) |
---|
| 370 | fqcalving_out(:) = fqcalving_out(:) + fqcalving_global(:,nisurf)*pctsrf(:,nisurf) |
---|
| 371 | ENDDO |
---|
| 372 | |
---|
[2617] | 373 | run_off_lic_out(:)=runofflic_global(:) |
---|
| 374 | |
---|
[782] | 375 | END SUBROUTINE fonte_neige_get_vars |
---|
| 376 | ! |
---|
| 377 | !**************************************************************************************** |
---|
| 378 | ! |
---|
| 379 | END MODULE fonte_neige_mod |
---|