1 | ! |
---|
2 | ! $Header$ |
---|
3 | ! |
---|
4 | SUBROUTINE albsno(klon, knon, dtime, agesno, alb_neig_grid, precip_snow) |
---|
5 | |
---|
6 | IMPLICIT NONE |
---|
7 | |
---|
8 | INCLUDE "clesphys.h" |
---|
9 | |
---|
10 | ! Input arguments |
---|
11 | !**************************************************************************************** |
---|
12 | INTEGER, INTENT(IN) :: klon, knon |
---|
13 | REAL, INTENT(IN) :: dtime |
---|
14 | REAL, DIMENSION(klon), INTENT(IN) :: precip_snow |
---|
15 | |
---|
16 | ! In/Output arguments |
---|
17 | !**************************************************************************************** |
---|
18 | REAL, DIMENSION(klon), INTENT(INOUT) :: agesno |
---|
19 | |
---|
20 | ! Output arguments |
---|
21 | !**************************************************************************************** |
---|
22 | REAL, DIMENSION(klon), INTENT(OUT) :: alb_neig_grid |
---|
23 | |
---|
24 | ! Local variables |
---|
25 | !**************************************************************************************** |
---|
26 | INTEGER :: i, nv |
---|
27 | INTEGER, PARAMETER :: nvm = 8 |
---|
28 | REAL :: as |
---|
29 | REAL, DIMENSION(klon,nvm) :: veget |
---|
30 | REAL, DIMENSION(nvm),SAVE :: init, decay |
---|
31 | !$OMP THREADPRIVATE(init, decay) |
---|
32 | |
---|
33 | DATA init /0.55, 0.14, 0.18, 0.29, 0.15, 0.15, 0.14, 0./ |
---|
34 | DATA decay/0.30, 0.67, 0.63, 0.45, 0.40, 0.14, 0.06, 1./ |
---|
35 | !**************************************************************************************** |
---|
36 | |
---|
37 | if (albsno0>=0.) then |
---|
38 | init(:)=albsno0 |
---|
39 | decay(:)=0. |
---|
40 | endif |
---|
41 | |
---|
42 | veget = 0. |
---|
43 | veget(:,1) = 1. ! desert partout |
---|
44 | DO i = 1, knon |
---|
45 | alb_neig_grid(i) = 0.0 |
---|
46 | ENDDO |
---|
47 | DO nv = 1, nvm |
---|
48 | DO i = 1, knon |
---|
49 | as = init(nv)+decay(nv)*EXP(-agesno(i)/5.) |
---|
50 | alb_neig_grid(i) = alb_neig_grid(i) + veget(i,nv)*as |
---|
51 | ENDDO |
---|
52 | ENDDO |
---|
53 | |
---|
54 | |
---|
55 | ! modilation en fonction de l'age de la neige |
---|
56 | DO i = 1, knon |
---|
57 | agesno(i) = (agesno(i) + (1.-agesno(i)/50.)*dtime/86400.)& |
---|
58 | & * EXP(-1.*MAX(0.0,precip_snow(i))*dtime/0.3) |
---|
59 | agesno(i) = MAX(agesno(i),0.0) |
---|
60 | ENDDO |
---|
61 | |
---|
62 | END SUBROUTINE albsno |
---|