! ! $Id: lwu.F90 5294 2024-10-29 18:35:00Z fairhead $ ! SUBROUTINE LWU & & ( KIDIA, KFDIA, KLON, KLEV,& & PAER , PCCO2, PDP , PPMB, PQOF , PTAVE, PVIEW, PWV,& & PABCU & & ) !**** *LWU* - LONGWAVE EFFECTIVE ABSORBER AMOUNTS ! PURPOSE. ! -------- ! COMPUTES ABSORBER AMOUNTS INCLUDING PRESSURE AND ! TEMPERATURE EFFECTS !** INTERFACE. ! ---------- ! EXPLICIT ARGUMENTS : ! -------------------- ! ==== INPUTS === ! PAER : (KLON,6,KLEV) ; OPTICAL THICKNESS OF THE AEROSOLS ! PCCO2 : ; CONCENTRATION IN CO2 (PA/PA) ! PDP : (KLON,KLEV) ; LAYER PRESSURE THICKNESS (PA) ! PPMB : (KLON,KLEV+1) ; HALF LEVEL PRESSURE ! PQOF : (KLON,KLEV) ; CONCENTRATION IN OZONE (PA/PA) ! PTAVE : (KLON,KLEV) ; TEMPERATURE ! PWV : (KLON,KLEV) ; SPECIFIC HUMIDITY PA/PA ! PVIEW : (KLON) ; COSECANT OF VIEWING ANGLE ! ==== OUTPUTS === ! PABCU :(KLON,NUA,3*KLEV+1); EFFECTIVE ABSORBER AMOUNTS ! IMPLICIT ARGUMENTS : NONE ! -------------------- ! METHOD. ! ------- ! 1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF ! ABSORBERS. ! EXTERNALS. ! ---------- ! NONE ! REFERENCE. ! ---------- ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS ! AUTHOR. ! ------- ! JEAN-JACQUES MORCRETTE *ECMWF* ! MODIFICATIONS. ! -------------- ! ORIGINAL : 89-07-14 ! JJ Morcrette 97-04-18 Revised Continuum + Clean-up ! M.Hamrud 01-Oct-2003 CY28 Cleaning !----------------------------------------------------------------------- USE PARKIND1 ,ONLY : JPIM ,JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK USE YOMCST , ONLY : RG USE YOESW , ONLY : RAER USE YOELW , ONLY : NSIL ,NUA ,NG1 ,NG1P1 ,& & ALWT ,BLWT ,RO3T ,RT1 ,TREF ,& & RVGCO2 ,RVGH2O ,RVGO3 !USE YOERDI , ONLY : RCH4 ,RN2O ,RCFC11 ,RCFC12 USE YOERDU , ONLY : R10E ,REPSCO ,REPSCQ USE lmdz_reprobus_wrappers, ONLY: rch42d, rn2o2d, rcfc112d, rcfc122d, ok_rtime2d USE infotrac_phy, ONLY : type_trac USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS ! Temporary fix waiting for cleaner interface (or not) USE clesphys_mod_h, ONLY: NSW, RCFC11, RCFC12, RCH4, RN2O IMPLICIT NONE INTEGER(KIND=JPIM),INTENT(IN) :: KLON INTEGER(KIND=JPIM),INTENT(IN) :: KLEV INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) REAL(KIND=JPRB) ,INTENT(IN) :: PCCO2 REAL(KIND=JPRB) ,INTENT(IN) :: PDP(KLON,KLEV) REAL(KIND=JPRB) ,INTENT(IN) :: PPMB(KLON,KLEV+1) REAL(KIND=JPRB) ,INTENT(IN) :: PQOF(KLON,KLEV) REAL(KIND=JPRB) ,INTENT(IN) :: PTAVE(KLON,KLEV) REAL(KIND=JPRB) ,INTENT(IN) :: PVIEW(KLON) REAL(KIND=JPRB) ,INTENT(IN) :: PWV(KLON,KLEV) REAL(KIND=JPRB) ,INTENT(OUT) :: PABCU(KLON,NUA,3*KLEV+1) !!include "clesphys.h" !----------------------------------------------------------------------- !* 0.1 ARGUMENTS ! --------- !----------------------------------------------------------------------- ! ------------ REAL(KIND=JPRB) :: ZABLY(KLON,7,3*KLEV+1) , ZDPM(KLON,3*KLEV)& & , ZDUC(KLON, 3*KLEV+1) , ZFACT(KLON)& & , ZUPM(KLON,3*KLEV) REAL(KIND=JPRB) :: ZPHIO(KLON),ZPSC2(KLON) , ZPSC3(KLON), ZPSH1(KLON)& & , ZPSH2(KLON),ZPSH3(KLON) , ZPSH4(KLON), ZPSH5(KLON)& & , ZPSH6(KLON),ZPSIO(KLON) , ZTCON(KLON)& & , ZPHM6(KLON),ZPSM6(KLON) , ZPHN6(KLON), ZPSN6(KLON) REAL(KIND=JPRB) :: ZSSIG(KLON,3*KLEV+1) , ZTAVI(KLON)& & , ZUAER(KLON,NSIL) , ZXOZ(KLON) , ZXWV(KLON) INTEGER(KIND=JPIM) :: IAE1, IAE2, IAE3, IC, ICP1, IG1, IJ, IJPN,& & IKIP1, IKJ, IKJP, IKJPN, IKJR, IKL, JA, JAE, & & JK, JKI, JKK, JL REAL(KIND=JPRB) :: ZALUP, ZCAC8, ZCAH1, ZCAH2, ZCAH3, ZCAH4,& & ZCAH5, ZCAH6, ZCBC8, ZCBH1, ZCBH2, ZCBH3, & & ZCBH4, ZCBH5, ZCBH6, ZDIFF, ZDPMG, ZDPMP0, & & ZFPPW, ZTX, ZTX2, ZU6, ZUP, ZUPMCO2, ZUPMG, & & ZUPMH2O, ZUPMO3, ZZABLY REAL(KIND=JPRB) :: ZHOOK_HANDLE !----------------------------------------------------------------------- !* 1. INITIALIZATION ! -------------- !----------------------------------------------------------------------- !* 2. PRESSURE OVER GAUSS SUB-LEVELS ! ------------------------------ IF (LHOOK) CALL DR_HOOK('LWU',0,ZHOOK_HANDLE) DO JL = KIDIA,KFDIA ZSSIG(JL, 1 ) = PPMB(JL,1) * 100._JPRB ENDDO DO JK = 1 , KLEV IKJ=(JK-1)*NG1P1+1 IKJR = IKJ IKJP = IKJ + NG1P1 DO JL = KIDIA,KFDIA ZSSIG(JL,IKJP)=PPMB(JL,JK+1)* 100._JPRB ENDDO DO IG1=1,NG1 IKJ=IKJ+1 DO JL = KIDIA,KFDIA ZSSIG(JL,IKJ)= (ZSSIG(JL,IKJR) + ZSSIG(JL,IKJP)) * 0.5_JPRB & & + RT1(IG1) * (ZSSIG(JL,IKJP) - ZSSIG(JL,IKJR)) * 0.5_JPRB ENDDO ENDDO ENDDO !----------------------------------------------------------------------- !* 4. PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS ! -------------------------------------------------- DO JKI=1,3*KLEV IKIP1=JKI+1 DO JL = KIDIA,KFDIA ZUPM(JL,JKI)=(ZSSIG(JL,JKI)+ZSSIG(JL,IKIP1))*0.5_JPRB ZDPM(JL,JKI)=(ZSSIG(JL,JKI)-ZSSIG(JL,IKIP1))/(10._JPRB*RG) ENDDO ENDDO DO JK = 1 , KLEV IKL = KLEV+1 - JK DO JL = KIDIA,KFDIA ZXWV(JL) = MAX (PWV(JL,IKL) , REPSCQ ) ZXOZ(JL) = MAX (PQOF(JL,IKL) / PDP(JL,IKL) , REPSCO ) ENDDO IKJ=(JK-1)*NG1P1+1 IKJPN=IKJ+NG1 DO JKK=IKJ,IKJPN DO JL = KIDIA,KFDIA ZDPMG = ZDPM(JL,JKK) ZDPMP0 = ZDPMG / 101325._JPRB ZUPMG = ZUPM(JL,JKK) * ZDPMP0 ZUPMCO2 = ( ZUPM(JL,JKK) + RVGCO2 ) * ZDPMP0 ZUPMH2O = ( ZUPM(JL,JKK) + RVGH2O ) * ZDPMP0 ZUPMO3 = ( ZUPM(JL,JKK) + RVGO3 ) * ZDPMP0 ZDUC(JL,JKK) = ZDPMG ZABLY(JL,6,JKK) = ZXOZ(JL) * ZDPMG ZABLY(JL,7,JKK) = ZXOZ(JL) * ZUPMO3 ZU6 = ZXWV(JL) * ZUPMG ZFPPW = 1.6078_JPRB * ZXWV(JL) / (1.0_JPRB+0.608_JPRB*ZXWV(JL)) ZABLY(JL,1,JKK) = ZXWV(JL) * ZUPMH2O ZABLY(JL,5,JKK) = ZU6 * ZFPPW ZABLY(JL,4,JKK) = ZU6 * (1.0_JPRB-ZFPPW) ZABLY(JL,3,JKK) = PCCO2 * ZUPMCO2 ZABLY(JL,2,JKK) = PCCO2 * ZDPMG ENDDO ENDDO ENDDO !----------------------------------------------------------------------- !* 5. CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE ! -------------------------------------------------- DO JA = 1, NUA DO JL = KIDIA,KFDIA PABCU(JL,JA,3*KLEV+1) = 0.0_JPRB ENDDO ENDDO DO JK = 1 , KLEV IJ=(JK-1)*NG1P1+1 IJPN=IJ+NG1 IKL=KLEV+1-JK !* 5.1 CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE ! -------------------------------------------------- ! -- NB: 'PAER' AEROSOLS ARE ENTERED FROM TOP TO BOTTOM IAE1=3*KLEV+1-IJ IAE2=3*KLEV+1-(IJ+1) IAE3=3*KLEV+1-IJPN ! print *,'IAE1= ',IAE1 ! print *,'IAE2= ',IAE2 ! print *,'IAE3= ',IAE3 ! print *,'KIDIA= ',KIDIA ! print *,'KFDIA= ',KFDIA ! print *,'KLEV= ',KLEV DO JAE=1,6 DO JL = KIDIA,KFDIA ! print *,'JL= ',JL,'-JAE= ',JAE,'-JK= ',JK,'-NSIL= ',NSIL ZUAER(JL,JAE) =& & (RAER(JAE,1)*PAER(JL,1,JK)+RAER(JAE,2)*PAER(JL,2,JK)& & +RAER(JAE,3)*PAER(JL,3,JK)+RAER(JAE,4)*PAER(JL,4,JK)& & +RAER(JAE,5)*PAER(JL,5,JK)+RAER(JAE,6)*PAER(JL,6,JK))& & /(ZDUC(JL,IAE1)+ZDUC(JL,IAE2)+ZDUC(JL,IAE3)) ENDDO ENDDO !* 5.2 INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS ! -------------------------------------------------- DO JL = KIDIA,KFDIA ZTAVI(JL)=PTAVE(JL,IKL) ZFACT(JL)=1.0_JPRB-ZTAVI(JL)/296._JPRB ZTCON(JL)=EXP(6.08_JPRB*(296._JPRB/ZTAVI(JL)-1.0_JPRB)) ! ZTCON(JL)=EXP(6.08*ZFACT(JL)) ZTX=ZTAVI(JL)-TREF ZTX2=ZTX*ZTX ZZABLY = ZABLY(JL,1,IAE1)+ZABLY(JL,1,IAE2)+ZABLY(JL,1,IAE3) ZUP=MIN( MAX( 0.5_JPRB*R10E*LOG( ZZABLY ) + 5._JPRB, 0.0_JPRB), 6.0_JPRB) ZCAH1=ALWT(1,1)+ZUP*(ALWT(1,2)+ZUP*(ALWT(1,3))) ZCBH1=BLWT(1,1)+ZUP*(BLWT(1,2)+ZUP*(BLWT(1,3))) ZPSH1(JL)=EXP( ZCAH1 * ZTX + ZCBH1 * ZTX2 ) ZCAH2=ALWT(2,1)+ZUP*(ALWT(2,2)+ZUP*(ALWT(2,3))) ZCBH2=BLWT(2,1)+ZUP*(BLWT(2,2)+ZUP*(BLWT(2,3))) ZPSH2(JL)=EXP( ZCAH2 * ZTX + ZCBH2 * ZTX2 ) ZCAH3=ALWT(3,1)+ZUP*(ALWT(3,2)+ZUP*(ALWT(3,3))) ZCBH3=BLWT(3,1)+ZUP*(BLWT(3,2)+ZUP*(BLWT(3,3))) ZPSH3(JL)=EXP( ZCAH3 * ZTX + ZCBH3 * ZTX2 ) ZCAH4=ALWT(4,1)+ZUP*(ALWT(4,2)+ZUP*(ALWT(4,3))) ZCBH4=BLWT(4,1)+ZUP*(BLWT(4,2)+ZUP*(BLWT(4,3))) ZPSH4(JL)=EXP( ZCAH4 * ZTX + ZCBH4 * ZTX2 ) ZCAH5=ALWT(5,1)+ZUP*(ALWT(5,2)+ZUP*(ALWT(5,3))) ZCBH5=BLWT(5,1)+ZUP*(BLWT(5,2)+ZUP*(BLWT(5,3))) ZPSH5(JL)=EXP( ZCAH5 * ZTX + ZCBH5 * ZTX2 ) ZCAH6=ALWT(6,1)+ZUP*(ALWT(6,2)+ZUP*(ALWT(6,3))) ZCBH6=BLWT(6,1)+ZUP*(BLWT(6,2)+ZUP*(BLWT(6,3))) ZPSH6(JL)=EXP( ZCAH6 * ZTX + ZCBH6 * ZTX2 ) ZPHM6(JL)=EXP(-5.81E-4_JPRB * ZTX - 1.13E-6_JPRB * ZTX2 ) ZPSM6(JL)=EXP(-5.57E-4_JPRB * ZTX - 3.30E-6_JPRB * ZTX2 ) ZPHN6(JL)=EXP(-3.46E-5_JPRB * ZTX + 2.05E-7_JPRB * ZTX2 ) ZPSN6(JL)=EXP( 3.70E-3_JPRB * ZTX - 2.30E-6_JPRB * ZTX2 ) ENDDO DO JL = KIDIA,KFDIA ZTAVI(JL)=PTAVE(JL,IKL) ZTX=ZTAVI(JL)-TREF ZTX2=ZTX*ZTX ZZABLY = ZABLY(JL,3,IAE1)+ZABLY(JL,3,IAE2)+ZABLY(JL,3,IAE3) ZALUP = R10E * LOG ( ZZABLY ) ZUP = MAX( 0.0_JPRB , 5.0_JPRB + 0.5_JPRB * ZALUP ) ZPSC2(JL) = (ZTAVI(JL)/TREF) ** ZUP ZCAC8=ALWT(8,1)+ZUP*(ALWT(8,2)+ZUP*(ALWT(8,3))) ZCBC8=BLWT(8,1)+ZUP*(BLWT(8,2)+ZUP*(BLWT(8,3))) ZPSC3(JL)=EXP( ZCAC8 * ZTX + ZCBC8 * ZTX2 ) ZPHIO(JL) = EXP( RO3T(1) * ZTX + RO3T(2) * ZTX2) ZPSIO(JL) = EXP( 2.0_JPRB* (RO3T(3)*ZTX+RO3T(4)*ZTX2)) ENDDO DO JKK=IJ,IJPN IC=3*KLEV+1-JKK ICP1=IC+1 DO JL = KIDIA,KFDIA ZDIFF = PVIEW(JL) !- H2O continuum PABCU(JL,10,IC)=PABCU(JL,10,ICP1)+ ZABLY(JL,4,IC) *ZDIFF PABCU(JL,11,IC)=PABCU(JL,11,ICP1)+ ZABLY(JL,5,IC)*ZTCON(JL)*ZDIFF !- O3 PABCU(JL,12,IC)=PABCU(JL,12,ICP1)+ ZABLY(JL,6,IC)*ZPHIO(JL)*ZDIFF PABCU(JL,13,IC)=PABCU(JL,13,ICP1)+ ZABLY(JL,7,IC)*ZPSIO(JL)*ZDIFF !- CO2 PABCU(JL,7,IC)=PABCU(JL,7,ICP1)+ ZABLY(JL,3,IC)*ZPSC2(JL)*ZDIFF PABCU(JL,8,IC)=PABCU(JL,8,ICP1)+ ZABLY(JL,3,IC)*ZPSC3(JL)*ZDIFF PABCU(JL,9,IC)=PABCU(JL,9,ICP1)+ ZABLY(JL,3,IC)*ZPSC3(JL)*ZDIFF !- H2O PABCU(JL,1,IC)=PABCU(JL,1,ICP1)+ ZABLY(JL,1,IC)*ZPSH1(JL) PABCU(JL,2,IC)=PABCU(JL,2,ICP1)+ ZABLY(JL,1,IC)*ZPSH2(JL) PABCU(JL,3,IC)=PABCU(JL,3,ICP1)+ ZABLY(JL,1,IC)*ZPSH5(JL)*ZDIFF PABCU(JL,4,IC)=PABCU(JL,4,ICP1)+ ZABLY(JL,1,IC)*ZPSH3(JL) PABCU(JL,5,IC)=PABCU(JL,5,ICP1)+ ZABLY(JL,1,IC)*ZPSH4(JL) PABCU(JL,6,IC)=PABCU(JL,6,ICP1)+ ZABLY(JL,1,IC)*ZPSH6(JL)*ZDIFF !- aerosols PABCU(JL,14,IC)=PABCU(JL,14,ICP1)+ ZUAER(JL,1) *ZDUC(JL,IC)*ZDIFF PABCU(JL,15,IC)=PABCU(JL,15,ICP1)+ ZUAER(JL,2) *ZDUC(JL,IC)*ZDIFF PABCU(JL,16,IC)=PABCU(JL,16,ICP1)+ ZUAER(JL,3) *ZDUC(JL,IC)*ZDIFF PABCU(JL,17,IC)=PABCU(JL,17,ICP1)+ ZUAER(JL,4) *ZDUC(JL,IC)*ZDIFF PABCU(JL,18,IC)=PABCU(JL,18,ICP1)+ ZUAER(JL,5) *ZDUC(JL,IC)*ZDIFF IF (CPPKEY_REPROBUS .AND. type_trac=='repr'.AND. ok_rtime2d) THEN !- CH4 PABCU(JL,19,IC)=PABCU(JL,19,ICP1)& & + ZABLY(JL,2,IC)*RCH42D(JL, IC)/PCCO2*ZPHM6(JL)*ZDIFF PABCU(JL,20,IC)=PABCU(JL,20,ICP1)& & + ZABLY(JL,3,IC)*RCH42D(JL, IC)/PCCO2*ZPSM6(JL)*ZDIFF !- N2O PABCU(JL,21,IC)=PABCU(JL,21,ICP1)& & + ZABLY(JL,2,IC)*RN2O2D(JL, IC)/PCCO2*ZPHN6(JL)*ZDIFF PABCU(JL,22,IC)=PABCU(JL,22,ICP1)& & + ZABLY(JL,3,IC)*RN2O2D(JL, IC)/PCCO2*ZPSN6(JL)*ZDIFF !- CFC11 PABCU(JL,23,IC)=PABCU(JL,23,ICP1)& & + ZABLY(JL,2,IC)*RCFC112D(JL, IC)/PCCO2 *ZDIFF !- CFC12 PABCU(JL,24,IC)=PABCU(JL,24,ICP1)& & + ZABLY(JL,2,IC)*RCFC122D(JL, IC)/PCCO2 *ZDIFF ELSE !- CH4 PABCU(JL,19,IC)=PABCU(JL,19,ICP1)& & + ZABLY(JL,2,IC)*RCH4/PCCO2*ZPHM6(JL)*ZDIFF PABCU(JL,20,IC)=PABCU(JL,20,ICP1)& & + ZABLY(JL,3,IC)*RCH4/PCCO2*ZPSM6(JL)*ZDIFF !- N2O PABCU(JL,21,IC)=PABCU(JL,21,ICP1)& & + ZABLY(JL,2,IC)*RN2O/PCCO2*ZPHN6(JL)*ZDIFF PABCU(JL,22,IC)=PABCU(JL,22,ICP1)& & + ZABLY(JL,3,IC)*RN2O/PCCO2*ZPSN6(JL)*ZDIFF !- CFC11 PABCU(JL,23,IC)=PABCU(JL,23,ICP1)& & + ZABLY(JL,2,IC)*RCFC11/PCCO2 *ZDIFF !- CFC12 PABCU(JL,24,IC)=PABCU(JL,24,ICP1)& & + ZABLY(JL,2,IC)*RCFC12/PCCO2 *ZDIFF END IF ENDDO ENDDO ENDDO ! print *,'END OF LWU' !----------------------------------------------------------------------- IF (LHOOK) CALL DR_HOOK('LWU',1,ZHOOK_HANDLE) END SUBROUTINE LWU