- Timestamp:
- Aug 4, 2025, 3:03:07 PM (12 days ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/contrails/libf/phylmd/rrtm/recmwf_aero.F90
r5791 r5796 43 43 & flag_aer_feedback, & 44 44 !--AB contrails radiative effect 45 & ok_rad_contrail, PCLFR_ NOCONT, PQIWP_NOCONT, PREF_ICE_NOCONT, &45 & ok_rad_contrail, PCLFR_CONT, PQIWP_CONT, PREF_ICE_CONT, & 46 46 & PTOPSWNOCONT, PSOLSWNOCONT, PTOPLWNOCONT, PSOLLWNOCONT) 47 47 !--fin … … 274 274 !--AB contrails radiative effect 275 275 LOGICAL ,INTENT(IN) :: ok_rad_contrail 276 REAL(KIND=JPRB) ,INTENT(IN) :: PCLFR_ NOCONT(KPROMA,KLEV)277 REAL(KIND=JPRB) ,INTENT(IN) :: PQIWP_ NOCONT(KPROMA,KLEV)278 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE_ NOCONT(KPROMA,KLEV)276 REAL(KIND=JPRB) ,INTENT(IN) :: PCLFR_CONT(KPROMA,KLEV) 277 REAL(KIND=JPRB) ,INTENT(IN) :: PQIWP_CONT(KPROMA,KLEV) 278 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE_CONT(KPROMA,KLEV) 279 279 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPSWNOCONT(KPROMA), PSOLSWNOCONT(KPROMA) ! No contrails experiment forcing at TOA and surface (SW) 280 280 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPLWNOCONT(KPROMA), PSOLLWNOCONT(KPROMA) ! No contrails experiment forcing at TOA and surface (LW) … … 360 360 REAL(KIND=JPRB) :: LWDN0_AERO(KPROMA,KLEV+1,5) 361 361 !--AB contrails radiative effect 362 REAL(KIND=JPRB) :: ZRCLC_NOCONT(KPROMA,KLEV), ZQIWP_NOCONT(KPROMA,KLEV) 362 REAL(KIND=JPRB) :: ZRCLC_CONT(KPROMA,KLEV), ZQIWP_CONT(KPROMA,KLEV) 363 REAL(KIND=JPRB) :: ZRCLC_ZERO(KPROMA,KLEV), ZQIWP_ZERO(KPROMA,KLEV) 364 REAL(KIND=JPRB) :: PREF_ICE_ZERO(KPROMA,KLEV) 363 365 REAL(KIND=JPRB) :: PREF_LIQ_NOCONT(KPROMA,KLEV) 366 REAL(KIND=JPRB) :: PREF_ICE_NOCONT(KPROMA,KLEV) 364 367 REAL(KIND=JPRB) :: PPIZA_NOCONT(KPROMA,KLEV,NSW) 365 368 REAL(KIND=JPRB) :: PCGA_NOCONT(KPROMA,KLEV,NSW) … … 413 416 ! ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK)*RMD/RMO3 414 417 ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK) 415 ZRCLC(JL,JK)=MAX( 0.0_JPRB ,MIN( 1.0_JPRB ,PCLFR(JL,JK)))416 IF (ZRCLC(JL,JK) > REPCLC) THEN417 ZQLWP(JL,JK)=PQLWP(JL,JK)418 ZQIWP(JL,JK)=PQIWP(JL,JK)419 ELSE420 ZQLWP(JL,JK)=REPH2O*ZRCLC(JL,JK)421 ZQIWP(JL,JK)=REPH2O*ZRCLC(JL,JK)422 ENDIF423 418 ZQRAIN(JL,JK)=0. 424 419 ZQRAINT(JL,JK)=0. … … 429 424 ENDDO 430 425 ENDDO 426 427 IF ( ok_rad_contrail ) THEN 428 DO JK=1,KLEV 429 DO JL=IBEG,IEND 430 ZRCLC(JL,JK)=MAX( 0.0_JPRB ,MIN( 1.0_JPRB ,PCLFR(JL,JK)-PCLFR_CONT(JL,JK))) 431 IF (ZRCLC(JL,JK) > REPCLC) THEN 432 ZQLWP(JL,JK)=PQLWP(JL,JK) 433 ZQIWP(JL,JK)=PQIWP(JL,JK)-PQIWP_CONT(JL,JK) 434 ELSE 435 ZQLWP(JL,JK)=REPH2O*ZRCLC(JL,JK) 436 ZQIWP(JL,JK)=REPH2O*ZRCLC(JL,JK) 437 ENDIF 438 ZRCLC_CONT(JL,JK)=MAX( 0.0_JPRB ,MIN( 1.0_JPRB ,PCLFR_CONT(JL,JK))) 439 IF (ZRCLC_CONT(JL,JK) > REPCLC) THEN 440 ZQIWP_CONT(JL,JK)=PQIWP_CONT(JL,JK) 441 ELSE 442 ZQIWP_CONT(JL,JK)=REPH2O*ZRCLC_CONT(JL,JK) 443 ENDIF 444 ENDDO 445 ENDDO 446 ELSE 447 DO JK=1,KLEV 448 DO JL=IBEG,IEND 449 ZRCLC(JL,JK)=MAX( 0.0_JPRB ,MIN( 1.0_JPRB ,PCLFR(JL,JK))) 450 IF (ZRCLC(JL,JK) > REPCLC) THEN 451 ZQLWP(JL,JK)=PQLWP(JL,JK) 452 ZQIWP(JL,JK)=PQIWP(JL,JK) 453 ELSE 454 ZQLWP(JL,JK)=REPH2O*ZRCLC(JL,JK) 455 ZQIWP(JL,JK)=REPH2O*ZRCLC(JL,JK) 456 ENDIF 457 ZRCLC_CONT(JL,JK)=0.0_JPRB 458 ZQIWP_CONT(JL,JK)=0.0_JPRB 459 ENDDO 460 ENDDO 461 ENDIF 431 462 432 463 IF (NAER == 0) THEN … … 512 543 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 513 544 & PREF_LIQ_PI, PREF_ICE_PI,& 545 & ZRCLC_CONT, ZQIWP_CONT, PREF_ICE_CONT,& ! AB FOR CONTRAILS 514 546 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 515 547 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& … … 553 585 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 554 586 & PREF_LIQ, PREF_ICE,& 587 & ZRCLC_CONT, ZQIWP_CONT, PREF_ICE_CONT,& ! AB FOR CONTRAILS 555 588 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 556 589 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& … … 594 627 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 595 628 & PREF_LIQ_PI, PREF_ICE_PI,& 629 & ZRCLC_CONT, ZQIWP_CONT, PREF_ICE_CONT,& ! AB FOR CONTRAILS 596 630 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 597 631 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& … … 634 668 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 635 669 & PREF_LIQ, PREF_ICE,& 670 & ZRCLC_CONT, ZQIWP_CONT, PREF_ICE_CONT,& ! AB FOR CONTRAILS 636 671 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 637 672 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& … … 676 711 !--this needs to be changed to fixed cloud optical properties 677 712 & PREF_LIQ_PI, PREF_ICE_PI,& 713 & ZRCLC_CONT, ZQIWP_CONT, PREF_ICE_CONT,& ! AB FOR CONTRAILS 678 714 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 679 715 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& … … 701 737 !--Double call to radiative routine for contrails 702 738 !--The calculation are done again WITHOUT contrails 703 IF ( ok_rad_contrail) THEN739 IF ( ok_rad_contrail ) THEN 704 740 705 741 !--The same base case is used … … 707 743 IF ( flag_aerosol .EQ. 0 ) THEN 708 744 PREF_LIQ_NOCONT(:,:) = PREF_LIQ_PI(:,:) 745 PREF_ICE_NOCONT(:,:) = PREF_ICE_PI(:,:) 709 746 PPIZA_NOCONT(:,:,:) = PPIZA_ZERO(:,:,:) 710 747 PCGA_NOCONT(:,:,:) = PCGA_ZERO(:,:,:) … … 713 750 ELSEIF ( .not. ok_ade .AND. .not. ok_aie ) THEN 714 751 PREF_LIQ_NOCONT(:,:) = PREF_LIQ_PI(:,:) 752 PREF_ICE_NOCONT(:,:) = PREF_ICE_PI(:,:) 715 753 PPIZA_NOCONT(:,:,:) = PPIZA_NAT(:,:,:) 716 754 PCGA_NOCONT(:,:,:) = PCGA_NAT(:,:,:) … … 719 757 ELSEIF ( .not. ok_ade .AND. ok_aie ) THEN 720 758 PREF_LIQ_NOCONT(:,:) = PREF_LIQ(:,:) 759 PREF_ICE_NOCONT(:,:) = PREF_ICE(:,:) 721 760 PPIZA_NOCONT(:,:,:) = PPIZA_NAT(:,:,:) 722 761 PCGA_NOCONT(:,:,:) = PCGA_NAT(:,:,:) … … 725 764 ELSEIF ( ok_ade .AND. .not. ok_aie ) THEN 726 765 PREF_LIQ_NOCONT(:,:) = PREF_LIQ_PI(:,:) 766 PREF_ICE_NOCONT(:,:) = PREF_ICE_PI(:,:) 727 767 PPIZA_NOCONT(:,:,:) = PPIZA_TOT(:,:,:) 728 768 PCGA_NOCONT(:,:,:) = PCGA_TOT(:,:,:) … … 731 771 ELSEIF ( ok_ade .AND. ok_aie ) THEN 732 772 PREF_LIQ_NOCONT(:,:) = PREF_LIQ(:,:) 773 PREF_ICE_NOCONT(:,:) = PREF_ICE(:,:) 733 774 PPIZA_NOCONT(:,:,:) = PPIZA_TOT(:,:,:) 734 775 PCGA_NOCONT(:,:,:) = PCGA_TOT(:,:,:) … … 739 780 DO JK=1,KLEV 740 781 DO JL=IBEG,IEND 741 ZRCLC_NOCONT(JL,JK)=MAX( 0.0_JPRB ,MIN( 1.0_JPRB ,PCLFR_NOCONT(JL,JK))) 742 IF (ZRCLC_NOCONT(JL,JK) > REPCLC) THEN 743 ZQIWP_NOCONT(JL,JK)=PQIWP_NOCONT(JL,JK) 744 ELSE 745 ZQIWP_NOCONT(JL,JK)=REPH2O*ZRCLC_NOCONT(JL,JK) 746 ENDIF 782 ZRCLC_ZERO(JL,JK)=0.0_JPRB 783 ZQIWP_ZERO(JL,JK)=0.0_JPRB 784 PREF_ICE_ZERO(JL,JK)=1.0_JPRB 747 785 ENDDO 748 786 ENDDO … … 753 791 & ZRAER , PALBD , PALBP , PAPRS , ZRPR ,& 754 792 & ZCCNL , ZCCNO ,& 755 & PCCO2 , ZRCLC _NOCONT, PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,&756 & ZQ , ZQIWP _NOCONT, ZQLWP , ZQS , ZQRAIN,ZQRAINT ,&793 & PCCO2 , ZRCLC , PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,& 794 & ZQ , ZQIWP , ZQLWP , ZQS , ZQRAIN,ZQRAINT ,& 757 795 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 758 796 & PREF_LIQ_NOCONT, PREF_ICE_NOCONT,& 797 & ZRCLC_ZERO, ZQIWP_ZERO, PREF_ICE_ZERO,& ! AB FOR CONTRAILS 759 798 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 760 799 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,&
Note: See TracChangeset
for help on using the changeset viewer.
