1 | SUBROUTINE SRTM_KGB21 |
---|
2 | |
---|
3 | ! Originally by J.Delamere, Atmospheric & Environmental Research. |
---|
4 | ! Revision: 2.4 |
---|
5 | ! BAND 21: 6150-7700 cm-1 (low - H2O,CO2; high - H2O,CO2) |
---|
6 | ! Reformatted for F90 by JJMorcrette, ECMWF |
---|
7 | ! R. Elkhatib 12-10-2005 Split for faster and more robust compilation. |
---|
8 | ! G.Mozdzynski March 2011 read constants from files |
---|
9 | ! T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring. |
---|
10 | ! ------------------------------------------------------------------ |
---|
11 | |
---|
12 | USE PARKIND1 , ONLY : JPRB |
---|
13 | USE YOMHOOK , ONLY : LHOOK, DR_HOOK |
---|
14 | USE YOMLUN , ONLY : NULRAD |
---|
15 | USE YOMMP0 , ONLY : NPROC, MYPROC |
---|
16 | USE MPL_MODULE, ONLY : MPL_BROADCAST |
---|
17 | USE YOMTAG , ONLY : MTAGRAD |
---|
18 | USE YOESRTA21 , ONLY : KA, KB, KA_D, KB_D, SELFREF, FORREF, SFLUXREF, RAYL, STRRAT, LAYREFFR |
---|
19 | |
---|
20 | ! ------------------------------------------------------------------ |
---|
21 | |
---|
22 | IMPLICIT NONE |
---|
23 | |
---|
24 | ! KURUCZ |
---|
25 | REAL(KIND=JPRB) :: ZHOOK_HANDLE |
---|
26 | |
---|
27 | #include "abor1.intfb.h" |
---|
28 | |
---|
29 | IF (LHOOK) CALL DR_HOOK('SRTM_KGB21',0,ZHOOK_HANDLE) |
---|
30 | |
---|
31 | IF( MYPROC==1 )THEN |
---|
32 | READ(NULRAD,ERR=1001) KA_D,KB_D |
---|
33 | KA = REAL(KA_D,JPRB) |
---|
34 | KB = REAL(KB_D,JPRB) |
---|
35 | ENDIF |
---|
36 | IF( NPROC>1 )THEN |
---|
37 | CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB21:') |
---|
38 | CALL MPL_BROADCAST (KB,MTAGRAD,1,CDSTRING='SRTM_KGB21:') |
---|
39 | ENDIF |
---|
40 | |
---|
41 | SFLUXREF(:, 1) = (/ & |
---|
42 | & 16.1643_JPRB , 15.5806_JPRB, 14.7254_JPRB , 13.5541_JPRB , & |
---|
43 | & 11.9519_JPRB ,10.44410_JPRB, 8.37884_JPRB , 6.26384_JPRB , & |
---|
44 | & 4.28435_JPRB ,0.465228_JPRB, 0.385095_JPRB ,0.304226_JPRB , & |
---|
45 | & 0.222479_JPRB,0.143286_JPRB, 5.58046E-02_JPRB, 7.84856E-03_JPRB /) |
---|
46 | SFLUXREF(:, 2) = (/ & |
---|
47 | & 15.6451_JPRB , 15.3170_JPRB, 14.6987_JPRB , 13.7350_JPRB , & |
---|
48 | & 12.2267_JPRB ,10.51646_JPRB, 8.47150_JPRB , 6.38873_JPRB , & |
---|
49 | & 4.33536_JPRB ,0.470610_JPRB,0.389426_JPRB ,0.306461_JPRB , & |
---|
50 | & 0.223537_JPRB,0.143273_JPRB, 5.58179E-02_JPRB, 7.84856E-03_JPRB /) |
---|
51 | SFLUXREF(:, 3) = (/ & |
---|
52 | & 15.6092_JPRB , 15.3293_JPRB, 14.6881_JPRB , 13.6693_JPRB , & |
---|
53 | & 12.2342_JPRB ,10.52010_JPRB, 8.49442_JPRB , 6.42138_JPRB , & |
---|
54 | & 4.35865_JPRB ,0.473349_JPRB,0.391349_JPRB ,0.308861_JPRB , & |
---|
55 | & 0.224666_JPRB,0.144799_JPRB, 5.58176E-02_JPRB, 7.84881E-03_JPRB /) |
---|
56 | SFLUXREF(:, 4) = (/ & |
---|
57 | & 15.5786_JPRB , 15.3422_JPRB, 14.6894_JPRB , 13.6040_JPRB , & |
---|
58 | & 12.2567_JPRB ,10.49400_JPRB, 8.53521_JPRB , 6.44427_JPRB , & |
---|
59 | & 4.37208_JPRB ,0.475709_JPRB,0.392956_JPRB ,0.309737_JPRB , & |
---|
60 | & 0.226274_JPRB,0.146483_JPRB, 5.59325E-02_JPRB, 7.84881E-03_JPRB /) |
---|
61 | SFLUXREF(:, 5) = (/ & |
---|
62 | & 15.5380_JPRB , 15.3826_JPRB, 14.6575_JPRB , 13.5722_JPRB , & |
---|
63 | & 12.2646_JPRB ,10.47672_JPRB, 8.57158_JPRB , 6.46343_JPRB , & |
---|
64 | & 4.38259_JPRB ,0.477647_JPRB,0.393982_JPRB ,0.310686_JPRB , & |
---|
65 | & 0.227620_JPRB,0.148376_JPRB, 5.60398E-02_JPRB, 7.83925E-03_JPRB /) |
---|
66 | SFLUXREF(:, 6) = (/ & |
---|
67 | & 15.5124_JPRB , 15.3986_JPRB, 14.6240_JPRB , 13.5535_JPRB , & |
---|
68 | & 12.2468_JPRB ,10.48891_JPRB, 8.60434_JPRB , 6.47985_JPRB , & |
---|
69 | & 4.39448_JPRB ,0.478267_JPRB,0.395618_JPRB ,0.311043_JPRB , & |
---|
70 | & 0.230927_JPRB,0.148774_JPRB, 5.61189E-02_JPRB, 7.83925E-03_JPRB /) |
---|
71 | SFLUXREF(:, 7) = (/ & |
---|
72 | & 15.4910_JPRB , 15.4028_JPRB, 14.5772_JPRB , 13.5507_JPRB , & |
---|
73 | & 12.2122_JPRB ,10.52735_JPRB, 8.62650_JPRB , 6.49644_JPRB , & |
---|
74 | & 4.41173_JPRB ,0.478627_JPRB,0.396433_JPRB ,0.314199_JPRB , & |
---|
75 | & 0.233125_JPRB,0.149052_JPRB, 5.62309E-02_JPRB, 7.83925E-03_JPRB /) |
---|
76 | SFLUXREF(:, 8) = (/ & |
---|
77 | & 15.4562_JPRB , 15.3928_JPRB, 14.5510_JPRB , 13.5122_JPRB , & |
---|
78 | & 12.1890_JPRB , 10.5826_JPRB, 8.65842_JPRB , 6.51558_JPRB , & |
---|
79 | & 4.42747_JPRB ,0.480669_JPRB,0.400143_JPRB ,0.318144_JPRB , & |
---|
80 | & 0.233937_JPRB,0.149119_JPRB, 5.62309E-02_JPRB, 7.83925E-03_JPRB /) |
---|
81 | SFLUXREF(:, 9) = (/ & |
---|
82 | & 15.0069_JPRB , 15.1479_JPRB, 14.7802_JPRB , 13.6085_JPRB , & |
---|
83 | & 12.2793_JPRB , 10.6929_JPRB, 8.72723_JPRB , 6.57114_JPRB , & |
---|
84 | & 4.46330_JPRB ,0.486724_JPRB,0.401446_JPRB ,0.318879_JPRB , & |
---|
85 | & 0.233959_JPRB,0.149119_JPRB, 5.62309E-02_JPRB, 7.83925E-03_JPRB /) |
---|
86 | |
---|
87 | ! Rayleigh extinction coefficient at v = 6925 cm-1. |
---|
88 | RAYL = 9.41E-09_JPRB |
---|
89 | |
---|
90 | STRRAT = 0.0045321_JPRB |
---|
91 | |
---|
92 | LAYREFFR = 8 |
---|
93 | |
---|
94 | ! ------------------------------------------------------------------ |
---|
95 | |
---|
96 | ! The array KA contains absorption coefs at the 16 chosen g-values |
---|
97 | ! for a range of pressure levels> ~100mb, temperatures, and binary |
---|
98 | ! species parameters (see taumol.f for definition). The first |
---|
99 | ! index in the array, JS, runs from 1 to 9, and corresponds to |
---|
100 | ! different values of the binary species parameter. For instance, |
---|
101 | ! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, |
---|
102 | ! JS = 3 corresponds to the parameter value 2/8, etc. The second index |
---|
103 | ! in the array, JT, which runs from 1 to 5, corresponds to different |
---|
104 | ! temperatures. More specifically, JT = 3 means that the data are for |
---|
105 | ! the reference temperature TREF for this pressure level, JT = 2 refers |
---|
106 | ! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 |
---|
107 | ! is for TREF+30. The third index, JP, runs from 1 to 13 and refers |
---|
108 | ! to the JPth reference pressure level (see taumol.f for these levels |
---|
109 | ! in mb). The fourth index, IG, goes from 1 to 16, and indicates |
---|
110 | ! which g-interval the absorption coefficients are for. |
---|
111 | ! ----------------------------------------------------------------- |
---|
112 | |
---|
113 | ! ----------------------------------------------------------------- |
---|
114 | ! The array KB contains absorption coefs at the 16 chosen g-values |
---|
115 | ! for a range of pressure levels < ~100mb and temperatures. The first |
---|
116 | ! index in the array, JT, which runs from 1 to 5, corresponds to |
---|
117 | ! different temperatures. More specifically, JT = 3 means that the |
---|
118 | ! data are for the reference temperature TREF for this pressure |
---|
119 | ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for |
---|
120 | ! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. |
---|
121 | ! The second index, JP, runs from 13 to 59 and refers to the JPth |
---|
122 | ! reference pressure level (see taumol.f for the value of these |
---|
123 | ! pressure levels in mb). The third index, IG, goes from 1 to 16, |
---|
124 | ! and tells us which g-interval the absorption coefficients are for. |
---|
125 | ! ----------------------------------------------------------------- |
---|
126 | |
---|
127 | |
---|
128 | FORREF(:, 1) = (/ 0.110008E-06_JPRB, 0.630912E-06_JPRB, 0.363159E-05_JPRB, 0.616892E-05_JPRB /) |
---|
129 | FORREF(:, 2) = (/ 0.429709E-05_JPRB, 0.789174E-05_JPRB, 0.217416E-04_JPRB, 0.639393E-04_JPRB /) |
---|
130 | FORREF(:, 3) = (/ 0.436283E-04_JPRB, 0.526247E-04_JPRB, 0.116341E-03_JPRB, 0.205616E-03_JPRB /) |
---|
131 | FORREF(:, 4) = (/ 0.215627E-03_JPRB, 0.234522E-03_JPRB, 0.280497E-03_JPRB, 0.838668E-03_JPRB /) |
---|
132 | FORREF(:, 5) = (/ 0.529283E-03_JPRB, 0.620848E-03_JPRB, 0.935561E-03_JPRB, 0.171252E-02_JPRB /) |
---|
133 | FORREF(:, 6) = (/ 0.212267E-02_JPRB, 0.218564E-02_JPRB, 0.222227E-02_JPRB, 0.199650E-02_JPRB /) |
---|
134 | FORREF(:, 7) = (/ 0.291120E-02_JPRB, 0.281168E-02_JPRB, 0.259543E-02_JPRB, 0.210159E-02_JPRB /) |
---|
135 | FORREF(:, 8) = (/ 0.316249E-02_JPRB, 0.310695E-02_JPRB, 0.279501E-02_JPRB, 0.208076E-02_JPRB /) |
---|
136 | FORREF(:, 9) = (/ 0.354993E-02_JPRB, 0.336989E-02_JPRB, 0.298930E-02_JPRB, 0.180424E-02_JPRB /) |
---|
137 | FORREF(:,10) = (/ 0.397729E-02_JPRB, 0.367409E-02_JPRB, 0.328982E-02_JPRB, 0.177807E-02_JPRB /) |
---|
138 | FORREF(:,11) = (/ 0.408831E-02_JPRB, 0.398792E-02_JPRB, 0.352727E-02_JPRB, 0.192470E-02_JPRB /) |
---|
139 | FORREF(:,12) = (/ 0.433926E-02_JPRB, 0.420667E-02_JPRB, 0.383894E-02_JPRB, 0.220836E-02_JPRB /) |
---|
140 | FORREF(:,13) = (/ 0.436397E-02_JPRB, 0.433769E-02_JPRB, 0.425752E-02_JPRB, 0.237343E-02_JPRB /) |
---|
141 | FORREF(:,14) = (/ 0.440525E-02_JPRB, 0.449018E-02_JPRB, 0.451881E-02_JPRB, 0.269169E-02_JPRB /) |
---|
142 | FORREF(:,15) = (/ 0.491350E-02_JPRB, 0.481760E-02_JPRB, 0.475799E-02_JPRB, 0.362666E-02_JPRB /) |
---|
143 | FORREF(:,16) = (/ 0.561641E-02_JPRB, 0.524553E-02_JPRB, 0.512473E-02_JPRB, 0.493802E-02_JPRB /) |
---|
144 | |
---|
145 | ! ----------------------------------------------------------------- |
---|
146 | ! The array SELFREF contains the coefficient of the water vapor |
---|
147 | ! self-continuum (including the energy term). The first index |
---|
148 | ! refers to temperature in 7.2 degree increments. For instance, |
---|
149 | ! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, |
---|
150 | ! etc. The second index runs over the g-channel (1 to 16). |
---|
151 | |
---|
152 | SELFREF(:, 1) = (/ & |
---|
153 | & 0.115887E-03_JPRB, 0.926537E-04_JPRB, 0.740783E-04_JPRB, 0.592270E-04_JPRB, 0.473530E-04_JPRB, & |
---|
154 | & 0.378596E-04_JPRB, 0.302694E-04_JPRB, 0.242010E-04_JPRB, 0.193491E-04_JPRB, 0.154700E-04_JPRB /) |
---|
155 | SELFREF(:, 2) = (/ & |
---|
156 | & 0.459557E-03_JPRB, 0.381962E-03_JPRB, 0.317469E-03_JPRB, 0.263866E-03_JPRB, 0.219313E-03_JPRB, & |
---|
157 | & 0.182283E-03_JPRB, 0.151505E-03_JPRB, 0.125924E-03_JPRB, 0.104662E-03_JPRB, 0.869904E-04_JPRB /) |
---|
158 | SELFREF(:, 3) = (/ & |
---|
159 | & 0.166821E-02_JPRB, 0.151103E-02_JPRB, 0.136866E-02_JPRB, 0.123970E-02_JPRB, 0.112290E-02_JPRB, & |
---|
160 | & 0.101710E-02_JPRB, 0.921266E-03_JPRB, 0.834463E-03_JPRB, 0.755839E-03_JPRB, 0.684623E-03_JPRB /) |
---|
161 | SELFREF(:, 4) = (/ & |
---|
162 | & 0.460175E-02_JPRB, 0.421372E-02_JPRB, 0.385842E-02_JPRB, 0.353307E-02_JPRB, 0.323516E-02_JPRB, & |
---|
163 | & 0.296236E-02_JPRB, 0.271257E-02_JPRB, 0.248385E-02_JPRB, 0.227440E-02_JPRB, 0.208262E-02_JPRB /) |
---|
164 | SELFREF(:, 5) = (/ & |
---|
165 | & 0.101589E-01_JPRB, 0.924742E-02_JPRB, 0.841772E-02_JPRB, 0.766247E-02_JPRB, 0.697497E-02_JPRB, & |
---|
166 | & 0.634917E-02_JPRB, 0.577951E-02_JPRB, 0.526096E-02_JPRB, 0.478893E-02_JPRB, 0.435926E-02_JPRB /) |
---|
167 | SELFREF(:, 6) = (/ & |
---|
168 | & 0.328043E-01_JPRB, 0.300853E-01_JPRB, 0.275917E-01_JPRB, 0.253048E-01_JPRB, 0.232075E-01_JPRB, & |
---|
169 | & 0.212839E-01_JPRB, 0.195198E-01_JPRB, 0.179020E-01_JPRB, 0.164182E-01_JPRB, 0.150574E-01_JPRB /) |
---|
170 | SELFREF(:, 7) = (/ & |
---|
171 | & 0.405936E-01_JPRB, 0.376032E-01_JPRB, 0.348331E-01_JPRB, 0.322671E-01_JPRB, 0.298901E-01_JPRB, & |
---|
172 | & 0.276883E-01_JPRB, 0.256486E-01_JPRB, 0.237591E-01_JPRB, 0.220089E-01_JPRB, 0.203876E-01_JPRB /) |
---|
173 | SELFREF(:, 8) = (/ & |
---|
174 | & 0.448362E-01_JPRB, 0.413811E-01_JPRB, 0.381923E-01_JPRB, 0.352492E-01_JPRB, 0.325329E-01_JPRB, & |
---|
175 | & 0.300259E-01_JPRB, 0.277121E-01_JPRB, 0.255766E-01_JPRB, 0.236056E-01_JPRB, 0.217866E-01_JPRB /) |
---|
176 | SELFREF(:, 9) = (/ & |
---|
177 | & 0.479741E-01_JPRB, 0.445389E-01_JPRB, 0.413497E-01_JPRB, 0.383889E-01_JPRB, 0.356400E-01_JPRB, & |
---|
178 | & 0.330880E-01_JPRB, 0.307188E-01_JPRB, 0.285191E-01_JPRB, 0.264770E-01_JPRB, 0.245812E-01_JPRB /) |
---|
179 | SELFREF(:,10) = (/ & |
---|
180 | & 0.519308E-01_JPRB, 0.484130E-01_JPRB, 0.451335E-01_JPRB, 0.420761E-01_JPRB, 0.392259E-01_JPRB, & |
---|
181 | & 0.365687E-01_JPRB, 0.340916E-01_JPRB, 0.317822E-01_JPRB, 0.296293E-01_JPRB, 0.276222E-01_JPRB /) |
---|
182 | SELFREF(:,11) = (/ & |
---|
183 | & 0.572039E-01_JPRB, 0.527780E-01_JPRB, 0.486945E-01_JPRB, 0.449270E-01_JPRB, 0.414510E-01_JPRB, & |
---|
184 | & 0.382439E-01_JPRB, 0.352849E-01_JPRB, 0.325549E-01_JPRB, 0.300361E-01_JPRB, 0.277122E-01_JPRB /) |
---|
185 | SELFREF(:,12) = (/ & |
---|
186 | & 0.601046E-01_JPRB, 0.554411E-01_JPRB, 0.511395E-01_JPRB, 0.471716E-01_JPRB, 0.435116E-01_JPRB, & |
---|
187 | & 0.401356E-01_JPRB, 0.370215E-01_JPRB, 0.341490E-01_JPRB, 0.314994E-01_JPRB, 0.290554E-01_JPRB /) |
---|
188 | SELFREF(:,13) = (/ & |
---|
189 | & 0.616595E-01_JPRB, 0.567145E-01_JPRB, 0.521662E-01_JPRB, 0.479826E-01_JPRB, 0.441346E-01_JPRB, & |
---|
190 | & 0.405951E-01_JPRB, 0.373395E-01_JPRB, 0.343450E-01_JPRB, 0.315906E-01_JPRB, 0.290571E-01_JPRB /) |
---|
191 | SELFREF(:,14) = (/ & |
---|
192 | & 0.647916E-01_JPRB, 0.592493E-01_JPRB, 0.541811E-01_JPRB, 0.495465E-01_JPRB, 0.453083E-01_JPRB, & |
---|
193 | & 0.414326E-01_JPRB, 0.378885E-01_JPRB, 0.346475E-01_JPRB, 0.316837E-01_JPRB, 0.289735E-01_JPRB /) |
---|
194 | SELFREF(:,15) = (/ & |
---|
195 | & 0.694231E-01_JPRB, 0.637703E-01_JPRB, 0.585777E-01_JPRB, 0.538079E-01_JPRB, 0.494265E-01_JPRB, & |
---|
196 | & 0.454019E-01_JPRB, 0.417050E-01_JPRB, 0.383091E-01_JPRB, 0.351897E-01_JPRB, 0.323244E-01_JPRB /) |
---|
197 | SELFREF(:,16) = (/ & |
---|
198 | & 0.761764E-01_JPRB, 0.701815E-01_JPRB, 0.646584E-01_JPRB, 0.595700E-01_JPRB, 0.548820E-01_JPRB, & |
---|
199 | & 0.505629E-01_JPRB, 0.465838E-01_JPRB, 0.429178E-01_JPRB, 0.395403E-01_JPRB, 0.364286E-01_JPRB /) |
---|
200 | |
---|
201 | IF (LHOOK) CALL DR_HOOK('SRTM_KGB21',1,ZHOOK_HANDLE) |
---|
202 | RETURN |
---|
203 | |
---|
204 | 1001 CONTINUE |
---|
205 | CALL ABOR1("SRTM_KGB21:ERROR READING FILE RADSRTM") |
---|
206 | |
---|
207 | END SUBROUTINE SRTM_KGB21 |
---|