source: LMDZ6/branches/Optimisation_LMDZ/libf/phylmd/rrtm/swtt.F90

Last change on this file was 1990, checked in by Laurent Fairhead, 11 years ago

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM


Changes to revision r1989 to enable RRTM code compilation
RRTM part put under CeCILL_V2 licence

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 2.9 KB
Line 
1SUBROUTINE SWTT ( KIDIA, KFDIA, KLON, KNU, KA , PU, PTR)
2
3!**** *SWTT* - COMPUTES THE SHORTWAVE TRANSMISSION FUNCTIONS
4
5!     PURPOSE.
6!     --------
7!           THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
8!     ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN THE TWO SPECTRAL
9!     INTERVALS.
10
11!**   INTERFACE.
12!     ----------
13!          *SWTT* IS CALLED FROM *SW1S*, *SWNI*.
14
15!        EXPLICIT ARGUMENTS :
16!        --------------------
17! KNU    :                     ; INDEX OF THE SPECTRAL INTERVAL
18! KA     :                     ; INDEX OF THE ABSORBER
19! PU     : (KLON)             ; ABSORBER AMOUNT
20!     ==== OUTPUTS ===
21! PTR    : (KLON)             ; TRANSMISSION FUNCTION
22
23!        IMPLICIT ARGUMENTS :   NONE
24!        --------------------
25
26!     METHOD.
27!     -------
28
29!          TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS
30!     AND HORNER'S ALGORITHM.
31
32!     EXTERNALS.
33!     ----------
34
35!          NONE
36
37!     REFERENCE.
38!     ----------
39
40!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
41!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
42
43!     AUTHOR.
44!     -------
45!        JEAN-JACQUES MORCRETTE  *ECMWF*
46
47!     MODIFICATIONS.
48!     --------------
49!        ORIGINAL : 88-12-15
50!        M.Hamrud      01-Oct-2003 CY28 Cleaning
51   
52!-----------------------------------------------------------------------
53
54USE PARKIND1  ,ONLY : JPIM     ,JPRB
55USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
56
57USE YOESW    , ONLY : APAD     ,BPAD     ,D
58
59IMPLICIT NONE
60
61INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
62INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
63INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
64INTEGER(KIND=JPIM),INTENT(IN)    :: KNU
65INTEGER(KIND=JPIM),INTENT(IN)    :: KA
66REAL(KIND=JPRB)   ,INTENT(IN)    :: PU(KLON)
67REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTR(KLON)
68!-----------------------------------------------------------------------
69
70!*       0.1   ARGUMENTS
71!              ---------
72
73!-----------------------------------------------------------------------
74
75!              ------------
76
77REAL(KIND=JPRB) :: ZR1(KLON), ZR2(KLON)
78
79INTEGER(KIND=JPIM) :: JL
80REAL(KIND=JPRB) :: ZHOOK_HANDLE
81
82!-----------------------------------------------------------------------
83
84!*         1.      HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION
85
86IF (LHOOK) CALL DR_HOOK('SWTT',0,ZHOOK_HANDLE)
87DO JL = KIDIA,KFDIA
88  ZR1(JL) = APAD(KNU,KA,1) + PU(JL) * (APAD(KNU,KA,2) + PU(JL)&
89   & * ( APAD(KNU,KA,3) + PU(JL) * (APAD(KNU,KA,4) + PU(JL)&
90   & * ( APAD(KNU,KA,5) + PU(JL) * (APAD(KNU,KA,6) + PU(JL)&
91   & * ( APAD(KNU,KA,7) )))))) 
92
93  ZR2(JL) = BPAD(KNU,KA,1) + PU(JL) * (BPAD(KNU,KA,2) + PU(JL)&
94   & * ( BPAD(KNU,KA,3) + PU(JL) * (BPAD(KNU,KA,4) + PU(JL)&
95   & * ( BPAD(KNU,KA,5) + PU(JL) * (BPAD(KNU,KA,6) + PU(JL)&
96   & * ( BPAD(KNU,KA,7) )))))) 
97
98!*         2.      ADD THE BACKGROUND TRANSMISSION
99
100  PTR(JL) = (ZR1(JL) / ZR2(JL)) * (1.0_JPRB - D(KNU,KA)) + D(KNU,KA)
101ENDDO
102
103IF (LHOOK) CALL DR_HOOK('SWTT',1,ZHOOK_HANDLE)
104END SUBROUTINE SWTT
Note: See TracBrowser for help on using the repository browser.