Changeset 1999 for LMDZ5/branches/testing/libf/phylmd/radlwsw_m.F90
- Timestamp:
- Mar 20, 2014, 10:57:19 AM (10 years ago)
- Location:
- LMDZ5/branches/testing
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/radlwsw_m.F90 (modified) (17 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/branches/testing
- Property svn:mergeinfo changed
/LMDZ5/trunk merged: 1922-1927,1929-1933,1937-1939,1943-1997
- Property svn:mergeinfo changed
-
LMDZ5/branches/testing/libf/phylmd/radlwsw_m.F90
r1910 r1999 15 15 cldtaupi, new_aod, & 16 16 qsat, flwc, fiwc, & 17 ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, & 17 18 heat,heat0,cool,cool0,radsol,albpla,& 18 19 topsw,toplw,solsw,sollw,& … … 26 27 topsw_aero, topsw0_aero,& 27 28 solsw_aero, solsw0_aero, & 28 topswcf_aero, solswcf_aero) 29 topswcf_aero, solswcf_aero,& 30 ZLWFT0_i, ZFLDN0, ZFLUP0,& 31 ZSWFT0_i, ZFSDN0, ZFSUP0) 29 32 30 33 … … 33 36 USE assert_m, ONLY : assert 34 37 USE infotrac, ONLY : type_trac 38 USE write_field_phy 35 39 #ifdef REPROBUS 36 40 USE CHEM_REP, ONLY : solaireTIME, ok_SUNTIME, ndimozon 41 #endif 42 #ifdef CPP_RRTM 43 ! modules necessaires au rayonnement 44 ! ----------------------------------------- 45 ! USE YOMCST , ONLY : RG ,RD ,RTT ,RPI 46 ! USE YOERAD , ONLY : NSW ,LRRTM ,LINHOM , LCCNL,LCCNO, 47 ! USE YOERAD , ONLY : NSW ,LRRTM ,LCCNL ,LCCNO ,& 48 ! NSW mis dans .def MPL 20140211 49 USE YOERAD , ONLY : LRRTM ,LCCNL ,LCCNO ,& 50 NRADIP , NRADLP , NICEOPT, NLIQOPT ,RCCNLND , RCCNSEA 51 USE YOELW , ONLY : NSIL ,NTRA ,NUA ,TSTAND ,XP 52 USE YOESW , ONLY : RYFWCA ,RYFWCB ,RYFWCC ,RYFWCD,& 53 RYFWCE ,RYFWCF ,REBCUA ,REBCUB ,REBCUC,& 54 REBCUD ,REBCUE ,REBCUF ,REBCUI ,REBCUJ,& 55 REBCUG ,REBCUH ,RHSAVI ,RFULIO ,RFLAA0,& 56 RFLAA1 ,RFLBB0 ,RFLBB1 ,RFLBB2 ,RFLBB3,& 57 RFLCC0 ,RFLCC1 ,RFLCC2 ,RFLCC3 ,RFLDD0,& 58 RFLDD1 ,RFLDD2 ,RFLDD3 ,RFUETA ,RASWCA,& 59 RASWCB ,RASWCC ,RASWCD ,RASWCE ,RASWCF 60 ! & RASWCB ,RASWCC ,RASWCD ,RASWCE ,RASWCF, RLINLI 61 USE YOERDU , ONLY : NUAER ,NTRAER ,REPLOG ,REPSC ,REPSCW ,DIFF 62 USE YOETHF , ONLY : RTICE 63 USE YOERRTWN , ONLY : DELWAVE ,TOTPLNK 64 USE YOMPHY3 , ONLY : RII0 37 65 #endif 38 66 … … 88 116 ! aerosol direct forcing is F_{AD} = topswai-topswad 89 117 ! 118 ! --------- RRTM: output RECMWFL 119 ! ZEMTD (KPROMA,KLEV+1) ; TOTAL DOWNWARD LONGWAVE EMISSIVITY 120 ! ZEMTU (KPROMA,KLEV+1) ; TOTAL UPWARD LONGWAVE EMISSIVITY 121 ! ZTRSO (KPROMA,KLEV+1) ; TOTAL SHORTWAVE TRANSMISSIVITY 122 ! ZTH (KPROMA,KLEV+1) ; HALF LEVEL TEMPERATURE 123 ! ZCTRSO(KPROMA,2) ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY 124 ! ZCEMTR(KPROMA,2) ; CLEAR-SKY NET LONGWAVE EMISSIVITY 125 ! ZTRSOD(KPROMA) ; TOTAL-SKY SURFACE SW TRANSMISSITY 126 ! ZLWFC (KPROMA,2) ; CLEAR-SKY LONGWAVE FLUXES 127 ! ZLWFT (KPROMA,KLEV+1) ; TOTAL-SKY LONGWAVE FLUXES 128 ! ZLWFT0(KPROMA,KLEV+1) ; CLEAR-SKY LONGWAVE FLUXES ! added by MPL 090109 129 ! ZSWFC (KPROMA,2) ; CLEAR-SKY SHORTWAVE FLUXES 130 ! ZSWFT (KPROMA,KLEV+1) ; TOTAL-SKY SHORTWAVE FLUXES 131 ! ZSWFT0(KPROMA,KLEV+1) ; CLEAR-SKY SHORTWAVE FLUXES ! added by MPL 090109 132 ! ZFLUX (KLON,2,KLEV+1) ; TOTAL LW FLUXES 1=up, 2=DWN ! added by MPL 080411 133 ! ZFLUC (KLON,2,KLEV+1) ; CLEAR SKY LW FLUXES ! added by MPL 080411 134 ! ZFSDWN(klon,KLEV+1) ; TOTAL SW DWN FLUXES ! added by MPL 080411 135 ! ZFCDWN(klon,KLEV+1) ; CLEAR SKY SW DWN FLUXES ! added by MPL 080411 136 ! ZFSUP (klon,KLEV+1) ; TOTAL SW UP FLUXES ! added by MPL 080411 137 ! ZFCUP (klon,KLEV+1) ; CLEAR SKY SW UP FLUXES ! added by MPL 080411 90 138 91 139 !====================================================================== … … 122 170 123 171 LOGICAL, INTENT(in) :: ok_ade, ok_aie ! switches whether to use aerosol direct (indirect) effects or not 172 LOGICAL :: lldebug 124 173 INTEGER, INTENT(in) :: flag_aerosol ! takes value 0 (no aerosol) or 1 to 6 (aerosols) 125 174 LOGICAL, INTENT(in) :: flag_aerosol_strat ! use stratospheric aerosols … … 133 182 REAL, INTENT(in) :: flwc(klon,klev) ! Variable pour iflag_rrtm=1 134 183 REAL, INTENT(in) :: fiwc(klon,klev) ! Variable pour iflag_rrtm=1 184 REAL, INTENT(in) :: ref_liq(klon,klev) ! cloud droplet radius present-day from newmicro 185 REAL, INTENT(in) :: ref_ice(klon,klev) ! ice crystal radius present-day from newmicro 186 REAL, INTENT(in) :: ref_liq_pi(klon,klev) ! cloud droplet radius pre-industrial from newmicro 187 REAL, INTENT(in) :: ref_ice_pi(klon,klev) ! ice crystal radius pre-industrial from newmicro 135 188 136 189 ! Output arguments … … 155 208 REAL, DIMENSION(kdlon,3), INTENT(out) :: topswcf_aero 156 209 REAL, DIMENSION(kdlon,3), INTENT(out) :: solswcf_aero 210 REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZSWFT0_i 211 REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZLWFT0_i 157 212 158 213 ! Local variables … … 167 222 REAL(KIND=8) zx_alpha1, zx_alpha2 168 223 INTEGER k, kk, i, j, iof, nb_gr 224 INTEGER ist,iend,ktdia,kmode 169 225 REAL(KIND=8) PSCT 170 226 REAL(KIND=8) PALBD(kdlon,2), PALBP(kdlon,2) 227 ! MPL 06.01.09: pour RRTM, creation de PALBD_NEW et PALBP_NEW 228 ! avec NSW en deuxieme dimension 229 REAL(KIND=8) PALBD_NEW(kdlon,NSW), PALBP_NEW(kdlon,NSW) 171 230 REAL(KIND=8) PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon) 172 231 REAL(KIND=8) PPSOL(kdlon), PDP(kdlon,KLEV) … … 178 237 ! "POZON(:, :, 1)" is for the average day-night field, 179 238 ! "POZON(:, :, 2)" is for daylight time. 180 181 REAL(KIND=8) PAER(kdlon,kflev, 5)239 !!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 240 REAL(KIND=8) PAER(kdlon,kflev,6) 182 241 REAL(KIND=8) PCLDLD(kdlon,kflev) 183 242 REAL(KIND=8) PCLDLU(kdlon,kflev) … … 206 265 REAL(KIND=8) zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9) 207 266 REAL(KIND=8) ztopswcf_aero(kdlon,3), zsolswcf_aero(kdlon,3) 267 ! real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2 deje declare dans physiq.F MPL 20130618 268 !MPL input supplementaires pour RECMWFL 269 ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg) 270 REAL(KIND=8) GEMU(klon) 271 !MPL input RECMWFL: 272 ! Tableaux aux niveaux inverses pour respecter convention Arpege 273 REAL(KIND=8) ref_liq_i(klon,klev) ! cloud droplet radius present-day from newmicro (inverted) 274 REAL(KIND=8) ref_ice_i(klon,klev) ! ice crystal radius present-day from newmicro (inverted) 275 REAL(KIND=8) paprs_i(klon,klev+1) 276 REAL(KIND=8) pplay_i(klon,klev) 277 REAL(KIND=8) cldfra_i(klon,klev) 278 REAL(KIND=8) POZON_i(kdlon,kflev, size(wo, 3)) ! mass fraction of ozone 279 ! "POZON(:, :, 1)" is for the average day-night field, 280 ! "POZON(:, :, 2)" is for daylight time. 281 !!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 282 REAL(KIND=8) PAER_i(kdlon,kflev,6) 283 REAL(KIND=8) PDP_i(klon,klev) 284 REAL(KIND=8) t_i(klon,klev),q_i(klon,klev),qsat_i(klon,klev) 285 REAL(KIND=8) flwc_i(klon,klev),fiwc_i(klon,klev) 286 !MPL output RECMWFL: 287 REAL(KIND=8) ZEMTD (klon,klev+1),ZEMTD_i (klon,klev+1) 288 REAL(KIND=8) ZEMTU (klon,klev+1),ZEMTU_i (klon,klev+1) 289 REAL(KIND=8) ZTRSO (klon,klev+1),ZTRSO_i (klon,klev+1) 290 REAL(KIND=8) ZTH (klon,klev+1),ZTH_i (klon,klev+1) 291 REAL(KIND=8) ZCTRSO(klon,2) 292 REAL(KIND=8) ZCEMTR(klon,2) 293 REAL(KIND=8) ZTRSOD(klon) 294 REAL(KIND=8) ZLWFC (klon,2) 295 REAL(KIND=8) ZLWFT (klon,klev+1),ZLWFT_i (klon,klev+1) 296 REAL(KIND=8) ZSWFC (klon,2) 297 REAL(KIND=8) ZSWFT (klon,klev+1),ZSWFT_i (klon,klev+1) 298 REAL(KIND=8) ZFLUCDWN_i(klon,klev+1),ZFLUCUP_i(klon,klev+1) 299 REAL(KIND=8) PPIZA_DST(klon,klev,NSW) 300 REAL(KIND=8) PCGA_DST(klon,klev,NSW) 301 REAL(KIND=8) PTAUREL_DST(klon,klev,NSW) 302 REAL(KIND=8) PSFSWDIR(klon,NSW) 303 REAL(KIND=8) PSFSWDIF(klon,NSW) 304 REAL(KIND=8) PFSDNN(klon) 305 REAL(KIND=8) PFSDNV(klon) 306 !MPL On ne redefinit pas les tableaux ZFLUX,ZFLUC, 307 !MPL ZFSDWN,ZFCDWN,ZFSUP,ZFCUP car ils existent deja 308 !MPL sous les noms de ZFLDN,ZFLDN0,ZFLUP,ZFLUP0, 309 !MPL ZFSDN,ZFSDN0,ZFSUP,ZFSUP0 310 REAL(KIND=8) ZFLUX_i (klon,2,klev+1) 311 REAL(KIND=8) ZFLUC_i (klon,2,klev+1) 312 REAL(KIND=8) ZFSDWN_i (klon,klev+1) 313 REAL(KIND=8) ZFCDWN_i (klon,klev+1) 314 REAL(KIND=8) ZFSUP_i (klon,klev+1) 315 REAL(KIND=8) ZFCUP_i (klon,klev+1) 316 ! 3 lignes suivantes a activer pour CCMVAL (MPL 20100412) 317 ! REAL(KIND=8) RSUN(3,2) 318 ! REAL(KIND=8) SUN(3) 319 ! REAL(KIND=8) SUN_FRACT(2) 208 320 real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2 321 !--OB 322 REAL tau(6), alt, zdz, zrho 323 character (len=20) :: modname='radlwsw' 324 character (len=80) :: abort_message 209 325 210 326 call assert(size(wo, 1) == klon, size(wo, 2) == klev, "radlwsw wo") 211 327 ! initialisation 328 ist=1 329 iend=klon 330 ktdia=1 331 kmode=ist 212 332 tauaero(:,:,:,:)=0. 213 333 pizaero(:,:,:,:)=0. 214 334 cgaero(:,:,:,:)=0. 335 lldebug=.FALSE. 215 336 216 337 ! … … 219 340 IF (nb_gr*kdlon .NE. KLON) THEN 220 341 PRINT*, "kdlon mauvais:", KLON, kdlon, nb_gr 221 CALL abort342 call abort_gcm("radlwsw", "", 1) 222 343 ENDIF 223 344 IF (kflev .NE. KLEV) THEN 224 345 PRINT*, "kflev differe de KLEV, kflev, KLEV" 225 CALL abort346 call abort_gcm("radlwsw", "", 1) 226 347 ENDIF 227 348 !------------------------------------------- … … 250 371 DO i = 1, kdlon 251 372 zfract(i) = fract(iof+i) 373 ! zfract(i) = 1. !!!!!! essai MPL 19052010 252 374 zrmu0(i) = rmu0(iof+i) 253 375 PALBD(i,1) = alb1(iof+i) 254 376 PALBD(i,2) = alb2(iof+i) 377 ! 378 PALBD_NEW(i,1) = alb1(iof+i) !!!!! A REVOIR (MPL) PALBD_NEW en fonction bdes SW 379 do kk=2,NSW 380 PALBD_NEW(i,kk) = alb2(iof+i) 381 enddo 255 382 PALBP(i,1) = alb1(iof+i) 256 383 PALBP(i,2) = alb2(iof+i) 257 PEMIS(i) = 1.0 384 ! 385 PALBP_NEW(i,1) = alb1(iof+i) !!!!! A REVOIR (MPL) PALBP_NEW en fonction bdes SW 386 do kk=2,NSW 387 PALBP_NEW(i,kk) = alb2(iof+i) 388 enddo 389 PEMIS(i) = 1.0 !!!!! A REVOIR (MPL) 258 390 PVIEW(i) = 1.66 259 391 PPSOL(i) = paprs(iof+i,1) … … 277 409 POZON(i,k, :) = wo(iof+i, k, :) * RG * dobson_u * 1e3 & 278 410 / (paprs(iof+i, k) - paprs(iof+i, k+1)) 411 ! A activer pour CCMVAL on prend l'ozone impose (MPL 07042010) 412 ! POZON(i,k,:) = wo(i,k,:) 413 ! print *,'RADLWSW: POZON',k, POZON(i,k,1) 279 414 PCLDLD(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k) 280 415 PCLDLU(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k) … … 313 448 ENDDO 314 449 ! 315 DO kk = 1, 5 450 !!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 451 DO kk = 1, 6 316 452 DO k = 1, kflev 317 453 DO i = 1, kdlon 318 PAER(i,k,kk) = 1.0E-15 454 PAER(i,k,kk) = 1.0E-15 !!!!! A REVOIR (MPL) 319 455 ENDDO 320 456 ENDDO … … 334 470 !===== iflag_rrtm ================================================ 335 471 ! 336 print*,'iflag_rrtm = ', iflag_rrtm 337 IF (iflag_rrtm == 0) THEN 472 IF (iflag_rrtm == 0) THEN !!!! remettre 0 juste pour tester l'ancien rayt via rrtm 473 !--- Mise a zero des tableaux output du rayonnement LW-AR4 ---------- 474 DO k = 1, kflev+1 475 DO i = 1, kdlon 476 ! print *,'RADLWSW: boucle mise a zero i k',i,k 477 ZFLUP(i,k)=0. 478 ZFLDN(i,k)=0. 479 ZFLUP0(i,k)=0. 480 ZFLDN0(i,k)=0. 481 ZLWFT0_i(i,k)=0. 482 ZFLUCUP_i(i,k)=0. 483 ZFLUCDWN_i(i,k)=0. 484 ENDDO 485 ENDDO 486 DO k = 1, kflev 487 DO i = 1, kdlon 488 zcool(i,k)=0. 489 zcool0(i,k)=0. 490 ENDDO 491 ENDDO 492 DO i = 1, kdlon 493 ztoplw(i)=0. 494 zsollw(i)=0. 495 ztoplw0(i)=0. 496 zsollw0(i)=0. 497 zsollwdown(i)=0. 498 ENDDO 338 499 ! Old radiation scheme, used for AR4 runs 339 500 ! average day-night ozone for longwave … … 348 509 zsollwdown,& 349 510 ZFLUP, ZFLDN, ZFLUP0,ZFLDN0) 350 511 !----- Mise a zero des tableaux output du rayonnement SW-AR4 512 DO k = 1, kflev+1 513 DO i = 1, kdlon 514 ZFSUP(i,k)=0. 515 ZFSDN(i,k)=0. 516 ZFSUP0(i,k)=0. 517 ZFSDN0(i,k)=0. 518 ZSWFT0_i(i,k)=0. 519 ZFCUP_i(i,k)=0. 520 ZFCDWN_i(i,k)=0. 521 ENDDO 522 ENDDO 523 DO k = 1, kflev 524 DO i = 1, kdlon 525 zheat(i,k)=0. 526 zheat0(i,k)=0. 527 ENDDO 528 ENDDO 529 DO i = 1, kdlon 530 zalbpla(i)=0. 531 ztopsw(i)=0. 532 zsolsw(i)=0. 533 ztopsw0(i)=0. 534 zsolsw0(i)=0. 535 ztopswadaero(i)=0. 536 zsolswadaero(i)=0. 537 ztopswaiaero(i)=0. 538 zsolswaiaero(i)=0. 539 ENDDO 540 ! print *,'Avant SW_LMDAR4: PSCT zrmu0 zfract',PSCT, zrmu0, zfract 351 541 ! daylight ozone, if we have it, for short wave 352 542 IF (.NOT. new_aod) THEN … … 386 576 ENDIF 387 577 578 579 DO i=1,kdlon 580 DO k=1,kflev+1 581 ZSWFT0_i(1:klon,k) = ZFSDN0(1:klon,k)-ZFSUP0(1:klon,k) 582 ZLWFT0_i(1:klon,k)=-ZFLDN0(1:klon,k)-ZFLUP0(1:klon,k) 583 ! print *,'iof i k klon klev=',iof,i,k,klon,klev 584 lwdn0 ( iof+i,k) = ZFLDN0 ( i,k) 585 lwdn ( iof+i,k) = ZFLDN ( i,k) 586 lwup0 ( iof+i,k) = ZFLUP0 ( i,k) 587 lwup ( iof+i,k) = ZFLUP ( i,k) 588 swdn0 ( iof+i,k) = ZFSDN0 ( i,k) 589 swdn ( iof+i,k) = ZFSDN ( i,k) 590 swup0 ( iof+i,k) = ZFSUP0 ( i,k) 591 swup ( iof+i,k) = ZFSUP ( i,k) 592 ENDDO 593 ENDDO 594 ! print*,'SW_AR4 ZFSDN0 1 , klev:',ZFSDN0(1:klon,1),ZFSDN0(1:klon,klev) 595 ! print*,'SW_AR4 swdn0 1 , klev:',swdn0(1:klon,1),swdn0(1:klon,klev) 596 ! print*,'SW_AR4 ZFSUP0 1 , klev:',ZFSUP0(1:klon,1),ZFSUP0(1:klon,klev) 597 ! print*,'SW_AR4 swup0 1 , klev:',swup0(1:klon,1),swup0(1:klon,klev) 598 ! print*,'SW_AR4 ZFSDN 1 , klev:',ZFSDN(1:klon,1) ,ZFSDN(1:klon,klev) 599 ! print*,'SW_AR4 ZFSUP 1 , klev:',ZFSUP(1:klon,1) ,ZFSUP(1:klon,klev) 388 600 ELSE 601 #ifdef CPP_RRTM 602 ! if (prt_level.gt.10)write(lunout,*)'CPP_RRTM=.T.' 389 603 !===== iflag_rrtm=1, on passe dans SW via RECMWFL =============== 390 WRITE(lunout,*) "Option iflag_rrtm=T ne fonctionne pas encore !!!" 391 CALL abort_gcm('radlwsw','iflag_rrtm=T not valid',1) 392 604 605 DO k = 1, kflev+1 606 DO i = 1, kdlon 607 ZEMTD_i(i,k)=0. 608 ZEMTU_i(i,k)=0. 609 ZTRSO_i(i,k)=0. 610 ZTH_i(i,k)=0. 611 ZLWFT_i(i,k)=0. 612 ZSWFT_i(i,k)=0. 613 ZFLUX_i(i,1,k)=0. 614 ZFLUX_i(i,2,k)=0. 615 ZFLUC_i(i,1,k)=0. 616 ZFLUC_i(i,2,k)=0. 617 ZFSDWN_i(i,k)=0. 618 ZFCDWN_i(i,k)=0. 619 ZFSUP_i(i,k)=0. 620 ZFCUP_i(i,k)=0. 621 ENDDO 622 ENDDO 623 ! 624 !--OB Valeurs de tau(NSW) calculees par O.Boucher (MPL 20130417) 625 !-- voir aod_2bands.F90, aod_4bands.F90, aod_6bands.F90 dans BENCH48x36x19 626 SELECT CASE (NSW) 627 CASE (2) 628 tau(1)=0.22017828 629 tau(2)=0.110565394 630 CASE (4) 631 tau(1)=0.22017743 632 tau(2)=0.12738435 633 tau(3)=0.07157799 634 tau(4)=0.03301198 635 CASE (6) 636 tau(1)=0.49999997 637 tau(2)=0.28593913 638 tau(3)=0.20057647 639 tau(4)=0.12738435 640 tau(5)=0.07157799 641 tau(6)=0.03301198 642 END SELECT 643 ! tau1=0.2099 ! anciennes valeurs de Nicolas Huneeus (20130326) 644 ! tau2=0.1022 645 ! tau(1)=1.0e-15 646 ! tau(2)=1.0e-15 647 ! tau(3)=1.0e-15 648 ! tau(4)=1.0e-15 649 ! tau(5)=1.0e-15 650 ! tau(6)=1.0e-15 651 print *,'Radlwsw: NSW tau= ',NSW,tau(:) 652 DO i = 1, kdlon 653 alt=0.0 654 DO k = 1, kflev 655 zrho=pplay(i,k)/t(i,k)/RD 656 zdz=(paprs(i,k)-paprs(i,k+1))/zrho/RG 657 DO kk=1, NSW 658 PTAUREL_DST(i,kflev+1-k,kk)=(tau(kk)/2000.0)*max(0.0,min(zdz,2000.0-alt)) 659 PTAUREL_DST(i,kflev+1-k,kk)=MAX(PTAUREL_DST(i,kflev+1-k,kk), 1e-15) 660 ENDDO 661 alt=alt+zdz 662 ENDDO 663 ENDDO 664 665 ! 666 DO k = 1, kflev 667 DO i = 1, kdlon 668 DO kk = 1, NSW 669 ! PPIZA_DST(i,k,kk)=1.0 670 PPIZA_DST(i,k,kk)=0.8 671 PCGA_DST(i,k,kk)=0.7 672 ENDDO 673 ENDDO 674 ENDDO 675 ! 676 DO i = 1, kdlon 677 ZCTRSO(i,1)=0. 678 ZCTRSO(i,2)=0. 679 ZCEMTR(i,1)=0. 680 ZCEMTR(i,2)=0. 681 ZTRSOD(i)=0. 682 ZLWFC(i,1)=0. 683 ZLWFC(i,2)=0. 684 ZSWFC(i,1)=0. 685 ZSWFC(i,2)=0. 686 PFSDNN(i)=0. 687 PFSDNV(i)=0. 688 DO kk = 1, NSW 689 PSFSWDIR(i,kk)=0. 690 PSFSWDIF(i,kk)=0. 691 ENDDO 692 ENDDO 693 !----- Fin des mises a zero des tableaux output de RECMWF ------------------- 694 ! GEMU(1:klon)=sin(rlatd(1:klon)) 695 ! On met les donnees dans l'ordre des niveaux arpege 696 paprs_i(:,1)=paprs(:,klev+1) 697 do k=1,klev 698 paprs_i(1:klon,k+1) =paprs(1:klon,klev+1-k) 699 pplay_i(1:klon,k) =pplay(1:klon,klev+1-k) 700 cldfra_i(1:klon,k) =cldfra(1:klon,klev+1-k) 701 PDP_i(1:klon,k) =PDP(1:klon,klev+1-k) 702 t_i(1:klon,k) =t(1:klon,klev+1-k) 703 q_i(1:klon,k) =q(1:klon,klev+1-k) 704 qsat_i(1:klon,k) =qsat(1:klon,klev+1-k) 705 flwc_i(1:klon,k) =flwc(1:klon,klev+1-k) 706 fiwc_i(1:klon,k) =fiwc(1:klon,klev+1-k) 707 ref_liq_i(1:klon,k) =ref_liq(1:klon,klev+1-k) 708 ref_ice_i(1:klon,k) =ref_ice(1:klon,klev+1-k) 709 enddo 710 do k=1,kflev 711 POZON_i(1:klon,k,:)=POZON(1:klon,kflev+1-k,:) 712 !!! POZON_i(1:klon,k)=POZON(1:klon,k) !!! on laisse 1=sol et klev=top 713 ! print *,'Juste avant RECMWFL: k tsol temp',k,tsol,t(1,k) 714 !!!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 715 do i=1,6 716 PAER_i(1:klon,k,i)=PAER(1:klon,kflev+1-k,i) 717 enddo 718 enddo 719 ! print *,'RADLWSW: avant RECMWFL, RI0,rmu0=',solaire,rmu0 720 721 ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 722 ! La version ARPEGE1D utilise differentes valeurs de la constante 723 ! solaire suivant le rayonnement utilise. 724 ! A controler ... 725 ! SOLAR FLUX AT THE TOP (/YOMPHY3/) 726 ! introduce season correction 727 !-------------------------------------- 728 ! RII0 = RIP0 729 ! IF(LRAYFM) 730 ! RII0 = RIP0M ! =rip0m if Morcrette non-each time step call. 731 ! IF(LRAYFM15) 732 ! RII0 = RIP0M15 ! =rip0m if Morcrette non-each time step call. 733 RII0=solaire/zdist/zdist 734 print*,'+++ radlwsw: solaire ,RII0',solaire,RII0 735 ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 736 ! Ancien appel a RECMWF (celui du cy25) 737 ! CALL RECMWF (ist , iend, klon , ktdia , klev , kmode , 738 ! s PALBD , PALBP , paprs_i , pplay_i , RCO2 , cldfra_i, 739 ! s POZON_i , PAER_i , PDP_i , PEMIS , GEMU , rmu0, 740 ! s q_i , qsat_i , fiwc_i , flwc_i , zmasq , t_i ,tsol, 741 ! s ZEMTD_i , ZEMTU_i , ZTRSO_i , 742 ! s ZTH_i , ZCTRSO , ZCEMTR , ZTRSOD , 743 ! s ZLWFC , ZLWFT_i , ZSWFC , ZSWFT_i , 744 ! s ZFLUX_i , ZFLUC_i , ZFSDWN_i, ZFSUP_i , ZFCDWN_i,ZFCUP_i) 745 ! s 'RECMWF ') 746 ! 747 if(lldebug) then 748 CALL writefield_phy('paprs_i',paprs_i,klev+1) 749 CALL writefield_phy('pplay_i',pplay_i,klev) 750 CALL writefield_phy('cldfra_i',cldfra_i,klev) 751 CALL writefield_phy('pozon_i',POZON_i,klev) 752 CALL writefield_phy('paer_i',PAER_i,klev) 753 CALL writefield_phy('pdp_i',PDP_i,klev) 754 CALL writefield_phy('q_i',q_i,klev) 755 CALL writefield_phy('qsat_i',qsat_i,klev) 756 CALL writefield_phy('fiwc_i',fiwc_i,klev) 757 CALL writefield_phy('flwc_i',flwc_i,klev) 758 CALL writefield_phy('t_i',t_i,klev) 759 CALL writefield_phy('palbd_new',PALBD_NEW,NSW) 760 CALL writefield_phy('palbp_new',PALBP_NEW,NSW) 761 endif 762 763 ! Nouvel appel a RECMWF (celui du cy32t0) 764 CALL RECMWF (ist , iend, klon , ktdia , klev , kmode ,& 765 PALBD_NEW,PALBP_NEW, paprs_i , pplay_i , RCO2 , cldfra_i,& 766 POZON_i , PAER_i , PDP_i , PEMIS , rmu0 ,& 767 q_i , qsat_i , fiwc_i , flwc_i , zmasq , t_i ,tsol,& 768 ref_liq_i, ref_ice_i, & 769 ZEMTD_i , ZEMTU_i , ZTRSO_i ,& 770 ZTH_i , ZCTRSO , ZCEMTR , ZTRSOD ,& 771 ZLWFC , ZLWFT_i , ZSWFC , ZSWFT_i ,& 772 PSFSWDIR , PSFSWDIF, PFSDNN , PFSDNV ,& 773 PPIZA_DST, PCGA_DST,PTAUREL_DST,ZFLUX_i , ZFLUC_i ,& 774 ZFSDWN_i , ZFSUP_i , ZFCDWN_i, ZFCUP_i) 775 776 print *,'RADLWSW: apres RECMWF' 777 if(lldebug) then 778 CALL writefield_phy('zemtd_i',ZEMTD_i,klev+1) 779 CALL writefield_phy('zemtu_i',ZEMTU_i,klev+1) 780 CALL writefield_phy('ztrso_i',ZTRSO_i,klev+1) 781 CALL writefield_phy('zth_i',ZTH_i,klev+1) 782 CALL writefield_phy('zctrso',ZCTRSO,2) 783 CALL writefield_phy('zcemtr',ZCEMTR,2) 784 CALL writefield_phy('ztrsod',ZTRSOD,1) 785 CALL writefield_phy('zlwfc',ZLWFC,2) 786 CALL writefield_phy('zlwft_i',ZLWFT_i,klev+1) 787 CALL writefield_phy('zswfc',ZSWFC,2) 788 CALL writefield_phy('zswft_i',ZSWFT_i,klev+1) 789 CALL writefield_phy('psfswdir',PSFSWDIR,6) 790 CALL writefield_phy('psfswdif',PSFSWDIF,6) 791 CALL writefield_phy('pfsdnn',PFSDNN,1) 792 CALL writefield_phy('pfsdnv',PFSDNV,1) 793 CALL writefield_phy('ppiza_dst',PPIZA_DST,klev) 794 CALL writefield_phy('pcga_dst',PCGA_DST,klev) 795 CALL writefield_phy('ptaurel_dst',PTAUREL_DST,klev) 796 CALL writefield_phy('zflux_i',ZFLUX_i,klev+1) 797 CALL writefield_phy('zfluc_i',ZFLUC_i,klev+1) 798 CALL writefield_phy('zfsdwn_i',ZFSDWN_i,klev+1) 799 CALL writefield_phy('zfsup_i',ZFSUP_i,klev+1) 800 CALL writefield_phy('zfcdwn_i',ZFCDWN_i,klev+1) 801 CALL writefield_phy('zfcup_i',ZFCUP_i,klev+1) 802 endif 803 ! --------- output RECMWFL 804 ! ZEMTD (KPROMA,KLEV+1) ; TOTAL DOWNWARD LONGWAVE EMISSIVITY 805 ! ZEMTU (KPROMA,KLEV+1) ; TOTAL UPWARD LONGWAVE EMISSIVITY 806 ! ZTRSO (KPROMA,KLEV+1) ; TOTAL SHORTWAVE TRANSMISSIVITY 807 ! ZTH (KPROMA,KLEV+1) ; HALF LEVEL TEMPERATURE 808 ! ZCTRSO (KPROMA,2) ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY 809 ! ZCEMTR (KPROMA,2) ; CLEAR-SKY NET LONGWAVE EMISSIVITY 810 ! ZTRSOD (KPROMA) ; TOTAL-SKY SURFACE SW TRANSMISSITY 811 ! ZLWFC (KPROMA,2) ; CLEAR-SKY LONGWAVE FLUXES 812 ! ZLWFT (KPROMA,KLEV+1) ; TOTAL-SKY LONGWAVE FLUXES 813 ! ZSWFC (KPROMA,2) ; CLEAR-SKY SHORTWAVE FLUXES 814 ! ZSWFT (KPROMA,KLEV+1) ; TOTAL-SKY SHORTWAVE FLUXES 815 ! PPIZA_DST (KPROMA,KLEV,NSW); Single scattering albedo of dust 816 ! PCGA_DST (KPROMA,KLEV,NSW); Assymetry factor for dust 817 ! PTAUREL_DST (KPROMA,KLEV,NSW); Optical depth of dust relative to at 550nm 818 ! PSFSWDIR (KPROMA,NSW) ; 819 ! PSFSWDIF (KPROMA,NSW) ; 820 ! PFSDNN (KPROMA) ; 821 ! PFSDNV (KPROMA) ; 822 ! --------- 823 ! --------- 824 ! On retablit l'ordre des niveaux lmd pour les tableaux de sortie 825 ! D autre part, on multiplie les resultats SW par fract pour etre coherent 826 ! avec l ancien rayonnement AR4. Si nuit, fract=0 donc pas de 827 ! rayonnement SW. (MPL 260609) 828 DO k=0,klev 829 DO i=1,klon 830 ZEMTD(i,k+1) = ZEMTD_i(i,k+1) 831 ZEMTU(i,k+1) = ZEMTU_i(i,k+1) 832 ZTRSO(i,k+1) = ZTRSO_i(i,k+1) 833 ZTH(i,k+1) = ZTH_i(i,k+1) 834 ! ZLWFT(i,k+1) = ZLWFT_i(i,klev+1-k) 835 ! ZSWFT(i,k+1) = ZSWFT_i(i,klev+1-k) 836 ZFLUP(i,k+1) = ZFLUX_i(i,1,k+1) 837 ZFLDN(i,k+1) = ZFLUX_i(i,2,k+1) 838 ZFLUP0(i,k+1) = ZFLUC_i(i,1,k+1) 839 ZFLDN0(i,k+1) = ZFLUC_i(i,2,k+1) 840 ZFSDN(i,k+1) = ZFSDWN_i(i,k+1)*fract(i) 841 ZFSDN0(i,k+1) = ZFCDWN_i(i,k+1)*fract(i) 842 ZFSUP (i,k+1) = ZFSUP_i(i,k+1)*fract(i) 843 ZFSUP0(i,k+1) = ZFCUP_i(i,k+1)*fract(i) 844 ! Nouveau calcul car visiblement ZSWFT et ZSWFC sont nuls dans RRTM cy32 845 ! en sortie de radlsw.F90 - MPL 7.01.09 846 ZSWFT(i,k+1) = (ZFSDWN_i(i,k+1)-ZFSUP_i(i,k+1))*fract(i) 847 ZSWFT0_i(i,k+1) = (ZFCDWN_i(i,k+1)-ZFCUP_i(i,k+1))*fract(i) 848 ! WRITE(*,'("FSDN FSUP FCDN FCUP: ",4E12.5)') ZFSDWN_i(i,k+1),& 849 ! ZFSUP_i(i,k+1),ZFCDWN_i(i,k+1),ZFCUP_i(i,k+1) 850 ZLWFT(i,k+1) =-ZFLUX_i(i,2,k+1)-ZFLUX_i(i,1,k+1) 851 ZLWFT0_i(i,k+1)=-ZFLUC_i(i,2,k+1)-ZFLUC_i(i,1,k+1) 852 ! print *,'FLUX2 FLUX1 FLUC2 FLUC1',ZFLUX_i(i,2,k+1),& 853 ! & ZFLUX_i(i,1,k+1),ZFLUC_i(i,2,k+1),ZFLUC_i(i,1,k+1) 854 ENDDO 855 ENDDO 856 857 ! print*,'SW_RRTM ZFSDN0 1 , klev:',ZFSDN0(1:klon,1),ZFSDN0(1:klon,klev) 858 ! print*,'SW_RRTM ZFSUP0 1 , klev:',ZFSUP0(1:klon,1),ZFSUP0(1:klon,klev) 859 ! print*,'SW_RRTM ZFSDN 1 , klev:',ZFSDN(1:klon,1),ZFSDN(1:klon,klev) 860 ! print*,'SW_RRTM ZFSUP 1 , klev:',ZFSUP(1:klon,1),ZFSUP(1:klon,klev) 861 ! print*,'OK1' 862 ! --------- 863 ! --------- 864 ! On renseigne les champs LMDz, pour avoir la meme chose qu'en sortie de 865 ! LW_LMDAR4 et SW_LMDAR4 866 DO i = 1, kdlon 867 zsolsw(i) = ZSWFT(i,1) 868 zsolsw0(i) = ZSWFT0_i(i,1) 869 ! zsolsw0(i) = ZFSDN0(i,1) -ZFSUP0(i,1) 870 ztopsw(i) = ZSWFT(i,klev+1) 871 ztopsw0(i) = ZSWFT0_i(i,klev+1) 872 ! ztopsw0(i) = ZFSDN0(i,klev+1)-ZFSUP0(i,klev+1) 873 ! 874 ! zsollw(i) = ZFLDN(i,1) -ZFLUP(i,1) 875 ! zsollw0(i) = ZFLDN0(i,1) -ZFLUP0(i,1) 876 ! ztoplw(i) = ZFLDN(i,klev+1) -ZFLUP(i,klev+1) 877 ! ztoplw0(i) = ZFLDN0(i,klev+1)-ZFLUP0(i,klev+1) 878 zsollw(i) = ZLWFT(i,1) 879 zsollw0(i) = ZLWFT0_i(i,1) 880 ztoplw(i) = ZLWFT(i,klev+1)*(-1) 881 ztoplw0(i) = ZLWFT0_i(i,klev+1)*(-1) 882 ! 883 IF (fract(i) == 0.) THEN 884 !!!!! A REVOIR MPL (20090630) ca n a pas de sens quand fract=0 885 ! pas plus que dans le sw_AR4 886 zalbpla(i) = 1.0e+39 887 ELSE 888 zalbpla(i) = ZFSUP(i,klev+1)/ZFSDN(i,klev+1) 889 ENDIF 890 zsollwdown(i)= ZFLDN(i,1) 891 ENDDO 892 print*,'OK2' 893 894 ! extrait de SW_AR4 895 ! DO k = 1, KFLEV 896 ! kpl1 = k+1 897 ! DO i = 1, KDLON 898 ! PHEAT(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k)) -(ZFSDN(i,k)-ZFSDN(i,kpl1)) 899 ! PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k) 900 ! ZLWFT(klon,k),ZSWFT 901 902 do k=1,kflev 903 do i=1,kdlon 904 zheat(i,k)=(ZSWFT(i,k+1)-ZSWFT(i,k))*RDAY*RG/RCPD/PDP(i,k) 905 zheat0(i,k)=(ZSWFT0_i(i,k+1)-ZSWFT0_i(i,k))*RDAY*RG/RCPD/PDP(i,k) 906 zcool(i,k)=(ZLWFT(i,k)-ZLWFT(i,k+1))*RDAY*RG/RCPD/PDP(i,k) 907 zcool0(i,k)=(ZLWFT0_i(i,k)-ZLWFT0_i(i,k+1))*RDAY*RG/RCPD/PDP(i,k) 908 ! print *,'heat cool heat0 cool0 ',zheat(i,k),zcool(i,k),zheat0(i,k),zcool0(i,k) 909 ! ZFLUCUP_i(i,k)=ZFLUC_i(i,1,k) 910 ! ZFLUCDWN_i(i,k)=ZFLUC_i(i,2,k) 911 enddo 912 enddo 913 #else 914 abort_message="You should compile with -rrtm if running with iflag_rrtm=1" 915 call abort_gcm(modname, abort_message, 1) 916 #endif 393 917 ENDIF ! iflag_rrtm 394 918 !======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
