Changeset 888 for LMDZ4/trunk
- Timestamp:
- Feb 4, 2008, 5:24:28 PM (17 years ago)
- Location:
- LMDZ4/trunk/libf/phylmd
- Files:
-
- 18 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk/libf/phylmd/ocean_cpl_mod.F90
r803 r888 65 65 ! 66 66 SUBROUTINE ocean_cpl_noice( & 67 s ollw, albedo, &67 swnet, lwnet, alb1, & 68 68 windsp, & 69 69 fder_old, & 70 70 itime, dtime, knon, knindex, & 71 swdown, &72 71 p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, & 73 72 petAcoef, peqAcoef, petBcoef, peqBcoef, & 74 73 ps, u1_lay, v1_lay, pctsrf_in, & 75 radsol, snow, qsurf,agesno, &76 evap, fluxsens, fluxlat, &74 radsol, snow, agesno, & 75 qsurf, evap, fluxsens, fluxlat, & 77 76 tsurf_new, dflux_s, dflux_l, pctsrf_oce) 78 77 ! … … 89 88 INTEGER, DIMENSION(klon), INTENT(IN) :: knindex 90 89 REAL, INTENT(IN) :: dtime 91 REAL, DIMENSION(klon), INTENT(IN) :: sollw 92 REAL, DIMENSION(klon), INTENT(IN) :: albedo 90 REAL, DIMENSION(klon), INTENT(IN) :: swnet 91 REAL, DIMENSION(klon), INTENT(IN) :: lwnet 92 REAL, DIMENSION(klon), INTENT(IN) :: alb1 ! albedo in visible SW interval 93 93 REAL, DIMENSION(klon), INTENT(IN) :: windsp 94 94 REAL, DIMENSION(klon), INTENT(IN) :: fder_old 95 REAL, DIMENSION(klon), INTENT(IN) :: swdown96 95 REAL, DIMENSION(klon), INTENT(IN) :: p1lay 97 96 REAL, DIMENSION(klon), INTENT(IN) :: tq_cdrag … … 199 198 200 199 CALL cpl_send_ocean_fields(itime, knon, knindex, & 201 sw down, sollw, fluxlat, fluxsens, &202 precip_rain, precip_snow, evap, tsurf_new, fder_new, alb edo, taux, tauy, windsp)200 swnet, lwnet, fluxlat, fluxsens, & 201 precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, taux, tauy, windsp) 203 202 204 203 … … 208 207 ! 209 208 SUBROUTINE ocean_cpl_ice( & 210 rlon, rlat, s ollw, albedo, &209 rlon, rlat, swnet, lwnet, alb1, & 211 210 fder_old, & 212 211 itime, dtime, knon, knindex, & 213 212 lafin, & 214 swdown, &215 213 p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, & 216 214 petAcoef, peqAcoef, petBcoef, peqBcoef, & 217 215 ps, u1_lay, v1_lay, pctsrf_in, & 218 216 radsol, snow, qsurf, & 219 alb lw, evap, fluxsens, fluxlat, &220 tsurf_new, alb_new,dflux_s, dflux_l, pctsrf_sic)217 alb1_new, alb2_new, evap, fluxsens, fluxlat, & 218 tsurf_new, dflux_s, dflux_l, pctsrf_sic) 221 219 ! 222 220 ! This subroutine treats the ocean where there is ice. The subroutine first receives … … 234 232 REAL, INTENT(IN) :: dtime 235 233 REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat 236 REAL, DIMENSION(klon), INTENT(IN) :: sollw 237 REAL, DIMENSION(klon), INTENT(IN) :: albedo 234 REAL, DIMENSION(klon), INTENT(IN) :: swnet 235 REAL, DIMENSION(klon), INTENT(IN) :: lwnet 236 REAL, DIMENSION(klon), INTENT(IN) :: alb1 ! albedo in visible SW interval 238 237 REAL, DIMENSION(klon), INTENT(IN) :: fder_old 239 REAL, DIMENSION(klon), INTENT(IN) :: swdown240 238 REAL, DIMENSION(klon), INTENT(IN) :: p1lay 241 239 REAL, DIMENSION(klon), INTENT(IN) :: tq_cdrag … … 256 254 !**************************************************************************************** 257 255 REAL, DIMENSION(klon), INTENT(OUT) :: qsurf 258 REAL, DIMENSION(klon), INTENT(OUT) :: alb lw256 REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new, alb2_new 259 257 REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat 260 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new , alb_new258 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new 261 259 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l 262 260 REAL, DIMENSION(klon), INTENT(OUT) :: pctsrf_sic … … 271 269 REAL, DIMENSION(klon) :: tsurf_cpl, fder_new 272 270 REAL, DIMENSION(klon) :: taux, tauy 271 REAL, DIMENSION(klon) :: alb_cpl 273 272 274 273 ! End definitions … … 278 277 279 278 !**************************************************************************************** 280 ! Receive ocean temperature(tsurf_cpl), albedo(alb_ new) and new fraction of279 ! Receive ocean temperature(tsurf_cpl), albedo(alb_cpl) and new fraction of 281 280 ! seaice(pctsrf_sic) from coupler 282 281 ! … … 284 283 285 284 CALL cpl_receive_seaice_fields(knon, knindex, & 286 tsurf_cpl, alb_new, pctsrf_sic) 285 tsurf_cpl, alb_cpl, pctsrf_sic) 286 287 alb1_new(1:knon) = alb_cpl(1:knon) 288 alb2_new(1:knon) = alb_cpl(1:knon) 289 287 290 288 291 !**************************************************************************************** … … 342 345 CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, & 343 346 pctsrf_in, lafin, rlon, rlat, & 344 sw down, sollw, fluxlat, fluxsens, &345 precip_rain, precip_snow, evap, tsurf_new, fder_new, alb edo, taux, tauy)347 swnet, lwnet, fluxlat, fluxsens, & 348 precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, taux, tauy) 346 349 347 348 alblw(1:knon) = alb_new(1:knon)349 350 350 351 END SUBROUTINE ocean_cpl_ice -
LMDZ4/trunk/libf/phylmd/ocean_forced_mod.F90
r882 r888 69 69 petAcoef, peqAcoef, petBcoef, peqBcoef, & 70 70 ps, u1_lay, v1_lay, & 71 radsol, snow, qsurf, & 72 agesno, & 73 evap, fluxsens, fluxlat, & 71 radsol, snow, agesno, & 72 qsurf, evap, fluxsens, fluxlat, & 74 73 tsurf_new, dflux_s, dflux_l, pctsrf_oce) 75 74 ! … … 191 190 petAcoef, peqAcoef, petBcoef, peqBcoef, & 192 191 ps, u1_lay, v1_lay, & 193 radsol, snow, qs urf, qsol, agesno, &194 tsoil, alblw, evap, fluxsens, fluxlat, &195 tsurf_new, alb_new,dflux_s, dflux_l, pctsrf_sic)192 radsol, snow, qsol, agesno, tsoil, & 193 qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, & 194 tsurf_new, dflux_s, dflux_l, pctsrf_sic) 196 195 ! 197 196 ! This subroutine treats the ocean where there is ice. … … 232 231 !**************************************************************************************** 233 232 REAL, DIMENSION(klon), INTENT(OUT) :: qsurf 234 REAL, DIMENSION(klon), INTENT(OUT) :: alblw 233 REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new ! new albedo in visible SW interval 234 REAL, DIMENSION(klon), INTENT(OUT) :: alb2_new ! new albedo in near IR interval 235 235 REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat 236 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new , alb_new236 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new 237 237 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l 238 238 REAL, DIMENSION(klon), INTENT(OUT) :: pctsrf_sic … … 286 286 IF (soil_model) THEN 287 287 ! update tsoil and calculate soilcap and soilflux 288 289 288 CALL soil(dtime, is_sic, knon,snow, tsurf_tmp, tsoil,soilcap, soilflux) 290 289 cal(1:knon) = RCPD / soilcap(1:knon) … … 320 319 WHERE (snow(1:knon) .LT. 0.0001) agesno(1:knon) = 0. 321 320 322 alb _new(:) = 0.0321 alb1_new(:) = 0.0 323 322 DO i=1, knon 324 323 zfra = MAX(0.0,MIN(1.0,snow(i)/(snow(i)+10.0))) 325 alb _new(i) = alb_neig(i) * zfra + 0.6 * (1.0-zfra)324 alb1_new(i) = alb_neig(i) * zfra + 0.6 * (1.0-zfra) 326 325 ENDDO 327 !! alb_new(1 : knon) = 0.6 326 327 alb2_new(:) = alb1_new(:) 328 328 329 329 !**************************************************************************************** … … 344 344 ENDDO 345 345 346 !!$ z0_new = 0.002347 !!$ z0_new = SQRT(z0_new**2+rugoro**2)348 alblw(1:knon) = alb_new(1:knon)349 346 350 347 !**************************************************************************************** … … 355 352 356 353 pctsrf_sic(:) = pctsrf_lim(:,is_sic) 357 358 354 359 355 END SUBROUTINE ocean_forced_ice -
LMDZ4/trunk/libf/phylmd/ocean_slab_mod.F90
r793 r888 139 139 petAcoef, peqAcoef, petBcoef, peqBcoef, & 140 140 ps, u1_lay, v1_lay, & 141 radsol, snow, qsurf, agesno, & 142 evap, fluxsens, fluxlat, & 143 tsurf_new, & 144 dflux_s, dflux_l, pctsrf_oce) 141 radsol, snow, agesno, & 142 qsurf, evap, fluxsens, fluxlat, & 143 tsurf_new, dflux_s, dflux_l, pctsrf_oce) 145 144 146 145 INCLUDE "indicesol.h" … … 179 178 INTEGER :: i 180 179 REAL, DIMENSION(klon) :: cal, beta, dif_grnd 181 REAL, DIMENSION(klon) :: alb_neig,tsurf_temp180 REAL, DIMENSION(klon) :: tsurf_temp 182 181 183 182 !**************************************************************************************** … … 191 190 beta = 1. 192 191 dif_grnd = 0. 193 alb_neig(:) = 0.194 192 agesno(:) = 0. 195 193 … … 221 219 petAcoef, peqAcoef, petBcoef, peqBcoef, & 222 220 ps, u1_lay, v1_lay, & 223 radsol, snow, qsurf, qsol, agesno, & 224 tsoil, & 225 alblw, evap, fluxsens, fluxlat, & 226 tsurf_new, alb_new, dflux_s, dflux_l, pctsrf_sic) 221 radsol, snow, qsurf, qsol, agesno, tsoil, & 222 alb1_new, alb2_new, evap, fluxsens, fluxlat, & 223 tsurf_new, dflux_s, dflux_l, pctsrf_sic) 227 224 228 225 INCLUDE "indicesol.h" … … 258 255 !**************************************************************************************** 259 256 REAL, DIMENSION(klon), INTENT(OUT) :: qsurf 260 REAL, DIMENSION(klon), INTENT(OUT) :: alblw 257 REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new ! new albedo in visible SW interval 258 REAL, DIMENSION(klon), INTENT(OUT) :: alb2_new ! new albedo in near IR interval 261 259 REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat 262 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new , alb_new260 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new 263 261 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l 264 262 REAL, DIMENSION(klon), INTENT(OUT) :: pctsrf_sic … … 282 280 283 281 ! Initialization of output variables 284 alb _new(:) = 0.0282 alb1_new(:) = 0.0 285 283 286 284 !**************************************************************************************** … … 347 345 WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0. 348 346 zfra(1:knon) = MAX(0.0,MIN(1.0,snow(1:knon)/(snow(1:knon)+10.0))) 349 alb _new(1 : knon) = alb_neig(1 : knon) *zfra(1:knon) + &347 alb1_new(1 : knon) = alb_neig(1 : knon) *zfra(1:knon) + & 350 348 0.6 * (1.0-zfra(1:knon)) 351 !! alb_new(1 : knon) = 0.6 349 350 alb2_new(:) = alb1_new(:) 352 351 353 352 ! … … 397 396 ENDDO 398 397 399 !!$ z0_new = 0.002400 !!$ z0_new = SQRT(z0_new**2+rugoro**2)401 alblw(1:knon) = alb_new(1:knon)402 398 403 399 !**************************************************************************************** -
LMDZ4/trunk/libf/phylmd/pbl_surface_mod.F90
r882 r888 26 26 27 27 ! Declaration of variables saved in restart file 28 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: qsol 28 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: qsol ! water height in the soil (mm) 29 29 !$OMP THREADPRIVATE(qsol) 30 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: fder 30 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: fder ! flux drift 31 31 !$OMP THREADPRIVATE(fder) 32 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: snow 32 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: snow ! snow at surface 33 33 !$OMP THREADPRIVATE(snow) 34 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: qsurf 34 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: qsurf ! humidity at surface 35 35 !$OMP THREADPRIVATE(qsurf) 36 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: evap 36 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: evap ! evaporation at surface 37 37 !$OMP THREADPRIVATE(evap) 38 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: rugos 38 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: rugos ! rugosity at surface (m) 39 39 !$OMP THREADPRIVATE(rugos) 40 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: agesno 40 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: agesno ! age of snow at surface 41 41 !$OMP THREADPRIVATE(agesno) 42 REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE :: ftsoil 42 REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE :: ftsoil ! soil temperature 43 43 !$OMP THREADPRIVATE(ftsoil) 44 44 … … 182 182 t, q, u, v, & 183 183 pplay, paprs, pctsrf, & 184 ts, alb e, alblw,u10m, v10m, &185 sollwdown,cdragh, cdragm, zu1, zv1, &186 alb sol, albsollw,zxsens, zxevap, &184 ts, alb1, alb2, u10m, v10m, & 185 lwdown_m, cdragh, cdragm, zu1, zv1, & 186 alb1_m, alb2_m, zxsens, zxevap, & 187 187 zxtsol, zxfluxlat, zt2m, qsat2m, & 188 188 d_t, d_q, d_u, d_v, & … … 270 270 ! Input variables 271 271 !**************************************************************************************** 272 REAL, INTENT(IN) :: dtime 273 REAL, INTENT(IN) :: date0 274 INTEGER, INTENT(IN) :: itap 275 INTEGER, INTENT(IN) :: jour ! jour de l'annee en cours 276 LOGICAL, INTENT(IN) :: debut, lafin 277 REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat 278 REAL, DIMENSION(klon), INTENT(IN) :: rugoro 279 REAL, DIMENSION(klon), INTENT(IN) :: rmu0 ! cosinus de l'angle solaire zenithal 280 REAL, DIMENSION(klon), INTENT(IN) :: rain_f, snow_f 281 REAL, DIMENSION(klon), INTENT(IN) :: solsw_m ! mean value 282 REAL, DIMENSION(klon), INTENT(IN) :: sollw_m ! mean value 283 REAL, DIMENSION(klon,klev), INTENT(IN) :: t, q 284 REAL, DIMENSION(klon,klev), INTENT(IN) :: u, v 285 REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay 286 REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs 287 REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pctsrf 272 REAL, INTENT(IN) :: dtime ! time interval (s) 273 REAL, INTENT(IN) :: date0 ! initial day 274 INTEGER, INTENT(IN) :: itap ! time step 275 INTEGER, INTENT(IN) :: jour ! current day of the year 276 LOGICAL, INTENT(IN) :: debut ! true if first run step 277 LOGICAL, INTENT(IN) :: lafin ! true if last run step 278 REAL, DIMENSION(klon), INTENT(IN) :: rlon ! longitudes in degrees 279 REAL, DIMENSION(klon), INTENT(IN) :: rlat ! latitudes in degrees 280 REAL, DIMENSION(klon), INTENT(IN) :: rugoro ! rugosity length 281 REAL, DIMENSION(klon), INTENT(IN) :: rmu0 ! cosine of solar zenith angle 282 REAL, DIMENSION(klon), INTENT(IN) :: rain_f ! rain fall 283 REAL, DIMENSION(klon), INTENT(IN) :: snow_f ! snow fall 284 REAL, DIMENSION(klon), INTENT(IN) :: solsw_m ! net shortwave radiation at mean surface 285 REAL, DIMENSION(klon), INTENT(IN) :: sollw_m ! net longwave radiation at mean surface 286 REAL, DIMENSION(klon,klev), INTENT(IN) :: t ! temperature (K) 287 REAL, DIMENSION(klon,klev), INTENT(IN) :: q ! water vapour (kg/kg) 288 REAL, DIMENSION(klon,klev), INTENT(IN) :: u ! u speed 289 REAL, DIMENSION(klon,klev), INTENT(IN) :: v ! v speed 290 REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay ! mid-layer pression (Pa) 291 REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs ! pression between layers (Pa) 292 REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pctsrf ! sub-surface fraction 288 293 289 294 ! Input/Output variables 290 295 !**************************************************************************************** 291 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ts 292 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: albe 293 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: alblw 294 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: u10m, v10m 296 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ts ! temperature at surface (K) 297 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: alb1 ! albedo in visible SW interval 298 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: alb2 ! albedo in near infra-red SW interval 299 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: u10m ! u speed at 10m 300 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: v10m ! v speed at 10m 295 301 296 302 ! Output variables 297 303 !**************************************************************************************** 298 REAL, DIMENSION(klon), INTENT(OUT) :: sollwdown 299 REAL, DIMENSION(klon), INTENT(OUT) :: cdragh, cdragm 300 REAL, DIMENSION(klon), INTENT(OUT) :: zu1 301 REAL, DIMENSION(klon), INTENT(OUT) :: zv1 302 REAL, DIMENSION(klon), INTENT(OUT) :: albsol 303 REAL, DIMENSION(klon), INTENT(OUT) :: albsollw 304 REAL, DIMENSION(klon), INTENT(OUT) :: zxsens, zxevap 305 REAL, DIMENSION(klon), INTENT(OUT) :: zxtsol 306 REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat 307 REAL, DIMENSION(klon), INTENT(OUT) :: zt2m 304 REAL, DIMENSION(klon), INTENT(OUT) :: lwdown_m ! Downcoming longwave radiation 305 REAL, DIMENSION(klon), INTENT(OUT) :: cdragh ! drag coefficient for T and Q 306 REAL, DIMENSION(klon), INTENT(OUT) :: cdragm ! drag coefficient for wind 307 REAL, DIMENSION(klon), INTENT(OUT) :: zu1 ! u wind speed in first layer 308 REAL, DIMENSION(klon), INTENT(OUT) :: zv1 ! v wind speed in first layer 309 REAL, DIMENSION(klon), INTENT(OUT) :: alb1_m ! mean albedo in visible SW interval 310 REAL, DIMENSION(klon), INTENT(OUT) :: alb2_m ! mean albedo in near IR SW interval 311 REAL, DIMENSION(klon), INTENT(OUT) :: zxsens ! sensible heat flux at surface with inversed sign 312 ! (=> positive sign upwards) 313 REAL, DIMENSION(klon), INTENT(OUT) :: zxevap ! water vapour flux at surface, positiv upwards 314 REAL, DIMENSION(klon), INTENT(OUT) :: zxtsol ! temperature at surface, mean for each grid point 315 REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat ! latent flux, mean for each grid point 316 REAL, DIMENSION(klon), INTENT(OUT) :: zt2m ! temperature at 2m, mean for each grid point 308 317 REAL, DIMENSION(klon), INTENT(OUT) :: qsat2m 309 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t, d_q 310 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_u, d_v 311 REAL, DIMENSION(klon, klev), INTENT(OUT) :: zcoefh 312 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pctsrf_new 318 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t ! change in temperature 319 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_q ! change in water vapour 320 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_u ! change in u speed 321 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_v ! change in v speed 322 REAL, DIMENSION(klon, klev), INTENT(OUT) :: zcoefh ! coef for turbulent diffusion of T and Q, mean for each grid point 323 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pctsrf_new ! new sub-surface fraction 313 324 314 325 ! Output only for diagnostics 315 REAL, DIMENSION(klon), INTENT(OUT) :: qsol_d 316 REAL, DIMENSION(klon), INTENT(OUT) :: zq2m 317 REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh 318 REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl 319 REAL, DIMENSION(klon), INTENT(OUT) :: s_capCL 320 REAL, DIMENSION(klon), INTENT(OUT) :: s_oliqCL 321 REAL, DIMENSION(klon), INTENT(OUT) :: s_cteiCL 322 REAL, DIMENSION(klon), INTENT(OUT) :: s_pblT 323 REAL, DIMENSION(klon), INTENT(OUT) :: s_therm 324 REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb1 325 REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb2 326 REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb3 327 REAL, DIMENSION(klon), INTENT(OUT) :: zxrugs 328 REAL, DIMENSION(klon), INTENT(OUT) :: zu10m 329 REAL, DIMENSION(klon), INTENT(OUT) :: zv10m 330 REAL, DIMENSION(klon), INTENT(OUT) :: fder_print 331 REAL, DIMENSION(klon), INTENT(OUT) :: zxqsurf 332 REAL, DIMENSION(klon), INTENT(OUT) :: rh2m 333 REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxu, zxfluxv 334 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: rugos_d 335 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: agesno_d 336 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: sollw, solsw 337 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: d_ts 338 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: evap_d 339 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: fluxlat 340 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: t2m 341 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wfbils, wfbilo 342 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_t 343 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_u, flux_v 326 REAL, DIMENSION(klon), INTENT(OUT) :: qsol_d ! water height in the soil (mm) 327 REAL, DIMENSION(klon), INTENT(OUT) :: zq2m ! water vapour at 2m, mean for each grid point 328 REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh ! height of the planetary boundary layer(HPBL) 329 REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl ! condensation level 330 REAL, DIMENSION(klon), INTENT(OUT) :: s_capCL ! CAPE of PBL 331 REAL, DIMENSION(klon), INTENT(OUT) :: s_oliqCL ! liquid water intergral of PBL 332 REAL, DIMENSION(klon), INTENT(OUT) :: s_cteiCL ! cloud top instab. crit. of PBL 333 REAL, DIMENSION(klon), INTENT(OUT) :: s_pblT ! temperature at PBLH 334 REAL, DIMENSION(klon), INTENT(OUT) :: s_therm ! thermal virtual temperature excess 335 REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb1 ! deep cape, mean for each grid point 336 REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb2 ! inhibition, mean for each grid point 337 REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb3 ! point Omega, mean for each grid point 338 REAL, DIMENSION(klon), INTENT(OUT) :: zxrugs ! rugosity at surface (m), mean for each grid point 339 REAL, DIMENSION(klon), INTENT(OUT) :: zu10m ! u speed at 10m, mean for each grid point 340 REAL, DIMENSION(klon), INTENT(OUT) :: zv10m ! v speed at 10m, mean for each grid point 341 REAL, DIMENSION(klon), INTENT(OUT) :: fder_print ! fder for printing (=fder(i) + dflux_t(i) + dflux_q(i)) 342 REAL, DIMENSION(klon), INTENT(OUT) :: zxqsurf ! humidity at surface, mean for each grid point 343 REAL, DIMENSION(klon), INTENT(OUT) :: rh2m ! relative humidity at 2m 344 REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxu ! u wind tension, mean for each grid point 345 REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxv ! v wind tension, mean for each grid point 346 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: rugos_d ! rugosity length (m) 347 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: agesno_d ! age of snow at surface 348 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: solsw ! net shortwave radiation at surface 349 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: sollw ! net longwave radiation at surface 350 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: d_ts ! change in temperature at surface 351 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: evap_d ! evaporation at surface 352 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: fluxlat ! latent flux 353 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: t2m ! temperature at 2 meter height 354 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wfbils ! heat balance at surface 355 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wfbilo ! water balance at surface 356 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_t ! sensible heat flux (CpT) J/m**2/s (W/m**2) 357 ! positve orientation downwards 358 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_u ! u wind tension (kg m/s)/(m**2 s) or Pascal 359 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_v ! v wind tension (kg m/s)/(m**2 s) or Pascal 344 360 345 361 ! Output not needed 346 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_t, dflux_q 347 REAL, DIMENSION(klon), INTENT(OUT) :: zxsnow 348 REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxt, zxfluxq 349 REAL, DIMENSION(klon, nbsrf),INTENT(OUT) :: q2m 350 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_q 362 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_t ! change of sensible heat flux 363 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_q ! change of water vapour flux 364 REAL, DIMENSION(klon), INTENT(OUT) :: zxsnow ! snow at surface, mean for each grid point 365 REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxt ! sensible heat flux, mean for each grid point 366 REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxq ! water vapour flux, mean for each grid point 367 REAL, DIMENSION(klon, nbsrf),INTENT(OUT) :: q2m ! water vapour at 2 meter height 368 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_q ! water vapour flux(latent flux) (kg/m**2/s) 351 369 352 370 ! Input/output … … 356 374 ! Local variables with attribute SAVE 357 375 !**************************************************************************************** 358 INTEGER, SAVE :: nhoridbg, nidbg 376 INTEGER, SAVE :: nhoridbg, nidbg ! variables for IOIPSL 359 377 !$OMP THREADPRIVATE(nhoridbg, nidbg) 360 378 LOGICAL, SAVE :: debugindex=.FALSE. … … 373 391 REAL :: zx_alf1, zx_alf2 !valeur ambiante par extrapola 374 392 REAL :: amn, amx 393 REAL :: f1 ! fraction de longeurs visibles parmi tout SW intervalle 375 394 REAL, DIMENSION(klon) :: r_co2_ppm ! taux CO2 atmosphere 376 395 REAL, DIMENSION(klon) :: yts, yrugos, ypct, yz0_new 377 REAL, DIMENSION(klon) :: yalb 378 REAL, DIMENSION(klon) :: yalblw 396 REAL, DIMENSION(klon) :: yalb, yalb1, yalb2 379 397 REAL, DIMENSION(klon) :: yu1, yv1 380 398 REAL, DIMENSION(klon) :: ysnow, yqsurf, yagesno, yqsol 381 399 REAL, DIMENSION(klon) :: yrain_f, ysnow_f 382 REAL, DIMENSION(klon) :: ysol lw, ysolsw, ysollwdown400 REAL, DIMENSION(klon) :: ysolsw, ysollw 383 401 REAL, DIMENSION(klon) :: yfder 384 REAL, DIMENSION(klon) :: yr ads,yrugoro402 REAL, DIMENSION(klon) :: yrugoro 385 403 REAL, DIMENSION(klon) :: yfluxlat 386 404 REAL, DIMENSION(klon) :: y_d_ts … … 409 427 REAL, DIMENSION(klon) :: qairsol, zgeo1 410 428 REAL, DIMENSION(klon) :: rugo1 411 REAL, DIMENSION(klon) :: yfluxsens , swdown429 REAL, DIMENSION(klon) :: yfluxsens 412 430 REAL, DIMENSION(klon) :: petAcoef, peqAcoef, petBcoef, peqBcoef 413 REAL, DIMENSION(klon) :: ypsref , epot_air414 REAL, DIMENSION(klon) :: yevap, ytsurf_new, yalb _new431 REAL, DIMENSION(klon) :: ypsref 432 REAL, DIMENSION(klon) :: yevap, ytsurf_new, yalb1_new, yalb2_new 415 433 REAL, DIMENSION(klon) :: pctsrf_nsrf 416 434 REAL, DIMENSION(klon) :: ztsol 435 REAL, DIMENSION(klon) :: alb_m ! mean albedo for whole SW interval 417 436 REAL, DIMENSION(klon,klev) :: y_d_t, y_d_q 418 437 REAL, DIMENSION(klon,klev) :: y_d_u, y_d_v … … 441 460 442 461 443 REAL, DIMENSION(klon,nbsrf) :: pblh 444 REAL, DIMENSION(klon,nbsrf) :: plcl 462 REAL, DIMENSION(klon,nbsrf) :: pblh ! height of the planetary boundary layer 463 REAL, DIMENSION(klon,nbsrf) :: plcl ! condensation level 445 464 REAL, DIMENSION(klon,nbsrf) :: capCL 446 465 REAL, DIMENSION(klon,nbsrf) :: oliqCL … … 448 467 REAL, DIMENSION(klon,nbsrf) :: pblT 449 468 REAL, DIMENSION(klon,nbsrf) :: therm 450 REAL, DIMENSION(klon,nbsrf) :: trmb1 451 REAL, DIMENSION(klon,nbsrf) :: trmb2 452 REAL, DIMENSION(klon,nbsrf) :: trmb3 469 REAL, DIMENSION(klon,nbsrf) :: trmb1 ! deep cape 470 REAL, DIMENSION(klon,nbsrf) :: trmb2 ! inhibition 471 REAL, DIMENSION(klon,nbsrf) :: trmb3 ! point Omega 453 472 REAL, DIMENSION(klon,nbsrf) :: zx_rh2m, zx_qsat2m 454 473 REAL, DIMENSION(klon,nbsrf) :: zx_qs1, zx_t1 455 474 REAL, DIMENSION(klon,nbsrf) :: zdelta1, zcor1 475 REAL, DIMENSION(klon, nbsrf) :: alb ! mean albedo for whole SW interval 476 REAL, DIMENSION(klon) :: ylwdown ! jg : temporary (ysollwdown) 456 477 457 478 … … 521 542 cdragh = 0.0 ; cdragm = 0.0 ; dflux_t = 0.0 ; dflux_q = 0.0 522 543 ypct = 0.0 ; yts = 0.0 ; ysnow = 0.0 ; zu1 = 0.0 523 zv1 = 0.0 ; yqsurf = 0.0 ; yalb = 0.0 ; yalblw= 0.0544 zv1 = 0.0 ; yqsurf = 0.0 ; yalb1 = 0.0 ; yalb2 = 0.0 524 545 yrain_f = 0.0 ; ysnow_f = 0.0 ; yfder = 0.0 ; ysolsw = 0.0 525 ysollw = 0.0 ; y sollwdown = 0.0 ; yrugos = 0.0; yu1 = 0.0526 yv1 = 0.0 ; y rads = 0.0 ; ypaprs = 0.0; ypplay = 0.0546 ysollw = 0.0 ; yrugos = 0.0 ; yu1 = 0.0 547 yv1 = 0.0 ; ypaprs = 0.0 ; ypplay = 0.0 527 548 ydelp = 0.0 ; yu = 0.0 ; yv = 0.0 ; yt = 0.0 528 549 yq = 0.0 ; pctsrf_new = 0.0 ; y_dflux_t = 0.0 ; y_dflux_q = 0.0 … … 538 559 ! 3) - Calculate pressure thickness of each layer 539 560 ! - Calculate the wind at first layer 540 ! 561 ! - Mean calculations of albedo 562 ! - Calculate net radiance at sub-surface 541 563 !**************************************************************************************** 542 564 DO k = 1, klev … … 555 577 !**************************************************************************************** 556 578 ! Test for rugos........ from physiq.. A la fin plutot??? 557 ! Calcul de l'abedo moyen par maille579 ! 558 580 !**************************************************************************************** 559 581 … … 566 588 ENDDO 567 589 568 ! Calcul de l'abedo moyen par maille 569 albsol(:) = 0.0 570 albsollw(:) = 0.0 590 ! Mean calculations of albedo 591 ! 592 ! Albedo at sub-surface 593 ! * alb1 : albedo in visible SW interval 594 ! * alb2 : albedo in near infrared SW interval 595 ! * alb : mean albedo for whole SW interval 596 ! 597 ! Mean albedo for grid point 598 ! * alb1_m : albedo in visible SW interval 599 ! * alb2_m : albedo in near infrared SW interval 600 ! * alb_m : mean albedo at whole SW interval 601 602 alb1_m(:) = 0.0 603 alb2_m(:) = 0.0 571 604 DO nsrf = 1, nbsrf 572 605 DO i = 1, klon 573 alb sol(i) = albsol(i) + albe(i,nsrf)* pctsrf(i,nsrf)574 alb sollw(i) = albsollw(i) + alblw(i,nsrf) * pctsrf(i,nsrf)606 alb1_m(i) = alb1_m(i) + alb1(i,nsrf) * pctsrf(i,nsrf) 607 alb2_m(i) = alb2_m(i) + alb2(i,nsrf) * pctsrf(i,nsrf) 575 608 ENDDO 576 609 ENDDO 577 610 578 579 580 ! Calcule de ztsol (aussi fait dans physiq.F, pourrait etre un argument) 611 ! We here suppose the fraction f1 of incoming radiance of visible radiance 612 ! as a fraction of all shortwave radiance 613 ! f1 = 0.5 614 f1 = 1 ! put f1=1 to recreate old calculations 615 616 DO nsrf = 1, nbsrf 617 DO i = 1, klon 618 alb(i,nsrf) = f1*alb1(i,nsrf) + (1-f1)*alb2(i,nsrf) 619 ENDDO 620 ENDDO 621 622 DO i = 1, klon 623 alb_m(i) = f1*alb1_m(i) + (1-f1)*alb2_m(i) 624 END DO 625 626 ! Calculation of mean temperature at surface grid points 581 627 ztsol(:) = 0.0 582 628 DO nsrf = 1, nbsrf … … 586 632 ENDDO 587 633 588 589 ! Repartition du longwave par sous-surface linearisee 634 ! Linear distrubution on sub-surface of long- and shortwave net radiance 590 635 DO nsrf = 1, nbsrf 591 636 DO i = 1, klon 592 637 sollw(i,nsrf) = sollw_m(i) + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ts(i,nsrf)) 593 solsw(i,nsrf) = solsw_m(i) *(1.-albe(i,nsrf))/(1.-albsol(i))638 solsw(i,nsrf) = solsw_m(i) * (1.-alb(i,nsrf)) / (1.-alb_m(i)) 594 639 ENDDO 595 640 ENDDO 596 641 597 642 643 ! Downwelling longwave radiation at mean surface 644 lwdown_m(:) = 0.0 598 645 DO i = 1, klon 599 sollwdown(i) = sollw_m(i) + RSIGMA*ztsol(i)**4646 lwdown_m(i) = sollw_m(i) + RSIGMA*ztsol(i)**4 600 647 ENDDO 601 648 … … 644 691 DO j = 1, knon 645 692 i = ni(j) 646 ypct(j) = pctsrf(i,nsrf) 647 yts(j) = ts(i,nsrf) 648 ysnow(j) = snow(i,nsrf) 649 yqsurf(j) = qsurf(i,nsrf) 650 yalb(j) = albe(i,nsrf) 651 yalblw(j) = alblw(i,nsrf) 693 ypct(j) = pctsrf(i,nsrf) 694 yts(j) = ts(i,nsrf) 695 ysnow(j) = snow(i,nsrf) 696 yqsurf(j) = qsurf(i,nsrf) 697 yalb(j) = alb(i,nsrf) 698 yalb1(j) = alb1(i,nsrf) 699 yalb2(j) = alb2(i,nsrf) 652 700 yrain_f(j) = rain_f(i) 653 701 ysnow_f(j) = snow_f(i) 654 702 yagesno(j) = agesno(i,nsrf) 655 yfder(j) = fder(i) 656 ysolsw(j) = solsw(i,nsrf) 657 ysollw(j) = sollw(i,nsrf) 658 ysollwdown(j) = sollwdown(i) 659 yrugos(j) = rugos(i,nsrf) 703 yfder(j) = fder(i) 704 ysolsw(j) = solsw(i,nsrf) 705 ysollw(j) = sollw(i,nsrf) 706 yrugos(j) = rugos(i,nsrf) 660 707 yrugoro(j) = rugoro(i) 661 yu1(j) = u1lay(i) 662 yv1(j) = v1lay(i) 663 yrads(j) = ysolsw(j)+ ysollw(j) 708 yu1(j) = u1lay(i) 709 yv1(j) = v1lay(i) 664 710 ypaprs(j,klev+1) = paprs(i,klev+1) 665 711 yu10mx(j) = u10m(i,nsrf) … … 730 776 ! 731 777 !**************************************************************************************** 732 778 779 ! - Reference pressure is given the values at surface level 733 780 ypsref(:) = ypaprs(:,1) 734 epot_air(:) = 0.0 735 epot_air(1:knon) = RCPD*yt(1:knon,1)*(ypsref(1:knon)/ypplay(1:knon,1))**RKAPPA 736 737 swdown(:) = 0.0 738 IF (nsrf .EQ. is_ter) THEN 739 swdown(1:knon) = ysolsw(1:knon)/(1-yalb(1:knon)) 740 ELSE 741 swdown(1:knon) = ysolsw(1:knon) 742 ENDIF 743 744 ! constant CO2 781 782 ! - Constant CO2 is copied to global grid 745 783 r_co2_ppm(:) = co2_ppm 746 784 … … 755 793 756 794 CASE(is_ter) 795 ! ylwdown : to be removed, calculation is now done at land surface in surf_land 796 ylwdown(:)=0.0 797 DO i=1,knon 798 ylwdown(i)=lwdown_m(ni(i)) 799 END DO 757 800 CALL surf_land(itap, dtime, date0, jour, knon, ni,& 758 801 rlon, rlat, & 759 debut, lafin, ydelp(:,1), epot_air, r_co2_ppm, ysollwdown, ysolsw, swdown, &802 debut, lafin, ydelp(:,1), r_co2_ppm, ysolsw, ysollw, yalb, & 760 803 yts, ypplay(:,1), ycoefh(:,1), yrain_f, ysnow_f, yt(:,1), yq(:,1),& 761 804 petAcoef, peqAcoef, petBcoef, peqBcoef, & 762 805 ypsref, yu1, yv1, yrugoro, pctsrf, & 763 yrads, ysnow, yqsurf, yqsol, yagesno, & 764 ytsoil, yz0_new, yalblw, yevap, yfluxsens, yfluxlat, & 765 ytsurf_new, yalb_new, y_dflux_t, y_dflux_q, pctsrf_nsrf) 806 ysnow, yqsol, yagesno, ytsoil, & 807 yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, & 808 yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, pctsrf_nsrf, & 809 ylwdown) 766 810 767 811 CASE(is_lic) 768 812 CALL surf_landice(itap, dtime, knon, ni, & 813 ysolsw, ysollw, yts, ypplay(:,1), & 814 ycoefh(:,1), yrain_f, ysnow_f, yt(:,1), yq(:,1),& 815 petAcoef, peqAcoef, petBcoef, peqBcoef, & 816 ypsref, yu1, yv1, yrugoro, pctsrf, & 817 ysnow, yqsurf, yqsol, yagesno, & 818 ytsoil, yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, & 819 ytsurf_new, y_dflux_t, y_dflux_q, pctsrf_nsrf) 820 821 CASE(is_oce) 822 CALL surf_ocean(rlon, rlat, ysolsw, ysollw, yalb1, & 823 yrugos, ywindsp, rmu0, yfder, & 824 itap, dtime, jour, knon, ni, & 825 debut, & 826 ypplay(:,1), ycoefh(:,1), ycoefm(:,1), yrain_f, ysnow_f, yt(:,1), yq(:,1),& 827 petAcoef, peqAcoef, petBcoef, peqBcoef, & 828 ypsref, yu1, yv1, yrugoro, pctsrf, & 829 ysnow, yqsurf, yagesno, & 830 yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, & 831 ytsurf_new, y_dflux_t, y_dflux_q, pctsrf_nsrf) 832 833 CASE(is_sic) 834 CALL surf_seaice( & 835 rlon, rlat, ysolsw, ysollw, yalb1, yfder, & 836 itap, dtime, jour, knon, ni, & 837 debut, lafin, & 769 838 yts, ypplay(:,1), ycoefh(:,1), yrain_f, ysnow_f, yt(:,1), yq(:,1),& 770 839 petAcoef, peqAcoef, petBcoef, peqBcoef, & 771 840 ypsref, yu1, yv1, yrugoro, pctsrf, & 772 yrads, ysnow, yqsurf, yqsol, yagesno, & 773 ytsoil, yz0_new, yalblw, yevap, yfluxsens, yfluxlat, & 774 ytsurf_new, yalb_new, y_dflux_t, y_dflux_q, pctsrf_nsrf) 775 776 CASE(is_oce) 777 CALL surf_ocean(rlon, rlat, ysollw, yalb, & 778 yrugos, ywindsp, rmu0, & 779 yfder, & 780 itap, dtime, jour, knon, ni, & 781 debut, swdown, & 782 ypplay(:,1), ycoefh(:,1), ycoefm(:,1), yrain_f, ysnow_f, yt(:,1), yq(:,1),& 783 petAcoef, peqAcoef, petBcoef, peqBcoef, & 784 ypsref, yu1, yv1, yrugoro, pctsrf, & 785 yrads, ysnow, yqsurf, yagesno, & 786 yz0_new, yalblw, yevap, yfluxsens, yfluxlat, & 787 ytsurf_new, yalb_new, y_dflux_t, y_dflux_q, pctsrf_nsrf) 788 789 CASE(is_sic) 790 CALL surf_seaice( & 791 rlon, rlat, ysollw, yalb, & 792 yfder, & 793 itap, dtime, jour, knon, ni, & 794 debut, lafin, swdown, & 795 yts, ypplay(:,1), ycoefh(:,1), yrain_f, ysnow_f, yt(:,1), yq(:,1),& 796 petAcoef, peqAcoef, petBcoef, peqBcoef, & 797 ypsref, yu1, yv1, yrugoro, pctsrf, & 798 yrads, ysnow, yqsurf, yqsol, yagesno, & 799 ytsoil, yz0_new, yalblw, yevap, yfluxsens, yfluxlat, & 800 ytsurf_new, yalb_new, y_dflux_t, y_dflux_q, pctsrf_nsrf) 841 ysnow, yqsurf, yqsol, yagesno, ytsoil, & 842 yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, & 843 ytsurf_new, y_dflux_t, y_dflux_q, pctsrf_nsrf) 801 844 802 845 … … 815 858 !**************************************************************************************** 816 859 ! 11) - Calcul the increment of surface temperature 817 ! - Update albedo818 860 ! 819 861 !**************************************************************************************** 820 862 y_d_ts(1:knon) = ytsurf_new(1:knon) - yts(1:knon) 821 863 822 yalb(1:knon) = yalb_new(1:knon)823 824 864 !**************************************************************************************** 825 865 ! … … 888 928 evap(:,nsrf) = - flux_q(:,1,nsrf) 889 929 890 alb e(:, nsrf) = 0.891 alb lw(:, nsrf) = 0.930 alb1(:, nsrf) = 0. 931 alb2(:, nsrf) = 0. 892 932 snow(:, nsrf) = 0. 893 933 qsurf(:, nsrf) = 0. … … 897 937 i = ni(j) 898 938 d_ts(i,nsrf) = y_d_ts(j) 899 alb e(i,nsrf) = yalb(j)900 alb lw(i,nsrf) = yalblw(j)939 alb1(i,nsrf) = yalb1_new(j) 940 alb2(i,nsrf) = yalb2_new(j) 901 941 snow(i,nsrf) = ysnow(j) 902 942 qsurf(i,nsrf) = yqsurf(j) -
LMDZ4/trunk/libf/phylmd/phyetat0.F
r879 r888 7 7 . rlat_p, rlon_p, pctsrf_p, tsol_p, 8 8 . ocean_in, ok_veget_in, 9 . alb e_p, alblw_p,9 . alb1_p, alb2_p, 10 10 . rain_fall_p, snow_fall_p,solsw_p, sollw_p, 11 11 . radsol_p,clesphy0, … … 53 53 REAL qsol_p(klon) 54 54 REAL snow_p(klon,nbsrf) 55 REAL albe_p(klon,nbsrf) 56 cIM BEG alblw 57 REAL alblw_p(klon,nbsrf) 58 cIM END alblw 55 REAL alb1_p(klon,nbsrf) ! albedo in visible SW interval 56 REAL alb2_p(klon,nbsrf) ! albedo in near IR interval 59 57 REAL evap_p(klon,nbsrf) 60 58 REAL radsol_p(klon) … … 93 91 REAL qsol(klon_glo) 94 92 REAL snow(klon_glo,nbsrf) 95 REAL alb e(klon_glo,nbsrf)96 REAL alb lw(klon_glo,nbsrf)93 REAL alb1(klon_glo,nbsrf) 94 REAL alb2(klon_glo,nbsrf) 97 95 REAL evap(klon_glo,nbsrf) 98 96 REAL radsol(klon_glo) … … 728 726 ENDIF 729 727 c 730 c Lecture de albedo au sol:728 c Lecture de albedo de l'interval visible au sol: 731 729 c 732 730 ierr = NF_INQ_VARID (nid, "ALBE", nvarid) … … 746 744 ENDIF 747 745 #ifdef NC_DOUBLE 748 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb e(1,nsrf))749 #else 750 ierr = NF_GET_VAR_REAL(nid, nvarid, alb e(1,nsrf))746 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb1(1,nsrf)) 747 #else 748 ierr = NF_GET_VAR_REAL(nid, nvarid, alb1(1,nsrf)) 751 749 #endif 752 750 IF (ierr.NE.NF_NOERR) THEN … … 757 755 xmax = -1.0E+20 758 756 DO i = 1, klon_glo 759 xmin = MIN(alb e(i,nsrf),xmin)760 xmax = MAX(alb e(i,nsrf),xmax)757 xmin = MIN(alb1(i,nsrf),xmin) 758 xmax = MAX(alb1(i,nsrf),xmax) 761 759 ENDDO 762 760 PRINT*,'Albedo du sol ALBE**:', nsrf, xmin, xmax … … 766 764 PRINT*, ' J ignore donc les autres ALBE**' 767 765 #ifdef NC_DOUBLE 768 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb e(1,1))769 #else 770 ierr = NF_GET_VAR_REAL(nid, nvarid, alb e(1,1))766 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb1(1,1)) 767 #else 768 ierr = NF_GET_VAR_REAL(nid, nvarid, alb1(1,1)) 771 769 #endif 772 770 IF (ierr.NE.NF_NOERR) THEN … … 777 775 xmax = -1.0E+20 778 776 DO i = 1, klon_glo 779 xmin = MIN(alb e(i,1),xmin)780 xmax = MAX(alb e(i,1),xmax)777 xmin = MIN(alb1(i,1),xmin) 778 xmax = MAX(alb1(i,1),xmax) 781 779 ENDDO 782 780 PRINT*,'Neige du sol <ALBE>', xmin, xmax 783 781 DO nsrf = 2, nbsrf 784 782 DO i = 1, klon_glo 785 alb e(i,nsrf) = albe(i,1)786 ENDDO 787 ENDDO 788 ENDIF 789 790 c 791 c Lecture de albedo au sol LW:783 alb1(i,nsrf) = alb1(i,1) 784 ENDDO 785 ENDDO 786 ENDIF 787 788 c 789 c Lecture de albedo au sol dans l'interval proche infra-rouge: 792 790 c 793 791 ierr = NF_INQ_VARID (nid, "ALBLW", nvarid) … … 798 796 DO nsrf = 1, nbsrf 799 797 DO i = 1, klon_glo 800 alb lw(i,nsrf) = albe(i,nsrf)798 alb2(i,nsrf) = alb1(i,nsrf) 801 799 ENDDO 802 800 ENDDO … … 805 803 PRINT*, ' J ignore donc les autres ALBLW**' 806 804 #ifdef NC_DOUBLE 807 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb lw(1,1))808 #else 809 ierr = NF_GET_VAR_REAL(nid, nvarid, alb lw(1,1))805 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb2(1,1)) 806 #else 807 ierr = NF_GET_VAR_REAL(nid, nvarid, alb2(1,1)) 810 808 #endif 811 809 IF (ierr.NE.NF_NOERR) THEN … … 816 814 xmax = -1.0E+20 817 815 DO i = 1, klon_glo 818 xmin = MIN(alb lw(i,1),xmin)819 xmax = MAX(alb lw(i,1),xmax)816 xmin = MIN(alb2(i,1),xmin) 817 xmax = MAX(alb2(i,1),xmax) 820 818 ENDDO 821 819 PRINT*,'Neige du sol <ALBLW>', xmin, xmax 822 820 DO nsrf = 2, nbsrf 823 821 DO i = 1, klon_glo 824 alb lw(i,nsrf) = alblw(i,1)822 alb2(i,nsrf) = alb2(i,1) 825 823 ENDDO 826 824 ENDDO … … 1583 1581 call Scatter( qsol,qsol_p) 1584 1582 call Scatter( snow,snow_p) 1585 call Scatter( alb e,albe_p)1586 call Scatter( alb lw,alblw_p)1583 call Scatter( alb1,alb1_p) 1584 call Scatter( alb2,alb2_p) 1587 1585 call Scatter( evap,evap_p) 1588 1586 call Scatter( radsol,radsol_p) -
LMDZ4/trunk/libf/phylmd/phyredem.F
r878 r888 5 5 SUBROUTINE phyredem (fichnom,dtime,radpas,ocean, 6 6 . rlat_p,rlon_p, pctsrf_p,tsol_p, 7 . alb edo_p, alblw_p,7 . alb1_p, alb2_p, 8 8 . rain_fall_p, snow_fall_p,solsw_p, sollw_p, 9 9 . radsol_p,zmea_p,zstd_p,zsig_p, … … 46 46 REAL qsol_p(klon) 47 47 REAL snow_p(klon,nbsrf) 48 REAL albedo_p(klon,nbsrf) 49 cIM BEG 50 REAL alblw_p(klon,nbsrf) 51 cIM END 48 REAL alb1_p(klon,nbsrf) ! albedo in visible SW interval 49 REAL alb2_p(klon,nbsrf) ! albedo in near IR interval 52 50 REAL evap_p(klon,nbsrf) 53 51 REAL rain_fall_p(klon) … … 80 78 REAL qsol(klon_glo) 81 79 REAL snow(klon_glo,nbsrf) 82 REAL alb edo(klon_glo,nbsrf)83 REAL alb lw(klon_glo,nbsrf)80 REAL alb1(klon_glo,nbsrf) 81 REAL alb2(klon_glo,nbsrf) 84 82 REAL evap(klon_glo,nbsrf) 85 83 REAL rain_fall(klon_glo) … … 147 145 call Gather( qsol_p,qsol) 148 146 call Gather( snow_p,snow) 149 call Gather( alb edo_p,albedo)150 call Gather( alb lw_p,alblw)147 call Gather( alb1_p,alb1) 148 call Gather( alb2_p,alb2) 151 149 call Gather( evap_p,evap) 152 150 call Gather( radsol_p,radsol) … … 481 479 ENDIF 482 480 #ifdef NC_DOUBLE 483 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,albedo(1,nsrf)) 484 #else 485 ierr = NF_PUT_VAR_REAL (nid,nvarid,albedo(1,nsrf)) 486 #endif 487 ENDDO 488 489 cIM BEG albedo LW 481 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,alb1(1,nsrf)) 482 #else 483 ierr = NF_PUT_VAR_REAL (nid,nvarid,alb1(1,nsrf)) 484 #endif 485 ENDDO 486 490 487 DO nsrf = 1, nbsrf 491 488 IF (nsrf.LE.99) THEN … … 505 502 ENDIF 506 503 #ifdef NC_DOUBLE 507 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,alb lw(1,nsrf))508 #else 509 ierr = NF_PUT_VAR_REAL (nid,nvarid,alb lw(1,nsrf))510 #endif 511 ENDDO 512 c IM END albedo LW504 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,alb2(1,nsrf)) 505 #else 506 ierr = NF_PUT_VAR_REAL (nid,nvarid,alb2(1,nsrf)) 507 #endif 508 ENDDO 509 c 513 510 c 514 511 DO nsrf = 1, nbsrf -
LMDZ4/trunk/libf/phylmd/physiq.F
r883 r888 690 690 REAL,save :: solarlong0 691 691 c 692 REAL,allocatable,save :: falb e(:,:)693 c$OMP THREADPRIVATE(falb e) ! albedo par type de surface694 c 695 REAL,allocatable,save :: falb lw(:,:)696 c$OMP THREADPRIVATE(falb lw) ! albedo par type de surface692 REAL,allocatable,save :: falb1(:,:) 693 c$OMP THREADPRIVATE(falb1) ! albedo par type de surface pour SW visible 694 c 695 REAL,allocatable,save :: falb2(:,:) 696 c$OMP THREADPRIVATE(falb2) ! albedo par type de surface pour SW proche IR 697 697 698 698 c … … 969 969 cIM 970 970 cym SAVE pctsrf ! sous-fraction du sol 971 REAL,allocatable,save :: albsol(:) 972 c$OMP THREADPRIVATE(albsol) 973 cym SAVE albsol ! albedo du sol total 974 REAL,allocatable,save :: albsollw(:) 975 c$OMP THREADPRIVATE(albsollw) 976 cym SAVE albsollw ! albedo du sol total 971 972 REAL,allocatable,save :: albsol1(:) ! albedo du sol total pour SW visible 973 c$OMP THREADPRIVATE(albsol1) 974 REAL,allocatable,save :: albsol2(:) ! albedo du sol total pour SW proche IR 975 c$OMP THREADPRIVATE(albsol2) 977 976 978 977 REAL,allocatable,save :: wo(:,:) … … 1527 1526 allocate( ftsol(klon,nbsrf)) 1528 1527 allocate( deltat(klon)) 1529 allocate( falb e(klon,nbsrf))1530 allocate( falb lw(klon,nbsrf))1528 allocate( falb1(klon,nbsrf)) 1529 allocate( falb2(klon,nbsrf)) 1531 1530 allocate( zmea(klon)) 1532 1531 allocate( zstd(klon)) … … 1573 1572 allocate( total_rain(klon), nday_rain(klon)) 1574 1573 allocate( pctsrf(klon,nbsrf)) 1575 allocate( albsol (klon))1576 allocate( albsol lw(klon))1574 allocate( albsol1(klon)) 1575 allocate( albsol2(klon)) 1577 1576 allocate( wo(klon,klev)) 1578 1577 allocate( clwcon(klon,klev),rnebcon(klon,klev)) … … 1731 1730 c nhistoW(:,:,:,:) = 0.0 1732 1731 c histoW(:,:,:,:) = 0.0 1732 ! fin anne 1733 1733 1734 1734 cIM … … 1773 1773 . rlat,rlon,pctsrf, ftsol, 1774 1774 . ocean, ok_veget, 1775 . falb e, falblw, rain_fall,snow_fall,1775 . falb1, falb2, rain_fall,snow_fall, 1776 1776 . solsw, sollw, 1777 1777 . radsol,clesphy0, … … 2318 2318 e t_seri, q_seri, u_seri, v_seri, 2319 2319 e pplay, paprs, pctsrf, 2320 + ftsol, falb e, falblw,u10m, v10m,2320 + ftsol, falb1, falb2, u10m, v10m, 2321 2321 s sollwdown, cdragh, cdragm, yu1, yv1, 2322 s albsol , albsollw,sens, evap,2322 s albsol1, albsol2, sens, evap, 2323 2323 s zxtsol, zxfluxlat, zt2m, qsat2m, 2324 2324 s d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, … … 3233 3233 $ zxsnow_dummy, 3234 3234 $ solsw, 3235 $ albsol ,3235 $ albsol1, 3236 3236 $ rain_fall, 3237 3237 $ snow_fall, … … 3294 3294 3295 3295 DO i = 1, klon 3296 albsol (i) = falbe(i,is_oce) * pctsrf(i,is_oce)3297 . + falb e(i,is_lic) * pctsrf(i,is_lic)3298 . + falb e(i,is_ter) * pctsrf(i,is_ter)3299 . + falb e(i,is_sic) * pctsrf(i,is_sic)3300 albsol lw(i) = falblw(i,is_oce) * pctsrf(i,is_oce)3301 . + falb lw(i,is_lic) * pctsrf(i,is_lic)3302 . + falb lw(i,is_ter) * pctsrf(i,is_ter)3303 . + falb lw(i,is_sic) * pctsrf(i,is_sic)3296 albsol1(i) = falb1(i,is_oce) * pctsrf(i,is_oce) 3297 . + falb1(i,is_lic) * pctsrf(i,is_lic) 3298 . + falb1(i,is_ter) * pctsrf(i,is_ter) 3299 . + falb1(i,is_sic) * pctsrf(i,is_sic) 3300 albsol2(i) = falb2(i,is_oce) * pctsrf(i,is_oce) 3301 . + falb2(i,is_lic) * pctsrf(i,is_lic) 3302 . + falb2(i,is_ter) * pctsrf(i,is_ter) 3303 . + falb2(i,is_sic) * pctsrf(i,is_sic) 3304 3304 ENDDO 3305 3305 … … 3335 3335 CALL radlwsw ! nouveau rayonnement (compatible Arpege-IFS) 3336 3336 e (dist, rmu0, fract, 3337 e paprs, pplay,zxtsol,albsol , albsollw, t_seri,q_seri,3337 e paprs, pplay,zxtsol,albsol1, albsol2, t_seri,q_seri, 3338 3338 e wo, 3339 3339 e cldfra, cldemi, cldtau, … … 3574 3574 I pphis, 3575 3575 I pphi, 3576 I albsol ,3576 I albsol1, 3577 3577 I qx(1,1,1), 3578 3578 I rhcl, … … 3827 3827 c pour ecriture dans histxxx.nc 3828 3828 3829 ! Get some variables from module mod_fonte_neige3829 ! Get some variables from module fonte_neige_mod 3830 3830 CALL fonte_neige_get_vars(pctsrf, 3831 3831 . zxfqcalving, zxfqfonte, zxffonte) 3832 3832 3833 3833 IF (ocean == 'slab') THEN 3834 ! Get some variables from module ocean slab3834 ! Get some variables from module ocean_slab_mod 3835 3835 CALL ocean_slab_get_vars(tslab, seaice, fluxo, fluxg) 3836 3836 ELSEIF (ocean == 'couple') THEN 3837 ! Get some variables from module ocean cpl3837 ! Get some variables from module ocean_cpl_mod 3838 3838 CALL ocean_cpl_get_vars(fluxo, fluxg) 3839 3839 ELSE 3840 ! Get some variables from module ocean forced3840 ! Get some variables from module ocean_forced_mod 3841 3841 CALL ocean_forced_get_vars(fluxo, fluxg) 3842 3842 ENDIF … … 3884 3884 CALL phyredem ("restartphy.nc",dtime,radpas,ocean, 3885 3885 . rlat, rlon, pctsrf, ftsol, 3886 . falb e,falblw, rain_fall,3886 . falb1, falb2, rain_fall, 3887 3887 . snow_fall, 3888 3888 . solsw, sollw, -
LMDZ4/trunk/libf/phylmd/radlwsw.F
r776 r888 3 3 ! 4 4 SUBROUTINE radlwsw(dist, rmu0, fract, 5 . paprs, pplay,tsol,alb edo, alblw, t,q,wo,5 . paprs, pplay,tsol,alb1, alb2, t,q,wo, 6 6 . cldfra, cldemi, cldtaupd, 7 7 . heat,heat0,cool,cool0,radsol,albpla, … … 30 30 c pplay----input-R- pression au milieu de couche (Pa) 31 31 c tsol-----input-R- temperature du sol (en K) 32 c albedo---input-R- albedo du sol (entre 0 et 1) 32 c alb1-----input-R- albedo du sol(entre 0 et 1) dans l'interval visible 33 c alb2-----input-R- albedo du sol(entre 0 et 1) dans l'interval proche infra-rouge 33 34 c t--------input-R- temperature (K) 34 35 c q--------input-R- vapeur d'eau (en kg/kg) … … 81 82 c 82 83 real paprs(klon,klev+1), pplay(klon,klev) 83 real alb edo(klon), alblw(klon), tsol(klon)84 real alb1(klon), alb2(klon), tsol(klon) 84 85 real t(klon,klev), q(klon,klev), wo(klon,klev) 85 86 real cldfra(klon,klev), cldemi(klon,klev), cldtaupd(klon,klev) … … 209 210 zfract(i) = fract(iof+i) 210 211 zrmu0(i) = rmu0(iof+i) 211 PALBD(i,1) = alb edo(iof+i)212 ! PALBD(i,2) = alb edo(iof+i)213 PALBD(i,2) = alb lw(iof+i)214 PALBP(i,1) = alb edo(iof+i)215 ! PALBP(i,2) = alb edo(iof+i)216 PALBP(i,2) = alb lw(iof+i)212 PALBD(i,1) = alb1(iof+i) 213 ! PALBD(i,2) = alb1(iof+i) 214 PALBD(i,2) = alb2(iof+i) 215 PALBP(i,1) = alb1(iof+i) 216 ! PALBP(i,2) = alb1(iof+i) 217 PALBP(i,2) = alb2(iof+i) 217 218 cIM cf. JLD pour etre en accord avec ORCHIDEE il faut mettre PEMIS(i) = 0.96 218 219 PEMIS(i) = 1.0 -
LMDZ4/trunk/libf/phylmd/surf_land_bucket_mod.F90
r793 r888 20 20 SUBROUTINE surf_land_bucket(itime, jour, knon, knindex, debut, dtime,& 21 21 tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, & 22 spechum, petAcoef, peqAcoef, petBcoef, peqBcoef, p s, &23 u1_lay, v1_lay, rugoro, &24 radsol,snow, qsol, agesno, tsoil, &25 qsurf, z0_new, alb lw, evap, fluxsens, fluxlat, &26 tsurf_new, alb_new, dflux_s, dflux_l)22 spechum, petAcoef, peqAcoef, petBcoef, peqBcoef, pref, & 23 u1_lay, v1_lay, rugoro, swnet, lwnet, & 24 snow, qsol, agesno, tsoil, & 25 qsurf, z0_new, alb1_new, alb2_new, evap, & 26 fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l) 27 27 28 28 !**************************************************************************************** … … 47 47 REAL, DIMENSION(klon), INTENT(IN) :: petAcoef, peqAcoef 48 48 REAL, DIMENSION(klon), INTENT(IN) :: petBcoef, peqBcoef 49 REAL, DIMENSION(klon), INTENT(IN) :: p s49 REAL, DIMENSION(klon), INTENT(IN) :: pref 50 50 REAL, DIMENSION(klon), INTENT(IN) :: u1_lay, v1_lay 51 51 REAL, DIMENSION(klon), INTENT(IN) :: rugoro 52 REAL, DIMENSION(klon), INTENT(IN) :: swnet, lwnet 52 53 53 54 ! In/Output variables 54 55 !**************************************************************************************** 55 REAL, DIMENSION(klon), INTENT(INOUT) :: radsol56 56 REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsol 57 57 REAL, DIMENSION(klon), INTENT(INOUT) :: agesno … … 62 62 REAL, DIMENSION(klon), INTENT(OUT) :: qsurf 63 63 REAL, DIMENSION(klon), INTENT(OUT) :: z0_new 64 REAL, DIMENSION(klon), INTENT(OUT) :: alb lw64 REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new, alb2_new 65 65 REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat 66 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new , alb_new66 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new 67 67 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l 68 68 … … 71 71 REAL, DIMENSION(klon) :: soilcap, soilflux 72 72 REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol 73 REAL, DIMENSION(klon) :: alb_neig 73 REAL, DIMENSION(klon) :: alb_neig, alb_lim 74 74 REAL, DIMENSION(klon) :: zfra 75 REAL, DIMENSION(klon) :: radsol ! total net radiance at surface 75 76 INTEGER :: i 76 77 ! … … 79 80 80 81 ! 81 !* Read from limit.nc : albedo(alb_ new), length of rugosity(z0_new)82 !* Read from limit.nc : albedo(alb_lim), length of rugosity(z0_new) 82 83 ! 83 84 CALL interfsur_lim(itime, dtime, jour, & 84 85 knon, knindex, debut, & 85 alb_ new, z0_new)86 alb_lim, z0_new) 86 87 87 88 ! 88 89 !* Calcultaion of fluxes 89 90 ! 91 92 ! calculate total absorbed radiance at surface 93 radsol(:) = 0.0 94 radsol(1:knon) = swnet(1:knon) + lwnet(1:knon) 95 90 96 ! calculate constants 91 97 CALL calbeta(dtime, is_ter, knon, snow, qsol, beta, capsol, dif_grnd) … … 103 109 104 110 CALL calcul_fluxs(knon, is_ter, dtime, & 105 tsurf, p1lay, cal, beta, tq_cdrag, p s, &111 tsurf, p1lay, cal, beta, tq_cdrag, pref, & 106 112 precip_rain, precip_snow, snow, qsurf, & 107 113 radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, & … … 124 130 DO i=1, knon 125 131 zfra(i) = MAX(0.0,MIN(1.0, snow(i)/(snow(i)+10.0))) 126 alb_ new(i) = alb_neig(i) *zfra(i) + alb_new(i)*(1.0-zfra(i))132 alb_lim(i) = alb_neig(i) *zfra(i) + alb_lim(i)*(1.0-zfra(i)) 127 133 END DO 128 134 129 alblw(:) = 0.0 130 alblw(1:knon) = alb_new(1:knon) 131 135 ! 136 !* Return albedo : 137 ! alb1_new and alb2_new are here given the same values 138 ! 139 alb1_new(:) = 0.0 140 alb2_new(:) = 0.0 141 alb1_new(1:knon) = alb_lim(1:knon) 142 alb2_new(1:knon) = alb_lim(1:knon) 143 132 144 ! 133 145 !* Calculate the rugosity -
LMDZ4/trunk/libf/phylmd/surf_land_mod.F90
r793 r888 20 20 SUBROUTINE surf_land(itime, dtime, date0, jour, knon, knindex, & 21 21 rlon, rlat, & 22 debut, lafin, zlev, epot_air, ccanopy, sollwdown, swnet, swdown, &22 debut, lafin, zlev, ccanopy, swnet, lwnet, albedo, & 23 23 tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, & 24 24 petAcoef, peqAcoef, petBcoef, peqBcoef, & 25 ps, u1_lay, v1_lay, rugoro, pctsrf, & 26 radsol, snow, qsurf, qsol, agesno, & 27 tsoil, z0_new, alblw, evap, fluxsens, fluxlat, & 28 tsurf_new, alb_new, dflux_s, dflux_l, pctsrf_ter) 25 pref, u1_lay, v1_lay, rugoro, pctsrf, & 26 snow, qsol, agesno, tsoil, & 27 z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, & 28 qsurf, tsurf_new, dflux_s, dflux_l, pctsrf_ter, & 29 lwdown_m) 29 30 30 31 INCLUDE "indicesol.h" 31 32 INCLUDE "dimsoil.h" 33 INCLUDE "YOMCST.h" 32 34 33 35 ! Input variables … … 39 41 LOGICAL, INTENT(IN) :: debut, lafin 40 42 REAL, INTENT(IN) :: dtime 41 REAL, DIMENSION(klon), INTENT(IN) :: zlev, epot_air, ccanopy 42 REAL, DIMENSION(klon), INTENT(IN) :: sollwdown, swnet, swdown 43 REAL, DIMENSION(klon), INTENT(IN) :: zlev, ccanopy 44 REAL, DIMENSION(klon), INTENT(IN) :: swnet, lwnet 45 REAL, DIMENSION(klon), INTENT(IN) :: albedo ! albedo for whole short-wave interval 43 46 REAL, DIMENSION(klon), INTENT(IN) :: tsurf 44 47 REAL, DIMENSION(klon), INTENT(IN) :: p1lay … … 48 51 REAL, DIMENSION(klon), INTENT(IN) :: petAcoef, peqAcoef 49 52 REAL, DIMENSION(klon), INTENT(IN) :: petBcoef, peqBcoef 50 REAL, DIMENSION(klon), INTENT(IN) :: p s53 REAL, DIMENSION(klon), INTENT(IN) :: pref ! pressure reference 51 54 REAL, DIMENSION(klon), INTENT(IN) :: u1_lay, v1_lay 52 55 REAL, DIMENSION(klon), INTENT(IN) :: rugoro 53 56 REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf 54 57 58 REAL, DIMENSION(klon), INTENT(IN) :: lwdown_m ! downwelling longwave radiation at mean surface 59 ! corresponds to previous sollwdown 60 55 61 ! In/Output variables 56 62 !**************************************************************************************** 57 REAL, DIMENSION(klon), INTENT(INOUT) :: radsol58 63 REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsol 59 64 REAL, DIMENSION(klon), INTENT(INOUT) :: agesno … … 62 67 ! Output variables 63 68 !**************************************************************************************** 69 REAL, DIMENSION(klon), INTENT(OUT) :: z0_new 70 REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new ! albdeo for shortwave interval 1(visible) 71 REAL, DIMENSION(klon), INTENT(OUT) :: alb2_new ! albedo for shortwave interval 2(near infrared) 72 REAL, DIMENSION(klon), INTENT(OUT) :: evap 73 REAL, DIMENSION(klon), INTENT(OUT) :: fluxsens, fluxlat 64 74 REAL, DIMENSION(klon), INTENT(OUT) :: qsurf 65 REAL, DIMENSION(klon), INTENT(OUT) :: z0_new 66 REAL, DIMENSION(klon), INTENT(OUT) :: alblw 67 REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat 68 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new, alb_new 75 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new 69 76 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l 70 77 REAL, DIMENSION(klon), INTENT(OUT) :: pctsrf_ter … … 72 79 ! Local variables 73 80 !**************************************************************************************** 74 REAL, DIMENSION(klon) :: ps_tmp, p1lay_tmp 81 REAL, DIMENSION(klon) :: p1lay_tmp 82 REAL, DIMENSION(klon) :: pref_tmp 83 REAL, DIMENSION(klon) :: swdown ! downwelling shortwave radiation at land surface 84 REAL, DIMENSION(klon) :: lwdown ! downwelling longwave radiation at land surface 85 REAL, DIMENSION(klon) :: epot_air ! potential air temperature 75 86 REAL, DIMENSION(klon) :: tsol_rad, emis_new ! output from interfsol not used 76 87 INTEGER :: i … … 83 94 IF (ok_veget) THEN 84 95 !**************************************************************************************** 85 ! Call model sechiba 96 ! Call model sechiba in model ORCHIDEE 86 97 ! 87 98 !**************************************************************************************** 88 99 p1lay_tmp(:) = 0.0 89 p s_tmp(:)= 0.0100 pref_tmp(:) = 0.0 90 101 p1lay_tmp(1:knon) = p1lay(1:knon)/100. 91 ps_tmp(1:knon) = ps(1:knon)/100. 102 pref_tmp(1:knon) = pref(1:knon)/100. 103 ! 104 !* Calculate incoming flux for SW and LW interval: swdown, lwdown 105 ! 106 swdown(:) = 0.0 107 lwdown(:) = 0.0 108 DO i = 1, knon 109 swdown(i) = swnet(i)/(1-albedo(i)) 110 lwdown(i) = lwnet(i) + RSIGMA*tsurf(i)**4 111 END DO 112 ! 113 !* Calculate potential air temperature 114 ! 115 epot_air(:) = 0.0 116 DO i = 1, knon 117 epot_air(i) = RCPD*temp_air(i)*(pref(i)/p1lay(i))**RKAPPA 118 END DO 92 119 93 120 #ifdef CPP_VEGET 121 ! temporary for keeping same results using lwdown_m instead of lwdown 94 122 CALL surf_land_orchidee(itime, dtime, date0, knon, & 95 123 knindex, rlon, rlat, pctsrf, & … … 97 125 zlev, u1_lay, v1_lay, temp_air, spechum, epot_air, ccanopy, & 98 126 tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, & 99 precip_rain, precip_snow, sollwdown, swnet, swdown, &100 p s_tmp, &127 precip_rain, precip_snow, lwdown_m, swnet, swdown, & 128 pref_tmp, & 101 129 evap, fluxsens, fluxlat, & 102 tsol_rad, tsurf_new, alb _new, alblw, &130 tsol_rad, tsurf_new, alb1_new, alb2_new, & 103 131 emis_new, z0_new, qsurf) 104 132 #endif 105 133 106 134 ! 107 !* A jout de la contribution du relief135 !* Add contribution of relief to surface roughness 108 136 ! 109 137 DO i=1,knon … … 118 146 CALL surf_land_bucket(itime, jour, knon, knindex, debut, dtime,& 119 147 tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, & 120 spechum, petAcoef, peqAcoef, petBcoef, peqBcoef, p s, &121 u1_lay, v1_lay, rugoro, &122 radsol,snow, qsol, agesno, tsoil, &123 qsurf, z0_new, alb lw, evap, fluxsens, fluxlat, &124 tsurf_new, alb_new, dflux_s, dflux_l)148 spechum, petAcoef, peqAcoef, petBcoef, peqBcoef, pref, & 149 u1_lay, v1_lay, rugoro, swnet, lwnet, & 150 snow, qsol, agesno, tsoil, & 151 qsurf, z0_new, alb1_new, alb2_new, evap, & 152 fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l) 125 153 126 154 ENDIF ! ok_veget -
LMDZ4/trunk/libf/phylmd/surf_land_orchidee_mod.F90
r854 r888 37 37 ps, & 38 38 evap, fluxsens, fluxlat, & 39 tsol_rad, tsurf_new, alb _new, alblw, &39 tsol_rad, tsurf_new, alb1_new, alb2_new, & 40 40 emis_new, z0_new, qsurf) 41 41 ! … … 84 84 ! tsol_rad 85 85 ! tsurf_new temperature au sol 86 ! alb_new albedo 86 ! alb1_new albedo in visible SW interval 87 ! alb2_new albedo in near IR interval 87 88 ! emis_new emissivite 88 89 ! z0_new surface roughness … … 120 121 !**************************************************************************************** 121 122 REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat, qsurf 122 REAL, DIMENSION(klon), INTENT(OUT) :: tsol_rad, tsurf_new, alb_new, alblw 123 REAL, DIMENSION(klon), INTENT(OUT) :: tsol_rad, tsurf_new 124 REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new, alb2_new 123 125 REAL, DIMENSION(klon), INTENT(OUT) :: emis_new, z0_new 124 126 … … 442 444 ENDIF 443 445 444 alb _new(1:knon) = albedo_out(1:knon,1)445 alb lw(1:knon) = albedo_out(1:knon,2)446 alb1_new(1:knon) = albedo_out(1:knon,1) 447 alb2_new(1:knon) = albedo_out(1:knon,2) 446 448 447 449 ! Convention orchidee: positif vers le haut -
LMDZ4/trunk/libf/phylmd/surf_landice_mod.F90
r793 r888 17 17 ! 18 18 SUBROUTINE surf_landice(itime, dtime, knon, knindex, & 19 tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, & 19 swnet, lwnet, tsurf, p1lay, & 20 tq_cdrag, precip_rain, precip_snow, temp_air, spechum, & 20 21 petAcoef, peqAcoef, petBcoef, peqBcoef, & 21 22 ps, u1_lay, v1_lay, rugoro, pctsrf, & 22 radsol,snow, qsurf, qsol, agesno, &23 tsoil, z0_new, alb lw, evap, fluxsens, fluxlat, &24 tsurf_new, alb_new,dflux_s, dflux_l, pctsrf_lic)23 snow, qsurf, qsol, agesno, & 24 tsoil, z0_new, alb1, alb2, evap, fluxsens, fluxlat, & 25 tsurf_new, dflux_s, dflux_l, pctsrf_lic) 25 26 26 27 INCLUDE "indicesol.h" … … 34 35 INTEGER, DIMENSION(klon), INTENT(in) :: knindex 35 36 REAL, INTENT(in) :: dtime 37 REAL, DIMENSION(klon), INTENT(IN) :: swnet ! net shortwave radiance 38 REAL, DIMENSION(klon), INTENT(IN) :: lwnet ! net longwave radiance 36 39 REAL, DIMENSION(klon), INTENT(IN) :: tsurf 37 40 REAL, DIMENSION(klon), INTENT(IN) :: p1lay … … 48 51 ! In/Output variables 49 52 !**************************************************************************************** 50 REAL, DIMENSION(klon), INTENT(INOUT) :: radsol51 53 REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsol 52 54 REAL, DIMENSION(klon), INTENT(INOUT) :: agesno … … 57 59 REAL, DIMENSION(klon), INTENT(OUT) :: qsurf 58 60 REAL, DIMENSION(klon), INTENT(OUT) :: z0_new 59 REAL, DIMENSION(klon), INTENT(OUT) :: alblw 61 REAL, DIMENSION(klon), INTENT(OUT) :: alb1 ! new albedo in visible SW interval 62 REAL, DIMENSION(klon), INTENT(OUT) :: alb2 ! new albedo in near IR interval 60 63 REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat 61 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new , alb_new64 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new 62 65 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l 63 66 REAL, DIMENSION(klon), INTENT(OUT) :: pctsrf_lic … … 68 71 REAL, DIMENSION(klon) :: cal, beta, dif_grnd 69 72 REAL, DIMENSION(klon) :: zfra, alb_neig 73 REAL, DIMENSION(klon) :: radsol 70 74 71 75 ! End definition … … 73 77 ! 74 78 ! Initialize output variables 75 alb lw(:) =999999.76 alb _new(:) = 999999.79 alb2(:) = 999999. 80 alb1(:) = 999999. 77 81 82 !**************************************************************************************** 83 ! Calculate total absorbed radiance at surface 84 ! 85 !**************************************************************************************** 86 radsol(:) = 0.0 87 radsol(1:knon) = swnet(1:knon) + lwnet(1:knon) 78 88 79 89 !**************************************************************************************** … … 122 132 WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0. 123 133 zfra(1:knon) = MAX(0.0,MIN(1.0,snow(1:knon)/(snow(1:knon)+10.0))) 124 alb _new(1:knon)= alb_neig(1:knon)*zfra(1:knon) + &134 alb1(1:knon) = alb_neig(1:knon)*zfra(1:knon) + & 125 135 0.6 * (1.0-zfra(1:knon)) 126 136 ! 127 137 !IM: plusieurs choix/tests sur l'albedo des "glaciers continentaux" 128 ! alb _new(1 : knon) = 0.6 !IM cf FH/GK129 ! alb _new(1 : knon) = 0.82130 ! alb _new(1 : knon) = 0.77 !211003 Ksta0.77131 ! alb _new(1 : knon) = 0.8 !KstaTER0.8 & LMD_ARMIP5138 ! alb1(1 : knon) = 0.6 !IM cf FH/GK 139 ! alb1(1 : knon) = 0.82 140 ! alb1(1 : knon) = 0.77 !211003 Ksta0.77 141 ! alb1(1 : knon) = 0.8 !KstaTER0.8 & LMD_ARMIP5 132 142 !IM: KstaTER0.77 & LMD_ARMIP6 133 143 134 ! Attantion: alb _new and alblware the same!135 alb _new(1:knon) = 0.77136 alb lw(1:knon) = alb_new(1:knon)144 ! Attantion: alb1 and alb2 are the same! 145 alb1(1:knon) = 0.77 146 alb2(1:knon) = alb1(1:knon) 137 147 138 148 -
LMDZ4/trunk/libf/phylmd/surf_ocean_mod.F90
r793 r888 16 16 !**************************************************************************************** 17 17 ! 18 SUBROUTINE surf_ocean(rlon, rlat, sollw, albedo, & 19 rugos, windsp, rmu0, & 20 fder, & 18 SUBROUTINE surf_ocean(rlon, rlat, swnet, lwnet, alb1, & 19 rugos, windsp, rmu0, fder, & 21 20 itime, dtime, jour, knon, knindex, & 22 debut, swdown,&21 debut, & 23 22 p1lay, tq_cdrag, coefm, precip_rain, precip_snow, temp_air, spechum, & 24 23 petAcoef, peqAcoef, petBcoef, peqBcoef, & 25 24 ps, u1_lay, v1_lay, rugoro, pctsrf, & 26 radsol,snow, qsurf, agesno, &27 z0_new, alb lw, evap, fluxsens, fluxlat, &28 tsurf_new, alb_new,dflux_s, dflux_l, pctsrf_oce)25 snow, qsurf, agesno, & 26 z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, & 27 tsurf_new, dflux_s, dflux_l, pctsrf_oce) 29 28 ! 30 29 ! This subroutine will make a call to ocean_XXX_noice according to the ocean mode (force, … … 41 40 REAL, INTENT(IN) :: dtime 42 41 REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat 43 REAL, DIMENSION(klon), INTENT(IN) :: sollw 44 REAL, DIMENSION(klon), INTENT(IN) :: albedo 42 REAL, DIMENSION(klon), INTENT(IN) :: swnet ! net shortwave radiation at surface 43 REAL, DIMENSION(klon), INTENT(IN) :: lwnet ! net longwave radiation at surface 44 REAL, DIMENSION(klon), INTENT(IN) :: alb1 ! albedo in visible SW interval 45 45 REAL, DIMENSION(klon), INTENT(IN) :: rugos 46 46 REAL, DIMENSION(klon), INTENT(IN) :: windsp 47 47 REAL, DIMENSION(klon), INTENT(IN) :: rmu0 48 48 REAL, DIMENSION(klon), INTENT(IN) :: fder 49 REAL, DIMENSION(klon), INTENT(IN) :: swdown50 49 REAL, DIMENSION(klon), INTENT(IN) :: p1lay 51 50 REAL, DIMENSION(klon), INTENT(IN) :: tq_cdrag … … 63 62 ! In/Output variables 64 63 !**************************************************************************************** 65 REAL, DIMENSION(klon), INTENT(INOUT) :: radsol66 REAL, DIMENSION(klon), INTENT(INOUT) :: snow,qsurf64 REAL, DIMENSION(klon), INTENT(INOUT) :: snow 65 REAL, DIMENSION(klon), INTENT(INOUT) :: qsurf 67 66 REAL, DIMENSION(klon), INTENT(INOUT) :: agesno 68 67 … … 70 69 !**************************************************************************************** 71 70 REAL, DIMENSION(klon), INTENT(OUT) :: z0_new 72 REAL, DIMENSION(klon), INTENT(OUT) :: alblw 71 REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new ! new albedo in visible SW interval 72 REAL, DIMENSION(klon), INTENT(OUT) :: alb2_new ! new albedo in near IR interval 73 73 REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat 74 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new , alb_new74 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new 75 75 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l 76 76 REAL, DIMENSION(klon), INTENT(OUT) :: pctsrf_oce … … 81 81 INTEGER :: i 82 82 REAL, DIMENSION(klon) :: alb_eau 83 REAL, DIMENSION(klon) :: radsol 83 84 84 85 ! End definition 85 86 !**************************************************************************************** 86 ! 87 88 89 !**************************************************************************************** 90 ! Calculate total net radiance at surface 91 ! 92 !**************************************************************************************** 93 radsol(:) = 0.0 94 radsol(1:knon) = swnet(1:knon) + lwnet(1:knon) 95 96 !**************************************************************************************** 87 97 ! Switch according to type of ocean (couple, slab or forced) 88 98 !**************************************************************************************** 89 99 SELECT CASE(ocean) 90 100 CASE('couple') 91 CALL ocean_cpl_noice( &92 s ollw, albedo, &101 CALL ocean_cpl_noice( & 102 swnet, lwnet, alb1, & 93 103 windsp, & 94 104 fder, & 95 105 itime, dtime, knon, knindex, & 96 swdown, &97 106 p1lay, tq_cdrag, precip_rain, precip_snow,temp_air,spechum,& 98 107 petAcoef, peqAcoef, petBcoef, peqBcoef, & 99 108 ps, u1_lay, v1_lay, pctsrf, & 100 radsol, snow, qsurf,agesno, &101 evap, fluxsens, fluxlat, &109 radsol, snow, agesno, & 110 qsurf, evap, fluxsens, fluxlat, & 102 111 tsurf_new, dflux_s, dflux_l, pctsrf_oce) 103 112 104 113 CASE('slab') 105 CALL ocean_slab_noice( &114 CALL ocean_slab_noice( & 106 115 dtime, knon, knindex, & 107 116 p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum,& 108 117 petAcoef, peqAcoef, petBcoef, peqBcoef, & 109 118 ps, u1_lay, v1_lay, & 110 radsol, snow, qsurf, agesno, & 111 evap, fluxsens, fluxlat, & 112 tsurf_new, & 113 dflux_s, dflux_l, pctsrf_oce) 119 radsol, snow, agesno, & 120 qsurf, evap, fluxsens, fluxlat, & 121 tsurf_new, dflux_s, dflux_l, pctsrf_oce) 114 122 115 123 CASE('force') 116 CALL ocean_forced_noice(itime, dtime, jour, knon, knindex, & 124 CALL ocean_forced_noice( & 125 itime, dtime, jour, knon, knindex, & 117 126 debut, & 118 127 p1lay, tq_cdrag, precip_rain, precip_snow, & … … 120 129 petAcoef, peqAcoef, petBcoef, peqBcoef, & 121 130 ps, u1_lay, v1_lay, & 122 radsol, snow, qsurf, & 123 agesno, & 124 evap, fluxsens, fluxlat, & 131 radsol, snow, agesno, & 132 qsurf, evap, fluxsens, fluxlat, & 125 133 tsurf_new, dflux_s, dflux_l, pctsrf_oce) 126 134 END SELECT … … 137 145 138 146 DO i =1, knon 139 alb _new(i) = alb_eau(knindex(i))147 alb1_new(i) = alb_eau(knindex(i)) 140 148 ENDDO 149 alb2_new(1:knon) = alb1_new(1:knon) 141 150 142 151 !**************************************************************************************** … … 154 163 ENDDO 155 164 156 alblw(1:knon) = alb_new(1:knon)157 165 ! 158 166 !**************************************************************************************** -
LMDZ4/trunk/libf/phylmd/surf_seaice_mod.F90
r793 r888 16 16 ! 17 17 SUBROUTINE surf_seaice( & 18 rlon, rlat, sollw, albedo, & 19 fder, & 18 rlon, rlat, swnet, lwnet, alb1, fder, & 20 19 itime, dtime, jour, knon, knindex, & 21 debut, lafin, swdown,&20 debut, lafin, & 22 21 tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, & 23 22 petAcoef, peqAcoef, petBcoef, peqBcoef, & 24 23 ps, u1_lay, v1_lay, rugoro, pctsrf, & 25 radsol, snow, qsurf, qsol, agesno, &26 tsoil, z0_new, alblw, evap, fluxsens, fluxlat, &27 tsurf_new, alb_new,dflux_s, dflux_l, pctsrf_sic)24 snow, qsurf, qsol, agesno, tsoil, & 25 z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, & 26 tsurf_new, dflux_s, dflux_l, pctsrf_sic) 28 27 ! 29 28 ! This subroutine will make a call to ocean_XXX_ice according to the ocean mode (force, … … 41 40 REAL, INTENT(IN) :: dtime 42 41 REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat 43 REAL, DIMENSION(klon), INTENT(IN) :: sollw 44 REAL, DIMENSION(klon), INTENT(IN) :: albedo 42 REAL, DIMENSION(klon), INTENT(IN) :: swnet ! net shortwave radiation at surface 43 REAL, DIMENSION(klon), INTENT(IN) :: lwnet ! net longwave radiation at surface 44 REAL, DIMENSION(klon), INTENT(IN) :: alb1 ! albedo in visible SW interval 45 45 REAL, DIMENSION(klon), INTENT(IN) :: fder 46 REAL, DIMENSION(klon), INTENT(IN) :: swdown47 46 REAL, DIMENSION(klon), INTENT(IN) :: tsurf 48 47 REAL, DIMENSION(klon), INTENT(IN) :: p1lay … … 59 58 ! In/Output arguments 60 59 !**************************************************************************************** 61 REAL, DIMENSION(klon), INTENT(INOUT) :: radsol62 60 REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsurf, qsol 63 61 REAL, DIMENSION(klon), INTENT(INOUT) :: agesno … … 67 65 !**************************************************************************************** 68 66 REAL, DIMENSION(klon), INTENT(OUT) :: z0_new 69 REAL, DIMENSION(klon), INTENT(OUT) :: alblw 67 REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new ! new albedo in visible SW interval 68 REAL, DIMENSION(klon), INTENT(OUT) :: alb2_new ! new albedo in near IR interval 70 69 REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat 71 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new , alb_new70 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new 72 71 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l 73 72 REAL, DIMENSION(klon), INTENT(OUT) :: pctsrf_sic 74 73 74 ! Local arguments 75 !**************************************************************************************** 76 REAL, DIMENSION(klon) :: radsol 77 ! 75 78 ! End definitions 76 79 !**************************************************************************************** 80 81 82 !**************************************************************************************** 83 ! Calculate total net radiance at surface 84 ! 85 !**************************************************************************************** 86 radsol(:) = 0.0 87 radsol(1:knon) = swnet(1:knon) + lwnet(1:knon) 77 88 78 89 !**************************************************************************************** … … 83 94 CASE('couple') 84 95 CALL ocean_cpl_ice( & 85 rlon, rlat, s ollw, albedo, &96 rlon, rlat, swnet, lwnet, alb1, & 86 97 fder, & 87 98 itime, dtime, knon, knindex, & 88 99 lafin,& 89 swdown, &90 100 p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum,& 91 101 petAcoef, peqAcoef, petBcoef, peqBcoef, & 92 102 ps, u1_lay, v1_lay, pctsrf, & 93 103 radsol, snow, qsurf, & 94 alb lw, evap, fluxsens, fluxlat, &95 tsurf_new, alb_new,dflux_s, dflux_l, pctsrf_sic)104 alb1_new, alb2_new, evap, fluxsens, fluxlat, & 105 tsurf_new, dflux_s, dflux_l, pctsrf_sic) 96 106 97 107 CASE('slab') … … 102 112 petAcoef, peqAcoef, petBcoef, peqBcoef, & 103 113 ps, u1_lay, v1_lay, & 104 radsol, snow, qsurf, qsol, agesno, & 105 tsoil, & 106 alblw, evap, fluxsens, fluxlat, & 107 tsurf_new, alb_new, dflux_s, dflux_l, pctsrf_sic) 114 radsol, snow, qsurf, qsol, agesno, tsoil, & 115 alb1_new, alb2_new, evap, fluxsens, fluxlat, & 116 tsurf_new, dflux_s, dflux_l, pctsrf_sic) 108 117 109 118 CASE('force') … … 113 122 petAcoef, peqAcoef, petBcoef, peqBcoef, & 114 123 ps, u1_lay, v1_lay, & 115 radsol, snow, qs urf, qsol, agesno, &116 tsoil, alblw, evap, fluxsens, fluxlat, &117 tsurf_new, alb_new,dflux_s, dflux_l, pctsrf_sic)124 radsol, snow, qsol, agesno, tsoil, & 125 qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, & 126 tsurf_new, dflux_s, dflux_l, pctsrf_sic) 118 127 END SELECT 119 128 -
LMDZ4/trunk/libf/phylmd/write_histday.h
r879 r888 515 515 $ zx_tmp_fi2d) 516 516 C 517 zx_tmp_fi2d(1 : klon) = falb e( 1 : klon, nsrf)517 zx_tmp_fi2d(1 : klon) = falb1( 1 : klon, nsrf) 518 518 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 519 519 CALL histwrite_phy(nid_day,"albe_"//clnsurf(nsrf),itau_w, -
LMDZ4/trunk/libf/phylmd/write_histhf.h
r782 r888 100 100 CALL histwrite_phy(nid_hf,"SWnetOR",itau_w, zx_tmp_fi2d) 101 101 c 102 zx_tmp_fi2d(1:klon) = solsw(1:klon)/(1.-albsol (1:klon))102 zx_tmp_fi2d(1:klon) = solsw(1:klon)/(1.-albsol1(1:klon)) 103 103 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d) 104 104 CALL histwrite_phy(nid_hf,"SWdownOR",itau_w, zx_tmp_fi2d) -
LMDZ4/trunk/libf/phylmd/write_histins.h
r776 r888 145 145 $ zx_tmp_fi2d) 146 146 C 147 zx_tmp_fi2d(1 : klon) = falb e( 1 : klon, nsrf)147 zx_tmp_fi2d(1 : klon) = falb1( 1 : klon, nsrf) 148 148 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 149 149 CALL histwrite_phy(nid_ins,"albe_"//clnsurf(nsrf),itau_w, … … 151 151 C 152 152 END DO 153 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol ,zx_tmp_2d)154 CALL histwrite_phy(nid_ins,"albs",itau_w,albsol )153 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol1,zx_tmp_2d) 154 CALL histwrite_phy(nid_ins,"albs",itau_w,albsol1) 155 155 156 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol lw,zx_tmp_2d)157 CALL histwrite_phy(nid_ins,"albslw",itau_w,albsol lw)156 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol2,zx_tmp_2d) 157 CALL histwrite_phy(nid_ins,"albslw",itau_w,albsol2) 158 158 159 159 c -
LMDZ4/trunk/libf/phylmd/write_histmth.h
r879 r888 671 671 DO nsrf=1, nbsrf 672 672 c 673 zx_tmp_fi2d(1 : klon) = falb e( 1 : klon, nsrf)673 zx_tmp_fi2d(1 : klon) = falb1( 1 : klon, nsrf) 674 674 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 675 675 CALL histwrite_phy(nid_mth,"albe_"//clnsurf(nsrf),itau_w, … … 688 688 ENDDO !nsrf=1, nbsrf 689 689 c 690 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol ,zx_tmp_2d)691 CALL histwrite_phy(nid_mth,"albs",itau_w,albsol )692 c 693 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol lw,zx_tmp_2d)694 CALL histwrite_phy(nid_mth,"albslw",itau_w,albsol lw)690 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol1,zx_tmp_2d) 691 CALL histwrite_phy(nid_mth,"albs",itau_w,albsol1) 692 c 693 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol2,zx_tmp_2d) 694 CALL histwrite_phy(nid_mth,"albslw",itau_w,albsol2) 695 695 c 696 696 ENDIF !lev_histmth.GE.3 … … 1703 1703 DO nsrf=1, nbsrf 1704 1704 c 1705 zx_tmp_fi2d(1 : klon) = falb e( 1 : klon, nsrf)1705 zx_tmp_fi2d(1 : klon) = falb1( 1 : klon, nsrf) 1706 1706 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 1707 1707 CALL histwrite_phy(nid_mth,"albe_"//clnsurf(nsrf),itau_w, … … 1720 1720 ENDDO !nsrf=1, nbsrf 1721 1721 c 1722 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol ,zx_tmp_2d)1723 CALL histwrite_phy(nid_mth,"albs",itau_w,albsol )1724 c 1725 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol lw,zx_tmp_2d)1726 CALL histwrite_phy(nid_mth,"albslw",itau_w,albsol lw)1722 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol1,zx_tmp_2d) 1723 CALL histwrite_phy(nid_mth,"albs",itau_w,albsol1) 1724 c 1725 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol2,zx_tmp_2d) 1726 CALL histwrite_phy(nid_mth,"albslw",itau_w,albsol2) 1727 1727 c 1728 1728 ENDIF !lev_histmth.GE.3
Note: See TracChangeset
for help on using the changeset viewer.