swuvo3.F90

Go to the documentation of this file.

SUBROUTINE swuvo3 &
  &( kidia,kfdia,klon,knu,kabs &
  &, pu, ptr &
  & )
  
!**** *SWUVO3* - COMPUTES THE SHORTWAVE TRANSMISSION FUNCTIONS

!     PURPOSE.
!     --------
!           THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR OZONE
!     IN THE UV and VISIBLE SPECTRAL INTERVALS.

!**   INTERFACE.
!     ----------
!          *SWUVO3* IS CALLED FROM *SW1S*.


!        EXPLICIT ARGUMENTS :
!        --------------------
! KNU    :                     ; INDEX OF THE SPECTRAL INTERVAL
! KABS   :                     ; NUMBER OF ABSORBERS
! PU     : (KLON,KABS)         ; ABSORBER AMOUNT
!     ==== OUTPUTS ===
! PTR    : (KLON,KABS)         ; TRANSMISSION FUNCTION

!        IMPLICIT ARGUMENTS :   NONE
!        --------------------

!     METHOD.
!     -------

!          TRANSMISSION FUNCTION ARE COMPUTED USING SUMS OF EXPONENTIALS

!     EXTERNALS.
!     ----------

!          NONE

!     REFERENCE.
!     ----------
!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS

!     AUTHOR.
!     -------
!        JEAN-JACQUES MORCRETTE  *ECMWF*
!        Ph.DUBUISSON/B.BONNEL L.O.A.

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 00-12-18
   
!-----------------------------------------------------------------------

#include "tsmbkind.h"

USE yoesw    , ONLY : nexpo3, rexpo3


IMPLICIT NONE


!     DUMMY INTEGER SCALARS
integer_m :: kabs
integer_m :: kfdia
integer_m :: kidia
integer_m :: klon
integer_m :: knu

!-----------------------------------------------------------------------

!*       0.1   ARGUMENTS
!              ---------

real_b :: pu(klon,kabs)
real_b :: ptr(klon,kabs)

!-----------------------------------------------------------------------

!*       0.2   LOCAL ARRAYS
!              ------------

!     LOCAL INTEGER SCALARS
integer_m :: ja, jl, iexp, jx


iexp=nexpo3(knu)
!print *,'IEXP(',KNU,')=',IEXP
!print *,(REXPO3(KNU,1,JX),JX=1,IEXP)
!print *,(REXPO3(KNU,2,JX),JX=1,IEXP)

DO ja = 1,kabs
  DO jl=kidia,kfdia
    ptr(jl,ja)=_zero_
  END DO
    
  DO jx=1,iexp
    DO jl = kidia,kfdia
      ptr(jl,ja) = ptr(jl,ja) &
        &+rexpo3(knu,1,jx)*exp(-min(rexpo3(knu,2,jx)*pu(jl,ja),200.0_jprb))
    END DO
  END DO    
ENDDO

RETURN
END SUBROUTINE swuvo3