!OPTIONS XOPT(HSFUN) SUBROUTINE SWU & & ( KIDIA, KFDIA , KLON , KLEV,& & PSCT , PCARDI, PCLDSW, PPMB , PPSOL, PRMU0, PTAVE, PWV,& & PAKI , PCLD , PCLEAR, PDSIG, PFACT, PRMU , PSEC , PUD & & ) !**** *SWU* - SHORTWAVE RADIATION, ABSORBER AMOUNTS ! PURPOSE. ! -------- ! COMPUTES THE ABSORBER AMOUNTS USED IN SHORTWAVE RADIATION ! CALCULATIONS !** INTERFACE. ! ---------- ! *SWU* IS CALLED BY *SW* ! IMPLICIT ARGUMENTS : ! -------------------- ! ==== INPUTS === ! ==== OUTPUTS === ! METHOD. ! ------- ! 1. COMPUTES ABSORBER AMOUNTS WITH TEMPERATURE AND PRESSURE ! SCALING. ! EXTERNALS. ! ---------- ! *SWTT* ! REFERENCE. ! ---------- ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980) ! AUTHOR. ! ------- ! JEAN-JACQUES MORCRETTE *ECMWF* ! MODIFICATIONS. ! -------------- ! ORIGINAL : 89-07-14 ! 03-03-18 JJMorcrette security on normalized cloud cover ! M.Hamrud 01-Oct-2003 CY28 Cleaning ! Y.Seity 06-09-09 : add modset from O.Thouron (MesoNH) under NOVLP tests ! ------------------------------------------------------------------ USE PARKIND1 ,ONLY : JPIM ,JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK USE YOECLD , ONLY : REPSEC !USE YOERAD , ONLY : NOVLP ,NSW ! NSW mis dans .def MPL 20140211 USE YOERAD , ONLY : NOVLP USE YOERDU , ONLY : REPSCQ USE YOESW , ONLY : RPDH1 ,RPDU1 ,RPNH ,RPNU ,& & RTDH2O ,RTDUMG ,RTH2O ,RTUMG USE YOEOVLP , ONLY : RA1OVLP ! Temporary fix waiting for cleaner interface (or not) USE clesphys_mod_h, ONLY: NSW IMPLICIT NONE !!include "clesphys.h" 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) :: PSCT REAL(KIND=JPRB) ,INTENT(IN) :: PCARDI REAL(KIND=JPRB) ,INTENT(IN) :: PCLDSW(KLON,KLEV) REAL(KIND=JPRB) ,INTENT(IN) :: PPMB(KLON,KLEV+1) REAL(KIND=JPRB) ,INTENT(IN) :: PPSOL(KLON) REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KLON) REAL(KIND=JPRB) ,INTENT(IN) :: PTAVE(KLON,KLEV) REAL(KIND=JPRB) ,INTENT(IN) :: PWV(KLON,KLEV) REAL(KIND=JPRB) ,INTENT(OUT) :: PAKI(KLON,2,NSW) REAL(KIND=JPRB) ,INTENT(INOUT) :: PCLD(KLON,KLEV) REAL(KIND=JPRB) ,INTENT(OUT) :: PCLEAR(KLON) REAL(KIND=JPRB) ,INTENT(OUT) :: PDSIG(KLON,KLEV) REAL(KIND=JPRB) ,INTENT(OUT) :: PFACT(KLON) REAL(KIND=JPRB) ,INTENT(OUT) :: PRMU(KLON) REAL(KIND=JPRB) ,INTENT(OUT) :: PSEC(KLON) REAL(KIND=JPRB) ,INTENT(OUT) :: PUD(KLON,5,KLEV+1) ! ------------------------------------------------------------------ !* 0.1 ARGUMENTS ! --------- INTEGER(KIND=JPIM) :: INUIR ! ------------------------------------------------------------------ ! ------------ INTEGER(KIND=JPIM) :: IIND(2) REAL(KIND=JPRB) :: ZC1J(KLON,KLEV+1),ZCLEAR(KLON),ZCLOUD(KLON)& & , ZN175(KLON), ZN190(KLON), ZO175(KLON)& & , ZO190(KLON), ZSIGN(KLON)& & , ZR(KLON,2) , ZSIGO(KLON), ZUD(KLON,2) INTEGER(KIND=JPIM) :: JA, JK, JKL, JKLP1, JKP1, JL, JNU REAL(KIND=JPRB) :: ZDSCO2, ZDSH2O, ZFPPW, ZRTH, ZRTU, ZWH2O, ZALPHA1 REAL(KIND=JPRB) :: ZHOOK_HANDLE #include "swtt1.intfb.h" ! ------------------------------------------------------------------ !* 1. COMPUTES AMOUNTS OF ABSORBERS ! ----------------------------- REPSEC=1.E-12_JPRB !!!!! A REVOIR (MPL) IF (LHOOK) CALL DR_HOOK('SWU',0,ZHOOK_HANDLE) IIND(1)=1 IIND(2)=2 !* 1.1 INITIALIZES QUANTITIES ! ---------------------- DO JL = KIDIA,KFDIA PUD(JL,1,KLEV+1)=0.0_JPRB PUD(JL,2,KLEV+1)=0.0_JPRB PUD(JL,3,KLEV+1)=0.0_JPRB PUD(JL,4,KLEV+1)=0.0_JPRB PUD(JL,5,KLEV+1)=0.0_JPRB PFACT(JL)= PRMU0(JL) * PSCT !- already accounted for in RADINT ! PRMU(JL)=SQRT(1224.* PRMU0(JL) * PRMU0(JL) + 1.) / 35. PRMU(JL)=PRMU0(JL) PSEC(JL)=1.0_JPRB/PRMU(JL) ZC1J(JL,KLEV+1)=0.0_JPRB ENDDO !* 1.3 AMOUNTS OF ABSORBERS ! -------------------- DO JL= KIDIA,KFDIA ZUD(JL,1) = 0.0_JPRB ZUD(JL,2) = 0.0_JPRB ZO175(JL) = PPSOL(JL)** RPDU1 ZO190(JL) = PPSOL(JL)** RPDH1 ZSIGO(JL) = PPSOL(JL) ZCLEAR(JL)=1.0_JPRB ZCLOUD(JL)=0.0_JPRB ENDDO DO JK = 1 , KLEV JKP1 = JK + 1 JKL = KLEV+1 - JK JKLP1 = JKL+1 ZALPHA1=RA1OVLP(KLEV+1-JK) DO JL = KIDIA,KFDIA ZRTH=(RTH2O/PTAVE(JL,JK))**RTDH2O ZRTU=(RTUMG/PTAVE(JL,JK))**RTDUMG ZWH2O = MAX (PWV(JL,JKL) , REPSCQ ) ZSIGN(JL) = 100._JPRB * PPMB(JL,JKP1) PDSIG(JL,JK) = (ZSIGO(JL) - ZSIGN(JL))/PPSOL(JL) ZN175(JL) = ZSIGN(JL) ** RPDU1 ZN190(JL) = ZSIGN(JL) ** RPDH1 ZDSCO2 = ZO175(JL) - ZN175(JL) ZDSH2O = ZO190(JL) - ZN190(JL) PUD(JL,1,JK) = RPNH * ZDSH2O * ZWH2O * ZRTH PUD(JL,2,JK) = RPNU * ZDSCO2 * PCARDI * ZRTU ZFPPW=1.6078_JPRB*ZWH2O/(1.0_JPRB+0.608_JPRB*ZWH2O) PUD(JL,4,JK)=PUD(JL,1,JK)*ZFPPW PUD(JL,5,JK)=PUD(JL,1,JK)*(1.0_JPRB-ZFPPW) ZUD(JL,1) = ZUD(JL,1) + PUD(JL,1,JK) ZUD(JL,2) = ZUD(JL,2) + PUD(JL,2,JK) ZSIGO(JL) = ZSIGN(JL) ZO175(JL) = ZN175(JL) ZO190(JL) = ZN190(JL) !print *,'SWU: RTH2O RTDH2O RTUMG RTDUMG',RTH2O,RTDH2O,RTUMG,RTDUMG !print *,'SWU: RPNH ZDSH2O ZWH2O ZRTH',RPNH,ZDSH2O,ZWH2O,ZRTH !print *,'SWU: RPNU ZDSCO2 PCARDI ZRTU',RPNU,ZDSCO2,PCARDI,ZRTU !++MODIFCODE IF ((NOVLP == 1).OR.(NOVLP==6).OR.(NOVLP==8)) THEN ZCLEAR(JL)=ZCLEAR(JL)& & *(1.0_JPRB-MAX(PCLDSW(JL,JKL),ZCLOUD(JL)))& & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) ZC1J(JL,JKL)= 1.0_JPRB - ZCLEAR(JL) ZCLOUD(JL) = PCLDSW(JL,JKL) ELSEIF ((NOVLP == 2).OR.(NOVLP==7)) THEN ZCLOUD(JL) = MAX(PCLDSW(JL,JKL),ZCLOUD(JL)) ZC1J(JL,JKL) = ZCLOUD(JL) ELSEIF ((NOVLP == 3).OR.(NOVLP==5)) THEN ZCLEAR(JL) = ZCLEAR(JL)*(1.0_JPRB-PCLDSW(JL,JKL)) ZCLOUD(JL) = 1.0_JPRB - ZCLEAR(JL) ZC1J(JL,JKL) = ZCLOUD(JL) ELSEIF (NOVLP == 4) THEN !** Hogan & Illingworth (2001) ZCLEAR(JL)=ZCLEAR(JL)*( & & ZALPHA1*(1.0_JPRB-MAX(PCLDSW(JL,JKL),ZCLOUD(JL))) & & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) & & +(1.0_JPRB-ZALPHA1)*(1.0_JPRB-PCLDSW(JL,JKL)) ) ZC1J(JL,JKL) = 1.0_JPRB - ZCLEAR(JL) ZCLOUD(JL) = PCLDSW(JL,JKL) ENDIF !--MODIFCODE ENDDO ENDDO DO JL=KIDIA,KFDIA PCLEAR(JL)=1.0_JPRB-ZC1J(JL,1) ENDDO DO JK=1,KLEV DO JL=KIDIA,KFDIA IF (PCLEAR(JL) < 1.0_JPRB) THEN PCLD(JL,JK)=PCLDSW(JL,JK)/(1.0_JPRB-PCLEAR(JL)) ELSE PCLD(JL,JK)=0.0_JPRB ENDIF PCLD(JL,JK)=MAX(0.0_JPRB,MIN(1.0_JPRB,PCLD(JL,JK))) ENDDO ENDDO !* 1.4 COMPUTES CLEAR-SKY GREY ABSORPTION COEFFICIENTS ! ----------------------------------------------- DO JA = 1,2 DO JL = KIDIA,KFDIA ZUD(JL,JA) = ZUD(JL,JA) * PSEC(JL) ENDDO ENDDO IF (NSW <= 4) THEN INUIR=2 ELSEIF (NSW == 6) THEN INUIR=4 ENDIF DO JNU= INUIR,NSW CALL SWTT1 ( KIDIA,KFDIA,KLON, JNU, 2, IIND,& & ZUD,& & ZR ) DO JA = 1,2 DO JL = KIDIA,KFDIA PAKI(JL,JA,JNU) = -LOG( ZR(JL,JA) ) / ZUD(JL,JA) ENDDO ENDDO ENDDO ! ------------------------------------------------------------------ IF (LHOOK) CALL DR_HOOK('SWU',1,ZHOOK_HANDLE) END SUBROUTINE SWU