*=*=*=*= SW1S.html =*=*=*=*
SUBROUTINE SW1S

SUBROUTINE SW1S


      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',sunfr(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) * sunfr(KNU)
      PFD(JL,JKL) =           ZRJ(JL,JAJ,JKL) * sunfr(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) * sunfr(KNU)
      PFU(JL,JK) =           ZRK(JL,JAJ,JK) * sunfr(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