LMDZ
susrtm.F90
Go to the documentation of this file.
1 SUBROUTINE 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 
9 USE parkind1 ,ONLY : jprb
10 USE yomhook ,ONLY : lhook, dr_hook
11 
12 USE yoesrtwn , ONLY : ng , nspa, nspb , nmpsrtm, &
13  & wavenum1, wavenum2, delwave, pref, preflog, tref , &
14  & ngm , wt , ngc , ngs , ngn , ngbsw
15 
16 ! ------------------------------------------------------------------
17 
18 IMPLICIT NONE
19 REAL(KIND=JPRB) :: ZHOOK_HANDLE
20 IF (lhook) CALL dr_hook('SUSRTM',0,zhook_handle)
21 ng(:) =(/ 16,16,16,16,16,16,16,16,16,16,16,16,16,16 /)
22 nspa(:) =(/ 9, 9, 9, 9, 1, 9, 9, 1, 9, 1, 0, 1, 9, 1 /)
23 nspb(:) =(/ 1, 5, 1, 1, 1, 5, 1, 0, 1, 0, 0, 1, 5, 1 /)
24 nmpsrtm(:)=(/ 6, 6, 5, 5, 5, 5, 5, 4, 4, 3, 2, 2, 1, 6 /)
25 
26 wavenum1( :) = (/&
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 /)
29 wavenum2( :) = (/&
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 /)
32 delwave( :) = (/&
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.
42 !
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)
54 ngc(:) = (/ 6,12, 8, 8,10,10, 2,10, 8, 6, 6, 8, 6,12 /)
55 ngs(:) = (/ 6,18,26,34,44,54,56,66,74,80,86,94,100,112 /)
56 ngm(:) = (/ 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
70 ngn(:) = (/ 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
84 ngbsw(:)=(/ 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 
146 wt(:) = (/ 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.
158 pref = (/ &
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 /)
171 preflog = (/ &
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.
186 tref = (/ &
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 ! -----------------------------------------------------------------
201 IF (lhook) CALL dr_hook('SUSRTM',1,zhook_handle)
202 END SUBROUTINE susrtm
203 
yoesrtwn::ngs
integer(kind=jpim), dimension(14) ngs
Definition: yoesrtwn.F90:25
yoesrtwn::ngn
integer(kind=jpim), dimension(112) ngn
Definition: yoesrtwn.F90:27
yoesrtwn::ngm
integer(kind=jpim), dimension(224) ngm
Definition: yoesrtwn.F90:24
yoesrtwn::wt
real(kind=jprb), dimension(16) wt
Definition: yoesrtwn.F90:31
yoesrtwn::wavenum1
real(kind=jprb), dimension(16:29) wavenum1
Definition: yoesrtwn.F90:16
yoesrtwn::pref
real(kind=jprb), dimension(59) pref
Definition: yoesrtwn.F90:20
yoesrtwn::wavenum2
real(kind=jprb), dimension(16:29) wavenum2
Definition: yoesrtwn.F90:17
yoesrtwn::preflog
real(kind=jprb), dimension(59) preflog
Definition: yoesrtwn.F90:21
yoesrtwn::tref
real(kind=jprb), dimension(59) tref
Definition: yoesrtwn.F90:22
yoesrtwn::nspa
integer(kind=jpim), dimension(16:29) nspa
Definition: yoesrtwn.F90:12
parkind1::jprb
integer, parameter jprb
Definition: parkind1.F90:31
yoesrtwn::ngbsw
integer(kind=jpim), dimension(112) ngbsw
Definition: yoesrtwn.F90:27
yoesrtwn::nspb
integer(kind=jpim), dimension(16:29) nspb
Definition: yoesrtwn.F90:13
yoesrtwn::nmpsrtm
integer(kind=jpim), dimension(14) nmpsrtm
Definition: yoesrtwn.F90:14
yoesrtwn::delwave
real(kind=jprb), dimension(16:29) delwave
Definition: yoesrtwn.F90:18
yomhook::lhook
logical lhook
Definition: yomhook.F90:12
susrtm
subroutine susrtm
Definition: susrtm.F90:2
yomhook::dr_hook
subroutine dr_hook(CDNAME, KSWITCH, PKEY)
Definition: yomhook.F90:17
yoesrtwn::ng
integer(kind=jpim), dimension(16:29) ng
Definition: yoesrtwn.F90:11
yoesrtwn::ngc
integer(kind=jpim), dimension(14) ngc
Definition: yoesrtwn.F90:25