GCC Code Coverage Report

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