*=*=*=*= SWU.html =*=*=*=*
SUBROUTINE SWU ( KDLON, KFLEV, KAER S , PSCT,PCARDI,POZ,PPMB,PPSOL,PRMU0,PTAVE,PWV S , PAKI,PDSIG,PFACT,PRMU,PSEC,PUD,PUM S ,PFRACT) IMPLICIT LOGICAL (L) C #include "dimensions.h" #include "dimphys.h" #include "dimradmars.h" C C**** *SWU* - SHORTWAVE RADIATION, ABSORBER AMOUNTS C C PURPOSE. C -------- C COMPUTES THE ABSORBER AMOUNTS USED IN SHORTWAVE RADIATION C CALCULATIONS C C** INTERFACE. C ---------- C *SWU* IS CALLED BY *SW* C C SUBROUTINE SWU ( KDLON, KFLEV, KAER C S , PSCT,PCARDI,POZ,PPMB,PPSOL,PRMU0,PTAVE,PWV C S , PAKI,PDSIG,PFACT,PRMU,PSEC,PUD,PUM ) C C IMPLICIT ARGUMENTS : C -------------------- C C ==== INPUTS === C ==== OUTPUTS === C C METHOD. C ------- C C 1. COMPUTES ABSORBER AMOUNTS WITH TEMPERATURE AND PRESSURE C SCALING. C C EXTERNALS. C ---------- C C *SWTT* C C REFERENCE. C ---------- C C SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT C DOCUMENTATION, AND FOUQUART AND BONNEL (1980) C C AUTHOR. C ------- C JEAN-JACQUES MORCRETTE *ECMWF* C C MODIFICATIONS. C -------------- C ORIGINAL : 89-07-14 C ------------------------------------------------------------------ C C C C----------------------------------------------------------------------- C #include "yomcst.h" #include "yomrad.h" #include "yomaer.h" #include "yomlw.h" #include "yomsw.h" #include "yomrdu.h" C C----------------------------------------------------------------------- C C C* 0.1 ARGUMENTS C --------- C REAL POZ(NDLO2,KFLEV),PPMB(NDLO2,KFLEV+1),PPSOL(NDLO2) S , PRMU0(NDLO2),PTAVE(NDLO2,KFLEV),PWV(NDLO2,KFLEV) C REAL PAKI(NDLO2,2),PDSIG(NDLO2,KFLEV),PFACT(NDLO2),PRMU(NDLO2) S , PSEC(NDLO2), PUD(NDLO2,3,KFLEV+1), PUM(NDLO2,KFLEV+1) C REAL PFRACT(NDLO2) C ------------------------------------------------------------------ C C* 0.2 LOCAL ARRAYS C ------------ C REAL ZR1(NDLON), ZR2(NDLON), ZU1D(NDLON) S , ZU2D(NDLON), ZN175(NDLON), ZN190(NDLON), ZO175(NDLON) S , ZO190(NDLON), ZP75(NDLON), ZP90(NDLON), ZSIGN(NDLON) S , ZSIGO(NDLON) C C ------------------------------------------------------------------ C C* 1. COMPUTES AMOUNTS OF ABSORBERS C ----------------------------- C 100 CONTINUE C C C* 1.1 INITIALIZES QUANTITIES C ---------------------- C 110 CONTINUE C c print*,'110' DO 111 JL = 1 , KDLON PUD(JL,1,KFLEV+1)=0. PUD(JL,2,KFLEV+1)=0. PUD(JL,3,KFLEV+1)=0. PFACT(JL)= PRMU0(JL) * PSCT * PFRACT(JL) PRMU(JL)=SQRT(1224.* PRMU0(JL) * PRMU0(JL) + 1.) / 35. PSEC(JL)=1./PRMU(JL) 111 CONTINUE C C* 1.2 OZONE FOR DOWNWARD LOOKING PATH C ------------------------------- C 120 CONTINUE c print*,'120' C DO 122 JK = 1 , KFLEV JKL = KFLEV+1 - JK JKLP1 = JKL + 1 DO 121 JL = 1 , KDLON PUD(JL,3,JKL) = PUD(JL,3,JKLP1) + POZ(JL,JKL) * PSEC(JL) 121 CONTINUE 122 CONTINUE C C* 1.3 OZONE FOR UPWARD LOOKING PATH AND OTHER ABSORBERS C ------------------------------------------------- C 130 CONTINUE C DO 131 JL = 1 , KDLON PUM(JL,1) = PUD(JL,3,1) ZU1D(JL) = 0. ZU2D(JL) = 0. ZPSIG = PPSOL(JL) / 101325. ZP75(JL) = PPSOL(JL) * ZPSIG ** 0.75 ZP90(JL) = PPSOL(JL) * ZPSIG ** 0.90 ZO175(JL) = 1.0 ZO190(JL) = 1.0 ZSIGO(JL) = 1.0 131 CONTINUE c print*,131 C DO 133 JK = 1 , KFLEV JKP1 = JK + 1 JKL = KFLEV+1 - JK DO 132 JL = 1 , KDLON PUM(JL,JKP1) = PUM(JL,JK) + POZ(JL,JK) * 1.66 ZRT = 273.15 / PTAVE(JL,JK) ZWH2O = AMAX1 (PWV(JL,JKL) , ZEPSCQ ) ZSIGN(JL) = 100. * PPMB(JL,JKP1) / PPSOL(JL) PDSIG(JL,JK) = ZSIGO(JL) - ZSIGN(JL) ZN175(JL) = ZSIGN(JL) ** 1.75 ZN190(JL) = ZSIGN(JL) ** 1.90 ZDSCO2 = ZO175(JL) - ZN175(JL) ZDSH2O = ZO190(JL) - ZN190(JL) PUD(JL,1,JK) = ZP90(JL) * ZDSH2O*CH2O*ZWH2O * ZRT **0.45 PUD(JL,2,JK) = ZP75(JL) * ZDSCO2*CCO2*PCARDI * ZRT **0.375 ZU1D(JL) = ZU1D(JL) + PUD(JL,1,JK) ZU2D(JL) = ZU2D(JL) + PUD(JL,2,JK) ZSIGO(JL) = ZSIGN(JL) ZO175(JL) = ZN175(JL) ZO190(JL) = ZN190(JL) 132 CONTINUE 133 CONTINUE c print*,133 C C* 1.4 COMPUTES CLEAR-SKY GREY ABSORPTION COEFFICIENTS C ----------------------------------------------- C 140 CONTINUE C DO 141 JL = 1 , KDLON ZU1D(JL) = ZU1D(JL) * PSEC(JL) ZU2D(JL) = ZU2D(JL) * PSEC(JL) 141 CONTINUE C CALL SWTT ( KDLON, 2, 1, ZU1D, ZR1 ) C DO 142 JL = 1 , KDLON PAKI(JL,1) = -ALOG( ZR1 (JL)) / ZU1D(JL) 142 CONTINUE C CALL SWTT ( KDLON, 2, 2, ZU2D, ZR2 ) C DO 143 JL = 1 , KDLON PAKI(JL,2) = -ALOG( ZR2 (JL)) / ZU2D(JL) 143 CONTINUE c print*,143 C C ------------------------------------------------------------------ C RETURN END