source: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/susrtm.F90 @ 5218

Last change on this file since 5218 was 5159, checked in by abarral, 5 months ago

Put dimensions.h and paramet.h into modules
  • 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: 12.6 KB
RevLine 
[1989]1SUBROUTINE SUSRTM
2
3!     Adapted from E.J. Mlawer, J. Delamere, Atmospheric & Environmental Research.
4!     by JJMorcrette, ECMWF
5!     Modified to add arrays relevant to mapping for g-point reduction,
6!     M.J. Iacono, Atmospheric & Environmental Research, Inc.
7!     ------------------------------------------------------------------
8
9USE PARKIND1  ,ONLY : JPRB
10USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
11
12USE YOESRTWN , ONLY : NG      , NSPA, NSPB   , NMPSRTM, &
13 & WAVENUM1, WAVENUM2, DELWAVE, PREF, PREFLOG, TREF   , &
14 & NGM     , WT      , NGC    , NGS , NGN    , NGBSW
15
16!     ------------------------------------------------------------------
17
18IMPLICIT NONE
19REAL(KIND=JPRB) :: ZHOOK_HANDLE
20IF (LHOOK) CALL DR_HOOK('SUSRTM',0,ZHOOK_HANDLE)
21NG(:)     =(/ 16,16,16,16,16,16,16,16,16,16,16,16,16,16 /)
22NSPA(:)   =(/  9, 9, 9, 9, 1, 9, 9, 1, 9, 1, 0, 1, 9, 1 /)
23NSPB(:)   =(/  1, 5, 1, 1, 1, 5, 1, 0, 1, 0, 0, 1, 5, 1 /)
24NMPSRTM(:)=(/  6, 6, 5, 5, 5, 5, 5, 4, 4, 3, 2, 2, 1, 6 /)
25
26WAVENUM1( :) = (/&
27 & 2600._JPRB, 3250._JPRB, 4000._JPRB, 4650._JPRB, 5150._JPRB, 6150._JPRB, 7700._JPRB &
28 & , 8050._JPRB,12850._JPRB,16000._JPRB,22650._JPRB,29000._JPRB,38000._JPRB,  820._JPRB /) 
29WAVENUM2( :) = (/&
30 & 3250._JPRB, 4000._JPRB, 4650._JPRB, 5150._JPRB, 6150._JPRB, 7700._JPRB, 8050._JPRB &
31 & ,12850._JPRB,16000._JPRB,22650._JPRB,29000._JPRB,38000._JPRB,50000._JPRB, 2600._JPRB /) 
32DELWAVE( :) = (/&
33 & 650._JPRB,  750._JPRB,  650._JPRB,  500._JPRB, 1000._JPRB, 1550._JPRB,  350._JPRB &
34 & , 4800._JPRB, 3150._JPRB, 6650._JPRB, 6350._JPRB, 9000._JPRB,12000._JPRB, 1780._JPRB /) 
35
36!=====================================================================
37! Set arrays needed for the g-point reduction from 224 to 112 for the
38! 14 SW bands:
39! This mapping from 224 to 112 points has been carefully selected to
40! minimize the effect on the resulting fluxes and cooling rates, and
41! caution should be used if the mapping is modified.
[5159]42
[1989]43! JPGPT   The total number of new g-points (NGPT)
44! NGC     The number of new g-points in each band
45! NGS     The cumulative sum of new g-points for each band
46! NGM     The index of each new g-point relative to the original
47!         16 g-points for each band.
48! NGN     The number of original g-points that are combined to make
49!         each new g-point in each band.
50! NGB     The band index for each new g-point.
51! WT      RRTM weights for 16 g-points.
52! Use this NGC, NGS, NGM, and NGN for reduced (112) g-point set
53! (A related code change is required in modules parsrtm.F90 and yoesrtwn.F90)
54NGC(:) = (/ 6,12, 8, 8,10,10, 2,10, 8, 6, 6, 8, 6,12 /)
55NGS(:) = (/ 6,18,26,34,44,54,56,66,74,80,86,94,100,112 /)
56NGM(:) = (/ 1,1,2,2,3,3,4,4,5,5,5,5,6,6,6,6, &           ! Band 16
57          & 1,2,3,4,5,6,6,7,8,8,9,10,10,11,12,12, &      ! Band 17
58          & 1,2,3,4,5,5,6,6,7,7,7,7,8,8,8,8, &           ! Band 18
59          & 1,2,3,4,5,5,6,6,7,7,7,7,8,8,8,8, &           ! Band 19
60          & 1,2,3,4,5,6,7,8,9,9,10,10,10,10,10,10, &     ! Band 20
61          & 1,2,3,4,5,6,7,8,9,9,10,10,10,10,10,10, &     ! Band 21
62          & 1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2, &           ! Band 22
63          & 1,1,2,2,3,4,5,6,7,8,9,9,10,10,10,10, &       ! Band 23
64          & 1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, &           ! Band 24
65          & 1,2,3,3,4,4,5,5,5,5,6,6,6,6,6,6, &           ! Band 25
66          & 1,2,3,3,4,4,5,5,5,5,6,6,6,6,6,6, &           ! Band 26
67          & 1,2,3,4,5,6,7,7,7,7,8,8,8,8,8,8, &           ! Band 27
68          & 1,2,3,3,4,4,5,5,5,5,6,6,6,6,6,6, &           ! Band 28
69          & 1,2,3,4,5,5,6,6,7,7,8,8,9,10,11,12 /)        ! Band 29
70NGN(:) = (/ 2,2,2,2,4,4, &                               ! Band 16
71          & 1,1,1,1,1,2,1,2,1,2,1,2, &                   ! Band 17
72          & 1,1,1,1,2,2,4,4, &                           ! Band 18
73          & 1,1,1,1,2,2,4,4, &                           ! Band 19
74          & 1,1,1,1,1,1,1,1,2,6, &                       ! Band 20
75          & 1,1,1,1,1,1,1,1,2,6, &                       ! Band 21
76          & 8,8, &                                       ! Band 22
77          & 2,2,1,1,1,1,1,1,2,4, &                       ! Band 23
78          & 2,2,2,2,2,2,2,2, &                           ! Band 24
79          & 1,1,2,2,4,6, &                               ! Band 25
80          & 1,1,2,2,4,6, &                               ! Band 26
81          & 1,1,1,1,1,1,4,6, &                           ! Band 27
82          & 1,1,2,2,4,6, &                               ! Band 28
83          & 1,1,1,1,2,2,2,2,1,1,1,1 /)                   ! Band 29
84NGBSW(:)=(/ 16,16,16,16,16,16, &                         ! Band 16
85          & 17,17,17,17,17,17,17,17,17,17,17,17, &       ! Band 17
86          & 18,18,18,18,18,18,18,18, &                   ! Band 18
87          & 19,19,19,19,19,19,19,19, &                   ! Band 19
88          & 20,20,20,20,20,20,20,20,20,20, &             ! Band 20
89          & 21,21,21,21,21,21,21,21,21,21, &             ! Band 21
90          & 22,22, &                                     ! Band 22
91          & 23,23,23,23,23,23,23,23,23,23, &             ! Band 23
92          & 24,24,24,24,24,24,24,24, &                   ! Band 24
93          & 25,25,25,25,25,25, &                         ! Band 25
94          & 26,26,26,26,26,26, &                         ! Band 26
95          & 27,27,27,27,27,27,27,27, &                   ! Band 27
96          & 28,28,28,28,28,28, &                         ! Band 28
97          & 29,29,29,29,29,29,29,29,29,29,29,29 /)       ! Band 29
98
99! Use this NGC, NGS, NGM, and NGN for full (224) g-point set
100! (A related code change is required in modules parsrtm.F90 and yoesrtwn.F90)
101!NGC(:) = (/ 16,16,16,16,16,16,16,16,16,16,16,16,16,16 /)
102!NGS(:) = (/ 16,32,48,64,80,96,112,128,144,160,176,192,208,224 /)
103!NGM(:) = (/ 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! Band 16
104!          & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! Band 17
105!          & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! Band 18
106!          & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! Band 19
107!          & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! Band 20
108!          & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! Band 21
109!          & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! Band 22
110!          & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! Band 23
111!          & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! Band 24
112!          & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! Band 25
113!          & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! Band 26
114!          & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! Band 27
115!          & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! Band 28
116!          & 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16 /)    ! Band 29
117!NGN(:) = (/ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! Band 16
118!          & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! Band 17
119!          & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! Band 18
120!          & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! Band 19
121!          & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! Band 20
122!          & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! Band 21
123!          & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! Band 22
124!          & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! Band 23
125!          & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! Band 24
126!          & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! Band 25
127!          & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! Band 26
128!          & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! Band 27
129!          & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! Band 28
130!          & 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 /)           ! Band 29
131!NGBSW(:)=(/ 16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16, &   ! Band 16
132!          & 17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17, &   ! Band 17
133!          & 18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18, &   ! Band 18
134!          & 19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19, &   ! Band 19
135!          & 20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20, &   ! Band 20
136!          & 21,21,21,21,21,21,21,21,21,21,21,21,21,21,21,21, &   ! Band 21
137!          & 22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22, &   ! Band 22
138!          & 23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23, &   ! Band 23
139!          & 24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, &   ! Band 24
140!          & 25,25,25,25,25,25,25,25,25,25,25,25,25,25,25,25, &   ! Band 25
141!          & 26,26,26,26,26,26,26,26,26,26,26,26,26,26,26,26, &   ! Band 26
142!          & 27,27,27,27,27,27,27,27,27,27,27,27,27,27,27,27, &   ! Band 27
143!          & 28,28,28,28,28,28,28,28,28,28,28,28,28,28,28,28, &   ! Band 28
144!          & 29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,28 /)   ! Band 29
145
146WT(:) =  (/ 0.1527534276_JPRB, 0.1491729617_JPRB, 0.1420961469_JPRB, &
147          & 0.1316886544_JPRB, 0.1181945205_JPRB, 0.1019300893_JPRB, &
148          & 0.0832767040_JPRB, 0.0626720116_JPRB, 0.0424925000_JPRB, &
149          & 0.0046269894_JPRB, 0.0038279891_JPRB, 0.0030260086_JPRB, &
150          & 0.0022199750_JPRB, 0.0014140010_JPRB, 0.0005330000_JPRB, &
151          & 0.0000750000_JPRB /)
152
153!=============================================================================
154
155! These pressures are chosen such that the ln of the first pressure
156! has only a few non-zero digits (i.e. ln(PREF(1)) = 6.96000) and
157!  each subsequent ln(pressure) differs from the previous one by 0.2.
158PREF = (/ &
159 & 1.05363E+03_JPRB,8.62642E+02_JPRB,7.06272E+02_JPRB,5.78246E+02_JPRB,4.73428E+02_JPRB, &
160 & 3.87610E+02_JPRB,3.17348E+02_JPRB,2.59823E+02_JPRB,2.12725E+02_JPRB,1.74164E+02_JPRB, &
161 & 1.42594E+02_JPRB,1.16746E+02_JPRB,9.55835E+01_JPRB,7.82571E+01_JPRB,6.40715E+01_JPRB, &
162 & 5.24573E+01_JPRB,4.29484E+01_JPRB,3.51632E+01_JPRB,2.87892E+01_JPRB,2.35706E+01_JPRB, &
163 & 1.92980E+01_JPRB,1.57998E+01_JPRB,1.29358E+01_JPRB,1.05910E+01_JPRB,8.67114E+00_JPRB, &
164 & 7.09933E+00_JPRB,5.81244E+00_JPRB,4.75882E+00_JPRB,3.89619E+00_JPRB,3.18993E+00_JPRB, &
165 & 2.61170E+00_JPRB,2.13828E+00_JPRB,1.75067E+00_JPRB,1.43333E+00_JPRB,1.17351E+00_JPRB, &
166 & 9.60789E-01_JPRB,7.86628E-01_JPRB,6.44036E-01_JPRB,5.27292E-01_JPRB,4.31710E-01_JPRB, &
167 & 3.53455E-01_JPRB,2.89384E-01_JPRB,2.36928E-01_JPRB,1.93980E-01_JPRB,1.58817E-01_JPRB, &
168 & 1.30029E-01_JPRB,1.06458E-01_JPRB,8.71608E-02_JPRB,7.13612E-02_JPRB,5.84256E-02_JPRB, &
169 & 4.78349E-02_JPRB,3.91639E-02_JPRB,3.20647E-02_JPRB,2.62523E-02_JPRB,2.14936E-02_JPRB, &
170 & 1.75975E-02_JPRB,1.44076E-02_JPRB,1.17959E-02_JPRB,9.65769E-03_JPRB /) 
171PREFLOG = (/ &
172 & 6.9600E+00_JPRB, 6.7600E+00_JPRB, 6.5600E+00_JPRB, 6.3600E+00_JPRB, 6.1600E+00_JPRB, &
173 & 5.9600E+00_JPRB, 5.7600E+00_JPRB, 5.5600E+00_JPRB, 5.3600E+00_JPRB, 5.1600E+00_JPRB, &
174 & 4.9600E+00_JPRB, 4.7600E+00_JPRB, 4.5600E+00_JPRB, 4.3600E+00_JPRB, 4.1600E+00_JPRB, &
175 & 3.9600E+00_JPRB, 3.7600E+00_JPRB, 3.5600E+00_JPRB, 3.3600E+00_JPRB, 3.1600E+00_JPRB, &
176 & 2.9600E+00_JPRB, 2.7600E+00_JPRB, 2.5600E+00_JPRB, 2.3600E+00_JPRB, 2.1600E+00_JPRB, &
177 & 1.9600E+00_JPRB, 1.7600E+00_JPRB, 1.5600E+00_JPRB, 1.3600E+00_JPRB, 1.1600E+00_JPRB, &
178 & 9.6000E-01_JPRB, 7.6000E-01_JPRB, 5.6000E-01_JPRB, 3.6000E-01_JPRB, 1.6000E-01_JPRB, &
179 & -4.0000E-02_JPRB,-2.4000E-01_JPRB,-4.4000E-01_JPRB,-6.4000E-01_JPRB,-8.4000E-01_JPRB, &
180 & -1.0400E+00_JPRB,-1.2400E+00_JPRB,-1.4400E+00_JPRB,-1.6400E+00_JPRB,-1.8400E+00_JPRB, &
181 & -2.0400E+00_JPRB,-2.2400E+00_JPRB,-2.4400E+00_JPRB,-2.6400E+00_JPRB,-2.8400E+00_JPRB, &
182 & -3.0400E+00_JPRB,-3.2400E+00_JPRB,-3.4400E+00_JPRB,-3.6400E+00_JPRB,-3.8400E+00_JPRB, &
183 & -4.0400E+00_JPRB,-4.2400E+00_JPRB,-4.4400E+00_JPRB,-4.6400E+00_JPRB /) 
184! These are the temperatures associated with the respective
185! pressures for the MLS standard atmosphere.
186TREF = (/ &
187 & 2.9420E+02_JPRB, 2.8799E+02_JPRB, 2.7894E+02_JPRB, 2.6925E+02_JPRB, 2.5983E+02_JPRB, &
188 & 2.5017E+02_JPRB, 2.4077E+02_JPRB, 2.3179E+02_JPRB, 2.2306E+02_JPRB, 2.1578E+02_JPRB, &
189 & 2.1570E+02_JPRB, 2.1570E+02_JPRB, 2.1570E+02_JPRB, 2.1706E+02_JPRB, 2.1858E+02_JPRB, &
190 & 2.2018E+02_JPRB, 2.2174E+02_JPRB, 2.2328E+02_JPRB, 2.2479E+02_JPRB, 2.2655E+02_JPRB, &
191 & 2.2834E+02_JPRB, 2.3113E+02_JPRB, 2.3401E+02_JPRB, 2.3703E+02_JPRB, 2.4022E+02_JPRB, &
192 & 2.4371E+02_JPRB, 2.4726E+02_JPRB, 2.5085E+02_JPRB, 2.5457E+02_JPRB, 2.5832E+02_JPRB, &
193 & 2.6216E+02_JPRB, 2.6606E+02_JPRB, 2.6999E+02_JPRB, 2.7340E+02_JPRB, 2.7536E+02_JPRB, &
194 & 2.7568E+02_JPRB, 2.7372E+02_JPRB, 2.7163E+02_JPRB, 2.6955E+02_JPRB, 2.6593E+02_JPRB, &
195 & 2.6211E+02_JPRB, 2.5828E+02_JPRB, 2.5360E+02_JPRB, 2.4854E+02_JPRB, 2.4348E+02_JPRB,  &
196 & 2.3809E+02_JPRB, 2.3206E+02_JPRB, 2.2603E+02_JPRB, 2.2000E+02_JPRB, 2.1435E+02_JPRB, &
197 & 2.0887E+02_JPRB, 2.0340E+02_JPRB, 1.9792E+02_JPRB, 1.9290E+02_JPRB, 1.8809E+02_JPRB, &
198 & 1.8329E+02_JPRB, 1.7849E+02_JPRB, 1.7394E+02_JPRB, 1.7212E+02_JPRB /) 
199
200!     -----------------------------------------------------------------
201IF (LHOOK) CALL DR_HOOK('SUSRTM',1,ZHOOK_HANDLE)
202END SUBROUTINE SUSRTM
203
Note: See TracBrowser for help on using the repository browser.