*=*=*=*= SWU.html =*=*=*=*
SUBROUTINE SWU

SUBROUTINE SWU


      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