Changeset 888 for LMDZ4/trunk/libf/phylmd/pbl_surface_mod.F90
- Timestamp:
- Feb 4, 2008, 5:24:28 PM (17 years ago)
- File:
-
- 1 edited
-
LMDZ4/trunk/libf/phylmd/pbl_surface_mod.F90 (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
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)
Note: See TracChangeset
for help on using the changeset viewer.
