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 |
|
|
|