*=*=*=*= SW.html =*=*=*=*
SUBROUTINE SW ( KDLON, KFLEV, KAER S , PSCT, PCARDI, PPSOL, PALBS, PWV, PRMU0, PCG S , PCLDSW, PDP, POMEGA, POZ, PPMB, PTAU, PTAVE, PAER S , PHEAT, PFDOWN, PFUP, PFDNN, PFDNV, PFUPN, PFUPV S ,PFRACT) IMPLICIT LOGICAL (L) C #include "dimensions.h" #include "dimphys.h" #include "dimradmars.h" C C**** *SW* - COMPUTES THE SHORTWAVE RADIATION FLUXES. C C PURPOSE. C -------- C C THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO C SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980). C C** INTERFACE. C ---------- C SUBROUTINE SW ( KDLON, KFLEV, KAER C S , PSCT, PCARDI, PPSOL, PALBS, PWV, PRMU0, PCG C S , PCLDSW, PDP, POMEGA, POZ, PPMB, PTAU, PTAVE, PAER C S , PHEAT, PFDOWN, PFUP, PFDNN, PFDNV, PFUPN, PFUPV ) C C *SW* IS CALLED FROM *RADITE* C C C IMPLICIT ARGUMENTS : C -------------------- C C ==== INPUTS === C ==== OUTPUTS === C C METHOD. C ------- C C 1. COMPUTES ABSORBER AMOUNTS C 2. COMPUTES FLUXES IN 1ST SPECTRAL INTERVAL C 3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL C C EXTERNALS. C ---------- C C *SWU*, *SW1S*, *SW2S* 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 PPSOL(NDLO2), PAER(NDLO2,KFLEV,5),PRMU0(NDLO2) S ,PWV(NDLO2,KFLEV) C REAL PALBS(NDLO2,2), PCG(NDLO2,2,KFLEV), PCLDSW(NDLO2,KFLEV), S PDP(NDLO2,KFLEV), POMEGA(NDLO2,2,KFLEV), POZ(NDLO2,KFLEV), S PPMB(NDLO2,KFLEV+1), PTAU(NDLO2,2,KFLEV), PTAVE(NDLO2,KFLEV) C REAL PHEAT(NDLO2,KFLEV),PFDOWN(NDLO2,KFLEV+1),PFUP(NDLO2,KFLEV+1), S PFUPV(NDLO2),PFUPN(NDLO2),PFDNV(NDLO2),PFDNN(NDLO2) C REAL PFRACT(NDLO2) C ------------------------------------------------------------------ C C* 0.2 LOCAL ARRAYS C ------------ C REAL ZAKI(NDLON,2), ZDSIG(NDLON,NFLEV), ZFACT(NDLON) S , ZFD(NDLON,NFLEV+1), ZFDOWN(NDLON,NFLEV+1) S , ZFU(NDLON,NFLEV+1), ZFUP(NDLON,NFLEV+1) S , ZHESW1(NDLON), ZHESW2(NDLON) S , ZRMU(NDLON), ZSEC(NDLON) S , ZUD(NDLON,3,NFLEV+1), ZUM(NDLON,NFLEV+1) C C ------------------------------------------------------------------ C C* 1. ABSORBER AMOUNTS AND OTHER USEFUL QUANTITIES C -------------------------------------------- C 100 CONTINUE C CALL SWU ( KDLON, KFLEV, KAER S , PSCT,PCARDI,POZ,PPMB,PPSOL,PRMU0,PTAVE,PWV S , ZAKI,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD,ZUM S ,PFRACT) C C C ------------------------------------------------------------------ C C* 2. FIRST SPECTRAL INTERVAL (0.25-0.68 MICRON) C ----------------------- ------------------ C 200 CONTINUE C INU = 1 C CALL SW1S ( KDLON, KFLEV, KAER, INU S , PAER,PALBS,PCG,PCLDSW,ZDSIG,POMEGA,ZRMU,ZSEC,PTAU S , ZUD,ZUM S , ZFD,ZFU ) C C C ------------------------------------------------------------------ C C* 3. SECOND SPECTRAL INTERVAL (0.68-4.00 MICRON) C ------------------------------------------- C 300 CONTINUE C INU = 2 C CALL SW1S ( KDLON, KFLEV, KAER, INU S , PAER,PALBS,PCG,PCLDSW,ZDSIG,POMEGA,ZRMU,ZSEC,PTAU S , ZUD,ZUM S , ZFDOWN,ZFUP ) C C CALL SW2S ( KDLON, KFLEV, KAER, INU C S , PAER,ZAKI,PALBS,PCG,PCLDSW,ZDSIG,POMEGA,ZRMU,ZSEC,PTAU C S , ZUD,ZUM C S , ZFDOWN,ZFUP ) C C C ------------------------------------------------------------------ C C* 4. FILL THE DIAGNOSTIC ARRAYS C -------------------------- C 400 CONTINUE C DO 401 JL = 1 , KDLON PFDNN(JL)=ZFDOWN(JL,1)*ZFACT(JL) PFDNV(JL)=ZFD(JL,1)*ZFACT(JL) PFUPN(JL)=ZFUP(JL,KFLEV+1)*ZFACT(JL) PFUPV(JL)=ZFU(JL,KFLEV+1)*ZFACT(JL) 401 CONTINUE C C print*,'zfact',zfact(1) DO 403 JK = 1 , KFLEV+1 DO 402 JL = 1 , KDLON PFUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) PFDOWN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) 402 CONTINUE 403 CONTINUE C DO 405 JK = 1 , KFLEV DO 404 JL = 1 , KDLON ZDFNET = PFUP (JL,JK ) - PFDOWN(JL,JK ) S -PFUP (JL,JK+1) + PFDOWN(JL,JK+1) PHEAT(JL,JK) = CDAY * ZDFNET / PDP(JL,JK) ZDFNET = ZFUP (JL,JK ) - ZFDOWN(JL,JK ) S -ZFUP (JL,JK+1) + ZFDOWN(JL,JK+1) ZHESW2(JL) = CDAY * ZDFNET / PDP(JL,JK) * ZFACT(JL) ZDFNET = ZFU (JL,JK ) - ZFD (JL,JK ) S -ZFU (JL,JK+1) + ZFD (JL,JK+1) ZHESW1(JL) = CDAY * ZDFNET / PDP(JL,JK) * ZFACT(JL) 404 CONTINUE C PRINT 9499,JK,(PHEAT(JL,JK),ZHESW1(JL),ZHESW2(JL),JL=1,KDLON,2) 405 CONTINUE C C C ------------------------------------------------------------------ C RETURN 9499 FORMAT (1X,I3,3(2X,3F10.3)) END