source: LMDZ6/branches/LMDZ-COSP/libf/phylmd/rrtm/supol_mod.F90 @ 3847

Last change on this file since 3847 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.3 KB
Line 
1MODULE SUPOL_MOD
2CONTAINS
3SUBROUTINE SUPOL(KNSMAX,DDMU,DDPOL,DDA,DDB,DDC,DDD,DDE,DDF,DDG,DDH,DDI)
4
5!**** *SUPOL * - Routine to compute the Legendre polynomials
6
7!     Purpose.
8!     --------
9!           For a given value of mu, computes the Legendre
10!           polynomials.
11
12!**   Interface.
13!     ----------
14!        *CALL* *SUPOL(KNSMAX,DDMU,DDPOL,DDA,DDB,DDC,DDD,DDE
15!        ,DDF,DDG,DDH,DDI)
16
17!        Explicit arguments :
18!        --------------------
19!              KNSMAX   :  Truncation  (triangular)
20!              DDMU     :  Abscissa at which the polynomials are computed (mu)
21!              DDPOL    :  Polynomials (the first index is m and the second n)
22
23
24!        Implicit arguments :   None
25!        --------------------
26
27!     Method.
28!     -------
29!        See documentation
30
31!     Externals.
32!     ----------
33
34!     Reference.
35!     ----------
36!        ECMWF Research Department documentation of the IFS
37
38!     Author.
39!     -------
40!        Mats Hamrud and Philippe Courtier  *ECMWF*
41
42!     Modifications.
43!     --------------
44!        Original : 87-10-15
45!        K. YESSAD (MAY 1998): modification to avoid underflow.
46!     ------------------------------------------------------------------
47
48USE PARKIND1  ,ONLY : JPIM     ,JPRB
49USE PARKIND2  ,ONLY : JPRH
50
51IMPLICIT NONE
52
53INTEGER(KIND=JPIM),INTENT(IN)  :: KNSMAX
54REAL(KIND=JPRH)   ,INTENT(IN)  :: DDMU
55REAL(KIND=JPRH)   ,INTENT(IN)  :: DDC(0:KNSMAX,0:KNSMAX)
56REAL(KIND=JPRH)   ,INTENT(IN)  :: DDD(0:KNSMAX,0:KNSMAX)
57REAL(KIND=JPRH)   ,INTENT(IN)  :: DDE(0:KNSMAX,0:KNSMAX)
58REAL(KIND=JPRH)   ,INTENT(IN)  :: DDA(0:KNSMAX),DDB(0:KNSMAX),DDF(0:KNSMAX)
59REAL(KIND=JPRH)   ,INTENT(IN)  :: DDG(0:KNSMAX),DDH(0:KNSMAX),DDI(0:KNSMAX)
60REAL(KIND=JPRH)   ,INTENT(OUT) :: DDPOL(0:KNSMAX,0:KNSMAX)
61
62REAL(KIND=JPRH) :: DLX,DLSITA,DL1SITA,DLKM2,DLKM1,DLK,DL1,DLS
63
64INTEGER(KIND=JPIM) :: JM, JN
65REAL(KIND=JPRB) :: Z
66
67!     ------------------------------------------------------------------
68
69!*       1. First two columns.
70!           ------------------
71
72DLX=DDMU
73DLSITA=SQRT(1.0_JPRB-DLX*DLX)
74
75! IF WE ARE LESS THAN 1Meter FROM THE POLE,
76IF(ABS(REAL(DLSITA,KIND(Z))) <= SQRT(EPSILON(Z)))THEN
77  DLX=1._JPRB
78  DLSITA=0._JPRB
79  DL1SITA=0._JPRB
80ELSE
81  DL1SITA=1.0_JPRB/DLSITA
82ENDIF
83DLKM2=1._JPRB
84DLKM1=DLX
85DDPOL(0,0)=DLKM2
86DDPOL(0,1)=DLKM1*DDA(1)
87DDPOL(1,1)=DLSITA*DDB(1)
88DO JN=2,KNSMAX
89  DLK=DDF(JN)*DLX*DLKM1-DDG(JN)*DLKM2
90  DL1=DDI(JN)*(DLKM1-DLX*DLK)*DL1SITA
91  DDPOL(0,JN)=DLK*DDA(JN)
92  DDPOL(1,JN)=DL1*DDB(JN)
93  DLKM2=DLKM1
94  DLKM1=DLK
95ENDDO
96
97!     ------------------------------------------------------------------
98
99!*       2. Diagonal (the terms 0,0 and 1,1 have already been computed)
100!           -----------------------------------------------------------
101
102DLS=DL1SITA*TINY(DLS)
103
104!OCL SCALAR
105DO JN=2,KNSMAX
106  DDPOL(JN,JN)=DDPOL(JN-1,JN-1)*DLSITA*DDH(JN)
107  IF ( ABS(DDPOL(JN,JN))  <  DLS ) DDPOL(JN,JN)=0.0_JPRB
108ENDDO
109
110!     ------------------------------------------------------------------
111
112!*       3. General recurrence.
113!           -------------------
114
115DO JN=3,KNSMAX
116!DIR$ IVDEP
117!OCL NOVREC
118  DO JM=2,JN-1
119    DDPOL(JM,JN)=DDC(JM,JN)*DDPOL(JM-2,JN-2)&
120     &-DDD(JM,JN)*DDPOL(JM-2,JN-1)*DLX &
121     &+DDE(JM,JN)*DDPOL(JM  ,JN-1)*DLX
122  ENDDO
123ENDDO
124
125!     ------------------------------------------------------------------
126
127END SUBROUTINE SUPOL
128END MODULE SUPOL_MOD
129
130
Note: See TracBrowser for help on using the repository browser.