*=*=*=*= SW1S.html =*=*=*=*
SUBROUTINE SW1S ( KDLON, KFLEV, KAER, KNU S , PAER,PALBS,PCG,PCLDSW,PDSIG,POMEGA,PRMU,PSEC,PTAU S , PUD,PUM S , PFD,PFU ) IMPLICIT LOGICAL (L) C #include "dimensions.h" #include "dimphys.h" #include "dimradmars.h" C C**** *SW1S* - SHORTWAVE RADIATION, FIRST SPECTRAL INTERVAL 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 SW1S ( KDLON, KFLEV, KAER, KNU C S , PAER,PALBS,PCG,PCLDSW,PDSIG,POMEGA,PRMU,PSEC,PTAU C S , PUD,PUM C S , PFD,PFU ) C C *SW1S* IS CALLED FROM *SW*. C C C IMPLICIT ARGUMENTS : C -------------------- C C ==== INPUTS === C ==== OUTPUTS === C C METHOD. C ------- C C 1. COMPUTES UPWARD AND DOWNWARD FLUXES CORRESPONDING TO C CONTINUUM SCATTERING C 2. MULTIPLY BY OZONE TRANSMISSION FUNCTION C C EXTERNALS. C ---------- C C *SWR*, *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----------------------------------------------------------------------- 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 PAER(NDLO2,KFLEV,5), PALBS(NDLO2,2), PCG(NDLO2,2,KFLEV) S , PCLDSW(NDLO2,KFLEV), PDSIG(NDLO2,KFLEV) S , POMEGA(NDLO2,2,KFLEV), PRMU(NDLO2), PSEC(NDLO2) S , PTAU(NDLO2,2,KFLEV), PUD(NDLO2,3,KFLEV+1) S , PUM(NDLO2,KFLEV+1) C REAL PFD(NDLO2,KFLEV+1),PFU(NDLO2,KFLEV+1) C C ------------------------------------------------------------------ C C* 0.2 LOCAL ARRAYS C ------------ C REAL ZCGAZ(NDLON,NFLEV), ZPIZAZ(NDLON,NFLEV) S , ZRAYL(NDLON), ZRAY1(NDLON,NFLEV+1), ZRAY2(NDLON,NFLEV+1) S , ZREFZ(NDLON,2,NFLEV+1), ZRJ(NDLON,6,NFLEV+1) S , ZRK(NDLON,6,NFLEV+1), ZRMUE(NDLON,NFLEV+1) S , ZR1(NDLON), ZR2(NDLON), ZTAUAZ(NDLON,NFLEV) S , ZTRA1(NDLON,NFLEV+1), ZTRA2(NDLON,NFLEV+1) S , ZW1(NDLON), ZW2(NDLON) common/scratch/ S ZCGAZ, ZPIZAZ S , ZRAYL, ZRAY1, ZRAY2 S , ZREFZ, ZRJ S , ZRK, ZRMUE S , ZR1, ZR2, ZTAUAZ S , ZTRA1, ZTRA2 S , ZW1, ZW2 C C ------------------------------------------------------------------ C C* 1. FIRST SPECTRAL INTERVAL (0.25-0.68 MICRON) C ----------------------- ------------------ C 100 CONTINUE C C C* 1.1 OPTICAL THICKNESS FOR RAYLEIGH SCATTERING C ----------------------------------------- C 110 CONTINUE C DO 111 JL = 1 , KDLON ZRAYL(JL) = CRAY(KNU,1) + PRMU(JL) * (CRAY(KNU,2) + PRMU(JL) S * (CRAY(KNU,3) + PRMU(JL) * (CRAY(KNU,4) + PRMU(JL) S * (CRAY(KNU,5) + PRMU(JL) * CRAY(KNU,6) )))) 111 CONTINUE C C C ------------------------------------------------------------------ C C* 2. CONTINUUM SCATTERING CALCULATIONS C --------------------------------- C 200 CONTINUE C CALL SWR ( KDLON,KFLEV,KAER,KNU S , PAER,PALBS,PCG,PCLDSW,PDSIG,POMEGA,ZRAYL,PSEC,PTAU S , ZCGAZ,ZPIZAZ,ZRAY1,ZRAY2,ZREFZ,ZRJ,ZRK,ZRMUE S , ZTAUAZ,ZTRA1,ZTRA2 ) C C C ------------------------------------------------------------------ C C* 3. OZONE ABSORPTION C ---------------- C 300 CONTINUE C C C* 3.1 DOWNWARD FLUXES C --------------- C 310 CONTINUE C C print*,'fraction du spectre solaire',sun(knu) JAJ = 2 C DO 314 JK = 1 , KFLEV+1 JKL = KFLEV+1 - JK + 1 DO 312 JL = 1 , KDLON ZW1(JL) = PUD(JL,3,JKL) 312 CONTINUE C C CALL SWTT ( KDLON, KNU, 3, ZW1, ZR1 ) C DO 313 JL = 1 , KDLON C PFD(JL,JKL) = ZR1(JL) * ZRJ(JL,JAJ,JKL) * SUN(KNU) PFD(JL,JKL) = ZRJ(JL,JAJ,JKL) * SUN(KNU) 313 CONTINUE 314 CONTINUE C C C* 3.2 UPWARD FLUXES C ------------- C 320 CONTINUE C DO 325 JL = 1 , KDLON PFU(JL,1) = PALBS(JL,KNU) * PFD(JL,1) 325 CONTINUE C DO 328 JK = 1 , KFLEV+1 DO 326 JL = 1 , KDLON ZW2(JL) = PUM(JL,JK) 326 CONTINUE C C CALL SWTT ( KDLON, KNU, 3, ZW2, ZR2 ) C DO 327 JL = 1 , KDLON C PFU(JL,JK) = ZR2(JL) * ZRK(JL,JAJ,JK) * SUN(KNU) PFU(JL,JK) = ZRK(JL,JAJ,JK) * SUN(KNU) 327 CONTINUE 328 CONTINUE C if(nimp.lt.5) then print*,'Flux en sortie de SW1s' print*,'Montants , descendants' do jk=1,kflev+1 print*,jk,pfu(jlimprad,jk),pfd(jlimprad,jk) enddo endif C ------------------------------------------------------------------ C RETURN END