GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/surf_land_mod.F90 Lines: 29 50 58.0 %
Date: 2023-06-30 12:56:34 Branches: 29 66 43.9 %

Line Branch Exec Source
1
!
2
MODULE surf_land_mod
3
4
  IMPLICIT NONE
5
6
CONTAINS
7
!
8
!****************************************************************************************
9
!
10
576
  SUBROUTINE surf_land(itime, dtime, date0, jour, knon, knindex, &
11
       rlon, rlat, yrmu0, &
12
       debut, lafin, zlev, ccanopy, swnet, lwnet, albedo, &
13
288
       tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, precip_bs, temp_air, spechum, &
14
       AcoefH, AcoefQ, BcoefH, BcoefQ, &
15
       AcoefU, AcoefV, BcoefU, BcoefV, &
16
288
       pref, u1, v1, gustiness, rugoro, pctsrf, &
17
       lwdown_m, q2m, t2m, &
18
       snow, qsol, agesno, tsoil, &
19
288
       z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, fluxbs, &
20
       qsurf, tsurf_new, dflux_s, dflux_l, &
21
       flux_u1, flux_v1 , &
22
       veget,lai,height)
23
24
    USE dimphy
25
    USE surface_data, ONLY    : ok_veget
26
    USE carbon_cycle_mod
27
28
29
    ! See comments in each module surf_land_orchidee_xxx for compatiblity with ORCHIDEE
30
#ifdef ORCHIDEE_NOOPENMP
31
    ! Compilation with cpp key ORCHIDEE NOOPENMP
32
    USE surf_land_orchidee_noopenmp_mod
33
#else
34
#if ORCHIDEE_NOZ0H
35
    ! Compilation with cpp key ORCHIDEE NOZ0H
36
    USE surf_land_orchidee_noz0h_mod
37
#else
38
#if ORCHIDEE_NOFREIN
39
    ! Compilation with cpp key ORCHIDEE_NOFREIN
40
    USE surf_land_orchidee_nofrein_mod
41
#else
42
#if ORCHIDEE_NOUNSTRUCT
43
    ! Compilation with cpp key ORCHIDEE_NOUNSTRUCT
44
    USE surf_land_orchidee_nounstruct_mod
45
#else
46
#if ORCHIDEE_NOLIC
47
    ! Compilation with cpp key ORCHIDEE_NOLIC
48
    USE surf_land_orchidee_nolic_mod
49
#else
50
    ! Default version
51
    USE surf_land_orchidee_mod
52
#endif
53
#endif
54
#endif
55
#endif
56
#endif
57
58
    USE surf_land_bucket_mod
59
    USE calcul_fluxs_mod
60
    USE indice_sol_mod
61
    USE print_control_mod, ONLY: lunout
62
63
    INCLUDE "dimsoil.h"
64
    INCLUDE "YOMCST.h"
65
    INCLUDE "clesphys.h"
66
    INCLUDE "dimpft.h"
67
68
! Input variables
69
!****************************************************************************************
70
    INTEGER, INTENT(IN)                     :: itime, jour, knon
71
    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
72
    REAL, INTENT(IN)                        :: date0
73
    REAL, DIMENSION(klon), INTENT(IN)       :: rlon, rlat
74
    REAL, DIMENSION(klon), INTENT(IN)       :: yrmu0  ! cosine of solar zenith angle
75
    LOGICAL, INTENT(IN)                     :: debut, lafin
76
    REAL, INTENT(IN)                        :: dtime
77
    REAL, DIMENSION(klon), INTENT(IN)       :: zlev, ccanopy
78
    REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
79
    REAL, DIMENSION(klon), INTENT(IN)       :: albedo  ! albedo for whole short-wave interval
80
    REAL, DIMENSION(klon), INTENT(IN)       :: tsurf
81
    REAL, DIMENSION(klon), INTENT(IN)       :: p1lay
82
    REAL, DIMENSION(klon), INTENT(IN)       :: cdragh, cdragm
83
    REAL, DIMENSION(klon), INTENT(IN)       :: precip_rain, precip_snow, precip_bs
84
    REAL, DIMENSION(klon), INTENT(IN)       :: temp_air, spechum
85
    REAL, DIMENSION(klon), INTENT(IN)       :: AcoefH, AcoefQ, BcoefH, BcoefQ
86
    REAL, DIMENSION(klon), INTENT(IN)       :: AcoefU, AcoefV, BcoefU, BcoefV
87
    REAL, DIMENSION(klon), INTENT(IN)       :: pref   ! pressure reference
88
    REAL, DIMENSION(klon), INTENT(IN)       :: u1, v1, gustiness
89
    REAL, DIMENSION(klon), INTENT(IN)       :: rugoro
90
    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
91
    REAL, DIMENSION(klon), INTENT(IN)       :: lwdown_m  ! downwelling longwave radiation at mean surface
92
                                                         ! corresponds to previous sollwdown
93
    REAL, DIMENSION(klon), INTENT(IN)       :: q2m, t2m
94
95
! In/Output variables
96
!****************************************************************************************
97
    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
98
    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
99
    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
100
101
! Output variables
102
!****************************************************************************************
103
    REAL, DIMENSION(klon), INTENT(OUT)       :: z0m, z0h
104
!albedo SB >>>
105
!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new ! albdeo for shortwave interval 1(visible)
106
!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new ! albedo for shortwave interval 2(near infrared)
107
    REAL, DIMENSION(6), INTENT(IN) :: SFRWL
108
    REAL, DIMENSION(klon,nsw), INTENT(OUT)       :: alb_dir_new,alb_dif_new
109
!albedo SB <<<
110
    REAL, DIMENSION(klon), INTENT(OUT)       :: evap
111
    REAL, DIMENSION(klon), INTENT(OUT)       :: fluxsens, fluxlat, fluxbs
112
    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
113
    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
114
    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l
115
    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1  ! flux for U and V at first model level
116
    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: veget,lai
117
    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height
118
119
! Local variables
120
!****************************************************************************************
121
576
    REAL, DIMENSION(klon) :: p1lay_tmp
122
576
    REAL, DIMENSION(klon) :: pref_tmp
123
576
    REAL, DIMENSION(klon) :: swdown     ! downwelling shortwave radiation at land surface
124
576
    REAL, DIMENSION(klon) :: epot_air           ! potential air temperature
125
576
    REAL, DIMENSION(klon) :: tsol_rad, emis_new ! output from interfsol not used
126
576
    REAL, DIMENSION(klon) :: u0, v0     ! surface speed
127
576
    REAL, DIMENSION(klon) :: precip_totsnow     ! total solid precip
128
    INTEGER               :: i
129
130
!albedo SB >>>
131
576
    REAL, DIMENSION(klon)      :: alb1_new,alb2_new
132
!albedo SB <<<
133
134
135
!****************************************************************************************
136
!Total solid precip
137
138
288
IF (ok_bs) THEN
139
precip_totsnow(:)=precip_snow(:)+precip_bs(:)
140
ELSE
141
286560
precip_totsnow(:)=precip_snow(:)
142
ENDIF
143
!****************************************************************************************
144
145
146
!****************************************************************************************
147
! Choice between call to vegetation model (ok_veget=true) or simple calculation below
148
!
149
!****************************************************************************************
150
288
   IF (ok_veget) THEN
151
!****************************************************************************************
152
!  Call model sechiba in model ORCHIDEE
153
!
154
!****************************************************************************************
155
       p1lay_tmp(:)      = 0.0
156
       pref_tmp(:)       = 0.0
157
       p1lay_tmp(1:knon) = p1lay(1:knon)/100.
158
       pref_tmp(1:knon)  = pref(1:knon)/100.
159
!
160
!* Calculate incoming flux for SW and LW interval: swdown
161
!
162
       swdown(:) = 0.0
163
       DO i = 1, knon
164
          swdown(i) = swnet(i)/(1-albedo(i))
165
       END DO
166
!
167
!* Calculate potential air temperature
168
!
169
       epot_air(:) = 0.0
170
       DO i = 1, knon
171
          epot_air(i) = RCPD*temp_air(i)*(pref(i)/p1lay(i))**RKAPPA
172
       END DO
173
174
       ! temporary for keeping same results using lwdown_m instead of lwdown
175
       CALL surf_land_orchidee(itime, dtime, date0, knon, &
176
            knindex, rlon, rlat, yrmu0, pctsrf, &
177
            debut, lafin, &
178
            zlev,  u1, v1, gustiness, temp_air, spechum, epot_air, ccanopy, &
179
            cdragh, AcoefH, AcoefQ, BcoefH, BcoefQ, &
180
            precip_rain, precip_totsnow, lwdown_m, swnet, swdown, &
181
            pref_tmp, q2m, t2m, &
182
            evap, fluxsens, fluxlat,  &
183
            tsol_rad, tsurf_new, alb1_new, alb2_new, &
184
            emis_new, z0m, z0h, qsurf, &
185
            veget, lai, height)
186
!
187
!* Add contribution of relief to surface roughness
188
!
189
       DO i=1,knon
190
          z0m(i) = MAX(1.5e-05,SQRT(z0m(i)**2 + rugoro(i)**2))
191
       ENDDO
192
193
    ELSE  ! not ok_veget
194
!****************************************************************************************
195
! No extern vegetation model choosen, call simple bucket calculations instead.
196
!
197
!****************************************************************************************
198
       CALL surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
199
            tsurf, p1lay, cdragh, precip_rain, precip_totsnow, temp_air, &
200
            spechum, AcoefH, AcoefQ, BcoefH, BcoefQ, pref, &
201
            u1, v1, gustiness, rugoro, swnet, lwnet, &
202
            snow, qsol, agesno, tsoil, &
203
            qsurf, z0m, alb1_new, alb2_new, evap, &
204
288
            fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l)
205
148896
        z0h(1:knon)=z0m(1:knon) ! En attendant mieux
206
207
208
    ENDIF ! ok_veget
209
210
        ! blowing snow not treated yet over land
211
286560
        fluxbs(:)=0.
212
213
214
!****************************************************************************************
215
! Calculation for all land models
216
! - Flux calculation at first modele level for U and V
217
!****************************************************************************************
218
! Suppose zero surface speed
219
286560
    u0(:)=0.0
220
286560
    v0(:)=0.0
221
    CALL calcul_flux_wind(knon, dtime, &
222
         u0, v0, u1, v1, gustiness, cdragm, &
223
         AcoefU, AcoefV, BcoefU, BcoefV, &
224
         p1lay, temp_air, &
225
288
         flux_u1, flux_v1)
226
227
!albedo SB >>>
228
     SELECT CASE(NSW)
229
     CASE(2)
230
       alb_dir_new(1:knon,1)=alb1_new(1:knon)
231
       alb_dir_new(1:knon,2)=alb2_new(1:knon)
232
     CASE(4)
233
       alb_dir_new(1:knon,1)=alb1_new(1:knon)
234
       alb_dir_new(1:knon,2)=alb2_new(1:knon)
235
       alb_dir_new(1:knon,3)=alb2_new(1:knon)
236
       alb_dir_new(1:knon,4)=alb2_new(1:knon)
237
     CASE(6)
238
148896
       alb_dir_new(1:knon,1)=alb1_new(1:knon)
239
148896
       alb_dir_new(1:knon,2)=alb1_new(1:knon)
240
148896
       alb_dir_new(1:knon,3)=alb1_new(1:knon)
241
148896
       alb_dir_new(1:knon,4)=alb2_new(1:knon)
242
148896
       alb_dir_new(1:knon,5)=alb2_new(1:knon)
243

149184
       alb_dir_new(1:knon,6)=alb2_new(1:knon)
244
     END SELECT
245
246

1719648
     alb_dif_new=alb_dir_new
247
!albedo SB <<<
248
249
288
  END SUBROUTINE surf_land
250
!
251
!****************************************************************************************
252
!
253
END MODULE surf_land_mod
254
!
255
!****************************************************************************************
256
!