source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/rrtm/swtt1.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: 3.5 KB
Line 
1SUBROUTINE SWTT1 ( KIDIA,KFDIA,KLON,KNU,KABS,KIND, PU, PTR )
2
3!**** *SWTT1* - 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!          *SWTT1* IS CALLED FROM *SW1S*.
14
15!        EXPLICIT ARGUMENTS :
16!        --------------------
17! KNU    :                     ; INDEX OF THE SPECTRAL INTERVAL
18! KABS   :                     ; NUMBER OF ABSORBERS
19! KIND   : (KABS)              ; INDICES OF THE ABSORBERS
20! PU     : (KLON,KABS)         ; ABSORBER AMOUNT
21!     ==== OUTPUTS ===
22! PTR    : (KLON,KABS)         ; TRANSMISSION FUNCTION
23
24!        IMPLICIT ARGUMENTS :   NONE
25!        --------------------
26
27!     METHOD.
28!     -------
29
30!          TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS
31!     AND HORNER'S ALGORITHM.
32
33!     EXTERNALS.
34!     ----------
35
36!          NONE
37
38!     REFERENCE.
39!     ----------
40
41!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
42!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
43
44!     AUTHOR.
45!     -------
46!        JEAN-JACQUES MORCRETTE  *ECMWF*
47
48!     MODIFICATIONS.
49!     --------------
50!        ORIGINAL : 95-01-20
51!        03-10-10 Deborah Salmond and Marta Janiskova Optimisation
52!        M.Hamrud      01-Oct-2003 CY28 Cleaning
53   
54!-----------------------------------------------------------------------
55
56USE PARKIND1  ,ONLY : JPIM     ,JPRB
57USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
58
59USE YOESW    , ONLY : APAD     ,BPAD     ,D
60
61IMPLICIT NONE
62
63INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
64INTEGER(KIND=JPIM),INTENT(IN)    :: KABS
65INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
66INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
67INTEGER(KIND=JPIM),INTENT(IN)    :: KNU
68INTEGER(KIND=JPIM),INTENT(IN)    :: KIND(KABS)
69REAL(KIND=JPRB)   ,INTENT(IN)    :: PU(KLON,KABS)
70REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTR(KLON,KABS)
71!-----------------------------------------------------------------------
72
73!*       0.1   ARGUMENTS
74!              ---------
75
76!-----------------------------------------------------------------------
77
78!              ------------
79
80REAL(KIND=JPRB) :: ZR1(KLON), ZR2(KLON), ZU(KLON)
81REAL(KIND=JPRB) :: ZRR
82
83INTEGER(KIND=JPIM) :: IA, JA, JL
84REAL(KIND=JPRB) :: ZHOOK_HANDLE
85
86!-----------------------------------------------------------------------
87
88!*         1.      HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION
89
90IF (LHOOK) CALL DR_HOOK('SWTT1',0,ZHOOK_HANDLE)
91DO JA = 1,KABS
92  IA=KIND(JA)
93! print *,'SWTT1: KNU', KNU
94  DO JL = KIDIA,KFDIA
95    ZU(JL) = PU(JL,JA)
96    ZR1(JL) = APAD(KNU,IA,1) + ZU(JL) * (APAD(KNU,IA,2) + ZU(JL)&
97     & * ( APAD(KNU,IA,3) + ZU(JL) * (APAD(KNU,IA,4) + ZU(JL)&
98     & * ( APAD(KNU,IA,5) + ZU(JL) * (APAD(KNU,IA,6) + ZU(JL)&
99     & * ( APAD(KNU,IA,7) )))))) 
100!    print *,'SWTT1 ZU APAD',IA,ZU(JL),APAD(KNU,IA,1),APAD(KNU,IA,2),&
101!    &APAD(KNU,IA,3),APAD(KNU,IA,4),APAD(KNU,IA,5),APAD(KNU,IA,6),APAD(KNU,IA,7)
102
103    ZR2(JL) = BPAD(KNU,IA,1) + ZU(JL) * (BPAD(KNU,IA,2) + ZU(JL)&
104     & * ( BPAD(KNU,IA,3) + ZU(JL) * (BPAD(KNU,IA,4) + ZU(JL)&
105     & * ( BPAD(KNU,IA,5) + ZU(JL) * (BPAD(KNU,IA,6) + ZU(JL)&
106     & * ( BPAD(KNU,IA,7) )))))) 
107    ZRR=1.0_JPRB/ZR2(JL)
108
109!*         2.      ADD THE BACKGROUND TRANSMISSION
110
111    PTR(JL,JA) = (ZR1(JL)*ZRR) * (1.0_JPRB-D(KNU,IA)) + D(KNU,IA)
112  ENDDO
113ENDDO
114!WRITE(*,'("---> Dans SWTT1, PTR : "10E12.5)') (PTR(1,JA),JA=1,KABS)
115
116IF (LHOOK) CALL DR_HOOK('SWTT1',1,ZHOOK_HANDLE)
117END SUBROUTINE SWTT1
Note: See TracBrowser for help on using the repository browser.