Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 : ! **************************************************************************************************
8 : !> \brief routines to contract density matrix blocks with the for center
9 : !> integrals to yield the Kohn-Sham matrix. The specialized routines
10 : !> are about 1.2-2.0 as fast as the default one.
11 : !> \par History
12 : !> 10.2009 created [Joost VandeVondele]
13 : !> \author Joost VandeVondele
14 : ! **************************************************************************************************
15 : MODULE hfx_contract_block
16 : USE kinds, ONLY: dp
17 : #include "../base/base_uses.f90"
18 :
19 : IMPLICIT NONE
20 : PRIVATE
21 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'hfx_contract_block'
22 : PUBLIC :: contract_block
23 : CONTAINS
24 : ! **************************************************************************************************
25 : !> \brief ...
26 : !> \param ma_max ...
27 : !> \param mb_max ...
28 : !> \param mc_max ...
29 : !> \param md_max ...
30 : !> \param kbd ...
31 : !> \param kbc ...
32 : !> \param kad ...
33 : !> \param kac ...
34 : !> \param pbd ...
35 : !> \param pbc ...
36 : !> \param pad ...
37 : !> \param pac ...
38 : !> \param prim ...
39 : !> \param scale ...
40 : ! **************************************************************************************************
41 71555570 : SUBROUTINE contract_block(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
42 : INTEGER :: ma_max, mb_max, mc_max, md_max
43 : REAL(KIND=dp) :: kbd(mb_max*md_max), kbc(mb_max*mc_max), &
44 : kad(ma_max*md_max), kac(ma_max*mc_max), pbd(mb_max*md_max), &
45 : pbc(mb_max*mc_max), pad(ma_max*md_max), pac(ma_max*mc_max), &
46 : prim(ma_max*mb_max*mc_max*md_max), scale
47 :
48 : #if !defined (__LIBINT)
49 : MARK_USED(ma_max)
50 : MARK_USED(mb_max)
51 : MARK_USED(mc_max)
52 : MARK_USED(md_max)
53 : MARK_USED(kbd)
54 : MARK_USED(kbc)
55 : MARK_USED(kad)
56 : MARK_USED(kac)
57 : MARK_USED(pbd)
58 : MARK_USED(pbc)
59 : MARK_USED(pad)
60 : MARK_USED(pac)
61 : MARK_USED(prim)
62 : MARK_USED(scale)
63 : CPABORT("libint not compiled in")
64 : #else
65 41028923 : SELECT CASE (ma_max)
66 : CASE (1)
67 32700310 : SELECT CASE (mb_max)
68 : CASE (1)
69 16970976 : SELECT CASE (mc_max)
70 : CASE (1)
71 12232299 : SELECT CASE (md_max)
72 : CASE (1)
73 12148798 : CALL block_1_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
74 : CASE (2)
75 10391 : CALL block_1_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
76 : CASE (3)
77 4424082 : CALL block_1_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
78 : CASE (4)
79 156602 : CALL block_1_1_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
80 : CASE (5)
81 177061 : CALL block_1_1_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
82 : CASE (6)
83 11 : CALL block_1_1_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
84 : CASE (7)
85 23226 : CALL block_1_1_1_7(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
86 : CASE (9)
87 10 : CALL block_1_1_1_9(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
88 : CASE (10)
89 9 : CALL block_1_1_1_10(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
90 : CASE (11)
91 9 : CALL block_1_1_1_11(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
92 : CASE (15)
93 10 : CALL block_1_1_1_15(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
94 : CASE DEFAULT
95 16940209 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
96 : END SELECT
97 : CASE (2)
98 12576333 : SELECT CASE (md_max)
99 : CASE (1)
100 35441 : CALL block_1_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
101 : CASE (2)
102 5028 : CALL block_1_1_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
103 : CASE (3)
104 31999 : CALL block_1_1_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
105 : CASE (4)
106 7 : CALL block_1_1_2_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
107 : CASE (5)
108 10255 : CALL block_1_1_2_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
109 : CASE (6)
110 8 : CALL block_1_1_2_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
111 : CASE (7)
112 742 : CALL block_1_1_2_7(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
113 : CASE (9)
114 6 : CALL block_1_1_2_9(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
115 : CASE (10)
116 5 : CALL block_1_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
117 : CASE (11)
118 4 : CALL block_1_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
119 : CASE (15)
120 6 : CALL block_1_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
121 : CASE DEFAULT
122 83501 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
123 : END SELECT
124 : CASE (3)
125 9502612 : SELECT CASE (md_max)
126 : CASE (1)
127 8167181 : CALL block_1_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
128 : CASE (2)
129 15297 : CALL block_1_1_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
130 : CASE (3)
131 4168271 : CALL block_1_1_3_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
132 : CASE (4)
133 39352 : CALL block_1_1_3_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
134 : CASE (5)
135 126860 : CALL block_1_1_3_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
136 : CASE (6)
137 7 : CALL block_1_1_3_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
138 : CASE (7)
139 23902 : CALL block_1_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
140 : CASE (9)
141 6 : CALL block_1_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
142 : CASE (10)
143 6 : CALL block_1_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
144 : CASE (11)
145 5 : CALL block_1_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
146 : CASE (15)
147 5 : CALL block_1_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
148 : CASE DEFAULT
149 12540892 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
150 : END SELECT
151 : CASE (4)
152 1755323 : SELECT CASE (md_max)
153 : CASE (1)
154 650469 : CALL block_1_1_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
155 : CASE (2)
156 4 : CALL block_1_1_4_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
157 : CASE (3)
158 231050 : CALL block_1_1_4_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
159 : CASE (4)
160 320410 : CALL block_1_1_4_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
161 : CASE (5)
162 133210 : CALL block_1_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
163 : CASE (6)
164 7 : CALL block_1_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
165 : CASE (7)
166 264 : CALL block_1_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
167 : CASE (9)
168 5 : CALL block_1_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
169 : CASE (10)
170 5 : CALL block_1_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
171 : CASE (11)
172 3 : CALL block_1_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
173 : CASE (15)
174 4 : CALL block_1_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
175 : CASE DEFAULT
176 1335431 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
177 : END SELECT
178 : CASE (5)
179 547156 : SELECT CASE (md_max)
180 : CASE (1)
181 547129 : CALL block_1_1_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
182 : CASE (2)
183 10248 : CALL block_1_1_5_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
184 : CASE (3)
185 284627 : CALL block_1_1_5_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
186 : CASE (4)
187 132880 : CALL block_1_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
188 : CASE (5)
189 119198 : CALL block_1_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
190 : CASE (6)
191 6 : CALL block_1_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
192 : CASE (7)
193 10752 : CALL block_1_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
194 : CASE (9)
195 4 : CALL block_1_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
196 : CASE (10)
197 4 : CALL block_1_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
198 : CASE (11)
199 3 : CALL block_1_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
200 : CASE (15)
201 3 : CALL block_1_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
202 : CASE DEFAULT
203 1104854 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
204 : END SELECT
205 : CASE (6)
206 108102 : SELECT CASE (md_max)
207 : CASE (1)
208 5 : CALL block_1_1_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
209 : CASE (2)
210 1 : CALL block_1_1_6_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
211 : CASE (3)
212 1 : CALL block_1_1_6_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
213 : CASE (4)
214 1 : CALL block_1_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
215 : CASE (5)
216 1 : CALL block_1_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
217 : CASE (6)
218 6 : CALL block_1_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
219 : CASE (7)
220 2 : CALL block_1_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
221 : CASE (9)
222 2 : CALL block_1_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
223 : CASE (10)
224 3 : CALL block_1_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
225 : CASE (11)
226 2 : CALL block_1_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
227 : CASE (15)
228 3 : CALL block_1_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
229 : CASE DEFAULT
230 27 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
231 : END SELECT
232 : CASE (7)
233 55748 : SELECT CASE (md_max)
234 : CASE (1)
235 55680 : CALL block_1_1_7_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
236 : CASE (2)
237 737 : CALL block_1_1_7_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
238 : CASE (3)
239 34805 : CALL block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
240 : CASE (4)
241 259 : CALL block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
242 : CASE (5)
243 10841 : CALL block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
244 : CASE (6)
245 6 : CALL block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
246 : CASE (7)
247 5725 : CALL block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
248 : CASE (9)
249 12 : CALL block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
250 : CASE (10)
251 11 : CALL block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
252 : CASE (11)
253 11 : CALL block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
254 : CASE (15)
255 10 : CALL block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
256 : CASE DEFAULT
257 108097 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
258 : END SELECT
259 : CASE (9)
260 65 : SELECT CASE (md_max)
261 : CASE (1)
262 10 : CALL block_1_1_9_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
263 : CASE (2)
264 1 : CALL block_1_1_9_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
265 : CASE (3)
266 1 : CALL block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
267 : CASE (4)
268 1 : CALL block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
269 : CASE (5)
270 4 : CALL block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
271 : CASE (6)
272 3 : CALL block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
273 : CASE (7)
274 5 : CALL block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
275 : CASE (9)
276 14 : CALL block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
277 : CASE (10)
278 10 : CALL block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
279 : CASE (11)
280 10 : CALL block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
281 : CASE (15)
282 9 : CALL block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
283 : CASE DEFAULT
284 68 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
285 : END SELECT
286 : CASE (10)
287 57 : SELECT CASE (md_max)
288 : CASE (1)
289 9 : CALL block_1_1_10_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
290 : CASE (2)
291 1 : CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
292 : CASE (3)
293 1 : CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
294 : CASE (4)
295 2 : CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
296 : CASE (5)
297 2 : CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
298 : CASE (6)
299 2 : CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
300 : CASE (7)
301 5 : CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
302 : CASE (9)
303 6 : CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
304 : CASE (10)
305 11 : CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
306 : CASE (11)
307 8 : CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
308 : CASE (15)
309 8 : CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
310 : CASE DEFAULT
311 55 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
312 : END SELECT
313 : CASE (11)
314 57 : SELECT CASE (md_max)
315 : CASE (1)
316 9 : CALL block_1_1_11_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
317 : CASE (2)
318 1 : CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
319 : CASE (3)
320 2 : CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
321 : CASE (4)
322 2 : CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
323 : CASE (5)
324 2 : CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
325 : CASE (6)
326 2 : CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
327 : CASE (7)
328 5 : CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
329 : CASE (9)
330 4 : CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
331 : CASE (10)
332 4 : CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
333 : CASE (11)
334 10 : CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
335 : CASE (15)
336 7 : CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
337 : CASE DEFAULT
338 48 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
339 : END SELECT
340 : CASE (15)
341 10 : SELECT CASE (md_max)
342 : CASE (1)
343 10 : CALL block_1_1_15_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
344 : CASE (2)
345 2 : CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
346 : CASE (3)
347 2 : CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
348 : CASE (4)
349 2 : CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
350 : CASE (5)
351 2 : CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
352 : CASE (6)
353 2 : CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
354 : CASE (7)
355 4 : CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
356 : CASE (9)
357 4 : CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
358 : CASE (10)
359 4 : CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
360 : CASE (11)
361 5 : CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
362 : CASE (15)
363 11 : CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
364 : CASE DEFAULT
365 48 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
366 : END SELECT
367 : CASE DEFAULT
368 32113230 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
369 : END SELECT
370 : CASE (2)
371 7921699 : SELECT CASE (mc_max)
372 : CASE (1)
373 4665 : SELECT CASE (md_max)
374 : CASE (1)
375 1810 : CALL block_1_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
376 : CASE (2)
377 706 : CALL block_1_2_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
378 : CASE (3)
379 2409 : CALL block_1_2_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
380 : CASE (4)
381 4 : CALL block_1_2_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
382 : CASE (5)
383 1708 : CALL block_1_2_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
384 : CASE (6)
385 4 : CALL block_1_2_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
386 : CASE (7)
387 713 : CALL block_1_2_1_7(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
388 : CASE (9)
389 1 : CALL block_1_2_1_9(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
390 : CASE (10)
391 1 : CALL block_1_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
392 : CASE (11)
393 1 : CALL block_1_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
394 : CASE (15)
395 1 : CALL block_1_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
396 : CASE DEFAULT
397 7358 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
398 : END SELECT
399 : CASE (2)
400 10887 : SELECT CASE (md_max)
401 : CASE (1)
402 698 : CALL block_1_2_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
403 : CASE (2)
404 307 : CALL block_1_2_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
405 : CASE (3)
406 941 : CALL block_1_2_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
407 : CASE (4)
408 3 : CALL block_1_2_2_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
409 : CASE (5)
410 655 : CALL block_1_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
411 : CASE (6)
412 3 : CALL block_1_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
413 : CASE (7)
414 248 : CALL block_1_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
415 : CASE (9)
416 0 : CALL block_1_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
417 : CASE (10)
418 0 : CALL block_1_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
419 : CASE (11)
420 0 : CALL block_1_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
421 : CASE (15)
422 0 : CALL block_1_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
423 : CASE DEFAULT
424 2855 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
425 : END SELECT
426 : CASE (3)
427 2418 : SELECT CASE (md_max)
428 : CASE (1)
429 2406 : CALL block_1_2_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
430 : CASE (2)
431 940 : CALL block_1_2_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
432 : CASE (3)
433 3509 : CALL block_1_2_3_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
434 : CASE (4)
435 4 : CALL block_1_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
436 : CASE (5)
437 2383 : CALL block_1_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
438 : CASE (6)
439 2 : CALL block_1_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
440 : CASE (7)
441 945 : CALL block_1_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
442 : CASE (9)
443 0 : CALL block_1_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
444 : CASE (10)
445 0 : CALL block_1_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
446 : CASE (11)
447 0 : CALL block_1_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
448 : CASE (15)
449 0 : CALL block_1_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
450 : CASE DEFAULT
451 10189 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
452 : END SELECT
453 : CASE (4)
454 7231 : SELECT CASE (md_max)
455 : CASE (1)
456 2 : CALL block_1_2_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
457 : CASE (2)
458 2 : CALL block_1_2_4_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
459 : CASE (3)
460 1 : CALL block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
461 : CASE (4)
462 4 : CALL block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
463 : CASE (5)
464 2 : CALL block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
465 : CASE (6)
466 1 : CALL block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
467 : CASE (7)
468 0 : CALL block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
469 : CASE (9)
470 0 : CALL block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
471 : CASE (10)
472 0 : CALL block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
473 : CASE (11)
474 0 : CALL block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
475 : CASE (15)
476 0 : CALL block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
477 : CASE DEFAULT
478 12 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
479 : END SELECT
480 : CASE (5)
481 1708 : SELECT CASE (md_max)
482 : CASE (1)
483 1705 : CALL block_1_2_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
484 : CASE (2)
485 653 : CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
486 : CASE (3)
487 2381 : CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
488 : CASE (4)
489 0 : CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
490 : CASE (5)
491 1785 : CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
492 : CASE (6)
493 1 : CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
494 : CASE (7)
495 704 : CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
496 : CASE (9)
497 0 : CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
498 : CASE (10)
499 0 : CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
500 : CASE (11)
501 0 : CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
502 : CASE (15)
503 0 : CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
504 : CASE DEFAULT
505 7229 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
506 : END SELECT
507 : CASE (6)
508 3098 : SELECT CASE (md_max)
509 : CASE (1)
510 1 : CALL block_1_2_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
511 : CASE (2)
512 1 : CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
513 : CASE (3)
514 0 : CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
515 : CASE (4)
516 0 : CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
517 : CASE (5)
518 0 : CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
519 : CASE (6)
520 1 : CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
521 : CASE (7)
522 0 : CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
523 : CASE (9)
524 0 : CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
525 : CASE (10)
526 0 : CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
527 : CASE (11)
528 0 : CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
529 : CASE (15)
530 0 : CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
531 : CASE DEFAULT
532 3 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
533 : END SELECT
534 : CASE (7)
535 715 : SELECT CASE (md_max)
536 : CASE (1)
537 712 : CALL block_1_2_7_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
538 : CASE (2)
539 248 : CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
540 : CASE (3)
541 944 : CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
542 : CASE (4)
543 0 : CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
544 : CASE (5)
545 704 : CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
546 : CASE (6)
547 0 : CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
548 : CASE (7)
549 489 : CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
550 : CASE (9)
551 0 : CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
552 : CASE (10)
553 0 : CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
554 : CASE (11)
555 0 : CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
556 : CASE (15)
557 0 : CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
558 : CASE DEFAULT
559 3097 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
560 : END SELECT
561 : CASE (9)
562 5 : SELECT CASE (md_max)
563 : CASE (1)
564 0 : CALL block_1_2_9_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
565 : CASE (2)
566 0 : CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
567 : CASE (3)
568 0 : CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
569 : CASE (4)
570 0 : CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
571 : CASE (5)
572 0 : CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
573 : CASE (6)
574 1 : CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
575 : CASE (7)
576 1 : CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
577 : CASE (9)
578 1 : CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
579 : CASE (10)
580 0 : CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
581 : CASE (11)
582 0 : CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
583 : CASE (15)
584 0 : CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
585 : CASE DEFAULT
586 3 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
587 : END SELECT
588 : CASE (10)
589 5 : CALL block_1_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
590 : CASE (11)
591 7 : CALL block_1_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
592 : CASE (15)
593 9 : CALL block_1_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
594 : CASE DEFAULT
595 30767 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
596 : END SELECT
597 : CASE (3)
598 4112292 : SELECT CASE (mc_max)
599 : CASE (1)
600 1942875 : SELECT CASE (md_max)
601 : CASE (1)
602 1881844 : CALL block_1_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
603 : CASE (2)
604 8131 : CALL block_1_3_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
605 : CASE (3)
606 1565118 : CALL block_1_3_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
607 : CASE (4)
608 51839 : CALL block_1_3_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
609 : CASE (5)
610 79587 : CALL block_1_3_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
611 : CASE (6)
612 4 : CALL block_1_3_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
613 : CASE (7)
614 11913 : CALL block_1_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
615 : CASE (9)
616 1 : CALL block_1_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
617 : CASE (10)
618 1 : CALL block_1_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
619 : CASE (11)
620 1 : CALL block_1_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
621 : CASE (15)
622 1 : CALL block_1_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
623 : CASE DEFAULT
624 3598440 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
625 : END SELECT
626 : CASE (2)
627 3193031 : SELECT CASE (md_max)
628 : CASE (1)
629 24830 : CALL block_1_3_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
630 : CASE (2)
631 3861 : CALL block_1_3_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
632 : CASE (3)
633 23255 : CALL block_1_3_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
634 : CASE (4)
635 3 : CALL block_1_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
636 : CASE (5)
637 8103 : CALL block_1_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
638 : CASE (6)
639 3 : CALL block_1_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
640 : CASE (7)
641 976 : CALL block_1_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
642 : CASE (9)
643 0 : CALL block_1_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
644 : CASE (10)
645 0 : CALL block_1_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
646 : CASE (11)
647 0 : CALL block_1_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
648 : CASE (15)
649 0 : CALL block_1_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
650 : CASE DEFAULT
651 61031 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
652 : END SELECT
653 : CASE (3)
654 2143636 : SELECT CASE (md_max)
655 : CASE (1)
656 1619394 : CALL block_1_3_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
657 : CASE (2)
658 12117 : CALL block_1_3_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
659 : CASE (3)
660 1443712 : CALL block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
661 : CASE (4)
662 15399 : CALL block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
663 : CASE (5)
664 64672 : CALL block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
665 : CASE (6)
666 3 : CALL block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
667 : CASE (7)
668 12904 : CALL block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
669 : CASE (9)
670 0 : CALL block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
671 : CASE (10)
672 0 : CALL block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
673 : CASE (11)
674 0 : CALL block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
675 : CASE (15)
676 0 : CALL block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
677 : CASE DEFAULT
678 3168201 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
679 : END SELECT
680 : CASE (4)
681 752594 : SELECT CASE (md_max)
682 : CASE (1)
683 241095 : CALL block_1_3_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
684 : CASE (2)
685 1 : CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
686 : CASE (3)
687 108607 : CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
688 : CASE (4)
689 116493 : CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
690 : CASE (5)
691 57936 : CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
692 : CASE (6)
693 2 : CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
694 : CASE (7)
695 108 : CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
696 : CASE (9)
697 0 : CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
698 : CASE (10)
699 0 : CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
700 : CASE (11)
701 0 : CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
702 : CASE (15)
703 0 : CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
704 : CASE DEFAULT
705 524242 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
706 : END SELECT
707 : CASE (5)
708 235273 : SELECT CASE (md_max)
709 : CASE (1)
710 235269 : CALL block_1_3_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
711 : CASE (2)
712 8101 : CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
713 : CASE (3)
714 144006 : CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
715 : CASE (4)
716 57694 : CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
717 : CASE (5)
718 59860 : CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
719 : CASE (6)
720 1 : CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
721 : CASE (7)
722 6568 : CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
723 : CASE (9)
724 0 : CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
725 : CASE (10)
726 0 : CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
727 : CASE (11)
728 0 : CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
729 : CASE (15)
730 0 : CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
731 : CASE DEFAULT
732 511499 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
733 : END SELECT
734 : CASE (6)
735 50905 : SELECT CASE (md_max)
736 : CASE (1)
737 1 : CALL block_1_3_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
738 : CASE (2)
739 1 : CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
740 : CASE (3)
741 1 : CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
742 : CASE (4)
743 0 : CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
744 : CASE (5)
745 0 : CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
746 : CASE (6)
747 1 : CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
748 : CASE (7)
749 0 : CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
750 : CASE (9)
751 0 : CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
752 : CASE (10)
753 0 : CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
754 : CASE (11)
755 0 : CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
756 : CASE (15)
757 0 : CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
758 : CASE DEFAULT
759 4 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
760 : END SELECT
761 : CASE (7)
762 50904 : CALL block_1_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
763 : CASE (9)
764 2 : CALL block_1_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
765 : CASE (10)
766 4 : CALL block_1_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
767 : CASE (11)
768 6 : CALL block_1_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
769 : CASE (15)
770 8 : CALL block_1_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
771 : CASE DEFAULT
772 7914341 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
773 : END SELECT
774 : CASE (4)
775 616904 : SELECT CASE (mc_max)
776 : CASE (1)
777 116020 : SELECT CASE (md_max)
778 : CASE (1)
779 115994 : CALL block_1_4_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
780 : CASE (2)
781 8 : CALL block_1_4_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
782 : CASE (3)
783 31019 : CALL block_1_4_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
784 : CASE (4)
785 59737 : CALL block_1_4_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
786 : CASE (5)
787 17373 : CALL block_1_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
788 : CASE (6)
789 4 : CALL block_1_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
790 : CASE (7)
791 97 : CALL block_1_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
792 : CASE (9)
793 1 : CALL block_1_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
794 : CASE (10)
795 1 : CALL block_1_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
796 : CASE (11)
797 1 : CALL block_1_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
798 : CASE (15)
799 1 : CALL block_1_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
800 : CASE DEFAULT
801 224236 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
802 : END SELECT
803 : CASE (2)
804 55914 : SELECT CASE (md_max)
805 : CASE (1)
806 2 : CALL block_1_4_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
807 : CASE (2)
808 8 : CALL block_1_4_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
809 : CASE (3)
810 7 : CALL block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
811 : CASE (4)
812 3 : CALL block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
813 : CASE (5)
814 3 : CALL block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
815 : CASE (6)
816 3 : CALL block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
817 : CASE (7)
818 0 : CALL block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
819 : CASE (9)
820 0 : CALL block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
821 : CASE (10)
822 0 : CALL block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
823 : CASE (11)
824 0 : CALL block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
825 : CASE (15)
826 0 : CALL block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
827 : CASE DEFAULT
828 26 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
829 : END SELECT
830 : CASE (3)
831 202626 : SELECT CASE (md_max)
832 : CASE (1)
833 27218 : CALL block_1_4_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
834 : CASE (2)
835 3 : CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
836 : CASE (3)
837 11767 : CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
838 : CASE (4)
839 11199 : CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
840 : CASE (5)
841 5722 : CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
842 : CASE (6)
843 3 : CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
844 : CASE (7)
845 0 : CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
846 : CASE (9)
847 0 : CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
848 : CASE (10)
849 0 : CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
850 : CASE (11)
851 0 : CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
852 : CASE (15)
853 0 : CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
854 : CASE DEFAULT
855 55912 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
856 : END SELECT
857 : CASE (4)
858 122875 : SELECT CASE (md_max)
859 : CASE (1)
860 65490 : CALL block_1_4_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
861 : CASE (2)
862 1 : CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
863 : CASE (3)
864 16561 : CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
865 : CASE (4)
866 76515 : CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
867 : CASE (5)
868 16454 : CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
869 : CASE (6)
870 3 : CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
871 : CASE (7)
872 384 : CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
873 : CASE (9)
874 0 : CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
875 : CASE (10)
876 0 : CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
877 : CASE (11)
878 0 : CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
879 : CASE (15)
880 0 : CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
881 : CASE DEFAULT
882 175408 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
883 : END SELECT
884 : CASE (5)
885 57385 : CALL block_1_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
886 : CASE (6)
887 5 : CALL block_1_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
888 : CASE (7)
889 864 : CALL block_1_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
890 : CASE (9)
891 1 : CALL block_1_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
892 : CASE (10)
893 3 : CALL block_1_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
894 : CASE (11)
895 5 : CALL block_1_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
896 : CASE (15)
897 7 : CALL block_1_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
898 : CASE DEFAULT
899 513852 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
900 : END SELECT
901 : CASE (5)
902 154086 : SELECT CASE (mc_max)
903 : CASE (1)
904 76834 : SELECT CASE (md_max)
905 : CASE (1)
906 69474 : CALL block_1_5_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
907 : CASE (2)
908 1713 : CALL block_1_5_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
909 : CASE (3)
910 40158 : CALL block_1_5_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
911 : CASE (4)
912 17390 : CALL block_1_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
913 : CASE (5)
914 21705 : CALL block_1_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
915 : CASE (6)
916 4 : CALL block_1_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
917 : CASE (7)
918 3442 : CALL block_1_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
919 : CASE (9)
920 2 : CALL block_1_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
921 : CASE (10)
922 1 : CALL block_1_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
923 : CASE (11)
924 1 : CALL block_1_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
925 : CASE (15)
926 1 : CALL block_1_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
927 : CASE DEFAULT
928 153891 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
929 : END SELECT
930 : CASE (2)
931 96588 : SELECT CASE (md_max)
932 : CASE (1)
933 1706 : CALL block_1_5_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
934 : CASE (2)
935 708 : CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
936 : CASE (3)
937 2403 : CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
938 : CASE (4)
939 7 : CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
940 : CASE (5)
941 1779 : CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
942 : CASE (6)
943 3 : CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
944 : CASE (7)
945 753 : CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
946 : CASE (9)
947 1 : CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
948 : CASE (10)
949 0 : CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
950 : CASE (11)
951 0 : CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
952 : CASE (15)
953 0 : CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
954 : CASE DEFAULT
955 7360 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
956 : END SELECT
957 : CASE (3)
958 94431 : SELECT CASE (md_max)
959 : CASE (1)
960 38151 : CALL block_1_5_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
961 : CASE (2)
962 2400 : CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
963 : CASE (3)
964 29227 : CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
965 : CASE (4)
966 5467 : CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
967 : CASE (5)
968 15503 : CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
969 : CASE (6)
970 4 : CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
971 : CASE (7)
972 4129 : CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
973 : CASE (9)
974 1 : CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
975 : CASE (10)
976 0 : CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
977 : CASE (11)
978 0 : CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
979 : CASE (15)
980 0 : CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
981 : CASE DEFAULT
982 94882 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
983 : END SELECT
984 : CASE (4)
985 56280 : CALL block_1_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
986 : CASE (5)
987 66691 : CALL block_1_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
988 : CASE (6)
989 7 : CALL block_1_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
990 : CASE (7)
991 13545 : CALL block_1_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
992 : CASE (9)
993 0 : CALL block_1_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
994 : CASE (10)
995 2 : CALL block_1_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
996 : CASE (11)
997 4 : CALL block_1_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
998 : CASE (15)
999 6 : CALL block_1_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1000 : CASE DEFAULT
1001 392668 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1002 : END SELECT
1003 : CASE (6)
1004 63177 : SELECT CASE (mc_max)
1005 : CASE (1)
1006 50 : SELECT CASE (md_max)
1007 : CASE (1)
1008 10 : CALL block_1_6_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1009 : CASE (2)
1010 9 : CALL block_1_6_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1011 : CASE (3)
1012 8 : CALL block_1_6_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1013 : CASE (4)
1014 8 : CALL block_1_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1015 : CASE (5)
1016 9 : CALL block_1_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1017 : CASE (6)
1018 10 : CALL block_1_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1019 : CASE (7)
1020 3 : CALL block_1_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1021 : CASE (9)
1022 2 : CALL block_1_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1023 : CASE (10)
1024 1 : CALL block_1_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1025 : CASE (11)
1026 1 : CALL block_1_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1027 : CASE (15)
1028 1 : CALL block_1_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1029 : CASE DEFAULT
1030 62 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1031 : END SELECT
1032 : CASE (2)
1033 40 : SELECT CASE (md_max)
1034 : CASE (1)
1035 2 : CALL block_1_6_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1036 : CASE (2)
1037 9 : CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1038 : CASE (3)
1039 7 : CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1040 : CASE (4)
1041 8 : CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1042 : CASE (5)
1043 9 : CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1044 : CASE (6)
1045 3 : CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1046 : CASE (7)
1047 1 : CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1048 : CASE (9)
1049 1 : CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1050 : CASE (10)
1051 0 : CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1052 : CASE (11)
1053 0 : CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1054 : CASE (15)
1055 0 : CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1056 : CASE DEFAULT
1057 40 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1058 : END SELECT
1059 : CASE (3)
1060 25 : SELECT CASE (md_max)
1061 : CASE (1)
1062 3 : CALL block_1_6_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1063 : CASE (2)
1064 4 : CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1065 : CASE (3)
1066 9 : CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1067 : CASE (4)
1068 9 : CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1069 : CASE (5)
1070 5 : CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1071 : CASE (6)
1072 4 : CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1073 : CASE (7)
1074 2 : CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1075 : CASE (9)
1076 1 : CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1077 : CASE (10)
1078 0 : CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1079 : CASE (11)
1080 0 : CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1081 : CASE (15)
1082 1 : CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1083 : CASE DEFAULT
1084 38 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1085 : END SELECT
1086 : CASE (4)
1087 22 : CALL block_1_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1088 : CASE (5)
1089 13 : CALL block_1_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1090 : CASE (6)
1091 9 : CALL block_1_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1092 : CASE (7)
1093 2 : CALL block_1_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1094 : CASE (9)
1095 0 : CALL block_1_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1096 : CASE (10)
1097 1 : CALL block_1_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1098 : CASE (11)
1099 3 : CALL block_1_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1100 : CASE (15)
1101 5 : CALL block_1_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1102 : CASE DEFAULT
1103 195 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1104 : END SELECT
1105 : CASE (7)
1106 17580 : SELECT CASE (mc_max)
1107 : CASE (1)
1108 8341 : SELECT CASE (md_max)
1109 : CASE (1)
1110 5221 : CALL block_1_7_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1111 : CASE (2)
1112 715 : CALL block_1_7_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1113 : CASE (3)
1114 5914 : CALL block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1115 : CASE (4)
1116 98 : CALL block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1117 : CASE (5)
1118 3442 : CALL block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1119 : CASE (6)
1120 1 : CALL block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1121 : CASE (7)
1122 2069 : CALL block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1123 : CASE (9)
1124 1 : CALL block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1125 : CASE (10)
1126 1 : CALL block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1127 : CASE (11)
1128 1 : CALL block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1129 : CASE (15)
1130 1 : CALL block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1131 : CASE DEFAULT
1132 17464 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1133 : END SELECT
1134 : CASE (2)
1135 21125 : SELECT CASE (md_max)
1136 : CASE (1)
1137 712 : CALL block_1_7_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1138 : CASE (2)
1139 251 : CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1140 : CASE (3)
1141 961 : CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1142 : CASE (4)
1143 1 : CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1144 : CASE (5)
1145 706 : CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1146 : CASE (6)
1147 1 : CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1148 : CASE (7)
1149 488 : CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1150 : CASE (9)
1151 0 : CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1152 : CASE (10)
1153 0 : CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1154 : CASE (11)
1155 0 : CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1156 : CASE (15)
1157 0 : CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1158 : CASE DEFAULT
1159 3120 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1160 : END SELECT
1161 : CASE (3)
1162 20413 : CALL block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1163 : CASE (4)
1164 869 : CALL block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1165 : CASE (5)
1166 13176 : CALL block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1167 : CASE (6)
1168 0 : CALL block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1169 : CASE (7)
1170 8043 : CALL block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1171 : CASE (9)
1172 9 : CALL block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1173 : CASE (10)
1174 7 : CALL block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1175 : CASE (11)
1176 7 : CALL block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1177 : CASE (15)
1178 7 : CALL block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1179 : CASE DEFAULT
1180 63115 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1181 : END SELECT
1182 : CASE (9)
1183 250 : SELECT CASE (mc_max)
1184 : CASE (1)
1185 18 : SELECT CASE (md_max)
1186 : CASE (1)
1187 5 : CALL block_1_9_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1188 : CASE (2)
1189 3 : CALL block_1_9_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1190 : CASE (3)
1191 2 : CALL block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1192 : CASE (4)
1193 2 : CALL block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1194 : CASE (5)
1195 2 : CALL block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1196 : CASE (6)
1197 2 : CALL block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1198 : CASE (7)
1199 4 : CALL block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1200 : CASE (9)
1201 5 : CALL block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1202 : CASE (10)
1203 2 : CALL block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1204 : CASE (11)
1205 1 : CALL block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1206 : CASE (15)
1207 1 : CALL block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1208 : CASE DEFAULT
1209 29 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1210 : END SELECT
1211 : CASE (2)
1212 18 : SELECT CASE (md_max)
1213 : CASE (1)
1214 0 : CALL block_1_9_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1215 : CASE (2)
1216 3 : CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1217 : CASE (3)
1218 1 : CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1219 : CASE (4)
1220 2 : CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1221 : CASE (5)
1222 2 : CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1223 : CASE (6)
1224 2 : CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1225 : CASE (7)
1226 3 : CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1227 : CASE (9)
1228 0 : CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1229 : CASE (10)
1230 0 : CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1231 : CASE (11)
1232 0 : CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1233 : CASE (15)
1234 0 : CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1235 : CASE DEFAULT
1236 13 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1237 : END SELECT
1238 : CASE (3)
1239 18 : CALL block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1240 : CASE (4)
1241 8 : CALL block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1242 : CASE (5)
1243 3 : CALL block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1244 : CASE (6)
1245 0 : CALL block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1246 : CASE (7)
1247 13 : CALL block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1248 : CASE (9)
1249 10 : CALL block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1250 : CASE (10)
1251 8 : CALL block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1252 : CASE (11)
1253 7 : CALL block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1254 : CASE (15)
1255 7 : CALL block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1256 : CASE DEFAULT
1257 116 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1258 : END SELECT
1259 : CASE (10)
1260 301 : SELECT CASE (mc_max)
1261 : CASE (1)
1262 36 : SELECT CASE (md_max)
1263 : CASE (1)
1264 9 : CALL block_1_10_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1265 : CASE (2)
1266 4 : CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1267 : CASE (3)
1268 2 : CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1269 : CASE (4)
1270 2 : CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1271 : CASE (5)
1272 4 : CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1273 : CASE (6)
1274 4 : CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1275 : CASE (7)
1276 5 : CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1277 : CASE (9)
1278 4 : CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1279 : CASE (10)
1280 7 : CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1281 : CASE (11)
1282 2 : CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1283 : CASE (15)
1284 3 : CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1285 : CASE DEFAULT
1286 46 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1287 : END SELECT
1288 : CASE (2)
1289 27 : CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1290 : CASE (3)
1291 35 : CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1292 : CASE (4)
1293 24 : CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1294 : CASE (5)
1295 10 : CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1296 : CASE (6)
1297 5 : CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1298 : CASE (7)
1299 27 : CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1300 : CASE (9)
1301 21 : CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1302 : CASE (10)
1303 9 : CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1304 : CASE (11)
1305 7 : CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1306 : CASE (15)
1307 10 : CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1308 : CASE DEFAULT
1309 221 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1310 : END SELECT
1311 : CASE (11)
1312 215 : SELECT CASE (mc_max)
1313 : CASE (1)
1314 41 : SELECT CASE (md_max)
1315 : CASE (1)
1316 9 : CALL block_1_11_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1317 : CASE (2)
1318 4 : CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1319 : CASE (3)
1320 2 : CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1321 : CASE (4)
1322 2 : CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1323 : CASE (5)
1324 4 : CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1325 : CASE (6)
1326 4 : CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1327 : CASE (7)
1328 5 : CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1329 : CASE (9)
1330 5 : CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1331 : CASE (10)
1332 6 : CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1333 : CASE (11)
1334 7 : CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1335 : CASE (15)
1336 4 : CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1337 : CASE DEFAULT
1338 52 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1339 : END SELECT
1340 : CASE (2)
1341 32 : CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1342 : CASE (3)
1343 39 : CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1344 : CASE (4)
1345 29 : CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1346 : CASE (5)
1347 15 : CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1348 : CASE (6)
1349 5 : CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1350 : CASE (7)
1351 30 : CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1352 : CASE (9)
1353 23 : CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1354 : CASE (10)
1355 11 : CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1356 : CASE (11)
1357 8 : CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1358 : CASE (15)
1359 11 : CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1360 : CASE DEFAULT
1361 255 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1362 : END SELECT
1363 : CASE (15)
1364 36 : SELECT CASE (mc_max)
1365 : CASE (1)
1366 25 : SELECT CASE (md_max)
1367 : CASE (1)
1368 5 : CALL block_1_15_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1369 : CASE (2)
1370 3 : CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1371 : CASE (3)
1372 2 : CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1373 : CASE (4)
1374 2 : CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1375 : CASE (5)
1376 3 : CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1377 : CASE (6)
1378 3 : CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1379 : CASE (7)
1380 4 : CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1381 : CASE (9)
1382 4 : CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1383 : CASE (10)
1384 3 : CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1385 : CASE (11)
1386 2 : CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1387 : CASE (15)
1388 5 : CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1389 : CASE DEFAULT
1390 36 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1391 : END SELECT
1392 : CASE (2)
1393 20 : CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1394 : CASE (3)
1395 25 : CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1396 : CASE (4)
1397 15 : CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1398 : CASE (5)
1399 7 : CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1400 : CASE (6)
1401 1 : CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1402 : CASE (7)
1403 19 : CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1404 : CASE (9)
1405 14 : CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1406 : CASE (10)
1407 10 : CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1408 : CASE (11)
1409 9 : CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1410 : CASE (15)
1411 7 : CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1412 : CASE DEFAULT
1413 163 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1414 : END SELECT
1415 : CASE DEFAULT
1416 41028923 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1417 : END SELECT
1418 : CASE (2)
1419 23397946 : SELECT CASE (mb_max)
1420 : CASE (1)
1421 246132 : SELECT CASE (mc_max)
1422 : CASE (1)
1423 26986 : SELECT CASE (md_max)
1424 : CASE (1)
1425 14170 : CALL block_2_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1426 : CASE (2)
1427 1913 : CALL block_2_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1428 : CASE (3)
1429 12668 : CALL block_2_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1430 : CASE (4)
1431 4 : CALL block_2_1_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1432 : CASE (5)
1433 4061 : CALL block_2_1_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1434 : CASE (6)
1435 5 : CALL block_2_1_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1436 : CASE (7)
1437 716 : CALL block_2_1_1_7(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1438 : CASE (9)
1439 4 : CALL block_2_1_1_9(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1440 : CASE (10)
1441 3 : CALL block_2_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1442 : CASE (11)
1443 3 : CALL block_2_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1444 : CASE (15)
1445 4 : CALL block_2_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1446 : CASE DEFAULT
1447 33551 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1448 : END SELECT
1449 : CASE (2)
1450 49334 : SELECT CASE (md_max)
1451 : CASE (1)
1452 4991 : CALL block_2_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1453 : CASE (2)
1454 915 : CALL block_2_1_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1455 : CASE (3)
1456 4810 : CALL block_2_1_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1457 : CASE (4)
1458 3 : CALL block_2_1_2_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1459 : CASE (5)
1460 1832 : CALL block_2_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1461 : CASE (6)
1462 4 : CALL block_2_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1463 : CASE (7)
1464 251 : CALL block_2_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1465 : CASE (9)
1466 3 : CALL block_2_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1467 : CASE (10)
1468 2 : CALL block_2_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1469 : CASE (11)
1470 2 : CALL block_2_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1471 : CASE (15)
1472 3 : CALL block_2_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1473 : CASE DEFAULT
1474 12816 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1475 : END SELECT
1476 : CASE (3)
1477 17827 : SELECT CASE (md_max)
1478 : CASE (1)
1479 17798 : CALL block_2_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1480 : CASE (2)
1481 2759 : CALL block_2_1_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1482 : CASE (3)
1483 16799 : CALL block_2_1_3_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1484 : CASE (4)
1485 4 : CALL block_2_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1486 : CASE (5)
1487 6020 : CALL block_2_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1488 : CASE (6)
1489 4 : CALL block_2_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1490 : CASE (7)
1491 947 : CALL block_2_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1492 : CASE (9)
1493 3 : CALL block_2_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1494 : CASE (10)
1495 3 : CALL block_2_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1496 : CASE (11)
1497 3 : CALL block_2_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1498 : CASE (15)
1499 3 : CALL block_2_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1500 : CASE DEFAULT
1501 44343 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1502 : END SELECT
1503 : CASE (4)
1504 27094 : SELECT CASE (md_max)
1505 : CASE (1)
1506 3 : CALL block_2_1_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1507 : CASE (2)
1508 2 : CALL block_2_1_4_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1509 : CASE (3)
1510 1 : CALL block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1511 : CASE (4)
1512 5 : CALL block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1513 : CASE (5)
1514 3 : CALL block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1515 : CASE (6)
1516 3 : CALL block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1517 : CASE (7)
1518 3 : CALL block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1519 : CASE (9)
1520 3 : CALL block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1521 : CASE (10)
1522 3 : CALL block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1523 : CASE (11)
1524 1 : CALL block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1525 : CASE (15)
1526 2 : CALL block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1527 : CASE DEFAULT
1528 29 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1529 : END SELECT
1530 : CASE (5)
1531 10224 : SELECT CASE (md_max)
1532 : CASE (1)
1533 10213 : CALL block_2_1_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1534 : CASE (2)
1535 1829 : CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1536 : CASE (3)
1537 10121 : CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1538 : CASE (4)
1539 2 : CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1540 : CASE (5)
1541 4212 : CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1542 : CASE (6)
1543 2 : CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1544 : CASE (7)
1545 706 : CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1546 : CASE (9)
1547 2 : CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1548 : CASE (10)
1549 2 : CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1550 : CASE (11)
1551 1 : CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1552 : CASE (15)
1553 1 : CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1554 : CASE DEFAULT
1555 27091 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1556 : END SELECT
1557 : CASE (6)
1558 3114 : SELECT CASE (md_max)
1559 : CASE (1)
1560 1 : CALL block_2_1_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1561 : CASE (2)
1562 1 : CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1563 : CASE (3)
1564 1 : CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1565 : CASE (4)
1566 1 : CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1567 : CASE (5)
1568 1 : CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1569 : CASE (6)
1570 3 : CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1571 : CASE (7)
1572 1 : CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1573 : CASE (9)
1574 1 : CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1575 : CASE (10)
1576 1 : CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1577 : CASE (11)
1578 0 : CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1579 : CASE (15)
1580 0 : CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1581 : CASE DEFAULT
1582 11 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1583 : END SELECT
1584 : CASE (7)
1585 724 : SELECT CASE (md_max)
1586 : CASE (1)
1587 713 : CALL block_2_1_7_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1588 : CASE (2)
1589 249 : CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1590 : CASE (3)
1591 945 : CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1592 : CASE (4)
1593 1 : CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1594 : CASE (5)
1595 706 : CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1596 : CASE (6)
1597 3 : CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1598 : CASE (7)
1599 492 : CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1600 : CASE (9)
1601 2 : CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1602 : CASE (10)
1603 1 : CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1604 : CASE (11)
1605 0 : CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1606 : CASE (15)
1607 1 : CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1608 : CASE DEFAULT
1609 3113 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1610 : END SELECT
1611 : CASE (9)
1612 10 : SELECT CASE (md_max)
1613 : CASE (1)
1614 1 : CALL block_2_1_9_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1615 : CASE (2)
1616 1 : CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1617 : CASE (3)
1618 1 : CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1619 : CASE (4)
1620 1 : CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1621 : CASE (5)
1622 2 : CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1623 : CASE (6)
1624 2 : CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1625 : CASE (7)
1626 1 : CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1627 : CASE (9)
1628 2 : CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1629 : CASE (10)
1630 0 : CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1631 : CASE (11)
1632 0 : CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1633 : CASE (15)
1634 0 : CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1635 : CASE DEFAULT
1636 11 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1637 : END SELECT
1638 : CASE (10)
1639 9 : CALL block_2_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1640 : CASE (11)
1641 10 : CALL block_2_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1642 : CASE (15)
1643 11 : CALL block_2_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1644 : CASE DEFAULT
1645 120995 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1646 : END SELECT
1647 : CASE (2)
1648 210730 : SELECT CASE (mc_max)
1649 : CASE (1)
1650 51922 : SELECT CASE (md_max)
1651 : CASE (1)
1652 739 : CALL block_2_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1653 : CASE (2)
1654 314 : CALL block_2_2_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1655 : CASE (3)
1656 999 : CALL block_2_2_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1657 : CASE (4)
1658 4 : CALL block_2_2_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1659 : CASE (5)
1660 705 : CALL block_2_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1661 : CASE (6)
1662 4 : CALL block_2_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1663 : CASE (7)
1664 249 : CALL block_2_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1665 : CASE (9)
1666 1 : CALL block_2_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1667 : CASE (10)
1668 1 : CALL block_2_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1669 : CASE (11)
1670 1 : CALL block_2_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1671 : CASE (15)
1672 1 : CALL block_2_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1673 : CASE DEFAULT
1674 3018 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1675 : END SELECT
1676 : CASE (2)
1677 33054 : SELECT CASE (md_max)
1678 : CASE (1)
1679 306 : CALL block_2_2_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1680 : CASE (2)
1681 35049 : CALL block_2_2_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1682 : CASE (3)
1683 15453 : CALL block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1684 : CASE (4)
1685 3 : CALL block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1686 : CASE (5)
1687 289 : CALL block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1688 : CASE (6)
1689 3 : CALL block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1690 : CASE (7)
1691 80 : CALL block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1692 : CASE (9)
1693 0 : CALL block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1694 : CASE (10)
1695 0 : CALL block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1696 : CASE (11)
1697 0 : CALL block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1698 : CASE (15)
1699 0 : CALL block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1700 : CASE DEFAULT
1701 51183 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1702 : END SELECT
1703 : CASE (3)
1704 1016 : SELECT CASE (md_max)
1705 : CASE (1)
1706 997 : CALL block_2_2_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1707 : CASE (2)
1708 15454 : CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1709 : CASE (3)
1710 14963 : CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1711 : CASE (4)
1712 4 : CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1713 : CASE (5)
1714 989 : CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1715 : CASE (6)
1716 3 : CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1717 : CASE (7)
1718 337 : CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1719 : CASE (9)
1720 1 : CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1721 : CASE (10)
1722 0 : CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1723 : CASE (11)
1724 0 : CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1725 : CASE (15)
1726 0 : CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1727 : CASE DEFAULT
1728 32748 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1729 : END SELECT
1730 : CASE (4)
1731 63730 : SELECT CASE (md_max)
1732 : CASE (1)
1733 3 : CALL block_2_2_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1734 : CASE (2)
1735 3 : CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1736 : CASE (3)
1737 2 : CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1738 : CASE (4)
1739 5 : CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1740 : CASE (5)
1741 3 : CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1742 : CASE (6)
1743 2 : CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1744 : CASE (7)
1745 1 : CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1746 : CASE (9)
1747 0 : CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1748 : CASE (10)
1749 0 : CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1750 : CASE (11)
1751 0 : CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1752 : CASE (15)
1753 0 : CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1754 : CASE DEFAULT
1755 19 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1756 : END SELECT
1757 : CASE (5)
1758 63727 : CALL block_2_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1759 : CASE (6)
1760 10 : CALL block_2_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1761 : CASE (7)
1762 1071 : CALL block_2_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1763 : CASE (9)
1764 8 : CALL block_2_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1765 : CASE (10)
1766 9 : CALL block_2_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1767 : CASE (11)
1768 10 : CALL block_2_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1769 : CASE (15)
1770 11 : CALL block_2_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1771 : CASE DEFAULT
1772 212581 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1773 : END SELECT
1774 : CASE (3)
1775 27913 : SELECT CASE (mc_max)
1776 : CASE (1)
1777 49787 : SELECT CASE (md_max)
1778 : CASE (1)
1779 10667 : CALL block_2_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1780 : CASE (2)
1781 1753 : CALL block_2_3_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1782 : CASE (3)
1783 10383 : CALL block_2_3_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1784 : CASE (4)
1785 3 : CALL block_2_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1786 : CASE (5)
1787 4015 : CALL block_2_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1788 : CASE (6)
1789 3 : CALL block_2_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1790 : CASE (7)
1791 960 : CALL block_2_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1792 : CASE (9)
1793 0 : CALL block_2_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1794 : CASE (10)
1795 0 : CALL block_2_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1796 : CASE (11)
1797 0 : CALL block_2_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1798 : CASE (15)
1799 0 : CALL block_2_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1800 : CASE DEFAULT
1801 27784 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1802 : END SELECT
1803 : CASE (2)
1804 65875 : SELECT CASE (md_max)
1805 : CASE (1)
1806 3800 : CALL block_2_3_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1807 : CASE (2)
1808 15733 : CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1809 : CASE (3)
1810 17456 : CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1811 : CASE (4)
1812 3 : CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1813 : CASE (5)
1814 1781 : CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1815 : CASE (6)
1816 3 : CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1817 : CASE (7)
1818 344 : CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1819 : CASE (9)
1820 0 : CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1821 : CASE (10)
1822 0 : CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1823 : CASE (11)
1824 0 : CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1825 : CASE (15)
1826 0 : CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1827 : CASE DEFAULT
1828 39120 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1829 : END SELECT
1830 : CASE (3)
1831 13811 : SELECT CASE (md_max)
1832 : CASE (1)
1833 13798 : CALL block_2_3_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1834 : CASE (2)
1835 16083 : CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1836 : CASE (3)
1837 24921 : CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1838 : CASE (4)
1839 3 : CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1840 : CASE (5)
1841 5955 : CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1842 : CASE (6)
1843 3 : CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1844 : CASE (7)
1845 1312 : CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1846 : CASE (9)
1847 0 : CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1848 : CASE (10)
1849 0 : CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1850 : CASE (11)
1851 0 : CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1852 : CASE (15)
1853 0 : CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1854 : CASE DEFAULT
1855 62075 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1856 : END SELECT
1857 : CASE (4)
1858 13 : CALL block_2_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1859 : CASE (5)
1860 49023 : CALL block_2_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1861 : CASE (6)
1862 5 : CALL block_2_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1863 : CASE (7)
1864 4264 : CALL block_2_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1865 : CASE (9)
1866 0 : CALL block_2_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1867 : CASE (10)
1868 0 : CALL block_2_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1869 : CASE (11)
1870 0 : CALL block_2_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1871 : CASE (15)
1872 0 : CALL block_2_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1873 : CASE DEFAULT
1874 207712 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1875 : END SELECT
1876 : CASE (4)
1877 31002 : SELECT CASE (mc_max)
1878 : CASE (1)
1879 40 : SELECT CASE (md_max)
1880 : CASE (1)
1881 8 : CALL block_2_4_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1882 : CASE (2)
1883 8 : CALL block_2_4_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1884 : CASE (3)
1885 8 : CALL block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1886 : CASE (4)
1887 8 : CALL block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1888 : CASE (5)
1889 4 : CALL block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1890 : CASE (6)
1891 3 : CALL block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1892 : CASE (7)
1893 1 : CALL block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1894 : CASE (9)
1895 0 : CALL block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1896 : CASE (10)
1897 0 : CALL block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1898 : CASE (11)
1899 0 : CALL block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1900 : CASE (15)
1901 0 : CALL block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1902 : CASE DEFAULT
1903 40 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1904 : END SELECT
1905 : CASE (2)
1906 26 : SELECT CASE (md_max)
1907 : CASE (1)
1908 2 : CALL block_2_4_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1909 : CASE (2)
1910 8 : CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1911 : CASE (3)
1912 7 : CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1913 : CASE (4)
1914 8 : CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1915 : CASE (5)
1916 4 : CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1917 : CASE (6)
1918 3 : CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1919 : CASE (7)
1920 0 : CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1921 : CASE (9)
1922 0 : CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1923 : CASE (10)
1924 0 : CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1925 : CASE (11)
1926 0 : CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1927 : CASE (15)
1928 0 : CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1929 : CASE DEFAULT
1930 32 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1931 : END SELECT
1932 : CASE (3)
1933 24 : CALL block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1934 : CASE (4)
1935 14 : CALL block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1936 : CASE (5)
1937 12 : CALL block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1938 : CASE (6)
1939 7 : CALL block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1940 : CASE (7)
1941 0 : CALL block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1942 : CASE (9)
1943 0 : CALL block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1944 : CASE (10)
1945 0 : CALL block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1946 : CASE (11)
1947 0 : CALL block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1948 : CASE (15)
1949 0 : CALL block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1950 : CASE DEFAULT
1951 129 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1952 : END SELECT
1953 : CASE (5)
1954 7486 : SELECT CASE (mc_max)
1955 : CASE (1)
1956 4660 : SELECT CASE (md_max)
1957 : CASE (1)
1958 1729 : CALL block_2_5_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1959 : CASE (2)
1960 661 : CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1961 : CASE (3)
1962 2388 : CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1963 : CASE (4)
1964 8 : CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1965 : CASE (5)
1966 1785 : CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1967 : CASE (6)
1968 3 : CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1969 : CASE (7)
1970 705 : CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1971 : CASE (9)
1972 1 : CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1973 : CASE (10)
1974 0 : CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1975 : CASE (11)
1976 0 : CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1977 : CASE (15)
1978 0 : CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1979 : CASE DEFAULT
1980 7280 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1981 : END SELECT
1982 : CASE (2)
1983 2931 : CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1984 : CASE (3)
1985 10198 : CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1986 : CASE (4)
1987 22 : CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1988 : CASE (5)
1989 7400 : CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1990 : CASE (6)
1991 9 : CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1992 : CASE (7)
1993 3122 : CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1994 : CASE (9)
1995 0 : CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1996 : CASE (10)
1997 0 : CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1998 : CASE (11)
1999 0 : CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2000 : CASE (15)
2001 0 : CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2002 : CASE DEFAULT
2003 30962 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2004 : END SELECT
2005 : CASE (6)
2006 14103 : SELECT CASE (mc_max)
2007 : CASE (1)
2008 57 : SELECT CASE (md_max)
2009 : CASE (1)
2010 10 : CALL block_2_6_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2011 : CASE (2)
2012 9 : CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2013 : CASE (3)
2014 8 : CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2015 : CASE (4)
2016 8 : CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2017 : CASE (5)
2018 9 : CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2019 : CASE (6)
2020 9 : CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2021 : CASE (7)
2022 2 : CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2023 : CASE (9)
2024 1 : CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2025 : CASE (10)
2026 1 : CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2027 : CASE (11)
2028 0 : CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2029 : CASE (15)
2030 0 : CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2031 : CASE DEFAULT
2032 57 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2033 : END SELECT
2034 : CASE (2)
2035 47 : CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2036 : CASE (3)
2037 44 : CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2038 : CASE (4)
2039 28 : CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2040 : CASE (5)
2041 16 : CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2042 : CASE (6)
2043 10 : CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2044 : CASE (7)
2045 3 : CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2046 : CASE (9)
2047 1 : CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2048 : CASE (10)
2049 0 : CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2050 : CASE (11)
2051 0 : CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2052 : CASE (15)
2053 0 : CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2054 : CASE DEFAULT
2055 206 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2056 : END SELECT
2057 : CASE (7)
2058 3297 : SELECT CASE (mc_max)
2059 : CASE (1)
2060 1831 : SELECT CASE (md_max)
2061 : CASE (1)
2062 739 : CALL block_2_7_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2063 : CASE (2)
2064 251 : CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2065 : CASE (3)
2066 978 : CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2067 : CASE (4)
2068 2 : CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2069 : CASE (5)
2070 754 : CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2071 : CASE (6)
2072 2 : CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2073 : CASE (7)
2074 491 : CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2075 : CASE (9)
2076 0 : CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2077 : CASE (10)
2078 0 : CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2079 : CASE (11)
2080 0 : CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2081 : CASE (15)
2082 0 : CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2083 : CASE DEFAULT
2084 3217 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2085 : END SELECT
2086 : CASE (2)
2087 1092 : CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2088 : CASE (3)
2089 4384 : CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2090 : CASE (4)
2091 7 : CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2092 : CASE (5)
2093 3242 : CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2094 : CASE (6)
2095 0 : CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2096 : CASE (7)
2097 2104 : CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2098 : CASE (9)
2099 0 : CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2100 : CASE (10)
2101 0 : CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2102 : CASE (11)
2103 0 : CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2104 : CASE (15)
2105 0 : CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2106 : CASE DEFAULT
2107 14046 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2108 : END SELECT
2109 : CASE (9)
2110 131 : SELECT CASE (mc_max)
2111 : CASE (1)
2112 20 : SELECT CASE (md_max)
2113 : CASE (1)
2114 3 : CALL block_2_9_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2115 : CASE (2)
2116 3 : CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2117 : CASE (3)
2118 2 : CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2119 : CASE (4)
2120 2 : CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2121 : CASE (5)
2122 2 : CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2123 : CASE (6)
2124 2 : CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2125 : CASE (7)
2126 3 : CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2127 : CASE (9)
2128 3 : CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2129 : CASE (10)
2130 1 : CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2131 : CASE (11)
2132 0 : CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2133 : CASE (15)
2134 1 : CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2135 : CASE DEFAULT
2136 22 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2137 : END SELECT
2138 : CASE (2)
2139 17 : CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2140 : CASE (3)
2141 21 : CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2142 : CASE (4)
2143 12 : CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2144 : CASE (5)
2145 6 : CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2146 : CASE (6)
2147 0 : CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2148 : CASE (7)
2149 2 : CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2150 : CASE (9)
2151 0 : CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2152 : CASE (10)
2153 0 : CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2154 : CASE (11)
2155 0 : CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2156 : CASE (15)
2157 0 : CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2158 : CASE DEFAULT
2159 80 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2160 : END SELECT
2161 : CASE (10)
2162 109 : CALL block_2_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2163 : CASE (11)
2164 140 : CALL block_2_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2165 : CASE (15)
2166 120 : CALL block_2_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2167 : CASE DEFAULT
2168 587080 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2169 : END SELECT
2170 : CASE (3)
2171 19078089 : SELECT CASE (mb_max)
2172 : CASE (1)
2173 7903694 : SELECT CASE (mc_max)
2174 : CASE (1)
2175 4954048 : SELECT CASE (md_max)
2176 : CASE (1)
2177 4876377 : CALL block_3_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2178 : CASE (2)
2179 10150 : CALL block_3_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2180 : CASE (3)
2181 2711002 : CALL block_3_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2182 : CASE (4)
2183 46117 : CALL block_3_1_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2184 : CASE (5)
2185 95820 : CALL block_3_1_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2186 : CASE (6)
2187 5 : CALL block_3_1_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2188 : CASE (7)
2189 16716 : CALL block_3_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2190 : CASE (9)
2191 4 : CALL block_3_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2192 : CASE (10)
2193 3 : CALL block_3_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2194 : CASE (11)
2195 3 : CALL block_3_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2196 : CASE (15)
2197 3 : CALL block_3_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2198 : CASE DEFAULT
2199 7756200 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2200 : END SELECT
2201 : CASE (2)
2202 6948543 : SELECT CASE (md_max)
2203 : CASE (1)
2204 31980 : CALL block_3_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2205 : CASE (2)
2206 4869 : CALL block_3_1_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2207 : CASE (3)
2208 29704 : CALL block_3_1_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2209 : CASE (4)
2210 3 : CALL block_3_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2211 : CASE (5)
2212 10124 : CALL block_3_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2213 : CASE (6)
2214 3 : CALL block_3_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2215 : CASE (7)
2216 979 : CALL block_3_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2217 : CASE (9)
2218 3 : CALL block_3_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2219 : CASE (10)
2220 2 : CALL block_3_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2221 : CASE (11)
2222 2 : CALL block_3_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2223 : CASE (15)
2224 2 : CALL block_3_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2225 : CASE DEFAULT
2226 77671 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2227 : END SELECT
2228 : CASE (3)
2229 4690693 : SELECT CASE (md_max)
2230 : CASE (1)
2231 4194542 : CALL block_3_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2232 : CASE (2)
2233 15149 : CALL block_3_1_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2234 : CASE (3)
2235 2591441 : CALL block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2236 : CASE (4)
2237 13991 : CALL block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2238 : CASE (5)
2239 83719 : CALL block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2240 : CASE (6)
2241 4 : CALL block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2242 : CASE (7)
2243 17707 : CALL block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2244 : CASE (9)
2245 3 : CALL block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2246 : CASE (10)
2247 2 : CALL block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2248 : CASE (11)
2249 2 : CALL block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2250 : CASE (15)
2251 3 : CALL block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2252 : CASE DEFAULT
2253 6916563 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2254 : END SELECT
2255 : CASE (4)
2256 823912 : SELECT CASE (md_max)
2257 : CASE (1)
2258 227600 : CALL block_3_1_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2259 : CASE (2)
2260 2 : CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2261 : CASE (3)
2262 103471 : CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2263 : CASE (4)
2264 110041 : CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2265 : CASE (5)
2266 54914 : CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2267 : CASE (6)
2268 4 : CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2269 : CASE (7)
2270 111 : CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2271 : CASE (9)
2272 3 : CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2273 : CASE (10)
2274 2 : CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2275 : CASE (11)
2276 1 : CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2277 : CASE (15)
2278 2 : CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2279 : CASE DEFAULT
2280 496151 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2281 : END SELECT
2282 : CASE (5)
2283 281903 : SELECT CASE (md_max)
2284 : CASE (1)
2285 281892 : CALL block_3_1_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2286 : CASE (2)
2287 10121 : CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2288 : CASE (3)
2289 173390 : CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2290 : CASE (4)
2291 54673 : CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2292 : CASE (5)
2293 67738 : CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2294 : CASE (6)
2295 2 : CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2296 : CASE (7)
2297 8490 : CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2298 : CASE (9)
2299 2 : CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2300 : CASE (10)
2301 2 : CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2302 : CASE (11)
2303 1 : CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2304 : CASE (15)
2305 1 : CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2306 : CASE DEFAULT
2307 596312 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2308 : END SELECT
2309 : CASE (6)
2310 72999 : SELECT CASE (md_max)
2311 : CASE (1)
2312 1 : CALL block_3_1_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2313 : CASE (2)
2314 1 : CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2315 : CASE (3)
2316 1 : CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2317 : CASE (4)
2318 1 : CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2319 : CASE (5)
2320 1 : CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2321 : CASE (6)
2322 3 : CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2323 : CASE (7)
2324 1 : CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2325 : CASE (9)
2326 1 : CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2327 : CASE (10)
2328 1 : CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2329 : CASE (11)
2330 0 : CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2331 : CASE (15)
2332 0 : CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2333 : CASE DEFAULT
2334 11 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2335 : END SELECT
2336 : CASE (7)
2337 72998 : CALL block_3_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2338 : CASE (9)
2339 8 : CALL block_3_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2340 : CASE (10)
2341 9 : CALL block_3_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2342 : CASE (11)
2343 10 : CALL block_3_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2344 : CASE (15)
2345 11 : CALL block_3_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2346 : CASE DEFAULT
2347 15915944 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2348 : END SELECT
2349 : CASE (2)
2350 6744080 : SELECT CASE (mc_max)
2351 : CASE (1)
2352 34875 : SELECT CASE (md_max)
2353 : CASE (1)
2354 2425 : CALL block_3_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2355 : CASE (2)
2356 942 : CALL block_3_2_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2357 : CASE (3)
2358 3540 : CALL block_3_2_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2359 : CASE (4)
2360 2 : CALL block_3_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2361 : CASE (5)
2362 2398 : CALL block_3_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2363 : CASE (6)
2364 2 : CALL block_3_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2365 : CASE (7)
2366 961 : CALL block_3_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2367 : CASE (9)
2368 1 : CALL block_3_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2369 : CASE (10)
2370 1 : CALL block_3_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2371 : CASE (11)
2372 1 : CALL block_3_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2373 : CASE (15)
2374 1 : CALL block_3_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2375 : CASE DEFAULT
2376 10274 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2377 : END SELECT
2378 : CASE (2)
2379 40248 : SELECT CASE (md_max)
2380 : CASE (1)
2381 939 : CALL block_3_2_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2382 : CASE (2)
2383 15324 : CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2384 : CASE (3)
2385 14870 : CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2386 : CASE (4)
2387 1 : CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2388 : CASE (5)
2389 971 : CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2390 : CASE (6)
2391 1 : CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2392 : CASE (7)
2393 344 : CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2394 : CASE (9)
2395 0 : CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2396 : CASE (10)
2397 0 : CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2398 : CASE (11)
2399 0 : CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2400 : CASE (15)
2401 0 : CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2402 : CASE DEFAULT
2403 32450 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2404 : END SELECT
2405 : CASE (3)
2406 3547 : SELECT CASE (md_max)
2407 : CASE (1)
2408 3538 : CALL block_3_2_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2409 : CASE (2)
2410 14873 : CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2411 : CASE (3)
2412 16062 : CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2413 : CASE (4)
2414 2 : CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2415 : CASE (5)
2416 3529 : CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2417 : CASE (6)
2418 1 : CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2419 : CASE (7)
2420 1304 : CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2421 : CASE (9)
2422 0 : CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2423 : CASE (10)
2424 0 : CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2425 : CASE (11)
2426 0 : CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2427 : CASE (15)
2428 0 : CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2429 : CASE DEFAULT
2430 39309 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2431 : END SELECT
2432 : CASE (4)
2433 9 : CALL block_3_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2434 : CASE (5)
2435 35717 : CALL block_3_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2436 : CASE (6)
2437 6 : CALL block_3_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2438 : CASE (7)
2439 4263 : CALL block_3_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2440 : CASE (9)
2441 8 : CALL block_3_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2442 : CASE (10)
2443 9 : CALL block_3_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2444 : CASE (11)
2445 10 : CALL block_3_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2446 : CASE (15)
2447 11 : CALL block_3_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2448 : CASE DEFAULT
2449 147494 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2450 : END SELECT
2451 : CASE (3)
2452 3203614 : SELECT CASE (mc_max)
2453 : CASE (1)
2454 1657984 : SELECT CASE (md_max)
2455 : CASE (1)
2456 1573828 : CALL block_3_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2457 : CASE (2)
2458 8672 : CALL block_3_3_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2459 : CASE (3)
2460 1405113 : CALL block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2461 : CASE (4)
2462 20420 : CALL block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2463 : CASE (5)
2464 54358 : CALL block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2465 : CASE (6)
2466 4 : CALL block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2467 : CASE (7)
2468 10473 : CALL block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2469 : CASE (9)
2470 1 : CALL block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2471 : CASE (10)
2472 1 : CALL block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2473 : CASE (11)
2474 1 : CALL block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2475 : CASE (15)
2476 1 : CALL block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2477 : CASE DEFAULT
2478 3072872 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2479 : END SELECT
2480 : CASE (2)
2481 2941245 : SELECT CASE (md_max)
2482 : CASE (1)
2483 23222 : CALL block_3_3_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2484 : CASE (2)
2485 17416 : CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2486 : CASE (3)
2487 33509 : CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2488 : CASE (4)
2489 3 : CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2490 : CASE (5)
2491 8635 : CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2492 : CASE (6)
2493 3 : CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2494 : CASE (7)
2495 1368 : CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2496 : CASE (9)
2497 0 : CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2498 : CASE (10)
2499 0 : CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2500 : CASE (11)
2501 0 : CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2502 : CASE (15)
2503 0 : CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2504 : CASE DEFAULT
2505 84156 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2506 : END SELECT
2507 : CASE (3)
2508 2918023 : CALL block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2509 : CASE (4)
2510 238937 : CALL block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2511 : CASE (5)
2512 351268 : CALL block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2513 : CASE (6)
2514 13 : CALL block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2515 : CASE (7)
2516 42511 : CALL block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2517 : CASE (9)
2518 568 : CALL block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2519 : CASE (10)
2520 9 : CALL block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2521 : CASE (11)
2522 10 : CALL block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2523 : CASE (15)
2524 11 : CALL block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2525 : CASE DEFAULT
2526 6733806 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2527 : END SELECT
2528 : CASE (4)
2529 332319 : SELECT CASE (mc_max)
2530 : CASE (1)
2531 30345 : SELECT CASE (md_max)
2532 : CASE (1)
2533 30314 : CALL block_3_4_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2534 : CASE (2)
2535 8 : CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2536 : CASE (3)
2537 11426 : CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2538 : CASE (4)
2539 11939 : CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2540 : CASE (5)
2541 5666 : CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2542 : CASE (6)
2543 3 : CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2544 : CASE (7)
2545 0 : CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2546 : CASE (9)
2547 0 : CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2548 : CASE (10)
2549 0 : CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2550 : CASE (11)
2551 0 : CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2552 : CASE (15)
2553 0 : CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2554 : CASE DEFAULT
2555 59356 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2556 : END SELECT
2557 : CASE (2)
2558 31 : CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2559 : CASE (3)
2560 20214 : CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2561 : CASE (4)
2562 34305 : CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2563 : CASE (5)
2564 16827 : CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2565 : CASE (6)
2566 9 : CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2567 : CASE (7)
2568 0 : CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2569 : CASE (9)
2570 0 : CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2571 : CASE (10)
2572 0 : CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2573 : CASE (11)
2574 0 : CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2575 : CASE (15)
2576 0 : CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2577 : CASE DEFAULT
2578 130742 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2579 : END SELECT
2580 : CASE (5)
2581 98007 : SELECT CASE (mc_max)
2582 : CASE (1)
2583 50446 : SELECT CASE (md_max)
2584 : CASE (1)
2585 40121 : CALL block_3_5_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2586 : CASE (2)
2587 2389 : CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2588 : CASE (3)
2589 29493 : CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2590 : CASE (4)
2591 6040 : CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2592 : CASE (5)
2593 15642 : CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2594 : CASE (6)
2595 7 : CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2596 : CASE (7)
2597 4113 : CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2598 : CASE (9)
2599 0 : CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2600 : CASE (10)
2601 0 : CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2602 : CASE (11)
2603 0 : CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2604 : CASE (15)
2605 0 : CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2606 : CASE DEFAULT
2607 97805 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2608 : END SELECT
2609 : CASE (2)
2610 10325 : CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2611 : CASE (3)
2612 80793 : CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2613 : CASE (4)
2614 17871 : CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2615 : CASE (5)
2616 50135 : CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2617 : CASE (6)
2618 10 : CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2619 : CASE (7)
2620 16024 : CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2621 : CASE (9)
2622 0 : CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2623 : CASE (10)
2624 0 : CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2625 : CASE (11)
2626 0 : CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2627 : CASE (15)
2628 0 : CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2629 : CASE DEFAULT
2630 272963 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2631 : END SELECT
2632 : CASE (6)
2633 75352 : SELECT CASE (mc_max)
2634 : CASE (1)
2635 54 : SELECT CASE (md_max)
2636 : CASE (1)
2637 11 : CALL block_3_6_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2638 : CASE (2)
2639 10 : CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2640 : CASE (3)
2641 8 : CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2642 : CASE (4)
2643 8 : CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2644 : CASE (5)
2645 8 : CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2646 : CASE (6)
2647 8 : CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2648 : CASE (7)
2649 3 : CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2650 : CASE (9)
2651 1 : CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2652 : CASE (10)
2653 0 : CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2654 : CASE (11)
2655 0 : CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2656 : CASE (15)
2657 0 : CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2658 : CASE DEFAULT
2659 57 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2660 : END SELECT
2661 : CASE (2)
2662 43 : CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2663 : CASE (3)
2664 46 : CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2665 : CASE (4)
2666 29 : CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2667 : CASE (5)
2668 16 : CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2669 : CASE (6)
2670 11 : CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2671 : CASE (7)
2672 0 : CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2673 : CASE (9)
2674 0 : CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2675 : CASE (10)
2676 0 : CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2677 : CASE (11)
2678 0 : CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2679 : CASE (15)
2680 0 : CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2681 : CASE DEFAULT
2682 202 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2683 : END SELECT
2684 : CASE (7)
2685 75295 : CALL block_3_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2686 : CASE (9)
2687 181 : CALL block_3_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2688 : CASE (10)
2689 94 : CALL block_3_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2690 : CASE (11)
2691 123 : CALL block_3_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2692 : CASE (15)
2693 107 : CALL block_3_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2694 : CASE DEFAULT
2695 23276951 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2696 : END SELECT
2697 : CASE (4)
2698 4490944 : SELECT CASE (mb_max)
2699 : CASE (1)
2700 461172 : SELECT CASE (mc_max)
2701 : CASE (1)
2702 257450 : SELECT CASE (md_max)
2703 : CASE (1)
2704 257417 : CALL block_4_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2705 : CASE (2)
2706 6 : CALL block_4_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2707 : CASE (3)
2708 87857 : CALL block_4_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2709 : CASE (4)
2710 85426 : CALL block_4_1_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2711 : CASE (5)
2712 30235 : CALL block_4_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2713 : CASE (6)
2714 5 : CALL block_4_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2715 : CASE (7)
2716 100 : CALL block_4_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2717 : CASE (9)
2718 4 : CALL block_4_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2719 : CASE (10)
2720 3 : CALL block_4_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2721 : CASE (11)
2722 3 : CALL block_4_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2723 : CASE (15)
2724 4 : CALL block_4_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2725 : CASE DEFAULT
2726 461060 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2727 : END SELECT
2728 : CASE (2)
2729 137013 : SELECT CASE (md_max)
2730 : CASE (1)
2731 3 : CALL block_4_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2732 : CASE (2)
2733 5 : CALL block_4_1_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2734 : CASE (3)
2735 2 : CALL block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2736 : CASE (4)
2737 3 : CALL block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2738 : CASE (5)
2739 4 : CALL block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2740 : CASE (6)
2741 4 : CALL block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2742 : CASE (7)
2743 3 : CALL block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2744 : CASE (9)
2745 3 : CALL block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2746 : CASE (10)
2747 2 : CALL block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2748 : CASE (11)
2749 2 : CALL block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2750 : CASE (15)
2751 2 : CALL block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2752 : CASE DEFAULT
2753 33 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2754 : END SELECT
2755 : CASE (3)
2756 784216 : SELECT CASE (md_max)
2757 : CASE (1)
2758 76229 : CALL block_4_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2759 : CASE (2)
2760 3 : CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2761 : CASE (3)
2762 35525 : CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2763 : CASE (4)
2764 16766 : CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2765 : CASE (5)
2766 8470 : CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2767 : CASE (6)
2768 4 : CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2769 : CASE (7)
2770 3 : CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2771 : CASE (9)
2772 3 : CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2773 : CASE (10)
2774 2 : CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2775 : CASE (11)
2776 2 : CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2777 : CASE (15)
2778 3 : CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2779 : CASE DEFAULT
2780 137010 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2781 : END SELECT
2782 : CASE (4)
2783 609904 : SELECT CASE (md_max)
2784 : CASE (1)
2785 313389 : CALL block_4_1_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2786 : CASE (2)
2787 2 : CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2788 : CASE (3)
2789 109295 : CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2790 : CASE (4)
2791 209698 : CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2792 : CASE (5)
2793 75094 : CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2794 : CASE (6)
2795 4 : CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2796 : CASE (7)
2797 495 : CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2798 : CASE (9)
2799 3 : CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2800 : CASE (10)
2801 2 : CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2802 : CASE (11)
2803 2 : CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2804 : CASE (15)
2805 3 : CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2806 : CASE DEFAULT
2807 707987 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2808 : END SELECT
2809 : CASE (5)
2810 296515 : CALL block_4_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2811 : CASE (6)
2812 15 : CALL block_4_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2813 : CASE (7)
2814 1423 : CALL block_4_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2815 : CASE (9)
2816 10 : CALL block_4_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2817 : CASE (10)
2818 11 : CALL block_4_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2819 : CASE (11)
2820 10 : CALL block_4_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2821 : CASE (15)
2822 11 : CALL block_4_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2823 : CASE DEFAULT
2824 1604085 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2825 : END SELECT
2826 : CASE (2)
2827 615482 : SELECT CASE (mc_max)
2828 : CASE (1)
2829 13 : SELECT CASE (md_max)
2830 : CASE (1)
2831 5 : CALL block_4_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2832 : CASE (2)
2833 3 : CALL block_4_2_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2834 : CASE (3)
2835 3 : CALL block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2836 : CASE (4)
2837 3 : CALL block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2838 : CASE (5)
2839 2 : CALL block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2840 : CASE (6)
2841 2 : CALL block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2842 : CASE (7)
2843 1 : CALL block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2844 : CASE (9)
2845 1 : CALL block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2846 : CASE (10)
2847 1 : CALL block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2848 : CASE (11)
2849 1 : CALL block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2850 : CASE (15)
2851 1 : CALL block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2852 : CASE DEFAULT
2853 23 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2854 : END SELECT
2855 : CASE (2)
2856 12 : SELECT CASE (md_max)
2857 : CASE (1)
2858 1 : CALL block_4_2_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2859 : CASE (2)
2860 2 : CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2861 : CASE (3)
2862 2 : CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2863 : CASE (4)
2864 1 : CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2865 : CASE (5)
2866 1 : CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2867 : CASE (6)
2868 1 : CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2869 : CASE (7)
2870 0 : CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2871 : CASE (9)
2872 0 : CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2873 : CASE (10)
2874 0 : CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2875 : CASE (11)
2876 0 : CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2877 : CASE (15)
2878 0 : CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2879 : CASE DEFAULT
2880 8 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2881 : END SELECT
2882 : CASE (3)
2883 11 : CALL block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2884 : CASE (4)
2885 11 : CALL block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2886 : CASE (5)
2887 7 : CALL block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2888 : CASE (6)
2889 7 : CALL block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2890 : CASE (7)
2891 7 : CALL block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2892 : CASE (9)
2893 8 : CALL block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2894 : CASE (10)
2895 9 : CALL block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2896 : CASE (11)
2897 10 : CALL block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2898 : CASE (15)
2899 11 : CALL block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2900 : CASE DEFAULT
2901 112 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2902 : END SELECT
2903 : CASE (3)
2904 865765 : SELECT CASE (mc_max)
2905 : CASE (1)
2906 93034 : SELECT CASE (md_max)
2907 : CASE (1)
2908 93025 : CALL block_4_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2909 : CASE (2)
2910 3 : CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2911 : CASE (3)
2912 39398 : CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2913 : CASE (4)
2914 22784 : CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2915 : CASE (5)
2916 10966 : CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2917 : CASE (6)
2918 2 : CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2919 : CASE (7)
2920 1 : CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2921 : CASE (9)
2922 1 : CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2923 : CASE (10)
2924 1 : CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2925 : CASE (11)
2926 1 : CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2927 : CASE (15)
2928 1 : CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2929 : CASE DEFAULT
2930 166183 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2931 : END SELECT
2932 : CASE (2)
2933 9 : CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2934 : CASE (3)
2935 60334 : CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2936 : CASE (4)
2937 259810 : CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2938 : CASE (5)
2939 128711 : CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2940 : CASE (6)
2941 7 : CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2942 : CASE (7)
2943 367 : CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2944 : CASE (9)
2945 8 : CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2946 : CASE (10)
2947 9 : CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2948 : CASE (11)
2949 10 : CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2950 : CASE (15)
2951 11 : CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2952 : CASE DEFAULT
2953 615459 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2954 : END SELECT
2955 : CASE (4)
2956 414843 : SELECT CASE (mc_max)
2957 : CASE (1)
2958 74690 : SELECT CASE (md_max)
2959 : CASE (1)
2960 74653 : CALL block_4_4_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2961 : CASE (2)
2962 9 : CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2963 : CASE (3)
2964 17355 : CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2965 : CASE (4)
2966 74924 : CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2967 : CASE (5)
2968 13379 : CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2969 : CASE (6)
2970 9 : CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2971 : CASE (7)
2972 386 : CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2973 : CASE (9)
2974 1 : CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2975 : CASE (10)
2976 2 : CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2977 : CASE (11)
2978 1 : CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2979 : CASE (15)
2980 1 : CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2981 : CASE DEFAULT
2982 180720 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2983 : END SELECT
2984 : CASE (2)
2985 37 : CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2986 : CASE (3)
2987 30500 : CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2988 : CASE (4)
2989 379643 : CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2990 : CASE (5)
2991 105060 : CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2992 : CASE (6)
2993 14 : CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2994 : CASE (7)
2995 3570 : CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2996 : CASE (9)
2997 8 : CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2998 : CASE (10)
2999 9 : CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3000 : CASE (11)
3001 10 : CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3002 : CASE (15)
3003 11 : CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3004 : CASE DEFAULT
3005 699582 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3006 : END SELECT
3007 : CASE (5)
3008 234123 : CALL block_4_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3009 : CASE (6)
3010 234 : CALL block_4_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3011 : CASE (7)
3012 8056 : CALL block_4_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3013 : CASE (9)
3014 93 : CALL block_4_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3015 : CASE (10)
3016 118 : CALL block_4_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3017 : CASE (11)
3018 151 : CALL block_4_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3019 : CASE (15)
3020 132 : CALL block_4_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3021 : CASE DEFAULT
3022 3162145 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3023 : END SELECT
3024 : CASE (5)
3025 1376032 : SELECT CASE (mb_max)
3026 : CASE (1)
3027 585165 : SELECT CASE (mc_max)
3028 : CASE (1)
3029 271631 : SELECT CASE (md_max)
3030 : CASE (1)
3031 244309 : CALL block_5_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3032 : CASE (2)
3033 4134 : CALL block_5_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3034 : CASE (3)
3035 125799 : CALL block_5_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3036 : CASE (4)
3037 30238 : CALL block_5_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3038 : CASE (5)
3039 42157 : CALL block_5_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3040 : CASE (6)
3041 5 : CALL block_5_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3042 : CASE (7)
3043 6324 : CALL block_5_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3044 : CASE (9)
3045 4 : CALL block_5_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3046 : CASE (10)
3047 4 : CALL block_5_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3048 : CASE (11)
3049 4 : CALL block_5_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3050 : CASE (15)
3051 4 : CALL block_5_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3052 : CASE DEFAULT
3053 452982 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3054 : END SELECT
3055 : CASE (2)
3056 316856 : SELECT CASE (md_max)
3057 : CASE (1)
3058 10288 : CALL block_5_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3059 : CASE (2)
3060 1917 : CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3061 : CASE (3)
3062 10139 : CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3063 : CASE (4)
3064 3 : CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3065 : CASE (5)
3066 4204 : CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3067 : CASE (6)
3068 4 : CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3069 : CASE (7)
3070 755 : CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3071 : CASE (9)
3072 3 : CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3073 : CASE (10)
3074 3 : CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3075 : CASE (11)
3076 3 : CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3077 : CASE (15)
3078 3 : CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3079 : CASE DEFAULT
3080 27322 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3081 : END SELECT
3082 : CASE (3)
3083 449602 : SELECT CASE (md_max)
3084 : CASE (1)
3085 154213 : CALL block_5_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3086 : CASE (2)
3087 6035 : CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3088 : CASE (3)
3089 98737 : CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3090 : CASE (4)
3091 8212 : CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3092 : CASE (5)
3093 32344 : CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3094 : CASE (6)
3095 4 : CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3096 : CASE (7)
3097 7011 : CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3098 : CASE (9)
3099 3 : CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3100 : CASE (10)
3101 3 : CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3102 : CASE (11)
3103 3 : CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3104 : CASE (15)
3105 3 : CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3106 : CASE DEFAULT
3107 306568 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3108 : END SELECT
3109 : CASE (4)
3110 295389 : CALL block_5_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3111 : CASE (5)
3112 264765 : CALL block_5_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3113 : CASE (6)
3114 18 : CALL block_5_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3115 : CASE (7)
3116 27175 : CALL block_5_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3117 : CASE (9)
3118 15 : CALL block_5_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3119 : CASE (10)
3120 10 : CALL block_5_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3121 : CASE (11)
3122 10 : CALL block_5_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3123 : CASE (15)
3124 11 : CALL block_5_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3125 : CASE DEFAULT
3126 1374265 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3127 : END SELECT
3128 : CASE (2)
3129 778177 : SELECT CASE (mc_max)
3130 : CASE (1)
3131 9708 : SELECT CASE (md_max)
3132 : CASE (1)
3133 1724 : CALL block_5_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3134 : CASE (2)
3135 655 : CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3136 : CASE (3)
3137 2383 : CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3138 : CASE (4)
3139 3 : CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3140 : CASE (5)
3141 1779 : CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3142 : CASE (6)
3143 2 : CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3144 : CASE (7)
3145 705 : CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3146 : CASE (9)
3147 1 : CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3148 : CASE (10)
3149 1 : CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3150 : CASE (11)
3151 1 : CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3152 : CASE (15)
3153 1 : CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3154 : CASE DEFAULT
3155 7255 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3156 : END SELECT
3157 : CASE (2)
3158 7984 : CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3159 : CASE (3)
3160 12185 : CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3161 : CASE (4)
3162 7 : CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3163 : CASE (5)
3164 54488 : CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3165 : CASE (6)
3166 7 : CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3167 : CASE (7)
3168 3127 : CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3169 : CASE (9)
3170 8 : CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3171 : CASE (10)
3172 9 : CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3173 : CASE (11)
3174 10 : CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3175 : CASE (15)
3176 11 : CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3177 : CASE DEFAULT
3178 132183 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3179 : END SELECT
3180 : CASE (3)
3181 456165 : SELECT CASE (mc_max)
3182 : CASE (1)
3183 135586 : SELECT CASE (md_max)
3184 : CASE (1)
3185 109966 : CALL block_5_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3186 : CASE (2)
3187 3999 : CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3188 : CASE (3)
3189 69186 : CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3190 : CASE (4)
3191 11368 : CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3192 : CASE (5)
3193 24422 : CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3194 : CASE (6)
3195 3 : CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3196 : CASE (7)
3197 5073 : CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3198 : CASE (9)
3199 1 : CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3200 : CASE (10)
3201 1 : CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3202 : CASE (11)
3203 1 : CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3204 : CASE (15)
3205 1 : CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3206 : CASE DEFAULT
3207 224021 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3208 : END SELECT
3209 : CASE (2)
3210 25620 : CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3211 : CASE (3)
3212 179302 : CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3213 : CASE (4)
3214 129752 : CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3215 : CASE (5)
3216 168268 : CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3217 : CASE (6)
3218 7 : CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3219 : CASE (7)
3220 20694 : CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3221 : CASE (9)
3222 8 : CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3223 : CASE (10)
3224 9 : CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3225 : CASE (11)
3226 10 : CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3227 : CASE (15)
3228 11 : CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3229 : CASE DEFAULT
3230 770922 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3231 : END SELECT
3232 : CASE (4)
3233 232144 : CALL block_5_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3234 : CASE (5)
3235 284854 : CALL block_5_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3236 : CASE (6)
3237 267 : CALL block_5_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3238 : CASE (7)
3239 55006 : CALL block_5_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3240 : CASE (9)
3241 77 : CALL block_5_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3242 : CASE (10)
3243 143 : CALL block_5_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3244 : CASE (11)
3245 172 : CALL block_5_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3246 : CASE (15)
3247 158 : CALL block_5_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3248 : CASE DEFAULT
3249 2886859 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3250 : END SELECT
3251 : CASE (6)
3252 378604 : SELECT CASE (mb_max)
3253 : CASE (1)
3254 166 : SELECT CASE (mc_max)
3255 : CASE (1)
3256 49 : SELECT CASE (md_max)
3257 : CASE (1)
3258 10 : CALL block_6_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3259 : CASE (2)
3260 6 : CALL block_6_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3261 : CASE (3)
3262 5 : CALL block_6_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3263 : CASE (4)
3264 5 : CALL block_6_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3265 : CASE (5)
3266 6 : CALL block_6_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3267 : CASE (6)
3268 5 : CALL block_6_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3269 : CASE (7)
3270 4 : CALL block_6_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3271 : CASE (9)
3272 4 : CALL block_6_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3273 : CASE (10)
3274 4 : CALL block_6_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3275 : CASE (11)
3276 4 : CALL block_6_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3277 : CASE (15)
3278 4 : CALL block_6_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3279 : CASE DEFAULT
3280 57 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3281 : END SELECT
3282 : CASE (2)
3283 44 : SELECT CASE (md_max)
3284 : CASE (1)
3285 4 : CALL block_6_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3286 : CASE (2)
3287 5 : CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3288 : CASE (3)
3289 3 : CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3290 : CASE (4)
3291 4 : CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3292 : CASE (5)
3293 4 : CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3294 : CASE (6)
3295 4 : CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3296 : CASE (7)
3297 3 : CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3298 : CASE (9)
3299 3 : CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3300 : CASE (10)
3301 3 : CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3302 : CASE (11)
3303 3 : CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3304 : CASE (15)
3305 3 : CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3306 : CASE DEFAULT
3307 39 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3308 : END SELECT
3309 : CASE (3)
3310 40 : SELECT CASE (md_max)
3311 : CASE (1)
3312 5 : CALL block_6_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3313 : CASE (2)
3314 3 : CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3315 : CASE (3)
3316 5 : CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3317 : CASE (4)
3318 4 : CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3319 : CASE (5)
3320 4 : CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3321 : CASE (6)
3322 4 : CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3323 : CASE (7)
3324 3 : CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3325 : CASE (9)
3326 3 : CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3327 : CASE (10)
3328 3 : CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3329 : CASE (11)
3330 3 : CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3331 : CASE (15)
3332 3 : CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3333 : CASE DEFAULT
3334 40 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3335 : END SELECT
3336 : CASE (4)
3337 35 : CALL block_6_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3338 : CASE (5)
3339 28 : CALL block_6_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3340 : CASE (6)
3341 24 : CALL block_6_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3342 : CASE (7)
3343 27 : CALL block_6_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3344 : CASE (9)
3345 19 : CALL block_6_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3346 : CASE (10)
3347 14 : CALL block_6_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3348 : CASE (11)
3349 10 : CALL block_6_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3350 : CASE (15)
3351 12 : CALL block_6_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3352 : CASE DEFAULT
3353 305 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3354 : END SELECT
3355 : CASE (2)
3356 135 : SELECT CASE (mc_max)
3357 : CASE (1)
3358 15 : SELECT CASE (md_max)
3359 : CASE (1)
3360 5 : CALL block_6_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3361 : CASE (2)
3362 3 : CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3363 : CASE (3)
3364 3 : CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3365 : CASE (4)
3366 3 : CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3367 : CASE (5)
3368 3 : CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3369 : CASE (6)
3370 3 : CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3371 : CASE (7)
3372 1 : CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3373 : CASE (9)
3374 1 : CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3375 : CASE (10)
3376 1 : CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3377 : CASE (11)
3378 1 : CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3379 : CASE (15)
3380 1 : CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3381 : CASE DEFAULT
3382 25 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3383 : END SELECT
3384 : CASE (2)
3385 10 : CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3386 : CASE (3)
3387 8 : CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3388 : CASE (4)
3389 7 : CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3390 : CASE (5)
3391 7 : CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3392 : CASE (6)
3393 8 : CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3394 : CASE (7)
3395 6 : CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3396 : CASE (9)
3397 8 : CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3398 : CASE (10)
3399 9 : CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3400 : CASE (11)
3401 10 : CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3402 : CASE (15)
3403 11 : CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3404 : CASE DEFAULT
3405 109 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3406 : END SELECT
3407 : CASE (3)
3408 137 : SELECT CASE (mc_max)
3409 : CASE (1)
3410 16 : SELECT CASE (md_max)
3411 : CASE (1)
3412 5 : CALL block_6_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3413 : CASE (2)
3414 4 : CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3415 : CASE (3)
3416 3 : CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3417 : CASE (4)
3418 3 : CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3419 : CASE (5)
3420 3 : CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3421 : CASE (6)
3422 3 : CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3423 : CASE (7)
3424 1 : CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3425 : CASE (9)
3426 1 : CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3427 : CASE (10)
3428 1 : CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3429 : CASE (11)
3430 1 : CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3431 : CASE (15)
3432 1 : CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3433 : CASE DEFAULT
3434 26 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3435 : END SELECT
3436 : CASE (2)
3437 11 : CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3438 : CASE (3)
3439 9 : CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3440 : CASE (4)
3441 7 : CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3442 : CASE (5)
3443 7 : CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3444 : CASE (6)
3445 8 : CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3446 : CASE (7)
3447 5 : CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3448 : CASE (9)
3449 7 : CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3450 : CASE (10)
3451 9 : CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3452 : CASE (11)
3453 10 : CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3454 : CASE (15)
3455 11 : CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3456 : CASE DEFAULT
3457 110 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3458 : END SELECT
3459 : CASE (4)
3460 111 : CALL block_6_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3461 : CASE (5)
3462 110 : CALL block_6_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3463 : CASE (6)
3464 346 : CALL block_6_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3465 : CASE (7)
3466 37 : CALL block_6_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3467 : CASE (9)
3468 99 : CALL block_6_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3469 : CASE (10)
3470 167 : CALL block_6_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3471 : CASE (11)
3472 193 : CALL block_6_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3473 : CASE (15)
3474 180 : CALL block_6_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3475 : CASE DEFAULT
3476 1767 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3477 : END SELECT
3478 : CASE (7)
3479 161339 : SELECT CASE (mb_max)
3480 : CASE (1)
3481 70823 : SELECT CASE (mc_max)
3482 : CASE (1)
3483 30957 : SELECT CASE (md_max)
3484 : CASE (1)
3485 27817 : CALL block_7_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3486 : CASE (2)
3487 716 : CALL block_7_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3488 : CASE (3)
3489 18263 : CALL block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3490 : CASE (4)
3491 99 : CALL block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3492 : CASE (5)
3493 6342 : CALL block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3494 : CASE (6)
3495 4 : CALL block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3496 : CASE (7)
3497 3510 : CALL block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3498 : CASE (9)
3499 5 : CALL block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3500 : CASE (10)
3501 5 : CALL block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3502 : CASE (11)
3503 4 : CALL block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3504 : CASE (15)
3505 5 : CALL block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3506 : CASE DEFAULT
3507 56770 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3508 : END SELECT
3509 : CASE (2)
3510 56356 : SELECT CASE (md_max)
3511 : CASE (1)
3512 715 : CALL block_7_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3513 : CASE (2)
3514 251 : CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3515 : CASE (3)
3516 961 : CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3517 : CASE (4)
3518 2 : CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3519 : CASE (5)
3520 707 : CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3521 : CASE (6)
3522 3 : CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3523 : CASE (7)
3524 491 : CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3525 : CASE (9)
3526 3 : CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3527 : CASE (10)
3528 2 : CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3529 : CASE (11)
3530 2 : CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3531 : CASE (15)
3532 3 : CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3533 : CASE DEFAULT
3534 3140 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3535 : END SELECT
3536 : CASE (3)
3537 55641 : CALL block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3538 : CASE (4)
3539 1433 : CALL block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3540 : CASE (5)
3541 26842 : CALL block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3542 : CASE (6)
3543 17 : CALL block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3544 : CASE (7)
3545 14898 : CALL block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3546 : CASE (9)
3547 46 : CALL block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3548 : CASE (10)
3549 36 : CALL block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3550 : CASE (11)
3551 25 : CALL block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3552 : CASE (15)
3553 23 : CALL block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3554 : CASE DEFAULT
3555 158871 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3556 : END SELECT
3557 : CASE (2)
3558 110740 : SELECT CASE (mc_max)
3559 : CASE (1)
3560 1818 : SELECT CASE (md_max)
3561 : CASE (1)
3562 738 : CALL block_7_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3563 : CASE (2)
3564 249 : CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3565 : CASE (3)
3566 977 : CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3567 : CASE (4)
3568 1 : CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3569 : CASE (5)
3570 753 : CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3571 : CASE (6)
3572 1 : CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3573 : CASE (7)
3574 489 : CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3575 : CASE (9)
3576 1 : CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3577 : CASE (10)
3578 1 : CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3579 : CASE (11)
3580 1 : CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3581 : CASE (15)
3582 1 : CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3583 : CASE DEFAULT
3584 3212 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3585 : END SELECT
3586 : CASE (2)
3587 1080 : CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3588 : CASE (3)
3589 4368 : CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3590 : CASE (4)
3591 0 : CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3592 : CASE (5)
3593 3242 : CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3594 : CASE (6)
3595 4 : CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3596 : CASE (7)
3597 2110 : CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3598 : CASE (9)
3599 7 : CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3600 : CASE (10)
3601 9 : CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3602 : CASE (11)
3603 10 : CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3604 : CASE (15)
3605 11 : CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3606 : CASE DEFAULT
3607 14053 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3608 : END SELECT
3609 : CASE (3)
3610 107528 : CALL block_7_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3611 : CASE (4)
3612 8042 : CALL block_7_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3613 : CASE (5)
3614 55460 : CALL block_7_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3615 : CASE (6)
3616 112 : CALL block_7_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3617 : CASE (7)
3618 33242 : CALL block_7_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3619 : CASE (9)
3620 196 : CALL block_7_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3621 : CASE (10)
3622 240 : CALL block_7_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3623 : CASE (11)
3624 279 : CALL block_7_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3625 : CASE (15)
3626 276 : CALL block_7_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3627 : CASE DEFAULT
3628 378299 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3629 : END SELECT
3630 : CASE (9)
3631 1999 : SELECT CASE (mb_max)
3632 : CASE (1)
3633 113 : SELECT CASE (mc_max)
3634 : CASE (1)
3635 40 : SELECT CASE (md_max)
3636 : CASE (1)
3637 11 : CALL block_9_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3638 : CASE (2)
3639 4 : CALL block_9_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3640 : CASE (3)
3641 3 : CALL block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3642 : CASE (4)
3643 3 : CALL block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3644 : CASE (5)
3645 4 : CALL block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3646 : CASE (6)
3647 4 : CALL block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3648 : CASE (7)
3649 6 : CALL block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3650 : CASE (9)
3651 6 : CALL block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3652 : CASE (10)
3653 5 : CALL block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3654 : CASE (11)
3655 5 : CALL block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3656 : CASE (15)
3657 5 : CALL block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3658 : CASE DEFAULT
3659 56 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3660 : END SELECT
3661 : CASE (2)
3662 36 : SELECT CASE (md_max)
3663 : CASE (1)
3664 3 : CALL block_9_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3665 : CASE (2)
3666 3 : CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3667 : CASE (3)
3668 1 : CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3669 : CASE (4)
3670 2 : CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3671 : CASE (5)
3672 3 : CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3673 : CASE (6)
3674 3 : CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3675 : CASE (7)
3676 3 : CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3677 : CASE (9)
3678 3 : CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3679 : CASE (10)
3680 3 : CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3681 : CASE (11)
3682 2 : CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3683 : CASE (15)
3684 3 : CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3685 : CASE DEFAULT
3686 29 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3687 : END SELECT
3688 : CASE (3)
3689 33 : CALL block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3690 : CASE (4)
3691 28 : CALL block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3692 : CASE (5)
3693 22 : CALL block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3694 : CASE (6)
3695 18 : CALL block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3696 : CASE (7)
3697 62 : CALL block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3698 : CASE (9)
3699 54 : CALL block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3700 : CASE (10)
3701 42 : CALL block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3702 : CASE (11)
3703 29 : CALL block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3704 : CASE (15)
3705 26 : CALL block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3706 : CASE DEFAULT
3707 399 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3708 : END SELECT
3709 : CASE (2)
3710 595 : SELECT CASE (mc_max)
3711 : CASE (1)
3712 2 : SELECT CASE (md_max)
3713 : CASE (1)
3714 2 : CALL block_9_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3715 : CASE (2)
3716 1 : CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3717 : CASE (3)
3718 1 : CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3719 : CASE (4)
3720 1 : CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3721 : CASE (5)
3722 1 : CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3723 : CASE (6)
3724 1 : CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3725 : CASE (7)
3726 1 : CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3727 : CASE (9)
3728 1 : CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3729 : CASE (10)
3730 1 : CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3731 : CASE (11)
3732 1 : CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3733 : CASE (15)
3734 1 : CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3735 : CASE DEFAULT
3736 12 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3737 : END SELECT
3738 : CASE (2)
3739 0 : CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3740 : CASE (3)
3741 0 : CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3742 : CASE (4)
3743 0 : CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3744 : CASE (5)
3745 1 : CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3746 : CASE (6)
3747 3 : CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3748 : CASE (7)
3749 5 : CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3750 : CASE (9)
3751 7 : CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3752 : CASE (10)
3753 8 : CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3754 : CASE (11)
3755 10 : CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3756 : CASE (15)
3757 11 : CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3758 : CASE DEFAULT
3759 57 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3760 : END SELECT
3761 : CASE (3)
3762 583 : CALL block_9_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3763 : CASE (4)
3764 45 : CALL block_9_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3765 : CASE (5)
3766 75 : CALL block_9_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3767 : CASE (6)
3768 76 : CALL block_9_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3769 : CASE (7)
3770 45 : CALL block_9_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3771 : CASE (9)
3772 362 : CALL block_9_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3773 : CASE (10)
3774 213 : CALL block_9_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3775 : CASE (11)
3776 308 : CALL block_9_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3777 : CASE (15)
3778 305 : CALL block_9_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3779 : CASE DEFAULT
3780 2468 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3781 : END SELECT
3782 : CASE (10)
3783 1598 : SELECT CASE (mb_max)
3784 : CASE (1)
3785 99 : SELECT CASE (mc_max)
3786 : CASE (1)
3787 30 : SELECT CASE (md_max)
3788 : CASE (1)
3789 9 : CALL block_10_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3790 : CASE (2)
3791 3 : CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3792 : CASE (3)
3793 3 : CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3794 : CASE (4)
3795 3 : CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3796 : CASE (5)
3797 3 : CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3798 : CASE (6)
3799 3 : CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3800 : CASE (7)
3801 5 : CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3802 : CASE (9)
3803 5 : CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3804 : CASE (10)
3805 5 : CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3806 : CASE (11)
3807 4 : CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3808 : CASE (15)
3809 4 : CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3810 : CASE DEFAULT
3811 47 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3812 : END SELECT
3813 : CASE (2)
3814 21 : CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3815 : CASE (3)
3816 21 : CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3817 : CASE (4)
3818 17 : CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3819 : CASE (5)
3820 18 : CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3821 : CASE (6)
3822 16 : CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3823 : CASE (7)
3824 57 : CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3825 : CASE (9)
3826 47 : CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3827 : CASE (10)
3828 46 : CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3829 : CASE (11)
3830 33 : CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3831 : CASE (15)
3832 26 : CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3833 : CASE DEFAULT
3834 349 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3835 : END SELECT
3836 : CASE (2)
3837 52 : CALL block_10_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3838 : CASE (3)
3839 46 : CALL block_10_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3840 : CASE (4)
3841 39 : CALL block_10_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3842 : CASE (5)
3843 33 : CALL block_10_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3844 : CASE (6)
3845 27 : CALL block_10_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3846 : CASE (7)
3847 45 : CALL block_10_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3848 : CASE (9)
3849 104 : CALL block_10_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3850 : CASE (10)
3851 309 : CALL block_10_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3852 : CASE (11)
3853 329 : CALL block_10_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3854 : CASE (15)
3855 267 : CALL block_10_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3856 : CASE DEFAULT
3857 1600 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3858 : END SELECT
3859 : CASE (11)
3860 1730 : SELECT CASE (mb_max)
3861 : CASE (1)
3862 95 : SELECT CASE (mc_max)
3863 : CASE (1)
3864 30 : SELECT CASE (md_max)
3865 : CASE (1)
3866 9 : CALL block_11_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3867 : CASE (2)
3868 3 : CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3869 : CASE (3)
3870 3 : CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3871 : CASE (4)
3872 3 : CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3873 : CASE (5)
3874 3 : CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3875 : CASE (6)
3876 3 : CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3877 : CASE (7)
3878 5 : CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3879 : CASE (9)
3880 5 : CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3881 : CASE (10)
3882 5 : CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3883 : CASE (11)
3884 5 : CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3885 : CASE (15)
3886 4 : CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3887 : CASE DEFAULT
3888 48 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3889 : END SELECT
3890 : CASE (2)
3891 21 : CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3892 : CASE (3)
3893 21 : CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3894 : CASE (4)
3895 17 : CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3896 : CASE (5)
3897 17 : CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3898 : CASE (6)
3899 15 : CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3900 : CASE (7)
3901 58 : CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3902 : CASE (9)
3903 49 : CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3904 : CASE (10)
3905 45 : CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3906 : CASE (11)
3907 39 : CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3908 : CASE (15)
3909 32 : CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3910 : CASE DEFAULT
3911 362 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3912 : END SELECT
3913 : CASE (2)
3914 47 : CALL block_11_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3915 : CASE (3)
3916 40 : CALL block_11_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3917 : CASE (4)
3918 34 : CALL block_11_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3919 : CASE (5)
3920 28 : CALL block_11_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3921 : CASE (6)
3922 23 : CALL block_11_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3923 : CASE (7)
3924 45 : CALL block_11_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3925 : CASE (9)
3926 47 : CALL block_11_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3927 : CASE (10)
3928 49 : CALL block_11_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3929 : CASE (11)
3930 359 : CALL block_11_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3931 : CASE (15)
3932 215 : CALL block_11_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3933 : CASE DEFAULT
3934 1249 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3935 : END SELECT
3936 : CASE (15)
3937 227294 : SELECT CASE (mb_max)
3938 : CASE (1)
3939 100 : SELECT CASE (mc_max)
3940 : CASE (1)
3941 41 : SELECT CASE (md_max)
3942 : CASE (1)
3943 11 : CALL block_15_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3944 : CASE (2)
3945 4 : CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3946 : CASE (3)
3947 3 : CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3948 : CASE (4)
3949 3 : CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3950 : CASE (5)
3951 4 : CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3952 : CASE (6)
3953 4 : CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3954 : CASE (7)
3955 6 : CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3956 : CASE (9)
3957 6 : CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3958 : CASE (10)
3959 6 : CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3960 : CASE (11)
3961 6 : CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3962 : CASE (15)
3963 6 : CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3964 : CASE DEFAULT
3965 59 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3966 : END SELECT
3967 : CASE (2)
3968 30 : CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3969 : CASE (3)
3970 33 : CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3971 : CASE (4)
3972 28 : CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3973 : CASE (5)
3974 22 : CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3975 : CASE (6)
3976 17 : CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3977 : CASE (7)
3978 67 : CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3979 : CASE (9)
3980 57 : CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3981 : CASE (10)
3982 45 : CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3983 : CASE (11)
3984 37 : CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3985 : CASE (15)
3986 38 : CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3987 : CASE DEFAULT
3988 433 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3989 : END SELECT
3990 : CASE (2)
3991 41 : CALL block_15_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3992 : CASE (3)
3993 35 : CALL block_15_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3994 : CASE (4)
3995 29 : CALL block_15_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3996 : CASE (5)
3997 24 : CALL block_15_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3998 : CASE (6)
3999 19 : CALL block_15_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4000 : CASE (7)
4001 47 : CALL block_15_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4002 : CASE (9)
4003 49 : CALL block_15_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4004 : CASE (10)
4005 124 : CALL block_15_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4006 : CASE (11)
4007 203 : CALL block_15_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4008 : CASE (15)
4009 364 : CALL block_15_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4010 : CASE DEFAULT
4011 1368 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4012 : END SELECT
4013 : CASE DEFAULT
4014 71555570 : CALL block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4015 : END SELECT
4016 : #endif
4017 71555570 : END SUBROUTINE contract_block
4018 :
4019 : #if defined (__LIBINT)
4020 : ! **************************************************************************************************
4021 : !> \brief ...
4022 : !> \param ma_max ...
4023 : !> \param mb_max ...
4024 : !> \param mc_max ...
4025 : !> \param md_max ...
4026 : !> \param kbd ...
4027 : !> \param kbc ...
4028 : !> \param kad ...
4029 : !> \param kac ...
4030 : !> \param pbd ...
4031 : !> \param pbc ...
4032 : !> \param pad ...
4033 : !> \param pac ...
4034 : !> \param prim ...
4035 : !> \param scale ...
4036 : ! **************************************************************************************************
4037 470892 : SUBROUTINE block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4038 : INTEGER :: ma_max, mb_max, mc_max, md_max
4039 : REAL(KIND=dp) :: kbd(mb_max*md_max), kbc(mb_max*mc_max), kad(ma_max*md_max), &
4040 : kac(ma_max*mc_max), pbd(mb_max*md_max), pbc(mb_max*mc_max), pad(ma_max*md_max), &
4041 : pac(ma_max*mc_max), prim(ma_max*mb_max*mc_max*md_max), scale
4042 :
4043 : INTEGER :: ma, mb, mc, md, p_index
4044 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4045 :
4046 9275868 : kbd(1:mb_max*md_max) = 0.0_dp
4047 11694300 : kbc(1:mb_max*mc_max) = 0.0_dp
4048 13924734 : kad(1:ma_max*md_max) = 0.0_dp
4049 18526188 : kac(1:ma_max*mc_max) = 0.0_dp
4050 : p_index = 0
4051 2773479 : DO md = 1, md_max
4052 19011846 : DO mc = 1, mc_max
4053 78895641 : DO mb = 1, mb_max
4054 60354687 : ks_bd = 0.0_dp
4055 60354687 : ks_bc = 0.0_dp
4056 60354687 : p_bd = pbd((md - 1)*mb_max + mb)
4057 60354687 : p_bc = pbc((mc - 1)*mb_max + mb)
4058 426279153 : DO ma = 1, ma_max
4059 365924466 : p_index = p_index + 1
4060 365924466 : tmp = scale*prim(p_index)
4061 365924466 : ks_bc = ks_bc + tmp*pad((md - 1)*ma_max + ma)
4062 365924466 : ks_bd = ks_bd + tmp*pac((mc - 1)*ma_max + ma)
4063 365924466 : kad((md - 1)*ma_max + ma) = kad((md - 1)*ma_max + ma) - tmp*p_bc
4064 426279153 : kac((mc - 1)*ma_max + ma) = kac((mc - 1)*ma_max + ma) - tmp*p_bd
4065 : END DO
4066 60354687 : kbd((md - 1)*mb_max + mb) = kbd((md - 1)*mb_max + mb) - ks_bd
4067 76593054 : kbc((mc - 1)*mb_max + mb) = kbc((mc - 1)*mb_max + mb) - ks_bc
4068 : END DO
4069 : END DO
4070 : END DO
4071 470892 : END SUBROUTINE block_default
4072 : ! **************************************************************************************************
4073 : !> \brief ...
4074 : !> \param kbd ...
4075 : !> \param kbc ...
4076 : !> \param kad ...
4077 : !> \param kac ...
4078 : !> \param pbd ...
4079 : !> \param pbc ...
4080 : !> \param pad ...
4081 : !> \param pac ...
4082 : !> \param prim ...
4083 : !> \param scale ...
4084 : ! **************************************************************************************************
4085 12148798 : SUBROUTINE block_1_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4086 : REAL(KIND=dp) :: kbd(1*1), kbc(1*1), kad(1*1), kac(1*1), &
4087 : pbd(1*1), pbc(1*1), pad(1*1), &
4088 : pac(1*1), prim(1*1*1*1), scale
4089 :
4090 : INTEGER :: ma, mb, mc, md, p_index
4091 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4092 :
4093 12148798 : kbd(1:1*1) = 0.0_dp
4094 12148798 : kbc(1:1*1) = 0.0_dp
4095 12148798 : kad(1:1*1) = 0.0_dp
4096 12148798 : kac(1:1*1) = 0.0_dp
4097 12148798 : p_index = 0
4098 24297596 : DO md = 1, 1
4099 36446394 : DO mc = 1, 1
4100 36446394 : DO mb = 1, 1
4101 12148798 : ks_bd = 0.0_dp
4102 12148798 : ks_bc = 0.0_dp
4103 12148798 : p_bd = pbd((md - 1)*1 + mb)
4104 12148798 : p_bc = pbc((mc - 1)*1 + mb)
4105 24297596 : DO ma = 1, 1
4106 12148798 : p_index = p_index + 1
4107 12148798 : tmp = scale*prim(p_index)
4108 12148798 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4109 12148798 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4110 12148798 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4111 24297596 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4112 : END DO
4113 12148798 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4114 24297596 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4115 : END DO
4116 : END DO
4117 : END DO
4118 12148798 : END SUBROUTINE block_1_1_1_1
4119 : ! **************************************************************************************************
4120 : !> \brief ...
4121 : !> \param kbd ...
4122 : !> \param kbc ...
4123 : !> \param kad ...
4124 : !> \param kac ...
4125 : !> \param pbd ...
4126 : !> \param pbc ...
4127 : !> \param pad ...
4128 : !> \param pac ...
4129 : !> \param prim ...
4130 : !> \param scale ...
4131 : ! **************************************************************************************************
4132 10391 : SUBROUTINE block_1_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4133 : REAL(KIND=dp) :: kbd(1*2), kbc(1*1), kad(1*2), kac(1*1), &
4134 : pbd(1*2), pbc(1*1), pad(1*2), &
4135 : pac(1*1), prim(1*1*1*2), scale
4136 :
4137 : INTEGER :: ma, mb, mc, md, p_index
4138 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4139 :
4140 10391 : kbd(1:1*2) = 0.0_dp
4141 10391 : kbc(1:1*1) = 0.0_dp
4142 10391 : kad(1:1*2) = 0.0_dp
4143 10391 : kac(1:1*1) = 0.0_dp
4144 10391 : p_index = 0
4145 31173 : DO md = 1, 2
4146 51955 : DO mc = 1, 1
4147 62346 : DO mb = 1, 1
4148 20782 : ks_bd = 0.0_dp
4149 20782 : ks_bc = 0.0_dp
4150 20782 : p_bd = pbd((md - 1)*1 + mb)
4151 20782 : p_bc = pbc((mc - 1)*1 + mb)
4152 41564 : DO ma = 1, 1
4153 20782 : p_index = p_index + 1
4154 20782 : tmp = scale*prim(p_index)
4155 20782 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4156 20782 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4157 20782 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4158 41564 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4159 : END DO
4160 20782 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4161 41564 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4162 : END DO
4163 : END DO
4164 : END DO
4165 10391 : END SUBROUTINE block_1_1_1_2
4166 : ! **************************************************************************************************
4167 : !> \brief ...
4168 : !> \param kbd ...
4169 : !> \param kbc ...
4170 : !> \param kad ...
4171 : !> \param kac ...
4172 : !> \param pbd ...
4173 : !> \param pbc ...
4174 : !> \param pad ...
4175 : !> \param pac ...
4176 : !> \param prim ...
4177 : !> \param scale ...
4178 : ! **************************************************************************************************
4179 4424082 : SUBROUTINE block_1_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4180 : REAL(KIND=dp) :: kbd(1*3), kbc(1*1), kad(1*3), kac(1*1), &
4181 : pbd(1*3), pbc(1*1), pad(1*3), &
4182 : pac(1*1), prim(1*1*1*3), scale
4183 :
4184 : INTEGER :: ma, mb, mc, md, p_index
4185 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4186 :
4187 4424082 : kbd(1:1*3) = 0.0_dp
4188 4424082 : kbc(1:1*1) = 0.0_dp
4189 4424082 : kad(1:1*3) = 0.0_dp
4190 4424082 : kac(1:1*1) = 0.0_dp
4191 4424082 : p_index = 0
4192 17696328 : DO md = 1, 3
4193 30968574 : DO mc = 1, 1
4194 39816738 : DO mb = 1, 1
4195 13272246 : ks_bd = 0.0_dp
4196 13272246 : ks_bc = 0.0_dp
4197 13272246 : p_bd = pbd((md - 1)*1 + mb)
4198 13272246 : p_bc = pbc((mc - 1)*1 + mb)
4199 26544492 : DO ma = 1, 1
4200 13272246 : p_index = p_index + 1
4201 13272246 : tmp = scale*prim(p_index)
4202 13272246 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4203 13272246 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4204 13272246 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4205 26544492 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4206 : END DO
4207 13272246 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4208 26544492 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4209 : END DO
4210 : END DO
4211 : END DO
4212 4424082 : END SUBROUTINE block_1_1_1_3
4213 : ! **************************************************************************************************
4214 : !> \brief ...
4215 : !> \param kbd ...
4216 : !> \param kbc ...
4217 : !> \param kad ...
4218 : !> \param kac ...
4219 : !> \param pbd ...
4220 : !> \param pbc ...
4221 : !> \param pad ...
4222 : !> \param pac ...
4223 : !> \param prim ...
4224 : !> \param scale ...
4225 : ! **************************************************************************************************
4226 156602 : SUBROUTINE block_1_1_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4227 : REAL(KIND=dp) :: kbd(1*4), kbc(1*1), kad(1*4), kac(1*1), &
4228 : pbd(1*4), pbc(1*1), pad(1*4), &
4229 : pac(1*1), prim(1*1*1*4), scale
4230 :
4231 : INTEGER :: ma, mb, mc, md, p_index
4232 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4233 :
4234 156602 : kbd(1:1*4) = 0.0_dp
4235 156602 : kbc(1:1*1) = 0.0_dp
4236 156602 : kad(1:1*4) = 0.0_dp
4237 156602 : kac(1:1*1) = 0.0_dp
4238 156602 : p_index = 0
4239 783010 : DO md = 1, 4
4240 1409418 : DO mc = 1, 1
4241 1879224 : DO mb = 1, 1
4242 626408 : ks_bd = 0.0_dp
4243 626408 : ks_bc = 0.0_dp
4244 626408 : p_bd = pbd((md - 1)*1 + mb)
4245 626408 : p_bc = pbc((mc - 1)*1 + mb)
4246 1252816 : DO ma = 1, 1
4247 626408 : p_index = p_index + 1
4248 626408 : tmp = scale*prim(p_index)
4249 626408 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4250 626408 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4251 626408 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4252 1252816 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4253 : END DO
4254 626408 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4255 1252816 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4256 : END DO
4257 : END DO
4258 : END DO
4259 156602 : END SUBROUTINE block_1_1_1_4
4260 : ! **************************************************************************************************
4261 : !> \brief ...
4262 : !> \param kbd ...
4263 : !> \param kbc ...
4264 : !> \param kad ...
4265 : !> \param kac ...
4266 : !> \param pbd ...
4267 : !> \param pbc ...
4268 : !> \param pad ...
4269 : !> \param pac ...
4270 : !> \param prim ...
4271 : !> \param scale ...
4272 : ! **************************************************************************************************
4273 177061 : SUBROUTINE block_1_1_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4274 : REAL(KIND=dp) :: kbd(1*5), kbc(1*1), kad(1*5), kac(1*1), &
4275 : pbd(1*5), pbc(1*1), pad(1*5), &
4276 : pac(1*1), prim(1*1*1*5), scale
4277 :
4278 : INTEGER :: ma, mb, mc, md, p_index
4279 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4280 :
4281 177061 : kbd(1:1*5) = 0.0_dp
4282 177061 : kbc(1:1*1) = 0.0_dp
4283 177061 : kad(1:1*5) = 0.0_dp
4284 177061 : kac(1:1*1) = 0.0_dp
4285 177061 : p_index = 0
4286 1062366 : DO md = 1, 5
4287 1947671 : DO mc = 1, 1
4288 2655915 : DO mb = 1, 1
4289 885305 : ks_bd = 0.0_dp
4290 885305 : ks_bc = 0.0_dp
4291 885305 : p_bd = pbd((md - 1)*1 + mb)
4292 885305 : p_bc = pbc((mc - 1)*1 + mb)
4293 1770610 : DO ma = 1, 1
4294 885305 : p_index = p_index + 1
4295 885305 : tmp = scale*prim(p_index)
4296 885305 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4297 885305 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4298 885305 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4299 1770610 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4300 : END DO
4301 885305 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4302 1770610 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4303 : END DO
4304 : END DO
4305 : END DO
4306 177061 : END SUBROUTINE block_1_1_1_5
4307 : ! **************************************************************************************************
4308 : !> \brief ...
4309 : !> \param kbd ...
4310 : !> \param kbc ...
4311 : !> \param kad ...
4312 : !> \param kac ...
4313 : !> \param pbd ...
4314 : !> \param pbc ...
4315 : !> \param pad ...
4316 : !> \param pac ...
4317 : !> \param prim ...
4318 : !> \param scale ...
4319 : ! **************************************************************************************************
4320 11 : SUBROUTINE block_1_1_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4321 : REAL(KIND=dp) :: kbd(1*6), kbc(1*1), kad(1*6), kac(1*1), &
4322 : pbd(1*6), pbc(1*1), pad(1*6), &
4323 : pac(1*1), prim(1*1*1*6), scale
4324 :
4325 : INTEGER :: ma, mb, mc, md, p_index
4326 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4327 :
4328 11 : kbd(1:1*6) = 0.0_dp
4329 11 : kbc(1:1*1) = 0.0_dp
4330 11 : kad(1:1*6) = 0.0_dp
4331 11 : kac(1:1*1) = 0.0_dp
4332 11 : p_index = 0
4333 77 : DO md = 1, 6
4334 143 : DO mc = 1, 1
4335 198 : DO mb = 1, 1
4336 66 : ks_bd = 0.0_dp
4337 66 : ks_bc = 0.0_dp
4338 66 : p_bd = pbd((md - 1)*1 + mb)
4339 66 : p_bc = pbc((mc - 1)*1 + mb)
4340 132 : DO ma = 1, 1
4341 66 : p_index = p_index + 1
4342 66 : tmp = scale*prim(p_index)
4343 66 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4344 66 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4345 66 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4346 132 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4347 : END DO
4348 66 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4349 132 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4350 : END DO
4351 : END DO
4352 : END DO
4353 11 : END SUBROUTINE block_1_1_1_6
4354 : ! **************************************************************************************************
4355 : !> \brief ...
4356 : !> \param kbd ...
4357 : !> \param kbc ...
4358 : !> \param kad ...
4359 : !> \param kac ...
4360 : !> \param pbd ...
4361 : !> \param pbc ...
4362 : !> \param pad ...
4363 : !> \param pac ...
4364 : !> \param prim ...
4365 : !> \param scale ...
4366 : ! **************************************************************************************************
4367 23226 : SUBROUTINE block_1_1_1_7(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4368 : REAL(KIND=dp) :: kbd(1*7), kbc(1*1), kad(1*7), kac(1*1), &
4369 : pbd(1*7), pbc(1*1), pad(1*7), &
4370 : pac(1*1), prim(1*1*1*7), scale
4371 :
4372 : INTEGER :: ma, mb, mc, md, p_index
4373 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4374 :
4375 23226 : kbd(1:1*7) = 0.0_dp
4376 23226 : kbc(1:1*1) = 0.0_dp
4377 23226 : kad(1:1*7) = 0.0_dp
4378 23226 : kac(1:1*1) = 0.0_dp
4379 23226 : p_index = 0
4380 185808 : DO md = 1, 7
4381 348390 : DO mc = 1, 1
4382 487746 : DO mb = 1, 1
4383 162582 : ks_bd = 0.0_dp
4384 162582 : ks_bc = 0.0_dp
4385 162582 : p_bd = pbd((md - 1)*1 + mb)
4386 162582 : p_bc = pbc((mc - 1)*1 + mb)
4387 325164 : DO ma = 1, 1
4388 162582 : p_index = p_index + 1
4389 162582 : tmp = scale*prim(p_index)
4390 162582 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4391 162582 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4392 162582 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4393 325164 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4394 : END DO
4395 162582 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4396 325164 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4397 : END DO
4398 : END DO
4399 : END DO
4400 23226 : END SUBROUTINE block_1_1_1_7
4401 : ! **************************************************************************************************
4402 : !> \brief ...
4403 : !> \param kbd ...
4404 : !> \param kbc ...
4405 : !> \param kad ...
4406 : !> \param kac ...
4407 : !> \param pbd ...
4408 : !> \param pbc ...
4409 : !> \param pad ...
4410 : !> \param pac ...
4411 : !> \param prim ...
4412 : !> \param scale ...
4413 : ! **************************************************************************************************
4414 10 : SUBROUTINE block_1_1_1_9(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4415 : REAL(KIND=dp) :: kbd(1*9), kbc(1*1), kad(1*9), kac(1*1), &
4416 : pbd(1*9), pbc(1*1), pad(1*9), &
4417 : pac(1*1), prim(1*1*1*9), scale
4418 :
4419 : INTEGER :: ma, mb, mc, md, p_index
4420 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4421 :
4422 10 : kbd(1:1*9) = 0.0_dp
4423 10 : kbc(1:1*1) = 0.0_dp
4424 10 : kad(1:1*9) = 0.0_dp
4425 10 : kac(1:1*1) = 0.0_dp
4426 10 : p_index = 0
4427 100 : DO md = 1, 9
4428 190 : DO mc = 1, 1
4429 270 : DO mb = 1, 1
4430 90 : ks_bd = 0.0_dp
4431 90 : ks_bc = 0.0_dp
4432 90 : p_bd = pbd((md - 1)*1 + mb)
4433 90 : p_bc = pbc((mc - 1)*1 + mb)
4434 180 : DO ma = 1, 1
4435 90 : p_index = p_index + 1
4436 90 : tmp = scale*prim(p_index)
4437 90 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4438 90 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4439 90 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4440 180 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4441 : END DO
4442 90 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4443 180 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4444 : END DO
4445 : END DO
4446 : END DO
4447 10 : END SUBROUTINE block_1_1_1_9
4448 : ! **************************************************************************************************
4449 : !> \brief ...
4450 : !> \param kbd ...
4451 : !> \param kbc ...
4452 : !> \param kad ...
4453 : !> \param kac ...
4454 : !> \param pbd ...
4455 : !> \param pbc ...
4456 : !> \param pad ...
4457 : !> \param pac ...
4458 : !> \param prim ...
4459 : !> \param scale ...
4460 : ! **************************************************************************************************
4461 9 : SUBROUTINE block_1_1_1_10(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4462 : REAL(KIND=dp) :: kbd(1*10), kbc(1*1), kad(1*10), &
4463 : kac(1*1), pbd(1*10), pbc(1*1), &
4464 : pad(1*10), pac(1*1), prim(1*1*1*10), &
4465 : scale
4466 :
4467 : INTEGER :: ma, mb, mc, md, p_index
4468 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4469 :
4470 9 : kbd(1:1*10) = 0.0_dp
4471 9 : kbc(1:1*1) = 0.0_dp
4472 9 : kad(1:1*10) = 0.0_dp
4473 9 : kac(1:1*1) = 0.0_dp
4474 9 : p_index = 0
4475 99 : DO md = 1, 10
4476 189 : DO mc = 1, 1
4477 270 : DO mb = 1, 1
4478 90 : ks_bd = 0.0_dp
4479 90 : ks_bc = 0.0_dp
4480 90 : p_bd = pbd((md - 1)*1 + mb)
4481 90 : p_bc = pbc((mc - 1)*1 + mb)
4482 180 : DO ma = 1, 1
4483 90 : p_index = p_index + 1
4484 90 : tmp = scale*prim(p_index)
4485 90 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4486 90 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4487 90 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4488 180 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4489 : END DO
4490 90 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4491 180 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4492 : END DO
4493 : END DO
4494 : END DO
4495 9 : END SUBROUTINE block_1_1_1_10
4496 : ! **************************************************************************************************
4497 : !> \brief ...
4498 : !> \param kbd ...
4499 : !> \param kbc ...
4500 : !> \param kad ...
4501 : !> \param kac ...
4502 : !> \param pbd ...
4503 : !> \param pbc ...
4504 : !> \param pad ...
4505 : !> \param pac ...
4506 : !> \param prim ...
4507 : !> \param scale ...
4508 : ! **************************************************************************************************
4509 9 : SUBROUTINE block_1_1_1_11(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4510 : REAL(KIND=dp) :: kbd(1*11), kbc(1*1), kad(1*11), &
4511 : kac(1*1), pbd(1*11), pbc(1*1), &
4512 : pad(1*11), pac(1*1), prim(1*1*1*11), &
4513 : scale
4514 :
4515 : INTEGER :: ma, mb, mc, md, p_index
4516 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4517 :
4518 9 : kbd(1:1*11) = 0.0_dp
4519 9 : kbc(1:1*1) = 0.0_dp
4520 9 : kad(1:1*11) = 0.0_dp
4521 9 : kac(1:1*1) = 0.0_dp
4522 9 : p_index = 0
4523 108 : DO md = 1, 11
4524 207 : DO mc = 1, 1
4525 297 : DO mb = 1, 1
4526 99 : ks_bd = 0.0_dp
4527 99 : ks_bc = 0.0_dp
4528 99 : p_bd = pbd((md - 1)*1 + mb)
4529 99 : p_bc = pbc((mc - 1)*1 + mb)
4530 198 : DO ma = 1, 1
4531 99 : p_index = p_index + 1
4532 99 : tmp = scale*prim(p_index)
4533 99 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4534 99 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4535 99 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4536 198 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4537 : END DO
4538 99 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4539 198 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4540 : END DO
4541 : END DO
4542 : END DO
4543 9 : END SUBROUTINE block_1_1_1_11
4544 : ! **************************************************************************************************
4545 : !> \brief ...
4546 : !> \param kbd ...
4547 : !> \param kbc ...
4548 : !> \param kad ...
4549 : !> \param kac ...
4550 : !> \param pbd ...
4551 : !> \param pbc ...
4552 : !> \param pad ...
4553 : !> \param pac ...
4554 : !> \param prim ...
4555 : !> \param scale ...
4556 : ! **************************************************************************************************
4557 10 : SUBROUTINE block_1_1_1_15(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4558 : REAL(KIND=dp) :: kbd(1*15), kbc(1*1), kad(1*15), &
4559 : kac(1*1), pbd(1*15), pbc(1*1), &
4560 : pad(1*15), pac(1*1), prim(1*1*1*15), &
4561 : scale
4562 :
4563 : INTEGER :: ma, mb, mc, md, p_index
4564 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4565 :
4566 10 : kbd(1:1*15) = 0.0_dp
4567 10 : kbc(1:1*1) = 0.0_dp
4568 10 : kad(1:1*15) = 0.0_dp
4569 10 : kac(1:1*1) = 0.0_dp
4570 10 : p_index = 0
4571 160 : DO md = 1, 15
4572 310 : DO mc = 1, 1
4573 450 : DO mb = 1, 1
4574 150 : ks_bd = 0.0_dp
4575 150 : ks_bc = 0.0_dp
4576 150 : p_bd = pbd((md - 1)*1 + mb)
4577 150 : p_bc = pbc((mc - 1)*1 + mb)
4578 300 : DO ma = 1, 1
4579 150 : p_index = p_index + 1
4580 150 : tmp = scale*prim(p_index)
4581 150 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4582 150 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4583 150 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4584 300 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4585 : END DO
4586 150 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4587 300 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4588 : END DO
4589 : END DO
4590 : END DO
4591 10 : END SUBROUTINE block_1_1_1_15
4592 : ! **************************************************************************************************
4593 : !> \brief ...
4594 : !> \param kbd ...
4595 : !> \param kbc ...
4596 : !> \param kad ...
4597 : !> \param kac ...
4598 : !> \param pbd ...
4599 : !> \param pbc ...
4600 : !> \param pad ...
4601 : !> \param pac ...
4602 : !> \param prim ...
4603 : !> \param scale ...
4604 : ! **************************************************************************************************
4605 35441 : SUBROUTINE block_1_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4606 : REAL(KIND=dp) :: kbd(1*1), kbc(1*2), kad(1*1), kac(1*2), &
4607 : pbd(1*1), pbc(1*2), pad(1*1), &
4608 : pac(1*2), prim(1*1*2*1), scale
4609 :
4610 : INTEGER :: ma, mb, mc, md, p_index
4611 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4612 :
4613 35441 : kbd(1:1*1) = 0.0_dp
4614 35441 : kbc(1:1*2) = 0.0_dp
4615 35441 : kad(1:1*1) = 0.0_dp
4616 35441 : kac(1:1*2) = 0.0_dp
4617 35441 : p_index = 0
4618 70882 : DO md = 1, 1
4619 141764 : DO mc = 1, 2
4620 177205 : DO mb = 1, 1
4621 70882 : ks_bd = 0.0_dp
4622 70882 : ks_bc = 0.0_dp
4623 70882 : p_bd = pbd((md - 1)*1 + mb)
4624 70882 : p_bc = pbc((mc - 1)*1 + mb)
4625 141764 : DO ma = 1, 1
4626 70882 : p_index = p_index + 1
4627 70882 : tmp = scale*prim(p_index)
4628 70882 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4629 70882 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4630 70882 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4631 141764 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4632 : END DO
4633 70882 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4634 141764 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4635 : END DO
4636 : END DO
4637 : END DO
4638 35441 : END SUBROUTINE block_1_1_2_1
4639 : ! **************************************************************************************************
4640 : !> \brief ...
4641 : !> \param kbd ...
4642 : !> \param kbc ...
4643 : !> \param kad ...
4644 : !> \param kac ...
4645 : !> \param pbd ...
4646 : !> \param pbc ...
4647 : !> \param pad ...
4648 : !> \param pac ...
4649 : !> \param prim ...
4650 : !> \param scale ...
4651 : ! **************************************************************************************************
4652 5028 : SUBROUTINE block_1_1_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4653 : REAL(KIND=dp) :: kbd(1*2), kbc(1*2), kad(1*2), kac(1*2), &
4654 : pbd(1*2), pbc(1*2), pad(1*2), &
4655 : pac(1*2), prim(1*1*2*2), scale
4656 :
4657 : INTEGER :: ma, mb, mc, md, p_index
4658 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4659 :
4660 5028 : kbd(1:1*2) = 0.0_dp
4661 5028 : kbc(1:1*2) = 0.0_dp
4662 5028 : kad(1:1*2) = 0.0_dp
4663 5028 : kac(1:1*2) = 0.0_dp
4664 5028 : p_index = 0
4665 15084 : DO md = 1, 2
4666 35196 : DO mc = 1, 2
4667 50280 : DO mb = 1, 1
4668 20112 : ks_bd = 0.0_dp
4669 20112 : ks_bc = 0.0_dp
4670 20112 : p_bd = pbd((md - 1)*1 + mb)
4671 20112 : p_bc = pbc((mc - 1)*1 + mb)
4672 40224 : DO ma = 1, 1
4673 20112 : p_index = p_index + 1
4674 20112 : tmp = scale*prim(p_index)
4675 20112 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4676 20112 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4677 20112 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4678 40224 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4679 : END DO
4680 20112 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4681 40224 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4682 : END DO
4683 : END DO
4684 : END DO
4685 5028 : END SUBROUTINE block_1_1_2_2
4686 : ! **************************************************************************************************
4687 : !> \brief ...
4688 : !> \param kbd ...
4689 : !> \param kbc ...
4690 : !> \param kad ...
4691 : !> \param kac ...
4692 : !> \param pbd ...
4693 : !> \param pbc ...
4694 : !> \param pad ...
4695 : !> \param pac ...
4696 : !> \param prim ...
4697 : !> \param scale ...
4698 : ! **************************************************************************************************
4699 31999 : SUBROUTINE block_1_1_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4700 : REAL(KIND=dp) :: kbd(1*3), kbc(1*2), kad(1*3), kac(1*2), &
4701 : pbd(1*3), pbc(1*2), pad(1*3), &
4702 : pac(1*2), prim(1*1*2*3), scale
4703 :
4704 : INTEGER :: ma, mb, mc, md, p_index
4705 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4706 :
4707 31999 : kbd(1:1*3) = 0.0_dp
4708 31999 : kbc(1:1*2) = 0.0_dp
4709 31999 : kad(1:1*3) = 0.0_dp
4710 31999 : kac(1:1*2) = 0.0_dp
4711 31999 : p_index = 0
4712 127996 : DO md = 1, 3
4713 319990 : DO mc = 1, 2
4714 479985 : DO mb = 1, 1
4715 191994 : ks_bd = 0.0_dp
4716 191994 : ks_bc = 0.0_dp
4717 191994 : p_bd = pbd((md - 1)*1 + mb)
4718 191994 : p_bc = pbc((mc - 1)*1 + mb)
4719 383988 : DO ma = 1, 1
4720 191994 : p_index = p_index + 1
4721 191994 : tmp = scale*prim(p_index)
4722 191994 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4723 191994 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4724 191994 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4725 383988 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4726 : END DO
4727 191994 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4728 383988 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4729 : END DO
4730 : END DO
4731 : END DO
4732 31999 : END SUBROUTINE block_1_1_2_3
4733 : ! **************************************************************************************************
4734 : !> \brief ...
4735 : !> \param kbd ...
4736 : !> \param kbc ...
4737 : !> \param kad ...
4738 : !> \param kac ...
4739 : !> \param pbd ...
4740 : !> \param pbc ...
4741 : !> \param pad ...
4742 : !> \param pac ...
4743 : !> \param prim ...
4744 : !> \param scale ...
4745 : ! **************************************************************************************************
4746 7 : SUBROUTINE block_1_1_2_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4747 : REAL(KIND=dp) :: kbd(1*4), kbc(1*2), kad(1*4), kac(1*2), &
4748 : pbd(1*4), pbc(1*2), pad(1*4), &
4749 : pac(1*2), prim(1*1*2*4), scale
4750 :
4751 : INTEGER :: ma, mb, mc, md, p_index
4752 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4753 :
4754 7 : kbd(1:1*4) = 0.0_dp
4755 7 : kbc(1:1*2) = 0.0_dp
4756 7 : kad(1:1*4) = 0.0_dp
4757 7 : kac(1:1*2) = 0.0_dp
4758 7 : p_index = 0
4759 35 : DO md = 1, 4
4760 91 : DO mc = 1, 2
4761 140 : DO mb = 1, 1
4762 56 : ks_bd = 0.0_dp
4763 56 : ks_bc = 0.0_dp
4764 56 : p_bd = pbd((md - 1)*1 + mb)
4765 56 : p_bc = pbc((mc - 1)*1 + mb)
4766 112 : DO ma = 1, 1
4767 56 : p_index = p_index + 1
4768 56 : tmp = scale*prim(p_index)
4769 56 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4770 56 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4771 56 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4772 112 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4773 : END DO
4774 56 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4775 112 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4776 : END DO
4777 : END DO
4778 : END DO
4779 7 : END SUBROUTINE block_1_1_2_4
4780 : ! **************************************************************************************************
4781 : !> \brief ...
4782 : !> \param kbd ...
4783 : !> \param kbc ...
4784 : !> \param kad ...
4785 : !> \param kac ...
4786 : !> \param pbd ...
4787 : !> \param pbc ...
4788 : !> \param pad ...
4789 : !> \param pac ...
4790 : !> \param prim ...
4791 : !> \param scale ...
4792 : ! **************************************************************************************************
4793 10255 : SUBROUTINE block_1_1_2_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4794 : REAL(KIND=dp) :: kbd(1*5), kbc(1*2), kad(1*5), kac(1*2), &
4795 : pbd(1*5), pbc(1*2), pad(1*5), &
4796 : pac(1*2), prim(1*1*2*5), scale
4797 :
4798 : INTEGER :: ma, mb, mc, md, p_index
4799 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4800 :
4801 10255 : kbd(1:1*5) = 0.0_dp
4802 10255 : kbc(1:1*2) = 0.0_dp
4803 10255 : kad(1:1*5) = 0.0_dp
4804 10255 : kac(1:1*2) = 0.0_dp
4805 10255 : p_index = 0
4806 61530 : DO md = 1, 5
4807 164080 : DO mc = 1, 2
4808 256375 : DO mb = 1, 1
4809 102550 : ks_bd = 0.0_dp
4810 102550 : ks_bc = 0.0_dp
4811 102550 : p_bd = pbd((md - 1)*1 + mb)
4812 102550 : p_bc = pbc((mc - 1)*1 + mb)
4813 205100 : DO ma = 1, 1
4814 102550 : p_index = p_index + 1
4815 102550 : tmp = scale*prim(p_index)
4816 102550 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4817 102550 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4818 102550 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4819 205100 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4820 : END DO
4821 102550 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4822 205100 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4823 : END DO
4824 : END DO
4825 : END DO
4826 10255 : END SUBROUTINE block_1_1_2_5
4827 : ! **************************************************************************************************
4828 : !> \brief ...
4829 : !> \param kbd ...
4830 : !> \param kbc ...
4831 : !> \param kad ...
4832 : !> \param kac ...
4833 : !> \param pbd ...
4834 : !> \param pbc ...
4835 : !> \param pad ...
4836 : !> \param pac ...
4837 : !> \param prim ...
4838 : !> \param scale ...
4839 : ! **************************************************************************************************
4840 8 : SUBROUTINE block_1_1_2_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4841 : REAL(KIND=dp) :: kbd(1*6), kbc(1*2), kad(1*6), kac(1*2), &
4842 : pbd(1*6), pbc(1*2), pad(1*6), &
4843 : pac(1*2), prim(1*1*2*6), scale
4844 :
4845 : INTEGER :: ma, mb, mc, md, p_index
4846 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4847 :
4848 8 : kbd(1:1*6) = 0.0_dp
4849 8 : kbc(1:1*2) = 0.0_dp
4850 8 : kad(1:1*6) = 0.0_dp
4851 8 : kac(1:1*2) = 0.0_dp
4852 8 : p_index = 0
4853 56 : DO md = 1, 6
4854 152 : DO mc = 1, 2
4855 240 : DO mb = 1, 1
4856 96 : ks_bd = 0.0_dp
4857 96 : ks_bc = 0.0_dp
4858 96 : p_bd = pbd((md - 1)*1 + mb)
4859 96 : p_bc = pbc((mc - 1)*1 + mb)
4860 192 : DO ma = 1, 1
4861 96 : p_index = p_index + 1
4862 96 : tmp = scale*prim(p_index)
4863 96 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4864 96 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4865 96 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4866 192 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4867 : END DO
4868 96 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4869 192 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4870 : END DO
4871 : END DO
4872 : END DO
4873 8 : END SUBROUTINE block_1_1_2_6
4874 : ! **************************************************************************************************
4875 : !> \brief ...
4876 : !> \param kbd ...
4877 : !> \param kbc ...
4878 : !> \param kad ...
4879 : !> \param kac ...
4880 : !> \param pbd ...
4881 : !> \param pbc ...
4882 : !> \param pad ...
4883 : !> \param pac ...
4884 : !> \param prim ...
4885 : !> \param scale ...
4886 : ! **************************************************************************************************
4887 742 : SUBROUTINE block_1_1_2_7(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4888 : REAL(KIND=dp) :: kbd(1*7), kbc(1*2), kad(1*7), kac(1*2), &
4889 : pbd(1*7), pbc(1*2), pad(1*7), &
4890 : pac(1*2), prim(1*1*2*7), scale
4891 :
4892 : INTEGER :: ma, mb, mc, md, p_index
4893 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4894 :
4895 742 : kbd(1:1*7) = 0.0_dp
4896 742 : kbc(1:1*2) = 0.0_dp
4897 742 : kad(1:1*7) = 0.0_dp
4898 742 : kac(1:1*2) = 0.0_dp
4899 742 : p_index = 0
4900 5936 : DO md = 1, 7
4901 16324 : DO mc = 1, 2
4902 25970 : DO mb = 1, 1
4903 10388 : ks_bd = 0.0_dp
4904 10388 : ks_bc = 0.0_dp
4905 10388 : p_bd = pbd((md - 1)*1 + mb)
4906 10388 : p_bc = pbc((mc - 1)*1 + mb)
4907 20776 : DO ma = 1, 1
4908 10388 : p_index = p_index + 1
4909 10388 : tmp = scale*prim(p_index)
4910 10388 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4911 10388 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4912 10388 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4913 20776 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4914 : END DO
4915 10388 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4916 20776 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4917 : END DO
4918 : END DO
4919 : END DO
4920 742 : END SUBROUTINE block_1_1_2_7
4921 : ! **************************************************************************************************
4922 : !> \brief ...
4923 : !> \param kbd ...
4924 : !> \param kbc ...
4925 : !> \param kad ...
4926 : !> \param kac ...
4927 : !> \param pbd ...
4928 : !> \param pbc ...
4929 : !> \param pad ...
4930 : !> \param pac ...
4931 : !> \param prim ...
4932 : !> \param scale ...
4933 : ! **************************************************************************************************
4934 6 : SUBROUTINE block_1_1_2_9(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4935 : REAL(KIND=dp) :: kbd(1*9), kbc(1*2), kad(1*9), kac(1*2), &
4936 : pbd(1*9), pbc(1*2), pad(1*9), &
4937 : pac(1*2), prim(1*1*2*9), scale
4938 :
4939 : INTEGER :: ma, mb, mc, md, p_index
4940 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4941 :
4942 6 : kbd(1:1*9) = 0.0_dp
4943 6 : kbc(1:1*2) = 0.0_dp
4944 6 : kad(1:1*9) = 0.0_dp
4945 6 : kac(1:1*2) = 0.0_dp
4946 6 : p_index = 0
4947 60 : DO md = 1, 9
4948 168 : DO mc = 1, 2
4949 270 : DO mb = 1, 1
4950 108 : ks_bd = 0.0_dp
4951 108 : ks_bc = 0.0_dp
4952 108 : p_bd = pbd((md - 1)*1 + mb)
4953 108 : p_bc = pbc((mc - 1)*1 + mb)
4954 216 : DO ma = 1, 1
4955 108 : p_index = p_index + 1
4956 108 : tmp = scale*prim(p_index)
4957 108 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4958 108 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4959 108 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4960 216 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4961 : END DO
4962 108 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4963 216 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4964 : END DO
4965 : END DO
4966 : END DO
4967 6 : END SUBROUTINE block_1_1_2_9
4968 : ! **************************************************************************************************
4969 : !> \brief ...
4970 : !> \param md_max ...
4971 : !> \param kbd ...
4972 : !> \param kbc ...
4973 : !> \param kad ...
4974 : !> \param kac ...
4975 : !> \param pbd ...
4976 : !> \param pbc ...
4977 : !> \param pad ...
4978 : !> \param pac ...
4979 : !> \param prim ...
4980 : !> \param scale ...
4981 : ! **************************************************************************************************
4982 15 : SUBROUTINE block_1_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4983 : INTEGER :: md_max
4984 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*2), kad(1*md_max), kac(1*2), pbd(1*md_max), pbc(1*2), &
4985 : pad(1*md_max), pac(1*2), prim(1*1*2*md_max), scale
4986 :
4987 : INTEGER :: ma, mb, mc, md, p_index
4988 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
4989 :
4990 199 : kbd(1:1*md_max) = 0.0_dp
4991 15 : kbc(1:1*2) = 0.0_dp
4992 199 : kad(1:1*md_max) = 0.0_dp
4993 15 : kac(1:1*2) = 0.0_dp
4994 15 : p_index = 0
4995 199 : DO md = 1, md_max
4996 567 : DO mc = 1, 2
4997 920 : DO mb = 1, 1
4998 368 : ks_bd = 0.0_dp
4999 368 : ks_bc = 0.0_dp
5000 368 : p_bd = pbd((md - 1)*1 + mb)
5001 368 : p_bc = pbc((mc - 1)*1 + mb)
5002 736 : DO ma = 1, 1
5003 368 : p_index = p_index + 1
5004 368 : tmp = scale*prim(p_index)
5005 368 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5006 368 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5007 368 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5008 736 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5009 : END DO
5010 368 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5011 736 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5012 : END DO
5013 : END DO
5014 : END DO
5015 15 : END SUBROUTINE block_1_1_2
5016 : ! **************************************************************************************************
5017 : !> \brief ...
5018 : !> \param kbd ...
5019 : !> \param kbc ...
5020 : !> \param kad ...
5021 : !> \param kac ...
5022 : !> \param pbd ...
5023 : !> \param pbc ...
5024 : !> \param pad ...
5025 : !> \param pac ...
5026 : !> \param prim ...
5027 : !> \param scale ...
5028 : ! **************************************************************************************************
5029 8167181 : SUBROUTINE block_1_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5030 : REAL(KIND=dp) :: kbd(1*1), kbc(1*3), kad(1*1), kac(1*3), &
5031 : pbd(1*1), pbc(1*3), pad(1*1), &
5032 : pac(1*3), prim(1*1*3*1), scale
5033 :
5034 : INTEGER :: ma, mb, mc, md, p_index
5035 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5036 :
5037 8167181 : kbd(1:1*1) = 0.0_dp
5038 8167181 : kbc(1:1*3) = 0.0_dp
5039 8167181 : kad(1:1*1) = 0.0_dp
5040 8167181 : kac(1:1*3) = 0.0_dp
5041 8167181 : p_index = 0
5042 16334362 : DO md = 1, 1
5043 40835905 : DO mc = 1, 3
5044 57170267 : DO mb = 1, 1
5045 24501543 : ks_bd = 0.0_dp
5046 24501543 : ks_bc = 0.0_dp
5047 24501543 : p_bd = pbd((md - 1)*1 + mb)
5048 24501543 : p_bc = pbc((mc - 1)*1 + mb)
5049 49003086 : DO ma = 1, 1
5050 24501543 : p_index = p_index + 1
5051 24501543 : tmp = scale*prim(p_index)
5052 24501543 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5053 24501543 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5054 24501543 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5055 49003086 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5056 : END DO
5057 24501543 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5058 49003086 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5059 : END DO
5060 : END DO
5061 : END DO
5062 8167181 : END SUBROUTINE block_1_1_3_1
5063 : ! **************************************************************************************************
5064 : !> \brief ...
5065 : !> \param kbd ...
5066 : !> \param kbc ...
5067 : !> \param kad ...
5068 : !> \param kac ...
5069 : !> \param pbd ...
5070 : !> \param pbc ...
5071 : !> \param pad ...
5072 : !> \param pac ...
5073 : !> \param prim ...
5074 : !> \param scale ...
5075 : ! **************************************************************************************************
5076 15297 : SUBROUTINE block_1_1_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5077 : REAL(KIND=dp) :: kbd(1*2), kbc(1*3), kad(1*2), kac(1*3), &
5078 : pbd(1*2), pbc(1*3), pad(1*2), &
5079 : pac(1*3), prim(1*1*3*2), scale
5080 :
5081 : INTEGER :: ma, mb, mc, md, p_index
5082 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5083 :
5084 15297 : kbd(1:1*2) = 0.0_dp
5085 15297 : kbc(1:1*3) = 0.0_dp
5086 15297 : kad(1:1*2) = 0.0_dp
5087 15297 : kac(1:1*3) = 0.0_dp
5088 15297 : p_index = 0
5089 45891 : DO md = 1, 2
5090 137673 : DO mc = 1, 3
5091 214158 : DO mb = 1, 1
5092 91782 : ks_bd = 0.0_dp
5093 91782 : ks_bc = 0.0_dp
5094 91782 : p_bd = pbd((md - 1)*1 + mb)
5095 91782 : p_bc = pbc((mc - 1)*1 + mb)
5096 183564 : DO ma = 1, 1
5097 91782 : p_index = p_index + 1
5098 91782 : tmp = scale*prim(p_index)
5099 91782 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5100 91782 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5101 91782 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5102 183564 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5103 : END DO
5104 91782 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5105 183564 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5106 : END DO
5107 : END DO
5108 : END DO
5109 15297 : END SUBROUTINE block_1_1_3_2
5110 : ! **************************************************************************************************
5111 : !> \brief ...
5112 : !> \param kbd ...
5113 : !> \param kbc ...
5114 : !> \param kad ...
5115 : !> \param kac ...
5116 : !> \param pbd ...
5117 : !> \param pbc ...
5118 : !> \param pad ...
5119 : !> \param pac ...
5120 : !> \param prim ...
5121 : !> \param scale ...
5122 : ! **************************************************************************************************
5123 4168271 : SUBROUTINE block_1_1_3_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5124 : REAL(KIND=dp) :: kbd(1*3), kbc(1*3), kad(1*3), kac(1*3), &
5125 : pbd(1*3), pbc(1*3), pad(1*3), &
5126 : pac(1*3), prim(1*1*3*3), scale
5127 :
5128 : INTEGER :: ma, mb, mc, md, p_index
5129 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5130 :
5131 4168271 : kbd(1:1*3) = 0.0_dp
5132 4168271 : kbc(1:1*3) = 0.0_dp
5133 4168271 : kad(1:1*3) = 0.0_dp
5134 4168271 : kac(1:1*3) = 0.0_dp
5135 4168271 : p_index = 0
5136 16673084 : DO md = 1, 3
5137 54187523 : DO mc = 1, 3
5138 87533691 : DO mb = 1, 1
5139 37514439 : ks_bd = 0.0_dp
5140 37514439 : ks_bc = 0.0_dp
5141 37514439 : p_bd = pbd((md - 1)*1 + mb)
5142 37514439 : p_bc = pbc((mc - 1)*1 + mb)
5143 75028878 : DO ma = 1, 1
5144 37514439 : p_index = p_index + 1
5145 37514439 : tmp = scale*prim(p_index)
5146 37514439 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5147 37514439 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5148 37514439 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5149 75028878 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5150 : END DO
5151 37514439 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5152 75028878 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5153 : END DO
5154 : END DO
5155 : END DO
5156 4168271 : END SUBROUTINE block_1_1_3_3
5157 : ! **************************************************************************************************
5158 : !> \brief ...
5159 : !> \param kbd ...
5160 : !> \param kbc ...
5161 : !> \param kad ...
5162 : !> \param kac ...
5163 : !> \param pbd ...
5164 : !> \param pbc ...
5165 : !> \param pad ...
5166 : !> \param pac ...
5167 : !> \param prim ...
5168 : !> \param scale ...
5169 : ! **************************************************************************************************
5170 39352 : SUBROUTINE block_1_1_3_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5171 : REAL(KIND=dp) :: kbd(1*4), kbc(1*3), kad(1*4), kac(1*3), &
5172 : pbd(1*4), pbc(1*3), pad(1*4), &
5173 : pac(1*3), prim(1*1*3*4), scale
5174 :
5175 : INTEGER :: ma, mb, mc, md, p_index
5176 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5177 :
5178 39352 : kbd(1:1*4) = 0.0_dp
5179 39352 : kbc(1:1*3) = 0.0_dp
5180 39352 : kad(1:1*4) = 0.0_dp
5181 39352 : kac(1:1*3) = 0.0_dp
5182 39352 : p_index = 0
5183 196760 : DO md = 1, 4
5184 668984 : DO mc = 1, 3
5185 1101856 : DO mb = 1, 1
5186 472224 : ks_bd = 0.0_dp
5187 472224 : ks_bc = 0.0_dp
5188 472224 : p_bd = pbd((md - 1)*1 + mb)
5189 472224 : p_bc = pbc((mc - 1)*1 + mb)
5190 944448 : DO ma = 1, 1
5191 472224 : p_index = p_index + 1
5192 472224 : tmp = scale*prim(p_index)
5193 472224 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5194 472224 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5195 472224 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5196 944448 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5197 : END DO
5198 472224 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5199 944448 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5200 : END DO
5201 : END DO
5202 : END DO
5203 39352 : END SUBROUTINE block_1_1_3_4
5204 : ! **************************************************************************************************
5205 : !> \brief ...
5206 : !> \param kbd ...
5207 : !> \param kbc ...
5208 : !> \param kad ...
5209 : !> \param kac ...
5210 : !> \param pbd ...
5211 : !> \param pbc ...
5212 : !> \param pad ...
5213 : !> \param pac ...
5214 : !> \param prim ...
5215 : !> \param scale ...
5216 : ! **************************************************************************************************
5217 126860 : SUBROUTINE block_1_1_3_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5218 : REAL(KIND=dp) :: kbd(1*5), kbc(1*3), kad(1*5), kac(1*3), &
5219 : pbd(1*5), pbc(1*3), pad(1*5), &
5220 : pac(1*3), prim(1*1*3*5), scale
5221 :
5222 : INTEGER :: ma, mb, mc, md, p_index
5223 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5224 :
5225 126860 : kbd(1:1*5) = 0.0_dp
5226 126860 : kbc(1:1*3) = 0.0_dp
5227 126860 : kad(1:1*5) = 0.0_dp
5228 126860 : kac(1:1*3) = 0.0_dp
5229 126860 : p_index = 0
5230 761160 : DO md = 1, 5
5231 2664060 : DO mc = 1, 3
5232 4440100 : DO mb = 1, 1
5233 1902900 : ks_bd = 0.0_dp
5234 1902900 : ks_bc = 0.0_dp
5235 1902900 : p_bd = pbd((md - 1)*1 + mb)
5236 1902900 : p_bc = pbc((mc - 1)*1 + mb)
5237 3805800 : DO ma = 1, 1
5238 1902900 : p_index = p_index + 1
5239 1902900 : tmp = scale*prim(p_index)
5240 1902900 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5241 1902900 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5242 1902900 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5243 3805800 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5244 : END DO
5245 1902900 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5246 3805800 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5247 : END DO
5248 : END DO
5249 : END DO
5250 126860 : END SUBROUTINE block_1_1_3_5
5251 : ! **************************************************************************************************
5252 : !> \brief ...
5253 : !> \param kbd ...
5254 : !> \param kbc ...
5255 : !> \param kad ...
5256 : !> \param kac ...
5257 : !> \param pbd ...
5258 : !> \param pbc ...
5259 : !> \param pad ...
5260 : !> \param pac ...
5261 : !> \param prim ...
5262 : !> \param scale ...
5263 : ! **************************************************************************************************
5264 7 : SUBROUTINE block_1_1_3_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5265 : REAL(KIND=dp) :: kbd(1*6), kbc(1*3), kad(1*6), kac(1*3), &
5266 : pbd(1*6), pbc(1*3), pad(1*6), &
5267 : pac(1*3), prim(1*1*3*6), scale
5268 :
5269 : INTEGER :: ma, mb, mc, md, p_index
5270 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5271 :
5272 7 : kbd(1:1*6) = 0.0_dp
5273 7 : kbc(1:1*3) = 0.0_dp
5274 7 : kad(1:1*6) = 0.0_dp
5275 7 : kac(1:1*3) = 0.0_dp
5276 7 : p_index = 0
5277 49 : DO md = 1, 6
5278 175 : DO mc = 1, 3
5279 294 : DO mb = 1, 1
5280 126 : ks_bd = 0.0_dp
5281 126 : ks_bc = 0.0_dp
5282 126 : p_bd = pbd((md - 1)*1 + mb)
5283 126 : p_bc = pbc((mc - 1)*1 + mb)
5284 252 : DO ma = 1, 1
5285 126 : p_index = p_index + 1
5286 126 : tmp = scale*prim(p_index)
5287 126 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5288 126 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5289 126 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5290 252 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5291 : END DO
5292 126 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5293 252 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5294 : END DO
5295 : END DO
5296 : END DO
5297 7 : END SUBROUTINE block_1_1_3_6
5298 : ! **************************************************************************************************
5299 : !> \brief ...
5300 : !> \param md_max ...
5301 : !> \param kbd ...
5302 : !> \param kbc ...
5303 : !> \param kad ...
5304 : !> \param kac ...
5305 : !> \param pbd ...
5306 : !> \param pbc ...
5307 : !> \param pad ...
5308 : !> \param pac ...
5309 : !> \param prim ...
5310 : !> \param scale ...
5311 : ! **************************************************************************************************
5312 23924 : SUBROUTINE block_1_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5313 : INTEGER :: md_max
5314 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*3), kad(1*md_max), kac(1*3), pbd(1*md_max), pbc(1*3), &
5315 : pad(1*md_max), pac(1*3), prim(1*1*3*md_max), scale
5316 :
5317 : INTEGER :: ma, mb, mc, md, p_index
5318 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5319 :
5320 191482 : kbd(1:1*md_max) = 0.0_dp
5321 23924 : kbc(1:1*3) = 0.0_dp
5322 191482 : kad(1:1*md_max) = 0.0_dp
5323 23924 : kac(1:1*3) = 0.0_dp
5324 23924 : p_index = 0
5325 191482 : DO md = 1, md_max
5326 694156 : DO mc = 1, 3
5327 1172906 : DO mb = 1, 1
5328 502674 : ks_bd = 0.0_dp
5329 502674 : ks_bc = 0.0_dp
5330 502674 : p_bd = pbd((md - 1)*1 + mb)
5331 502674 : p_bc = pbc((mc - 1)*1 + mb)
5332 1005348 : DO ma = 1, 1
5333 502674 : p_index = p_index + 1
5334 502674 : tmp = scale*prim(p_index)
5335 502674 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5336 502674 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5337 502674 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5338 1005348 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5339 : END DO
5340 502674 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5341 1005348 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5342 : END DO
5343 : END DO
5344 : END DO
5345 23924 : END SUBROUTINE block_1_1_3
5346 : ! **************************************************************************************************
5347 : !> \brief ...
5348 : !> \param kbd ...
5349 : !> \param kbc ...
5350 : !> \param kad ...
5351 : !> \param kac ...
5352 : !> \param pbd ...
5353 : !> \param pbc ...
5354 : !> \param pad ...
5355 : !> \param pac ...
5356 : !> \param prim ...
5357 : !> \param scale ...
5358 : ! **************************************************************************************************
5359 650469 : SUBROUTINE block_1_1_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5360 : REAL(KIND=dp) :: kbd(1*1), kbc(1*4), kad(1*1), kac(1*4), &
5361 : pbd(1*1), pbc(1*4), pad(1*1), &
5362 : pac(1*4), prim(1*1*4*1), scale
5363 :
5364 : INTEGER :: ma, mb, mc, md, p_index
5365 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5366 :
5367 650469 : kbd(1:1*1) = 0.0_dp
5368 650469 : kbc(1:1*4) = 0.0_dp
5369 650469 : kad(1:1*1) = 0.0_dp
5370 650469 : kac(1:1*4) = 0.0_dp
5371 650469 : p_index = 0
5372 1300938 : DO md = 1, 1
5373 3902814 : DO mc = 1, 4
5374 5854221 : DO mb = 1, 1
5375 2601876 : ks_bd = 0.0_dp
5376 2601876 : ks_bc = 0.0_dp
5377 2601876 : p_bd = pbd((md - 1)*1 + mb)
5378 2601876 : p_bc = pbc((mc - 1)*1 + mb)
5379 5203752 : DO ma = 1, 1
5380 2601876 : p_index = p_index + 1
5381 2601876 : tmp = scale*prim(p_index)
5382 2601876 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5383 2601876 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5384 2601876 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5385 5203752 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5386 : END DO
5387 2601876 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5388 5203752 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5389 : END DO
5390 : END DO
5391 : END DO
5392 650469 : END SUBROUTINE block_1_1_4_1
5393 : ! **************************************************************************************************
5394 : !> \brief ...
5395 : !> \param kbd ...
5396 : !> \param kbc ...
5397 : !> \param kad ...
5398 : !> \param kac ...
5399 : !> \param pbd ...
5400 : !> \param pbc ...
5401 : !> \param pad ...
5402 : !> \param pac ...
5403 : !> \param prim ...
5404 : !> \param scale ...
5405 : ! **************************************************************************************************
5406 4 : SUBROUTINE block_1_1_4_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5407 : REAL(KIND=dp) :: kbd(1*2), kbc(1*4), kad(1*2), kac(1*4), &
5408 : pbd(1*2), pbc(1*4), pad(1*2), &
5409 : pac(1*4), prim(1*1*4*2), scale
5410 :
5411 : INTEGER :: ma, mb, mc, md, p_index
5412 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5413 :
5414 4 : kbd(1:1*2) = 0.0_dp
5415 4 : kbc(1:1*4) = 0.0_dp
5416 4 : kad(1:1*2) = 0.0_dp
5417 4 : kac(1:1*4) = 0.0_dp
5418 4 : p_index = 0
5419 12 : DO md = 1, 2
5420 44 : DO mc = 1, 4
5421 72 : DO mb = 1, 1
5422 32 : ks_bd = 0.0_dp
5423 32 : ks_bc = 0.0_dp
5424 32 : p_bd = pbd((md - 1)*1 + mb)
5425 32 : p_bc = pbc((mc - 1)*1 + mb)
5426 64 : DO ma = 1, 1
5427 32 : p_index = p_index + 1
5428 32 : tmp = scale*prim(p_index)
5429 32 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5430 32 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5431 32 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5432 64 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5433 : END DO
5434 32 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5435 64 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5436 : END DO
5437 : END DO
5438 : END DO
5439 4 : END SUBROUTINE block_1_1_4_2
5440 : ! **************************************************************************************************
5441 : !> \brief ...
5442 : !> \param kbd ...
5443 : !> \param kbc ...
5444 : !> \param kad ...
5445 : !> \param kac ...
5446 : !> \param pbd ...
5447 : !> \param pbc ...
5448 : !> \param pad ...
5449 : !> \param pac ...
5450 : !> \param prim ...
5451 : !> \param scale ...
5452 : ! **************************************************************************************************
5453 231050 : SUBROUTINE block_1_1_4_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5454 : REAL(KIND=dp) :: kbd(1*3), kbc(1*4), kad(1*3), kac(1*4), &
5455 : pbd(1*3), pbc(1*4), pad(1*3), &
5456 : pac(1*4), prim(1*1*4*3), scale
5457 :
5458 : INTEGER :: ma, mb, mc, md, p_index
5459 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5460 :
5461 231050 : kbd(1:1*3) = 0.0_dp
5462 231050 : kbc(1:1*4) = 0.0_dp
5463 231050 : kad(1:1*3) = 0.0_dp
5464 231050 : kac(1:1*4) = 0.0_dp
5465 231050 : p_index = 0
5466 924200 : DO md = 1, 3
5467 3696800 : DO mc = 1, 4
5468 6238350 : DO mb = 1, 1
5469 2772600 : ks_bd = 0.0_dp
5470 2772600 : ks_bc = 0.0_dp
5471 2772600 : p_bd = pbd((md - 1)*1 + mb)
5472 2772600 : p_bc = pbc((mc - 1)*1 + mb)
5473 5545200 : DO ma = 1, 1
5474 2772600 : p_index = p_index + 1
5475 2772600 : tmp = scale*prim(p_index)
5476 2772600 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5477 2772600 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5478 2772600 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5479 5545200 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5480 : END DO
5481 2772600 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5482 5545200 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5483 : END DO
5484 : END DO
5485 : END DO
5486 231050 : END SUBROUTINE block_1_1_4_3
5487 : ! **************************************************************************************************
5488 : !> \brief ...
5489 : !> \param kbd ...
5490 : !> \param kbc ...
5491 : !> \param kad ...
5492 : !> \param kac ...
5493 : !> \param pbd ...
5494 : !> \param pbc ...
5495 : !> \param pad ...
5496 : !> \param pac ...
5497 : !> \param prim ...
5498 : !> \param scale ...
5499 : ! **************************************************************************************************
5500 320410 : SUBROUTINE block_1_1_4_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5501 : REAL(KIND=dp) :: kbd(1*4), kbc(1*4), kad(1*4), kac(1*4), &
5502 : pbd(1*4), pbc(1*4), pad(1*4), &
5503 : pac(1*4), prim(1*1*4*4), scale
5504 :
5505 : INTEGER :: ma, mb, mc, md, p_index
5506 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5507 :
5508 320410 : kbd(1:1*4) = 0.0_dp
5509 320410 : kbc(1:1*4) = 0.0_dp
5510 320410 : kad(1:1*4) = 0.0_dp
5511 320410 : kac(1:1*4) = 0.0_dp
5512 320410 : p_index = 0
5513 1602050 : DO md = 1, 4
5514 6728610 : DO mc = 1, 4
5515 11534760 : DO mb = 1, 1
5516 5126560 : ks_bd = 0.0_dp
5517 5126560 : ks_bc = 0.0_dp
5518 5126560 : p_bd = pbd((md - 1)*1 + mb)
5519 5126560 : p_bc = pbc((mc - 1)*1 + mb)
5520 10253120 : DO ma = 1, 1
5521 5126560 : p_index = p_index + 1
5522 5126560 : tmp = scale*prim(p_index)
5523 5126560 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5524 5126560 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5525 5126560 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5526 10253120 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5527 : END DO
5528 5126560 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5529 10253120 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5530 : END DO
5531 : END DO
5532 : END DO
5533 320410 : END SUBROUTINE block_1_1_4_4
5534 : ! **************************************************************************************************
5535 : !> \brief ...
5536 : !> \param md_max ...
5537 : !> \param kbd ...
5538 : !> \param kbc ...
5539 : !> \param kad ...
5540 : !> \param kac ...
5541 : !> \param pbd ...
5542 : !> \param pbc ...
5543 : !> \param pad ...
5544 : !> \param pac ...
5545 : !> \param prim ...
5546 : !> \param scale ...
5547 : ! **************************************************************************************************
5548 133498 : SUBROUTINE block_1_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5549 : INTEGER :: md_max
5550 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*4), kad(1*md_max), kac(1*4), pbd(1*md_max), pbc(1*4), &
5551 : pad(1*md_max), pac(1*4), prim(1*1*4*md_max), scale
5552 :
5553 : INTEGER :: ma, mb, mc, md, p_index
5554 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5555 :
5556 801626 : kbd(1:1*md_max) = 0.0_dp
5557 133498 : kbc(1:1*4) = 0.0_dp
5558 801626 : kad(1:1*md_max) = 0.0_dp
5559 133498 : kac(1:1*4) = 0.0_dp
5560 133498 : p_index = 0
5561 801626 : DO md = 1, md_max
5562 3474138 : DO mc = 1, 4
5563 6013152 : DO mb = 1, 1
5564 2672512 : ks_bd = 0.0_dp
5565 2672512 : ks_bc = 0.0_dp
5566 2672512 : p_bd = pbd((md - 1)*1 + mb)
5567 2672512 : p_bc = pbc((mc - 1)*1 + mb)
5568 5345024 : DO ma = 1, 1
5569 2672512 : p_index = p_index + 1
5570 2672512 : tmp = scale*prim(p_index)
5571 2672512 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5572 2672512 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5573 2672512 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5574 5345024 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5575 : END DO
5576 2672512 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5577 5345024 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5578 : END DO
5579 : END DO
5580 : END DO
5581 133498 : END SUBROUTINE block_1_1_4
5582 : ! **************************************************************************************************
5583 : !> \brief ...
5584 : !> \param kbd ...
5585 : !> \param kbc ...
5586 : !> \param kad ...
5587 : !> \param kac ...
5588 : !> \param pbd ...
5589 : !> \param pbc ...
5590 : !> \param pad ...
5591 : !> \param pac ...
5592 : !> \param prim ...
5593 : !> \param scale ...
5594 : ! **************************************************************************************************
5595 547129 : SUBROUTINE block_1_1_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5596 : REAL(KIND=dp) :: kbd(1*1), kbc(1*5), kad(1*1), kac(1*5), &
5597 : pbd(1*1), pbc(1*5), pad(1*1), &
5598 : pac(1*5), prim(1*1*5*1), scale
5599 :
5600 : INTEGER :: ma, mb, mc, md, p_index
5601 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5602 :
5603 547129 : kbd(1:1*1) = 0.0_dp
5604 547129 : kbc(1:1*5) = 0.0_dp
5605 547129 : kad(1:1*1) = 0.0_dp
5606 547129 : kac(1:1*5) = 0.0_dp
5607 547129 : p_index = 0
5608 1094258 : DO md = 1, 1
5609 3829903 : DO mc = 1, 5
5610 6018419 : DO mb = 1, 1
5611 2735645 : ks_bd = 0.0_dp
5612 2735645 : ks_bc = 0.0_dp
5613 2735645 : p_bd = pbd((md - 1)*1 + mb)
5614 2735645 : p_bc = pbc((mc - 1)*1 + mb)
5615 5471290 : DO ma = 1, 1
5616 2735645 : p_index = p_index + 1
5617 2735645 : tmp = scale*prim(p_index)
5618 2735645 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5619 2735645 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5620 2735645 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5621 5471290 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5622 : END DO
5623 2735645 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5624 5471290 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5625 : END DO
5626 : END DO
5627 : END DO
5628 547129 : END SUBROUTINE block_1_1_5_1
5629 : ! **************************************************************************************************
5630 : !> \brief ...
5631 : !> \param kbd ...
5632 : !> \param kbc ...
5633 : !> \param kad ...
5634 : !> \param kac ...
5635 : !> \param pbd ...
5636 : !> \param pbc ...
5637 : !> \param pad ...
5638 : !> \param pac ...
5639 : !> \param prim ...
5640 : !> \param scale ...
5641 : ! **************************************************************************************************
5642 10248 : SUBROUTINE block_1_1_5_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5643 : REAL(KIND=dp) :: kbd(1*2), kbc(1*5), kad(1*2), kac(1*5), &
5644 : pbd(1*2), pbc(1*5), pad(1*2), &
5645 : pac(1*5), prim(1*1*5*2), scale
5646 :
5647 : INTEGER :: ma, mb, mc, md, p_index
5648 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5649 :
5650 10248 : kbd(1:1*2) = 0.0_dp
5651 10248 : kbc(1:1*5) = 0.0_dp
5652 10248 : kad(1:1*2) = 0.0_dp
5653 10248 : kac(1:1*5) = 0.0_dp
5654 10248 : p_index = 0
5655 30744 : DO md = 1, 2
5656 133224 : DO mc = 1, 5
5657 225456 : DO mb = 1, 1
5658 102480 : ks_bd = 0.0_dp
5659 102480 : ks_bc = 0.0_dp
5660 102480 : p_bd = pbd((md - 1)*1 + mb)
5661 102480 : p_bc = pbc((mc - 1)*1 + mb)
5662 204960 : DO ma = 1, 1
5663 102480 : p_index = p_index + 1
5664 102480 : tmp = scale*prim(p_index)
5665 102480 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5666 102480 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5667 102480 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5668 204960 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5669 : END DO
5670 102480 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5671 204960 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5672 : END DO
5673 : END DO
5674 : END DO
5675 10248 : END SUBROUTINE block_1_1_5_2
5676 : ! **************************************************************************************************
5677 : !> \brief ...
5678 : !> \param kbd ...
5679 : !> \param kbc ...
5680 : !> \param kad ...
5681 : !> \param kac ...
5682 : !> \param pbd ...
5683 : !> \param pbc ...
5684 : !> \param pad ...
5685 : !> \param pac ...
5686 : !> \param prim ...
5687 : !> \param scale ...
5688 : ! **************************************************************************************************
5689 284627 : SUBROUTINE block_1_1_5_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5690 : REAL(KIND=dp) :: kbd(1*3), kbc(1*5), kad(1*3), kac(1*5), &
5691 : pbd(1*3), pbc(1*5), pad(1*3), &
5692 : pac(1*5), prim(1*1*5*3), scale
5693 :
5694 : INTEGER :: ma, mb, mc, md, p_index
5695 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5696 :
5697 284627 : kbd(1:1*3) = 0.0_dp
5698 284627 : kbc(1:1*5) = 0.0_dp
5699 284627 : kad(1:1*3) = 0.0_dp
5700 284627 : kac(1:1*5) = 0.0_dp
5701 284627 : p_index = 0
5702 1138508 : DO md = 1, 3
5703 5407913 : DO mc = 1, 5
5704 9392691 : DO mb = 1, 1
5705 4269405 : ks_bd = 0.0_dp
5706 4269405 : ks_bc = 0.0_dp
5707 4269405 : p_bd = pbd((md - 1)*1 + mb)
5708 4269405 : p_bc = pbc((mc - 1)*1 + mb)
5709 8538810 : DO ma = 1, 1
5710 4269405 : p_index = p_index + 1
5711 4269405 : tmp = scale*prim(p_index)
5712 4269405 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5713 4269405 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5714 4269405 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5715 8538810 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5716 : END DO
5717 4269405 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5718 8538810 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5719 : END DO
5720 : END DO
5721 : END DO
5722 284627 : END SUBROUTINE block_1_1_5_3
5723 : ! **************************************************************************************************
5724 : !> \brief ...
5725 : !> \param md_max ...
5726 : !> \param kbd ...
5727 : !> \param kbc ...
5728 : !> \param kad ...
5729 : !> \param kac ...
5730 : !> \param pbd ...
5731 : !> \param pbc ...
5732 : !> \param pad ...
5733 : !> \param pac ...
5734 : !> \param prim ...
5735 : !> \param scale ...
5736 : ! **************************************************************************************************
5737 262850 : SUBROUTINE block_1_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5738 : INTEGER :: md_max
5739 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*5), kad(1*md_max), kac(1*5), pbd(1*md_max), pbc(1*5), &
5740 : pad(1*md_max), pac(1*5), prim(1*1*5*md_max), scale
5741 :
5742 : INTEGER :: ma, mb, mc, md, p_index
5743 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5744 :
5745 1465814 : kbd(1:1*md_max) = 0.0_dp
5746 262850 : kbc(1:1*5) = 0.0_dp
5747 1465814 : kad(1:1*md_max) = 0.0_dp
5748 262850 : kac(1:1*5) = 0.0_dp
5749 262850 : p_index = 0
5750 1465814 : DO md = 1, md_max
5751 7480634 : DO mc = 1, 5
5752 13232604 : DO mb = 1, 1
5753 6014820 : ks_bd = 0.0_dp
5754 6014820 : ks_bc = 0.0_dp
5755 6014820 : p_bd = pbd((md - 1)*1 + mb)
5756 6014820 : p_bc = pbc((mc - 1)*1 + mb)
5757 12029640 : DO ma = 1, 1
5758 6014820 : p_index = p_index + 1
5759 6014820 : tmp = scale*prim(p_index)
5760 6014820 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5761 6014820 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5762 6014820 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5763 12029640 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5764 : END DO
5765 6014820 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5766 12029640 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5767 : END DO
5768 : END DO
5769 : END DO
5770 262850 : END SUBROUTINE block_1_1_5
5771 : ! **************************************************************************************************
5772 : !> \brief ...
5773 : !> \param kbd ...
5774 : !> \param kbc ...
5775 : !> \param kad ...
5776 : !> \param kac ...
5777 : !> \param pbd ...
5778 : !> \param pbc ...
5779 : !> \param pad ...
5780 : !> \param pac ...
5781 : !> \param prim ...
5782 : !> \param scale ...
5783 : ! **************************************************************************************************
5784 5 : SUBROUTINE block_1_1_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5785 : REAL(KIND=dp) :: kbd(1*1), kbc(1*6), kad(1*1), kac(1*6), &
5786 : pbd(1*1), pbc(1*6), pad(1*1), &
5787 : pac(1*6), prim(1*1*6*1), scale
5788 :
5789 : INTEGER :: ma, mb, mc, md, p_index
5790 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5791 :
5792 5 : kbd(1:1*1) = 0.0_dp
5793 5 : kbc(1:1*6) = 0.0_dp
5794 5 : kad(1:1*1) = 0.0_dp
5795 5 : kac(1:1*6) = 0.0_dp
5796 5 : p_index = 0
5797 10 : DO md = 1, 1
5798 40 : DO mc = 1, 6
5799 65 : DO mb = 1, 1
5800 30 : ks_bd = 0.0_dp
5801 30 : ks_bc = 0.0_dp
5802 30 : p_bd = pbd((md - 1)*1 + mb)
5803 30 : p_bc = pbc((mc - 1)*1 + mb)
5804 60 : DO ma = 1, 1
5805 30 : p_index = p_index + 1
5806 30 : tmp = scale*prim(p_index)
5807 30 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5808 30 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5809 30 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5810 60 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5811 : END DO
5812 30 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5813 60 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5814 : END DO
5815 : END DO
5816 : END DO
5817 5 : END SUBROUTINE block_1_1_6_1
5818 : ! **************************************************************************************************
5819 : !> \brief ...
5820 : !> \param kbd ...
5821 : !> \param kbc ...
5822 : !> \param kad ...
5823 : !> \param kac ...
5824 : !> \param pbd ...
5825 : !> \param pbc ...
5826 : !> \param pad ...
5827 : !> \param pac ...
5828 : !> \param prim ...
5829 : !> \param scale ...
5830 : ! **************************************************************************************************
5831 1 : SUBROUTINE block_1_1_6_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5832 : REAL(KIND=dp) :: kbd(1*2), kbc(1*6), kad(1*2), kac(1*6), &
5833 : pbd(1*2), pbc(1*6), pad(1*2), &
5834 : pac(1*6), prim(1*1*6*2), scale
5835 :
5836 : INTEGER :: ma, mb, mc, md, p_index
5837 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5838 :
5839 1 : kbd(1:1*2) = 0.0_dp
5840 1 : kbc(1:1*6) = 0.0_dp
5841 1 : kad(1:1*2) = 0.0_dp
5842 1 : kac(1:1*6) = 0.0_dp
5843 1 : p_index = 0
5844 3 : DO md = 1, 2
5845 15 : DO mc = 1, 6
5846 26 : DO mb = 1, 1
5847 12 : ks_bd = 0.0_dp
5848 12 : ks_bc = 0.0_dp
5849 12 : p_bd = pbd((md - 1)*1 + mb)
5850 12 : p_bc = pbc((mc - 1)*1 + mb)
5851 24 : DO ma = 1, 1
5852 12 : p_index = p_index + 1
5853 12 : tmp = scale*prim(p_index)
5854 12 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5855 12 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5856 12 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5857 24 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5858 : END DO
5859 12 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5860 24 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5861 : END DO
5862 : END DO
5863 : END DO
5864 1 : END SUBROUTINE block_1_1_6_2
5865 : ! **************************************************************************************************
5866 : !> \brief ...
5867 : !> \param kbd ...
5868 : !> \param kbc ...
5869 : !> \param kad ...
5870 : !> \param kac ...
5871 : !> \param pbd ...
5872 : !> \param pbc ...
5873 : !> \param pad ...
5874 : !> \param pac ...
5875 : !> \param prim ...
5876 : !> \param scale ...
5877 : ! **************************************************************************************************
5878 1 : SUBROUTINE block_1_1_6_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5879 : REAL(KIND=dp) :: kbd(1*3), kbc(1*6), kad(1*3), kac(1*6), &
5880 : pbd(1*3), pbc(1*6), pad(1*3), &
5881 : pac(1*6), prim(1*1*6*3), scale
5882 :
5883 : INTEGER :: ma, mb, mc, md, p_index
5884 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5885 :
5886 1 : kbd(1:1*3) = 0.0_dp
5887 1 : kbc(1:1*6) = 0.0_dp
5888 1 : kad(1:1*3) = 0.0_dp
5889 1 : kac(1:1*6) = 0.0_dp
5890 1 : p_index = 0
5891 4 : DO md = 1, 3
5892 22 : DO mc = 1, 6
5893 39 : DO mb = 1, 1
5894 18 : ks_bd = 0.0_dp
5895 18 : ks_bc = 0.0_dp
5896 18 : p_bd = pbd((md - 1)*1 + mb)
5897 18 : p_bc = pbc((mc - 1)*1 + mb)
5898 36 : DO ma = 1, 1
5899 18 : p_index = p_index + 1
5900 18 : tmp = scale*prim(p_index)
5901 18 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5902 18 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5903 18 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5904 36 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5905 : END DO
5906 18 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5907 36 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5908 : END DO
5909 : END DO
5910 : END DO
5911 1 : END SUBROUTINE block_1_1_6_3
5912 : ! **************************************************************************************************
5913 : !> \brief ...
5914 : !> \param md_max ...
5915 : !> \param kbd ...
5916 : !> \param kbc ...
5917 : !> \param kad ...
5918 : !> \param kac ...
5919 : !> \param pbd ...
5920 : !> \param pbc ...
5921 : !> \param pad ...
5922 : !> \param pac ...
5923 : !> \param prim ...
5924 : !> \param scale ...
5925 : ! **************************************************************************************************
5926 20 : SUBROUTINE block_1_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5927 : INTEGER :: md_max
5928 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*6), kad(1*md_max), kac(1*6), pbd(1*md_max), pbc(1*6), &
5929 : pad(1*md_max), pac(1*6), prim(1*1*6*md_max), scale
5930 :
5931 : INTEGER :: ma, mb, mc, md, p_index
5932 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5933 :
5934 194 : kbd(1:1*md_max) = 0.0_dp
5935 20 : kbc(1:1*6) = 0.0_dp
5936 194 : kad(1:1*md_max) = 0.0_dp
5937 20 : kac(1:1*6) = 0.0_dp
5938 20 : p_index = 0
5939 194 : DO md = 1, md_max
5940 1238 : DO mc = 1, 6
5941 2262 : DO mb = 1, 1
5942 1044 : ks_bd = 0.0_dp
5943 1044 : ks_bc = 0.0_dp
5944 1044 : p_bd = pbd((md - 1)*1 + mb)
5945 1044 : p_bc = pbc((mc - 1)*1 + mb)
5946 2088 : DO ma = 1, 1
5947 1044 : p_index = p_index + 1
5948 1044 : tmp = scale*prim(p_index)
5949 1044 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5950 1044 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5951 1044 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5952 2088 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5953 : END DO
5954 1044 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5955 2088 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5956 : END DO
5957 : END DO
5958 : END DO
5959 20 : END SUBROUTINE block_1_1_6
5960 : ! **************************************************************************************************
5961 : !> \brief ...
5962 : !> \param kbd ...
5963 : !> \param kbc ...
5964 : !> \param kad ...
5965 : !> \param kac ...
5966 : !> \param pbd ...
5967 : !> \param pbc ...
5968 : !> \param pad ...
5969 : !> \param pac ...
5970 : !> \param prim ...
5971 : !> \param scale ...
5972 : ! **************************************************************************************************
5973 55680 : SUBROUTINE block_1_1_7_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
5974 : REAL(KIND=dp) :: kbd(1*1), kbc(1*7), kad(1*1), kac(1*7), &
5975 : pbd(1*1), pbc(1*7), pad(1*1), &
5976 : pac(1*7), prim(1*1*7*1), scale
5977 :
5978 : INTEGER :: ma, mb, mc, md, p_index
5979 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
5980 :
5981 55680 : kbd(1:1*1) = 0.0_dp
5982 55680 : kbc(1:1*7) = 0.0_dp
5983 55680 : kad(1:1*1) = 0.0_dp
5984 55680 : kac(1:1*7) = 0.0_dp
5985 55680 : p_index = 0
5986 111360 : DO md = 1, 1
5987 501120 : DO mc = 1, 7
5988 835200 : DO mb = 1, 1
5989 389760 : ks_bd = 0.0_dp
5990 389760 : ks_bc = 0.0_dp
5991 389760 : p_bd = pbd((md - 1)*1 + mb)
5992 389760 : p_bc = pbc((mc - 1)*1 + mb)
5993 779520 : DO ma = 1, 1
5994 389760 : p_index = p_index + 1
5995 389760 : tmp = scale*prim(p_index)
5996 389760 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5997 389760 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5998 389760 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5999 779520 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6000 : END DO
6001 389760 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6002 779520 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6003 : END DO
6004 : END DO
6005 : END DO
6006 55680 : END SUBROUTINE block_1_1_7_1
6007 : ! **************************************************************************************************
6008 : !> \brief ...
6009 : !> \param kbd ...
6010 : !> \param kbc ...
6011 : !> \param kad ...
6012 : !> \param kac ...
6013 : !> \param pbd ...
6014 : !> \param pbc ...
6015 : !> \param pad ...
6016 : !> \param pac ...
6017 : !> \param prim ...
6018 : !> \param scale ...
6019 : ! **************************************************************************************************
6020 737 : SUBROUTINE block_1_1_7_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6021 : REAL(KIND=dp) :: kbd(1*2), kbc(1*7), kad(1*2), kac(1*7), &
6022 : pbd(1*2), pbc(1*7), pad(1*2), &
6023 : pac(1*7), prim(1*1*7*2), scale
6024 :
6025 : INTEGER :: ma, mb, mc, md, p_index
6026 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6027 :
6028 737 : kbd(1:1*2) = 0.0_dp
6029 737 : kbc(1:1*7) = 0.0_dp
6030 737 : kad(1:1*2) = 0.0_dp
6031 737 : kac(1:1*7) = 0.0_dp
6032 737 : p_index = 0
6033 2211 : DO md = 1, 2
6034 12529 : DO mc = 1, 7
6035 22110 : DO mb = 1, 1
6036 10318 : ks_bd = 0.0_dp
6037 10318 : ks_bc = 0.0_dp
6038 10318 : p_bd = pbd((md - 1)*1 + mb)
6039 10318 : p_bc = pbc((mc - 1)*1 + mb)
6040 20636 : DO ma = 1, 1
6041 10318 : p_index = p_index + 1
6042 10318 : tmp = scale*prim(p_index)
6043 10318 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6044 10318 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6045 10318 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6046 20636 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6047 : END DO
6048 10318 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6049 20636 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6050 : END DO
6051 : END DO
6052 : END DO
6053 737 : END SUBROUTINE block_1_1_7_2
6054 : ! **************************************************************************************************
6055 : !> \brief ...
6056 : !> \param md_max ...
6057 : !> \param kbd ...
6058 : !> \param kbc ...
6059 : !> \param kad ...
6060 : !> \param kac ...
6061 : !> \param pbd ...
6062 : !> \param pbc ...
6063 : !> \param pad ...
6064 : !> \param pac ...
6065 : !> \param prim ...
6066 : !> \param scale ...
6067 : ! **************************************************************************************************
6068 51680 : SUBROUTINE block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6069 : INTEGER :: md_max
6070 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*7), kad(1*md_max), kac(1*7), pbd(1*md_max), pbc(1*7), &
6071 : pad(1*md_max), pac(1*7), prim(1*1*7*md_max), scale
6072 :
6073 : INTEGER :: ma, mb, mc, md, p_index
6074 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6075 :
6076 251936 : kbd(1:1*md_max) = 0.0_dp
6077 51680 : kbc(1:1*7) = 0.0_dp
6078 251936 : kad(1:1*md_max) = 0.0_dp
6079 51680 : kac(1:1*7) = 0.0_dp
6080 51680 : p_index = 0
6081 251936 : DO md = 1, md_max
6082 1653728 : DO mc = 1, 7
6083 3003840 : DO mb = 1, 1
6084 1401792 : ks_bd = 0.0_dp
6085 1401792 : ks_bc = 0.0_dp
6086 1401792 : p_bd = pbd((md - 1)*1 + mb)
6087 1401792 : p_bc = pbc((mc - 1)*1 + mb)
6088 2803584 : DO ma = 1, 1
6089 1401792 : p_index = p_index + 1
6090 1401792 : tmp = scale*prim(p_index)
6091 1401792 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6092 1401792 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6093 1401792 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6094 2803584 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6095 : END DO
6096 1401792 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6097 2803584 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6098 : END DO
6099 : END DO
6100 : END DO
6101 51680 : END SUBROUTINE block_1_1_7
6102 : ! **************************************************************************************************
6103 : !> \brief ...
6104 : !> \param kbd ...
6105 : !> \param kbc ...
6106 : !> \param kad ...
6107 : !> \param kac ...
6108 : !> \param pbd ...
6109 : !> \param pbc ...
6110 : !> \param pad ...
6111 : !> \param pac ...
6112 : !> \param prim ...
6113 : !> \param scale ...
6114 : ! **************************************************************************************************
6115 10 : SUBROUTINE block_1_1_9_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6116 : REAL(KIND=dp) :: kbd(1*1), kbc(1*9), kad(1*1), kac(1*9), &
6117 : pbd(1*1), pbc(1*9), pad(1*1), &
6118 : pac(1*9), prim(1*1*9*1), scale
6119 :
6120 : INTEGER :: ma, mb, mc, md, p_index
6121 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6122 :
6123 10 : kbd(1:1*1) = 0.0_dp
6124 10 : kbc(1:1*9) = 0.0_dp
6125 10 : kad(1:1*1) = 0.0_dp
6126 10 : kac(1:1*9) = 0.0_dp
6127 10 : p_index = 0
6128 20 : DO md = 1, 1
6129 110 : DO mc = 1, 9
6130 190 : DO mb = 1, 1
6131 90 : ks_bd = 0.0_dp
6132 90 : ks_bc = 0.0_dp
6133 90 : p_bd = pbd((md - 1)*1 + mb)
6134 90 : p_bc = pbc((mc - 1)*1 + mb)
6135 180 : DO ma = 1, 1
6136 90 : p_index = p_index + 1
6137 90 : tmp = scale*prim(p_index)
6138 90 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6139 90 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6140 90 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6141 180 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6142 : END DO
6143 90 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6144 180 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6145 : END DO
6146 : END DO
6147 : END DO
6148 10 : END SUBROUTINE block_1_1_9_1
6149 : ! **************************************************************************************************
6150 : !> \brief ...
6151 : !> \param kbd ...
6152 : !> \param kbc ...
6153 : !> \param kad ...
6154 : !> \param kac ...
6155 : !> \param pbd ...
6156 : !> \param pbc ...
6157 : !> \param pad ...
6158 : !> \param pac ...
6159 : !> \param prim ...
6160 : !> \param scale ...
6161 : ! **************************************************************************************************
6162 1 : SUBROUTINE block_1_1_9_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6163 : REAL(KIND=dp) :: kbd(1*2), kbc(1*9), kad(1*2), kac(1*9), &
6164 : pbd(1*2), pbc(1*9), pad(1*2), &
6165 : pac(1*9), prim(1*1*9*2), scale
6166 :
6167 : INTEGER :: ma, mb, mc, md, p_index
6168 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6169 :
6170 1 : kbd(1:1*2) = 0.0_dp
6171 1 : kbc(1:1*9) = 0.0_dp
6172 1 : kad(1:1*2) = 0.0_dp
6173 1 : kac(1:1*9) = 0.0_dp
6174 1 : p_index = 0
6175 3 : DO md = 1, 2
6176 21 : DO mc = 1, 9
6177 38 : DO mb = 1, 1
6178 18 : ks_bd = 0.0_dp
6179 18 : ks_bc = 0.0_dp
6180 18 : p_bd = pbd((md - 1)*1 + mb)
6181 18 : p_bc = pbc((mc - 1)*1 + mb)
6182 36 : DO ma = 1, 1
6183 18 : p_index = p_index + 1
6184 18 : tmp = scale*prim(p_index)
6185 18 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6186 18 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6187 18 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6188 36 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6189 : END DO
6190 18 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6191 36 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6192 : END DO
6193 : END DO
6194 : END DO
6195 1 : END SUBROUTINE block_1_1_9_2
6196 : ! **************************************************************************************************
6197 : !> \brief ...
6198 : !> \param md_max ...
6199 : !> \param kbd ...
6200 : !> \param kbc ...
6201 : !> \param kad ...
6202 : !> \param kac ...
6203 : !> \param pbd ...
6204 : !> \param pbc ...
6205 : !> \param pad ...
6206 : !> \param pac ...
6207 : !> \param prim ...
6208 : !> \param scale ...
6209 : ! **************************************************************************************************
6210 57 : SUBROUTINE block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6211 : INTEGER :: md_max
6212 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*9), kad(1*md_max), kac(1*9), pbd(1*md_max), pbc(1*9), &
6213 : pad(1*md_max), pac(1*9), prim(1*1*9*md_max), scale
6214 :
6215 : INTEGER :: ma, mb, mc, md, p_index
6216 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6217 :
6218 608 : kbd(1:1*md_max) = 0.0_dp
6219 57 : kbc(1:1*9) = 0.0_dp
6220 608 : kad(1:1*md_max) = 0.0_dp
6221 57 : kac(1:1*9) = 0.0_dp
6222 57 : p_index = 0
6223 608 : DO md = 1, md_max
6224 5567 : DO mc = 1, 9
6225 10469 : DO mb = 1, 1
6226 4959 : ks_bd = 0.0_dp
6227 4959 : ks_bc = 0.0_dp
6228 4959 : p_bd = pbd((md - 1)*1 + mb)
6229 4959 : p_bc = pbc((mc - 1)*1 + mb)
6230 9918 : DO ma = 1, 1
6231 4959 : p_index = p_index + 1
6232 4959 : tmp = scale*prim(p_index)
6233 4959 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6234 4959 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6235 4959 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6236 9918 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6237 : END DO
6238 4959 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6239 9918 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6240 : END DO
6241 : END DO
6242 : END DO
6243 57 : END SUBROUTINE block_1_1_9
6244 : ! **************************************************************************************************
6245 : !> \brief ...
6246 : !> \param kbd ...
6247 : !> \param kbc ...
6248 : !> \param kad ...
6249 : !> \param kac ...
6250 : !> \param pbd ...
6251 : !> \param pbc ...
6252 : !> \param pad ...
6253 : !> \param pac ...
6254 : !> \param prim ...
6255 : !> \param scale ...
6256 : ! **************************************************************************************************
6257 9 : SUBROUTINE block_1_1_10_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6258 : REAL(KIND=dp) :: kbd(1*1), kbc(1*10), kad(1*1), &
6259 : kac(1*10), pbd(1*1), pbc(1*10), &
6260 : pad(1*1), pac(1*10), prim(1*1*10*1), &
6261 : scale
6262 :
6263 : INTEGER :: ma, mb, mc, md, p_index
6264 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6265 :
6266 9 : kbd(1:1*1) = 0.0_dp
6267 9 : kbc(1:1*10) = 0.0_dp
6268 9 : kad(1:1*1) = 0.0_dp
6269 9 : kac(1:1*10) = 0.0_dp
6270 9 : p_index = 0
6271 18 : DO md = 1, 1
6272 108 : DO mc = 1, 10
6273 189 : DO mb = 1, 1
6274 90 : ks_bd = 0.0_dp
6275 90 : ks_bc = 0.0_dp
6276 90 : p_bd = pbd((md - 1)*1 + mb)
6277 90 : p_bc = pbc((mc - 1)*1 + mb)
6278 180 : DO ma = 1, 1
6279 90 : p_index = p_index + 1
6280 90 : tmp = scale*prim(p_index)
6281 90 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6282 90 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6283 90 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6284 180 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6285 : END DO
6286 90 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6287 180 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6288 : END DO
6289 : END DO
6290 : END DO
6291 9 : END SUBROUTINE block_1_1_10_1
6292 : ! **************************************************************************************************
6293 : !> \brief ...
6294 : !> \param md_max ...
6295 : !> \param kbd ...
6296 : !> \param kbc ...
6297 : !> \param kad ...
6298 : !> \param kac ...
6299 : !> \param pbd ...
6300 : !> \param pbc ...
6301 : !> \param pad ...
6302 : !> \param pac ...
6303 : !> \param prim ...
6304 : !> \param scale ...
6305 : ! **************************************************************************************************
6306 46 : SUBROUTINE block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6307 : INTEGER :: md_max
6308 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*10), kad(1*md_max), kac(1*10), pbd(1*md_max), &
6309 : pbc(1*10), pad(1*md_max), pac(1*10), prim(1*1*10*md_max), scale
6310 :
6311 : INTEGER :: ma, mb, mc, md, p_index
6312 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6313 :
6314 488 : kbd(1:1*md_max) = 0.0_dp
6315 46 : kbc(1:1*10) = 0.0_dp
6316 488 : kad(1:1*md_max) = 0.0_dp
6317 46 : kac(1:1*10) = 0.0_dp
6318 46 : p_index = 0
6319 488 : DO md = 1, md_max
6320 4908 : DO mc = 1, 10
6321 9282 : DO mb = 1, 1
6322 4420 : ks_bd = 0.0_dp
6323 4420 : ks_bc = 0.0_dp
6324 4420 : p_bd = pbd((md - 1)*1 + mb)
6325 4420 : p_bc = pbc((mc - 1)*1 + mb)
6326 8840 : DO ma = 1, 1
6327 4420 : p_index = p_index + 1
6328 4420 : tmp = scale*prim(p_index)
6329 4420 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6330 4420 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6331 4420 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6332 8840 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6333 : END DO
6334 4420 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6335 8840 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6336 : END DO
6337 : END DO
6338 : END DO
6339 46 : END SUBROUTINE block_1_1_10
6340 : ! **************************************************************************************************
6341 : !> \brief ...
6342 : !> \param kbd ...
6343 : !> \param kbc ...
6344 : !> \param kad ...
6345 : !> \param kac ...
6346 : !> \param pbd ...
6347 : !> \param pbc ...
6348 : !> \param pad ...
6349 : !> \param pac ...
6350 : !> \param prim ...
6351 : !> \param scale ...
6352 : ! **************************************************************************************************
6353 9 : SUBROUTINE block_1_1_11_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6354 : REAL(KIND=dp) :: kbd(1*1), kbc(1*11), kad(1*1), &
6355 : kac(1*11), pbd(1*1), pbc(1*11), &
6356 : pad(1*1), pac(1*11), prim(1*1*11*1), &
6357 : scale
6358 :
6359 : INTEGER :: ma, mb, mc, md, p_index
6360 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6361 :
6362 9 : kbd(1:1*1) = 0.0_dp
6363 9 : kbc(1:1*11) = 0.0_dp
6364 9 : kad(1:1*1) = 0.0_dp
6365 9 : kac(1:1*11) = 0.0_dp
6366 9 : p_index = 0
6367 18 : DO md = 1, 1
6368 117 : DO mc = 1, 11
6369 207 : DO mb = 1, 1
6370 99 : ks_bd = 0.0_dp
6371 99 : ks_bc = 0.0_dp
6372 99 : p_bd = pbd((md - 1)*1 + mb)
6373 99 : p_bc = pbc((mc - 1)*1 + mb)
6374 198 : DO ma = 1, 1
6375 99 : p_index = p_index + 1
6376 99 : tmp = scale*prim(p_index)
6377 99 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6378 99 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6379 99 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6380 198 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6381 : END DO
6382 99 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6383 198 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6384 : END DO
6385 : END DO
6386 : END DO
6387 9 : END SUBROUTINE block_1_1_11_1
6388 : ! **************************************************************************************************
6389 : !> \brief ...
6390 : !> \param md_max ...
6391 : !> \param kbd ...
6392 : !> \param kbc ...
6393 : !> \param kad ...
6394 : !> \param kac ...
6395 : !> \param pbd ...
6396 : !> \param pbc ...
6397 : !> \param pad ...
6398 : !> \param pac ...
6399 : !> \param prim ...
6400 : !> \param scale ...
6401 : ! **************************************************************************************************
6402 39 : SUBROUTINE block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6403 : INTEGER :: md_max
6404 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*11), kad(1*md_max), kac(1*11), pbd(1*md_max), &
6405 : pbc(1*11), pad(1*md_max), pac(1*11), prim(1*1*11*md_max), scale
6406 :
6407 : INTEGER :: ma, mb, mc, md, p_index
6408 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6409 :
6410 403 : kbd(1:1*md_max) = 0.0_dp
6411 39 : kbc(1:1*11) = 0.0_dp
6412 403 : kad(1:1*md_max) = 0.0_dp
6413 39 : kac(1:1*11) = 0.0_dp
6414 39 : p_index = 0
6415 403 : DO md = 1, md_max
6416 4407 : DO mc = 1, 11
6417 8372 : DO mb = 1, 1
6418 4004 : ks_bd = 0.0_dp
6419 4004 : ks_bc = 0.0_dp
6420 4004 : p_bd = pbd((md - 1)*1 + mb)
6421 4004 : p_bc = pbc((mc - 1)*1 + mb)
6422 8008 : DO ma = 1, 1
6423 4004 : p_index = p_index + 1
6424 4004 : tmp = scale*prim(p_index)
6425 4004 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6426 4004 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6427 4004 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6428 8008 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6429 : END DO
6430 4004 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6431 8008 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6432 : END DO
6433 : END DO
6434 : END DO
6435 39 : END SUBROUTINE block_1_1_11
6436 : ! **************************************************************************************************
6437 : !> \brief ...
6438 : !> \param kbd ...
6439 : !> \param kbc ...
6440 : !> \param kad ...
6441 : !> \param kac ...
6442 : !> \param pbd ...
6443 : !> \param pbc ...
6444 : !> \param pad ...
6445 : !> \param pac ...
6446 : !> \param prim ...
6447 : !> \param scale ...
6448 : ! **************************************************************************************************
6449 10 : SUBROUTINE block_1_1_15_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6450 : REAL(KIND=dp) :: kbd(1*1), kbc(1*15), kad(1*1), &
6451 : kac(1*15), pbd(1*1), pbc(1*15), &
6452 : pad(1*1), pac(1*15), prim(1*1*15*1), &
6453 : scale
6454 :
6455 : INTEGER :: ma, mb, mc, md, p_index
6456 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6457 :
6458 10 : kbd(1:1*1) = 0.0_dp
6459 10 : kbc(1:1*15) = 0.0_dp
6460 10 : kad(1:1*1) = 0.0_dp
6461 10 : kac(1:1*15) = 0.0_dp
6462 10 : p_index = 0
6463 20 : DO md = 1, 1
6464 170 : DO mc = 1, 15
6465 310 : DO mb = 1, 1
6466 150 : ks_bd = 0.0_dp
6467 150 : ks_bc = 0.0_dp
6468 150 : p_bd = pbd((md - 1)*1 + mb)
6469 150 : p_bc = pbc((mc - 1)*1 + mb)
6470 300 : DO ma = 1, 1
6471 150 : p_index = p_index + 1
6472 150 : tmp = scale*prim(p_index)
6473 150 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6474 150 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6475 150 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6476 300 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6477 : END DO
6478 150 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6479 300 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6480 : END DO
6481 : END DO
6482 : END DO
6483 10 : END SUBROUTINE block_1_1_15_1
6484 : ! **************************************************************************************************
6485 : !> \brief ...
6486 : !> \param md_max ...
6487 : !> \param kbd ...
6488 : !> \param kbc ...
6489 : !> \param kad ...
6490 : !> \param kac ...
6491 : !> \param pbd ...
6492 : !> \param pbc ...
6493 : !> \param pad ...
6494 : !> \param pac ...
6495 : !> \param prim ...
6496 : !> \param scale ...
6497 : ! **************************************************************************************************
6498 38 : SUBROUTINE block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6499 : INTEGER :: md_max
6500 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*15), kad(1*md_max), kac(1*15), pbd(1*md_max), &
6501 : pbc(1*15), pad(1*md_max), pac(1*15), prim(1*1*15*md_max), scale
6502 :
6503 : INTEGER :: ma, mb, mc, md, p_index
6504 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6505 :
6506 402 : kbd(1:1*md_max) = 0.0_dp
6507 38 : kbc(1:1*15) = 0.0_dp
6508 402 : kad(1:1*md_max) = 0.0_dp
6509 38 : kac(1:1*15) = 0.0_dp
6510 38 : p_index = 0
6511 402 : DO md = 1, md_max
6512 5862 : DO mc = 1, 15
6513 11284 : DO mb = 1, 1
6514 5460 : ks_bd = 0.0_dp
6515 5460 : ks_bc = 0.0_dp
6516 5460 : p_bd = pbd((md - 1)*1 + mb)
6517 5460 : p_bc = pbc((mc - 1)*1 + mb)
6518 10920 : DO ma = 1, 1
6519 5460 : p_index = p_index + 1
6520 5460 : tmp = scale*prim(p_index)
6521 5460 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6522 5460 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6523 5460 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6524 10920 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6525 : END DO
6526 5460 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6527 10920 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6528 : END DO
6529 : END DO
6530 : END DO
6531 38 : END SUBROUTINE block_1_1_15
6532 : ! **************************************************************************************************
6533 : !> \brief ...
6534 : !> \param kbd ...
6535 : !> \param kbc ...
6536 : !> \param kad ...
6537 : !> \param kac ...
6538 : !> \param pbd ...
6539 : !> \param pbc ...
6540 : !> \param pad ...
6541 : !> \param pac ...
6542 : !> \param prim ...
6543 : !> \param scale ...
6544 : ! **************************************************************************************************
6545 1810 : SUBROUTINE block_1_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6546 : REAL(KIND=dp) :: kbd(2*1), kbc(2*1), kad(1*1), kac(1*1), &
6547 : pbd(2*1), pbc(2*1), pad(1*1), &
6548 : pac(1*1), prim(1*2*1*1), scale
6549 :
6550 : INTEGER :: ma, mb, mc, md, p_index
6551 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6552 :
6553 1810 : kbd(1:2*1) = 0.0_dp
6554 1810 : kbc(1:2*1) = 0.0_dp
6555 1810 : kad(1:1*1) = 0.0_dp
6556 1810 : kac(1:1*1) = 0.0_dp
6557 1810 : p_index = 0
6558 3620 : DO md = 1, 1
6559 5430 : DO mc = 1, 1
6560 7240 : DO mb = 1, 2
6561 3620 : ks_bd = 0.0_dp
6562 3620 : ks_bc = 0.0_dp
6563 3620 : p_bd = pbd((md - 1)*2 + mb)
6564 3620 : p_bc = pbc((mc - 1)*2 + mb)
6565 7240 : DO ma = 1, 1
6566 3620 : p_index = p_index + 1
6567 3620 : tmp = scale*prim(p_index)
6568 3620 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6569 3620 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6570 3620 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6571 7240 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6572 : END DO
6573 3620 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6574 5430 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6575 : END DO
6576 : END DO
6577 : END DO
6578 1810 : END SUBROUTINE block_1_2_1_1
6579 : ! **************************************************************************************************
6580 : !> \brief ...
6581 : !> \param kbd ...
6582 : !> \param kbc ...
6583 : !> \param kad ...
6584 : !> \param kac ...
6585 : !> \param pbd ...
6586 : !> \param pbc ...
6587 : !> \param pad ...
6588 : !> \param pac ...
6589 : !> \param prim ...
6590 : !> \param scale ...
6591 : ! **************************************************************************************************
6592 706 : SUBROUTINE block_1_2_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6593 : REAL(KIND=dp) :: kbd(2*2), kbc(2*1), kad(1*2), kac(1*1), &
6594 : pbd(2*2), pbc(2*1), pad(1*2), &
6595 : pac(1*1), prim(1*2*1*2), scale
6596 :
6597 : INTEGER :: ma, mb, mc, md, p_index
6598 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6599 :
6600 706 : kbd(1:2*2) = 0.0_dp
6601 706 : kbc(1:2*1) = 0.0_dp
6602 706 : kad(1:1*2) = 0.0_dp
6603 706 : kac(1:1*1) = 0.0_dp
6604 706 : p_index = 0
6605 2118 : DO md = 1, 2
6606 3530 : DO mc = 1, 1
6607 5648 : DO mb = 1, 2
6608 2824 : ks_bd = 0.0_dp
6609 2824 : ks_bc = 0.0_dp
6610 2824 : p_bd = pbd((md - 1)*2 + mb)
6611 2824 : p_bc = pbc((mc - 1)*2 + mb)
6612 5648 : DO ma = 1, 1
6613 2824 : p_index = p_index + 1
6614 2824 : tmp = scale*prim(p_index)
6615 2824 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6616 2824 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6617 2824 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6618 5648 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6619 : END DO
6620 2824 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6621 4236 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6622 : END DO
6623 : END DO
6624 : END DO
6625 706 : END SUBROUTINE block_1_2_1_2
6626 : ! **************************************************************************************************
6627 : !> \brief ...
6628 : !> \param kbd ...
6629 : !> \param kbc ...
6630 : !> \param kad ...
6631 : !> \param kac ...
6632 : !> \param pbd ...
6633 : !> \param pbc ...
6634 : !> \param pad ...
6635 : !> \param pac ...
6636 : !> \param prim ...
6637 : !> \param scale ...
6638 : ! **************************************************************************************************
6639 2409 : SUBROUTINE block_1_2_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6640 : REAL(KIND=dp) :: kbd(2*3), kbc(2*1), kad(1*3), kac(1*1), &
6641 : pbd(2*3), pbc(2*1), pad(1*3), &
6642 : pac(1*1), prim(1*2*1*3), scale
6643 :
6644 : INTEGER :: ma, mb, mc, md, p_index
6645 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6646 :
6647 2409 : kbd(1:2*3) = 0.0_dp
6648 2409 : kbc(1:2*1) = 0.0_dp
6649 2409 : kad(1:1*3) = 0.0_dp
6650 2409 : kac(1:1*1) = 0.0_dp
6651 2409 : p_index = 0
6652 9636 : DO md = 1, 3
6653 16863 : DO mc = 1, 1
6654 28908 : DO mb = 1, 2
6655 14454 : ks_bd = 0.0_dp
6656 14454 : ks_bc = 0.0_dp
6657 14454 : p_bd = pbd((md - 1)*2 + mb)
6658 14454 : p_bc = pbc((mc - 1)*2 + mb)
6659 28908 : DO ma = 1, 1
6660 14454 : p_index = p_index + 1
6661 14454 : tmp = scale*prim(p_index)
6662 14454 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6663 14454 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6664 14454 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6665 28908 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6666 : END DO
6667 14454 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6668 21681 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6669 : END DO
6670 : END DO
6671 : END DO
6672 2409 : END SUBROUTINE block_1_2_1_3
6673 : ! **************************************************************************************************
6674 : !> \brief ...
6675 : !> \param kbd ...
6676 : !> \param kbc ...
6677 : !> \param kad ...
6678 : !> \param kac ...
6679 : !> \param pbd ...
6680 : !> \param pbc ...
6681 : !> \param pad ...
6682 : !> \param pac ...
6683 : !> \param prim ...
6684 : !> \param scale ...
6685 : ! **************************************************************************************************
6686 4 : SUBROUTINE block_1_2_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6687 : REAL(KIND=dp) :: kbd(2*4), kbc(2*1), kad(1*4), kac(1*1), &
6688 : pbd(2*4), pbc(2*1), pad(1*4), &
6689 : pac(1*1), prim(1*2*1*4), scale
6690 :
6691 : INTEGER :: ma, mb, mc, md, p_index
6692 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6693 :
6694 4 : kbd(1:2*4) = 0.0_dp
6695 4 : kbc(1:2*1) = 0.0_dp
6696 4 : kad(1:1*4) = 0.0_dp
6697 4 : kac(1:1*1) = 0.0_dp
6698 4 : p_index = 0
6699 20 : DO md = 1, 4
6700 36 : DO mc = 1, 1
6701 64 : DO mb = 1, 2
6702 32 : ks_bd = 0.0_dp
6703 32 : ks_bc = 0.0_dp
6704 32 : p_bd = pbd((md - 1)*2 + mb)
6705 32 : p_bc = pbc((mc - 1)*2 + mb)
6706 64 : DO ma = 1, 1
6707 32 : p_index = p_index + 1
6708 32 : tmp = scale*prim(p_index)
6709 32 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6710 32 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6711 32 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6712 64 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6713 : END DO
6714 32 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6715 48 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6716 : END DO
6717 : END DO
6718 : END DO
6719 4 : END SUBROUTINE block_1_2_1_4
6720 : ! **************************************************************************************************
6721 : !> \brief ...
6722 : !> \param kbd ...
6723 : !> \param kbc ...
6724 : !> \param kad ...
6725 : !> \param kac ...
6726 : !> \param pbd ...
6727 : !> \param pbc ...
6728 : !> \param pad ...
6729 : !> \param pac ...
6730 : !> \param prim ...
6731 : !> \param scale ...
6732 : ! **************************************************************************************************
6733 1708 : SUBROUTINE block_1_2_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6734 : REAL(KIND=dp) :: kbd(2*5), kbc(2*1), kad(1*5), kac(1*1), &
6735 : pbd(2*5), pbc(2*1), pad(1*5), &
6736 : pac(1*1), prim(1*2*1*5), scale
6737 :
6738 : INTEGER :: ma, mb, mc, md, p_index
6739 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6740 :
6741 1708 : kbd(1:2*5) = 0.0_dp
6742 1708 : kbc(1:2*1) = 0.0_dp
6743 1708 : kad(1:1*5) = 0.0_dp
6744 1708 : kac(1:1*1) = 0.0_dp
6745 1708 : p_index = 0
6746 10248 : DO md = 1, 5
6747 18788 : DO mc = 1, 1
6748 34160 : DO mb = 1, 2
6749 17080 : ks_bd = 0.0_dp
6750 17080 : ks_bc = 0.0_dp
6751 17080 : p_bd = pbd((md - 1)*2 + mb)
6752 17080 : p_bc = pbc((mc - 1)*2 + mb)
6753 34160 : DO ma = 1, 1
6754 17080 : p_index = p_index + 1
6755 17080 : tmp = scale*prim(p_index)
6756 17080 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6757 17080 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6758 17080 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6759 34160 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6760 : END DO
6761 17080 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6762 25620 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6763 : END DO
6764 : END DO
6765 : END DO
6766 1708 : END SUBROUTINE block_1_2_1_5
6767 : ! **************************************************************************************************
6768 : !> \brief ...
6769 : !> \param kbd ...
6770 : !> \param kbc ...
6771 : !> \param kad ...
6772 : !> \param kac ...
6773 : !> \param pbd ...
6774 : !> \param pbc ...
6775 : !> \param pad ...
6776 : !> \param pac ...
6777 : !> \param prim ...
6778 : !> \param scale ...
6779 : ! **************************************************************************************************
6780 4 : SUBROUTINE block_1_2_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6781 : REAL(KIND=dp) :: kbd(2*6), kbc(2*1), kad(1*6), kac(1*1), &
6782 : pbd(2*6), pbc(2*1), pad(1*6), &
6783 : pac(1*1), prim(1*2*1*6), scale
6784 :
6785 : INTEGER :: ma, mb, mc, md, p_index
6786 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6787 :
6788 4 : kbd(1:2*6) = 0.0_dp
6789 4 : kbc(1:2*1) = 0.0_dp
6790 4 : kad(1:1*6) = 0.0_dp
6791 4 : kac(1:1*1) = 0.0_dp
6792 4 : p_index = 0
6793 28 : DO md = 1, 6
6794 52 : DO mc = 1, 1
6795 96 : DO mb = 1, 2
6796 48 : ks_bd = 0.0_dp
6797 48 : ks_bc = 0.0_dp
6798 48 : p_bd = pbd((md - 1)*2 + mb)
6799 48 : p_bc = pbc((mc - 1)*2 + mb)
6800 96 : DO ma = 1, 1
6801 48 : p_index = p_index + 1
6802 48 : tmp = scale*prim(p_index)
6803 48 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6804 48 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6805 48 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6806 96 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6807 : END DO
6808 48 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6809 72 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6810 : END DO
6811 : END DO
6812 : END DO
6813 4 : END SUBROUTINE block_1_2_1_6
6814 : ! **************************************************************************************************
6815 : !> \brief ...
6816 : !> \param kbd ...
6817 : !> \param kbc ...
6818 : !> \param kad ...
6819 : !> \param kac ...
6820 : !> \param pbd ...
6821 : !> \param pbc ...
6822 : !> \param pad ...
6823 : !> \param pac ...
6824 : !> \param prim ...
6825 : !> \param scale ...
6826 : ! **************************************************************************************************
6827 713 : SUBROUTINE block_1_2_1_7(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6828 : REAL(KIND=dp) :: kbd(2*7), kbc(2*1), kad(1*7), kac(1*1), &
6829 : pbd(2*7), pbc(2*1), pad(1*7), &
6830 : pac(1*1), prim(1*2*1*7), scale
6831 :
6832 : INTEGER :: ma, mb, mc, md, p_index
6833 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6834 :
6835 713 : kbd(1:2*7) = 0.0_dp
6836 713 : kbc(1:2*1) = 0.0_dp
6837 713 : kad(1:1*7) = 0.0_dp
6838 713 : kac(1:1*1) = 0.0_dp
6839 713 : p_index = 0
6840 5704 : DO md = 1, 7
6841 10695 : DO mc = 1, 1
6842 19964 : DO mb = 1, 2
6843 9982 : ks_bd = 0.0_dp
6844 9982 : ks_bc = 0.0_dp
6845 9982 : p_bd = pbd((md - 1)*2 + mb)
6846 9982 : p_bc = pbc((mc - 1)*2 + mb)
6847 19964 : DO ma = 1, 1
6848 9982 : p_index = p_index + 1
6849 9982 : tmp = scale*prim(p_index)
6850 9982 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6851 9982 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6852 9982 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6853 19964 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6854 : END DO
6855 9982 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6856 14973 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6857 : END DO
6858 : END DO
6859 : END DO
6860 713 : END SUBROUTINE block_1_2_1_7
6861 : ! **************************************************************************************************
6862 : !> \brief ...
6863 : !> \param kbd ...
6864 : !> \param kbc ...
6865 : !> \param kad ...
6866 : !> \param kac ...
6867 : !> \param pbd ...
6868 : !> \param pbc ...
6869 : !> \param pad ...
6870 : !> \param pac ...
6871 : !> \param prim ...
6872 : !> \param scale ...
6873 : ! **************************************************************************************************
6874 1 : SUBROUTINE block_1_2_1_9(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6875 : REAL(KIND=dp) :: kbd(2*9), kbc(2*1), kad(1*9), kac(1*1), &
6876 : pbd(2*9), pbc(2*1), pad(1*9), &
6877 : pac(1*1), prim(1*2*1*9), scale
6878 :
6879 : INTEGER :: ma, mb, mc, md, p_index
6880 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6881 :
6882 1 : kbd(1:2*9) = 0.0_dp
6883 1 : kbc(1:2*1) = 0.0_dp
6884 1 : kad(1:1*9) = 0.0_dp
6885 1 : kac(1:1*1) = 0.0_dp
6886 1 : p_index = 0
6887 10 : DO md = 1, 9
6888 19 : DO mc = 1, 1
6889 36 : DO mb = 1, 2
6890 18 : ks_bd = 0.0_dp
6891 18 : ks_bc = 0.0_dp
6892 18 : p_bd = pbd((md - 1)*2 + mb)
6893 18 : p_bc = pbc((mc - 1)*2 + mb)
6894 36 : DO ma = 1, 1
6895 18 : p_index = p_index + 1
6896 18 : tmp = scale*prim(p_index)
6897 18 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6898 18 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6899 18 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6900 36 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6901 : END DO
6902 18 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6903 27 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6904 : END DO
6905 : END DO
6906 : END DO
6907 1 : END SUBROUTINE block_1_2_1_9
6908 : ! **************************************************************************************************
6909 : !> \brief ...
6910 : !> \param md_max ...
6911 : !> \param kbd ...
6912 : !> \param kbc ...
6913 : !> \param kad ...
6914 : !> \param kac ...
6915 : !> \param pbd ...
6916 : !> \param pbc ...
6917 : !> \param pad ...
6918 : !> \param pac ...
6919 : !> \param prim ...
6920 : !> \param scale ...
6921 : ! **************************************************************************************************
6922 3 : SUBROUTINE block_1_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6923 : INTEGER :: md_max
6924 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*1), kad(1*md_max), kac(1*1), pbd(2*md_max), pbc(2*1), &
6925 : pad(1*md_max), pac(1*1), prim(1*2*1*md_max), scale
6926 :
6927 : INTEGER :: ma, mb, mc, md, p_index
6928 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6929 :
6930 75 : kbd(1:2*md_max) = 0.0_dp
6931 3 : kbc(1:2*1) = 0.0_dp
6932 39 : kad(1:1*md_max) = 0.0_dp
6933 3 : kac(1:1*1) = 0.0_dp
6934 3 : p_index = 0
6935 39 : DO md = 1, md_max
6936 75 : DO mc = 1, 1
6937 144 : DO mb = 1, 2
6938 72 : ks_bd = 0.0_dp
6939 72 : ks_bc = 0.0_dp
6940 72 : p_bd = pbd((md - 1)*2 + mb)
6941 72 : p_bc = pbc((mc - 1)*2 + mb)
6942 144 : DO ma = 1, 1
6943 72 : p_index = p_index + 1
6944 72 : tmp = scale*prim(p_index)
6945 72 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6946 72 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6947 72 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6948 144 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6949 : END DO
6950 72 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6951 108 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6952 : END DO
6953 : END DO
6954 : END DO
6955 3 : END SUBROUTINE block_1_2_1
6956 : ! **************************************************************************************************
6957 : !> \brief ...
6958 : !> \param kbd ...
6959 : !> \param kbc ...
6960 : !> \param kad ...
6961 : !> \param kac ...
6962 : !> \param pbd ...
6963 : !> \param pbc ...
6964 : !> \param pad ...
6965 : !> \param pac ...
6966 : !> \param prim ...
6967 : !> \param scale ...
6968 : ! **************************************************************************************************
6969 698 : SUBROUTINE block_1_2_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
6970 : REAL(KIND=dp) :: kbd(2*1), kbc(2*2), kad(1*1), kac(1*2), &
6971 : pbd(2*1), pbc(2*2), pad(1*1), &
6972 : pac(1*2), prim(1*2*2*1), scale
6973 :
6974 : INTEGER :: ma, mb, mc, md, p_index
6975 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
6976 :
6977 698 : kbd(1:2*1) = 0.0_dp
6978 698 : kbc(1:2*2) = 0.0_dp
6979 698 : kad(1:1*1) = 0.0_dp
6980 698 : kac(1:1*2) = 0.0_dp
6981 698 : p_index = 0
6982 1396 : DO md = 1, 1
6983 2792 : DO mc = 1, 2
6984 4886 : DO mb = 1, 2
6985 2792 : ks_bd = 0.0_dp
6986 2792 : ks_bc = 0.0_dp
6987 2792 : p_bd = pbd((md - 1)*2 + mb)
6988 2792 : p_bc = pbc((mc - 1)*2 + mb)
6989 5584 : DO ma = 1, 1
6990 2792 : p_index = p_index + 1
6991 2792 : tmp = scale*prim(p_index)
6992 2792 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6993 2792 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6994 2792 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6995 5584 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6996 : END DO
6997 2792 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6998 4188 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6999 : END DO
7000 : END DO
7001 : END DO
7002 698 : END SUBROUTINE block_1_2_2_1
7003 : ! **************************************************************************************************
7004 : !> \brief ...
7005 : !> \param kbd ...
7006 : !> \param kbc ...
7007 : !> \param kad ...
7008 : !> \param kac ...
7009 : !> \param pbd ...
7010 : !> \param pbc ...
7011 : !> \param pad ...
7012 : !> \param pac ...
7013 : !> \param prim ...
7014 : !> \param scale ...
7015 : ! **************************************************************************************************
7016 307 : SUBROUTINE block_1_2_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7017 : REAL(KIND=dp) :: kbd(2*2), kbc(2*2), kad(1*2), kac(1*2), &
7018 : pbd(2*2), pbc(2*2), pad(1*2), &
7019 : pac(1*2), prim(1*2*2*2), scale
7020 :
7021 : INTEGER :: ma, mb, mc, md, p_index
7022 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7023 :
7024 307 : kbd(1:2*2) = 0.0_dp
7025 307 : kbc(1:2*2) = 0.0_dp
7026 307 : kad(1:1*2) = 0.0_dp
7027 307 : kac(1:1*2) = 0.0_dp
7028 307 : p_index = 0
7029 921 : DO md = 1, 2
7030 2149 : DO mc = 1, 2
7031 4298 : DO mb = 1, 2
7032 2456 : ks_bd = 0.0_dp
7033 2456 : ks_bc = 0.0_dp
7034 2456 : p_bd = pbd((md - 1)*2 + mb)
7035 2456 : p_bc = pbc((mc - 1)*2 + mb)
7036 4912 : DO ma = 1, 1
7037 2456 : p_index = p_index + 1
7038 2456 : tmp = scale*prim(p_index)
7039 2456 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7040 2456 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7041 2456 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7042 4912 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7043 : END DO
7044 2456 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7045 3684 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7046 : END DO
7047 : END DO
7048 : END DO
7049 307 : END SUBROUTINE block_1_2_2_2
7050 : ! **************************************************************************************************
7051 : !> \brief ...
7052 : !> \param kbd ...
7053 : !> \param kbc ...
7054 : !> \param kad ...
7055 : !> \param kac ...
7056 : !> \param pbd ...
7057 : !> \param pbc ...
7058 : !> \param pad ...
7059 : !> \param pac ...
7060 : !> \param prim ...
7061 : !> \param scale ...
7062 : ! **************************************************************************************************
7063 941 : SUBROUTINE block_1_2_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7064 : REAL(KIND=dp) :: kbd(2*3), kbc(2*2), kad(1*3), kac(1*2), &
7065 : pbd(2*3), pbc(2*2), pad(1*3), &
7066 : pac(1*2), prim(1*2*2*3), scale
7067 :
7068 : INTEGER :: ma, mb, mc, md, p_index
7069 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7070 :
7071 941 : kbd(1:2*3) = 0.0_dp
7072 941 : kbc(1:2*2) = 0.0_dp
7073 941 : kad(1:1*3) = 0.0_dp
7074 941 : kac(1:1*2) = 0.0_dp
7075 941 : p_index = 0
7076 3764 : DO md = 1, 3
7077 9410 : DO mc = 1, 2
7078 19761 : DO mb = 1, 2
7079 11292 : ks_bd = 0.0_dp
7080 11292 : ks_bc = 0.0_dp
7081 11292 : p_bd = pbd((md - 1)*2 + mb)
7082 11292 : p_bc = pbc((mc - 1)*2 + mb)
7083 22584 : DO ma = 1, 1
7084 11292 : p_index = p_index + 1
7085 11292 : tmp = scale*prim(p_index)
7086 11292 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7087 11292 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7088 11292 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7089 22584 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7090 : END DO
7091 11292 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7092 16938 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7093 : END DO
7094 : END DO
7095 : END DO
7096 941 : END SUBROUTINE block_1_2_2_3
7097 : ! **************************************************************************************************
7098 : !> \brief ...
7099 : !> \param kbd ...
7100 : !> \param kbc ...
7101 : !> \param kad ...
7102 : !> \param kac ...
7103 : !> \param pbd ...
7104 : !> \param pbc ...
7105 : !> \param pad ...
7106 : !> \param pac ...
7107 : !> \param prim ...
7108 : !> \param scale ...
7109 : ! **************************************************************************************************
7110 3 : SUBROUTINE block_1_2_2_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7111 : REAL(KIND=dp) :: kbd(2*4), kbc(2*2), kad(1*4), kac(1*2), &
7112 : pbd(2*4), pbc(2*2), pad(1*4), &
7113 : pac(1*2), prim(1*2*2*4), scale
7114 :
7115 : INTEGER :: ma, mb, mc, md, p_index
7116 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7117 :
7118 3 : kbd(1:2*4) = 0.0_dp
7119 3 : kbc(1:2*2) = 0.0_dp
7120 3 : kad(1:1*4) = 0.0_dp
7121 3 : kac(1:1*2) = 0.0_dp
7122 3 : p_index = 0
7123 15 : DO md = 1, 4
7124 39 : DO mc = 1, 2
7125 84 : DO mb = 1, 2
7126 48 : ks_bd = 0.0_dp
7127 48 : ks_bc = 0.0_dp
7128 48 : p_bd = pbd((md - 1)*2 + mb)
7129 48 : p_bc = pbc((mc - 1)*2 + mb)
7130 96 : DO ma = 1, 1
7131 48 : p_index = p_index + 1
7132 48 : tmp = scale*prim(p_index)
7133 48 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7134 48 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7135 48 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7136 96 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7137 : END DO
7138 48 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7139 72 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7140 : END DO
7141 : END DO
7142 : END DO
7143 3 : END SUBROUTINE block_1_2_2_4
7144 : ! **************************************************************************************************
7145 : !> \brief ...
7146 : !> \param md_max ...
7147 : !> \param kbd ...
7148 : !> \param kbc ...
7149 : !> \param kad ...
7150 : !> \param kac ...
7151 : !> \param pbd ...
7152 : !> \param pbc ...
7153 : !> \param pad ...
7154 : !> \param pac ...
7155 : !> \param prim ...
7156 : !> \param scale ...
7157 : ! **************************************************************************************************
7158 906 : SUBROUTINE block_1_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7159 : INTEGER :: md_max
7160 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*2), kad(1*md_max), kac(1*2), pbd(2*md_max), pbc(2*2), &
7161 : pad(1*md_max), pac(1*2), prim(1*2*2*md_max), scale
7162 :
7163 : INTEGER :: ma, mb, mc, md, p_index
7164 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7165 :
7166 10964 : kbd(1:2*md_max) = 0.0_dp
7167 906 : kbc(1:2*2) = 0.0_dp
7168 5935 : kad(1:1*md_max) = 0.0_dp
7169 906 : kac(1:1*2) = 0.0_dp
7170 906 : p_index = 0
7171 5935 : DO md = 1, md_max
7172 15993 : DO mc = 1, 2
7173 35203 : DO mb = 1, 2
7174 20116 : ks_bd = 0.0_dp
7175 20116 : ks_bc = 0.0_dp
7176 20116 : p_bd = pbd((md - 1)*2 + mb)
7177 20116 : p_bc = pbc((mc - 1)*2 + mb)
7178 40232 : DO ma = 1, 1
7179 20116 : p_index = p_index + 1
7180 20116 : tmp = scale*prim(p_index)
7181 20116 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7182 20116 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7183 20116 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7184 40232 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7185 : END DO
7186 20116 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7187 30174 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7188 : END DO
7189 : END DO
7190 : END DO
7191 906 : END SUBROUTINE block_1_2_2
7192 : ! **************************************************************************************************
7193 : !> \brief ...
7194 : !> \param kbd ...
7195 : !> \param kbc ...
7196 : !> \param kad ...
7197 : !> \param kac ...
7198 : !> \param pbd ...
7199 : !> \param pbc ...
7200 : !> \param pad ...
7201 : !> \param pac ...
7202 : !> \param prim ...
7203 : !> \param scale ...
7204 : ! **************************************************************************************************
7205 2406 : SUBROUTINE block_1_2_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7206 : REAL(KIND=dp) :: kbd(2*1), kbc(2*3), kad(1*1), kac(1*3), &
7207 : pbd(2*1), pbc(2*3), pad(1*1), &
7208 : pac(1*3), prim(1*2*3*1), scale
7209 :
7210 : INTEGER :: ma, mb, mc, md, p_index
7211 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7212 :
7213 2406 : kbd(1:2*1) = 0.0_dp
7214 2406 : kbc(1:2*3) = 0.0_dp
7215 2406 : kad(1:1*1) = 0.0_dp
7216 2406 : kac(1:1*3) = 0.0_dp
7217 2406 : p_index = 0
7218 4812 : DO md = 1, 1
7219 12030 : DO mc = 1, 3
7220 24060 : DO mb = 1, 2
7221 14436 : ks_bd = 0.0_dp
7222 14436 : ks_bc = 0.0_dp
7223 14436 : p_bd = pbd((md - 1)*2 + mb)
7224 14436 : p_bc = pbc((mc - 1)*2 + mb)
7225 28872 : DO ma = 1, 1
7226 14436 : p_index = p_index + 1
7227 14436 : tmp = scale*prim(p_index)
7228 14436 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7229 14436 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7230 14436 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7231 28872 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7232 : END DO
7233 14436 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7234 21654 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7235 : END DO
7236 : END DO
7237 : END DO
7238 2406 : END SUBROUTINE block_1_2_3_1
7239 : ! **************************************************************************************************
7240 : !> \brief ...
7241 : !> \param kbd ...
7242 : !> \param kbc ...
7243 : !> \param kad ...
7244 : !> \param kac ...
7245 : !> \param pbd ...
7246 : !> \param pbc ...
7247 : !> \param pad ...
7248 : !> \param pac ...
7249 : !> \param prim ...
7250 : !> \param scale ...
7251 : ! **************************************************************************************************
7252 940 : SUBROUTINE block_1_2_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7253 : REAL(KIND=dp) :: kbd(2*2), kbc(2*3), kad(1*2), kac(1*3), &
7254 : pbd(2*2), pbc(2*3), pad(1*2), &
7255 : pac(1*3), prim(1*2*3*2), scale
7256 :
7257 : INTEGER :: ma, mb, mc, md, p_index
7258 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7259 :
7260 940 : kbd(1:2*2) = 0.0_dp
7261 940 : kbc(1:2*3) = 0.0_dp
7262 940 : kad(1:1*2) = 0.0_dp
7263 940 : kac(1:1*3) = 0.0_dp
7264 940 : p_index = 0
7265 2820 : DO md = 1, 2
7266 8460 : DO mc = 1, 3
7267 18800 : DO mb = 1, 2
7268 11280 : ks_bd = 0.0_dp
7269 11280 : ks_bc = 0.0_dp
7270 11280 : p_bd = pbd((md - 1)*2 + mb)
7271 11280 : p_bc = pbc((mc - 1)*2 + mb)
7272 22560 : DO ma = 1, 1
7273 11280 : p_index = p_index + 1
7274 11280 : tmp = scale*prim(p_index)
7275 11280 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7276 11280 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7277 11280 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7278 22560 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7279 : END DO
7280 11280 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7281 16920 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7282 : END DO
7283 : END DO
7284 : END DO
7285 940 : END SUBROUTINE block_1_2_3_2
7286 : ! **************************************************************************************************
7287 : !> \brief ...
7288 : !> \param kbd ...
7289 : !> \param kbc ...
7290 : !> \param kad ...
7291 : !> \param kac ...
7292 : !> \param pbd ...
7293 : !> \param pbc ...
7294 : !> \param pad ...
7295 : !> \param pac ...
7296 : !> \param prim ...
7297 : !> \param scale ...
7298 : ! **************************************************************************************************
7299 3509 : SUBROUTINE block_1_2_3_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7300 : REAL(KIND=dp) :: kbd(2*3), kbc(2*3), kad(1*3), kac(1*3), &
7301 : pbd(2*3), pbc(2*3), pad(1*3), &
7302 : pac(1*3), prim(1*2*3*3), scale
7303 :
7304 : INTEGER :: ma, mb, mc, md, p_index
7305 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7306 :
7307 3509 : kbd(1:2*3) = 0.0_dp
7308 3509 : kbc(1:2*3) = 0.0_dp
7309 3509 : kad(1:1*3) = 0.0_dp
7310 3509 : kac(1:1*3) = 0.0_dp
7311 3509 : p_index = 0
7312 14036 : DO md = 1, 3
7313 45617 : DO mc = 1, 3
7314 105270 : DO mb = 1, 2
7315 63162 : ks_bd = 0.0_dp
7316 63162 : ks_bc = 0.0_dp
7317 63162 : p_bd = pbd((md - 1)*2 + mb)
7318 63162 : p_bc = pbc((mc - 1)*2 + mb)
7319 126324 : DO ma = 1, 1
7320 63162 : p_index = p_index + 1
7321 63162 : tmp = scale*prim(p_index)
7322 63162 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7323 63162 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7324 63162 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7325 126324 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7326 : END DO
7327 63162 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7328 94743 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7329 : END DO
7330 : END DO
7331 : END DO
7332 3509 : END SUBROUTINE block_1_2_3_3
7333 : ! **************************************************************************************************
7334 : !> \brief ...
7335 : !> \param md_max ...
7336 : !> \param kbd ...
7337 : !> \param kbc ...
7338 : !> \param kad ...
7339 : !> \param kac ...
7340 : !> \param pbd ...
7341 : !> \param pbc ...
7342 : !> \param pad ...
7343 : !> \param pac ...
7344 : !> \param prim ...
7345 : !> \param scale ...
7346 : ! **************************************************************************************************
7347 3334 : SUBROUTINE block_1_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7348 : INTEGER :: md_max
7349 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*3), kad(1*md_max), kac(1*3), pbd(2*md_max), pbc(2*3), &
7350 : pad(1*md_max), pac(1*3), prim(1*2*3*md_max), scale
7351 :
7352 : INTEGER :: ma, mb, mc, md, p_index
7353 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7354 :
7355 40450 : kbd(1:2*md_max) = 0.0_dp
7356 3334 : kbc(1:2*3) = 0.0_dp
7357 21892 : kad(1:1*md_max) = 0.0_dp
7358 3334 : kac(1:1*3) = 0.0_dp
7359 3334 : p_index = 0
7360 21892 : DO md = 1, md_max
7361 77566 : DO mc = 1, 3
7362 185580 : DO mb = 1, 2
7363 111348 : ks_bd = 0.0_dp
7364 111348 : ks_bc = 0.0_dp
7365 111348 : p_bd = pbd((md - 1)*2 + mb)
7366 111348 : p_bc = pbc((mc - 1)*2 + mb)
7367 222696 : DO ma = 1, 1
7368 111348 : p_index = p_index + 1
7369 111348 : tmp = scale*prim(p_index)
7370 111348 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7371 111348 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7372 111348 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7373 222696 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7374 : END DO
7375 111348 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7376 167022 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7377 : END DO
7378 : END DO
7379 : END DO
7380 3334 : END SUBROUTINE block_1_2_3
7381 : ! **************************************************************************************************
7382 : !> \brief ...
7383 : !> \param kbd ...
7384 : !> \param kbc ...
7385 : !> \param kad ...
7386 : !> \param kac ...
7387 : !> \param pbd ...
7388 : !> \param pbc ...
7389 : !> \param pad ...
7390 : !> \param pac ...
7391 : !> \param prim ...
7392 : !> \param scale ...
7393 : ! **************************************************************************************************
7394 2 : SUBROUTINE block_1_2_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7395 : REAL(KIND=dp) :: kbd(2*1), kbc(2*4), kad(1*1), kac(1*4), &
7396 : pbd(2*1), pbc(2*4), pad(1*1), &
7397 : pac(1*4), prim(1*2*4*1), scale
7398 :
7399 : INTEGER :: ma, mb, mc, md, p_index
7400 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7401 :
7402 2 : kbd(1:2*1) = 0.0_dp
7403 2 : kbc(1:2*4) = 0.0_dp
7404 2 : kad(1:1*1) = 0.0_dp
7405 2 : kac(1:1*4) = 0.0_dp
7406 2 : p_index = 0
7407 4 : DO md = 1, 1
7408 12 : DO mc = 1, 4
7409 26 : DO mb = 1, 2
7410 16 : ks_bd = 0.0_dp
7411 16 : ks_bc = 0.0_dp
7412 16 : p_bd = pbd((md - 1)*2 + mb)
7413 16 : p_bc = pbc((mc - 1)*2 + mb)
7414 32 : DO ma = 1, 1
7415 16 : p_index = p_index + 1
7416 16 : tmp = scale*prim(p_index)
7417 16 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7418 16 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7419 16 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7420 32 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7421 : END DO
7422 16 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7423 24 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7424 : END DO
7425 : END DO
7426 : END DO
7427 2 : END SUBROUTINE block_1_2_4_1
7428 : ! **************************************************************************************************
7429 : !> \brief ...
7430 : !> \param kbd ...
7431 : !> \param kbc ...
7432 : !> \param kad ...
7433 : !> \param kac ...
7434 : !> \param pbd ...
7435 : !> \param pbc ...
7436 : !> \param pad ...
7437 : !> \param pac ...
7438 : !> \param prim ...
7439 : !> \param scale ...
7440 : ! **************************************************************************************************
7441 2 : SUBROUTINE block_1_2_4_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7442 : REAL(KIND=dp) :: kbd(2*2), kbc(2*4), kad(1*2), kac(1*4), &
7443 : pbd(2*2), pbc(2*4), pad(1*2), &
7444 : pac(1*4), prim(1*2*4*2), scale
7445 :
7446 : INTEGER :: ma, mb, mc, md, p_index
7447 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7448 :
7449 2 : kbd(1:2*2) = 0.0_dp
7450 2 : kbc(1:2*4) = 0.0_dp
7451 2 : kad(1:1*2) = 0.0_dp
7452 2 : kac(1:1*4) = 0.0_dp
7453 2 : p_index = 0
7454 6 : DO md = 1, 2
7455 22 : DO mc = 1, 4
7456 52 : DO mb = 1, 2
7457 32 : ks_bd = 0.0_dp
7458 32 : ks_bc = 0.0_dp
7459 32 : p_bd = pbd((md - 1)*2 + mb)
7460 32 : p_bc = pbc((mc - 1)*2 + mb)
7461 64 : DO ma = 1, 1
7462 32 : p_index = p_index + 1
7463 32 : tmp = scale*prim(p_index)
7464 32 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7465 32 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7466 32 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7467 64 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7468 : END DO
7469 32 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7470 48 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7471 : END DO
7472 : END DO
7473 : END DO
7474 2 : END SUBROUTINE block_1_2_4_2
7475 : ! **************************************************************************************************
7476 : !> \brief ...
7477 : !> \param md_max ...
7478 : !> \param kbd ...
7479 : !> \param kbc ...
7480 : !> \param kad ...
7481 : !> \param kac ...
7482 : !> \param pbd ...
7483 : !> \param pbc ...
7484 : !> \param pad ...
7485 : !> \param pac ...
7486 : !> \param prim ...
7487 : !> \param scale ...
7488 : ! **************************************************************************************************
7489 8 : SUBROUTINE block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7490 : INTEGER :: md_max
7491 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*4), kad(1*md_max), kac(1*4), pbd(2*md_max), pbc(2*4), &
7492 : pad(1*md_max), pac(1*4), prim(1*2*4*md_max), scale
7493 :
7494 : INTEGER :: ma, mb, mc, md, p_index
7495 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7496 :
7497 78 : kbd(1:2*md_max) = 0.0_dp
7498 8 : kbc(1:2*4) = 0.0_dp
7499 43 : kad(1:1*md_max) = 0.0_dp
7500 8 : kac(1:1*4) = 0.0_dp
7501 8 : p_index = 0
7502 43 : DO md = 1, md_max
7503 183 : DO mc = 1, 4
7504 455 : DO mb = 1, 2
7505 280 : ks_bd = 0.0_dp
7506 280 : ks_bc = 0.0_dp
7507 280 : p_bd = pbd((md - 1)*2 + mb)
7508 280 : p_bc = pbc((mc - 1)*2 + mb)
7509 560 : DO ma = 1, 1
7510 280 : p_index = p_index + 1
7511 280 : tmp = scale*prim(p_index)
7512 280 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7513 280 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7514 280 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7515 560 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7516 : END DO
7517 280 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7518 420 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7519 : END DO
7520 : END DO
7521 : END DO
7522 8 : END SUBROUTINE block_1_2_4
7523 : ! **************************************************************************************************
7524 : !> \brief ...
7525 : !> \param kbd ...
7526 : !> \param kbc ...
7527 : !> \param kad ...
7528 : !> \param kac ...
7529 : !> \param pbd ...
7530 : !> \param pbc ...
7531 : !> \param pad ...
7532 : !> \param pac ...
7533 : !> \param prim ...
7534 : !> \param scale ...
7535 : ! **************************************************************************************************
7536 1705 : SUBROUTINE block_1_2_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7537 : REAL(KIND=dp) :: kbd(2*1), kbc(2*5), kad(1*1), kac(1*5), &
7538 : pbd(2*1), pbc(2*5), pad(1*1), &
7539 : pac(1*5), prim(1*2*5*1), scale
7540 :
7541 : INTEGER :: ma, mb, mc, md, p_index
7542 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7543 :
7544 1705 : kbd(1:2*1) = 0.0_dp
7545 1705 : kbc(1:2*5) = 0.0_dp
7546 1705 : kad(1:1*1) = 0.0_dp
7547 1705 : kac(1:1*5) = 0.0_dp
7548 1705 : p_index = 0
7549 3410 : DO md = 1, 1
7550 11935 : DO mc = 1, 5
7551 27280 : DO mb = 1, 2
7552 17050 : ks_bd = 0.0_dp
7553 17050 : ks_bc = 0.0_dp
7554 17050 : p_bd = pbd((md - 1)*2 + mb)
7555 17050 : p_bc = pbc((mc - 1)*2 + mb)
7556 34100 : DO ma = 1, 1
7557 17050 : p_index = p_index + 1
7558 17050 : tmp = scale*prim(p_index)
7559 17050 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7560 17050 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7561 17050 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7562 34100 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7563 : END DO
7564 17050 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7565 25575 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7566 : END DO
7567 : END DO
7568 : END DO
7569 1705 : END SUBROUTINE block_1_2_5_1
7570 : ! **************************************************************************************************
7571 : !> \brief ...
7572 : !> \param md_max ...
7573 : !> \param kbd ...
7574 : !> \param kbc ...
7575 : !> \param kad ...
7576 : !> \param kac ...
7577 : !> \param pbd ...
7578 : !> \param pbc ...
7579 : !> \param pad ...
7580 : !> \param pac ...
7581 : !> \param prim ...
7582 : !> \param scale ...
7583 : ! **************************************************************************************************
7584 5524 : SUBROUTINE block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7585 : INTEGER :: md_max
7586 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*5), kad(1*md_max), kac(1*5), pbd(2*md_max), pbc(2*5), &
7587 : pad(1*md_max), pac(1*5), prim(1*2*5*md_max), scale
7588 :
7589 : INTEGER :: ma, mb, mc, md, p_index
7590 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7591 :
7592 50140 : kbd(1:2*md_max) = 0.0_dp
7593 5524 : kbc(1:2*5) = 0.0_dp
7594 27832 : kad(1:1*md_max) = 0.0_dp
7595 5524 : kac(1:1*5) = 0.0_dp
7596 5524 : p_index = 0
7597 27832 : DO md = 1, md_max
7598 139372 : DO mc = 1, 5
7599 356928 : DO mb = 1, 2
7600 223080 : ks_bd = 0.0_dp
7601 223080 : ks_bc = 0.0_dp
7602 223080 : p_bd = pbd((md - 1)*2 + mb)
7603 223080 : p_bc = pbc((mc - 1)*2 + mb)
7604 446160 : DO ma = 1, 1
7605 223080 : p_index = p_index + 1
7606 223080 : tmp = scale*prim(p_index)
7607 223080 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7608 223080 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7609 223080 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7610 446160 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7611 : END DO
7612 223080 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7613 334620 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7614 : END DO
7615 : END DO
7616 : END DO
7617 5524 : END SUBROUTINE block_1_2_5
7618 : ! **************************************************************************************************
7619 : !> \brief ...
7620 : !> \param kbd ...
7621 : !> \param kbc ...
7622 : !> \param kad ...
7623 : !> \param kac ...
7624 : !> \param pbd ...
7625 : !> \param pbc ...
7626 : !> \param pad ...
7627 : !> \param pac ...
7628 : !> \param prim ...
7629 : !> \param scale ...
7630 : ! **************************************************************************************************
7631 1 : SUBROUTINE block_1_2_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7632 : REAL(KIND=dp) :: kbd(2*1), kbc(2*6), kad(1*1), kac(1*6), &
7633 : pbd(2*1), pbc(2*6), pad(1*1), &
7634 : pac(1*6), prim(1*2*6*1), scale
7635 :
7636 : INTEGER :: ma, mb, mc, md, p_index
7637 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7638 :
7639 1 : kbd(1:2*1) = 0.0_dp
7640 1 : kbc(1:2*6) = 0.0_dp
7641 1 : kad(1:1*1) = 0.0_dp
7642 1 : kac(1:1*6) = 0.0_dp
7643 1 : p_index = 0
7644 2 : DO md = 1, 1
7645 8 : DO mc = 1, 6
7646 19 : DO mb = 1, 2
7647 12 : ks_bd = 0.0_dp
7648 12 : ks_bc = 0.0_dp
7649 12 : p_bd = pbd((md - 1)*2 + mb)
7650 12 : p_bc = pbc((mc - 1)*2 + mb)
7651 24 : DO ma = 1, 1
7652 12 : p_index = p_index + 1
7653 12 : tmp = scale*prim(p_index)
7654 12 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7655 12 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7656 12 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7657 24 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7658 : END DO
7659 12 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7660 18 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7661 : END DO
7662 : END DO
7663 : END DO
7664 1 : END SUBROUTINE block_1_2_6_1
7665 : ! **************************************************************************************************
7666 : !> \brief ...
7667 : !> \param md_max ...
7668 : !> \param kbd ...
7669 : !> \param kbc ...
7670 : !> \param kad ...
7671 : !> \param kac ...
7672 : !> \param pbd ...
7673 : !> \param pbc ...
7674 : !> \param pad ...
7675 : !> \param pac ...
7676 : !> \param prim ...
7677 : !> \param scale ...
7678 : ! **************************************************************************************************
7679 2 : SUBROUTINE block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7680 : INTEGER :: md_max
7681 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*6), kad(1*md_max), kac(1*6), pbd(2*md_max), pbc(2*6), &
7682 : pad(1*md_max), pac(1*6), prim(1*2*6*md_max), scale
7683 :
7684 : INTEGER :: ma, mb, mc, md, p_index
7685 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7686 :
7687 18 : kbd(1:2*md_max) = 0.0_dp
7688 2 : kbc(1:2*6) = 0.0_dp
7689 10 : kad(1:1*md_max) = 0.0_dp
7690 2 : kac(1:1*6) = 0.0_dp
7691 2 : p_index = 0
7692 10 : DO md = 1, md_max
7693 58 : DO mc = 1, 6
7694 152 : DO mb = 1, 2
7695 96 : ks_bd = 0.0_dp
7696 96 : ks_bc = 0.0_dp
7697 96 : p_bd = pbd((md - 1)*2 + mb)
7698 96 : p_bc = pbc((mc - 1)*2 + mb)
7699 192 : DO ma = 1, 1
7700 96 : p_index = p_index + 1
7701 96 : tmp = scale*prim(p_index)
7702 96 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7703 96 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7704 96 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7705 192 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7706 : END DO
7707 96 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7708 144 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7709 : END DO
7710 : END DO
7711 : END DO
7712 2 : END SUBROUTINE block_1_2_6
7713 : ! **************************************************************************************************
7714 : !> \brief ...
7715 : !> \param kbd ...
7716 : !> \param kbc ...
7717 : !> \param kad ...
7718 : !> \param kac ...
7719 : !> \param pbd ...
7720 : !> \param pbc ...
7721 : !> \param pad ...
7722 : !> \param pac ...
7723 : !> \param prim ...
7724 : !> \param scale ...
7725 : ! **************************************************************************************************
7726 712 : SUBROUTINE block_1_2_7_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7727 : REAL(KIND=dp) :: kbd(2*1), kbc(2*7), kad(1*1), kac(1*7), &
7728 : pbd(2*1), pbc(2*7), pad(1*1), &
7729 : pac(1*7), prim(1*2*7*1), scale
7730 :
7731 : INTEGER :: ma, mb, mc, md, p_index
7732 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7733 :
7734 712 : kbd(1:2*1) = 0.0_dp
7735 712 : kbc(1:2*7) = 0.0_dp
7736 712 : kad(1:1*1) = 0.0_dp
7737 712 : kac(1:1*7) = 0.0_dp
7738 712 : p_index = 0
7739 1424 : DO md = 1, 1
7740 6408 : DO mc = 1, 7
7741 15664 : DO mb = 1, 2
7742 9968 : ks_bd = 0.0_dp
7743 9968 : ks_bc = 0.0_dp
7744 9968 : p_bd = pbd((md - 1)*2 + mb)
7745 9968 : p_bc = pbc((mc - 1)*2 + mb)
7746 19936 : DO ma = 1, 1
7747 9968 : p_index = p_index + 1
7748 9968 : tmp = scale*prim(p_index)
7749 9968 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7750 9968 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7751 9968 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7752 19936 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7753 : END DO
7754 9968 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7755 14952 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7756 : END DO
7757 : END DO
7758 : END DO
7759 712 : END SUBROUTINE block_1_2_7_1
7760 : ! **************************************************************************************************
7761 : !> \brief ...
7762 : !> \param md_max ...
7763 : !> \param kbd ...
7764 : !> \param kbc ...
7765 : !> \param kad ...
7766 : !> \param kac ...
7767 : !> \param pbd ...
7768 : !> \param pbc ...
7769 : !> \param pad ...
7770 : !> \param pac ...
7771 : !> \param prim ...
7772 : !> \param scale ...
7773 : ! **************************************************************************************************
7774 2385 : SUBROUTINE block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7775 : INTEGER :: md_max
7776 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*7), kad(1*md_max), kac(1*7), pbd(2*md_max), pbc(2*7), &
7777 : pad(1*md_max), pac(1*7), prim(1*2*7*md_max), scale
7778 :
7779 : INTEGER :: ma, mb, mc, md, p_index
7780 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7781 :
7782 22927 : kbd(1:2*md_max) = 0.0_dp
7783 2385 : kbc(1:2*7) = 0.0_dp
7784 12656 : kad(1:1*md_max) = 0.0_dp
7785 2385 : kac(1:1*7) = 0.0_dp
7786 2385 : p_index = 0
7787 12656 : DO md = 1, md_max
7788 84553 : DO mc = 1, 7
7789 225962 : DO mb = 1, 2
7790 143794 : ks_bd = 0.0_dp
7791 143794 : ks_bc = 0.0_dp
7792 143794 : p_bd = pbd((md - 1)*2 + mb)
7793 143794 : p_bc = pbc((mc - 1)*2 + mb)
7794 287588 : DO ma = 1, 1
7795 143794 : p_index = p_index + 1
7796 143794 : tmp = scale*prim(p_index)
7797 143794 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7798 143794 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7799 143794 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7800 287588 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7801 : END DO
7802 143794 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7803 215691 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7804 : END DO
7805 : END DO
7806 : END DO
7807 2385 : END SUBROUTINE block_1_2_7
7808 : ! **************************************************************************************************
7809 : !> \brief ...
7810 : !> \param kbd ...
7811 : !> \param kbc ...
7812 : !> \param kad ...
7813 : !> \param kac ...
7814 : !> \param pbd ...
7815 : !> \param pbc ...
7816 : !> \param pad ...
7817 : !> \param pac ...
7818 : !> \param prim ...
7819 : !> \param scale ...
7820 : ! **************************************************************************************************
7821 0 : SUBROUTINE block_1_2_9_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7822 : REAL(KIND=dp) :: kbd(2*1), kbc(2*9), kad(1*1), kac(1*9), &
7823 : pbd(2*1), pbc(2*9), pad(1*1), &
7824 : pac(1*9), prim(1*2*9*1), scale
7825 :
7826 : INTEGER :: ma, mb, mc, md, p_index
7827 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7828 :
7829 0 : kbd(1:2*1) = 0.0_dp
7830 0 : kbc(1:2*9) = 0.0_dp
7831 0 : kad(1:1*1) = 0.0_dp
7832 0 : kac(1:1*9) = 0.0_dp
7833 0 : p_index = 0
7834 0 : DO md = 1, 1
7835 0 : DO mc = 1, 9
7836 0 : DO mb = 1, 2
7837 0 : ks_bd = 0.0_dp
7838 0 : ks_bc = 0.0_dp
7839 0 : p_bd = pbd((md - 1)*2 + mb)
7840 0 : p_bc = pbc((mc - 1)*2 + mb)
7841 0 : DO ma = 1, 1
7842 0 : p_index = p_index + 1
7843 0 : tmp = scale*prim(p_index)
7844 0 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7845 0 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7846 0 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7847 0 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7848 : END DO
7849 0 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7850 0 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7851 : END DO
7852 : END DO
7853 : END DO
7854 0 : END SUBROUTINE block_1_2_9_1
7855 : ! **************************************************************************************************
7856 : !> \brief ...
7857 : !> \param md_max ...
7858 : !> \param kbd ...
7859 : !> \param kbc ...
7860 : !> \param kad ...
7861 : !> \param kac ...
7862 : !> \param pbd ...
7863 : !> \param pbc ...
7864 : !> \param pad ...
7865 : !> \param pac ...
7866 : !> \param prim ...
7867 : !> \param scale ...
7868 : ! **************************************************************************************************
7869 3 : SUBROUTINE block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7870 : INTEGER :: md_max
7871 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*9), kad(1*md_max), kac(1*9), pbd(2*md_max), pbc(2*9), &
7872 : pad(1*md_max), pac(1*9), prim(1*2*9*md_max), scale
7873 :
7874 : INTEGER :: ma, mb, mc, md, p_index
7875 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7876 :
7877 47 : kbd(1:2*md_max) = 0.0_dp
7878 3 : kbc(1:2*9) = 0.0_dp
7879 25 : kad(1:1*md_max) = 0.0_dp
7880 3 : kac(1:1*9) = 0.0_dp
7881 3 : p_index = 0
7882 25 : DO md = 1, md_max
7883 223 : DO mc = 1, 9
7884 616 : DO mb = 1, 2
7885 396 : ks_bd = 0.0_dp
7886 396 : ks_bc = 0.0_dp
7887 396 : p_bd = pbd((md - 1)*2 + mb)
7888 396 : p_bc = pbc((mc - 1)*2 + mb)
7889 792 : DO ma = 1, 1
7890 396 : p_index = p_index + 1
7891 396 : tmp = scale*prim(p_index)
7892 396 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7893 396 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7894 396 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7895 792 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7896 : END DO
7897 396 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7898 594 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7899 : END DO
7900 : END DO
7901 : END DO
7902 3 : END SUBROUTINE block_1_2_9
7903 : ! **************************************************************************************************
7904 : !> \brief ...
7905 : !> \param mc_max ...
7906 : !> \param md_max ...
7907 : !> \param kbd ...
7908 : !> \param kbc ...
7909 : !> \param kad ...
7910 : !> \param kac ...
7911 : !> \param pbd ...
7912 : !> \param pbc ...
7913 : !> \param pad ...
7914 : !> \param pac ...
7915 : !> \param prim ...
7916 : !> \param scale ...
7917 : ! **************************************************************************************************
7918 21 : SUBROUTINE block_1_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7919 : INTEGER :: mc_max, md_max
7920 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*mc_max), kad(1*md_max), kac(1*mc_max), pbd(2*md_max), &
7921 : pbc(2*mc_max), pad(1*md_max), pac(1*mc_max), prim(1*2*mc_max*md_max), scale
7922 :
7923 : INTEGER :: ma, mb, mc, md, p_index
7924 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7925 :
7926 339 : kbd(1:2*md_max) = 0.0_dp
7927 545 : kbc(1:2*mc_max) = 0.0_dp
7928 180 : kad(1:1*md_max) = 0.0_dp
7929 283 : kac(1:1*mc_max) = 0.0_dp
7930 : p_index = 0
7931 180 : DO md = 1, md_max
7932 2172 : DO mc = 1, mc_max
7933 6135 : DO mb = 1, 2
7934 3984 : ks_bd = 0.0_dp
7935 3984 : ks_bc = 0.0_dp
7936 3984 : p_bd = pbd((md - 1)*2 + mb)
7937 3984 : p_bc = pbc((mc - 1)*2 + mb)
7938 7968 : DO ma = 1, 1
7939 3984 : p_index = p_index + 1
7940 3984 : tmp = scale*prim(p_index)
7941 3984 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7942 3984 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7943 3984 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7944 7968 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7945 : END DO
7946 3984 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7947 5976 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7948 : END DO
7949 : END DO
7950 : END DO
7951 21 : END SUBROUTINE block_1_2
7952 : ! **************************************************************************************************
7953 : !> \brief ...
7954 : !> \param kbd ...
7955 : !> \param kbc ...
7956 : !> \param kad ...
7957 : !> \param kac ...
7958 : !> \param pbd ...
7959 : !> \param pbc ...
7960 : !> \param pad ...
7961 : !> \param pac ...
7962 : !> \param prim ...
7963 : !> \param scale ...
7964 : ! **************************************************************************************************
7965 1881844 : SUBROUTINE block_1_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
7966 : REAL(KIND=dp) :: kbd(3*1), kbc(3*1), kad(1*1), kac(1*1), &
7967 : pbd(3*1), pbc(3*1), pad(1*1), &
7968 : pac(1*1), prim(1*3*1*1), scale
7969 :
7970 : INTEGER :: ma, mb, mc, md, p_index
7971 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
7972 :
7973 1881844 : kbd(1:3*1) = 0.0_dp
7974 1881844 : kbc(1:3*1) = 0.0_dp
7975 1881844 : kad(1:1*1) = 0.0_dp
7976 1881844 : kac(1:1*1) = 0.0_dp
7977 1881844 : p_index = 0
7978 3763688 : DO md = 1, 1
7979 5645532 : DO mc = 1, 1
7980 9409220 : DO mb = 1, 3
7981 5645532 : ks_bd = 0.0_dp
7982 5645532 : ks_bc = 0.0_dp
7983 5645532 : p_bd = pbd((md - 1)*3 + mb)
7984 5645532 : p_bc = pbc((mc - 1)*3 + mb)
7985 11291064 : DO ma = 1, 1
7986 5645532 : p_index = p_index + 1
7987 5645532 : tmp = scale*prim(p_index)
7988 5645532 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7989 5645532 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7990 5645532 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7991 11291064 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7992 : END DO
7993 5645532 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
7994 7527376 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
7995 : END DO
7996 : END DO
7997 : END DO
7998 1881844 : END SUBROUTINE block_1_3_1_1
7999 : ! **************************************************************************************************
8000 : !> \brief ...
8001 : !> \param kbd ...
8002 : !> \param kbc ...
8003 : !> \param kad ...
8004 : !> \param kac ...
8005 : !> \param pbd ...
8006 : !> \param pbc ...
8007 : !> \param pad ...
8008 : !> \param pac ...
8009 : !> \param prim ...
8010 : !> \param scale ...
8011 : ! **************************************************************************************************
8012 8131 : SUBROUTINE block_1_3_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8013 : REAL(KIND=dp) :: kbd(3*2), kbc(3*1), kad(1*2), kac(1*1), &
8014 : pbd(3*2), pbc(3*1), pad(1*2), &
8015 : pac(1*1), prim(1*3*1*2), scale
8016 :
8017 : INTEGER :: ma, mb, mc, md, p_index
8018 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8019 :
8020 8131 : kbd(1:3*2) = 0.0_dp
8021 8131 : kbc(1:3*1) = 0.0_dp
8022 8131 : kad(1:1*2) = 0.0_dp
8023 8131 : kac(1:1*1) = 0.0_dp
8024 8131 : p_index = 0
8025 24393 : DO md = 1, 2
8026 40655 : DO mc = 1, 1
8027 81310 : DO mb = 1, 3
8028 48786 : ks_bd = 0.0_dp
8029 48786 : ks_bc = 0.0_dp
8030 48786 : p_bd = pbd((md - 1)*3 + mb)
8031 48786 : p_bc = pbc((mc - 1)*3 + mb)
8032 97572 : DO ma = 1, 1
8033 48786 : p_index = p_index + 1
8034 48786 : tmp = scale*prim(p_index)
8035 48786 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8036 48786 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8037 48786 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8038 97572 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8039 : END DO
8040 48786 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8041 65048 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8042 : END DO
8043 : END DO
8044 : END DO
8045 8131 : END SUBROUTINE block_1_3_1_2
8046 : ! **************************************************************************************************
8047 : !> \brief ...
8048 : !> \param kbd ...
8049 : !> \param kbc ...
8050 : !> \param kad ...
8051 : !> \param kac ...
8052 : !> \param pbd ...
8053 : !> \param pbc ...
8054 : !> \param pad ...
8055 : !> \param pac ...
8056 : !> \param prim ...
8057 : !> \param scale ...
8058 : ! **************************************************************************************************
8059 1565118 : SUBROUTINE block_1_3_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8060 : REAL(KIND=dp) :: kbd(3*3), kbc(3*1), kad(1*3), kac(1*1), &
8061 : pbd(3*3), pbc(3*1), pad(1*3), &
8062 : pac(1*1), prim(1*3*1*3), scale
8063 :
8064 : INTEGER :: ma, mb, mc, md, p_index
8065 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8066 :
8067 1565118 : kbd(1:3*3) = 0.0_dp
8068 1565118 : kbc(1:3*1) = 0.0_dp
8069 1565118 : kad(1:1*3) = 0.0_dp
8070 1565118 : kac(1:1*1) = 0.0_dp
8071 1565118 : p_index = 0
8072 6260472 : DO md = 1, 3
8073 10955826 : DO mc = 1, 1
8074 23476770 : DO mb = 1, 3
8075 14086062 : ks_bd = 0.0_dp
8076 14086062 : ks_bc = 0.0_dp
8077 14086062 : p_bd = pbd((md - 1)*3 + mb)
8078 14086062 : p_bc = pbc((mc - 1)*3 + mb)
8079 28172124 : DO ma = 1, 1
8080 14086062 : p_index = p_index + 1
8081 14086062 : tmp = scale*prim(p_index)
8082 14086062 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8083 14086062 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8084 14086062 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8085 28172124 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8086 : END DO
8087 14086062 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8088 18781416 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8089 : END DO
8090 : END DO
8091 : END DO
8092 1565118 : END SUBROUTINE block_1_3_1_3
8093 : ! **************************************************************************************************
8094 : !> \brief ...
8095 : !> \param kbd ...
8096 : !> \param kbc ...
8097 : !> \param kad ...
8098 : !> \param kac ...
8099 : !> \param pbd ...
8100 : !> \param pbc ...
8101 : !> \param pad ...
8102 : !> \param pac ...
8103 : !> \param prim ...
8104 : !> \param scale ...
8105 : ! **************************************************************************************************
8106 51839 : SUBROUTINE block_1_3_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8107 : REAL(KIND=dp) :: kbd(3*4), kbc(3*1), kad(1*4), kac(1*1), &
8108 : pbd(3*4), pbc(3*1), pad(1*4), &
8109 : pac(1*1), prim(1*3*1*4), scale
8110 :
8111 : INTEGER :: ma, mb, mc, md, p_index
8112 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8113 :
8114 51839 : kbd(1:3*4) = 0.0_dp
8115 51839 : kbc(1:3*1) = 0.0_dp
8116 51839 : kad(1:1*4) = 0.0_dp
8117 51839 : kac(1:1*1) = 0.0_dp
8118 51839 : p_index = 0
8119 259195 : DO md = 1, 4
8120 466551 : DO mc = 1, 1
8121 1036780 : DO mb = 1, 3
8122 622068 : ks_bd = 0.0_dp
8123 622068 : ks_bc = 0.0_dp
8124 622068 : p_bd = pbd((md - 1)*3 + mb)
8125 622068 : p_bc = pbc((mc - 1)*3 + mb)
8126 1244136 : DO ma = 1, 1
8127 622068 : p_index = p_index + 1
8128 622068 : tmp = scale*prim(p_index)
8129 622068 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8130 622068 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8131 622068 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8132 1244136 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8133 : END DO
8134 622068 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8135 829424 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8136 : END DO
8137 : END DO
8138 : END DO
8139 51839 : END SUBROUTINE block_1_3_1_4
8140 : ! **************************************************************************************************
8141 : !> \brief ...
8142 : !> \param kbd ...
8143 : !> \param kbc ...
8144 : !> \param kad ...
8145 : !> \param kac ...
8146 : !> \param pbd ...
8147 : !> \param pbc ...
8148 : !> \param pad ...
8149 : !> \param pac ...
8150 : !> \param prim ...
8151 : !> \param scale ...
8152 : ! **************************************************************************************************
8153 79587 : SUBROUTINE block_1_3_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8154 : REAL(KIND=dp) :: kbd(3*5), kbc(3*1), kad(1*5), kac(1*1), &
8155 : pbd(3*5), pbc(3*1), pad(1*5), &
8156 : pac(1*1), prim(1*3*1*5), scale
8157 :
8158 : INTEGER :: ma, mb, mc, md, p_index
8159 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8160 :
8161 79587 : kbd(1:3*5) = 0.0_dp
8162 79587 : kbc(1:3*1) = 0.0_dp
8163 79587 : kad(1:1*5) = 0.0_dp
8164 79587 : kac(1:1*1) = 0.0_dp
8165 79587 : p_index = 0
8166 477522 : DO md = 1, 5
8167 875457 : DO mc = 1, 1
8168 1989675 : DO mb = 1, 3
8169 1193805 : ks_bd = 0.0_dp
8170 1193805 : ks_bc = 0.0_dp
8171 1193805 : p_bd = pbd((md - 1)*3 + mb)
8172 1193805 : p_bc = pbc((mc - 1)*3 + mb)
8173 2387610 : DO ma = 1, 1
8174 1193805 : p_index = p_index + 1
8175 1193805 : tmp = scale*prim(p_index)
8176 1193805 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8177 1193805 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8178 1193805 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8179 2387610 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8180 : END DO
8181 1193805 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8182 1591740 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8183 : END DO
8184 : END DO
8185 : END DO
8186 79587 : END SUBROUTINE block_1_3_1_5
8187 : ! **************************************************************************************************
8188 : !> \brief ...
8189 : !> \param kbd ...
8190 : !> \param kbc ...
8191 : !> \param kad ...
8192 : !> \param kac ...
8193 : !> \param pbd ...
8194 : !> \param pbc ...
8195 : !> \param pad ...
8196 : !> \param pac ...
8197 : !> \param prim ...
8198 : !> \param scale ...
8199 : ! **************************************************************************************************
8200 4 : SUBROUTINE block_1_3_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8201 : REAL(KIND=dp) :: kbd(3*6), kbc(3*1), kad(1*6), kac(1*1), &
8202 : pbd(3*6), pbc(3*1), pad(1*6), &
8203 : pac(1*1), prim(1*3*1*6), scale
8204 :
8205 : INTEGER :: ma, mb, mc, md, p_index
8206 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8207 :
8208 4 : kbd(1:3*6) = 0.0_dp
8209 4 : kbc(1:3*1) = 0.0_dp
8210 4 : kad(1:1*6) = 0.0_dp
8211 4 : kac(1:1*1) = 0.0_dp
8212 4 : p_index = 0
8213 28 : DO md = 1, 6
8214 52 : DO mc = 1, 1
8215 120 : DO mb = 1, 3
8216 72 : ks_bd = 0.0_dp
8217 72 : ks_bc = 0.0_dp
8218 72 : p_bd = pbd((md - 1)*3 + mb)
8219 72 : p_bc = pbc((mc - 1)*3 + mb)
8220 144 : DO ma = 1, 1
8221 72 : p_index = p_index + 1
8222 72 : tmp = scale*prim(p_index)
8223 72 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8224 72 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8225 72 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8226 144 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8227 : END DO
8228 72 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8229 96 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8230 : END DO
8231 : END DO
8232 : END DO
8233 4 : END SUBROUTINE block_1_3_1_6
8234 : ! **************************************************************************************************
8235 : !> \brief ...
8236 : !> \param md_max ...
8237 : !> \param kbd ...
8238 : !> \param kbc ...
8239 : !> \param kad ...
8240 : !> \param kac ...
8241 : !> \param pbd ...
8242 : !> \param pbc ...
8243 : !> \param pad ...
8244 : !> \param pac ...
8245 : !> \param prim ...
8246 : !> \param scale ...
8247 : ! **************************************************************************************************
8248 11917 : SUBROUTINE block_1_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8249 : INTEGER :: md_max
8250 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*1), kad(1*md_max), kac(1*1), pbd(3*md_max), pbc(3*1), &
8251 : pad(1*md_max), pac(1*1), prim(1*3*1*md_max), scale
8252 :
8253 : INTEGER :: ma, mb, mc, md, p_index
8254 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8255 :
8256 262225 : kbd(1:3*md_max) = 0.0_dp
8257 11917 : kbc(1:3*1) = 0.0_dp
8258 95353 : kad(1:1*md_max) = 0.0_dp
8259 11917 : kac(1:1*1) = 0.0_dp
8260 11917 : p_index = 0
8261 95353 : DO md = 1, md_max
8262 178789 : DO mc = 1, 1
8263 417180 : DO mb = 1, 3
8264 250308 : ks_bd = 0.0_dp
8265 250308 : ks_bc = 0.0_dp
8266 250308 : p_bd = pbd((md - 1)*3 + mb)
8267 250308 : p_bc = pbc((mc - 1)*3 + mb)
8268 500616 : DO ma = 1, 1
8269 250308 : p_index = p_index + 1
8270 250308 : tmp = scale*prim(p_index)
8271 250308 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8272 250308 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8273 250308 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8274 500616 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8275 : END DO
8276 250308 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8277 333744 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8278 : END DO
8279 : END DO
8280 : END DO
8281 11917 : END SUBROUTINE block_1_3_1
8282 : ! **************************************************************************************************
8283 : !> \brief ...
8284 : !> \param kbd ...
8285 : !> \param kbc ...
8286 : !> \param kad ...
8287 : !> \param kac ...
8288 : !> \param pbd ...
8289 : !> \param pbc ...
8290 : !> \param pad ...
8291 : !> \param pac ...
8292 : !> \param prim ...
8293 : !> \param scale ...
8294 : ! **************************************************************************************************
8295 24830 : SUBROUTINE block_1_3_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8296 : REAL(KIND=dp) :: kbd(3*1), kbc(3*2), kad(1*1), kac(1*2), &
8297 : pbd(3*1), pbc(3*2), pad(1*1), &
8298 : pac(1*2), prim(1*3*2*1), scale
8299 :
8300 : INTEGER :: ma, mb, mc, md, p_index
8301 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8302 :
8303 24830 : kbd(1:3*1) = 0.0_dp
8304 24830 : kbc(1:3*2) = 0.0_dp
8305 24830 : kad(1:1*1) = 0.0_dp
8306 24830 : kac(1:1*2) = 0.0_dp
8307 24830 : p_index = 0
8308 49660 : DO md = 1, 1
8309 99320 : DO mc = 1, 2
8310 223470 : DO mb = 1, 3
8311 148980 : ks_bd = 0.0_dp
8312 148980 : ks_bc = 0.0_dp
8313 148980 : p_bd = pbd((md - 1)*3 + mb)
8314 148980 : p_bc = pbc((mc - 1)*3 + mb)
8315 297960 : DO ma = 1, 1
8316 148980 : p_index = p_index + 1
8317 148980 : tmp = scale*prim(p_index)
8318 148980 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8319 148980 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8320 148980 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8321 297960 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8322 : END DO
8323 148980 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8324 198640 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8325 : END DO
8326 : END DO
8327 : END DO
8328 24830 : END SUBROUTINE block_1_3_2_1
8329 : ! **************************************************************************************************
8330 : !> \brief ...
8331 : !> \param kbd ...
8332 : !> \param kbc ...
8333 : !> \param kad ...
8334 : !> \param kac ...
8335 : !> \param pbd ...
8336 : !> \param pbc ...
8337 : !> \param pad ...
8338 : !> \param pac ...
8339 : !> \param prim ...
8340 : !> \param scale ...
8341 : ! **************************************************************************************************
8342 3861 : SUBROUTINE block_1_3_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8343 : REAL(KIND=dp) :: kbd(3*2), kbc(3*2), kad(1*2), kac(1*2), &
8344 : pbd(3*2), pbc(3*2), pad(1*2), &
8345 : pac(1*2), prim(1*3*2*2), scale
8346 :
8347 : INTEGER :: ma, mb, mc, md, p_index
8348 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8349 :
8350 3861 : kbd(1:3*2) = 0.0_dp
8351 3861 : kbc(1:3*2) = 0.0_dp
8352 3861 : kad(1:1*2) = 0.0_dp
8353 3861 : kac(1:1*2) = 0.0_dp
8354 3861 : p_index = 0
8355 11583 : DO md = 1, 2
8356 27027 : DO mc = 1, 2
8357 69498 : DO mb = 1, 3
8358 46332 : ks_bd = 0.0_dp
8359 46332 : ks_bc = 0.0_dp
8360 46332 : p_bd = pbd((md - 1)*3 + mb)
8361 46332 : p_bc = pbc((mc - 1)*3 + mb)
8362 92664 : DO ma = 1, 1
8363 46332 : p_index = p_index + 1
8364 46332 : tmp = scale*prim(p_index)
8365 46332 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8366 46332 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8367 46332 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8368 92664 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8369 : END DO
8370 46332 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8371 61776 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8372 : END DO
8373 : END DO
8374 : END DO
8375 3861 : END SUBROUTINE block_1_3_2_2
8376 : ! **************************************************************************************************
8377 : !> \brief ...
8378 : !> \param kbd ...
8379 : !> \param kbc ...
8380 : !> \param kad ...
8381 : !> \param kac ...
8382 : !> \param pbd ...
8383 : !> \param pbc ...
8384 : !> \param pad ...
8385 : !> \param pac ...
8386 : !> \param prim ...
8387 : !> \param scale ...
8388 : ! **************************************************************************************************
8389 23255 : SUBROUTINE block_1_3_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8390 : REAL(KIND=dp) :: kbd(3*3), kbc(3*2), kad(1*3), kac(1*2), &
8391 : pbd(3*3), pbc(3*2), pad(1*3), &
8392 : pac(1*2), prim(1*3*2*3), scale
8393 :
8394 : INTEGER :: ma, mb, mc, md, p_index
8395 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8396 :
8397 23255 : kbd(1:3*3) = 0.0_dp
8398 23255 : kbc(1:3*2) = 0.0_dp
8399 23255 : kad(1:1*3) = 0.0_dp
8400 23255 : kac(1:1*2) = 0.0_dp
8401 23255 : p_index = 0
8402 93020 : DO md = 1, 3
8403 232550 : DO mc = 1, 2
8404 627885 : DO mb = 1, 3
8405 418590 : ks_bd = 0.0_dp
8406 418590 : ks_bc = 0.0_dp
8407 418590 : p_bd = pbd((md - 1)*3 + mb)
8408 418590 : p_bc = pbc((mc - 1)*3 + mb)
8409 837180 : DO ma = 1, 1
8410 418590 : p_index = p_index + 1
8411 418590 : tmp = scale*prim(p_index)
8412 418590 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8413 418590 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8414 418590 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8415 837180 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8416 : END DO
8417 418590 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8418 558120 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8419 : END DO
8420 : END DO
8421 : END DO
8422 23255 : END SUBROUTINE block_1_3_2_3
8423 : ! **************************************************************************************************
8424 : !> \brief ...
8425 : !> \param md_max ...
8426 : !> \param kbd ...
8427 : !> \param kbc ...
8428 : !> \param kad ...
8429 : !> \param kac ...
8430 : !> \param pbd ...
8431 : !> \param pbc ...
8432 : !> \param pad ...
8433 : !> \param pac ...
8434 : !> \param prim ...
8435 : !> \param scale ...
8436 : ! **************************************************************************************************
8437 9085 : SUBROUTINE block_1_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8438 : INTEGER :: md_max
8439 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*2), kad(1*md_max), kac(1*2), pbd(3*md_max), pbc(3*2), &
8440 : pad(1*md_max), pac(1*2), prim(1*3*2*md_max), scale
8441 :
8442 : INTEGER :: ma, mb, mc, md, p_index
8443 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8444 :
8445 151216 : kbd(1:3*md_max) = 0.0_dp
8446 9085 : kbc(1:3*2) = 0.0_dp
8447 56462 : kad(1:1*md_max) = 0.0_dp
8448 9085 : kac(1:1*2) = 0.0_dp
8449 9085 : p_index = 0
8450 56462 : DO md = 1, md_max
8451 151216 : DO mc = 1, 2
8452 426393 : DO mb = 1, 3
8453 284262 : ks_bd = 0.0_dp
8454 284262 : ks_bc = 0.0_dp
8455 284262 : p_bd = pbd((md - 1)*3 + mb)
8456 284262 : p_bc = pbc((mc - 1)*3 + mb)
8457 568524 : DO ma = 1, 1
8458 284262 : p_index = p_index + 1
8459 284262 : tmp = scale*prim(p_index)
8460 284262 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8461 284262 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8462 284262 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8463 568524 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8464 : END DO
8465 284262 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8466 379016 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8467 : END DO
8468 : END DO
8469 : END DO
8470 9085 : END SUBROUTINE block_1_3_2
8471 : ! **************************************************************************************************
8472 : !> \brief ...
8473 : !> \param kbd ...
8474 : !> \param kbc ...
8475 : !> \param kad ...
8476 : !> \param kac ...
8477 : !> \param pbd ...
8478 : !> \param pbc ...
8479 : !> \param pad ...
8480 : !> \param pac ...
8481 : !> \param prim ...
8482 : !> \param scale ...
8483 : ! **************************************************************************************************
8484 1619394 : SUBROUTINE block_1_3_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8485 : REAL(KIND=dp) :: kbd(3*1), kbc(3*3), kad(1*1), kac(1*3), &
8486 : pbd(3*1), pbc(3*3), pad(1*1), &
8487 : pac(1*3), prim(1*3*3*1), scale
8488 :
8489 : INTEGER :: ma, mb, mc, md, p_index
8490 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8491 :
8492 1619394 : kbd(1:3*1) = 0.0_dp
8493 1619394 : kbc(1:3*3) = 0.0_dp
8494 1619394 : kad(1:1*1) = 0.0_dp
8495 1619394 : kac(1:1*3) = 0.0_dp
8496 1619394 : p_index = 0
8497 3238788 : DO md = 1, 1
8498 8096970 : DO mc = 1, 3
8499 21052122 : DO mb = 1, 3
8500 14574546 : ks_bd = 0.0_dp
8501 14574546 : ks_bc = 0.0_dp
8502 14574546 : p_bd = pbd((md - 1)*3 + mb)
8503 14574546 : p_bc = pbc((mc - 1)*3 + mb)
8504 29149092 : DO ma = 1, 1
8505 14574546 : p_index = p_index + 1
8506 14574546 : tmp = scale*prim(p_index)
8507 14574546 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8508 14574546 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8509 14574546 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8510 29149092 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8511 : END DO
8512 14574546 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8513 19432728 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8514 : END DO
8515 : END DO
8516 : END DO
8517 1619394 : END SUBROUTINE block_1_3_3_1
8518 : ! **************************************************************************************************
8519 : !> \brief ...
8520 : !> \param kbd ...
8521 : !> \param kbc ...
8522 : !> \param kad ...
8523 : !> \param kac ...
8524 : !> \param pbd ...
8525 : !> \param pbc ...
8526 : !> \param pad ...
8527 : !> \param pac ...
8528 : !> \param prim ...
8529 : !> \param scale ...
8530 : ! **************************************************************************************************
8531 12117 : SUBROUTINE block_1_3_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8532 : REAL(KIND=dp) :: kbd(3*2), kbc(3*3), kad(1*2), kac(1*3), &
8533 : pbd(3*2), pbc(3*3), pad(1*2), &
8534 : pac(1*3), prim(1*3*3*2), scale
8535 :
8536 : INTEGER :: ma, mb, mc, md, p_index
8537 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8538 :
8539 12117 : kbd(1:3*2) = 0.0_dp
8540 12117 : kbc(1:3*3) = 0.0_dp
8541 12117 : kad(1:1*2) = 0.0_dp
8542 12117 : kac(1:1*3) = 0.0_dp
8543 12117 : p_index = 0
8544 36351 : DO md = 1, 2
8545 109053 : DO mc = 1, 3
8546 315042 : DO mb = 1, 3
8547 218106 : ks_bd = 0.0_dp
8548 218106 : ks_bc = 0.0_dp
8549 218106 : p_bd = pbd((md - 1)*3 + mb)
8550 218106 : p_bc = pbc((mc - 1)*3 + mb)
8551 436212 : DO ma = 1, 1
8552 218106 : p_index = p_index + 1
8553 218106 : tmp = scale*prim(p_index)
8554 218106 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8555 218106 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8556 218106 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8557 436212 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8558 : END DO
8559 218106 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8560 290808 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8561 : END DO
8562 : END DO
8563 : END DO
8564 12117 : END SUBROUTINE block_1_3_3_2
8565 : ! **************************************************************************************************
8566 : !> \brief ...
8567 : !> \param md_max ...
8568 : !> \param kbd ...
8569 : !> \param kbc ...
8570 : !> \param kad ...
8571 : !> \param kac ...
8572 : !> \param pbd ...
8573 : !> \param pbc ...
8574 : !> \param pad ...
8575 : !> \param pac ...
8576 : !> \param prim ...
8577 : !> \param scale ...
8578 : ! **************************************************************************************************
8579 1536690 : SUBROUTINE block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8580 : INTEGER :: md_max
8581 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*3), kad(1*md_max), kac(1*3), pbd(3*md_max), pbc(3*3), &
8582 : pad(1*md_max), pac(1*3), prim(1*3*3*md_max), scale
8583 :
8584 : INTEGER :: ma, mb, mc, md, p_index
8585 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8586 :
8587 15956004 : kbd(1:3*md_max) = 0.0_dp
8588 1536690 : kbc(1:3*3) = 0.0_dp
8589 6343128 : kad(1:1*md_max) = 0.0_dp
8590 1536690 : kac(1:1*3) = 0.0_dp
8591 1536690 : p_index = 0
8592 6343128 : DO md = 1, md_max
8593 20762442 : DO mc = 1, 3
8594 62483694 : DO mb = 1, 3
8595 43257942 : ks_bd = 0.0_dp
8596 43257942 : ks_bc = 0.0_dp
8597 43257942 : p_bd = pbd((md - 1)*3 + mb)
8598 43257942 : p_bc = pbc((mc - 1)*3 + mb)
8599 86515884 : DO ma = 1, 1
8600 43257942 : p_index = p_index + 1
8601 43257942 : tmp = scale*prim(p_index)
8602 43257942 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8603 43257942 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8604 43257942 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8605 86515884 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8606 : END DO
8607 43257942 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8608 57677256 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8609 : END DO
8610 : END DO
8611 : END DO
8612 1536690 : END SUBROUTINE block_1_3_3
8613 : ! **************************************************************************************************
8614 : !> \brief ...
8615 : !> \param kbd ...
8616 : !> \param kbc ...
8617 : !> \param kad ...
8618 : !> \param kac ...
8619 : !> \param pbd ...
8620 : !> \param pbc ...
8621 : !> \param pad ...
8622 : !> \param pac ...
8623 : !> \param prim ...
8624 : !> \param scale ...
8625 : ! **************************************************************************************************
8626 241095 : SUBROUTINE block_1_3_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8627 : REAL(KIND=dp) :: kbd(3*1), kbc(3*4), kad(1*1), kac(1*4), &
8628 : pbd(3*1), pbc(3*4), pad(1*1), &
8629 : pac(1*4), prim(1*3*4*1), scale
8630 :
8631 : INTEGER :: ma, mb, mc, md, p_index
8632 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8633 :
8634 241095 : kbd(1:3*1) = 0.0_dp
8635 241095 : kbc(1:3*4) = 0.0_dp
8636 241095 : kad(1:1*1) = 0.0_dp
8637 241095 : kac(1:1*4) = 0.0_dp
8638 241095 : p_index = 0
8639 482190 : DO md = 1, 1
8640 1446570 : DO mc = 1, 4
8641 4098615 : DO mb = 1, 3
8642 2893140 : ks_bd = 0.0_dp
8643 2893140 : ks_bc = 0.0_dp
8644 2893140 : p_bd = pbd((md - 1)*3 + mb)
8645 2893140 : p_bc = pbc((mc - 1)*3 + mb)
8646 5786280 : DO ma = 1, 1
8647 2893140 : p_index = p_index + 1
8648 2893140 : tmp = scale*prim(p_index)
8649 2893140 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8650 2893140 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8651 2893140 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8652 5786280 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8653 : END DO
8654 2893140 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8655 3857520 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8656 : END DO
8657 : END DO
8658 : END DO
8659 241095 : END SUBROUTINE block_1_3_4_1
8660 : ! **************************************************************************************************
8661 : !> \brief ...
8662 : !> \param md_max ...
8663 : !> \param kbd ...
8664 : !> \param kbc ...
8665 : !> \param kad ...
8666 : !> \param kac ...
8667 : !> \param pbd ...
8668 : !> \param pbc ...
8669 : !> \param pad ...
8670 : !> \param pac ...
8671 : !> \param prim ...
8672 : !> \param scale ...
8673 : ! **************************************************************************************************
8674 283147 : SUBROUTINE block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8675 : INTEGER :: md_max
8676 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*4), kad(1*md_max), kac(1*4), pbd(3*md_max), pbc(3*4), &
8677 : pad(1*md_max), pac(1*4), prim(1*3*4*md_max), scale
8678 :
8679 : INTEGER :: ma, mb, mc, md, p_index
8680 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8681 :
8682 3529876 : kbd(1:3*md_max) = 0.0_dp
8683 283147 : kbc(1:3*4) = 0.0_dp
8684 1365390 : kad(1:1*md_max) = 0.0_dp
8685 283147 : kac(1:1*4) = 0.0_dp
8686 283147 : p_index = 0
8687 1365390 : DO md = 1, md_max
8688 5694362 : DO mc = 1, 4
8689 18398131 : DO mb = 1, 3
8690 12986916 : ks_bd = 0.0_dp
8691 12986916 : ks_bc = 0.0_dp
8692 12986916 : p_bd = pbd((md - 1)*3 + mb)
8693 12986916 : p_bc = pbc((mc - 1)*3 + mb)
8694 25973832 : DO ma = 1, 1
8695 12986916 : p_index = p_index + 1
8696 12986916 : tmp = scale*prim(p_index)
8697 12986916 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8698 12986916 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8699 12986916 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8700 25973832 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8701 : END DO
8702 12986916 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8703 17315888 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8704 : END DO
8705 : END DO
8706 : END DO
8707 283147 : END SUBROUTINE block_1_3_4
8708 : ! **************************************************************************************************
8709 : !> \brief ...
8710 : !> \param kbd ...
8711 : !> \param kbc ...
8712 : !> \param kad ...
8713 : !> \param kac ...
8714 : !> \param pbd ...
8715 : !> \param pbc ...
8716 : !> \param pad ...
8717 : !> \param pac ...
8718 : !> \param prim ...
8719 : !> \param scale ...
8720 : ! **************************************************************************************************
8721 235269 : SUBROUTINE block_1_3_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8722 : REAL(KIND=dp) :: kbd(3*1), kbc(3*5), kad(1*1), kac(1*5), &
8723 : pbd(3*1), pbc(3*5), pad(1*1), &
8724 : pac(1*5), prim(1*3*5*1), scale
8725 :
8726 : INTEGER :: ma, mb, mc, md, p_index
8727 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8728 :
8729 235269 : kbd(1:3*1) = 0.0_dp
8730 235269 : kbc(1:3*5) = 0.0_dp
8731 235269 : kad(1:1*1) = 0.0_dp
8732 235269 : kac(1:1*5) = 0.0_dp
8733 235269 : p_index = 0
8734 470538 : DO md = 1, 1
8735 1646883 : DO mc = 1, 5
8736 4940649 : DO mb = 1, 3
8737 3529035 : ks_bd = 0.0_dp
8738 3529035 : ks_bc = 0.0_dp
8739 3529035 : p_bd = pbd((md - 1)*3 + mb)
8740 3529035 : p_bc = pbc((mc - 1)*3 + mb)
8741 7058070 : DO ma = 1, 1
8742 3529035 : p_index = p_index + 1
8743 3529035 : tmp = scale*prim(p_index)
8744 3529035 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8745 3529035 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8746 3529035 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8747 7058070 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8748 : END DO
8749 3529035 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8750 4705380 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8751 : END DO
8752 : END DO
8753 : END DO
8754 235269 : END SUBROUTINE block_1_3_5_1
8755 : ! **************************************************************************************************
8756 : !> \brief ...
8757 : !> \param md_max ...
8758 : !> \param kbd ...
8759 : !> \param kbc ...
8760 : !> \param kad ...
8761 : !> \param kac ...
8762 : !> \param pbd ...
8763 : !> \param pbc ...
8764 : !> \param pad ...
8765 : !> \param pac ...
8766 : !> \param prim ...
8767 : !> \param scale ...
8768 : ! **************************************************************************************************
8769 276230 : SUBROUTINE block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8770 : INTEGER :: md_max
8771 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*5), kad(1*md_max), kac(1*5), pbd(3*md_max), pbc(3*5), &
8772 : pad(1*md_max), pac(1*5), prim(1*3*5*md_max), scale
8773 :
8774 : INTEGER :: ma, mb, mc, md, p_index
8775 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8776 :
8777 3349064 : kbd(1:3*md_max) = 0.0_dp
8778 276230 : kbc(1:3*5) = 0.0_dp
8779 1300508 : kad(1:1*md_max) = 0.0_dp
8780 276230 : kac(1:1*5) = 0.0_dp
8781 276230 : p_index = 0
8782 1300508 : DO md = 1, md_max
8783 6421898 : DO mc = 1, 5
8784 21509838 : DO mb = 1, 3
8785 15364170 : ks_bd = 0.0_dp
8786 15364170 : ks_bc = 0.0_dp
8787 15364170 : p_bd = pbd((md - 1)*3 + mb)
8788 15364170 : p_bc = pbc((mc - 1)*3 + mb)
8789 30728340 : DO ma = 1, 1
8790 15364170 : p_index = p_index + 1
8791 15364170 : tmp = scale*prim(p_index)
8792 15364170 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8793 15364170 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8794 15364170 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8795 30728340 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8796 : END DO
8797 15364170 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8798 20485560 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8799 : END DO
8800 : END DO
8801 : END DO
8802 276230 : END SUBROUTINE block_1_3_5
8803 : ! **************************************************************************************************
8804 : !> \brief ...
8805 : !> \param kbd ...
8806 : !> \param kbc ...
8807 : !> \param kad ...
8808 : !> \param kac ...
8809 : !> \param pbd ...
8810 : !> \param pbc ...
8811 : !> \param pad ...
8812 : !> \param pac ...
8813 : !> \param prim ...
8814 : !> \param scale ...
8815 : ! **************************************************************************************************
8816 1 : SUBROUTINE block_1_3_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8817 : REAL(KIND=dp) :: kbd(3*1), kbc(3*6), kad(1*1), kac(1*6), &
8818 : pbd(3*1), pbc(3*6), pad(1*1), &
8819 : pac(1*6), prim(1*3*6*1), scale
8820 :
8821 : INTEGER :: ma, mb, mc, md, p_index
8822 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8823 :
8824 1 : kbd(1:3*1) = 0.0_dp
8825 1 : kbc(1:3*6) = 0.0_dp
8826 1 : kad(1:1*1) = 0.0_dp
8827 1 : kac(1:1*6) = 0.0_dp
8828 1 : p_index = 0
8829 2 : DO md = 1, 1
8830 8 : DO mc = 1, 6
8831 25 : DO mb = 1, 3
8832 18 : ks_bd = 0.0_dp
8833 18 : ks_bc = 0.0_dp
8834 18 : p_bd = pbd((md - 1)*3 + mb)
8835 18 : p_bc = pbc((mc - 1)*3 + mb)
8836 36 : DO ma = 1, 1
8837 18 : p_index = p_index + 1
8838 18 : tmp = scale*prim(p_index)
8839 18 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8840 18 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8841 18 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8842 36 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8843 : END DO
8844 18 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8845 24 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8846 : END DO
8847 : END DO
8848 : END DO
8849 1 : END SUBROUTINE block_1_3_6_1
8850 : ! **************************************************************************************************
8851 : !> \brief ...
8852 : !> \param md_max ...
8853 : !> \param kbd ...
8854 : !> \param kbc ...
8855 : !> \param kad ...
8856 : !> \param kac ...
8857 : !> \param pbd ...
8858 : !> \param pbc ...
8859 : !> \param pad ...
8860 : !> \param pac ...
8861 : !> \param prim ...
8862 : !> \param scale ...
8863 : ! **************************************************************************************************
8864 3 : SUBROUTINE block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8865 : INTEGER :: md_max
8866 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*6), kad(1*md_max), kac(1*6), pbd(3*md_max), pbc(3*6), &
8867 : pad(1*md_max), pac(1*6), prim(1*3*6*md_max), scale
8868 :
8869 : INTEGER :: ma, mb, mc, md, p_index
8870 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8871 :
8872 36 : kbd(1:3*md_max) = 0.0_dp
8873 3 : kbc(1:3*6) = 0.0_dp
8874 14 : kad(1:1*md_max) = 0.0_dp
8875 3 : kac(1:1*6) = 0.0_dp
8876 3 : p_index = 0
8877 14 : DO md = 1, md_max
8878 80 : DO mc = 1, 6
8879 275 : DO mb = 1, 3
8880 198 : ks_bd = 0.0_dp
8881 198 : ks_bc = 0.0_dp
8882 198 : p_bd = pbd((md - 1)*3 + mb)
8883 198 : p_bc = pbc((mc - 1)*3 + mb)
8884 396 : DO ma = 1, 1
8885 198 : p_index = p_index + 1
8886 198 : tmp = scale*prim(p_index)
8887 198 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8888 198 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8889 198 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8890 396 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8891 : END DO
8892 198 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8893 264 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8894 : END DO
8895 : END DO
8896 : END DO
8897 3 : END SUBROUTINE block_1_3_6
8898 : ! **************************************************************************************************
8899 : !> \brief ...
8900 : !> \param mc_max ...
8901 : !> \param md_max ...
8902 : !> \param kbd ...
8903 : !> \param kbc ...
8904 : !> \param kad ...
8905 : !> \param kac ...
8906 : !> \param pbd ...
8907 : !> \param pbc ...
8908 : !> \param pad ...
8909 : !> \param pac ...
8910 : !> \param prim ...
8911 : !> \param scale ...
8912 : ! **************************************************************************************************
8913 50924 : SUBROUTINE block_1_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8914 : INTEGER :: mc_max, md_max
8915 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*mc_max), kad(1*md_max), kac(1*mc_max), pbd(3*md_max), &
8916 : pbc(3*mc_max), pad(1*md_max), pac(1*mc_max), prim(1*3*mc_max*md_max), scale
8917 :
8918 : INTEGER :: ma, mb, mc, md, p_index
8919 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8920 :
8921 455057 : kbd(1:3*md_max) = 0.0_dp
8922 1120640 : kbc(1:3*mc_max) = 0.0_dp
8923 185635 : kad(1:1*md_max) = 0.0_dp
8924 407496 : kac(1:1*mc_max) = 0.0_dp
8925 : p_index = 0
8926 185635 : DO md = 1, md_max
8927 1129468 : DO mc = 1, mc_max
8928 3910043 : DO mb = 1, 3
8929 2831499 : ks_bd = 0.0_dp
8930 2831499 : ks_bc = 0.0_dp
8931 2831499 : p_bd = pbd((md - 1)*3 + mb)
8932 2831499 : p_bc = pbc((mc - 1)*3 + mb)
8933 5662998 : DO ma = 1, 1
8934 2831499 : p_index = p_index + 1
8935 2831499 : tmp = scale*prim(p_index)
8936 2831499 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8937 2831499 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8938 2831499 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8939 5662998 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8940 : END DO
8941 2831499 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8942 3775332 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8943 : END DO
8944 : END DO
8945 : END DO
8946 50924 : END SUBROUTINE block_1_3
8947 : ! **************************************************************************************************
8948 : !> \brief ...
8949 : !> \param kbd ...
8950 : !> \param kbc ...
8951 : !> \param kad ...
8952 : !> \param kac ...
8953 : !> \param pbd ...
8954 : !> \param pbc ...
8955 : !> \param pad ...
8956 : !> \param pac ...
8957 : !> \param prim ...
8958 : !> \param scale ...
8959 : ! **************************************************************************************************
8960 115994 : SUBROUTINE block_1_4_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
8961 : REAL(KIND=dp) :: kbd(4*1), kbc(4*1), kad(1*1), kac(1*1), &
8962 : pbd(4*1), pbc(4*1), pad(1*1), &
8963 : pac(1*1), prim(1*4*1*1), scale
8964 :
8965 : INTEGER :: ma, mb, mc, md, p_index
8966 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
8967 :
8968 115994 : kbd(1:4*1) = 0.0_dp
8969 115994 : kbc(1:4*1) = 0.0_dp
8970 115994 : kad(1:1*1) = 0.0_dp
8971 115994 : kac(1:1*1) = 0.0_dp
8972 115994 : p_index = 0
8973 231988 : DO md = 1, 1
8974 347982 : DO mc = 1, 1
8975 695964 : DO mb = 1, 4
8976 463976 : ks_bd = 0.0_dp
8977 463976 : ks_bc = 0.0_dp
8978 463976 : p_bd = pbd((md - 1)*4 + mb)
8979 463976 : p_bc = pbc((mc - 1)*4 + mb)
8980 927952 : DO ma = 1, 1
8981 463976 : p_index = p_index + 1
8982 463976 : tmp = scale*prim(p_index)
8983 463976 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8984 463976 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8985 463976 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8986 927952 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8987 : END DO
8988 463976 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
8989 579970 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
8990 : END DO
8991 : END DO
8992 : END DO
8993 115994 : END SUBROUTINE block_1_4_1_1
8994 : ! **************************************************************************************************
8995 : !> \brief ...
8996 : !> \param kbd ...
8997 : !> \param kbc ...
8998 : !> \param kad ...
8999 : !> \param kac ...
9000 : !> \param pbd ...
9001 : !> \param pbc ...
9002 : !> \param pad ...
9003 : !> \param pac ...
9004 : !> \param prim ...
9005 : !> \param scale ...
9006 : ! **************************************************************************************************
9007 8 : SUBROUTINE block_1_4_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9008 : REAL(KIND=dp) :: kbd(4*2), kbc(4*1), kad(1*2), kac(1*1), &
9009 : pbd(4*2), pbc(4*1), pad(1*2), &
9010 : pac(1*1), prim(1*4*1*2), scale
9011 :
9012 : INTEGER :: ma, mb, mc, md, p_index
9013 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9014 :
9015 8 : kbd(1:4*2) = 0.0_dp
9016 8 : kbc(1:4*1) = 0.0_dp
9017 8 : kad(1:1*2) = 0.0_dp
9018 8 : kac(1:1*1) = 0.0_dp
9019 8 : p_index = 0
9020 24 : DO md = 1, 2
9021 40 : DO mc = 1, 1
9022 96 : DO mb = 1, 4
9023 64 : ks_bd = 0.0_dp
9024 64 : ks_bc = 0.0_dp
9025 64 : p_bd = pbd((md - 1)*4 + mb)
9026 64 : p_bc = pbc((mc - 1)*4 + mb)
9027 128 : DO ma = 1, 1
9028 64 : p_index = p_index + 1
9029 64 : tmp = scale*prim(p_index)
9030 64 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9031 64 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9032 64 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9033 128 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9034 : END DO
9035 64 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9036 80 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9037 : END DO
9038 : END DO
9039 : END DO
9040 8 : END SUBROUTINE block_1_4_1_2
9041 : ! **************************************************************************************************
9042 : !> \brief ...
9043 : !> \param kbd ...
9044 : !> \param kbc ...
9045 : !> \param kad ...
9046 : !> \param kac ...
9047 : !> \param pbd ...
9048 : !> \param pbc ...
9049 : !> \param pad ...
9050 : !> \param pac ...
9051 : !> \param prim ...
9052 : !> \param scale ...
9053 : ! **************************************************************************************************
9054 31019 : SUBROUTINE block_1_4_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9055 : REAL(KIND=dp) :: kbd(4*3), kbc(4*1), kad(1*3), kac(1*1), &
9056 : pbd(4*3), pbc(4*1), pad(1*3), &
9057 : pac(1*1), prim(1*4*1*3), scale
9058 :
9059 : INTEGER :: ma, mb, mc, md, p_index
9060 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9061 :
9062 31019 : kbd(1:4*3) = 0.0_dp
9063 31019 : kbc(1:4*1) = 0.0_dp
9064 31019 : kad(1:1*3) = 0.0_dp
9065 31019 : kac(1:1*1) = 0.0_dp
9066 31019 : p_index = 0
9067 124076 : DO md = 1, 3
9068 217133 : DO mc = 1, 1
9069 558342 : DO mb = 1, 4
9070 372228 : ks_bd = 0.0_dp
9071 372228 : ks_bc = 0.0_dp
9072 372228 : p_bd = pbd((md - 1)*4 + mb)
9073 372228 : p_bc = pbc((mc - 1)*4 + mb)
9074 744456 : DO ma = 1, 1
9075 372228 : p_index = p_index + 1
9076 372228 : tmp = scale*prim(p_index)
9077 372228 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9078 372228 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9079 372228 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9080 744456 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9081 : END DO
9082 372228 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9083 465285 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9084 : END DO
9085 : END DO
9086 : END DO
9087 31019 : END SUBROUTINE block_1_4_1_3
9088 : ! **************************************************************************************************
9089 : !> \brief ...
9090 : !> \param kbd ...
9091 : !> \param kbc ...
9092 : !> \param kad ...
9093 : !> \param kac ...
9094 : !> \param pbd ...
9095 : !> \param pbc ...
9096 : !> \param pad ...
9097 : !> \param pac ...
9098 : !> \param prim ...
9099 : !> \param scale ...
9100 : ! **************************************************************************************************
9101 59737 : SUBROUTINE block_1_4_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9102 : REAL(KIND=dp) :: kbd(4*4), kbc(4*1), kad(1*4), kac(1*1), &
9103 : pbd(4*4), pbc(4*1), pad(1*4), &
9104 : pac(1*1), prim(1*4*1*4), scale
9105 :
9106 : INTEGER :: ma, mb, mc, md, p_index
9107 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9108 :
9109 59737 : kbd(1:4*4) = 0.0_dp
9110 59737 : kbc(1:4*1) = 0.0_dp
9111 59737 : kad(1:1*4) = 0.0_dp
9112 59737 : kac(1:1*1) = 0.0_dp
9113 59737 : p_index = 0
9114 298685 : DO md = 1, 4
9115 537633 : DO mc = 1, 1
9116 1433688 : DO mb = 1, 4
9117 955792 : ks_bd = 0.0_dp
9118 955792 : ks_bc = 0.0_dp
9119 955792 : p_bd = pbd((md - 1)*4 + mb)
9120 955792 : p_bc = pbc((mc - 1)*4 + mb)
9121 1911584 : DO ma = 1, 1
9122 955792 : p_index = p_index + 1
9123 955792 : tmp = scale*prim(p_index)
9124 955792 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9125 955792 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9126 955792 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9127 1911584 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9128 : END DO
9129 955792 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9130 1194740 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9131 : END DO
9132 : END DO
9133 : END DO
9134 59737 : END SUBROUTINE block_1_4_1_4
9135 : ! **************************************************************************************************
9136 : !> \brief ...
9137 : !> \param md_max ...
9138 : !> \param kbd ...
9139 : !> \param kbc ...
9140 : !> \param kad ...
9141 : !> \param kac ...
9142 : !> \param pbd ...
9143 : !> \param pbc ...
9144 : !> \param pad ...
9145 : !> \param pac ...
9146 : !> \param prim ...
9147 : !> \param scale ...
9148 : ! **************************************************************************************************
9149 17478 : SUBROUTINE block_1_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9150 : INTEGER :: md_max
9151 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*1), kad(1*md_max), kac(1*1), pbd(4*md_max), pbc(4*1), &
9152 : pad(1*md_max), pac(1*1), prim(1*4*1*md_max), scale
9153 :
9154 : INTEGER :: ma, mb, mc, md, p_index
9155 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9156 :
9157 367930 : kbd(1:4*md_max) = 0.0_dp
9158 17478 : kbc(1:4*1) = 0.0_dp
9159 105091 : kad(1:1*md_max) = 0.0_dp
9160 17478 : kac(1:1*1) = 0.0_dp
9161 17478 : p_index = 0
9162 105091 : DO md = 1, md_max
9163 192704 : DO mc = 1, 1
9164 525678 : DO mb = 1, 4
9165 350452 : ks_bd = 0.0_dp
9166 350452 : ks_bc = 0.0_dp
9167 350452 : p_bd = pbd((md - 1)*4 + mb)
9168 350452 : p_bc = pbc((mc - 1)*4 + mb)
9169 700904 : DO ma = 1, 1
9170 350452 : p_index = p_index + 1
9171 350452 : tmp = scale*prim(p_index)
9172 350452 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9173 350452 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9174 350452 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9175 700904 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9176 : END DO
9177 350452 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9178 438065 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9179 : END DO
9180 : END DO
9181 : END DO
9182 17478 : END SUBROUTINE block_1_4_1
9183 : ! **************************************************************************************************
9184 : !> \brief ...
9185 : !> \param kbd ...
9186 : !> \param kbc ...
9187 : !> \param kad ...
9188 : !> \param kac ...
9189 : !> \param pbd ...
9190 : !> \param pbc ...
9191 : !> \param pad ...
9192 : !> \param pac ...
9193 : !> \param prim ...
9194 : !> \param scale ...
9195 : ! **************************************************************************************************
9196 2 : SUBROUTINE block_1_4_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9197 : REAL(KIND=dp) :: kbd(4*1), kbc(4*2), kad(1*1), kac(1*2), &
9198 : pbd(4*1), pbc(4*2), pad(1*1), &
9199 : pac(1*2), prim(1*4*2*1), scale
9200 :
9201 : INTEGER :: ma, mb, mc, md, p_index
9202 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9203 :
9204 2 : kbd(1:4*1) = 0.0_dp
9205 2 : kbc(1:4*2) = 0.0_dp
9206 2 : kad(1:1*1) = 0.0_dp
9207 2 : kac(1:1*2) = 0.0_dp
9208 2 : p_index = 0
9209 4 : DO md = 1, 1
9210 8 : DO mc = 1, 2
9211 22 : DO mb = 1, 4
9212 16 : ks_bd = 0.0_dp
9213 16 : ks_bc = 0.0_dp
9214 16 : p_bd = pbd((md - 1)*4 + mb)
9215 16 : p_bc = pbc((mc - 1)*4 + mb)
9216 32 : DO ma = 1, 1
9217 16 : p_index = p_index + 1
9218 16 : tmp = scale*prim(p_index)
9219 16 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9220 16 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9221 16 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9222 32 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9223 : END DO
9224 16 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9225 20 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9226 : END DO
9227 : END DO
9228 : END DO
9229 2 : END SUBROUTINE block_1_4_2_1
9230 : ! **************************************************************************************************
9231 : !> \brief ...
9232 : !> \param kbd ...
9233 : !> \param kbc ...
9234 : !> \param kad ...
9235 : !> \param kac ...
9236 : !> \param pbd ...
9237 : !> \param pbc ...
9238 : !> \param pad ...
9239 : !> \param pac ...
9240 : !> \param prim ...
9241 : !> \param scale ...
9242 : ! **************************************************************************************************
9243 8 : SUBROUTINE block_1_4_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9244 : REAL(KIND=dp) :: kbd(4*2), kbc(4*2), kad(1*2), kac(1*2), &
9245 : pbd(4*2), pbc(4*2), pad(1*2), &
9246 : pac(1*2), prim(1*4*2*2), scale
9247 :
9248 : INTEGER :: ma, mb, mc, md, p_index
9249 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9250 :
9251 8 : kbd(1:4*2) = 0.0_dp
9252 8 : kbc(1:4*2) = 0.0_dp
9253 8 : kad(1:1*2) = 0.0_dp
9254 8 : kac(1:1*2) = 0.0_dp
9255 8 : p_index = 0
9256 24 : DO md = 1, 2
9257 56 : DO mc = 1, 2
9258 176 : DO mb = 1, 4
9259 128 : ks_bd = 0.0_dp
9260 128 : ks_bc = 0.0_dp
9261 128 : p_bd = pbd((md - 1)*4 + mb)
9262 128 : p_bc = pbc((mc - 1)*4 + mb)
9263 256 : DO ma = 1, 1
9264 128 : p_index = p_index + 1
9265 128 : tmp = scale*prim(p_index)
9266 128 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9267 128 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9268 128 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9269 256 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9270 : END DO
9271 128 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9272 160 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9273 : END DO
9274 : END DO
9275 : END DO
9276 8 : END SUBROUTINE block_1_4_2_2
9277 : ! **************************************************************************************************
9278 : !> \brief ...
9279 : !> \param md_max ...
9280 : !> \param kbd ...
9281 : !> \param kbc ...
9282 : !> \param kad ...
9283 : !> \param kac ...
9284 : !> \param pbd ...
9285 : !> \param pbc ...
9286 : !> \param pad ...
9287 : !> \param pac ...
9288 : !> \param prim ...
9289 : !> \param scale ...
9290 : ! **************************************************************************************************
9291 16 : SUBROUTINE block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9292 : INTEGER :: md_max
9293 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*2), kad(1*md_max), kac(1*2), pbd(4*md_max), pbc(4*2), &
9294 : pad(1*md_max), pac(1*2), prim(1*4*2*md_max), scale
9295 :
9296 : INTEGER :: ma, mb, mc, md, p_index
9297 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9298 :
9299 280 : kbd(1:4*md_max) = 0.0_dp
9300 16 : kbc(1:4*2) = 0.0_dp
9301 82 : kad(1:1*md_max) = 0.0_dp
9302 16 : kac(1:1*2) = 0.0_dp
9303 16 : p_index = 0
9304 82 : DO md = 1, md_max
9305 214 : DO mc = 1, 2
9306 726 : DO mb = 1, 4
9307 528 : ks_bd = 0.0_dp
9308 528 : ks_bc = 0.0_dp
9309 528 : p_bd = pbd((md - 1)*4 + mb)
9310 528 : p_bc = pbc((mc - 1)*4 + mb)
9311 1056 : DO ma = 1, 1
9312 528 : p_index = p_index + 1
9313 528 : tmp = scale*prim(p_index)
9314 528 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9315 528 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9316 528 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9317 1056 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9318 : END DO
9319 528 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9320 660 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9321 : END DO
9322 : END DO
9323 : END DO
9324 16 : END SUBROUTINE block_1_4_2
9325 : ! **************************************************************************************************
9326 : !> \brief ...
9327 : !> \param kbd ...
9328 : !> \param kbc ...
9329 : !> \param kad ...
9330 : !> \param kac ...
9331 : !> \param pbd ...
9332 : !> \param pbc ...
9333 : !> \param pad ...
9334 : !> \param pac ...
9335 : !> \param prim ...
9336 : !> \param scale ...
9337 : ! **************************************************************************************************
9338 27218 : SUBROUTINE block_1_4_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9339 : REAL(KIND=dp) :: kbd(4*1), kbc(4*3), kad(1*1), kac(1*3), &
9340 : pbd(4*1), pbc(4*3), pad(1*1), &
9341 : pac(1*3), prim(1*4*3*1), scale
9342 :
9343 : INTEGER :: ma, mb, mc, md, p_index
9344 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9345 :
9346 27218 : kbd(1:4*1) = 0.0_dp
9347 27218 : kbc(1:4*3) = 0.0_dp
9348 27218 : kad(1:1*1) = 0.0_dp
9349 27218 : kac(1:1*3) = 0.0_dp
9350 27218 : p_index = 0
9351 54436 : DO md = 1, 1
9352 136090 : DO mc = 1, 3
9353 435488 : DO mb = 1, 4
9354 326616 : ks_bd = 0.0_dp
9355 326616 : ks_bc = 0.0_dp
9356 326616 : p_bd = pbd((md - 1)*4 + mb)
9357 326616 : p_bc = pbc((mc - 1)*4 + mb)
9358 653232 : DO ma = 1, 1
9359 326616 : p_index = p_index + 1
9360 326616 : tmp = scale*prim(p_index)
9361 326616 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9362 326616 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9363 326616 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9364 653232 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9365 : END DO
9366 326616 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9367 408270 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9368 : END DO
9369 : END DO
9370 : END DO
9371 27218 : END SUBROUTINE block_1_4_3_1
9372 : ! **************************************************************************************************
9373 : !> \brief ...
9374 : !> \param md_max ...
9375 : !> \param kbd ...
9376 : !> \param kbc ...
9377 : !> \param kad ...
9378 : !> \param kac ...
9379 : !> \param pbd ...
9380 : !> \param pbc ...
9381 : !> \param pad ...
9382 : !> \param pac ...
9383 : !> \param prim ...
9384 : !> \param scale ...
9385 : ! **************************************************************************************************
9386 28694 : SUBROUTINE block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9387 : INTEGER :: md_max
9388 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*3), kad(1*md_max), kac(1*3), pbd(4*md_max), pbc(4*3), &
9389 : pad(1*md_max), pac(1*3), prim(1*4*3*md_max), scale
9390 :
9391 : INTEGER :: ma, mb, mc, md, p_index
9392 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9393 :
9394 463618 : kbd(1:4*md_max) = 0.0_dp
9395 28694 : kbc(1:4*3) = 0.0_dp
9396 137425 : kad(1:1*md_max) = 0.0_dp
9397 28694 : kac(1:1*3) = 0.0_dp
9398 28694 : p_index = 0
9399 137425 : DO md = 1, md_max
9400 463618 : DO mc = 1, 3
9401 1739696 : DO mb = 1, 4
9402 1304772 : ks_bd = 0.0_dp
9403 1304772 : ks_bc = 0.0_dp
9404 1304772 : p_bd = pbd((md - 1)*4 + mb)
9405 1304772 : p_bc = pbc((mc - 1)*4 + mb)
9406 2609544 : DO ma = 1, 1
9407 1304772 : p_index = p_index + 1
9408 1304772 : tmp = scale*prim(p_index)
9409 1304772 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9410 1304772 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9411 1304772 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9412 2609544 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9413 : END DO
9414 1304772 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9415 1630965 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9416 : END DO
9417 : END DO
9418 : END DO
9419 28694 : END SUBROUTINE block_1_4_3
9420 : ! **************************************************************************************************
9421 : !> \brief ...
9422 : !> \param kbd ...
9423 : !> \param kbc ...
9424 : !> \param kad ...
9425 : !> \param kac ...
9426 : !> \param pbd ...
9427 : !> \param pbc ...
9428 : !> \param pad ...
9429 : !> \param pac ...
9430 : !> \param prim ...
9431 : !> \param scale ...
9432 : ! **************************************************************************************************
9433 65490 : SUBROUTINE block_1_4_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9434 : REAL(KIND=dp) :: kbd(4*1), kbc(4*4), kad(1*1), kac(1*4), &
9435 : pbd(4*1), pbc(4*4), pad(1*1), &
9436 : pac(1*4), prim(1*4*4*1), scale
9437 :
9438 : INTEGER :: ma, mb, mc, md, p_index
9439 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9440 :
9441 65490 : kbd(1:4*1) = 0.0_dp
9442 65490 : kbc(1:4*4) = 0.0_dp
9443 65490 : kad(1:1*1) = 0.0_dp
9444 65490 : kac(1:1*4) = 0.0_dp
9445 65490 : p_index = 0
9446 130980 : DO md = 1, 1
9447 392940 : DO mc = 1, 4
9448 1375290 : DO mb = 1, 4
9449 1047840 : ks_bd = 0.0_dp
9450 1047840 : ks_bc = 0.0_dp
9451 1047840 : p_bd = pbd((md - 1)*4 + mb)
9452 1047840 : p_bc = pbc((mc - 1)*4 + mb)
9453 2095680 : DO ma = 1, 1
9454 1047840 : p_index = p_index + 1
9455 1047840 : tmp = scale*prim(p_index)
9456 1047840 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9457 1047840 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9458 1047840 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9459 2095680 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9460 : END DO
9461 1047840 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9462 1309800 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9463 : END DO
9464 : END DO
9465 : END DO
9466 65490 : END SUBROUTINE block_1_4_4_1
9467 : ! **************************************************************************************************
9468 : !> \brief ...
9469 : !> \param md_max ...
9470 : !> \param kbd ...
9471 : !> \param kbc ...
9472 : !> \param kad ...
9473 : !> \param kac ...
9474 : !> \param pbd ...
9475 : !> \param pbc ...
9476 : !> \param pad ...
9477 : !> \param pac ...
9478 : !> \param prim ...
9479 : !> \param scale ...
9480 : ! **************************************************************************************************
9481 109918 : SUBROUTINE block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9482 : INTEGER :: md_max
9483 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*4), kad(1*md_max), kac(1*4), pbd(4*md_max), pbc(4*4), &
9484 : pad(1*md_max), pac(1*4), prim(1*4*4*md_max), scale
9485 :
9486 : INTEGER :: ma, mb, mc, md, p_index
9487 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9488 :
9489 1872802 : kbd(1:4*md_max) = 0.0_dp
9490 109918 : kbc(1:4*4) = 0.0_dp
9491 550639 : kad(1:1*md_max) = 0.0_dp
9492 109918 : kac(1:1*4) = 0.0_dp
9493 109918 : p_index = 0
9494 550639 : DO md = 1, md_max
9495 2313523 : DO mc = 1, 4
9496 9255141 : DO mb = 1, 4
9497 7051536 : ks_bd = 0.0_dp
9498 7051536 : ks_bc = 0.0_dp
9499 7051536 : p_bd = pbd((md - 1)*4 + mb)
9500 7051536 : p_bc = pbc((mc - 1)*4 + mb)
9501 14103072 : DO ma = 1, 1
9502 7051536 : p_index = p_index + 1
9503 7051536 : tmp = scale*prim(p_index)
9504 7051536 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9505 7051536 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9506 7051536 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9507 14103072 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9508 : END DO
9509 7051536 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9510 8814420 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9511 : END DO
9512 : END DO
9513 : END DO
9514 109918 : END SUBROUTINE block_1_4_4
9515 : ! **************************************************************************************************
9516 : !> \brief ...
9517 : !> \param mc_max ...
9518 : !> \param md_max ...
9519 : !> \param kbd ...
9520 : !> \param kbc ...
9521 : !> \param kad ...
9522 : !> \param kac ...
9523 : !> \param pbd ...
9524 : !> \param pbc ...
9525 : !> \param pad ...
9526 : !> \param pac ...
9527 : !> \param prim ...
9528 : !> \param scale ...
9529 : ! **************************************************************************************************
9530 58270 : SUBROUTINE block_1_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9531 : INTEGER :: mc_max, md_max
9532 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*mc_max), kad(1*md_max), kac(1*mc_max), pbd(4*md_max), &
9533 : pbc(4*mc_max), pad(1*md_max), pac(1*mc_max), prim(1*4*mc_max*md_max), scale
9534 :
9535 : INTEGER :: ma, mb, mc, md, p_index
9536 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9537 :
9538 716186 : kbd(1:4*md_max) = 0.0_dp
9539 1231078 : kbc(1:4*mc_max) = 0.0_dp
9540 222749 : kad(1:1*md_max) = 0.0_dp
9541 351472 : kac(1:1*mc_max) = 0.0_dp
9542 : p_index = 0
9543 222749 : DO md = 1, md_max
9544 1053702 : DO mc = 1, mc_max
9545 4319244 : DO mb = 1, 4
9546 3323812 : ks_bd = 0.0_dp
9547 3323812 : ks_bc = 0.0_dp
9548 3323812 : p_bd = pbd((md - 1)*4 + mb)
9549 3323812 : p_bc = pbc((mc - 1)*4 + mb)
9550 6647624 : DO ma = 1, 1
9551 3323812 : p_index = p_index + 1
9552 3323812 : tmp = scale*prim(p_index)
9553 3323812 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9554 3323812 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9555 3323812 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9556 6647624 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9557 : END DO
9558 3323812 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9559 4154765 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9560 : END DO
9561 : END DO
9562 : END DO
9563 58270 : END SUBROUTINE block_1_4
9564 : ! **************************************************************************************************
9565 : !> \brief ...
9566 : !> \param kbd ...
9567 : !> \param kbc ...
9568 : !> \param kad ...
9569 : !> \param kac ...
9570 : !> \param pbd ...
9571 : !> \param pbc ...
9572 : !> \param pad ...
9573 : !> \param pac ...
9574 : !> \param prim ...
9575 : !> \param scale ...
9576 : ! **************************************************************************************************
9577 69474 : SUBROUTINE block_1_5_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9578 : REAL(KIND=dp) :: kbd(5*1), kbc(5*1), kad(1*1), kac(1*1), &
9579 : pbd(5*1), pbc(5*1), pad(1*1), &
9580 : pac(1*1), prim(1*5*1*1), scale
9581 :
9582 : INTEGER :: ma, mb, mc, md, p_index
9583 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9584 :
9585 69474 : kbd(1:5*1) = 0.0_dp
9586 69474 : kbc(1:5*1) = 0.0_dp
9587 69474 : kad(1:1*1) = 0.0_dp
9588 69474 : kac(1:1*1) = 0.0_dp
9589 69474 : p_index = 0
9590 138948 : DO md = 1, 1
9591 208422 : DO mc = 1, 1
9592 486318 : DO mb = 1, 5
9593 347370 : ks_bd = 0.0_dp
9594 347370 : ks_bc = 0.0_dp
9595 347370 : p_bd = pbd((md - 1)*5 + mb)
9596 347370 : p_bc = pbc((mc - 1)*5 + mb)
9597 694740 : DO ma = 1, 1
9598 347370 : p_index = p_index + 1
9599 347370 : tmp = scale*prim(p_index)
9600 347370 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9601 347370 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9602 347370 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9603 694740 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9604 : END DO
9605 347370 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
9606 416844 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
9607 : END DO
9608 : END DO
9609 : END DO
9610 69474 : END SUBROUTINE block_1_5_1_1
9611 : ! **************************************************************************************************
9612 : !> \brief ...
9613 : !> \param kbd ...
9614 : !> \param kbc ...
9615 : !> \param kad ...
9616 : !> \param kac ...
9617 : !> \param pbd ...
9618 : !> \param pbc ...
9619 : !> \param pad ...
9620 : !> \param pac ...
9621 : !> \param prim ...
9622 : !> \param scale ...
9623 : ! **************************************************************************************************
9624 1713 : SUBROUTINE block_1_5_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9625 : REAL(KIND=dp) :: kbd(5*2), kbc(5*1), kad(1*2), kac(1*1), &
9626 : pbd(5*2), pbc(5*1), pad(1*2), &
9627 : pac(1*1), prim(1*5*1*2), scale
9628 :
9629 : INTEGER :: ma, mb, mc, md, p_index
9630 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9631 :
9632 1713 : kbd(1:5*2) = 0.0_dp
9633 1713 : kbc(1:5*1) = 0.0_dp
9634 1713 : kad(1:1*2) = 0.0_dp
9635 1713 : kac(1:1*1) = 0.0_dp
9636 1713 : p_index = 0
9637 5139 : DO md = 1, 2
9638 8565 : DO mc = 1, 1
9639 23982 : DO mb = 1, 5
9640 17130 : ks_bd = 0.0_dp
9641 17130 : ks_bc = 0.0_dp
9642 17130 : p_bd = pbd((md - 1)*5 + mb)
9643 17130 : p_bc = pbc((mc - 1)*5 + mb)
9644 34260 : DO ma = 1, 1
9645 17130 : p_index = p_index + 1
9646 17130 : tmp = scale*prim(p_index)
9647 17130 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9648 17130 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9649 17130 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9650 34260 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9651 : END DO
9652 17130 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
9653 20556 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
9654 : END DO
9655 : END DO
9656 : END DO
9657 1713 : END SUBROUTINE block_1_5_1_2
9658 : ! **************************************************************************************************
9659 : !> \brief ...
9660 : !> \param kbd ...
9661 : !> \param kbc ...
9662 : !> \param kad ...
9663 : !> \param kac ...
9664 : !> \param pbd ...
9665 : !> \param pbc ...
9666 : !> \param pad ...
9667 : !> \param pac ...
9668 : !> \param prim ...
9669 : !> \param scale ...
9670 : ! **************************************************************************************************
9671 40158 : SUBROUTINE block_1_5_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9672 : REAL(KIND=dp) :: kbd(5*3), kbc(5*1), kad(1*3), kac(1*1), &
9673 : pbd(5*3), pbc(5*1), pad(1*3), &
9674 : pac(1*1), prim(1*5*1*3), scale
9675 :
9676 : INTEGER :: ma, mb, mc, md, p_index
9677 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9678 :
9679 40158 : kbd(1:5*3) = 0.0_dp
9680 40158 : kbc(1:5*1) = 0.0_dp
9681 40158 : kad(1:1*3) = 0.0_dp
9682 40158 : kac(1:1*1) = 0.0_dp
9683 40158 : p_index = 0
9684 160632 : DO md = 1, 3
9685 281106 : DO mc = 1, 1
9686 843318 : DO mb = 1, 5
9687 602370 : ks_bd = 0.0_dp
9688 602370 : ks_bc = 0.0_dp
9689 602370 : p_bd = pbd((md - 1)*5 + mb)
9690 602370 : p_bc = pbc((mc - 1)*5 + mb)
9691 1204740 : DO ma = 1, 1
9692 602370 : p_index = p_index + 1
9693 602370 : tmp = scale*prim(p_index)
9694 602370 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9695 602370 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9696 602370 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9697 1204740 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9698 : END DO
9699 602370 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
9700 722844 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
9701 : END DO
9702 : END DO
9703 : END DO
9704 40158 : END SUBROUTINE block_1_5_1_3
9705 : ! **************************************************************************************************
9706 : !> \brief ...
9707 : !> \param md_max ...
9708 : !> \param kbd ...
9709 : !> \param kbc ...
9710 : !> \param kad ...
9711 : !> \param kac ...
9712 : !> \param pbd ...
9713 : !> \param pbc ...
9714 : !> \param pad ...
9715 : !> \param pac ...
9716 : !> \param prim ...
9717 : !> \param scale ...
9718 : ! **************************************************************************************************
9719 42546 : SUBROUTINE block_1_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9720 : INTEGER :: md_max
9721 : REAL(KIND=dp) :: kbd(5*md_max), kbc(5*1), kad(1*md_max), kac(1*1), pbd(5*md_max), pbc(5*1), &
9722 : pad(1*md_max), pac(1*1), prim(1*5*1*md_max), scale
9723 :
9724 : INTEGER :: ma, mb, mc, md, p_index
9725 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9726 :
9727 1053831 : kbd(1:5*md_max) = 0.0_dp
9728 42546 : kbc(1:5*1) = 0.0_dp
9729 244803 : kad(1:1*md_max) = 0.0_dp
9730 42546 : kac(1:1*1) = 0.0_dp
9731 42546 : p_index = 0
9732 244803 : DO md = 1, md_max
9733 447060 : DO mc = 1, 1
9734 1415799 : DO mb = 1, 5
9735 1011285 : ks_bd = 0.0_dp
9736 1011285 : ks_bc = 0.0_dp
9737 1011285 : p_bd = pbd((md - 1)*5 + mb)
9738 1011285 : p_bc = pbc((mc - 1)*5 + mb)
9739 2022570 : DO ma = 1, 1
9740 1011285 : p_index = p_index + 1
9741 1011285 : tmp = scale*prim(p_index)
9742 1011285 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9743 1011285 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9744 1011285 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9745 2022570 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9746 : END DO
9747 1011285 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
9748 1213542 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
9749 : END DO
9750 : END DO
9751 : END DO
9752 42546 : END SUBROUTINE block_1_5_1
9753 : ! **************************************************************************************************
9754 : !> \brief ...
9755 : !> \param kbd ...
9756 : !> \param kbc ...
9757 : !> \param kad ...
9758 : !> \param kac ...
9759 : !> \param pbd ...
9760 : !> \param pbc ...
9761 : !> \param pad ...
9762 : !> \param pac ...
9763 : !> \param prim ...
9764 : !> \param scale ...
9765 : ! **************************************************************************************************
9766 1706 : SUBROUTINE block_1_5_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9767 : REAL(KIND=dp) :: kbd(5*1), kbc(5*2), kad(1*1), kac(1*2), &
9768 : pbd(5*1), pbc(5*2), pad(1*1), &
9769 : pac(1*2), prim(1*5*2*1), scale
9770 :
9771 : INTEGER :: ma, mb, mc, md, p_index
9772 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9773 :
9774 1706 : kbd(1:5*1) = 0.0_dp
9775 1706 : kbc(1:5*2) = 0.0_dp
9776 1706 : kad(1:1*1) = 0.0_dp
9777 1706 : kac(1:1*2) = 0.0_dp
9778 1706 : p_index = 0
9779 3412 : DO md = 1, 1
9780 6824 : DO mc = 1, 2
9781 22178 : DO mb = 1, 5
9782 17060 : ks_bd = 0.0_dp
9783 17060 : ks_bc = 0.0_dp
9784 17060 : p_bd = pbd((md - 1)*5 + mb)
9785 17060 : p_bc = pbc((mc - 1)*5 + mb)
9786 34120 : DO ma = 1, 1
9787 17060 : p_index = p_index + 1
9788 17060 : tmp = scale*prim(p_index)
9789 17060 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9790 17060 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9791 17060 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9792 34120 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9793 : END DO
9794 17060 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
9795 20472 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
9796 : END DO
9797 : END DO
9798 : END DO
9799 1706 : END SUBROUTINE block_1_5_2_1
9800 : ! **************************************************************************************************
9801 : !> \brief ...
9802 : !> \param md_max ...
9803 : !> \param kbd ...
9804 : !> \param kbc ...
9805 : !> \param kad ...
9806 : !> \param kac ...
9807 : !> \param pbd ...
9808 : !> \param pbc ...
9809 : !> \param pad ...
9810 : !> \param pac ...
9811 : !> \param prim ...
9812 : !> \param scale ...
9813 : ! **************************************************************************************************
9814 5654 : SUBROUTINE block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9815 : INTEGER :: md_max
9816 : REAL(KIND=dp) :: kbd(5*md_max), kbc(5*2), kad(1*md_max), kac(1*2), pbd(5*md_max), pbc(5*2), &
9817 : pad(1*md_max), pac(1*2), prim(1*5*2*md_max), scale
9818 :
9819 : INTEGER :: ma, mb, mc, md, p_index
9820 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9821 :
9822 119884 : kbd(1:5*md_max) = 0.0_dp
9823 5654 : kbc(1:5*2) = 0.0_dp
9824 28500 : kad(1:1*md_max) = 0.0_dp
9825 5654 : kac(1:1*2) = 0.0_dp
9826 5654 : p_index = 0
9827 28500 : DO md = 1, md_max
9828 74192 : DO mc = 1, 2
9829 296998 : DO mb = 1, 5
9830 228460 : ks_bd = 0.0_dp
9831 228460 : ks_bc = 0.0_dp
9832 228460 : p_bd = pbd((md - 1)*5 + mb)
9833 228460 : p_bc = pbc((mc - 1)*5 + mb)
9834 456920 : DO ma = 1, 1
9835 228460 : p_index = p_index + 1
9836 228460 : tmp = scale*prim(p_index)
9837 228460 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9838 228460 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9839 228460 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9840 456920 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9841 : END DO
9842 228460 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
9843 274152 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
9844 : END DO
9845 : END DO
9846 : END DO
9847 5654 : END SUBROUTINE block_1_5_2
9848 : ! **************************************************************************************************
9849 : !> \brief ...
9850 : !> \param kbd ...
9851 : !> \param kbc ...
9852 : !> \param kad ...
9853 : !> \param kac ...
9854 : !> \param pbd ...
9855 : !> \param pbc ...
9856 : !> \param pad ...
9857 : !> \param pac ...
9858 : !> \param prim ...
9859 : !> \param scale ...
9860 : ! **************************************************************************************************
9861 38151 : SUBROUTINE block_1_5_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9862 : REAL(KIND=dp) :: kbd(5*1), kbc(5*3), kad(1*1), kac(1*3), &
9863 : pbd(5*1), pbc(5*3), pad(1*1), &
9864 : pac(1*3), prim(1*5*3*1), scale
9865 :
9866 : INTEGER :: ma, mb, mc, md, p_index
9867 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9868 :
9869 38151 : kbd(1:5*1) = 0.0_dp
9870 38151 : kbc(1:5*3) = 0.0_dp
9871 38151 : kad(1:1*1) = 0.0_dp
9872 38151 : kac(1:1*3) = 0.0_dp
9873 38151 : p_index = 0
9874 76302 : DO md = 1, 1
9875 190755 : DO mc = 1, 3
9876 724869 : DO mb = 1, 5
9877 572265 : ks_bd = 0.0_dp
9878 572265 : ks_bc = 0.0_dp
9879 572265 : p_bd = pbd((md - 1)*5 + mb)
9880 572265 : p_bc = pbc((mc - 1)*5 + mb)
9881 1144530 : DO ma = 1, 1
9882 572265 : p_index = p_index + 1
9883 572265 : tmp = scale*prim(p_index)
9884 572265 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9885 572265 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9886 572265 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9887 1144530 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9888 : END DO
9889 572265 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
9890 686718 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
9891 : END DO
9892 : END DO
9893 : END DO
9894 38151 : END SUBROUTINE block_1_5_3_1
9895 : ! **************************************************************************************************
9896 : !> \brief ...
9897 : !> \param md_max ...
9898 : !> \param kbd ...
9899 : !> \param kbc ...
9900 : !> \param kad ...
9901 : !> \param kac ...
9902 : !> \param pbd ...
9903 : !> \param pbc ...
9904 : !> \param pad ...
9905 : !> \param pac ...
9906 : !> \param prim ...
9907 : !> \param scale ...
9908 : ! **************************************************************************************************
9909 56731 : SUBROUTINE block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9910 : INTEGER :: md_max
9911 : REAL(KIND=dp) :: kbd(5*md_max), kbc(5*3), kad(1*md_max), kac(1*3), pbd(5*md_max), pbc(5*3), &
9912 : pad(1*md_max), pac(1*3), prim(1*5*3*md_max), scale
9913 :
9914 : INTEGER :: ma, mb, mc, md, p_index
9915 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9916 :
9917 1160731 : kbd(1:5*md_max) = 0.0_dp
9918 56731 : kbc(1:5*3) = 0.0_dp
9919 277531 : kad(1:1*md_max) = 0.0_dp
9920 56731 : kac(1:1*3) = 0.0_dp
9921 56731 : p_index = 0
9922 277531 : DO md = 1, md_max
9923 939931 : DO mc = 1, 3
9924 4195200 : DO mb = 1, 5
9925 3312000 : ks_bd = 0.0_dp
9926 3312000 : ks_bc = 0.0_dp
9927 3312000 : p_bd = pbd((md - 1)*5 + mb)
9928 3312000 : p_bc = pbc((mc - 1)*5 + mb)
9929 6624000 : DO ma = 1, 1
9930 3312000 : p_index = p_index + 1
9931 3312000 : tmp = scale*prim(p_index)
9932 3312000 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9933 3312000 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9934 3312000 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9935 6624000 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9936 : END DO
9937 3312000 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
9938 3974400 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
9939 : END DO
9940 : END DO
9941 : END DO
9942 56731 : END SUBROUTINE block_1_5_3
9943 : ! **************************************************************************************************
9944 : !> \brief ...
9945 : !> \param mc_max ...
9946 : !> \param md_max ...
9947 : !> \param kbd ...
9948 : !> \param kbc ...
9949 : !> \param kad ...
9950 : !> \param kac ...
9951 : !> \param pbd ...
9952 : !> \param pbc ...
9953 : !> \param pad ...
9954 : !> \param pac ...
9955 : !> \param prim ...
9956 : !> \param scale ...
9957 : ! **************************************************************************************************
9958 136535 : SUBROUTINE block_1_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
9959 : INTEGER :: mc_max, md_max
9960 : REAL(KIND=dp) :: kbd(5*md_max), kbc(5*mc_max), kad(1*md_max), kac(1*mc_max), pbd(5*md_max), &
9961 : pbc(5*mc_max), pad(1*md_max), pac(1*mc_max), prim(1*5*mc_max*md_max), scale
9962 :
9963 : INTEGER :: ma, mb, mc, md, p_index
9964 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
9965 :
9966 2108485 : kbd(1:5*md_max) = 0.0_dp
9967 3404465 : kbc(1:5*mc_max) = 0.0_dp
9968 530925 : kad(1:1*md_max) = 0.0_dp
9969 790121 : kac(1:1*mc_max) = 0.0_dp
9970 : p_index = 0
9971 530925 : DO md = 1, md_max
9972 2440651 : DO mc = 1, mc_max
9973 11852746 : DO mb = 1, 5
9974 9548630 : ks_bd = 0.0_dp
9975 9548630 : ks_bc = 0.0_dp
9976 9548630 : p_bd = pbd((md - 1)*5 + mb)
9977 9548630 : p_bc = pbc((mc - 1)*5 + mb)
9978 19097260 : DO ma = 1, 1
9979 9548630 : p_index = p_index + 1
9980 9548630 : tmp = scale*prim(p_index)
9981 9548630 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9982 9548630 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9983 9548630 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9984 19097260 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9985 : END DO
9986 9548630 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
9987 11458356 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
9988 : END DO
9989 : END DO
9990 : END DO
9991 136535 : END SUBROUTINE block_1_5
9992 : ! **************************************************************************************************
9993 : !> \brief ...
9994 : !> \param kbd ...
9995 : !> \param kbc ...
9996 : !> \param kad ...
9997 : !> \param kac ...
9998 : !> \param pbd ...
9999 : !> \param pbc ...
10000 : !> \param pad ...
10001 : !> \param pac ...
10002 : !> \param prim ...
10003 : !> \param scale ...
10004 : ! **************************************************************************************************
10005 10 : SUBROUTINE block_1_6_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10006 : REAL(KIND=dp) :: kbd(6*1), kbc(6*1), kad(1*1), kac(1*1), &
10007 : pbd(6*1), pbc(6*1), pad(1*1), &
10008 : pac(1*1), prim(1*6*1*1), scale
10009 :
10010 : INTEGER :: ma, mb, mc, md, p_index
10011 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10012 :
10013 10 : kbd(1:6*1) = 0.0_dp
10014 10 : kbc(1:6*1) = 0.0_dp
10015 10 : kad(1:1*1) = 0.0_dp
10016 10 : kac(1:1*1) = 0.0_dp
10017 10 : p_index = 0
10018 20 : DO md = 1, 1
10019 30 : DO mc = 1, 1
10020 80 : DO mb = 1, 6
10021 60 : ks_bd = 0.0_dp
10022 60 : ks_bc = 0.0_dp
10023 60 : p_bd = pbd((md - 1)*6 + mb)
10024 60 : p_bc = pbc((mc - 1)*6 + mb)
10025 120 : DO ma = 1, 1
10026 60 : p_index = p_index + 1
10027 60 : tmp = scale*prim(p_index)
10028 60 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10029 60 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10030 60 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10031 120 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10032 : END DO
10033 60 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
10034 70 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
10035 : END DO
10036 : END DO
10037 : END DO
10038 10 : END SUBROUTINE block_1_6_1_1
10039 : ! **************************************************************************************************
10040 : !> \brief ...
10041 : !> \param kbd ...
10042 : !> \param kbc ...
10043 : !> \param kad ...
10044 : !> \param kac ...
10045 : !> \param pbd ...
10046 : !> \param pbc ...
10047 : !> \param pad ...
10048 : !> \param pac ...
10049 : !> \param prim ...
10050 : !> \param scale ...
10051 : ! **************************************************************************************************
10052 9 : SUBROUTINE block_1_6_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10053 : REAL(KIND=dp) :: kbd(6*2), kbc(6*1), kad(1*2), kac(1*1), &
10054 : pbd(6*2), pbc(6*1), pad(1*2), &
10055 : pac(1*1), prim(1*6*1*2), scale
10056 :
10057 : INTEGER :: ma, mb, mc, md, p_index
10058 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10059 :
10060 9 : kbd(1:6*2) = 0.0_dp
10061 9 : kbc(1:6*1) = 0.0_dp
10062 9 : kad(1:1*2) = 0.0_dp
10063 9 : kac(1:1*1) = 0.0_dp
10064 9 : p_index = 0
10065 27 : DO md = 1, 2
10066 45 : DO mc = 1, 1
10067 144 : DO mb = 1, 6
10068 108 : ks_bd = 0.0_dp
10069 108 : ks_bc = 0.0_dp
10070 108 : p_bd = pbd((md - 1)*6 + mb)
10071 108 : p_bc = pbc((mc - 1)*6 + mb)
10072 216 : DO ma = 1, 1
10073 108 : p_index = p_index + 1
10074 108 : tmp = scale*prim(p_index)
10075 108 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10076 108 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10077 108 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10078 216 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10079 : END DO
10080 108 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
10081 126 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
10082 : END DO
10083 : END DO
10084 : END DO
10085 9 : END SUBROUTINE block_1_6_1_2
10086 : ! **************************************************************************************************
10087 : !> \brief ...
10088 : !> \param kbd ...
10089 : !> \param kbc ...
10090 : !> \param kad ...
10091 : !> \param kac ...
10092 : !> \param pbd ...
10093 : !> \param pbc ...
10094 : !> \param pad ...
10095 : !> \param pac ...
10096 : !> \param prim ...
10097 : !> \param scale ...
10098 : ! **************************************************************************************************
10099 8 : SUBROUTINE block_1_6_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10100 : REAL(KIND=dp) :: kbd(6*3), kbc(6*1), kad(1*3), kac(1*1), &
10101 : pbd(6*3), pbc(6*1), pad(1*3), &
10102 : pac(1*1), prim(1*6*1*3), scale
10103 :
10104 : INTEGER :: ma, mb, mc, md, p_index
10105 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10106 :
10107 8 : kbd(1:6*3) = 0.0_dp
10108 8 : kbc(1:6*1) = 0.0_dp
10109 8 : kad(1:1*3) = 0.0_dp
10110 8 : kac(1:1*1) = 0.0_dp
10111 8 : p_index = 0
10112 32 : DO md = 1, 3
10113 56 : DO mc = 1, 1
10114 192 : DO mb = 1, 6
10115 144 : ks_bd = 0.0_dp
10116 144 : ks_bc = 0.0_dp
10117 144 : p_bd = pbd((md - 1)*6 + mb)
10118 144 : p_bc = pbc((mc - 1)*6 + mb)
10119 288 : DO ma = 1, 1
10120 144 : p_index = p_index + 1
10121 144 : tmp = scale*prim(p_index)
10122 144 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10123 144 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10124 144 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10125 288 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10126 : END DO
10127 144 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
10128 168 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
10129 : END DO
10130 : END DO
10131 : END DO
10132 8 : END SUBROUTINE block_1_6_1_3
10133 : ! **************************************************************************************************
10134 : !> \brief ...
10135 : !> \param md_max ...
10136 : !> \param kbd ...
10137 : !> \param kbc ...
10138 : !> \param kad ...
10139 : !> \param kac ...
10140 : !> \param pbd ...
10141 : !> \param pbc ...
10142 : !> \param pad ...
10143 : !> \param pac ...
10144 : !> \param prim ...
10145 : !> \param scale ...
10146 : ! **************************************************************************************************
10147 35 : SUBROUTINE block_1_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10148 : INTEGER :: md_max
10149 : REAL(KIND=dp) :: kbd(6*md_max), kbc(6*1), kad(1*md_max), kac(1*1), pbd(6*md_max), pbc(6*1), &
10150 : pad(1*md_max), pac(1*1), prim(1*6*1*md_max), scale
10151 :
10152 : INTEGER :: ma, mb, mc, md, p_index
10153 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10154 :
10155 1307 : kbd(1:6*md_max) = 0.0_dp
10156 35 : kbc(1:6*1) = 0.0_dp
10157 247 : kad(1:1*md_max) = 0.0_dp
10158 35 : kac(1:1*1) = 0.0_dp
10159 35 : p_index = 0
10160 247 : DO md = 1, md_max
10161 459 : DO mc = 1, 1
10162 1696 : DO mb = 1, 6
10163 1272 : ks_bd = 0.0_dp
10164 1272 : ks_bc = 0.0_dp
10165 1272 : p_bd = pbd((md - 1)*6 + mb)
10166 1272 : p_bc = pbc((mc - 1)*6 + mb)
10167 2544 : DO ma = 1, 1
10168 1272 : p_index = p_index + 1
10169 1272 : tmp = scale*prim(p_index)
10170 1272 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10171 1272 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10172 1272 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10173 2544 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10174 : END DO
10175 1272 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
10176 1484 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
10177 : END DO
10178 : END DO
10179 : END DO
10180 35 : END SUBROUTINE block_1_6_1
10181 : ! **************************************************************************************************
10182 : !> \brief ...
10183 : !> \param kbd ...
10184 : !> \param kbc ...
10185 : !> \param kad ...
10186 : !> \param kac ...
10187 : !> \param pbd ...
10188 : !> \param pbc ...
10189 : !> \param pad ...
10190 : !> \param pac ...
10191 : !> \param prim ...
10192 : !> \param scale ...
10193 : ! **************************************************************************************************
10194 2 : SUBROUTINE block_1_6_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10195 : REAL(KIND=dp) :: kbd(6*1), kbc(6*2), kad(1*1), kac(1*2), &
10196 : pbd(6*1), pbc(6*2), pad(1*1), &
10197 : pac(1*2), prim(1*6*2*1), scale
10198 :
10199 : INTEGER :: ma, mb, mc, md, p_index
10200 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10201 :
10202 2 : kbd(1:6*1) = 0.0_dp
10203 2 : kbc(1:6*2) = 0.0_dp
10204 2 : kad(1:1*1) = 0.0_dp
10205 2 : kac(1:1*2) = 0.0_dp
10206 2 : p_index = 0
10207 4 : DO md = 1, 1
10208 8 : DO mc = 1, 2
10209 30 : DO mb = 1, 6
10210 24 : ks_bd = 0.0_dp
10211 24 : ks_bc = 0.0_dp
10212 24 : p_bd = pbd((md - 1)*6 + mb)
10213 24 : p_bc = pbc((mc - 1)*6 + mb)
10214 48 : DO ma = 1, 1
10215 24 : p_index = p_index + 1
10216 24 : tmp = scale*prim(p_index)
10217 24 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10218 24 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10219 24 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10220 48 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10221 : END DO
10222 24 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
10223 28 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
10224 : END DO
10225 : END DO
10226 : END DO
10227 2 : END SUBROUTINE block_1_6_2_1
10228 : ! **************************************************************************************************
10229 : !> \brief ...
10230 : !> \param md_max ...
10231 : !> \param kbd ...
10232 : !> \param kbc ...
10233 : !> \param kad ...
10234 : !> \param kac ...
10235 : !> \param pbd ...
10236 : !> \param pbc ...
10237 : !> \param pad ...
10238 : !> \param pac ...
10239 : !> \param prim ...
10240 : !> \param scale ...
10241 : ! **************************************************************************************************
10242 38 : SUBROUTINE block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10243 : INTEGER :: md_max
10244 : REAL(KIND=dp) :: kbd(6*md_max), kbc(6*2), kad(1*md_max), kac(1*2), pbd(6*md_max), pbc(6*2), &
10245 : pad(1*md_max), pac(1*2), prim(1*6*2*md_max), scale
10246 :
10247 : INTEGER :: ma, mb, mc, md, p_index
10248 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10249 :
10250 938 : kbd(1:6*md_max) = 0.0_dp
10251 38 : kbc(1:6*2) = 0.0_dp
10252 188 : kad(1:1*md_max) = 0.0_dp
10253 38 : kac(1:1*2) = 0.0_dp
10254 38 : p_index = 0
10255 188 : DO md = 1, md_max
10256 488 : DO mc = 1, 2
10257 2250 : DO mb = 1, 6
10258 1800 : ks_bd = 0.0_dp
10259 1800 : ks_bc = 0.0_dp
10260 1800 : p_bd = pbd((md - 1)*6 + mb)
10261 1800 : p_bc = pbc((mc - 1)*6 + mb)
10262 3600 : DO ma = 1, 1
10263 1800 : p_index = p_index + 1
10264 1800 : tmp = scale*prim(p_index)
10265 1800 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10266 1800 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10267 1800 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10268 3600 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10269 : END DO
10270 1800 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
10271 2100 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
10272 : END DO
10273 : END DO
10274 : END DO
10275 38 : END SUBROUTINE block_1_6_2
10276 : ! **************************************************************************************************
10277 : !> \brief ...
10278 : !> \param kbd ...
10279 : !> \param kbc ...
10280 : !> \param kad ...
10281 : !> \param kac ...
10282 : !> \param pbd ...
10283 : !> \param pbc ...
10284 : !> \param pad ...
10285 : !> \param pac ...
10286 : !> \param prim ...
10287 : !> \param scale ...
10288 : ! **************************************************************************************************
10289 3 : SUBROUTINE block_1_6_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10290 : REAL(KIND=dp) :: kbd(6*1), kbc(6*3), kad(1*1), kac(1*3), &
10291 : pbd(6*1), pbc(6*3), pad(1*1), &
10292 : pac(1*3), prim(1*6*3*1), scale
10293 :
10294 : INTEGER :: ma, mb, mc, md, p_index
10295 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10296 :
10297 3 : kbd(1:6*1) = 0.0_dp
10298 3 : kbc(1:6*3) = 0.0_dp
10299 3 : kad(1:1*1) = 0.0_dp
10300 3 : kac(1:1*3) = 0.0_dp
10301 3 : p_index = 0
10302 6 : DO md = 1, 1
10303 15 : DO mc = 1, 3
10304 66 : DO mb = 1, 6
10305 54 : ks_bd = 0.0_dp
10306 54 : ks_bc = 0.0_dp
10307 54 : p_bd = pbd((md - 1)*6 + mb)
10308 54 : p_bc = pbc((mc - 1)*6 + mb)
10309 108 : DO ma = 1, 1
10310 54 : p_index = p_index + 1
10311 54 : tmp = scale*prim(p_index)
10312 54 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10313 54 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10314 54 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10315 108 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10316 : END DO
10317 54 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
10318 63 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
10319 : END DO
10320 : END DO
10321 : END DO
10322 3 : END SUBROUTINE block_1_6_3_1
10323 : ! **************************************************************************************************
10324 : !> \brief ...
10325 : !> \param md_max ...
10326 : !> \param kbd ...
10327 : !> \param kbc ...
10328 : !> \param kad ...
10329 : !> \param kac ...
10330 : !> \param pbd ...
10331 : !> \param pbc ...
10332 : !> \param pad ...
10333 : !> \param pac ...
10334 : !> \param prim ...
10335 : !> \param scale ...
10336 : ! **************************************************************************************************
10337 35 : SUBROUTINE block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10338 : INTEGER :: md_max
10339 : REAL(KIND=dp) :: kbd(6*md_max), kbc(6*3), kad(1*md_max), kac(1*3), pbd(6*md_max), pbc(6*3), &
10340 : pad(1*md_max), pac(1*3), prim(1*6*3*md_max), scale
10341 :
10342 : INTEGER :: ma, mb, mc, md, p_index
10343 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10344 :
10345 983 : kbd(1:6*md_max) = 0.0_dp
10346 35 : kbc(1:6*3) = 0.0_dp
10347 193 : kad(1:1*md_max) = 0.0_dp
10348 35 : kac(1:1*3) = 0.0_dp
10349 35 : p_index = 0
10350 193 : DO md = 1, md_max
10351 667 : DO mc = 1, 3
10352 3476 : DO mb = 1, 6
10353 2844 : ks_bd = 0.0_dp
10354 2844 : ks_bc = 0.0_dp
10355 2844 : p_bd = pbd((md - 1)*6 + mb)
10356 2844 : p_bc = pbc((mc - 1)*6 + mb)
10357 5688 : DO ma = 1, 1
10358 2844 : p_index = p_index + 1
10359 2844 : tmp = scale*prim(p_index)
10360 2844 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10361 2844 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10362 2844 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10363 5688 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10364 : END DO
10365 2844 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
10366 3318 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
10367 : END DO
10368 : END DO
10369 : END DO
10370 35 : END SUBROUTINE block_1_6_3
10371 : ! **************************************************************************************************
10372 : !> \brief ...
10373 : !> \param mc_max ...
10374 : !> \param md_max ...
10375 : !> \param kbd ...
10376 : !> \param kbc ...
10377 : !> \param kad ...
10378 : !> \param kac ...
10379 : !> \param pbd ...
10380 : !> \param pbc ...
10381 : !> \param pad ...
10382 : !> \param pac ...
10383 : !> \param prim ...
10384 : !> \param scale ...
10385 : ! **************************************************************************************************
10386 55 : SUBROUTINE block_1_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10387 : INTEGER :: mc_max, md_max
10388 : REAL(KIND=dp) :: kbd(6*md_max), kbc(6*mc_max), kad(1*md_max), kac(1*mc_max), pbd(6*md_max), &
10389 : pbc(6*mc_max), pad(1*md_max), pac(1*mc_max), prim(1*6*mc_max*md_max), scale
10390 :
10391 : INTEGER :: ma, mb, mc, md, p_index
10392 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10393 :
10394 1759 : kbd(1:6*md_max) = 0.0_dp
10395 2089 : kbc(1:6*mc_max) = 0.0_dp
10396 339 : kad(1:1*md_max) = 0.0_dp
10397 394 : kac(1:1*mc_max) = 0.0_dp
10398 : p_index = 0
10399 339 : DO md = 1, md_max
10400 2484 : DO mc = 1, mc_max
10401 15299 : DO mb = 1, 6
10402 12870 : ks_bd = 0.0_dp
10403 12870 : ks_bc = 0.0_dp
10404 12870 : p_bd = pbd((md - 1)*6 + mb)
10405 12870 : p_bc = pbc((mc - 1)*6 + mb)
10406 25740 : DO ma = 1, 1
10407 12870 : p_index = p_index + 1
10408 12870 : tmp = scale*prim(p_index)
10409 12870 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10410 12870 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10411 12870 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10412 25740 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10413 : END DO
10414 12870 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
10415 15015 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
10416 : END DO
10417 : END DO
10418 : END DO
10419 55 : END SUBROUTINE block_1_6
10420 : ! **************************************************************************************************
10421 : !> \brief ...
10422 : !> \param kbd ...
10423 : !> \param kbc ...
10424 : !> \param kad ...
10425 : !> \param kac ...
10426 : !> \param pbd ...
10427 : !> \param pbc ...
10428 : !> \param pad ...
10429 : !> \param pac ...
10430 : !> \param prim ...
10431 : !> \param scale ...
10432 : ! **************************************************************************************************
10433 5221 : SUBROUTINE block_1_7_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10434 : REAL(KIND=dp) :: kbd(7*1), kbc(7*1), kad(1*1), kac(1*1), &
10435 : pbd(7*1), pbc(7*1), pad(1*1), &
10436 : pac(1*1), prim(1*7*1*1), scale
10437 :
10438 : INTEGER :: ma, mb, mc, md, p_index
10439 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10440 :
10441 5221 : kbd(1:7*1) = 0.0_dp
10442 5221 : kbc(1:7*1) = 0.0_dp
10443 5221 : kad(1:1*1) = 0.0_dp
10444 5221 : kac(1:1*1) = 0.0_dp
10445 5221 : p_index = 0
10446 10442 : DO md = 1, 1
10447 15663 : DO mc = 1, 1
10448 46989 : DO mb = 1, 7
10449 36547 : ks_bd = 0.0_dp
10450 36547 : ks_bc = 0.0_dp
10451 36547 : p_bd = pbd((md - 1)*7 + mb)
10452 36547 : p_bc = pbc((mc - 1)*7 + mb)
10453 73094 : DO ma = 1, 1
10454 36547 : p_index = p_index + 1
10455 36547 : tmp = scale*prim(p_index)
10456 36547 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10457 36547 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10458 36547 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10459 73094 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10460 : END DO
10461 36547 : kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
10462 41768 : kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
10463 : END DO
10464 : END DO
10465 : END DO
10466 5221 : END SUBROUTINE block_1_7_1_1
10467 : ! **************************************************************************************************
10468 : !> \brief ...
10469 : !> \param kbd ...
10470 : !> \param kbc ...
10471 : !> \param kad ...
10472 : !> \param kac ...
10473 : !> \param pbd ...
10474 : !> \param pbc ...
10475 : !> \param pad ...
10476 : !> \param pac ...
10477 : !> \param prim ...
10478 : !> \param scale ...
10479 : ! **************************************************************************************************
10480 715 : SUBROUTINE block_1_7_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10481 : REAL(KIND=dp) :: kbd(7*2), kbc(7*1), kad(1*2), kac(1*1), &
10482 : pbd(7*2), pbc(7*1), pad(1*2), &
10483 : pac(1*1), prim(1*7*1*2), scale
10484 :
10485 : INTEGER :: ma, mb, mc, md, p_index
10486 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10487 :
10488 715 : kbd(1:7*2) = 0.0_dp
10489 715 : kbc(1:7*1) = 0.0_dp
10490 715 : kad(1:1*2) = 0.0_dp
10491 715 : kac(1:1*1) = 0.0_dp
10492 715 : p_index = 0
10493 2145 : DO md = 1, 2
10494 3575 : DO mc = 1, 1
10495 12870 : DO mb = 1, 7
10496 10010 : ks_bd = 0.0_dp
10497 10010 : ks_bc = 0.0_dp
10498 10010 : p_bd = pbd((md - 1)*7 + mb)
10499 10010 : p_bc = pbc((mc - 1)*7 + mb)
10500 20020 : DO ma = 1, 1
10501 10010 : p_index = p_index + 1
10502 10010 : tmp = scale*prim(p_index)
10503 10010 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10504 10010 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10505 10010 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10506 20020 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10507 : END DO
10508 10010 : kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
10509 11440 : kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
10510 : END DO
10511 : END DO
10512 : END DO
10513 715 : END SUBROUTINE block_1_7_1_2
10514 : ! **************************************************************************************************
10515 : !> \brief ...
10516 : !> \param md_max ...
10517 : !> \param kbd ...
10518 : !> \param kbc ...
10519 : !> \param kad ...
10520 : !> \param kac ...
10521 : !> \param pbd ...
10522 : !> \param pbc ...
10523 : !> \param pad ...
10524 : !> \param pac ...
10525 : !> \param prim ...
10526 : !> \param scale ...
10527 : ! **************************************************************************************************
10528 11528 : SUBROUTINE block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10529 : INTEGER :: md_max
10530 : REAL(KIND=dp) :: kbd(7*md_max), kbc(7*1), kad(1*md_max), kac(1*1), pbd(7*md_max), pbc(7*1), &
10531 : pad(1*md_max), pac(1*1), prim(1*7*1*md_max), scale
10532 :
10533 : INTEGER :: ma, mb, mc, md, p_index
10534 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10535 :
10536 360674 : kbd(1:7*md_max) = 0.0_dp
10537 11528 : kbc(1:7*1) = 0.0_dp
10538 61406 : kad(1:1*md_max) = 0.0_dp
10539 11528 : kac(1:1*1) = 0.0_dp
10540 11528 : p_index = 0
10541 61406 : DO md = 1, md_max
10542 111284 : DO mc = 1, 1
10543 448902 : DO mb = 1, 7
10544 349146 : ks_bd = 0.0_dp
10545 349146 : ks_bc = 0.0_dp
10546 349146 : p_bd = pbd((md - 1)*7 + mb)
10547 349146 : p_bc = pbc((mc - 1)*7 + mb)
10548 698292 : DO ma = 1, 1
10549 349146 : p_index = p_index + 1
10550 349146 : tmp = scale*prim(p_index)
10551 349146 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10552 349146 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10553 349146 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10554 698292 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10555 : END DO
10556 349146 : kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
10557 399024 : kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
10558 : END DO
10559 : END DO
10560 : END DO
10561 11528 : END SUBROUTINE block_1_7_1
10562 : ! **************************************************************************************************
10563 : !> \brief ...
10564 : !> \param kbd ...
10565 : !> \param kbc ...
10566 : !> \param kad ...
10567 : !> \param kac ...
10568 : !> \param pbd ...
10569 : !> \param pbc ...
10570 : !> \param pad ...
10571 : !> \param pac ...
10572 : !> \param prim ...
10573 : !> \param scale ...
10574 : ! **************************************************************************************************
10575 712 : SUBROUTINE block_1_7_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10576 : REAL(KIND=dp) :: kbd(7*1), kbc(7*2), kad(1*1), kac(1*2), &
10577 : pbd(7*1), pbc(7*2), pad(1*1), &
10578 : pac(1*2), prim(1*7*2*1), scale
10579 :
10580 : INTEGER :: ma, mb, mc, md, p_index
10581 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10582 :
10583 712 : kbd(1:7*1) = 0.0_dp
10584 712 : kbc(1:7*2) = 0.0_dp
10585 712 : kad(1:1*1) = 0.0_dp
10586 712 : kac(1:1*2) = 0.0_dp
10587 712 : p_index = 0
10588 1424 : DO md = 1, 1
10589 2848 : DO mc = 1, 2
10590 12104 : DO mb = 1, 7
10591 9968 : ks_bd = 0.0_dp
10592 9968 : ks_bc = 0.0_dp
10593 9968 : p_bd = pbd((md - 1)*7 + mb)
10594 9968 : p_bc = pbc((mc - 1)*7 + mb)
10595 19936 : DO ma = 1, 1
10596 9968 : p_index = p_index + 1
10597 9968 : tmp = scale*prim(p_index)
10598 9968 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10599 9968 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10600 9968 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10601 19936 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10602 : END DO
10603 9968 : kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
10604 11392 : kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
10605 : END DO
10606 : END DO
10607 : END DO
10608 712 : END SUBROUTINE block_1_7_2_1
10609 : ! **************************************************************************************************
10610 : !> \brief ...
10611 : !> \param md_max ...
10612 : !> \param kbd ...
10613 : !> \param kbc ...
10614 : !> \param kad ...
10615 : !> \param kac ...
10616 : !> \param pbd ...
10617 : !> \param pbc ...
10618 : !> \param pad ...
10619 : !> \param pac ...
10620 : !> \param prim ...
10621 : !> \param scale ...
10622 : ! **************************************************************************************************
10623 2408 : SUBROUTINE block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10624 : INTEGER :: md_max
10625 : REAL(KIND=dp) :: kbd(7*md_max), kbc(7*2), kad(1*md_max), kac(1*2), pbd(7*md_max), pbc(7*2), &
10626 : pad(1*md_max), pac(1*2), prim(1*7*2*md_max), scale
10627 :
10628 : INTEGER :: ma, mb, mc, md, p_index
10629 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10630 :
10631 74795 : kbd(1:7*md_max) = 0.0_dp
10632 2408 : kbc(1:7*2) = 0.0_dp
10633 12749 : kad(1:1*md_max) = 0.0_dp
10634 2408 : kac(1:1*2) = 0.0_dp
10635 2408 : p_index = 0
10636 12749 : DO md = 1, md_max
10637 33431 : DO mc = 1, 2
10638 175797 : DO mb = 1, 7
10639 144774 : ks_bd = 0.0_dp
10640 144774 : ks_bc = 0.0_dp
10641 144774 : p_bd = pbd((md - 1)*7 + mb)
10642 144774 : p_bc = pbc((mc - 1)*7 + mb)
10643 289548 : DO ma = 1, 1
10644 144774 : p_index = p_index + 1
10645 144774 : tmp = scale*prim(p_index)
10646 144774 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10647 144774 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10648 144774 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10649 289548 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10650 : END DO
10651 144774 : kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
10652 165456 : kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
10653 : END DO
10654 : END DO
10655 : END DO
10656 2408 : END SUBROUTINE block_1_7_2
10657 : ! **************************************************************************************************
10658 : !> \brief ...
10659 : !> \param mc_max ...
10660 : !> \param md_max ...
10661 : !> \param kbd ...
10662 : !> \param kbc ...
10663 : !> \param kad ...
10664 : !> \param kac ...
10665 : !> \param pbd ...
10666 : !> \param pbc ...
10667 : !> \param pad ...
10668 : !> \param pac ...
10669 : !> \param prim ...
10670 : !> \param scale ...
10671 : ! **************************************************************************************************
10672 42531 : SUBROUTINE block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10673 : INTEGER :: mc_max, md_max
10674 : REAL(KIND=dp) :: kbd(7*md_max), kbc(7*mc_max), kad(1*md_max), kac(1*mc_max), pbd(7*md_max), &
10675 : pbc(7*mc_max), pad(1*md_max), pac(1*mc_max), prim(1*7*mc_max*md_max), scale
10676 :
10677 : INTEGER :: ma, mb, mc, md, p_index
10678 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10679 :
10680 1046870 : kbd(1:7*md_max) = 0.0_dp
10681 1353134 : kbc(1:7*mc_max) = 0.0_dp
10682 186008 : kad(1:1*md_max) = 0.0_dp
10683 229760 : kac(1:1*mc_max) = 0.0_dp
10684 : p_index = 0
10685 186008 : DO md = 1, md_max
10686 822712 : DO mc = 1, mc_max
10687 5237109 : DO mb = 1, 7
10688 4456928 : ks_bd = 0.0_dp
10689 4456928 : ks_bc = 0.0_dp
10690 4456928 : p_bd = pbd((md - 1)*7 + mb)
10691 4456928 : p_bc = pbc((mc - 1)*7 + mb)
10692 8913856 : DO ma = 1, 1
10693 4456928 : p_index = p_index + 1
10694 4456928 : tmp = scale*prim(p_index)
10695 4456928 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10696 4456928 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10697 4456928 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10698 8913856 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10699 : END DO
10700 4456928 : kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
10701 5093632 : kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
10702 : END DO
10703 : END DO
10704 : END DO
10705 42531 : END SUBROUTINE block_1_7
10706 : ! **************************************************************************************************
10707 : !> \brief ...
10708 : !> \param kbd ...
10709 : !> \param kbc ...
10710 : !> \param kad ...
10711 : !> \param kac ...
10712 : !> \param pbd ...
10713 : !> \param pbc ...
10714 : !> \param pad ...
10715 : !> \param pac ...
10716 : !> \param prim ...
10717 : !> \param scale ...
10718 : ! **************************************************************************************************
10719 5 : SUBROUTINE block_1_9_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10720 : REAL(KIND=dp) :: kbd(9*1), kbc(9*1), kad(1*1), kac(1*1), &
10721 : pbd(9*1), pbc(9*1), pad(1*1), &
10722 : pac(1*1), prim(1*9*1*1), scale
10723 :
10724 : INTEGER :: ma, mb, mc, md, p_index
10725 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10726 :
10727 5 : kbd(1:9*1) = 0.0_dp
10728 5 : kbc(1:9*1) = 0.0_dp
10729 5 : kad(1:1*1) = 0.0_dp
10730 5 : kac(1:1*1) = 0.0_dp
10731 5 : p_index = 0
10732 10 : DO md = 1, 1
10733 15 : DO mc = 1, 1
10734 55 : DO mb = 1, 9
10735 45 : ks_bd = 0.0_dp
10736 45 : ks_bc = 0.0_dp
10737 45 : p_bd = pbd((md - 1)*9 + mb)
10738 45 : p_bc = pbc((mc - 1)*9 + mb)
10739 90 : DO ma = 1, 1
10740 45 : p_index = p_index + 1
10741 45 : tmp = scale*prim(p_index)
10742 45 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10743 45 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10744 45 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10745 90 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10746 : END DO
10747 45 : kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
10748 50 : kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
10749 : END DO
10750 : END DO
10751 : END DO
10752 5 : END SUBROUTINE block_1_9_1_1
10753 : ! **************************************************************************************************
10754 : !> \brief ...
10755 : !> \param kbd ...
10756 : !> \param kbc ...
10757 : !> \param kad ...
10758 : !> \param kac ...
10759 : !> \param pbd ...
10760 : !> \param pbc ...
10761 : !> \param pad ...
10762 : !> \param pac ...
10763 : !> \param prim ...
10764 : !> \param scale ...
10765 : ! **************************************************************************************************
10766 3 : SUBROUTINE block_1_9_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10767 : REAL(KIND=dp) :: kbd(9*2), kbc(9*1), kad(1*2), kac(1*1), &
10768 : pbd(9*2), pbc(9*1), pad(1*2), &
10769 : pac(1*1), prim(1*9*1*2), scale
10770 :
10771 : INTEGER :: ma, mb, mc, md, p_index
10772 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10773 :
10774 3 : kbd(1:9*2) = 0.0_dp
10775 3 : kbc(1:9*1) = 0.0_dp
10776 3 : kad(1:1*2) = 0.0_dp
10777 3 : kac(1:1*1) = 0.0_dp
10778 3 : p_index = 0
10779 9 : DO md = 1, 2
10780 15 : DO mc = 1, 1
10781 66 : DO mb = 1, 9
10782 54 : ks_bd = 0.0_dp
10783 54 : ks_bc = 0.0_dp
10784 54 : p_bd = pbd((md - 1)*9 + mb)
10785 54 : p_bc = pbc((mc - 1)*9 + mb)
10786 108 : DO ma = 1, 1
10787 54 : p_index = p_index + 1
10788 54 : tmp = scale*prim(p_index)
10789 54 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10790 54 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10791 54 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10792 108 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10793 : END DO
10794 54 : kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
10795 60 : kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
10796 : END DO
10797 : END DO
10798 : END DO
10799 3 : END SUBROUTINE block_1_9_1_2
10800 : ! **************************************************************************************************
10801 : !> \brief ...
10802 : !> \param md_max ...
10803 : !> \param kbd ...
10804 : !> \param kbc ...
10805 : !> \param kad ...
10806 : !> \param kac ...
10807 : !> \param pbd ...
10808 : !> \param pbc ...
10809 : !> \param pad ...
10810 : !> \param pac ...
10811 : !> \param prim ...
10812 : !> \param scale ...
10813 : ! **************************************************************************************************
10814 21 : SUBROUTINE block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10815 : INTEGER :: md_max
10816 : REAL(KIND=dp) :: kbd(9*md_max), kbc(9*1), kad(1*md_max), kac(1*1), pbd(9*md_max), pbc(9*1), &
10817 : pad(1*md_max), pac(1*1), prim(1*9*1*md_max), scale
10818 :
10819 : INTEGER :: ma, mb, mc, md, p_index
10820 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10821 :
10822 1416 : kbd(1:9*md_max) = 0.0_dp
10823 21 : kbc(1:9*1) = 0.0_dp
10824 176 : kad(1:1*md_max) = 0.0_dp
10825 21 : kac(1:1*1) = 0.0_dp
10826 21 : p_index = 0
10827 176 : DO md = 1, md_max
10828 331 : DO mc = 1, 1
10829 1705 : DO mb = 1, 9
10830 1395 : ks_bd = 0.0_dp
10831 1395 : ks_bc = 0.0_dp
10832 1395 : p_bd = pbd((md - 1)*9 + mb)
10833 1395 : p_bc = pbc((mc - 1)*9 + mb)
10834 2790 : DO ma = 1, 1
10835 1395 : p_index = p_index + 1
10836 1395 : tmp = scale*prim(p_index)
10837 1395 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10838 1395 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10839 1395 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10840 2790 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10841 : END DO
10842 1395 : kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
10843 1550 : kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
10844 : END DO
10845 : END DO
10846 : END DO
10847 21 : END SUBROUTINE block_1_9_1
10848 : ! **************************************************************************************************
10849 : !> \brief ...
10850 : !> \param kbd ...
10851 : !> \param kbc ...
10852 : !> \param kad ...
10853 : !> \param kac ...
10854 : !> \param pbd ...
10855 : !> \param pbc ...
10856 : !> \param pad ...
10857 : !> \param pac ...
10858 : !> \param prim ...
10859 : !> \param scale ...
10860 : ! **************************************************************************************************
10861 0 : SUBROUTINE block_1_9_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10862 : REAL(KIND=dp) :: kbd(9*1), kbc(9*2), kad(1*1), kac(1*2), &
10863 : pbd(9*1), pbc(9*2), pad(1*1), &
10864 : pac(1*2), prim(1*9*2*1), scale
10865 :
10866 : INTEGER :: ma, mb, mc, md, p_index
10867 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10868 :
10869 0 : kbd(1:9*1) = 0.0_dp
10870 0 : kbc(1:9*2) = 0.0_dp
10871 0 : kad(1:1*1) = 0.0_dp
10872 0 : kac(1:1*2) = 0.0_dp
10873 0 : p_index = 0
10874 0 : DO md = 1, 1
10875 0 : DO mc = 1, 2
10876 0 : DO mb = 1, 9
10877 0 : ks_bd = 0.0_dp
10878 0 : ks_bc = 0.0_dp
10879 0 : p_bd = pbd((md - 1)*9 + mb)
10880 0 : p_bc = pbc((mc - 1)*9 + mb)
10881 0 : DO ma = 1, 1
10882 0 : p_index = p_index + 1
10883 0 : tmp = scale*prim(p_index)
10884 0 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10885 0 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10886 0 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10887 0 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10888 : END DO
10889 0 : kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
10890 0 : kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
10891 : END DO
10892 : END DO
10893 : END DO
10894 0 : END SUBROUTINE block_1_9_2_1
10895 : ! **************************************************************************************************
10896 : !> \brief ...
10897 : !> \param md_max ...
10898 : !> \param kbd ...
10899 : !> \param kbc ...
10900 : !> \param kad ...
10901 : !> \param kac ...
10902 : !> \param pbd ...
10903 : !> \param pbc ...
10904 : !> \param pad ...
10905 : !> \param pac ...
10906 : !> \param prim ...
10907 : !> \param scale ...
10908 : ! **************************************************************************************************
10909 13 : SUBROUTINE block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10910 : INTEGER :: md_max
10911 : REAL(KIND=dp) :: kbd(9*md_max), kbc(9*2), kad(1*md_max), kac(1*2), pbd(9*md_max), pbc(9*2), &
10912 : pad(1*md_max), pac(1*2), prim(1*9*2*md_max), scale
10913 :
10914 : INTEGER :: ma, mb, mc, md, p_index
10915 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10916 :
10917 553 : kbd(1:9*md_max) = 0.0_dp
10918 13 : kbc(1:9*2) = 0.0_dp
10919 73 : kad(1:1*md_max) = 0.0_dp
10920 13 : kac(1:1*2) = 0.0_dp
10921 13 : p_index = 0
10922 73 : DO md = 1, md_max
10923 193 : DO mc = 1, 2
10924 1260 : DO mb = 1, 9
10925 1080 : ks_bd = 0.0_dp
10926 1080 : ks_bc = 0.0_dp
10927 1080 : p_bd = pbd((md - 1)*9 + mb)
10928 1080 : p_bc = pbc((mc - 1)*9 + mb)
10929 2160 : DO ma = 1, 1
10930 1080 : p_index = p_index + 1
10931 1080 : tmp = scale*prim(p_index)
10932 1080 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10933 1080 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10934 1080 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10935 2160 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10936 : END DO
10937 1080 : kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
10938 1200 : kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
10939 : END DO
10940 : END DO
10941 : END DO
10942 13 : END SUBROUTINE block_1_9_2
10943 : ! **************************************************************************************************
10944 : !> \brief ...
10945 : !> \param mc_max ...
10946 : !> \param md_max ...
10947 : !> \param kbd ...
10948 : !> \param kbc ...
10949 : !> \param kad ...
10950 : !> \param kac ...
10951 : !> \param pbd ...
10952 : !> \param pbc ...
10953 : !> \param pad ...
10954 : !> \param pac ...
10955 : !> \param prim ...
10956 : !> \param scale ...
10957 : ! **************************************************************************************************
10958 74 : SUBROUTINE block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
10959 : INTEGER :: mc_max, md_max
10960 : REAL(KIND=dp) :: kbd(9*md_max), kbc(9*mc_max), kad(1*md_max), kac(1*mc_max), pbd(9*md_max), &
10961 : pbc(9*mc_max), pad(1*md_max), pac(1*mc_max), prim(1*9*mc_max*md_max), scale
10962 :
10963 : INTEGER :: ma, mb, mc, md, p_index
10964 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
10965 :
10966 5069 : kbd(1:9*md_max) = 0.0_dp
10967 4970 : kbc(1:9*mc_max) = 0.0_dp
10968 629 : kad(1:1*md_max) = 0.0_dp
10969 618 : kac(1:1*mc_max) = 0.0_dp
10970 : p_index = 0
10971 629 : DO md = 1, md_max
10972 5248 : DO mc = 1, mc_max
10973 46745 : DO mb = 1, 9
10974 41571 : ks_bd = 0.0_dp
10975 41571 : ks_bc = 0.0_dp
10976 41571 : p_bd = pbd((md - 1)*9 + mb)
10977 41571 : p_bc = pbc((mc - 1)*9 + mb)
10978 83142 : DO ma = 1, 1
10979 41571 : p_index = p_index + 1
10980 41571 : tmp = scale*prim(p_index)
10981 41571 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10982 41571 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10983 41571 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10984 83142 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10985 : END DO
10986 41571 : kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
10987 46190 : kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
10988 : END DO
10989 : END DO
10990 : END DO
10991 74 : END SUBROUTINE block_1_9
10992 : ! **************************************************************************************************
10993 : !> \brief ...
10994 : !> \param kbd ...
10995 : !> \param kbc ...
10996 : !> \param kad ...
10997 : !> \param kac ...
10998 : !> \param pbd ...
10999 : !> \param pbc ...
11000 : !> \param pad ...
11001 : !> \param pac ...
11002 : !> \param prim ...
11003 : !> \param scale ...
11004 : ! **************************************************************************************************
11005 9 : SUBROUTINE block_1_10_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11006 : REAL(KIND=dp) :: kbd(10*1), kbc(10*1), kad(1*1), &
11007 : kac(1*1), pbd(10*1), pbc(10*1), &
11008 : pad(1*1), pac(1*1), prim(1*10*1*1), &
11009 : scale
11010 :
11011 : INTEGER :: ma, mb, mc, md, p_index
11012 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11013 :
11014 9 : kbd(1:10*1) = 0.0_dp
11015 9 : kbc(1:10*1) = 0.0_dp
11016 9 : kad(1:1*1) = 0.0_dp
11017 9 : kac(1:1*1) = 0.0_dp
11018 9 : p_index = 0
11019 18 : DO md = 1, 1
11020 27 : DO mc = 1, 1
11021 108 : DO mb = 1, 10
11022 90 : ks_bd = 0.0_dp
11023 90 : ks_bc = 0.0_dp
11024 90 : p_bd = pbd((md - 1)*10 + mb)
11025 90 : p_bc = pbc((mc - 1)*10 + mb)
11026 180 : DO ma = 1, 1
11027 90 : p_index = p_index + 1
11028 90 : tmp = scale*prim(p_index)
11029 90 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
11030 90 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
11031 90 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
11032 180 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
11033 : END DO
11034 90 : kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
11035 99 : kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
11036 : END DO
11037 : END DO
11038 : END DO
11039 9 : END SUBROUTINE block_1_10_1_1
11040 : ! **************************************************************************************************
11041 : !> \brief ...
11042 : !> \param md_max ...
11043 : !> \param kbd ...
11044 : !> \param kbc ...
11045 : !> \param kad ...
11046 : !> \param kac ...
11047 : !> \param pbd ...
11048 : !> \param pbc ...
11049 : !> \param pad ...
11050 : !> \param pac ...
11051 : !> \param prim ...
11052 : !> \param scale ...
11053 : ! **************************************************************************************************
11054 37 : SUBROUTINE block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11055 : INTEGER :: md_max
11056 : REAL(KIND=dp) :: kbd(10*md_max), kbc(10*1), kad(1*md_max), kac(1*1), pbd(10*md_max), &
11057 : pbc(10*1), pad(1*md_max), pac(1*1), prim(1*10*1*md_max), scale
11058 :
11059 : INTEGER :: ma, mb, mc, md, p_index
11060 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11061 :
11062 2777 : kbd(1:10*md_max) = 0.0_dp
11063 37 : kbc(1:10*1) = 0.0_dp
11064 311 : kad(1:1*md_max) = 0.0_dp
11065 37 : kac(1:1*1) = 0.0_dp
11066 37 : p_index = 0
11067 311 : DO md = 1, md_max
11068 585 : DO mc = 1, 1
11069 3288 : DO mb = 1, 10
11070 2740 : ks_bd = 0.0_dp
11071 2740 : ks_bc = 0.0_dp
11072 2740 : p_bd = pbd((md - 1)*10 + mb)
11073 2740 : p_bc = pbc((mc - 1)*10 + mb)
11074 5480 : DO ma = 1, 1
11075 2740 : p_index = p_index + 1
11076 2740 : tmp = scale*prim(p_index)
11077 2740 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
11078 2740 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
11079 2740 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
11080 5480 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
11081 : END DO
11082 2740 : kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
11083 3014 : kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
11084 : END DO
11085 : END DO
11086 : END DO
11087 37 : END SUBROUTINE block_1_10_1
11088 : ! **************************************************************************************************
11089 : !> \brief ...
11090 : !> \param mc_max ...
11091 : !> \param md_max ...
11092 : !> \param kbd ...
11093 : !> \param kbc ...
11094 : !> \param kad ...
11095 : !> \param kac ...
11096 : !> \param pbd ...
11097 : !> \param pbc ...
11098 : !> \param pad ...
11099 : !> \param pac ...
11100 : !> \param prim ...
11101 : !> \param scale ...
11102 : ! **************************************************************************************************
11103 175 : SUBROUTINE block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11104 : INTEGER :: mc_max, md_max
11105 : REAL(KIND=dp) :: kbd(10*md_max), kbc(10*mc_max), kad(1*md_max), kac(1*mc_max), &
11106 : pbd(10*md_max), pbc(10*mc_max), pad(1*md_max), pac(1*mc_max), prim(1*10*mc_max*md_max), &
11107 : scale
11108 :
11109 : INTEGER :: ma, mb, mc, md, p_index
11110 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11111 :
11112 12895 : kbd(1:10*md_max) = 0.0_dp
11113 10475 : kbc(1:10*mc_max) = 0.0_dp
11114 1447 : kad(1:1*md_max) = 0.0_dp
11115 1205 : kac(1:1*mc_max) = 0.0_dp
11116 : p_index = 0
11117 1447 : DO md = 1, md_max
11118 9738 : DO mc = 1, mc_max
11119 92473 : DO mb = 1, 10
11120 82910 : ks_bd = 0.0_dp
11121 82910 : ks_bc = 0.0_dp
11122 82910 : p_bd = pbd((md - 1)*10 + mb)
11123 82910 : p_bc = pbc((mc - 1)*10 + mb)
11124 165820 : DO ma = 1, 1
11125 82910 : p_index = p_index + 1
11126 82910 : tmp = scale*prim(p_index)
11127 82910 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
11128 82910 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
11129 82910 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
11130 165820 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
11131 : END DO
11132 82910 : kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
11133 91201 : kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
11134 : END DO
11135 : END DO
11136 : END DO
11137 175 : END SUBROUTINE block_1_10
11138 : ! **************************************************************************************************
11139 : !> \brief ...
11140 : !> \param kbd ...
11141 : !> \param kbc ...
11142 : !> \param kad ...
11143 : !> \param kac ...
11144 : !> \param pbd ...
11145 : !> \param pbc ...
11146 : !> \param pad ...
11147 : !> \param pac ...
11148 : !> \param prim ...
11149 : !> \param scale ...
11150 : ! **************************************************************************************************
11151 9 : SUBROUTINE block_1_11_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11152 : REAL(KIND=dp) :: kbd(11*1), kbc(11*1), kad(1*1), &
11153 : kac(1*1), pbd(11*1), pbc(11*1), &
11154 : pad(1*1), pac(1*1), prim(1*11*1*1), &
11155 : scale
11156 :
11157 : INTEGER :: ma, mb, mc, md, p_index
11158 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11159 :
11160 9 : kbd(1:11*1) = 0.0_dp
11161 9 : kbc(1:11*1) = 0.0_dp
11162 9 : kad(1:1*1) = 0.0_dp
11163 9 : kac(1:1*1) = 0.0_dp
11164 9 : p_index = 0
11165 18 : DO md = 1, 1
11166 27 : DO mc = 1, 1
11167 117 : DO mb = 1, 11
11168 99 : ks_bd = 0.0_dp
11169 99 : ks_bc = 0.0_dp
11170 99 : p_bd = pbd((md - 1)*11 + mb)
11171 99 : p_bc = pbc((mc - 1)*11 + mb)
11172 198 : DO ma = 1, 1
11173 99 : p_index = p_index + 1
11174 99 : tmp = scale*prim(p_index)
11175 99 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
11176 99 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
11177 99 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
11178 198 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
11179 : END DO
11180 99 : kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
11181 108 : kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
11182 : END DO
11183 : END DO
11184 : END DO
11185 9 : END SUBROUTINE block_1_11_1_1
11186 : ! **************************************************************************************************
11187 : !> \brief ...
11188 : !> \param md_max ...
11189 : !> \param kbd ...
11190 : !> \param kbc ...
11191 : !> \param kad ...
11192 : !> \param kac ...
11193 : !> \param pbd ...
11194 : !> \param pbc ...
11195 : !> \param pad ...
11196 : !> \param pac ...
11197 : !> \param prim ...
11198 : !> \param scale ...
11199 : ! **************************************************************************************************
11200 43 : SUBROUTINE block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11201 : INTEGER :: md_max
11202 : REAL(KIND=dp) :: kbd(11*md_max), kbc(11*1), kad(1*md_max), kac(1*1), pbd(11*md_max), &
11203 : pbc(11*1), pad(1*md_max), pac(1*1), prim(1*11*1*md_max), scale
11204 :
11205 : INTEGER :: ma, mb, mc, md, p_index
11206 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11207 :
11208 3816 : kbd(1:11*md_max) = 0.0_dp
11209 43 : kbc(1:11*1) = 0.0_dp
11210 386 : kad(1:1*md_max) = 0.0_dp
11211 43 : kac(1:1*1) = 0.0_dp
11212 43 : p_index = 0
11213 386 : DO md = 1, md_max
11214 729 : DO mc = 1, 1
11215 4459 : DO mb = 1, 11
11216 3773 : ks_bd = 0.0_dp
11217 3773 : ks_bc = 0.0_dp
11218 3773 : p_bd = pbd((md - 1)*11 + mb)
11219 3773 : p_bc = pbc((mc - 1)*11 + mb)
11220 7546 : DO ma = 1, 1
11221 3773 : p_index = p_index + 1
11222 3773 : tmp = scale*prim(p_index)
11223 3773 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
11224 3773 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
11225 3773 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
11226 7546 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
11227 : END DO
11228 3773 : kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
11229 4116 : kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
11230 : END DO
11231 : END DO
11232 : END DO
11233 43 : END SUBROUTINE block_1_11_1
11234 : ! **************************************************************************************************
11235 : !> \brief ...
11236 : !> \param mc_max ...
11237 : !> \param md_max ...
11238 : !> \param kbd ...
11239 : !> \param kbc ...
11240 : !> \param kad ...
11241 : !> \param kac ...
11242 : !> \param pbd ...
11243 : !> \param pbc ...
11244 : !> \param pad ...
11245 : !> \param pac ...
11246 : !> \param prim ...
11247 : !> \param scale ...
11248 : ! **************************************************************************************************
11249 203 : SUBROUTINE block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11250 : INTEGER :: mc_max, md_max
11251 : REAL(KIND=dp) :: kbd(11*md_max), kbc(11*mc_max), kad(1*md_max), kac(1*mc_max), &
11252 : pbd(11*md_max), pbc(11*mc_max), pad(1*md_max), pac(1*mc_max), prim(1*11*mc_max*md_max), &
11253 : scale
11254 :
11255 : INTEGER :: ma, mb, mc, md, p_index
11256 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11257 :
11258 16802 : kbd(1:11*md_max) = 0.0_dp
11259 13205 : kbc(1:11*mc_max) = 0.0_dp
11260 1712 : kad(1:1*md_max) = 0.0_dp
11261 1385 : kac(1:1*mc_max) = 0.0_dp
11262 : p_index = 0
11263 1712 : DO md = 1, md_max
11264 11319 : DO mc = 1, mc_max
11265 116793 : DO mb = 1, 11
11266 105677 : ks_bd = 0.0_dp
11267 105677 : ks_bc = 0.0_dp
11268 105677 : p_bd = pbd((md - 1)*11 + mb)
11269 105677 : p_bc = pbc((mc - 1)*11 + mb)
11270 211354 : DO ma = 1, 1
11271 105677 : p_index = p_index + 1
11272 105677 : tmp = scale*prim(p_index)
11273 105677 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
11274 105677 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
11275 105677 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
11276 211354 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
11277 : END DO
11278 105677 : kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
11279 115284 : kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
11280 : END DO
11281 : END DO
11282 : END DO
11283 203 : END SUBROUTINE block_1_11
11284 : ! **************************************************************************************************
11285 : !> \brief ...
11286 : !> \param kbd ...
11287 : !> \param kbc ...
11288 : !> \param kad ...
11289 : !> \param kac ...
11290 : !> \param pbd ...
11291 : !> \param pbc ...
11292 : !> \param pad ...
11293 : !> \param pac ...
11294 : !> \param prim ...
11295 : !> \param scale ...
11296 : ! **************************************************************************************************
11297 5 : SUBROUTINE block_1_15_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11298 : REAL(KIND=dp) :: kbd(15*1), kbc(15*1), kad(1*1), &
11299 : kac(1*1), pbd(15*1), pbc(15*1), &
11300 : pad(1*1), pac(1*1), prim(1*15*1*1), &
11301 : scale
11302 :
11303 : INTEGER :: ma, mb, mc, md, p_index
11304 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11305 :
11306 5 : kbd(1:15*1) = 0.0_dp
11307 5 : kbc(1:15*1) = 0.0_dp
11308 5 : kad(1:1*1) = 0.0_dp
11309 5 : kac(1:1*1) = 0.0_dp
11310 5 : p_index = 0
11311 10 : DO md = 1, 1
11312 15 : DO mc = 1, 1
11313 85 : DO mb = 1, 15
11314 75 : ks_bd = 0.0_dp
11315 75 : ks_bc = 0.0_dp
11316 75 : p_bd = pbd((md - 1)*15 + mb)
11317 75 : p_bc = pbc((mc - 1)*15 + mb)
11318 150 : DO ma = 1, 1
11319 75 : p_index = p_index + 1
11320 75 : tmp = scale*prim(p_index)
11321 75 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
11322 75 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
11323 75 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
11324 150 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
11325 : END DO
11326 75 : kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
11327 80 : kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
11328 : END DO
11329 : END DO
11330 : END DO
11331 5 : END SUBROUTINE block_1_15_1_1
11332 : ! **************************************************************************************************
11333 : !> \brief ...
11334 : !> \param md_max ...
11335 : !> \param kbd ...
11336 : !> \param kbc ...
11337 : !> \param kad ...
11338 : !> \param kac ...
11339 : !> \param pbd ...
11340 : !> \param pbc ...
11341 : !> \param pad ...
11342 : !> \param pac ...
11343 : !> \param prim ...
11344 : !> \param scale ...
11345 : ! **************************************************************************************************
11346 31 : SUBROUTINE block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11347 : INTEGER :: md_max
11348 : REAL(KIND=dp) :: kbd(15*md_max), kbc(15*1), kad(1*md_max), kac(1*1), pbd(15*md_max), &
11349 : pbc(15*1), pad(1*md_max), pac(1*1), prim(1*15*1*md_max), scale
11350 :
11351 : INTEGER :: ma, mb, mc, md, p_index
11352 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11353 :
11354 3691 : kbd(1:15*md_max) = 0.0_dp
11355 31 : kbc(1:15*1) = 0.0_dp
11356 275 : kad(1:1*md_max) = 0.0_dp
11357 31 : kac(1:1*1) = 0.0_dp
11358 31 : p_index = 0
11359 275 : DO md = 1, md_max
11360 519 : DO mc = 1, 1
11361 4148 : DO mb = 1, 15
11362 3660 : ks_bd = 0.0_dp
11363 3660 : ks_bc = 0.0_dp
11364 3660 : p_bd = pbd((md - 1)*15 + mb)
11365 3660 : p_bc = pbc((mc - 1)*15 + mb)
11366 7320 : DO ma = 1, 1
11367 3660 : p_index = p_index + 1
11368 3660 : tmp = scale*prim(p_index)
11369 3660 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
11370 3660 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
11371 3660 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
11372 7320 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
11373 : END DO
11374 3660 : kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
11375 3904 : kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
11376 : END DO
11377 : END DO
11378 : END DO
11379 31 : END SUBROUTINE block_1_15_1
11380 : ! **************************************************************************************************
11381 : !> \brief ...
11382 : !> \param mc_max ...
11383 : !> \param md_max ...
11384 : !> \param kbd ...
11385 : !> \param kbc ...
11386 : !> \param kad ...
11387 : !> \param kac ...
11388 : !> \param pbd ...
11389 : !> \param pbc ...
11390 : !> \param pad ...
11391 : !> \param pac ...
11392 : !> \param prim ...
11393 : !> \param scale ...
11394 : ! **************************************************************************************************
11395 127 : SUBROUTINE block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11396 : INTEGER :: mc_max, md_max
11397 : REAL(KIND=dp) :: kbd(15*md_max), kbc(15*mc_max), kad(1*md_max), kac(1*mc_max), &
11398 : pbd(15*md_max), pbc(15*mc_max), pad(1*md_max), pac(1*mc_max), prim(1*15*mc_max*md_max), &
11399 : scale
11400 :
11401 : INTEGER :: ma, mb, mc, md, p_index
11402 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11403 :
11404 14062 : kbd(1:15*md_max) = 0.0_dp
11405 11812 : kbc(1:15*mc_max) = 0.0_dp
11406 1056 : kad(1:1*md_max) = 0.0_dp
11407 906 : kac(1:1*mc_max) = 0.0_dp
11408 : p_index = 0
11409 1056 : DO md = 1, md_max
11410 7416 : DO mc = 1, mc_max
11411 102689 : DO mb = 1, 15
11412 95400 : ks_bd = 0.0_dp
11413 95400 : ks_bc = 0.0_dp
11414 95400 : p_bd = pbd((md - 1)*15 + mb)
11415 95400 : p_bc = pbc((mc - 1)*15 + mb)
11416 190800 : DO ma = 1, 1
11417 95400 : p_index = p_index + 1
11418 95400 : tmp = scale*prim(p_index)
11419 95400 : ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
11420 95400 : ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
11421 95400 : kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
11422 190800 : kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
11423 : END DO
11424 95400 : kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
11425 101760 : kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
11426 : END DO
11427 : END DO
11428 : END DO
11429 127 : END SUBROUTINE block_1_15
11430 : ! **************************************************************************************************
11431 : !> \brief ...
11432 : !> \param kbd ...
11433 : !> \param kbc ...
11434 : !> \param kad ...
11435 : !> \param kac ...
11436 : !> \param pbd ...
11437 : !> \param pbc ...
11438 : !> \param pad ...
11439 : !> \param pac ...
11440 : !> \param prim ...
11441 : !> \param scale ...
11442 : ! **************************************************************************************************
11443 14170 : SUBROUTINE block_2_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11444 : REAL(KIND=dp) :: kbd(1*1), kbc(1*1), kad(2*1), kac(2*1), &
11445 : pbd(1*1), pbc(1*1), pad(2*1), &
11446 : pac(2*1), prim(2*1*1*1), scale
11447 :
11448 : INTEGER :: ma, mb, mc, md, p_index
11449 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11450 :
11451 14170 : kbd(1:1*1) = 0.0_dp
11452 14170 : kbc(1:1*1) = 0.0_dp
11453 14170 : kad(1:2*1) = 0.0_dp
11454 14170 : kac(1:2*1) = 0.0_dp
11455 14170 : p_index = 0
11456 28340 : DO md = 1, 1
11457 42510 : DO mc = 1, 1
11458 42510 : DO mb = 1, 1
11459 14170 : ks_bd = 0.0_dp
11460 14170 : ks_bc = 0.0_dp
11461 14170 : p_bd = pbd((md - 1)*1 + mb)
11462 14170 : p_bc = pbc((mc - 1)*1 + mb)
11463 42510 : DO ma = 1, 2
11464 28340 : p_index = p_index + 1
11465 28340 : tmp = scale*prim(p_index)
11466 28340 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11467 28340 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11468 28340 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11469 42510 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11470 : END DO
11471 14170 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11472 28340 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11473 : END DO
11474 : END DO
11475 : END DO
11476 14170 : END SUBROUTINE block_2_1_1_1
11477 : ! **************************************************************************************************
11478 : !> \brief ...
11479 : !> \param kbd ...
11480 : !> \param kbc ...
11481 : !> \param kad ...
11482 : !> \param kac ...
11483 : !> \param pbd ...
11484 : !> \param pbc ...
11485 : !> \param pad ...
11486 : !> \param pac ...
11487 : !> \param prim ...
11488 : !> \param scale ...
11489 : ! **************************************************************************************************
11490 1913 : SUBROUTINE block_2_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11491 : REAL(KIND=dp) :: kbd(1*2), kbc(1*1), kad(2*2), kac(2*1), &
11492 : pbd(1*2), pbc(1*1), pad(2*2), &
11493 : pac(2*1), prim(2*1*1*2), scale
11494 :
11495 : INTEGER :: ma, mb, mc, md, p_index
11496 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11497 :
11498 1913 : kbd(1:1*2) = 0.0_dp
11499 1913 : kbc(1:1*1) = 0.0_dp
11500 1913 : kad(1:2*2) = 0.0_dp
11501 1913 : kac(1:2*1) = 0.0_dp
11502 1913 : p_index = 0
11503 5739 : DO md = 1, 2
11504 9565 : DO mc = 1, 1
11505 11478 : DO mb = 1, 1
11506 3826 : ks_bd = 0.0_dp
11507 3826 : ks_bc = 0.0_dp
11508 3826 : p_bd = pbd((md - 1)*1 + mb)
11509 3826 : p_bc = pbc((mc - 1)*1 + mb)
11510 11478 : DO ma = 1, 2
11511 7652 : p_index = p_index + 1
11512 7652 : tmp = scale*prim(p_index)
11513 7652 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11514 7652 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11515 7652 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11516 11478 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11517 : END DO
11518 3826 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11519 7652 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11520 : END DO
11521 : END DO
11522 : END DO
11523 1913 : END SUBROUTINE block_2_1_1_2
11524 : ! **************************************************************************************************
11525 : !> \brief ...
11526 : !> \param kbd ...
11527 : !> \param kbc ...
11528 : !> \param kad ...
11529 : !> \param kac ...
11530 : !> \param pbd ...
11531 : !> \param pbc ...
11532 : !> \param pad ...
11533 : !> \param pac ...
11534 : !> \param prim ...
11535 : !> \param scale ...
11536 : ! **************************************************************************************************
11537 12668 : SUBROUTINE block_2_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11538 : REAL(KIND=dp) :: kbd(1*3), kbc(1*1), kad(2*3), kac(2*1), &
11539 : pbd(1*3), pbc(1*1), pad(2*3), &
11540 : pac(2*1), prim(2*1*1*3), scale
11541 :
11542 : INTEGER :: ma, mb, mc, md, p_index
11543 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11544 :
11545 12668 : kbd(1:1*3) = 0.0_dp
11546 12668 : kbc(1:1*1) = 0.0_dp
11547 12668 : kad(1:2*3) = 0.0_dp
11548 12668 : kac(1:2*1) = 0.0_dp
11549 12668 : p_index = 0
11550 50672 : DO md = 1, 3
11551 88676 : DO mc = 1, 1
11552 114012 : DO mb = 1, 1
11553 38004 : ks_bd = 0.0_dp
11554 38004 : ks_bc = 0.0_dp
11555 38004 : p_bd = pbd((md - 1)*1 + mb)
11556 38004 : p_bc = pbc((mc - 1)*1 + mb)
11557 114012 : DO ma = 1, 2
11558 76008 : p_index = p_index + 1
11559 76008 : tmp = scale*prim(p_index)
11560 76008 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11561 76008 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11562 76008 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11563 114012 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11564 : END DO
11565 38004 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11566 76008 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11567 : END DO
11568 : END DO
11569 : END DO
11570 12668 : END SUBROUTINE block_2_1_1_3
11571 : ! **************************************************************************************************
11572 : !> \brief ...
11573 : !> \param kbd ...
11574 : !> \param kbc ...
11575 : !> \param kad ...
11576 : !> \param kac ...
11577 : !> \param pbd ...
11578 : !> \param pbc ...
11579 : !> \param pad ...
11580 : !> \param pac ...
11581 : !> \param prim ...
11582 : !> \param scale ...
11583 : ! **************************************************************************************************
11584 4 : SUBROUTINE block_2_1_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11585 : REAL(KIND=dp) :: kbd(1*4), kbc(1*1), kad(2*4), kac(2*1), &
11586 : pbd(1*4), pbc(1*1), pad(2*4), &
11587 : pac(2*1), prim(2*1*1*4), scale
11588 :
11589 : INTEGER :: ma, mb, mc, md, p_index
11590 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11591 :
11592 4 : kbd(1:1*4) = 0.0_dp
11593 4 : kbc(1:1*1) = 0.0_dp
11594 4 : kad(1:2*4) = 0.0_dp
11595 4 : kac(1:2*1) = 0.0_dp
11596 4 : p_index = 0
11597 20 : DO md = 1, 4
11598 36 : DO mc = 1, 1
11599 48 : DO mb = 1, 1
11600 16 : ks_bd = 0.0_dp
11601 16 : ks_bc = 0.0_dp
11602 16 : p_bd = pbd((md - 1)*1 + mb)
11603 16 : p_bc = pbc((mc - 1)*1 + mb)
11604 48 : DO ma = 1, 2
11605 32 : p_index = p_index + 1
11606 32 : tmp = scale*prim(p_index)
11607 32 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11608 32 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11609 32 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11610 48 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11611 : END DO
11612 16 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11613 32 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11614 : END DO
11615 : END DO
11616 : END DO
11617 4 : END SUBROUTINE block_2_1_1_4
11618 : ! **************************************************************************************************
11619 : !> \brief ...
11620 : !> \param kbd ...
11621 : !> \param kbc ...
11622 : !> \param kad ...
11623 : !> \param kac ...
11624 : !> \param pbd ...
11625 : !> \param pbc ...
11626 : !> \param pad ...
11627 : !> \param pac ...
11628 : !> \param prim ...
11629 : !> \param scale ...
11630 : ! **************************************************************************************************
11631 4061 : SUBROUTINE block_2_1_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11632 : REAL(KIND=dp) :: kbd(1*5), kbc(1*1), kad(2*5), kac(2*1), &
11633 : pbd(1*5), pbc(1*1), pad(2*5), &
11634 : pac(2*1), prim(2*1*1*5), scale
11635 :
11636 : INTEGER :: ma, mb, mc, md, p_index
11637 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11638 :
11639 4061 : kbd(1:1*5) = 0.0_dp
11640 4061 : kbc(1:1*1) = 0.0_dp
11641 4061 : kad(1:2*5) = 0.0_dp
11642 4061 : kac(1:2*1) = 0.0_dp
11643 4061 : p_index = 0
11644 24366 : DO md = 1, 5
11645 44671 : DO mc = 1, 1
11646 60915 : DO mb = 1, 1
11647 20305 : ks_bd = 0.0_dp
11648 20305 : ks_bc = 0.0_dp
11649 20305 : p_bd = pbd((md - 1)*1 + mb)
11650 20305 : p_bc = pbc((mc - 1)*1 + mb)
11651 60915 : DO ma = 1, 2
11652 40610 : p_index = p_index + 1
11653 40610 : tmp = scale*prim(p_index)
11654 40610 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11655 40610 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11656 40610 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11657 60915 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11658 : END DO
11659 20305 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11660 40610 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11661 : END DO
11662 : END DO
11663 : END DO
11664 4061 : END SUBROUTINE block_2_1_1_5
11665 : ! **************************************************************************************************
11666 : !> \brief ...
11667 : !> \param kbd ...
11668 : !> \param kbc ...
11669 : !> \param kad ...
11670 : !> \param kac ...
11671 : !> \param pbd ...
11672 : !> \param pbc ...
11673 : !> \param pad ...
11674 : !> \param pac ...
11675 : !> \param prim ...
11676 : !> \param scale ...
11677 : ! **************************************************************************************************
11678 5 : SUBROUTINE block_2_1_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11679 : REAL(KIND=dp) :: kbd(1*6), kbc(1*1), kad(2*6), kac(2*1), &
11680 : pbd(1*6), pbc(1*1), pad(2*6), &
11681 : pac(2*1), prim(2*1*1*6), scale
11682 :
11683 : INTEGER :: ma, mb, mc, md, p_index
11684 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11685 :
11686 5 : kbd(1:1*6) = 0.0_dp
11687 5 : kbc(1:1*1) = 0.0_dp
11688 5 : kad(1:2*6) = 0.0_dp
11689 5 : kac(1:2*1) = 0.0_dp
11690 5 : p_index = 0
11691 35 : DO md = 1, 6
11692 65 : DO mc = 1, 1
11693 90 : DO mb = 1, 1
11694 30 : ks_bd = 0.0_dp
11695 30 : ks_bc = 0.0_dp
11696 30 : p_bd = pbd((md - 1)*1 + mb)
11697 30 : p_bc = pbc((mc - 1)*1 + mb)
11698 90 : DO ma = 1, 2
11699 60 : p_index = p_index + 1
11700 60 : tmp = scale*prim(p_index)
11701 60 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11702 60 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11703 60 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11704 90 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11705 : END DO
11706 30 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11707 60 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11708 : END DO
11709 : END DO
11710 : END DO
11711 5 : END SUBROUTINE block_2_1_1_6
11712 : ! **************************************************************************************************
11713 : !> \brief ...
11714 : !> \param kbd ...
11715 : !> \param kbc ...
11716 : !> \param kad ...
11717 : !> \param kac ...
11718 : !> \param pbd ...
11719 : !> \param pbc ...
11720 : !> \param pad ...
11721 : !> \param pac ...
11722 : !> \param prim ...
11723 : !> \param scale ...
11724 : ! **************************************************************************************************
11725 716 : SUBROUTINE block_2_1_1_7(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11726 : REAL(KIND=dp) :: kbd(1*7), kbc(1*1), kad(2*7), kac(2*1), &
11727 : pbd(1*7), pbc(1*1), pad(2*7), &
11728 : pac(2*1), prim(2*1*1*7), scale
11729 :
11730 : INTEGER :: ma, mb, mc, md, p_index
11731 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11732 :
11733 716 : kbd(1:1*7) = 0.0_dp
11734 716 : kbc(1:1*1) = 0.0_dp
11735 716 : kad(1:2*7) = 0.0_dp
11736 716 : kac(1:2*1) = 0.0_dp
11737 716 : p_index = 0
11738 5728 : DO md = 1, 7
11739 10740 : DO mc = 1, 1
11740 15036 : DO mb = 1, 1
11741 5012 : ks_bd = 0.0_dp
11742 5012 : ks_bc = 0.0_dp
11743 5012 : p_bd = pbd((md - 1)*1 + mb)
11744 5012 : p_bc = pbc((mc - 1)*1 + mb)
11745 15036 : DO ma = 1, 2
11746 10024 : p_index = p_index + 1
11747 10024 : tmp = scale*prim(p_index)
11748 10024 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11749 10024 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11750 10024 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11751 15036 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11752 : END DO
11753 5012 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11754 10024 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11755 : END DO
11756 : END DO
11757 : END DO
11758 716 : END SUBROUTINE block_2_1_1_7
11759 : ! **************************************************************************************************
11760 : !> \brief ...
11761 : !> \param kbd ...
11762 : !> \param kbc ...
11763 : !> \param kad ...
11764 : !> \param kac ...
11765 : !> \param pbd ...
11766 : !> \param pbc ...
11767 : !> \param pad ...
11768 : !> \param pac ...
11769 : !> \param prim ...
11770 : !> \param scale ...
11771 : ! **************************************************************************************************
11772 4 : SUBROUTINE block_2_1_1_9(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11773 : REAL(KIND=dp) :: kbd(1*9), kbc(1*1), kad(2*9), kac(2*1), &
11774 : pbd(1*9), pbc(1*1), pad(2*9), &
11775 : pac(2*1), prim(2*1*1*9), scale
11776 :
11777 : INTEGER :: ma, mb, mc, md, p_index
11778 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11779 :
11780 4 : kbd(1:1*9) = 0.0_dp
11781 4 : kbc(1:1*1) = 0.0_dp
11782 4 : kad(1:2*9) = 0.0_dp
11783 4 : kac(1:2*1) = 0.0_dp
11784 4 : p_index = 0
11785 40 : DO md = 1, 9
11786 76 : DO mc = 1, 1
11787 108 : DO mb = 1, 1
11788 36 : ks_bd = 0.0_dp
11789 36 : ks_bc = 0.0_dp
11790 36 : p_bd = pbd((md - 1)*1 + mb)
11791 36 : p_bc = pbc((mc - 1)*1 + mb)
11792 108 : DO ma = 1, 2
11793 72 : p_index = p_index + 1
11794 72 : tmp = scale*prim(p_index)
11795 72 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11796 72 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11797 72 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11798 108 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11799 : END DO
11800 36 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11801 72 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11802 : END DO
11803 : END DO
11804 : END DO
11805 4 : END SUBROUTINE block_2_1_1_9
11806 : ! **************************************************************************************************
11807 : !> \brief ...
11808 : !> \param md_max ...
11809 : !> \param kbd ...
11810 : !> \param kbc ...
11811 : !> \param kad ...
11812 : !> \param kac ...
11813 : !> \param pbd ...
11814 : !> \param pbc ...
11815 : !> \param pad ...
11816 : !> \param pac ...
11817 : !> \param prim ...
11818 : !> \param scale ...
11819 : ! **************************************************************************************************
11820 10 : SUBROUTINE block_2_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11821 : INTEGER :: md_max
11822 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*1), kad(2*md_max), kac(2*1), pbd(1*md_max), pbc(1*1), &
11823 : pad(2*md_max), pac(2*1), prim(2*1*1*md_max), scale
11824 :
11825 : INTEGER :: ma, mb, mc, md, p_index
11826 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11827 :
11828 133 : kbd(1:1*md_max) = 0.0_dp
11829 10 : kbc(1:1*1) = 0.0_dp
11830 256 : kad(1:2*md_max) = 0.0_dp
11831 10 : kac(1:2*1) = 0.0_dp
11832 10 : p_index = 0
11833 133 : DO md = 1, md_max
11834 256 : DO mc = 1, 1
11835 369 : DO mb = 1, 1
11836 123 : ks_bd = 0.0_dp
11837 123 : ks_bc = 0.0_dp
11838 123 : p_bd = pbd((md - 1)*1 + mb)
11839 123 : p_bc = pbc((mc - 1)*1 + mb)
11840 369 : DO ma = 1, 2
11841 246 : p_index = p_index + 1
11842 246 : tmp = scale*prim(p_index)
11843 246 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11844 246 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11845 246 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11846 369 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11847 : END DO
11848 123 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11849 246 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11850 : END DO
11851 : END DO
11852 : END DO
11853 10 : END SUBROUTINE block_2_1_1
11854 : ! **************************************************************************************************
11855 : !> \brief ...
11856 : !> \param kbd ...
11857 : !> \param kbc ...
11858 : !> \param kad ...
11859 : !> \param kac ...
11860 : !> \param pbd ...
11861 : !> \param pbc ...
11862 : !> \param pad ...
11863 : !> \param pac ...
11864 : !> \param prim ...
11865 : !> \param scale ...
11866 : ! **************************************************************************************************
11867 4991 : SUBROUTINE block_2_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11868 : REAL(KIND=dp) :: kbd(1*1), kbc(1*2), kad(2*1), kac(2*2), &
11869 : pbd(1*1), pbc(1*2), pad(2*1), &
11870 : pac(2*2), prim(2*1*2*1), scale
11871 :
11872 : INTEGER :: ma, mb, mc, md, p_index
11873 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11874 :
11875 4991 : kbd(1:1*1) = 0.0_dp
11876 4991 : kbc(1:1*2) = 0.0_dp
11877 4991 : kad(1:2*1) = 0.0_dp
11878 4991 : kac(1:2*2) = 0.0_dp
11879 4991 : p_index = 0
11880 9982 : DO md = 1, 1
11881 19964 : DO mc = 1, 2
11882 24955 : DO mb = 1, 1
11883 9982 : ks_bd = 0.0_dp
11884 9982 : ks_bc = 0.0_dp
11885 9982 : p_bd = pbd((md - 1)*1 + mb)
11886 9982 : p_bc = pbc((mc - 1)*1 + mb)
11887 29946 : DO ma = 1, 2
11888 19964 : p_index = p_index + 1
11889 19964 : tmp = scale*prim(p_index)
11890 19964 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11891 19964 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11892 19964 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11893 29946 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11894 : END DO
11895 9982 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11896 19964 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11897 : END DO
11898 : END DO
11899 : END DO
11900 4991 : END SUBROUTINE block_2_1_2_1
11901 : ! **************************************************************************************************
11902 : !> \brief ...
11903 : !> \param kbd ...
11904 : !> \param kbc ...
11905 : !> \param kad ...
11906 : !> \param kac ...
11907 : !> \param pbd ...
11908 : !> \param pbc ...
11909 : !> \param pad ...
11910 : !> \param pac ...
11911 : !> \param prim ...
11912 : !> \param scale ...
11913 : ! **************************************************************************************************
11914 915 : SUBROUTINE block_2_1_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11915 : REAL(KIND=dp) :: kbd(1*2), kbc(1*2), kad(2*2), kac(2*2), &
11916 : pbd(1*2), pbc(1*2), pad(2*2), &
11917 : pac(2*2), prim(2*1*2*2), scale
11918 :
11919 : INTEGER :: ma, mb, mc, md, p_index
11920 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11921 :
11922 915 : kbd(1:1*2) = 0.0_dp
11923 915 : kbc(1:1*2) = 0.0_dp
11924 915 : kad(1:2*2) = 0.0_dp
11925 915 : kac(1:2*2) = 0.0_dp
11926 915 : p_index = 0
11927 2745 : DO md = 1, 2
11928 6405 : DO mc = 1, 2
11929 9150 : DO mb = 1, 1
11930 3660 : ks_bd = 0.0_dp
11931 3660 : ks_bc = 0.0_dp
11932 3660 : p_bd = pbd((md - 1)*1 + mb)
11933 3660 : p_bc = pbc((mc - 1)*1 + mb)
11934 10980 : DO ma = 1, 2
11935 7320 : p_index = p_index + 1
11936 7320 : tmp = scale*prim(p_index)
11937 7320 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11938 7320 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11939 7320 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11940 10980 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11941 : END DO
11942 3660 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11943 7320 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11944 : END DO
11945 : END DO
11946 : END DO
11947 915 : END SUBROUTINE block_2_1_2_2
11948 : ! **************************************************************************************************
11949 : !> \brief ...
11950 : !> \param kbd ...
11951 : !> \param kbc ...
11952 : !> \param kad ...
11953 : !> \param kac ...
11954 : !> \param pbd ...
11955 : !> \param pbc ...
11956 : !> \param pad ...
11957 : !> \param pac ...
11958 : !> \param prim ...
11959 : !> \param scale ...
11960 : ! **************************************************************************************************
11961 4810 : SUBROUTINE block_2_1_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
11962 : REAL(KIND=dp) :: kbd(1*3), kbc(1*2), kad(2*3), kac(2*2), &
11963 : pbd(1*3), pbc(1*2), pad(2*3), &
11964 : pac(2*2), prim(2*1*2*3), scale
11965 :
11966 : INTEGER :: ma, mb, mc, md, p_index
11967 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
11968 :
11969 4810 : kbd(1:1*3) = 0.0_dp
11970 4810 : kbc(1:1*2) = 0.0_dp
11971 4810 : kad(1:2*3) = 0.0_dp
11972 4810 : kac(1:2*2) = 0.0_dp
11973 4810 : p_index = 0
11974 19240 : DO md = 1, 3
11975 48100 : DO mc = 1, 2
11976 72150 : DO mb = 1, 1
11977 28860 : ks_bd = 0.0_dp
11978 28860 : ks_bc = 0.0_dp
11979 28860 : p_bd = pbd((md - 1)*1 + mb)
11980 28860 : p_bc = pbc((mc - 1)*1 + mb)
11981 86580 : DO ma = 1, 2
11982 57720 : p_index = p_index + 1
11983 57720 : tmp = scale*prim(p_index)
11984 57720 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11985 57720 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11986 57720 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11987 86580 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11988 : END DO
11989 28860 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11990 57720 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11991 : END DO
11992 : END DO
11993 : END DO
11994 4810 : END SUBROUTINE block_2_1_2_3
11995 : ! **************************************************************************************************
11996 : !> \brief ...
11997 : !> \param kbd ...
11998 : !> \param kbc ...
11999 : !> \param kad ...
12000 : !> \param kac ...
12001 : !> \param pbd ...
12002 : !> \param pbc ...
12003 : !> \param pad ...
12004 : !> \param pac ...
12005 : !> \param prim ...
12006 : !> \param scale ...
12007 : ! **************************************************************************************************
12008 3 : SUBROUTINE block_2_1_2_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12009 : REAL(KIND=dp) :: kbd(1*4), kbc(1*2), kad(2*4), kac(2*2), &
12010 : pbd(1*4), pbc(1*2), pad(2*4), &
12011 : pac(2*2), prim(2*1*2*4), scale
12012 :
12013 : INTEGER :: ma, mb, mc, md, p_index
12014 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12015 :
12016 3 : kbd(1:1*4) = 0.0_dp
12017 3 : kbc(1:1*2) = 0.0_dp
12018 3 : kad(1:2*4) = 0.0_dp
12019 3 : kac(1:2*2) = 0.0_dp
12020 3 : p_index = 0
12021 15 : DO md = 1, 4
12022 39 : DO mc = 1, 2
12023 60 : DO mb = 1, 1
12024 24 : ks_bd = 0.0_dp
12025 24 : ks_bc = 0.0_dp
12026 24 : p_bd = pbd((md - 1)*1 + mb)
12027 24 : p_bc = pbc((mc - 1)*1 + mb)
12028 72 : DO ma = 1, 2
12029 48 : p_index = p_index + 1
12030 48 : tmp = scale*prim(p_index)
12031 48 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12032 48 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12033 48 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12034 72 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12035 : END DO
12036 24 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12037 48 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12038 : END DO
12039 : END DO
12040 : END DO
12041 3 : END SUBROUTINE block_2_1_2_4
12042 : ! **************************************************************************************************
12043 : !> \brief ...
12044 : !> \param md_max ...
12045 : !> \param kbd ...
12046 : !> \param kbc ...
12047 : !> \param kad ...
12048 : !> \param kac ...
12049 : !> \param pbd ...
12050 : !> \param pbc ...
12051 : !> \param pad ...
12052 : !> \param pac ...
12053 : !> \param prim ...
12054 : !> \param scale ...
12055 : ! **************************************************************************************************
12056 2097 : SUBROUTINE block_2_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12057 : INTEGER :: md_max
12058 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*2), kad(2*md_max), kac(2*2), pbd(1*md_max), pbc(1*2), &
12059 : pad(2*md_max), pac(2*2), prim(2*1*2*md_max), scale
12060 :
12061 : INTEGER :: ma, mb, mc, md, p_index
12062 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12063 :
12064 13152 : kbd(1:1*md_max) = 0.0_dp
12065 2097 : kbc(1:1*2) = 0.0_dp
12066 24207 : kad(1:2*md_max) = 0.0_dp
12067 2097 : kac(1:2*2) = 0.0_dp
12068 2097 : p_index = 0
12069 13152 : DO md = 1, md_max
12070 35262 : DO mc = 1, 2
12071 55275 : DO mb = 1, 1
12072 22110 : ks_bd = 0.0_dp
12073 22110 : ks_bc = 0.0_dp
12074 22110 : p_bd = pbd((md - 1)*1 + mb)
12075 22110 : p_bc = pbc((mc - 1)*1 + mb)
12076 66330 : DO ma = 1, 2
12077 44220 : p_index = p_index + 1
12078 44220 : tmp = scale*prim(p_index)
12079 44220 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12080 44220 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12081 44220 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12082 66330 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12083 : END DO
12084 22110 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12085 44220 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12086 : END DO
12087 : END DO
12088 : END DO
12089 2097 : END SUBROUTINE block_2_1_2
12090 : ! **************************************************************************************************
12091 : !> \brief ...
12092 : !> \param kbd ...
12093 : !> \param kbc ...
12094 : !> \param kad ...
12095 : !> \param kac ...
12096 : !> \param pbd ...
12097 : !> \param pbc ...
12098 : !> \param pad ...
12099 : !> \param pac ...
12100 : !> \param prim ...
12101 : !> \param scale ...
12102 : ! **************************************************************************************************
12103 17798 : SUBROUTINE block_2_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12104 : REAL(KIND=dp) :: kbd(1*1), kbc(1*3), kad(2*1), kac(2*3), &
12105 : pbd(1*1), pbc(1*3), pad(2*1), &
12106 : pac(2*3), prim(2*1*3*1), scale
12107 :
12108 : INTEGER :: ma, mb, mc, md, p_index
12109 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12110 :
12111 17798 : kbd(1:1*1) = 0.0_dp
12112 17798 : kbc(1:1*3) = 0.0_dp
12113 17798 : kad(1:2*1) = 0.0_dp
12114 17798 : kac(1:2*3) = 0.0_dp
12115 17798 : p_index = 0
12116 35596 : DO md = 1, 1
12117 88990 : DO mc = 1, 3
12118 124586 : DO mb = 1, 1
12119 53394 : ks_bd = 0.0_dp
12120 53394 : ks_bc = 0.0_dp
12121 53394 : p_bd = pbd((md - 1)*1 + mb)
12122 53394 : p_bc = pbc((mc - 1)*1 + mb)
12123 160182 : DO ma = 1, 2
12124 106788 : p_index = p_index + 1
12125 106788 : tmp = scale*prim(p_index)
12126 106788 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12127 106788 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12128 106788 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12129 160182 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12130 : END DO
12131 53394 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12132 106788 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12133 : END DO
12134 : END DO
12135 : END DO
12136 17798 : END SUBROUTINE block_2_1_3_1
12137 : ! **************************************************************************************************
12138 : !> \brief ...
12139 : !> \param kbd ...
12140 : !> \param kbc ...
12141 : !> \param kad ...
12142 : !> \param kac ...
12143 : !> \param pbd ...
12144 : !> \param pbc ...
12145 : !> \param pad ...
12146 : !> \param pac ...
12147 : !> \param prim ...
12148 : !> \param scale ...
12149 : ! **************************************************************************************************
12150 2759 : SUBROUTINE block_2_1_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12151 : REAL(KIND=dp) :: kbd(1*2), kbc(1*3), kad(2*2), kac(2*3), &
12152 : pbd(1*2), pbc(1*3), pad(2*2), &
12153 : pac(2*3), prim(2*1*3*2), scale
12154 :
12155 : INTEGER :: ma, mb, mc, md, p_index
12156 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12157 :
12158 2759 : kbd(1:1*2) = 0.0_dp
12159 2759 : kbc(1:1*3) = 0.0_dp
12160 2759 : kad(1:2*2) = 0.0_dp
12161 2759 : kac(1:2*3) = 0.0_dp
12162 2759 : p_index = 0
12163 8277 : DO md = 1, 2
12164 24831 : DO mc = 1, 3
12165 38626 : DO mb = 1, 1
12166 16554 : ks_bd = 0.0_dp
12167 16554 : ks_bc = 0.0_dp
12168 16554 : p_bd = pbd((md - 1)*1 + mb)
12169 16554 : p_bc = pbc((mc - 1)*1 + mb)
12170 49662 : DO ma = 1, 2
12171 33108 : p_index = p_index + 1
12172 33108 : tmp = scale*prim(p_index)
12173 33108 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12174 33108 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12175 33108 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12176 49662 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12177 : END DO
12178 16554 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12179 33108 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12180 : END DO
12181 : END DO
12182 : END DO
12183 2759 : END SUBROUTINE block_2_1_3_2
12184 : ! **************************************************************************************************
12185 : !> \brief ...
12186 : !> \param kbd ...
12187 : !> \param kbc ...
12188 : !> \param kad ...
12189 : !> \param kac ...
12190 : !> \param pbd ...
12191 : !> \param pbc ...
12192 : !> \param pad ...
12193 : !> \param pac ...
12194 : !> \param prim ...
12195 : !> \param scale ...
12196 : ! **************************************************************************************************
12197 16799 : SUBROUTINE block_2_1_3_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12198 : REAL(KIND=dp) :: kbd(1*3), kbc(1*3), kad(2*3), kac(2*3), &
12199 : pbd(1*3), pbc(1*3), pad(2*3), &
12200 : pac(2*3), prim(2*1*3*3), scale
12201 :
12202 : INTEGER :: ma, mb, mc, md, p_index
12203 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12204 :
12205 16799 : kbd(1:1*3) = 0.0_dp
12206 16799 : kbc(1:1*3) = 0.0_dp
12207 16799 : kad(1:2*3) = 0.0_dp
12208 16799 : kac(1:2*3) = 0.0_dp
12209 16799 : p_index = 0
12210 67196 : DO md = 1, 3
12211 218387 : DO mc = 1, 3
12212 352779 : DO mb = 1, 1
12213 151191 : ks_bd = 0.0_dp
12214 151191 : ks_bc = 0.0_dp
12215 151191 : p_bd = pbd((md - 1)*1 + mb)
12216 151191 : p_bc = pbc((mc - 1)*1 + mb)
12217 453573 : DO ma = 1, 2
12218 302382 : p_index = p_index + 1
12219 302382 : tmp = scale*prim(p_index)
12220 302382 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12221 302382 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12222 302382 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12223 453573 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12224 : END DO
12225 151191 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12226 302382 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12227 : END DO
12228 : END DO
12229 : END DO
12230 16799 : END SUBROUTINE block_2_1_3_3
12231 : ! **************************************************************************************************
12232 : !> \brief ...
12233 : !> \param md_max ...
12234 : !> \param kbd ...
12235 : !> \param kbc ...
12236 : !> \param kad ...
12237 : !> \param kac ...
12238 : !> \param pbd ...
12239 : !> \param pbc ...
12240 : !> \param pad ...
12241 : !> \param pac ...
12242 : !> \param prim ...
12243 : !> \param scale ...
12244 : ! **************************************************************************************************
12245 6987 : SUBROUTINE block_2_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12246 : INTEGER :: md_max
12247 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*3), kad(2*md_max), kac(2*3), pbd(1*md_max), pbc(1*3), &
12248 : pad(2*md_max), pac(2*3), prim(2*1*3*md_max), scale
12249 :
12250 : INTEGER :: ma, mb, mc, md, p_index
12251 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12252 :
12253 43891 : kbd(1:1*md_max) = 0.0_dp
12254 6987 : kbc(1:1*3) = 0.0_dp
12255 80795 : kad(1:2*md_max) = 0.0_dp
12256 6987 : kac(1:2*3) = 0.0_dp
12257 6987 : p_index = 0
12258 43891 : DO md = 1, md_max
12259 154603 : DO mc = 1, 3
12260 258328 : DO mb = 1, 1
12261 110712 : ks_bd = 0.0_dp
12262 110712 : ks_bc = 0.0_dp
12263 110712 : p_bd = pbd((md - 1)*1 + mb)
12264 110712 : p_bc = pbc((mc - 1)*1 + mb)
12265 332136 : DO ma = 1, 2
12266 221424 : p_index = p_index + 1
12267 221424 : tmp = scale*prim(p_index)
12268 221424 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12269 221424 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12270 221424 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12271 332136 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12272 : END DO
12273 110712 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12274 221424 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12275 : END DO
12276 : END DO
12277 : END DO
12278 6987 : END SUBROUTINE block_2_1_3
12279 : ! **************************************************************************************************
12280 : !> \brief ...
12281 : !> \param kbd ...
12282 : !> \param kbc ...
12283 : !> \param kad ...
12284 : !> \param kac ...
12285 : !> \param pbd ...
12286 : !> \param pbc ...
12287 : !> \param pad ...
12288 : !> \param pac ...
12289 : !> \param prim ...
12290 : !> \param scale ...
12291 : ! **************************************************************************************************
12292 3 : SUBROUTINE block_2_1_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12293 : REAL(KIND=dp) :: kbd(1*1), kbc(1*4), kad(2*1), kac(2*4), &
12294 : pbd(1*1), pbc(1*4), pad(2*1), &
12295 : pac(2*4), prim(2*1*4*1), scale
12296 :
12297 : INTEGER :: ma, mb, mc, md, p_index
12298 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12299 :
12300 3 : kbd(1:1*1) = 0.0_dp
12301 3 : kbc(1:1*4) = 0.0_dp
12302 3 : kad(1:2*1) = 0.0_dp
12303 3 : kac(1:2*4) = 0.0_dp
12304 3 : p_index = 0
12305 6 : DO md = 1, 1
12306 18 : DO mc = 1, 4
12307 27 : DO mb = 1, 1
12308 12 : ks_bd = 0.0_dp
12309 12 : ks_bc = 0.0_dp
12310 12 : p_bd = pbd((md - 1)*1 + mb)
12311 12 : p_bc = pbc((mc - 1)*1 + mb)
12312 36 : DO ma = 1, 2
12313 24 : p_index = p_index + 1
12314 24 : tmp = scale*prim(p_index)
12315 24 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12316 24 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12317 24 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12318 36 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12319 : END DO
12320 12 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12321 24 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12322 : END DO
12323 : END DO
12324 : END DO
12325 3 : END SUBROUTINE block_2_1_4_1
12326 : ! **************************************************************************************************
12327 : !> \brief ...
12328 : !> \param kbd ...
12329 : !> \param kbc ...
12330 : !> \param kad ...
12331 : !> \param kac ...
12332 : !> \param pbd ...
12333 : !> \param pbc ...
12334 : !> \param pad ...
12335 : !> \param pac ...
12336 : !> \param prim ...
12337 : !> \param scale ...
12338 : ! **************************************************************************************************
12339 2 : SUBROUTINE block_2_1_4_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12340 : REAL(KIND=dp) :: kbd(1*2), kbc(1*4), kad(2*2), kac(2*4), &
12341 : pbd(1*2), pbc(1*4), pad(2*2), &
12342 : pac(2*4), prim(2*1*4*2), scale
12343 :
12344 : INTEGER :: ma, mb, mc, md, p_index
12345 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12346 :
12347 2 : kbd(1:1*2) = 0.0_dp
12348 2 : kbc(1:1*4) = 0.0_dp
12349 2 : kad(1:2*2) = 0.0_dp
12350 2 : kac(1:2*4) = 0.0_dp
12351 2 : p_index = 0
12352 6 : DO md = 1, 2
12353 22 : DO mc = 1, 4
12354 36 : DO mb = 1, 1
12355 16 : ks_bd = 0.0_dp
12356 16 : ks_bc = 0.0_dp
12357 16 : p_bd = pbd((md - 1)*1 + mb)
12358 16 : p_bc = pbc((mc - 1)*1 + mb)
12359 48 : DO ma = 1, 2
12360 32 : p_index = p_index + 1
12361 32 : tmp = scale*prim(p_index)
12362 32 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12363 32 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12364 32 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12365 48 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12366 : END DO
12367 16 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12368 32 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12369 : END DO
12370 : END DO
12371 : END DO
12372 2 : END SUBROUTINE block_2_1_4_2
12373 : ! **************************************************************************************************
12374 : !> \brief ...
12375 : !> \param md_max ...
12376 : !> \param kbd ...
12377 : !> \param kbc ...
12378 : !> \param kad ...
12379 : !> \param kac ...
12380 : !> \param pbd ...
12381 : !> \param pbc ...
12382 : !> \param pad ...
12383 : !> \param pac ...
12384 : !> \param prim ...
12385 : !> \param scale ...
12386 : ! **************************************************************************************************
12387 24 : SUBROUTINE block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12388 : INTEGER :: md_max
12389 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*4), kad(2*md_max), kac(2*4), pbd(1*md_max), pbc(1*4), &
12390 : pad(2*md_max), pac(2*4), prim(2*1*4*md_max), scale
12391 :
12392 : INTEGER :: ma, mb, mc, md, p_index
12393 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12394 :
12395 199 : kbd(1:1*md_max) = 0.0_dp
12396 24 : kbc(1:1*4) = 0.0_dp
12397 374 : kad(1:2*md_max) = 0.0_dp
12398 24 : kac(1:2*4) = 0.0_dp
12399 24 : p_index = 0
12400 199 : DO md = 1, md_max
12401 899 : DO mc = 1, 4
12402 1575 : DO mb = 1, 1
12403 700 : ks_bd = 0.0_dp
12404 700 : ks_bc = 0.0_dp
12405 700 : p_bd = pbd((md - 1)*1 + mb)
12406 700 : p_bc = pbc((mc - 1)*1 + mb)
12407 2100 : DO ma = 1, 2
12408 1400 : p_index = p_index + 1
12409 1400 : tmp = scale*prim(p_index)
12410 1400 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12411 1400 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12412 1400 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12413 2100 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12414 : END DO
12415 700 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12416 1400 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12417 : END DO
12418 : END DO
12419 : END DO
12420 24 : END SUBROUTINE block_2_1_4
12421 : ! **************************************************************************************************
12422 : !> \brief ...
12423 : !> \param kbd ...
12424 : !> \param kbc ...
12425 : !> \param kad ...
12426 : !> \param kac ...
12427 : !> \param pbd ...
12428 : !> \param pbc ...
12429 : !> \param pad ...
12430 : !> \param pac ...
12431 : !> \param prim ...
12432 : !> \param scale ...
12433 : ! **************************************************************************************************
12434 10213 : SUBROUTINE block_2_1_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12435 : REAL(KIND=dp) :: kbd(1*1), kbc(1*5), kad(2*1), kac(2*5), &
12436 : pbd(1*1), pbc(1*5), pad(2*1), &
12437 : pac(2*5), prim(2*1*5*1), scale
12438 :
12439 : INTEGER :: ma, mb, mc, md, p_index
12440 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12441 :
12442 10213 : kbd(1:1*1) = 0.0_dp
12443 10213 : kbc(1:1*5) = 0.0_dp
12444 10213 : kad(1:2*1) = 0.0_dp
12445 10213 : kac(1:2*5) = 0.0_dp
12446 10213 : p_index = 0
12447 20426 : DO md = 1, 1
12448 71491 : DO mc = 1, 5
12449 112343 : DO mb = 1, 1
12450 51065 : ks_bd = 0.0_dp
12451 51065 : ks_bc = 0.0_dp
12452 51065 : p_bd = pbd((md - 1)*1 + mb)
12453 51065 : p_bc = pbc((mc - 1)*1 + mb)
12454 153195 : DO ma = 1, 2
12455 102130 : p_index = p_index + 1
12456 102130 : tmp = scale*prim(p_index)
12457 102130 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12458 102130 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12459 102130 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12460 153195 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12461 : END DO
12462 51065 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12463 102130 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12464 : END DO
12465 : END DO
12466 : END DO
12467 10213 : END SUBROUTINE block_2_1_5_1
12468 : ! **************************************************************************************************
12469 : !> \brief ...
12470 : !> \param md_max ...
12471 : !> \param kbd ...
12472 : !> \param kbc ...
12473 : !> \param kad ...
12474 : !> \param kac ...
12475 : !> \param pbd ...
12476 : !> \param pbc ...
12477 : !> \param pad ...
12478 : !> \param pac ...
12479 : !> \param prim ...
12480 : !> \param scale ...
12481 : ! **************************************************************************************************
12482 16878 : SUBROUTINE block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12483 : INTEGER :: md_max
12484 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*5), kad(2*md_max), kac(2*5), pbd(1*md_max), pbc(1*5), &
12485 : pad(2*md_max), pac(2*5), prim(2*1*5*md_max), scale
12486 :
12487 : INTEGER :: ma, mb, mc, md, p_index
12488 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12489 :
12490 76985 : kbd(1:1*md_max) = 0.0_dp
12491 16878 : kbc(1:1*5) = 0.0_dp
12492 137092 : kad(1:2*md_max) = 0.0_dp
12493 16878 : kac(1:2*5) = 0.0_dp
12494 16878 : p_index = 0
12495 76985 : DO md = 1, md_max
12496 377520 : DO mc = 1, 5
12497 661177 : DO mb = 1, 1
12498 300535 : ks_bd = 0.0_dp
12499 300535 : ks_bc = 0.0_dp
12500 300535 : p_bd = pbd((md - 1)*1 + mb)
12501 300535 : p_bc = pbc((mc - 1)*1 + mb)
12502 901605 : DO ma = 1, 2
12503 601070 : p_index = p_index + 1
12504 601070 : tmp = scale*prim(p_index)
12505 601070 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12506 601070 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12507 601070 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12508 901605 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12509 : END DO
12510 300535 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12511 601070 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12512 : END DO
12513 : END DO
12514 : END DO
12515 16878 : END SUBROUTINE block_2_1_5
12516 : ! **************************************************************************************************
12517 : !> \brief ...
12518 : !> \param kbd ...
12519 : !> \param kbc ...
12520 : !> \param kad ...
12521 : !> \param kac ...
12522 : !> \param pbd ...
12523 : !> \param pbc ...
12524 : !> \param pad ...
12525 : !> \param pac ...
12526 : !> \param prim ...
12527 : !> \param scale ...
12528 : ! **************************************************************************************************
12529 1 : SUBROUTINE block_2_1_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12530 : REAL(KIND=dp) :: kbd(1*1), kbc(1*6), kad(2*1), kac(2*6), &
12531 : pbd(1*1), pbc(1*6), pad(2*1), &
12532 : pac(2*6), prim(2*1*6*1), scale
12533 :
12534 : INTEGER :: ma, mb, mc, md, p_index
12535 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12536 :
12537 1 : kbd(1:1*1) = 0.0_dp
12538 1 : kbc(1:1*6) = 0.0_dp
12539 1 : kad(1:2*1) = 0.0_dp
12540 1 : kac(1:2*6) = 0.0_dp
12541 1 : p_index = 0
12542 2 : DO md = 1, 1
12543 8 : DO mc = 1, 6
12544 13 : DO mb = 1, 1
12545 6 : ks_bd = 0.0_dp
12546 6 : ks_bc = 0.0_dp
12547 6 : p_bd = pbd((md - 1)*1 + mb)
12548 6 : p_bc = pbc((mc - 1)*1 + mb)
12549 18 : DO ma = 1, 2
12550 12 : p_index = p_index + 1
12551 12 : tmp = scale*prim(p_index)
12552 12 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12553 12 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12554 12 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12555 18 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12556 : END DO
12557 6 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12558 12 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12559 : END DO
12560 : END DO
12561 : END DO
12562 1 : END SUBROUTINE block_2_1_6_1
12563 : ! **************************************************************************************************
12564 : !> \brief ...
12565 : !> \param md_max ...
12566 : !> \param kbd ...
12567 : !> \param kbc ...
12568 : !> \param kad ...
12569 : !> \param kac ...
12570 : !> \param pbd ...
12571 : !> \param pbc ...
12572 : !> \param pad ...
12573 : !> \param pac ...
12574 : !> \param prim ...
12575 : !> \param scale ...
12576 : ! **************************************************************************************************
12577 10 : SUBROUTINE block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12578 : INTEGER :: md_max
12579 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*6), kad(2*md_max), kac(2*6), pbd(1*md_max), pbc(1*6), &
12580 : pad(2*md_max), pac(2*6), prim(2*1*6*md_max), scale
12581 :
12582 : INTEGER :: ma, mb, mc, md, p_index
12583 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12584 :
12585 68 : kbd(1:1*md_max) = 0.0_dp
12586 10 : kbc(1:1*6) = 0.0_dp
12587 126 : kad(1:2*md_max) = 0.0_dp
12588 10 : kac(1:2*6) = 0.0_dp
12589 10 : p_index = 0
12590 68 : DO md = 1, md_max
12591 416 : DO mc = 1, 6
12592 754 : DO mb = 1, 1
12593 348 : ks_bd = 0.0_dp
12594 348 : ks_bc = 0.0_dp
12595 348 : p_bd = pbd((md - 1)*1 + mb)
12596 348 : p_bc = pbc((mc - 1)*1 + mb)
12597 1044 : DO ma = 1, 2
12598 696 : p_index = p_index + 1
12599 696 : tmp = scale*prim(p_index)
12600 696 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12601 696 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12602 696 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12603 1044 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12604 : END DO
12605 348 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12606 696 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12607 : END DO
12608 : END DO
12609 : END DO
12610 10 : END SUBROUTINE block_2_1_6
12611 : ! **************************************************************************************************
12612 : !> \brief ...
12613 : !> \param kbd ...
12614 : !> \param kbc ...
12615 : !> \param kad ...
12616 : !> \param kac ...
12617 : !> \param pbd ...
12618 : !> \param pbc ...
12619 : !> \param pad ...
12620 : !> \param pac ...
12621 : !> \param prim ...
12622 : !> \param scale ...
12623 : ! **************************************************************************************************
12624 713 : SUBROUTINE block_2_1_7_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12625 : REAL(KIND=dp) :: kbd(1*1), kbc(1*7), kad(2*1), kac(2*7), &
12626 : pbd(1*1), pbc(1*7), pad(2*1), &
12627 : pac(2*7), prim(2*1*7*1), scale
12628 :
12629 : INTEGER :: ma, mb, mc, md, p_index
12630 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12631 :
12632 713 : kbd(1:1*1) = 0.0_dp
12633 713 : kbc(1:1*7) = 0.0_dp
12634 713 : kad(1:2*1) = 0.0_dp
12635 713 : kac(1:2*7) = 0.0_dp
12636 713 : p_index = 0
12637 1426 : DO md = 1, 1
12638 6417 : DO mc = 1, 7
12639 10695 : DO mb = 1, 1
12640 4991 : ks_bd = 0.0_dp
12641 4991 : ks_bc = 0.0_dp
12642 4991 : p_bd = pbd((md - 1)*1 + mb)
12643 4991 : p_bc = pbc((mc - 1)*1 + mb)
12644 14973 : DO ma = 1, 2
12645 9982 : p_index = p_index + 1
12646 9982 : tmp = scale*prim(p_index)
12647 9982 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12648 9982 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12649 9982 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12650 14973 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12651 : END DO
12652 4991 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12653 9982 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12654 : END DO
12655 : END DO
12656 : END DO
12657 713 : END SUBROUTINE block_2_1_7_1
12658 : ! **************************************************************************************************
12659 : !> \brief ...
12660 : !> \param md_max ...
12661 : !> \param kbd ...
12662 : !> \param kbc ...
12663 : !> \param kad ...
12664 : !> \param kac ...
12665 : !> \param pbd ...
12666 : !> \param pbc ...
12667 : !> \param pad ...
12668 : !> \param pac ...
12669 : !> \param prim ...
12670 : !> \param scale ...
12671 : ! **************************************************************************************************
12672 2400 : SUBROUTINE block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12673 : INTEGER :: md_max
12674 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*7), kad(2*md_max), kac(2*7), pbd(1*md_max), pbc(1*7), &
12675 : pad(2*md_max), pac(2*7), prim(2*1*7*md_max), scale
12676 :
12677 : INTEGER :: ma, mb, mc, md, p_index
12678 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12679 :
12680 12772 : kbd(1:1*md_max) = 0.0_dp
12681 2400 : kbc(1:1*7) = 0.0_dp
12682 23144 : kad(1:2*md_max) = 0.0_dp
12683 2400 : kac(1:2*7) = 0.0_dp
12684 2400 : p_index = 0
12685 12772 : DO md = 1, md_max
12686 85376 : DO mc = 1, 7
12687 155580 : DO mb = 1, 1
12688 72604 : ks_bd = 0.0_dp
12689 72604 : ks_bc = 0.0_dp
12690 72604 : p_bd = pbd((md - 1)*1 + mb)
12691 72604 : p_bc = pbc((mc - 1)*1 + mb)
12692 217812 : DO ma = 1, 2
12693 145208 : p_index = p_index + 1
12694 145208 : tmp = scale*prim(p_index)
12695 145208 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12696 145208 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12697 145208 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12698 217812 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12699 : END DO
12700 72604 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12701 145208 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12702 : END DO
12703 : END DO
12704 : END DO
12705 2400 : END SUBROUTINE block_2_1_7
12706 : ! **************************************************************************************************
12707 : !> \brief ...
12708 : !> \param kbd ...
12709 : !> \param kbc ...
12710 : !> \param kad ...
12711 : !> \param kac ...
12712 : !> \param pbd ...
12713 : !> \param pbc ...
12714 : !> \param pad ...
12715 : !> \param pac ...
12716 : !> \param prim ...
12717 : !> \param scale ...
12718 : ! **************************************************************************************************
12719 1 : SUBROUTINE block_2_1_9_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12720 : REAL(KIND=dp) :: kbd(1*1), kbc(1*9), kad(2*1), kac(2*9), &
12721 : pbd(1*1), pbc(1*9), pad(2*1), &
12722 : pac(2*9), prim(2*1*9*1), scale
12723 :
12724 : INTEGER :: ma, mb, mc, md, p_index
12725 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12726 :
12727 1 : kbd(1:1*1) = 0.0_dp
12728 1 : kbc(1:1*9) = 0.0_dp
12729 1 : kad(1:2*1) = 0.0_dp
12730 1 : kac(1:2*9) = 0.0_dp
12731 1 : p_index = 0
12732 2 : DO md = 1, 1
12733 11 : DO mc = 1, 9
12734 19 : DO mb = 1, 1
12735 9 : ks_bd = 0.0_dp
12736 9 : ks_bc = 0.0_dp
12737 9 : p_bd = pbd((md - 1)*1 + mb)
12738 9 : p_bc = pbc((mc - 1)*1 + mb)
12739 27 : DO ma = 1, 2
12740 18 : p_index = p_index + 1
12741 18 : tmp = scale*prim(p_index)
12742 18 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12743 18 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12744 18 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12745 27 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12746 : END DO
12747 9 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12748 18 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12749 : END DO
12750 : END DO
12751 : END DO
12752 1 : END SUBROUTINE block_2_1_9_1
12753 : ! **************************************************************************************************
12754 : !> \brief ...
12755 : !> \param md_max ...
12756 : !> \param kbd ...
12757 : !> \param kbc ...
12758 : !> \param kad ...
12759 : !> \param kac ...
12760 : !> \param pbd ...
12761 : !> \param pbc ...
12762 : !> \param pad ...
12763 : !> \param pac ...
12764 : !> \param prim ...
12765 : !> \param scale ...
12766 : ! **************************************************************************************************
12767 10 : SUBROUTINE block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12768 : INTEGER :: md_max
12769 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*9), kad(2*md_max), kac(2*9), pbd(1*md_max), pbc(1*9), &
12770 : pad(2*md_max), pac(2*9), prim(2*1*9*md_max), scale
12771 :
12772 : INTEGER :: ma, mb, mc, md, p_index
12773 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12774 :
12775 66 : kbd(1:1*md_max) = 0.0_dp
12776 10 : kbc(1:1*9) = 0.0_dp
12777 122 : kad(1:2*md_max) = 0.0_dp
12778 10 : kac(1:2*9) = 0.0_dp
12779 10 : p_index = 0
12780 66 : DO md = 1, md_max
12781 570 : DO mc = 1, 9
12782 1064 : DO mb = 1, 1
12783 504 : ks_bd = 0.0_dp
12784 504 : ks_bc = 0.0_dp
12785 504 : p_bd = pbd((md - 1)*1 + mb)
12786 504 : p_bc = pbc((mc - 1)*1 + mb)
12787 1512 : DO ma = 1, 2
12788 1008 : p_index = p_index + 1
12789 1008 : tmp = scale*prim(p_index)
12790 1008 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12791 1008 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12792 1008 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12793 1512 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12794 : END DO
12795 504 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12796 1008 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12797 : END DO
12798 : END DO
12799 : END DO
12800 10 : END SUBROUTINE block_2_1_9
12801 : ! **************************************************************************************************
12802 : !> \brief ...
12803 : !> \param mc_max ...
12804 : !> \param md_max ...
12805 : !> \param kbd ...
12806 : !> \param kbc ...
12807 : !> \param kad ...
12808 : !> \param kac ...
12809 : !> \param pbd ...
12810 : !> \param pbc ...
12811 : !> \param pad ...
12812 : !> \param pac ...
12813 : !> \param prim ...
12814 : !> \param scale ...
12815 : ! **************************************************************************************************
12816 30 : SUBROUTINE block_2_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12817 : INTEGER :: mc_max, md_max
12818 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*mc_max), kad(2*md_max), kac(2*mc_max), pbd(1*md_max), &
12819 : pbc(1*mc_max), pad(2*md_max), pac(2*mc_max), prim(2*1*mc_max*md_max), scale
12820 :
12821 : INTEGER :: ma, mb, mc, md, p_index
12822 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12823 :
12824 208 : kbd(1:1*md_max) = 0.0_dp
12825 395 : kbc(1:1*mc_max) = 0.0_dp
12826 386 : kad(1:2*md_max) = 0.0_dp
12827 760 : kac(1:2*mc_max) = 0.0_dp
12828 : p_index = 0
12829 208 : DO md = 1, md_max
12830 2411 : DO mc = 1, mc_max
12831 4584 : DO mb = 1, 1
12832 2203 : ks_bd = 0.0_dp
12833 2203 : ks_bc = 0.0_dp
12834 2203 : p_bd = pbd((md - 1)*1 + mb)
12835 2203 : p_bc = pbc((mc - 1)*1 + mb)
12836 6609 : DO ma = 1, 2
12837 4406 : p_index = p_index + 1
12838 4406 : tmp = scale*prim(p_index)
12839 4406 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12840 4406 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12841 4406 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12842 6609 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12843 : END DO
12844 2203 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12845 4406 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12846 : END DO
12847 : END DO
12848 : END DO
12849 30 : END SUBROUTINE block_2_1
12850 : ! **************************************************************************************************
12851 : !> \brief ...
12852 : !> \param kbd ...
12853 : !> \param kbc ...
12854 : !> \param kad ...
12855 : !> \param kac ...
12856 : !> \param pbd ...
12857 : !> \param pbc ...
12858 : !> \param pad ...
12859 : !> \param pac ...
12860 : !> \param prim ...
12861 : !> \param scale ...
12862 : ! **************************************************************************************************
12863 739 : SUBROUTINE block_2_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12864 : REAL(KIND=dp) :: kbd(2*1), kbc(2*1), kad(2*1), kac(2*1), &
12865 : pbd(2*1), pbc(2*1), pad(2*1), &
12866 : pac(2*1), prim(2*2*1*1), scale
12867 :
12868 : INTEGER :: ma, mb, mc, md, p_index
12869 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12870 :
12871 739 : kbd(1:2*1) = 0.0_dp
12872 739 : kbc(1:2*1) = 0.0_dp
12873 739 : kad(1:2*1) = 0.0_dp
12874 739 : kac(1:2*1) = 0.0_dp
12875 739 : p_index = 0
12876 1478 : DO md = 1, 1
12877 2217 : DO mc = 1, 1
12878 2956 : DO mb = 1, 2
12879 1478 : ks_bd = 0.0_dp
12880 1478 : ks_bc = 0.0_dp
12881 1478 : p_bd = pbd((md - 1)*2 + mb)
12882 1478 : p_bc = pbc((mc - 1)*2 + mb)
12883 4434 : DO ma = 1, 2
12884 2956 : p_index = p_index + 1
12885 2956 : tmp = scale*prim(p_index)
12886 2956 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12887 2956 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12888 2956 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12889 4434 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12890 : END DO
12891 1478 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
12892 2217 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
12893 : END DO
12894 : END DO
12895 : END DO
12896 739 : END SUBROUTINE block_2_2_1_1
12897 : ! **************************************************************************************************
12898 : !> \brief ...
12899 : !> \param kbd ...
12900 : !> \param kbc ...
12901 : !> \param kad ...
12902 : !> \param kac ...
12903 : !> \param pbd ...
12904 : !> \param pbc ...
12905 : !> \param pad ...
12906 : !> \param pac ...
12907 : !> \param prim ...
12908 : !> \param scale ...
12909 : ! **************************************************************************************************
12910 314 : SUBROUTINE block_2_2_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12911 : REAL(KIND=dp) :: kbd(2*2), kbc(2*1), kad(2*2), kac(2*1), &
12912 : pbd(2*2), pbc(2*1), pad(2*2), &
12913 : pac(2*1), prim(2*2*1*2), scale
12914 :
12915 : INTEGER :: ma, mb, mc, md, p_index
12916 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12917 :
12918 314 : kbd(1:2*2) = 0.0_dp
12919 314 : kbc(1:2*1) = 0.0_dp
12920 314 : kad(1:2*2) = 0.0_dp
12921 314 : kac(1:2*1) = 0.0_dp
12922 314 : p_index = 0
12923 942 : DO md = 1, 2
12924 1570 : DO mc = 1, 1
12925 2512 : DO mb = 1, 2
12926 1256 : ks_bd = 0.0_dp
12927 1256 : ks_bc = 0.0_dp
12928 1256 : p_bd = pbd((md - 1)*2 + mb)
12929 1256 : p_bc = pbc((mc - 1)*2 + mb)
12930 3768 : DO ma = 1, 2
12931 2512 : p_index = p_index + 1
12932 2512 : tmp = scale*prim(p_index)
12933 2512 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12934 2512 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12935 2512 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12936 3768 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12937 : END DO
12938 1256 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
12939 1884 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
12940 : END DO
12941 : END DO
12942 : END DO
12943 314 : END SUBROUTINE block_2_2_1_2
12944 : ! **************************************************************************************************
12945 : !> \brief ...
12946 : !> \param kbd ...
12947 : !> \param kbc ...
12948 : !> \param kad ...
12949 : !> \param kac ...
12950 : !> \param pbd ...
12951 : !> \param pbc ...
12952 : !> \param pad ...
12953 : !> \param pac ...
12954 : !> \param prim ...
12955 : !> \param scale ...
12956 : ! **************************************************************************************************
12957 999 : SUBROUTINE block_2_2_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
12958 : REAL(KIND=dp) :: kbd(2*3), kbc(2*1), kad(2*3), kac(2*1), &
12959 : pbd(2*3), pbc(2*1), pad(2*3), &
12960 : pac(2*1), prim(2*2*1*3), scale
12961 :
12962 : INTEGER :: ma, mb, mc, md, p_index
12963 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
12964 :
12965 999 : kbd(1:2*3) = 0.0_dp
12966 999 : kbc(1:2*1) = 0.0_dp
12967 999 : kad(1:2*3) = 0.0_dp
12968 999 : kac(1:2*1) = 0.0_dp
12969 999 : p_index = 0
12970 3996 : DO md = 1, 3
12971 6993 : DO mc = 1, 1
12972 11988 : DO mb = 1, 2
12973 5994 : ks_bd = 0.0_dp
12974 5994 : ks_bc = 0.0_dp
12975 5994 : p_bd = pbd((md - 1)*2 + mb)
12976 5994 : p_bc = pbc((mc - 1)*2 + mb)
12977 17982 : DO ma = 1, 2
12978 11988 : p_index = p_index + 1
12979 11988 : tmp = scale*prim(p_index)
12980 11988 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12981 11988 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12982 11988 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12983 17982 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12984 : END DO
12985 5994 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
12986 8991 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
12987 : END DO
12988 : END DO
12989 : END DO
12990 999 : END SUBROUTINE block_2_2_1_3
12991 : ! **************************************************************************************************
12992 : !> \brief ...
12993 : !> \param kbd ...
12994 : !> \param kbc ...
12995 : !> \param kad ...
12996 : !> \param kac ...
12997 : !> \param pbd ...
12998 : !> \param pbc ...
12999 : !> \param pad ...
13000 : !> \param pac ...
13001 : !> \param prim ...
13002 : !> \param scale ...
13003 : ! **************************************************************************************************
13004 4 : SUBROUTINE block_2_2_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13005 : REAL(KIND=dp) :: kbd(2*4), kbc(2*1), kad(2*4), kac(2*1), &
13006 : pbd(2*4), pbc(2*1), pad(2*4), &
13007 : pac(2*1), prim(2*2*1*4), scale
13008 :
13009 : INTEGER :: ma, mb, mc, md, p_index
13010 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13011 :
13012 4 : kbd(1:2*4) = 0.0_dp
13013 4 : kbc(1:2*1) = 0.0_dp
13014 4 : kad(1:2*4) = 0.0_dp
13015 4 : kac(1:2*1) = 0.0_dp
13016 4 : p_index = 0
13017 20 : DO md = 1, 4
13018 36 : DO mc = 1, 1
13019 64 : DO mb = 1, 2
13020 32 : ks_bd = 0.0_dp
13021 32 : ks_bc = 0.0_dp
13022 32 : p_bd = pbd((md - 1)*2 + mb)
13023 32 : p_bc = pbc((mc - 1)*2 + mb)
13024 96 : DO ma = 1, 2
13025 64 : p_index = p_index + 1
13026 64 : tmp = scale*prim(p_index)
13027 64 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13028 64 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13029 64 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13030 96 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13031 : END DO
13032 32 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13033 48 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13034 : END DO
13035 : END DO
13036 : END DO
13037 4 : END SUBROUTINE block_2_2_1_4
13038 : ! **************************************************************************************************
13039 : !> \brief ...
13040 : !> \param md_max ...
13041 : !> \param kbd ...
13042 : !> \param kbc ...
13043 : !> \param kad ...
13044 : !> \param kac ...
13045 : !> \param pbd ...
13046 : !> \param pbc ...
13047 : !> \param pad ...
13048 : !> \param pac ...
13049 : !> \param prim ...
13050 : !> \param scale ...
13051 : ! **************************************************************************************************
13052 962 : SUBROUTINE block_2_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13053 : INTEGER :: md_max
13054 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*1), kad(2*md_max), kac(2*1), pbd(2*md_max), pbc(2*1), &
13055 : pad(2*md_max), pac(2*1), prim(2*2*1*md_max), scale
13056 :
13057 : INTEGER :: ma, mb, mc, md, p_index
13058 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13059 :
13060 11636 : kbd(1:2*md_max) = 0.0_dp
13061 962 : kbc(1:2*1) = 0.0_dp
13062 11636 : kad(1:2*md_max) = 0.0_dp
13063 962 : kac(1:2*1) = 0.0_dp
13064 962 : p_index = 0
13065 6299 : DO md = 1, md_max
13066 11636 : DO mc = 1, 1
13067 21348 : DO mb = 1, 2
13068 10674 : ks_bd = 0.0_dp
13069 10674 : ks_bc = 0.0_dp
13070 10674 : p_bd = pbd((md - 1)*2 + mb)
13071 10674 : p_bc = pbc((mc - 1)*2 + mb)
13072 32022 : DO ma = 1, 2
13073 21348 : p_index = p_index + 1
13074 21348 : tmp = scale*prim(p_index)
13075 21348 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13076 21348 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13077 21348 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13078 32022 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13079 : END DO
13080 10674 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13081 16011 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13082 : END DO
13083 : END DO
13084 : END DO
13085 962 : END SUBROUTINE block_2_2_1
13086 : ! **************************************************************************************************
13087 : !> \brief ...
13088 : !> \param kbd ...
13089 : !> \param kbc ...
13090 : !> \param kad ...
13091 : !> \param kac ...
13092 : !> \param pbd ...
13093 : !> \param pbc ...
13094 : !> \param pad ...
13095 : !> \param pac ...
13096 : !> \param prim ...
13097 : !> \param scale ...
13098 : ! **************************************************************************************************
13099 306 : SUBROUTINE block_2_2_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13100 : REAL(KIND=dp) :: kbd(2*1), kbc(2*2), kad(2*1), kac(2*2), &
13101 : pbd(2*1), pbc(2*2), pad(2*1), &
13102 : pac(2*2), prim(2*2*2*1), scale
13103 :
13104 : INTEGER :: ma, mb, mc, md, p_index
13105 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13106 :
13107 306 : kbd(1:2*1) = 0.0_dp
13108 306 : kbc(1:2*2) = 0.0_dp
13109 306 : kad(1:2*1) = 0.0_dp
13110 306 : kac(1:2*2) = 0.0_dp
13111 306 : p_index = 0
13112 612 : DO md = 1, 1
13113 1224 : DO mc = 1, 2
13114 2142 : DO mb = 1, 2
13115 1224 : ks_bd = 0.0_dp
13116 1224 : ks_bc = 0.0_dp
13117 1224 : p_bd = pbd((md - 1)*2 + mb)
13118 1224 : p_bc = pbc((mc - 1)*2 + mb)
13119 3672 : DO ma = 1, 2
13120 2448 : p_index = p_index + 1
13121 2448 : tmp = scale*prim(p_index)
13122 2448 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13123 2448 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13124 2448 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13125 3672 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13126 : END DO
13127 1224 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13128 1836 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13129 : END DO
13130 : END DO
13131 : END DO
13132 306 : END SUBROUTINE block_2_2_2_1
13133 : ! **************************************************************************************************
13134 : !> \brief ...
13135 : !> \param kbd ...
13136 : !> \param kbc ...
13137 : !> \param kad ...
13138 : !> \param kac ...
13139 : !> \param pbd ...
13140 : !> \param pbc ...
13141 : !> \param pad ...
13142 : !> \param pac ...
13143 : !> \param prim ...
13144 : !> \param scale ...
13145 : ! **************************************************************************************************
13146 35049 : SUBROUTINE block_2_2_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13147 : REAL(KIND=dp) :: kbd(2*2), kbc(2*2), kad(2*2), kac(2*2), &
13148 : pbd(2*2), pbc(2*2), pad(2*2), &
13149 : pac(2*2), prim(2*2*2*2), scale
13150 :
13151 : INTEGER :: ma, mb, mc, md, p_index
13152 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13153 :
13154 35049 : kbd(1:2*2) = 0.0_dp
13155 35049 : kbc(1:2*2) = 0.0_dp
13156 35049 : kad(1:2*2) = 0.0_dp
13157 35049 : kac(1:2*2) = 0.0_dp
13158 35049 : p_index = 0
13159 105147 : DO md = 1, 2
13160 245343 : DO mc = 1, 2
13161 490686 : DO mb = 1, 2
13162 280392 : ks_bd = 0.0_dp
13163 280392 : ks_bc = 0.0_dp
13164 280392 : p_bd = pbd((md - 1)*2 + mb)
13165 280392 : p_bc = pbc((mc - 1)*2 + mb)
13166 841176 : DO ma = 1, 2
13167 560784 : p_index = p_index + 1
13168 560784 : tmp = scale*prim(p_index)
13169 560784 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13170 560784 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13171 560784 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13172 841176 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13173 : END DO
13174 280392 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13175 420588 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13176 : END DO
13177 : END DO
13178 : END DO
13179 35049 : END SUBROUTINE block_2_2_2_2
13180 : ! **************************************************************************************************
13181 : !> \brief ...
13182 : !> \param md_max ...
13183 : !> \param kbd ...
13184 : !> \param kbc ...
13185 : !> \param kad ...
13186 : !> \param kac ...
13187 : !> \param pbd ...
13188 : !> \param pbc ...
13189 : !> \param pad ...
13190 : !> \param pac ...
13191 : !> \param prim ...
13192 : !> \param scale ...
13193 : ! **************************************************************************************************
13194 15828 : SUBROUTINE block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13195 : INTEGER :: md_max
13196 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*2), kad(2*md_max), kac(2*2), pbd(2*md_max), pbc(2*2), &
13197 : pad(2*md_max), pac(2*2), prim(2*2*2*md_max), scale
13198 :
13199 : INTEGER :: ma, mb, mc, md, p_index
13200 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13201 :
13202 112616 : kbd(1:2*md_max) = 0.0_dp
13203 15828 : kbc(1:2*2) = 0.0_dp
13204 112616 : kad(1:2*md_max) = 0.0_dp
13205 15828 : kac(1:2*2) = 0.0_dp
13206 15828 : p_index = 0
13207 64222 : DO md = 1, md_max
13208 161010 : DO mc = 1, 2
13209 338758 : DO mb = 1, 2
13210 193576 : ks_bd = 0.0_dp
13211 193576 : ks_bc = 0.0_dp
13212 193576 : p_bd = pbd((md - 1)*2 + mb)
13213 193576 : p_bc = pbc((mc - 1)*2 + mb)
13214 580728 : DO ma = 1, 2
13215 387152 : p_index = p_index + 1
13216 387152 : tmp = scale*prim(p_index)
13217 387152 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13218 387152 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13219 387152 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13220 580728 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13221 : END DO
13222 193576 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13223 290364 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13224 : END DO
13225 : END DO
13226 : END DO
13227 15828 : END SUBROUTINE block_2_2_2
13228 : ! **************************************************************************************************
13229 : !> \brief ...
13230 : !> \param kbd ...
13231 : !> \param kbc ...
13232 : !> \param kad ...
13233 : !> \param kac ...
13234 : !> \param pbd ...
13235 : !> \param pbc ...
13236 : !> \param pad ...
13237 : !> \param pac ...
13238 : !> \param prim ...
13239 : !> \param scale ...
13240 : ! **************************************************************************************************
13241 997 : SUBROUTINE block_2_2_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13242 : REAL(KIND=dp) :: kbd(2*1), kbc(2*3), kad(2*1), kac(2*3), &
13243 : pbd(2*1), pbc(2*3), pad(2*1), &
13244 : pac(2*3), prim(2*2*3*1), scale
13245 :
13246 : INTEGER :: ma, mb, mc, md, p_index
13247 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13248 :
13249 997 : kbd(1:2*1) = 0.0_dp
13250 997 : kbc(1:2*3) = 0.0_dp
13251 997 : kad(1:2*1) = 0.0_dp
13252 997 : kac(1:2*3) = 0.0_dp
13253 997 : p_index = 0
13254 1994 : DO md = 1, 1
13255 4985 : DO mc = 1, 3
13256 9970 : DO mb = 1, 2
13257 5982 : ks_bd = 0.0_dp
13258 5982 : ks_bc = 0.0_dp
13259 5982 : p_bd = pbd((md - 1)*2 + mb)
13260 5982 : p_bc = pbc((mc - 1)*2 + mb)
13261 17946 : DO ma = 1, 2
13262 11964 : p_index = p_index + 1
13263 11964 : tmp = scale*prim(p_index)
13264 11964 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13265 11964 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13266 11964 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13267 17946 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13268 : END DO
13269 5982 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13270 8973 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13271 : END DO
13272 : END DO
13273 : END DO
13274 997 : END SUBROUTINE block_2_2_3_1
13275 : ! **************************************************************************************************
13276 : !> \brief ...
13277 : !> \param md_max ...
13278 : !> \param kbd ...
13279 : !> \param kbc ...
13280 : !> \param kad ...
13281 : !> \param kac ...
13282 : !> \param pbd ...
13283 : !> \param pbc ...
13284 : !> \param pad ...
13285 : !> \param pac ...
13286 : !> \param prim ...
13287 : !> \param scale ...
13288 : ! **************************************************************************************************
13289 31751 : SUBROUTINE block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13290 : INTEGER :: md_max
13291 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*3), kad(2*md_max), kac(2*3), pbd(2*md_max), pbc(2*3), &
13292 : pad(2*md_max), pac(2*3), prim(2*2*3*md_max), scale
13293 :
13294 : INTEGER :: ma, mb, mc, md, p_index
13295 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13296 :
13297 198039 : kbd(1:2*md_max) = 0.0_dp
13298 31751 : kbc(1:2*3) = 0.0_dp
13299 198039 : kad(1:2*md_max) = 0.0_dp
13300 31751 : kac(1:2*3) = 0.0_dp
13301 31751 : p_index = 0
13302 114895 : DO md = 1, md_max
13303 364327 : DO mc = 1, 3
13304 831440 : DO mb = 1, 2
13305 498864 : ks_bd = 0.0_dp
13306 498864 : ks_bc = 0.0_dp
13307 498864 : p_bd = pbd((md - 1)*2 + mb)
13308 498864 : p_bc = pbc((mc - 1)*2 + mb)
13309 1496592 : DO ma = 1, 2
13310 997728 : p_index = p_index + 1
13311 997728 : tmp = scale*prim(p_index)
13312 997728 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13313 997728 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13314 997728 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13315 1496592 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13316 : END DO
13317 498864 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13318 748296 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13319 : END DO
13320 : END DO
13321 : END DO
13322 31751 : END SUBROUTINE block_2_2_3
13323 : ! **************************************************************************************************
13324 : !> \brief ...
13325 : !> \param kbd ...
13326 : !> \param kbc ...
13327 : !> \param kad ...
13328 : !> \param kac ...
13329 : !> \param pbd ...
13330 : !> \param pbc ...
13331 : !> \param pad ...
13332 : !> \param pac ...
13333 : !> \param prim ...
13334 : !> \param scale ...
13335 : ! **************************************************************************************************
13336 3 : SUBROUTINE block_2_2_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13337 : REAL(KIND=dp) :: kbd(2*1), kbc(2*4), kad(2*1), kac(2*4), &
13338 : pbd(2*1), pbc(2*4), pad(2*1), &
13339 : pac(2*4), prim(2*2*4*1), scale
13340 :
13341 : INTEGER :: ma, mb, mc, md, p_index
13342 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13343 :
13344 3 : kbd(1:2*1) = 0.0_dp
13345 3 : kbc(1:2*4) = 0.0_dp
13346 3 : kad(1:2*1) = 0.0_dp
13347 3 : kac(1:2*4) = 0.0_dp
13348 3 : p_index = 0
13349 6 : DO md = 1, 1
13350 18 : DO mc = 1, 4
13351 39 : DO mb = 1, 2
13352 24 : ks_bd = 0.0_dp
13353 24 : ks_bc = 0.0_dp
13354 24 : p_bd = pbd((md - 1)*2 + mb)
13355 24 : p_bc = pbc((mc - 1)*2 + mb)
13356 72 : DO ma = 1, 2
13357 48 : p_index = p_index + 1
13358 48 : tmp = scale*prim(p_index)
13359 48 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13360 48 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13361 48 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13362 72 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13363 : END DO
13364 24 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13365 36 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13366 : END DO
13367 : END DO
13368 : END DO
13369 3 : END SUBROUTINE block_2_2_4_1
13370 : ! **************************************************************************************************
13371 : !> \brief ...
13372 : !> \param md_max ...
13373 : !> \param kbd ...
13374 : !> \param kbc ...
13375 : !> \param kad ...
13376 : !> \param kac ...
13377 : !> \param pbd ...
13378 : !> \param pbc ...
13379 : !> \param pad ...
13380 : !> \param pac ...
13381 : !> \param prim ...
13382 : !> \param scale ...
13383 : ! **************************************************************************************************
13384 16 : SUBROUTINE block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13385 : INTEGER :: md_max
13386 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*4), kad(2*md_max), kac(2*4), pbd(2*md_max), pbc(2*4), &
13387 : pad(2*md_max), pac(2*4), prim(2*2*4*md_max), scale
13388 :
13389 : INTEGER :: ma, mb, mc, md, p_index
13390 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13391 :
13392 148 : kbd(1:2*md_max) = 0.0_dp
13393 16 : kbc(1:2*4) = 0.0_dp
13394 148 : kad(1:2*md_max) = 0.0_dp
13395 16 : kac(1:2*4) = 0.0_dp
13396 16 : p_index = 0
13397 82 : DO md = 1, md_max
13398 346 : DO mc = 1, 4
13399 858 : DO mb = 1, 2
13400 528 : ks_bd = 0.0_dp
13401 528 : ks_bc = 0.0_dp
13402 528 : p_bd = pbd((md - 1)*2 + mb)
13403 528 : p_bc = pbc((mc - 1)*2 + mb)
13404 1584 : DO ma = 1, 2
13405 1056 : p_index = p_index + 1
13406 1056 : tmp = scale*prim(p_index)
13407 1056 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13408 1056 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13409 1056 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13410 1584 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13411 : END DO
13412 528 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13413 792 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13414 : END DO
13415 : END DO
13416 : END DO
13417 16 : END SUBROUTINE block_2_2_4
13418 : ! **************************************************************************************************
13419 : !> \brief ...
13420 : !> \param mc_max ...
13421 : !> \param md_max ...
13422 : !> \param kbd ...
13423 : !> \param kbc ...
13424 : !> \param kad ...
13425 : !> \param kac ...
13426 : !> \param pbd ...
13427 : !> \param pbc ...
13428 : !> \param pad ...
13429 : !> \param pac ...
13430 : !> \param prim ...
13431 : !> \param scale ...
13432 : ! **************************************************************************************************
13433 64846 : SUBROUTINE block_2_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13434 : INTEGER :: mc_max, md_max
13435 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*mc_max), kad(2*md_max), kac(2*mc_max), pbd(2*md_max), &
13436 : pbc(2*mc_max), pad(2*md_max), pac(2*mc_max), prim(2*2*mc_max*md_max), scale
13437 :
13438 : INTEGER :: ma, mb, mc, md, p_index
13439 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13440 :
13441 621442 : kbd(1:2*md_max) = 0.0_dp
13442 718104 : kbc(1:2*mc_max) = 0.0_dp
13443 621442 : kad(1:2*md_max) = 0.0_dp
13444 718104 : kac(1:2*mc_max) = 0.0_dp
13445 : p_index = 0
13446 343144 : DO md = 1, md_max
13447 1743624 : DO mc = 1, mc_max
13448 4479738 : DO mb = 1, 2
13449 2800960 : ks_bd = 0.0_dp
13450 2800960 : ks_bc = 0.0_dp
13451 2800960 : p_bd = pbd((md - 1)*2 + mb)
13452 2800960 : p_bc = pbc((mc - 1)*2 + mb)
13453 8402880 : DO ma = 1, 2
13454 5601920 : p_index = p_index + 1
13455 5601920 : tmp = scale*prim(p_index)
13456 5601920 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13457 5601920 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13458 5601920 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13459 8402880 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13460 : END DO
13461 2800960 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13462 4201440 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13463 : END DO
13464 : END DO
13465 : END DO
13466 64846 : END SUBROUTINE block_2_2
13467 : ! **************************************************************************************************
13468 : !> \brief ...
13469 : !> \param kbd ...
13470 : !> \param kbc ...
13471 : !> \param kad ...
13472 : !> \param kac ...
13473 : !> \param pbd ...
13474 : !> \param pbc ...
13475 : !> \param pad ...
13476 : !> \param pac ...
13477 : !> \param prim ...
13478 : !> \param scale ...
13479 : ! **************************************************************************************************
13480 10667 : SUBROUTINE block_2_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13481 : REAL(KIND=dp) :: kbd(3*1), kbc(3*1), kad(2*1), kac(2*1), &
13482 : pbd(3*1), pbc(3*1), pad(2*1), &
13483 : pac(2*1), prim(2*3*1*1), scale
13484 :
13485 : INTEGER :: ma, mb, mc, md, p_index
13486 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13487 :
13488 10667 : kbd(1:3*1) = 0.0_dp
13489 10667 : kbc(1:3*1) = 0.0_dp
13490 10667 : kad(1:2*1) = 0.0_dp
13491 10667 : kac(1:2*1) = 0.0_dp
13492 10667 : p_index = 0
13493 21334 : DO md = 1, 1
13494 32001 : DO mc = 1, 1
13495 53335 : DO mb = 1, 3
13496 32001 : ks_bd = 0.0_dp
13497 32001 : ks_bc = 0.0_dp
13498 32001 : p_bd = pbd((md - 1)*3 + mb)
13499 32001 : p_bc = pbc((mc - 1)*3 + mb)
13500 96003 : DO ma = 1, 2
13501 64002 : p_index = p_index + 1
13502 64002 : tmp = scale*prim(p_index)
13503 64002 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13504 64002 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13505 64002 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13506 96003 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13507 : END DO
13508 32001 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
13509 42668 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
13510 : END DO
13511 : END DO
13512 : END DO
13513 10667 : END SUBROUTINE block_2_3_1_1
13514 : ! **************************************************************************************************
13515 : !> \brief ...
13516 : !> \param kbd ...
13517 : !> \param kbc ...
13518 : !> \param kad ...
13519 : !> \param kac ...
13520 : !> \param pbd ...
13521 : !> \param pbc ...
13522 : !> \param pad ...
13523 : !> \param pac ...
13524 : !> \param prim ...
13525 : !> \param scale ...
13526 : ! **************************************************************************************************
13527 1753 : SUBROUTINE block_2_3_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13528 : REAL(KIND=dp) :: kbd(3*2), kbc(3*1), kad(2*2), kac(2*1), &
13529 : pbd(3*2), pbc(3*1), pad(2*2), &
13530 : pac(2*1), prim(2*3*1*2), scale
13531 :
13532 : INTEGER :: ma, mb, mc, md, p_index
13533 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13534 :
13535 1753 : kbd(1:3*2) = 0.0_dp
13536 1753 : kbc(1:3*1) = 0.0_dp
13537 1753 : kad(1:2*2) = 0.0_dp
13538 1753 : kac(1:2*1) = 0.0_dp
13539 1753 : p_index = 0
13540 5259 : DO md = 1, 2
13541 8765 : DO mc = 1, 1
13542 17530 : DO mb = 1, 3
13543 10518 : ks_bd = 0.0_dp
13544 10518 : ks_bc = 0.0_dp
13545 10518 : p_bd = pbd((md - 1)*3 + mb)
13546 10518 : p_bc = pbc((mc - 1)*3 + mb)
13547 31554 : DO ma = 1, 2
13548 21036 : p_index = p_index + 1
13549 21036 : tmp = scale*prim(p_index)
13550 21036 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13551 21036 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13552 21036 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13553 31554 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13554 : END DO
13555 10518 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
13556 14024 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
13557 : END DO
13558 : END DO
13559 : END DO
13560 1753 : END SUBROUTINE block_2_3_1_2
13561 : ! **************************************************************************************************
13562 : !> \brief ...
13563 : !> \param kbd ...
13564 : !> \param kbc ...
13565 : !> \param kad ...
13566 : !> \param kac ...
13567 : !> \param pbd ...
13568 : !> \param pbc ...
13569 : !> \param pad ...
13570 : !> \param pac ...
13571 : !> \param prim ...
13572 : !> \param scale ...
13573 : ! **************************************************************************************************
13574 10383 : SUBROUTINE block_2_3_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13575 : REAL(KIND=dp) :: kbd(3*3), kbc(3*1), kad(2*3), kac(2*1), &
13576 : pbd(3*3), pbc(3*1), pad(2*3), &
13577 : pac(2*1), prim(2*3*1*3), scale
13578 :
13579 : INTEGER :: ma, mb, mc, md, p_index
13580 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13581 :
13582 10383 : kbd(1:3*3) = 0.0_dp
13583 10383 : kbc(1:3*1) = 0.0_dp
13584 10383 : kad(1:2*3) = 0.0_dp
13585 10383 : kac(1:2*1) = 0.0_dp
13586 10383 : p_index = 0
13587 41532 : DO md = 1, 3
13588 72681 : DO mc = 1, 1
13589 155745 : DO mb = 1, 3
13590 93447 : ks_bd = 0.0_dp
13591 93447 : ks_bc = 0.0_dp
13592 93447 : p_bd = pbd((md - 1)*3 + mb)
13593 93447 : p_bc = pbc((mc - 1)*3 + mb)
13594 280341 : DO ma = 1, 2
13595 186894 : p_index = p_index + 1
13596 186894 : tmp = scale*prim(p_index)
13597 186894 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13598 186894 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13599 186894 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13600 280341 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13601 : END DO
13602 93447 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
13603 124596 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
13604 : END DO
13605 : END DO
13606 : END DO
13607 10383 : END SUBROUTINE block_2_3_1_3
13608 : ! **************************************************************************************************
13609 : !> \brief ...
13610 : !> \param md_max ...
13611 : !> \param kbd ...
13612 : !> \param kbc ...
13613 : !> \param kad ...
13614 : !> \param kac ...
13615 : !> \param pbd ...
13616 : !> \param pbc ...
13617 : !> \param pad ...
13618 : !> \param pac ...
13619 : !> \param prim ...
13620 : !> \param scale ...
13621 : ! **************************************************************************************************
13622 4981 : SUBROUTINE block_2_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13623 : INTEGER :: md_max
13624 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*1), kad(2*md_max), kac(2*1), pbd(3*md_max), pbc(3*1), &
13625 : pad(2*md_max), pac(2*1), prim(2*3*1*md_max), scale
13626 :
13627 : INTEGER :: ma, mb, mc, md, p_index
13628 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13629 :
13630 85456 : kbd(1:3*md_max) = 0.0_dp
13631 4981 : kbc(1:3*1) = 0.0_dp
13632 58631 : kad(1:2*md_max) = 0.0_dp
13633 4981 : kac(1:2*1) = 0.0_dp
13634 4981 : p_index = 0
13635 31806 : DO md = 1, md_max
13636 58631 : DO mc = 1, 1
13637 134125 : DO mb = 1, 3
13638 80475 : ks_bd = 0.0_dp
13639 80475 : ks_bc = 0.0_dp
13640 80475 : p_bd = pbd((md - 1)*3 + mb)
13641 80475 : p_bc = pbc((mc - 1)*3 + mb)
13642 241425 : DO ma = 1, 2
13643 160950 : p_index = p_index + 1
13644 160950 : tmp = scale*prim(p_index)
13645 160950 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13646 160950 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13647 160950 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13648 241425 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13649 : END DO
13650 80475 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
13651 107300 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
13652 : END DO
13653 : END DO
13654 : END DO
13655 4981 : END SUBROUTINE block_2_3_1
13656 : ! **************************************************************************************************
13657 : !> \brief ...
13658 : !> \param kbd ...
13659 : !> \param kbc ...
13660 : !> \param kad ...
13661 : !> \param kac ...
13662 : !> \param pbd ...
13663 : !> \param pbc ...
13664 : !> \param pad ...
13665 : !> \param pac ...
13666 : !> \param prim ...
13667 : !> \param scale ...
13668 : ! **************************************************************************************************
13669 3800 : SUBROUTINE block_2_3_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13670 : REAL(KIND=dp) :: kbd(3*1), kbc(3*2), kad(2*1), kac(2*2), &
13671 : pbd(3*1), pbc(3*2), pad(2*1), &
13672 : pac(2*2), prim(2*3*2*1), scale
13673 :
13674 : INTEGER :: ma, mb, mc, md, p_index
13675 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13676 :
13677 3800 : kbd(1:3*1) = 0.0_dp
13678 3800 : kbc(1:3*2) = 0.0_dp
13679 3800 : kad(1:2*1) = 0.0_dp
13680 3800 : kac(1:2*2) = 0.0_dp
13681 3800 : p_index = 0
13682 7600 : DO md = 1, 1
13683 15200 : DO mc = 1, 2
13684 34200 : DO mb = 1, 3
13685 22800 : ks_bd = 0.0_dp
13686 22800 : ks_bc = 0.0_dp
13687 22800 : p_bd = pbd((md - 1)*3 + mb)
13688 22800 : p_bc = pbc((mc - 1)*3 + mb)
13689 68400 : DO ma = 1, 2
13690 45600 : p_index = p_index + 1
13691 45600 : tmp = scale*prim(p_index)
13692 45600 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13693 45600 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13694 45600 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13695 68400 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13696 : END DO
13697 22800 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
13698 30400 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
13699 : END DO
13700 : END DO
13701 : END DO
13702 3800 : END SUBROUTINE block_2_3_2_1
13703 : ! **************************************************************************************************
13704 : !> \brief ...
13705 : !> \param md_max ...
13706 : !> \param kbd ...
13707 : !> \param kbc ...
13708 : !> \param kad ...
13709 : !> \param kac ...
13710 : !> \param pbd ...
13711 : !> \param pbc ...
13712 : !> \param pad ...
13713 : !> \param pac ...
13714 : !> \param prim ...
13715 : !> \param scale ...
13716 : ! **************************************************************************************************
13717 35320 : SUBROUTINE block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13718 : INTEGER :: md_max
13719 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*2), kad(2*md_max), kac(2*2), pbd(3*md_max), pbc(3*2), &
13720 : pad(2*md_max), pac(2*2), prim(2*3*2*md_max), scale
13721 :
13722 : INTEGER :: ma, mb, mc, md, p_index
13723 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13724 :
13725 320851 : kbd(1:3*md_max) = 0.0_dp
13726 35320 : kbc(1:3*2) = 0.0_dp
13727 225674 : kad(1:2*md_max) = 0.0_dp
13728 35320 : kac(1:2*2) = 0.0_dp
13729 35320 : p_index = 0
13730 130497 : DO md = 1, md_max
13731 320851 : DO mc = 1, 2
13732 856593 : DO mb = 1, 3
13733 571062 : ks_bd = 0.0_dp
13734 571062 : ks_bc = 0.0_dp
13735 571062 : p_bd = pbd((md - 1)*3 + mb)
13736 571062 : p_bc = pbc((mc - 1)*3 + mb)
13737 1713186 : DO ma = 1, 2
13738 1142124 : p_index = p_index + 1
13739 1142124 : tmp = scale*prim(p_index)
13740 1142124 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13741 1142124 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13742 1142124 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13743 1713186 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13744 : END DO
13745 571062 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
13746 761416 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
13747 : END DO
13748 : END DO
13749 : END DO
13750 35320 : END SUBROUTINE block_2_3_2
13751 : ! **************************************************************************************************
13752 : !> \brief ...
13753 : !> \param kbd ...
13754 : !> \param kbc ...
13755 : !> \param kad ...
13756 : !> \param kac ...
13757 : !> \param pbd ...
13758 : !> \param pbc ...
13759 : !> \param pad ...
13760 : !> \param pac ...
13761 : !> \param prim ...
13762 : !> \param scale ...
13763 : ! **************************************************************************************************
13764 13798 : SUBROUTINE block_2_3_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13765 : REAL(KIND=dp) :: kbd(3*1), kbc(3*3), kad(2*1), kac(2*3), &
13766 : pbd(3*1), pbc(3*3), pad(2*1), &
13767 : pac(2*3), prim(2*3*3*1), scale
13768 :
13769 : INTEGER :: ma, mb, mc, md, p_index
13770 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13771 :
13772 13798 : kbd(1:3*1) = 0.0_dp
13773 13798 : kbc(1:3*3) = 0.0_dp
13774 13798 : kad(1:2*1) = 0.0_dp
13775 13798 : kac(1:2*3) = 0.0_dp
13776 13798 : p_index = 0
13777 27596 : DO md = 1, 1
13778 68990 : DO mc = 1, 3
13779 179374 : DO mb = 1, 3
13780 124182 : ks_bd = 0.0_dp
13781 124182 : ks_bc = 0.0_dp
13782 124182 : p_bd = pbd((md - 1)*3 + mb)
13783 124182 : p_bc = pbc((mc - 1)*3 + mb)
13784 372546 : DO ma = 1, 2
13785 248364 : p_index = p_index + 1
13786 248364 : tmp = scale*prim(p_index)
13787 248364 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13788 248364 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13789 248364 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13790 372546 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13791 : END DO
13792 124182 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
13793 165576 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
13794 : END DO
13795 : END DO
13796 : END DO
13797 13798 : END SUBROUTINE block_2_3_3_1
13798 : ! **************************************************************************************************
13799 : !> \brief ...
13800 : !> \param md_max ...
13801 : !> \param kbd ...
13802 : !> \param kbc ...
13803 : !> \param kad ...
13804 : !> \param kac ...
13805 : !> \param pbd ...
13806 : !> \param pbc ...
13807 : !> \param pad ...
13808 : !> \param pac ...
13809 : !> \param prim ...
13810 : !> \param scale ...
13811 : ! **************************************************************************************************
13812 48277 : SUBROUTINE block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13813 : INTEGER :: md_max
13814 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*3), kad(2*md_max), kac(2*3), pbd(3*md_max), pbc(3*3), &
13815 : pad(2*md_max), pac(2*3), prim(2*3*3*md_max), scale
13816 :
13817 : INTEGER :: ma, mb, mc, md, p_index
13818 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13819 :
13820 486031 : kbd(1:3*md_max) = 0.0_dp
13821 48277 : kbc(1:3*3) = 0.0_dp
13822 340113 : kad(1:2*md_max) = 0.0_dp
13823 48277 : kac(1:2*3) = 0.0_dp
13824 48277 : p_index = 0
13825 194195 : DO md = 1, md_max
13826 631949 : DO mc = 1, 3
13827 1896934 : DO mb = 1, 3
13828 1313262 : ks_bd = 0.0_dp
13829 1313262 : ks_bc = 0.0_dp
13830 1313262 : p_bd = pbd((md - 1)*3 + mb)
13831 1313262 : p_bc = pbc((mc - 1)*3 + mb)
13832 3939786 : DO ma = 1, 2
13833 2626524 : p_index = p_index + 1
13834 2626524 : tmp = scale*prim(p_index)
13835 2626524 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13836 2626524 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13837 2626524 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13838 3939786 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13839 : END DO
13840 1313262 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
13841 1751016 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
13842 : END DO
13843 : END DO
13844 : END DO
13845 48277 : END SUBROUTINE block_2_3_3
13846 : ! **************************************************************************************************
13847 : !> \brief ...
13848 : !> \param mc_max ...
13849 : !> \param md_max ...
13850 : !> \param kbd ...
13851 : !> \param kbc ...
13852 : !> \param kad ...
13853 : !> \param kac ...
13854 : !> \param pbd ...
13855 : !> \param pbc ...
13856 : !> \param pad ...
13857 : !> \param pac ...
13858 : !> \param prim ...
13859 : !> \param scale ...
13860 : ! **************************************************************************************************
13861 53305 : SUBROUTINE block_2_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13862 : INTEGER :: mc_max, md_max
13863 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*mc_max), kad(2*md_max), kac(2*mc_max), pbd(3*md_max), &
13864 : pbc(3*mc_max), pad(2*md_max), pac(2*mc_max), prim(2*3*mc_max*md_max), scale
13865 :
13866 : INTEGER :: ma, mb, mc, md, p_index
13867 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13868 :
13869 612334 : kbd(1:3*md_max) = 0.0_dp
13870 878440 : kbc(1:3*mc_max) = 0.0_dp
13871 425991 : kad(1:2*md_max) = 0.0_dp
13872 603395 : kac(1:2*mc_max) = 0.0_dp
13873 : p_index = 0
13874 239648 : DO md = 1, md_max
13875 1201599 : DO mc = 1, mc_max
13876 4034147 : DO mb = 1, 3
13877 2885853 : ks_bd = 0.0_dp
13878 2885853 : ks_bc = 0.0_dp
13879 2885853 : p_bd = pbd((md - 1)*3 + mb)
13880 2885853 : p_bc = pbc((mc - 1)*3 + mb)
13881 8657559 : DO ma = 1, 2
13882 5771706 : p_index = p_index + 1
13883 5771706 : tmp = scale*prim(p_index)
13884 5771706 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13885 5771706 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13886 5771706 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13887 8657559 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13888 : END DO
13889 2885853 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
13890 3847804 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
13891 : END DO
13892 : END DO
13893 : END DO
13894 53305 : END SUBROUTINE block_2_3
13895 : ! **************************************************************************************************
13896 : !> \brief ...
13897 : !> \param kbd ...
13898 : !> \param kbc ...
13899 : !> \param kad ...
13900 : !> \param kac ...
13901 : !> \param pbd ...
13902 : !> \param pbc ...
13903 : !> \param pad ...
13904 : !> \param pac ...
13905 : !> \param prim ...
13906 : !> \param scale ...
13907 : ! **************************************************************************************************
13908 8 : SUBROUTINE block_2_4_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13909 : REAL(KIND=dp) :: kbd(4*1), kbc(4*1), kad(2*1), kac(2*1), &
13910 : pbd(4*1), pbc(4*1), pad(2*1), &
13911 : pac(2*1), prim(2*4*1*1), scale
13912 :
13913 : INTEGER :: ma, mb, mc, md, p_index
13914 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13915 :
13916 8 : kbd(1:4*1) = 0.0_dp
13917 8 : kbc(1:4*1) = 0.0_dp
13918 8 : kad(1:2*1) = 0.0_dp
13919 8 : kac(1:2*1) = 0.0_dp
13920 8 : p_index = 0
13921 16 : DO md = 1, 1
13922 24 : DO mc = 1, 1
13923 48 : DO mb = 1, 4
13924 32 : ks_bd = 0.0_dp
13925 32 : ks_bc = 0.0_dp
13926 32 : p_bd = pbd((md - 1)*4 + mb)
13927 32 : p_bc = pbc((mc - 1)*4 + mb)
13928 96 : DO ma = 1, 2
13929 64 : p_index = p_index + 1
13930 64 : tmp = scale*prim(p_index)
13931 64 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13932 64 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13933 64 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13934 96 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13935 : END DO
13936 32 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
13937 40 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
13938 : END DO
13939 : END DO
13940 : END DO
13941 8 : END SUBROUTINE block_2_4_1_1
13942 : ! **************************************************************************************************
13943 : !> \brief ...
13944 : !> \param kbd ...
13945 : !> \param kbc ...
13946 : !> \param kad ...
13947 : !> \param kac ...
13948 : !> \param pbd ...
13949 : !> \param pbc ...
13950 : !> \param pad ...
13951 : !> \param pac ...
13952 : !> \param prim ...
13953 : !> \param scale ...
13954 : ! **************************************************************************************************
13955 8 : SUBROUTINE block_2_4_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
13956 : REAL(KIND=dp) :: kbd(4*2), kbc(4*1), kad(2*2), kac(2*1), &
13957 : pbd(4*2), pbc(4*1), pad(2*2), &
13958 : pac(2*1), prim(2*4*1*2), scale
13959 :
13960 : INTEGER :: ma, mb, mc, md, p_index
13961 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
13962 :
13963 8 : kbd(1:4*2) = 0.0_dp
13964 8 : kbc(1:4*1) = 0.0_dp
13965 8 : kad(1:2*2) = 0.0_dp
13966 8 : kac(1:2*1) = 0.0_dp
13967 8 : p_index = 0
13968 24 : DO md = 1, 2
13969 40 : DO mc = 1, 1
13970 96 : DO mb = 1, 4
13971 64 : ks_bd = 0.0_dp
13972 64 : ks_bc = 0.0_dp
13973 64 : p_bd = pbd((md - 1)*4 + mb)
13974 64 : p_bc = pbc((mc - 1)*4 + mb)
13975 192 : DO ma = 1, 2
13976 128 : p_index = p_index + 1
13977 128 : tmp = scale*prim(p_index)
13978 128 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13979 128 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13980 128 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13981 192 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13982 : END DO
13983 64 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
13984 80 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
13985 : END DO
13986 : END DO
13987 : END DO
13988 8 : END SUBROUTINE block_2_4_1_2
13989 : ! **************************************************************************************************
13990 : !> \brief ...
13991 : !> \param md_max ...
13992 : !> \param kbd ...
13993 : !> \param kbc ...
13994 : !> \param kad ...
13995 : !> \param kac ...
13996 : !> \param pbd ...
13997 : !> \param pbc ...
13998 : !> \param pad ...
13999 : !> \param pac ...
14000 : !> \param prim ...
14001 : !> \param scale ...
14002 : ! **************************************************************************************************
14003 24 : SUBROUTINE block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14004 : INTEGER :: md_max
14005 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*1), kad(2*md_max), kac(2*1), pbd(4*md_max), pbc(4*1), &
14006 : pad(2*md_max), pac(2*1), prim(2*4*1*md_max), scale
14007 :
14008 : INTEGER :: ma, mb, mc, md, p_index
14009 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14010 :
14011 428 : kbd(1:4*md_max) = 0.0_dp
14012 24 : kbc(1:4*1) = 0.0_dp
14013 226 : kad(1:2*md_max) = 0.0_dp
14014 24 : kac(1:2*1) = 0.0_dp
14015 24 : p_index = 0
14016 125 : DO md = 1, md_max
14017 226 : DO mc = 1, 1
14018 606 : DO mb = 1, 4
14019 404 : ks_bd = 0.0_dp
14020 404 : ks_bc = 0.0_dp
14021 404 : p_bd = pbd((md - 1)*4 + mb)
14022 404 : p_bc = pbc((mc - 1)*4 + mb)
14023 1212 : DO ma = 1, 2
14024 808 : p_index = p_index + 1
14025 808 : tmp = scale*prim(p_index)
14026 808 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14027 808 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14028 808 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14029 1212 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14030 : END DO
14031 404 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
14032 505 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
14033 : END DO
14034 : END DO
14035 : END DO
14036 24 : END SUBROUTINE block_2_4_1
14037 : ! **************************************************************************************************
14038 : !> \brief ...
14039 : !> \param kbd ...
14040 : !> \param kbc ...
14041 : !> \param kad ...
14042 : !> \param kac ...
14043 : !> \param pbd ...
14044 : !> \param pbc ...
14045 : !> \param pad ...
14046 : !> \param pac ...
14047 : !> \param prim ...
14048 : !> \param scale ...
14049 : ! **************************************************************************************************
14050 2 : SUBROUTINE block_2_4_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14051 : REAL(KIND=dp) :: kbd(4*1), kbc(4*2), kad(2*1), kac(2*2), &
14052 : pbd(4*1), pbc(4*2), pad(2*1), &
14053 : pac(2*2), prim(2*4*2*1), scale
14054 :
14055 : INTEGER :: ma, mb, mc, md, p_index
14056 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14057 :
14058 2 : kbd(1:4*1) = 0.0_dp
14059 2 : kbc(1:4*2) = 0.0_dp
14060 2 : kad(1:2*1) = 0.0_dp
14061 2 : kac(1:2*2) = 0.0_dp
14062 2 : p_index = 0
14063 4 : DO md = 1, 1
14064 8 : DO mc = 1, 2
14065 22 : DO mb = 1, 4
14066 16 : ks_bd = 0.0_dp
14067 16 : ks_bc = 0.0_dp
14068 16 : p_bd = pbd((md - 1)*4 + mb)
14069 16 : p_bc = pbc((mc - 1)*4 + mb)
14070 48 : DO ma = 1, 2
14071 32 : p_index = p_index + 1
14072 32 : tmp = scale*prim(p_index)
14073 32 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14074 32 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14075 32 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14076 48 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14077 : END DO
14078 16 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
14079 20 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
14080 : END DO
14081 : END DO
14082 : END DO
14083 2 : END SUBROUTINE block_2_4_2_1
14084 : ! **************************************************************************************************
14085 : !> \brief ...
14086 : !> \param md_max ...
14087 : !> \param kbd ...
14088 : !> \param kbc ...
14089 : !> \param kad ...
14090 : !> \param kac ...
14091 : !> \param pbd ...
14092 : !> \param pbc ...
14093 : !> \param pad ...
14094 : !> \param pac ...
14095 : !> \param prim ...
14096 : !> \param scale ...
14097 : ! **************************************************************************************************
14098 30 : SUBROUTINE block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14099 : INTEGER :: md_max
14100 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*2), kad(2*md_max), kac(2*2), pbd(4*md_max), pbc(4*2), &
14101 : pad(2*md_max), pac(2*2), prim(2*4*2*md_max), scale
14102 :
14103 : INTEGER :: ma, mb, mc, md, p_index
14104 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14105 :
14106 458 : kbd(1:4*md_max) = 0.0_dp
14107 30 : kbc(1:4*2) = 0.0_dp
14108 244 : kad(1:2*md_max) = 0.0_dp
14109 30 : kac(1:2*2) = 0.0_dp
14110 30 : p_index = 0
14111 137 : DO md = 1, md_max
14112 351 : DO mc = 1, 2
14113 1177 : DO mb = 1, 4
14114 856 : ks_bd = 0.0_dp
14115 856 : ks_bc = 0.0_dp
14116 856 : p_bd = pbd((md - 1)*4 + mb)
14117 856 : p_bc = pbc((mc - 1)*4 + mb)
14118 2568 : DO ma = 1, 2
14119 1712 : p_index = p_index + 1
14120 1712 : tmp = scale*prim(p_index)
14121 1712 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14122 1712 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14123 1712 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14124 2568 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14125 : END DO
14126 856 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
14127 1070 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
14128 : END DO
14129 : END DO
14130 : END DO
14131 30 : END SUBROUTINE block_2_4_2
14132 : ! **************************************************************************************************
14133 : !> \brief ...
14134 : !> \param mc_max ...
14135 : !> \param md_max ...
14136 : !> \param kbd ...
14137 : !> \param kbc ...
14138 : !> \param kad ...
14139 : !> \param kac ...
14140 : !> \param pbd ...
14141 : !> \param pbc ...
14142 : !> \param pad ...
14143 : !> \param pac ...
14144 : !> \param prim ...
14145 : !> \param scale ...
14146 : ! **************************************************************************************************
14147 57 : SUBROUTINE block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14148 : INTEGER :: mc_max, md_max
14149 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*mc_max), kad(2*md_max), kac(2*mc_max), pbd(4*md_max), &
14150 : pbc(4*mc_max), pad(2*md_max), pac(2*mc_max), prim(2*4*mc_max*md_max), scale
14151 :
14152 : INTEGER :: ma, mb, mc, md, p_index
14153 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14154 :
14155 921 : kbd(1:4*md_max) = 0.0_dp
14156 977 : kbc(1:4*mc_max) = 0.0_dp
14157 489 : kad(1:2*md_max) = 0.0_dp
14158 517 : kac(1:2*mc_max) = 0.0_dp
14159 : p_index = 0
14160 273 : DO md = 1, md_max
14161 1154 : DO mc = 1, mc_max
14162 4621 : DO mb = 1, 4
14163 3524 : ks_bd = 0.0_dp
14164 3524 : ks_bc = 0.0_dp
14165 3524 : p_bd = pbd((md - 1)*4 + mb)
14166 3524 : p_bc = pbc((mc - 1)*4 + mb)
14167 10572 : DO ma = 1, 2
14168 7048 : p_index = p_index + 1
14169 7048 : tmp = scale*prim(p_index)
14170 7048 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14171 7048 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14172 7048 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14173 10572 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14174 : END DO
14175 3524 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
14176 4405 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
14177 : END DO
14178 : END DO
14179 : END DO
14180 57 : END SUBROUTINE block_2_4
14181 : ! **************************************************************************************************
14182 : !> \brief ...
14183 : !> \param kbd ...
14184 : !> \param kbc ...
14185 : !> \param kad ...
14186 : !> \param kac ...
14187 : !> \param pbd ...
14188 : !> \param pbc ...
14189 : !> \param pad ...
14190 : !> \param pac ...
14191 : !> \param prim ...
14192 : !> \param scale ...
14193 : ! **************************************************************************************************
14194 1729 : SUBROUTINE block_2_5_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14195 : REAL(KIND=dp) :: kbd(5*1), kbc(5*1), kad(2*1), kac(2*1), &
14196 : pbd(5*1), pbc(5*1), pad(2*1), &
14197 : pac(2*1), prim(2*5*1*1), scale
14198 :
14199 : INTEGER :: ma, mb, mc, md, p_index
14200 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14201 :
14202 1729 : kbd(1:5*1) = 0.0_dp
14203 1729 : kbc(1:5*1) = 0.0_dp
14204 1729 : kad(1:2*1) = 0.0_dp
14205 1729 : kac(1:2*1) = 0.0_dp
14206 1729 : p_index = 0
14207 3458 : DO md = 1, 1
14208 5187 : DO mc = 1, 1
14209 12103 : DO mb = 1, 5
14210 8645 : ks_bd = 0.0_dp
14211 8645 : ks_bc = 0.0_dp
14212 8645 : p_bd = pbd((md - 1)*5 + mb)
14213 8645 : p_bc = pbc((mc - 1)*5 + mb)
14214 25935 : DO ma = 1, 2
14215 17290 : p_index = p_index + 1
14216 17290 : tmp = scale*prim(p_index)
14217 17290 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14218 17290 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14219 17290 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14220 25935 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14221 : END DO
14222 8645 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
14223 10374 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
14224 : END DO
14225 : END DO
14226 : END DO
14227 1729 : END SUBROUTINE block_2_5_1_1
14228 : ! **************************************************************************************************
14229 : !> \brief ...
14230 : !> \param md_max ...
14231 : !> \param kbd ...
14232 : !> \param kbc ...
14233 : !> \param kad ...
14234 : !> \param kac ...
14235 : !> \param pbd ...
14236 : !> \param pbc ...
14237 : !> \param pad ...
14238 : !> \param pac ...
14239 : !> \param prim ...
14240 : !> \param scale ...
14241 : ! **************************************************************************************************
14242 5551 : SUBROUTINE block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14243 : INTEGER :: md_max
14244 : REAL(KIND=dp) :: kbd(5*md_max), kbc(5*1), kad(2*md_max), kac(2*1), pbd(5*md_max), pbc(5*1), &
14245 : pad(2*md_max), pac(2*1), prim(2*5*1*md_max), scale
14246 :
14247 : INTEGER :: ma, mb, mc, md, p_index
14248 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14249 :
14250 117576 : kbd(1:5*md_max) = 0.0_dp
14251 5551 : kbc(1:5*1) = 0.0_dp
14252 50361 : kad(1:2*md_max) = 0.0_dp
14253 5551 : kac(1:2*1) = 0.0_dp
14254 5551 : p_index = 0
14255 27956 : DO md = 1, md_max
14256 50361 : DO mc = 1, 1
14257 156835 : DO mb = 1, 5
14258 112025 : ks_bd = 0.0_dp
14259 112025 : ks_bc = 0.0_dp
14260 112025 : p_bd = pbd((md - 1)*5 + mb)
14261 112025 : p_bc = pbc((mc - 1)*5 + mb)
14262 336075 : DO ma = 1, 2
14263 224050 : p_index = p_index + 1
14264 224050 : tmp = scale*prim(p_index)
14265 224050 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14266 224050 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14267 224050 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14268 336075 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14269 : END DO
14270 112025 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
14271 134430 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
14272 : END DO
14273 : END DO
14274 : END DO
14275 5551 : END SUBROUTINE block_2_5_1
14276 : ! **************************************************************************************************
14277 : !> \brief ...
14278 : !> \param mc_max ...
14279 : !> \param md_max ...
14280 : !> \param kbd ...
14281 : !> \param kbc ...
14282 : !> \param kad ...
14283 : !> \param kac ...
14284 : !> \param pbd ...
14285 : !> \param pbc ...
14286 : !> \param pad ...
14287 : !> \param pac ...
14288 : !> \param prim ...
14289 : !> \param scale ...
14290 : ! **************************************************************************************************
14291 23682 : SUBROUTINE block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14292 : INTEGER :: mc_max, md_max
14293 : REAL(KIND=dp) :: kbd(5*md_max), kbc(5*mc_max), kad(2*md_max), kac(2*mc_max), pbd(5*md_max), &
14294 : pbc(5*mc_max), pad(2*md_max), pac(2*mc_max), prim(2*5*mc_max*md_max), scale
14295 :
14296 : INTEGER :: ma, mb, mc, md, p_index
14297 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14298 :
14299 417657 : kbd(1:5*md_max) = 0.0_dp
14300 500942 : kbc(1:5*mc_max) = 0.0_dp
14301 181272 : kad(1:2*md_max) = 0.0_dp
14302 214586 : kac(1:2*mc_max) = 0.0_dp
14303 : p_index = 0
14304 102477 : DO md = 1, md_max
14305 422481 : DO mc = 1, mc_max
14306 1998819 : DO mb = 1, 5
14307 1600020 : ks_bd = 0.0_dp
14308 1600020 : ks_bc = 0.0_dp
14309 1600020 : p_bd = pbd((md - 1)*5 + mb)
14310 1600020 : p_bc = pbc((mc - 1)*5 + mb)
14311 4800060 : DO ma = 1, 2
14312 3200040 : p_index = p_index + 1
14313 3200040 : tmp = scale*prim(p_index)
14314 3200040 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14315 3200040 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14316 3200040 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14317 4800060 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14318 : END DO
14319 1600020 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
14320 1920024 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
14321 : END DO
14322 : END DO
14323 : END DO
14324 23682 : END SUBROUTINE block_2_5
14325 : ! **************************************************************************************************
14326 : !> \brief ...
14327 : !> \param kbd ...
14328 : !> \param kbc ...
14329 : !> \param kad ...
14330 : !> \param kac ...
14331 : !> \param pbd ...
14332 : !> \param pbc ...
14333 : !> \param pad ...
14334 : !> \param pac ...
14335 : !> \param prim ...
14336 : !> \param scale ...
14337 : ! **************************************************************************************************
14338 10 : SUBROUTINE block_2_6_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14339 : REAL(KIND=dp) :: kbd(6*1), kbc(6*1), kad(2*1), kac(2*1), &
14340 : pbd(6*1), pbc(6*1), pad(2*1), &
14341 : pac(2*1), prim(2*6*1*1), scale
14342 :
14343 : INTEGER :: ma, mb, mc, md, p_index
14344 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14345 :
14346 10 : kbd(1:6*1) = 0.0_dp
14347 10 : kbc(1:6*1) = 0.0_dp
14348 10 : kad(1:2*1) = 0.0_dp
14349 10 : kac(1:2*1) = 0.0_dp
14350 10 : p_index = 0
14351 20 : DO md = 1, 1
14352 30 : DO mc = 1, 1
14353 80 : DO mb = 1, 6
14354 60 : ks_bd = 0.0_dp
14355 60 : ks_bc = 0.0_dp
14356 60 : p_bd = pbd((md - 1)*6 + mb)
14357 60 : p_bc = pbc((mc - 1)*6 + mb)
14358 180 : DO ma = 1, 2
14359 120 : p_index = p_index + 1
14360 120 : tmp = scale*prim(p_index)
14361 120 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14362 120 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14363 120 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14364 180 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14365 : END DO
14366 60 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
14367 70 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
14368 : END DO
14369 : END DO
14370 : END DO
14371 10 : END SUBROUTINE block_2_6_1_1
14372 : ! **************************************************************************************************
14373 : !> \brief ...
14374 : !> \param md_max ...
14375 : !> \param kbd ...
14376 : !> \param kbc ...
14377 : !> \param kad ...
14378 : !> \param kac ...
14379 : !> \param pbd ...
14380 : !> \param pbc ...
14381 : !> \param pad ...
14382 : !> \param pac ...
14383 : !> \param prim ...
14384 : !> \param scale ...
14385 : ! **************************************************************************************************
14386 47 : SUBROUTINE block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14387 : INTEGER :: md_max
14388 : REAL(KIND=dp) :: kbd(6*md_max), kbc(6*1), kad(2*md_max), kac(2*1), pbd(6*md_max), pbc(6*1), &
14389 : pad(2*md_max), pac(2*1), prim(2*6*1*md_max), scale
14390 :
14391 : INTEGER :: ma, mb, mc, md, p_index
14392 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14393 :
14394 1283 : kbd(1:6*md_max) = 0.0_dp
14395 47 : kbc(1:6*1) = 0.0_dp
14396 459 : kad(1:2*md_max) = 0.0_dp
14397 47 : kac(1:2*1) = 0.0_dp
14398 47 : p_index = 0
14399 253 : DO md = 1, md_max
14400 459 : DO mc = 1, 1
14401 1648 : DO mb = 1, 6
14402 1236 : ks_bd = 0.0_dp
14403 1236 : ks_bc = 0.0_dp
14404 1236 : p_bd = pbd((md - 1)*6 + mb)
14405 1236 : p_bc = pbc((mc - 1)*6 + mb)
14406 3708 : DO ma = 1, 2
14407 2472 : p_index = p_index + 1
14408 2472 : tmp = scale*prim(p_index)
14409 2472 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14410 2472 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14411 2472 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14412 3708 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14413 : END DO
14414 1236 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
14415 1442 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
14416 : END DO
14417 : END DO
14418 : END DO
14419 47 : END SUBROUTINE block_2_6_1
14420 : ! **************************************************************************************************
14421 : !> \brief ...
14422 : !> \param mc_max ...
14423 : !> \param md_max ...
14424 : !> \param kbd ...
14425 : !> \param kbc ...
14426 : !> \param kad ...
14427 : !> \param kac ...
14428 : !> \param pbd ...
14429 : !> \param pbc ...
14430 : !> \param pad ...
14431 : !> \param pac ...
14432 : !> \param prim ...
14433 : !> \param scale ...
14434 : ! **************************************************************************************************
14435 149 : SUBROUTINE block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14436 : INTEGER :: mc_max, md_max
14437 : REAL(KIND=dp) :: kbd(6*md_max), kbc(6*mc_max), kad(2*md_max), kac(2*mc_max), pbd(6*md_max), &
14438 : pbc(6*mc_max), pad(2*md_max), pac(2*mc_max), prim(2*6*mc_max*md_max), scale
14439 :
14440 : INTEGER :: ma, mb, mc, md, p_index
14441 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14442 :
14443 3989 : kbd(1:6*md_max) = 0.0_dp
14444 3197 : kbc(1:6*mc_max) = 0.0_dp
14445 1429 : kad(1:2*md_max) = 0.0_dp
14446 1165 : kac(1:2*mc_max) = 0.0_dp
14447 : p_index = 0
14448 789 : DO md = 1, md_max
14449 3016 : DO mc = 1, mc_max
14450 16229 : DO mb = 1, 6
14451 13362 : ks_bd = 0.0_dp
14452 13362 : ks_bc = 0.0_dp
14453 13362 : p_bd = pbd((md - 1)*6 + mb)
14454 13362 : p_bc = pbc((mc - 1)*6 + mb)
14455 40086 : DO ma = 1, 2
14456 26724 : p_index = p_index + 1
14457 26724 : tmp = scale*prim(p_index)
14458 26724 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14459 26724 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14460 26724 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14461 40086 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14462 : END DO
14463 13362 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
14464 15589 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
14465 : END DO
14466 : END DO
14467 : END DO
14468 149 : END SUBROUTINE block_2_6
14469 : ! **************************************************************************************************
14470 : !> \brief ...
14471 : !> \param kbd ...
14472 : !> \param kbc ...
14473 : !> \param kad ...
14474 : !> \param kac ...
14475 : !> \param pbd ...
14476 : !> \param pbc ...
14477 : !> \param pad ...
14478 : !> \param pac ...
14479 : !> \param prim ...
14480 : !> \param scale ...
14481 : ! **************************************************************************************************
14482 739 : SUBROUTINE block_2_7_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14483 : REAL(KIND=dp) :: kbd(7*1), kbc(7*1), kad(2*1), kac(2*1), &
14484 : pbd(7*1), pbc(7*1), pad(2*1), &
14485 : pac(2*1), prim(2*7*1*1), scale
14486 :
14487 : INTEGER :: ma, mb, mc, md, p_index
14488 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14489 :
14490 739 : kbd(1:7*1) = 0.0_dp
14491 739 : kbc(1:7*1) = 0.0_dp
14492 739 : kad(1:2*1) = 0.0_dp
14493 739 : kac(1:2*1) = 0.0_dp
14494 739 : p_index = 0
14495 1478 : DO md = 1, 1
14496 2217 : DO mc = 1, 1
14497 6651 : DO mb = 1, 7
14498 5173 : ks_bd = 0.0_dp
14499 5173 : ks_bc = 0.0_dp
14500 5173 : p_bd = pbd((md - 1)*7 + mb)
14501 5173 : p_bc = pbc((mc - 1)*7 + mb)
14502 15519 : DO ma = 1, 2
14503 10346 : p_index = p_index + 1
14504 10346 : tmp = scale*prim(p_index)
14505 10346 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14506 10346 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14507 10346 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14508 15519 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14509 : END DO
14510 5173 : kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
14511 5912 : kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
14512 : END DO
14513 : END DO
14514 : END DO
14515 739 : END SUBROUTINE block_2_7_1_1
14516 : ! **************************************************************************************************
14517 : !> \brief ...
14518 : !> \param md_max ...
14519 : !> \param kbd ...
14520 : !> \param kbc ...
14521 : !> \param kad ...
14522 : !> \param kac ...
14523 : !> \param pbd ...
14524 : !> \param pbc ...
14525 : !> \param pad ...
14526 : !> \param pac ...
14527 : !> \param prim ...
14528 : !> \param scale ...
14529 : ! **************************************************************************************************
14530 2478 : SUBROUTINE block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14531 : INTEGER :: md_max
14532 : REAL(KIND=dp) :: kbd(7*md_max), kbc(7*1), kad(2*md_max), kac(2*1), pbd(7*md_max), pbc(7*1), &
14533 : pad(2*md_max), pac(2*1), prim(2*7*1*md_max), scale
14534 :
14535 : INTEGER :: ma, mb, mc, md, p_index
14536 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14537 :
14538 77119 : kbd(1:7*md_max) = 0.0_dp
14539 2478 : kbc(1:7*1) = 0.0_dp
14540 23804 : kad(1:2*md_max) = 0.0_dp
14541 2478 : kac(1:2*1) = 0.0_dp
14542 2478 : p_index = 0
14543 13141 : DO md = 1, md_max
14544 23804 : DO mc = 1, 1
14545 95967 : DO mb = 1, 7
14546 74641 : ks_bd = 0.0_dp
14547 74641 : ks_bc = 0.0_dp
14548 74641 : p_bd = pbd((md - 1)*7 + mb)
14549 74641 : p_bc = pbc((mc - 1)*7 + mb)
14550 223923 : DO ma = 1, 2
14551 149282 : p_index = p_index + 1
14552 149282 : tmp = scale*prim(p_index)
14553 149282 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14554 149282 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14555 149282 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14556 223923 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14557 : END DO
14558 74641 : kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
14559 85304 : kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
14560 : END DO
14561 : END DO
14562 : END DO
14563 2478 : END SUBROUTINE block_2_7_1
14564 : ! **************************************************************************************************
14565 : !> \brief ...
14566 : !> \param mc_max ...
14567 : !> \param md_max ...
14568 : !> \param kbd ...
14569 : !> \param kbc ...
14570 : !> \param kad ...
14571 : !> \param kac ...
14572 : !> \param pbd ...
14573 : !> \param pbc ...
14574 : !> \param pad ...
14575 : !> \param pac ...
14576 : !> \param prim ...
14577 : !> \param scale ...
14578 : ! **************************************************************************************************
14579 10829 : SUBROUTINE block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14580 : INTEGER :: mc_max, md_max
14581 : REAL(KIND=dp) :: kbd(7*md_max), kbc(7*mc_max), kad(2*md_max), kac(2*mc_max), pbd(7*md_max), &
14582 : pbc(7*mc_max), pad(2*md_max), pac(2*mc_max), prim(2*7*mc_max*md_max), scale
14583 :
14584 : INTEGER :: ma, mb, mc, md, p_index
14585 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14586 :
14587 278376 : kbd(1:7*md_max) = 0.0_dp
14588 334943 : kbc(1:7*mc_max) = 0.0_dp
14589 87271 : kad(1:2*md_max) = 0.0_dp
14590 103433 : kac(1:2*mc_max) = 0.0_dp
14591 : p_index = 0
14592 49050 : DO md = 1, md_max
14593 212197 : DO mc = 1, mc_max
14594 1343397 : DO mb = 1, 7
14595 1142029 : ks_bd = 0.0_dp
14596 1142029 : ks_bc = 0.0_dp
14597 1142029 : p_bd = pbd((md - 1)*7 + mb)
14598 1142029 : p_bc = pbc((mc - 1)*7 + mb)
14599 3426087 : DO ma = 1, 2
14600 2284058 : p_index = p_index + 1
14601 2284058 : tmp = scale*prim(p_index)
14602 2284058 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14603 2284058 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14604 2284058 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14605 3426087 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14606 : END DO
14607 1142029 : kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
14608 1305176 : kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
14609 : END DO
14610 : END DO
14611 : END DO
14612 10829 : END SUBROUTINE block_2_7
14613 : ! **************************************************************************************************
14614 : !> \brief ...
14615 : !> \param kbd ...
14616 : !> \param kbc ...
14617 : !> \param kad ...
14618 : !> \param kac ...
14619 : !> \param pbd ...
14620 : !> \param pbc ...
14621 : !> \param pad ...
14622 : !> \param pac ...
14623 : !> \param prim ...
14624 : !> \param scale ...
14625 : ! **************************************************************************************************
14626 3 : SUBROUTINE block_2_9_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14627 : REAL(KIND=dp) :: kbd(9*1), kbc(9*1), kad(2*1), kac(2*1), &
14628 : pbd(9*1), pbc(9*1), pad(2*1), &
14629 : pac(2*1), prim(2*9*1*1), scale
14630 :
14631 : INTEGER :: ma, mb, mc, md, p_index
14632 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14633 :
14634 3 : kbd(1:9*1) = 0.0_dp
14635 3 : kbc(1:9*1) = 0.0_dp
14636 3 : kad(1:2*1) = 0.0_dp
14637 3 : kac(1:2*1) = 0.0_dp
14638 3 : p_index = 0
14639 6 : DO md = 1, 1
14640 9 : DO mc = 1, 1
14641 33 : DO mb = 1, 9
14642 27 : ks_bd = 0.0_dp
14643 27 : ks_bc = 0.0_dp
14644 27 : p_bd = pbd((md - 1)*9 + mb)
14645 27 : p_bc = pbc((mc - 1)*9 + mb)
14646 81 : DO ma = 1, 2
14647 54 : p_index = p_index + 1
14648 54 : tmp = scale*prim(p_index)
14649 54 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14650 54 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14651 54 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14652 81 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14653 : END DO
14654 27 : kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
14655 30 : kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
14656 : END DO
14657 : END DO
14658 : END DO
14659 3 : END SUBROUTINE block_2_9_1_1
14660 : ! **************************************************************************************************
14661 : !> \brief ...
14662 : !> \param md_max ...
14663 : !> \param kbd ...
14664 : !> \param kbc ...
14665 : !> \param kad ...
14666 : !> \param kac ...
14667 : !> \param pbd ...
14668 : !> \param pbc ...
14669 : !> \param pad ...
14670 : !> \param pac ...
14671 : !> \param prim ...
14672 : !> \param scale ...
14673 : ! **************************************************************************************************
14674 19 : SUBROUTINE block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14675 : INTEGER :: md_max
14676 : REAL(KIND=dp) :: kbd(9*md_max), kbc(9*1), kad(2*md_max), kac(2*1), pbd(9*md_max), pbc(9*1), &
14677 : pad(2*md_max), pac(2*1), prim(2*9*1*md_max), scale
14678 :
14679 : INTEGER :: ma, mb, mc, md, p_index
14680 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14681 :
14682 1054 : kbd(1:9*md_max) = 0.0_dp
14683 19 : kbc(1:9*1) = 0.0_dp
14684 249 : kad(1:2*md_max) = 0.0_dp
14685 19 : kac(1:2*1) = 0.0_dp
14686 19 : p_index = 0
14687 134 : DO md = 1, md_max
14688 249 : DO mc = 1, 1
14689 1265 : DO mb = 1, 9
14690 1035 : ks_bd = 0.0_dp
14691 1035 : ks_bc = 0.0_dp
14692 1035 : p_bd = pbd((md - 1)*9 + mb)
14693 1035 : p_bc = pbc((mc - 1)*9 + mb)
14694 3105 : DO ma = 1, 2
14695 2070 : p_index = p_index + 1
14696 2070 : tmp = scale*prim(p_index)
14697 2070 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14698 2070 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14699 2070 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14700 3105 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14701 : END DO
14702 1035 : kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
14703 1150 : kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
14704 : END DO
14705 : END DO
14706 : END DO
14707 19 : END SUBROUTINE block_2_9_1
14708 : ! **************************************************************************************************
14709 : !> \brief ...
14710 : !> \param mc_max ...
14711 : !> \param md_max ...
14712 : !> \param kbd ...
14713 : !> \param kbc ...
14714 : !> \param kad ...
14715 : !> \param kac ...
14716 : !> \param pbd ...
14717 : !> \param pbc ...
14718 : !> \param pad ...
14719 : !> \param pac ...
14720 : !> \param prim ...
14721 : !> \param scale ...
14722 : ! **************************************************************************************************
14723 58 : SUBROUTINE block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14724 : INTEGER :: mc_max, md_max
14725 : REAL(KIND=dp) :: kbd(9*md_max), kbc(9*mc_max), kad(2*md_max), kac(2*mc_max), pbd(9*md_max), &
14726 : pbc(9*mc_max), pad(2*md_max), pac(2*mc_max), prim(2*9*mc_max*md_max), scale
14727 :
14728 : INTEGER :: ma, mb, mc, md, p_index
14729 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14730 :
14731 2902 : kbd(1:9*md_max) = 0.0_dp
14732 1759 : kbc(1:9*mc_max) = 0.0_dp
14733 690 : kad(1:2*md_max) = 0.0_dp
14734 436 : kac(1:2*mc_max) = 0.0_dp
14735 : p_index = 0
14736 374 : DO md = 1, md_max
14737 1415 : DO mc = 1, mc_max
14738 10726 : DO mb = 1, 9
14739 9369 : ks_bd = 0.0_dp
14740 9369 : ks_bc = 0.0_dp
14741 9369 : p_bd = pbd((md - 1)*9 + mb)
14742 9369 : p_bc = pbc((mc - 1)*9 + mb)
14743 28107 : DO ma = 1, 2
14744 18738 : p_index = p_index + 1
14745 18738 : tmp = scale*prim(p_index)
14746 18738 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14747 18738 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14748 18738 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14749 28107 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14750 : END DO
14751 9369 : kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
14752 10410 : kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
14753 : END DO
14754 : END DO
14755 : END DO
14756 58 : END SUBROUTINE block_2_9
14757 : ! **************************************************************************************************
14758 : !> \brief ...
14759 : !> \param mc_max ...
14760 : !> \param md_max ...
14761 : !> \param kbd ...
14762 : !> \param kbc ...
14763 : !> \param kad ...
14764 : !> \param kac ...
14765 : !> \param pbd ...
14766 : !> \param pbc ...
14767 : !> \param pad ...
14768 : !> \param pac ...
14769 : !> \param prim ...
14770 : !> \param scale ...
14771 : ! **************************************************************************************************
14772 109 : SUBROUTINE block_2_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14773 : INTEGER :: mc_max, md_max
14774 : REAL(KIND=dp) :: kbd(10*md_max), kbc(10*mc_max), kad(2*md_max), kac(2*mc_max), &
14775 : pbd(10*md_max), pbc(10*mc_max), pad(2*md_max), pac(2*mc_max), prim(2*10*mc_max*md_max), &
14776 : scale
14777 :
14778 : INTEGER :: ma, mb, mc, md, p_index
14779 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14780 :
14781 6669 : kbd(1:10*md_max) = 0.0_dp
14782 3429 : kbc(1:10*mc_max) = 0.0_dp
14783 1421 : kad(1:2*md_max) = 0.0_dp
14784 773 : kac(1:2*mc_max) = 0.0_dp
14785 : p_index = 0
14786 765 : DO md = 1, md_max
14787 2872 : DO mc = 1, mc_max
14788 23833 : DO mb = 1, 10
14789 21070 : ks_bd = 0.0_dp
14790 21070 : ks_bc = 0.0_dp
14791 21070 : p_bd = pbd((md - 1)*10 + mb)
14792 21070 : p_bc = pbc((mc - 1)*10 + mb)
14793 63210 : DO ma = 1, 2
14794 42140 : p_index = p_index + 1
14795 42140 : tmp = scale*prim(p_index)
14796 42140 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14797 42140 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14798 42140 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14799 63210 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14800 : END DO
14801 21070 : kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
14802 23177 : kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
14803 : END DO
14804 : END DO
14805 : END DO
14806 109 : END SUBROUTINE block_2_10
14807 : ! **************************************************************************************************
14808 : !> \brief ...
14809 : !> \param mc_max ...
14810 : !> \param md_max ...
14811 : !> \param kbd ...
14812 : !> \param kbc ...
14813 : !> \param kad ...
14814 : !> \param kac ...
14815 : !> \param pbd ...
14816 : !> \param pbc ...
14817 : !> \param pad ...
14818 : !> \param pac ...
14819 : !> \param prim ...
14820 : !> \param scale ...
14821 : ! **************************************************************************************************
14822 140 : SUBROUTINE block_2_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14823 : INTEGER :: mc_max, md_max
14824 : REAL(KIND=dp) :: kbd(11*md_max), kbc(11*mc_max), kad(2*md_max), kac(2*mc_max), &
14825 : pbd(11*md_max), pbc(11*mc_max), pad(2*md_max), pac(2*mc_max), prim(2*11*mc_max*md_max), &
14826 : scale
14827 :
14828 : INTEGER :: ma, mb, mc, md, p_index
14829 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14830 :
14831 10579 : kbd(1:11*md_max) = 0.0_dp
14832 5145 : kbc(1:11*mc_max) = 0.0_dp
14833 2038 : kad(1:2*md_max) = 0.0_dp
14834 1050 : kac(1:2*mc_max) = 0.0_dp
14835 : p_index = 0
14836 1089 : DO md = 1, md_max
14837 4258 : DO mc = 1, mc_max
14838 38977 : DO mb = 1, 11
14839 34859 : ks_bd = 0.0_dp
14840 34859 : ks_bc = 0.0_dp
14841 34859 : p_bd = pbd((md - 1)*11 + mb)
14842 34859 : p_bc = pbc((mc - 1)*11 + mb)
14843 104577 : DO ma = 1, 2
14844 69718 : p_index = p_index + 1
14845 69718 : tmp = scale*prim(p_index)
14846 69718 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14847 69718 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14848 69718 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14849 104577 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14850 : END DO
14851 34859 : kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
14852 38028 : kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
14853 : END DO
14854 : END DO
14855 : END DO
14856 140 : END SUBROUTINE block_2_11
14857 : ! **************************************************************************************************
14858 : !> \brief ...
14859 : !> \param mc_max ...
14860 : !> \param md_max ...
14861 : !> \param kbd ...
14862 : !> \param kbc ...
14863 : !> \param kad ...
14864 : !> \param kac ...
14865 : !> \param pbd ...
14866 : !> \param pbc ...
14867 : !> \param pad ...
14868 : !> \param pac ...
14869 : !> \param prim ...
14870 : !> \param scale ...
14871 : ! **************************************************************************************************
14872 120 : SUBROUTINE block_2_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14873 : INTEGER :: mc_max, md_max
14874 : REAL(KIND=dp) :: kbd(15*md_max), kbc(15*mc_max), kad(2*md_max), kac(2*mc_max), &
14875 : pbd(15*md_max), pbc(15*mc_max), pad(2*md_max), pac(2*mc_max), prim(2*15*mc_max*md_max), &
14876 : scale
14877 :
14878 : INTEGER :: ma, mb, mc, md, p_index
14879 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14880 :
14881 12075 : kbd(1:15*md_max) = 0.0_dp
14882 5505 : kbc(1:15*mc_max) = 0.0_dp
14883 1714 : kad(1:2*md_max) = 0.0_dp
14884 838 : kac(1:2*mc_max) = 0.0_dp
14885 : p_index = 0
14886 917 : DO md = 1, md_max
14887 3289 : DO mc = 1, mc_max
14888 38749 : DO mb = 1, 15
14889 35580 : ks_bd = 0.0_dp
14890 35580 : ks_bc = 0.0_dp
14891 35580 : p_bd = pbd((md - 1)*15 + mb)
14892 35580 : p_bc = pbc((mc - 1)*15 + mb)
14893 106740 : DO ma = 1, 2
14894 71160 : p_index = p_index + 1
14895 71160 : tmp = scale*prim(p_index)
14896 71160 : ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14897 71160 : ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14898 71160 : kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14899 106740 : kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14900 : END DO
14901 35580 : kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
14902 37952 : kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
14903 : END DO
14904 : END DO
14905 : END DO
14906 120 : END SUBROUTINE block_2_15
14907 : ! **************************************************************************************************
14908 : !> \brief ...
14909 : !> \param kbd ...
14910 : !> \param kbc ...
14911 : !> \param kad ...
14912 : !> \param kac ...
14913 : !> \param pbd ...
14914 : !> \param pbc ...
14915 : !> \param pad ...
14916 : !> \param pac ...
14917 : !> \param prim ...
14918 : !> \param scale ...
14919 : ! **************************************************************************************************
14920 4876377 : SUBROUTINE block_3_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14921 : REAL(KIND=dp) :: kbd(1*1), kbc(1*1), kad(3*1), kac(3*1), &
14922 : pbd(1*1), pbc(1*1), pad(3*1), &
14923 : pac(3*1), prim(3*1*1*1), scale
14924 :
14925 : INTEGER :: ma, mb, mc, md, p_index
14926 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14927 :
14928 4876377 : kbd(1:1*1) = 0.0_dp
14929 4876377 : kbc(1:1*1) = 0.0_dp
14930 4876377 : kad(1:3*1) = 0.0_dp
14931 4876377 : kac(1:3*1) = 0.0_dp
14932 4876377 : p_index = 0
14933 9752754 : DO md = 1, 1
14934 14629131 : DO mc = 1, 1
14935 14629131 : DO mb = 1, 1
14936 4876377 : ks_bd = 0.0_dp
14937 4876377 : ks_bc = 0.0_dp
14938 4876377 : p_bd = pbd((md - 1)*1 + mb)
14939 4876377 : p_bc = pbc((mc - 1)*1 + mb)
14940 19505508 : DO ma = 1, 3
14941 14629131 : p_index = p_index + 1
14942 14629131 : tmp = scale*prim(p_index)
14943 14629131 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
14944 14629131 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
14945 14629131 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
14946 19505508 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
14947 : END DO
14948 4876377 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
14949 9752754 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
14950 : END DO
14951 : END DO
14952 : END DO
14953 4876377 : END SUBROUTINE block_3_1_1_1
14954 : ! **************************************************************************************************
14955 : !> \brief ...
14956 : !> \param kbd ...
14957 : !> \param kbc ...
14958 : !> \param kad ...
14959 : !> \param kac ...
14960 : !> \param pbd ...
14961 : !> \param pbc ...
14962 : !> \param pad ...
14963 : !> \param pac ...
14964 : !> \param prim ...
14965 : !> \param scale ...
14966 : ! **************************************************************************************************
14967 10150 : SUBROUTINE block_3_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
14968 : REAL(KIND=dp) :: kbd(1*2), kbc(1*1), kad(3*2), kac(3*1), &
14969 : pbd(1*2), pbc(1*1), pad(3*2), &
14970 : pac(3*1), prim(3*1*1*2), scale
14971 :
14972 : INTEGER :: ma, mb, mc, md, p_index
14973 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
14974 :
14975 10150 : kbd(1:1*2) = 0.0_dp
14976 10150 : kbc(1:1*1) = 0.0_dp
14977 10150 : kad(1:3*2) = 0.0_dp
14978 10150 : kac(1:3*1) = 0.0_dp
14979 10150 : p_index = 0
14980 30450 : DO md = 1, 2
14981 50750 : DO mc = 1, 1
14982 60900 : DO mb = 1, 1
14983 20300 : ks_bd = 0.0_dp
14984 20300 : ks_bc = 0.0_dp
14985 20300 : p_bd = pbd((md - 1)*1 + mb)
14986 20300 : p_bc = pbc((mc - 1)*1 + mb)
14987 81200 : DO ma = 1, 3
14988 60900 : p_index = p_index + 1
14989 60900 : tmp = scale*prim(p_index)
14990 60900 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
14991 60900 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
14992 60900 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
14993 81200 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
14994 : END DO
14995 20300 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
14996 40600 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
14997 : END DO
14998 : END DO
14999 : END DO
15000 10150 : END SUBROUTINE block_3_1_1_2
15001 : ! **************************************************************************************************
15002 : !> \brief ...
15003 : !> \param kbd ...
15004 : !> \param kbc ...
15005 : !> \param kad ...
15006 : !> \param kac ...
15007 : !> \param pbd ...
15008 : !> \param pbc ...
15009 : !> \param pad ...
15010 : !> \param pac ...
15011 : !> \param prim ...
15012 : !> \param scale ...
15013 : ! **************************************************************************************************
15014 2711002 : SUBROUTINE block_3_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15015 : REAL(KIND=dp) :: kbd(1*3), kbc(1*1), kad(3*3), kac(3*1), &
15016 : pbd(1*3), pbc(1*1), pad(3*3), &
15017 : pac(3*1), prim(3*1*1*3), scale
15018 :
15019 : INTEGER :: ma, mb, mc, md, p_index
15020 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15021 :
15022 2711002 : kbd(1:1*3) = 0.0_dp
15023 2711002 : kbc(1:1*1) = 0.0_dp
15024 2711002 : kad(1:3*3) = 0.0_dp
15025 2711002 : kac(1:3*1) = 0.0_dp
15026 2711002 : p_index = 0
15027 10844008 : DO md = 1, 3
15028 18977014 : DO mc = 1, 1
15029 24399018 : DO mb = 1, 1
15030 8133006 : ks_bd = 0.0_dp
15031 8133006 : ks_bc = 0.0_dp
15032 8133006 : p_bd = pbd((md - 1)*1 + mb)
15033 8133006 : p_bc = pbc((mc - 1)*1 + mb)
15034 32532024 : DO ma = 1, 3
15035 24399018 : p_index = p_index + 1
15036 24399018 : tmp = scale*prim(p_index)
15037 24399018 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15038 24399018 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15039 24399018 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15040 32532024 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15041 : END DO
15042 8133006 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15043 16266012 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15044 : END DO
15045 : END DO
15046 : END DO
15047 2711002 : END SUBROUTINE block_3_1_1_3
15048 : ! **************************************************************************************************
15049 : !> \brief ...
15050 : !> \param kbd ...
15051 : !> \param kbc ...
15052 : !> \param kad ...
15053 : !> \param kac ...
15054 : !> \param pbd ...
15055 : !> \param pbc ...
15056 : !> \param pad ...
15057 : !> \param pac ...
15058 : !> \param prim ...
15059 : !> \param scale ...
15060 : ! **************************************************************************************************
15061 46117 : SUBROUTINE block_3_1_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15062 : REAL(KIND=dp) :: kbd(1*4), kbc(1*1), kad(3*4), kac(3*1), &
15063 : pbd(1*4), pbc(1*1), pad(3*4), &
15064 : pac(3*1), prim(3*1*1*4), scale
15065 :
15066 : INTEGER :: ma, mb, mc, md, p_index
15067 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15068 :
15069 46117 : kbd(1:1*4) = 0.0_dp
15070 46117 : kbc(1:1*1) = 0.0_dp
15071 46117 : kad(1:3*4) = 0.0_dp
15072 46117 : kac(1:3*1) = 0.0_dp
15073 46117 : p_index = 0
15074 230585 : DO md = 1, 4
15075 415053 : DO mc = 1, 1
15076 553404 : DO mb = 1, 1
15077 184468 : ks_bd = 0.0_dp
15078 184468 : ks_bc = 0.0_dp
15079 184468 : p_bd = pbd((md - 1)*1 + mb)
15080 184468 : p_bc = pbc((mc - 1)*1 + mb)
15081 737872 : DO ma = 1, 3
15082 553404 : p_index = p_index + 1
15083 553404 : tmp = scale*prim(p_index)
15084 553404 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15085 553404 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15086 553404 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15087 737872 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15088 : END DO
15089 184468 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15090 368936 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15091 : END DO
15092 : END DO
15093 : END DO
15094 46117 : END SUBROUTINE block_3_1_1_4
15095 : ! **************************************************************************************************
15096 : !> \brief ...
15097 : !> \param kbd ...
15098 : !> \param kbc ...
15099 : !> \param kad ...
15100 : !> \param kac ...
15101 : !> \param pbd ...
15102 : !> \param pbc ...
15103 : !> \param pad ...
15104 : !> \param pac ...
15105 : !> \param prim ...
15106 : !> \param scale ...
15107 : ! **************************************************************************************************
15108 95820 : SUBROUTINE block_3_1_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15109 : REAL(KIND=dp) :: kbd(1*5), kbc(1*1), kad(3*5), kac(3*1), &
15110 : pbd(1*5), pbc(1*1), pad(3*5), &
15111 : pac(3*1), prim(3*1*1*5), scale
15112 :
15113 : INTEGER :: ma, mb, mc, md, p_index
15114 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15115 :
15116 95820 : kbd(1:1*5) = 0.0_dp
15117 95820 : kbc(1:1*1) = 0.0_dp
15118 95820 : kad(1:3*5) = 0.0_dp
15119 95820 : kac(1:3*1) = 0.0_dp
15120 95820 : p_index = 0
15121 574920 : DO md = 1, 5
15122 1054020 : DO mc = 1, 1
15123 1437300 : DO mb = 1, 1
15124 479100 : ks_bd = 0.0_dp
15125 479100 : ks_bc = 0.0_dp
15126 479100 : p_bd = pbd((md - 1)*1 + mb)
15127 479100 : p_bc = pbc((mc - 1)*1 + mb)
15128 1916400 : DO ma = 1, 3
15129 1437300 : p_index = p_index + 1
15130 1437300 : tmp = scale*prim(p_index)
15131 1437300 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15132 1437300 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15133 1437300 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15134 1916400 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15135 : END DO
15136 479100 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15137 958200 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15138 : END DO
15139 : END DO
15140 : END DO
15141 95820 : END SUBROUTINE block_3_1_1_5
15142 : ! **************************************************************************************************
15143 : !> \brief ...
15144 : !> \param kbd ...
15145 : !> \param kbc ...
15146 : !> \param kad ...
15147 : !> \param kac ...
15148 : !> \param pbd ...
15149 : !> \param pbc ...
15150 : !> \param pad ...
15151 : !> \param pac ...
15152 : !> \param prim ...
15153 : !> \param scale ...
15154 : ! **************************************************************************************************
15155 5 : SUBROUTINE block_3_1_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15156 : REAL(KIND=dp) :: kbd(1*6), kbc(1*1), kad(3*6), kac(3*1), &
15157 : pbd(1*6), pbc(1*1), pad(3*6), &
15158 : pac(3*1), prim(3*1*1*6), scale
15159 :
15160 : INTEGER :: ma, mb, mc, md, p_index
15161 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15162 :
15163 5 : kbd(1:1*6) = 0.0_dp
15164 5 : kbc(1:1*1) = 0.0_dp
15165 5 : kad(1:3*6) = 0.0_dp
15166 5 : kac(1:3*1) = 0.0_dp
15167 5 : p_index = 0
15168 35 : DO md = 1, 6
15169 65 : DO mc = 1, 1
15170 90 : DO mb = 1, 1
15171 30 : ks_bd = 0.0_dp
15172 30 : ks_bc = 0.0_dp
15173 30 : p_bd = pbd((md - 1)*1 + mb)
15174 30 : p_bc = pbc((mc - 1)*1 + mb)
15175 120 : DO ma = 1, 3
15176 90 : p_index = p_index + 1
15177 90 : tmp = scale*prim(p_index)
15178 90 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15179 90 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15180 90 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15181 120 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15182 : END DO
15183 30 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15184 60 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15185 : END DO
15186 : END DO
15187 : END DO
15188 5 : END SUBROUTINE block_3_1_1_6
15189 : ! **************************************************************************************************
15190 : !> \brief ...
15191 : !> \param md_max ...
15192 : !> \param kbd ...
15193 : !> \param kbc ...
15194 : !> \param kad ...
15195 : !> \param kac ...
15196 : !> \param pbd ...
15197 : !> \param pbc ...
15198 : !> \param pad ...
15199 : !> \param pac ...
15200 : !> \param prim ...
15201 : !> \param scale ...
15202 : ! **************************************************************************************************
15203 16729 : SUBROUTINE block_3_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15204 : INTEGER :: md_max
15205 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*1), kad(3*md_max), kac(3*1), pbd(1*md_max), pbc(1*1), &
15206 : pad(3*md_max), pac(3*1), prim(3*1*1*md_max), scale
15207 :
15208 : INTEGER :: ma, mb, mc, md, p_index
15209 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15210 :
15211 133885 : kbd(1:1*md_max) = 0.0_dp
15212 16729 : kbc(1:1*1) = 0.0_dp
15213 368197 : kad(1:3*md_max) = 0.0_dp
15214 16729 : kac(1:3*1) = 0.0_dp
15215 16729 : p_index = 0
15216 133885 : DO md = 1, md_max
15217 251041 : DO mc = 1, 1
15218 351468 : DO mb = 1, 1
15219 117156 : ks_bd = 0.0_dp
15220 117156 : ks_bc = 0.0_dp
15221 117156 : p_bd = pbd((md - 1)*1 + mb)
15222 117156 : p_bc = pbc((mc - 1)*1 + mb)
15223 468624 : DO ma = 1, 3
15224 351468 : p_index = p_index + 1
15225 351468 : tmp = scale*prim(p_index)
15226 351468 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15227 351468 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15228 351468 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15229 468624 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15230 : END DO
15231 117156 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15232 234312 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15233 : END DO
15234 : END DO
15235 : END DO
15236 16729 : END SUBROUTINE block_3_1_1
15237 : ! **************************************************************************************************
15238 : !> \brief ...
15239 : !> \param kbd ...
15240 : !> \param kbc ...
15241 : !> \param kad ...
15242 : !> \param kac ...
15243 : !> \param pbd ...
15244 : !> \param pbc ...
15245 : !> \param pad ...
15246 : !> \param pac ...
15247 : !> \param prim ...
15248 : !> \param scale ...
15249 : ! **************************************************************************************************
15250 31980 : SUBROUTINE block_3_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15251 : REAL(KIND=dp) :: kbd(1*1), kbc(1*2), kad(3*1), kac(3*2), &
15252 : pbd(1*1), pbc(1*2), pad(3*1), &
15253 : pac(3*2), prim(3*1*2*1), scale
15254 :
15255 : INTEGER :: ma, mb, mc, md, p_index
15256 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15257 :
15258 31980 : kbd(1:1*1) = 0.0_dp
15259 31980 : kbc(1:1*2) = 0.0_dp
15260 31980 : kad(1:3*1) = 0.0_dp
15261 31980 : kac(1:3*2) = 0.0_dp
15262 31980 : p_index = 0
15263 63960 : DO md = 1, 1
15264 127920 : DO mc = 1, 2
15265 159900 : DO mb = 1, 1
15266 63960 : ks_bd = 0.0_dp
15267 63960 : ks_bc = 0.0_dp
15268 63960 : p_bd = pbd((md - 1)*1 + mb)
15269 63960 : p_bc = pbc((mc - 1)*1 + mb)
15270 255840 : DO ma = 1, 3
15271 191880 : p_index = p_index + 1
15272 191880 : tmp = scale*prim(p_index)
15273 191880 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15274 191880 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15275 191880 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15276 255840 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15277 : END DO
15278 63960 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15279 127920 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15280 : END DO
15281 : END DO
15282 : END DO
15283 31980 : END SUBROUTINE block_3_1_2_1
15284 : ! **************************************************************************************************
15285 : !> \brief ...
15286 : !> \param kbd ...
15287 : !> \param kbc ...
15288 : !> \param kad ...
15289 : !> \param kac ...
15290 : !> \param pbd ...
15291 : !> \param pbc ...
15292 : !> \param pad ...
15293 : !> \param pac ...
15294 : !> \param prim ...
15295 : !> \param scale ...
15296 : ! **************************************************************************************************
15297 4869 : SUBROUTINE block_3_1_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15298 : REAL(KIND=dp) :: kbd(1*2), kbc(1*2), kad(3*2), kac(3*2), &
15299 : pbd(1*2), pbc(1*2), pad(3*2), &
15300 : pac(3*2), prim(3*1*2*2), scale
15301 :
15302 : INTEGER :: ma, mb, mc, md, p_index
15303 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15304 :
15305 4869 : kbd(1:1*2) = 0.0_dp
15306 4869 : kbc(1:1*2) = 0.0_dp
15307 4869 : kad(1:3*2) = 0.0_dp
15308 4869 : kac(1:3*2) = 0.0_dp
15309 4869 : p_index = 0
15310 14607 : DO md = 1, 2
15311 34083 : DO mc = 1, 2
15312 48690 : DO mb = 1, 1
15313 19476 : ks_bd = 0.0_dp
15314 19476 : ks_bc = 0.0_dp
15315 19476 : p_bd = pbd((md - 1)*1 + mb)
15316 19476 : p_bc = pbc((mc - 1)*1 + mb)
15317 77904 : DO ma = 1, 3
15318 58428 : p_index = p_index + 1
15319 58428 : tmp = scale*prim(p_index)
15320 58428 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15321 58428 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15322 58428 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15323 77904 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15324 : END DO
15325 19476 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15326 38952 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15327 : END DO
15328 : END DO
15329 : END DO
15330 4869 : END SUBROUTINE block_3_1_2_2
15331 : ! **************************************************************************************************
15332 : !> \brief ...
15333 : !> \param kbd ...
15334 : !> \param kbc ...
15335 : !> \param kad ...
15336 : !> \param kac ...
15337 : !> \param pbd ...
15338 : !> \param pbc ...
15339 : !> \param pad ...
15340 : !> \param pac ...
15341 : !> \param prim ...
15342 : !> \param scale ...
15343 : ! **************************************************************************************************
15344 29704 : SUBROUTINE block_3_1_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15345 : REAL(KIND=dp) :: kbd(1*3), kbc(1*2), kad(3*3), kac(3*2), &
15346 : pbd(1*3), pbc(1*2), pad(3*3), &
15347 : pac(3*2), prim(3*1*2*3), scale
15348 :
15349 : INTEGER :: ma, mb, mc, md, p_index
15350 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15351 :
15352 29704 : kbd(1:1*3) = 0.0_dp
15353 29704 : kbc(1:1*2) = 0.0_dp
15354 29704 : kad(1:3*3) = 0.0_dp
15355 29704 : kac(1:3*2) = 0.0_dp
15356 29704 : p_index = 0
15357 118816 : DO md = 1, 3
15358 297040 : DO mc = 1, 2
15359 445560 : DO mb = 1, 1
15360 178224 : ks_bd = 0.0_dp
15361 178224 : ks_bc = 0.0_dp
15362 178224 : p_bd = pbd((md - 1)*1 + mb)
15363 178224 : p_bc = pbc((mc - 1)*1 + mb)
15364 712896 : DO ma = 1, 3
15365 534672 : p_index = p_index + 1
15366 534672 : tmp = scale*prim(p_index)
15367 534672 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15368 534672 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15369 534672 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15370 712896 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15371 : END DO
15372 178224 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15373 356448 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15374 : END DO
15375 : END DO
15376 : END DO
15377 29704 : END SUBROUTINE block_3_1_2_3
15378 : ! **************************************************************************************************
15379 : !> \brief ...
15380 : !> \param md_max ...
15381 : !> \param kbd ...
15382 : !> \param kbc ...
15383 : !> \param kad ...
15384 : !> \param kac ...
15385 : !> \param pbd ...
15386 : !> \param pbc ...
15387 : !> \param pad ...
15388 : !> \param pac ...
15389 : !> \param prim ...
15390 : !> \param scale ...
15391 : ! **************************************************************************************************
15392 11118 : SUBROUTINE block_3_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15393 : INTEGER :: md_max
15394 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*2), kad(3*md_max), kac(3*2), pbd(1*md_max), pbc(1*2), &
15395 : pad(3*md_max), pac(3*2), prim(3*1*2*md_max), scale
15396 :
15397 : INTEGER :: ma, mb, mc, md, p_index
15398 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15399 :
15400 68720 : kbd(1:1*md_max) = 0.0_dp
15401 11118 : kbc(1:1*2) = 0.0_dp
15402 183924 : kad(1:3*md_max) = 0.0_dp
15403 11118 : kac(1:3*2) = 0.0_dp
15404 11118 : p_index = 0
15405 68720 : DO md = 1, md_max
15406 183924 : DO mc = 1, 2
15407 288010 : DO mb = 1, 1
15408 115204 : ks_bd = 0.0_dp
15409 115204 : ks_bc = 0.0_dp
15410 115204 : p_bd = pbd((md - 1)*1 + mb)
15411 115204 : p_bc = pbc((mc - 1)*1 + mb)
15412 460816 : DO ma = 1, 3
15413 345612 : p_index = p_index + 1
15414 345612 : tmp = scale*prim(p_index)
15415 345612 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15416 345612 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15417 345612 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15418 460816 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15419 : END DO
15420 115204 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15421 230408 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15422 : END DO
15423 : END DO
15424 : END DO
15425 11118 : END SUBROUTINE block_3_1_2
15426 : ! **************************************************************************************************
15427 : !> \brief ...
15428 : !> \param kbd ...
15429 : !> \param kbc ...
15430 : !> \param kad ...
15431 : !> \param kac ...
15432 : !> \param pbd ...
15433 : !> \param pbc ...
15434 : !> \param pad ...
15435 : !> \param pac ...
15436 : !> \param prim ...
15437 : !> \param scale ...
15438 : ! **************************************************************************************************
15439 4194542 : SUBROUTINE block_3_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15440 : REAL(KIND=dp) :: kbd(1*1), kbc(1*3), kad(3*1), kac(3*3), &
15441 : pbd(1*1), pbc(1*3), pad(3*1), &
15442 : pac(3*3), prim(3*1*3*1), scale
15443 :
15444 : INTEGER :: ma, mb, mc, md, p_index
15445 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15446 :
15447 4194542 : kbd(1:1*1) = 0.0_dp
15448 4194542 : kbc(1:1*3) = 0.0_dp
15449 4194542 : kad(1:3*1) = 0.0_dp
15450 4194542 : kac(1:3*3) = 0.0_dp
15451 4194542 : p_index = 0
15452 8389084 : DO md = 1, 1
15453 20972710 : DO mc = 1, 3
15454 29361794 : DO mb = 1, 1
15455 12583626 : ks_bd = 0.0_dp
15456 12583626 : ks_bc = 0.0_dp
15457 12583626 : p_bd = pbd((md - 1)*1 + mb)
15458 12583626 : p_bc = pbc((mc - 1)*1 + mb)
15459 50334504 : DO ma = 1, 3
15460 37750878 : p_index = p_index + 1
15461 37750878 : tmp = scale*prim(p_index)
15462 37750878 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15463 37750878 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15464 37750878 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15465 50334504 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15466 : END DO
15467 12583626 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15468 25167252 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15469 : END DO
15470 : END DO
15471 : END DO
15472 4194542 : END SUBROUTINE block_3_1_3_1
15473 : ! **************************************************************************************************
15474 : !> \brief ...
15475 : !> \param kbd ...
15476 : !> \param kbc ...
15477 : !> \param kad ...
15478 : !> \param kac ...
15479 : !> \param pbd ...
15480 : !> \param pbc ...
15481 : !> \param pad ...
15482 : !> \param pac ...
15483 : !> \param prim ...
15484 : !> \param scale ...
15485 : ! **************************************************************************************************
15486 15149 : SUBROUTINE block_3_1_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15487 : REAL(KIND=dp) :: kbd(1*2), kbc(1*3), kad(3*2), kac(3*3), &
15488 : pbd(1*2), pbc(1*3), pad(3*2), &
15489 : pac(3*3), prim(3*1*3*2), scale
15490 :
15491 : INTEGER :: ma, mb, mc, md, p_index
15492 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15493 :
15494 15149 : kbd(1:1*2) = 0.0_dp
15495 15149 : kbc(1:1*3) = 0.0_dp
15496 15149 : kad(1:3*2) = 0.0_dp
15497 15149 : kac(1:3*3) = 0.0_dp
15498 15149 : p_index = 0
15499 45447 : DO md = 1, 2
15500 136341 : DO mc = 1, 3
15501 212086 : DO mb = 1, 1
15502 90894 : ks_bd = 0.0_dp
15503 90894 : ks_bc = 0.0_dp
15504 90894 : p_bd = pbd((md - 1)*1 + mb)
15505 90894 : p_bc = pbc((mc - 1)*1 + mb)
15506 363576 : DO ma = 1, 3
15507 272682 : p_index = p_index + 1
15508 272682 : tmp = scale*prim(p_index)
15509 272682 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15510 272682 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15511 272682 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15512 363576 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15513 : END DO
15514 90894 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15515 181788 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15516 : END DO
15517 : END DO
15518 : END DO
15519 15149 : END SUBROUTINE block_3_1_3_2
15520 : ! **************************************************************************************************
15521 : !> \brief ...
15522 : !> \param md_max ...
15523 : !> \param kbd ...
15524 : !> \param kbc ...
15525 : !> \param kad ...
15526 : !> \param kac ...
15527 : !> \param pbd ...
15528 : !> \param pbc ...
15529 : !> \param pad ...
15530 : !> \param pac ...
15531 : !> \param prim ...
15532 : !> \param scale ...
15533 : ! **************************************************************************************************
15534 2706872 : SUBROUTINE block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15535 : INTEGER :: md_max
15536 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*3), kad(3*md_max), kac(3*3), pbd(1*md_max), pbc(1*3), &
15537 : pad(3*md_max), pac(3*3), prim(3*1*3*md_max), scale
15538 :
15539 : INTEGER :: ma, mb, mc, md, p_index
15540 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15541 :
15542 11079841 : kbd(1:1*md_max) = 0.0_dp
15543 2706872 : kbc(1:1*3) = 0.0_dp
15544 27825779 : kad(1:3*md_max) = 0.0_dp
15545 2706872 : kac(1:3*3) = 0.0_dp
15546 2706872 : p_index = 0
15547 11079841 : DO md = 1, md_max
15548 36198748 : DO mc = 1, 3
15549 58610783 : DO mb = 1, 1
15550 25118907 : ks_bd = 0.0_dp
15551 25118907 : ks_bc = 0.0_dp
15552 25118907 : p_bd = pbd((md - 1)*1 + mb)
15553 25118907 : p_bc = pbc((mc - 1)*1 + mb)
15554 100475628 : DO ma = 1, 3
15555 75356721 : p_index = p_index + 1
15556 75356721 : tmp = scale*prim(p_index)
15557 75356721 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15558 75356721 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15559 75356721 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15560 100475628 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15561 : END DO
15562 25118907 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15563 50237814 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15564 : END DO
15565 : END DO
15566 : END DO
15567 2706872 : END SUBROUTINE block_3_1_3
15568 : ! **************************************************************************************************
15569 : !> \brief ...
15570 : !> \param kbd ...
15571 : !> \param kbc ...
15572 : !> \param kad ...
15573 : !> \param kac ...
15574 : !> \param pbd ...
15575 : !> \param pbc ...
15576 : !> \param pad ...
15577 : !> \param pac ...
15578 : !> \param prim ...
15579 : !> \param scale ...
15580 : ! **************************************************************************************************
15581 227600 : SUBROUTINE block_3_1_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15582 : REAL(KIND=dp) :: kbd(1*1), kbc(1*4), kad(3*1), kac(3*4), &
15583 : pbd(1*1), pbc(1*4), pad(3*1), &
15584 : pac(3*4), prim(3*1*4*1), scale
15585 :
15586 : INTEGER :: ma, mb, mc, md, p_index
15587 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15588 :
15589 227600 : kbd(1:1*1) = 0.0_dp
15590 227600 : kbc(1:1*4) = 0.0_dp
15591 227600 : kad(1:3*1) = 0.0_dp
15592 227600 : kac(1:3*4) = 0.0_dp
15593 227600 : p_index = 0
15594 455200 : DO md = 1, 1
15595 1365600 : DO mc = 1, 4
15596 2048400 : DO mb = 1, 1
15597 910400 : ks_bd = 0.0_dp
15598 910400 : ks_bc = 0.0_dp
15599 910400 : p_bd = pbd((md - 1)*1 + mb)
15600 910400 : p_bc = pbc((mc - 1)*1 + mb)
15601 3641600 : DO ma = 1, 3
15602 2731200 : p_index = p_index + 1
15603 2731200 : tmp = scale*prim(p_index)
15604 2731200 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15605 2731200 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15606 2731200 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15607 3641600 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15608 : END DO
15609 910400 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15610 1820800 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15611 : END DO
15612 : END DO
15613 : END DO
15614 227600 : END SUBROUTINE block_3_1_4_1
15615 : ! **************************************************************************************************
15616 : !> \brief ...
15617 : !> \param md_max ...
15618 : !> \param kbd ...
15619 : !> \param kbc ...
15620 : !> \param kad ...
15621 : !> \param kac ...
15622 : !> \param pbd ...
15623 : !> \param pbc ...
15624 : !> \param pad ...
15625 : !> \param pac ...
15626 : !> \param prim ...
15627 : !> \param scale ...
15628 : ! **************************************************************************************************
15629 268551 : SUBROUTINE block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15630 : INTEGER :: md_max
15631 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*4), kad(3*md_max), kac(3*4), pbd(1*md_max), pbc(1*4), &
15632 : pad(3*md_max), pac(3*4), prim(3*1*4*md_max), scale
15633 :
15634 : INTEGER :: ma, mb, mc, md, p_index
15635 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15636 :
15637 1294591 : kbd(1:1*md_max) = 0.0_dp
15638 268551 : kbc(1:1*4) = 0.0_dp
15639 3346671 : kad(1:3*md_max) = 0.0_dp
15640 268551 : kac(1:3*4) = 0.0_dp
15641 268551 : p_index = 0
15642 1294591 : DO md = 1, md_max
15643 5398751 : DO mc = 1, 4
15644 9234360 : DO mb = 1, 1
15645 4104160 : ks_bd = 0.0_dp
15646 4104160 : ks_bc = 0.0_dp
15647 4104160 : p_bd = pbd((md - 1)*1 + mb)
15648 4104160 : p_bc = pbc((mc - 1)*1 + mb)
15649 16416640 : DO ma = 1, 3
15650 12312480 : p_index = p_index + 1
15651 12312480 : tmp = scale*prim(p_index)
15652 12312480 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15653 12312480 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15654 12312480 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15655 16416640 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15656 : END DO
15657 4104160 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15658 8208320 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15659 : END DO
15660 : END DO
15661 : END DO
15662 268551 : END SUBROUTINE block_3_1_4
15663 : ! **************************************************************************************************
15664 : !> \brief ...
15665 : !> \param kbd ...
15666 : !> \param kbc ...
15667 : !> \param kad ...
15668 : !> \param kac ...
15669 : !> \param pbd ...
15670 : !> \param pbc ...
15671 : !> \param pad ...
15672 : !> \param pac ...
15673 : !> \param prim ...
15674 : !> \param scale ...
15675 : ! **************************************************************************************************
15676 281892 : SUBROUTINE block_3_1_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15677 : REAL(KIND=dp) :: kbd(1*1), kbc(1*5), kad(3*1), kac(3*5), &
15678 : pbd(1*1), pbc(1*5), pad(3*1), &
15679 : pac(3*5), prim(3*1*5*1), scale
15680 :
15681 : INTEGER :: ma, mb, mc, md, p_index
15682 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15683 :
15684 281892 : kbd(1:1*1) = 0.0_dp
15685 281892 : kbc(1:1*5) = 0.0_dp
15686 281892 : kad(1:3*1) = 0.0_dp
15687 281892 : kac(1:3*5) = 0.0_dp
15688 281892 : p_index = 0
15689 563784 : DO md = 1, 1
15690 1973244 : DO mc = 1, 5
15691 3100812 : DO mb = 1, 1
15692 1409460 : ks_bd = 0.0_dp
15693 1409460 : ks_bc = 0.0_dp
15694 1409460 : p_bd = pbd((md - 1)*1 + mb)
15695 1409460 : p_bc = pbc((mc - 1)*1 + mb)
15696 5637840 : DO ma = 1, 3
15697 4228380 : p_index = p_index + 1
15698 4228380 : tmp = scale*prim(p_index)
15699 4228380 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15700 4228380 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15701 4228380 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15702 5637840 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15703 : END DO
15704 1409460 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15705 2818920 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15706 : END DO
15707 : END DO
15708 : END DO
15709 281892 : END SUBROUTINE block_3_1_5_1
15710 : ! **************************************************************************************************
15711 : !> \brief ...
15712 : !> \param md_max ...
15713 : !> \param kbd ...
15714 : !> \param kbc ...
15715 : !> \param kad ...
15716 : !> \param kac ...
15717 : !> \param pbd ...
15718 : !> \param pbc ...
15719 : !> \param pad ...
15720 : !> \param pac ...
15721 : !> \param prim ...
15722 : !> \param scale ...
15723 : ! **************************************************************************************************
15724 314420 : SUBROUTINE block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15725 : INTEGER :: md_max
15726 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*5), kad(3*md_max), kac(3*5), pbd(1*md_max), pbc(1*5), &
15727 : pad(3*md_max), pac(3*5), prim(3*1*5*md_max), scale
15728 :
15729 : INTEGER :: ma, mb, mc, md, p_index
15730 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15731 :
15732 1471720 : kbd(1:1*md_max) = 0.0_dp
15733 314420 : kbc(1:1*5) = 0.0_dp
15734 3786320 : kad(1:3*md_max) = 0.0_dp
15735 314420 : kac(1:3*5) = 0.0_dp
15736 314420 : p_index = 0
15737 1471720 : DO md = 1, md_max
15738 7258220 : DO mc = 1, 5
15739 12730300 : DO mb = 1, 1
15740 5786500 : ks_bd = 0.0_dp
15741 5786500 : ks_bc = 0.0_dp
15742 5786500 : p_bd = pbd((md - 1)*1 + mb)
15743 5786500 : p_bc = pbc((mc - 1)*1 + mb)
15744 23146000 : DO ma = 1, 3
15745 17359500 : p_index = p_index + 1
15746 17359500 : tmp = scale*prim(p_index)
15747 17359500 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15748 17359500 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15749 17359500 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15750 23146000 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15751 : END DO
15752 5786500 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15753 11573000 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15754 : END DO
15755 : END DO
15756 : END DO
15757 314420 : END SUBROUTINE block_3_1_5
15758 : ! **************************************************************************************************
15759 : !> \brief ...
15760 : !> \param kbd ...
15761 : !> \param kbc ...
15762 : !> \param kad ...
15763 : !> \param kac ...
15764 : !> \param pbd ...
15765 : !> \param pbc ...
15766 : !> \param pad ...
15767 : !> \param pac ...
15768 : !> \param prim ...
15769 : !> \param scale ...
15770 : ! **************************************************************************************************
15771 1 : SUBROUTINE block_3_1_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15772 : REAL(KIND=dp) :: kbd(1*1), kbc(1*6), kad(3*1), kac(3*6), &
15773 : pbd(1*1), pbc(1*6), pad(3*1), &
15774 : pac(3*6), prim(3*1*6*1), scale
15775 :
15776 : INTEGER :: ma, mb, mc, md, p_index
15777 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15778 :
15779 1 : kbd(1:1*1) = 0.0_dp
15780 1 : kbc(1:1*6) = 0.0_dp
15781 1 : kad(1:3*1) = 0.0_dp
15782 1 : kac(1:3*6) = 0.0_dp
15783 1 : p_index = 0
15784 2 : DO md = 1, 1
15785 8 : DO mc = 1, 6
15786 13 : DO mb = 1, 1
15787 6 : ks_bd = 0.0_dp
15788 6 : ks_bc = 0.0_dp
15789 6 : p_bd = pbd((md - 1)*1 + mb)
15790 6 : p_bc = pbc((mc - 1)*1 + mb)
15791 24 : DO ma = 1, 3
15792 18 : p_index = p_index + 1
15793 18 : tmp = scale*prim(p_index)
15794 18 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15795 18 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15796 18 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15797 24 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15798 : END DO
15799 6 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15800 12 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15801 : END DO
15802 : END DO
15803 : END DO
15804 1 : END SUBROUTINE block_3_1_6_1
15805 : ! **************************************************************************************************
15806 : !> \brief ...
15807 : !> \param md_max ...
15808 : !> \param kbd ...
15809 : !> \param kbc ...
15810 : !> \param kad ...
15811 : !> \param kac ...
15812 : !> \param pbd ...
15813 : !> \param pbc ...
15814 : !> \param pad ...
15815 : !> \param pac ...
15816 : !> \param prim ...
15817 : !> \param scale ...
15818 : ! **************************************************************************************************
15819 10 : SUBROUTINE block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15820 : INTEGER :: md_max
15821 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*6), kad(3*md_max), kac(3*6), pbd(1*md_max), pbc(1*6), &
15822 : pad(3*md_max), pac(3*6), prim(3*1*6*md_max), scale
15823 :
15824 : INTEGER :: ma, mb, mc, md, p_index
15825 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15826 :
15827 68 : kbd(1:1*md_max) = 0.0_dp
15828 10 : kbc(1:1*6) = 0.0_dp
15829 184 : kad(1:3*md_max) = 0.0_dp
15830 10 : kac(1:3*6) = 0.0_dp
15831 10 : p_index = 0
15832 68 : DO md = 1, md_max
15833 416 : DO mc = 1, 6
15834 754 : DO mb = 1, 1
15835 348 : ks_bd = 0.0_dp
15836 348 : ks_bc = 0.0_dp
15837 348 : p_bd = pbd((md - 1)*1 + mb)
15838 348 : p_bc = pbc((mc - 1)*1 + mb)
15839 1392 : DO ma = 1, 3
15840 1044 : p_index = p_index + 1
15841 1044 : tmp = scale*prim(p_index)
15842 1044 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15843 1044 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15844 1044 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15845 1392 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15846 : END DO
15847 348 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15848 696 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15849 : END DO
15850 : END DO
15851 : END DO
15852 10 : END SUBROUTINE block_3_1_6
15853 : ! **************************************************************************************************
15854 : !> \brief ...
15855 : !> \param mc_max ...
15856 : !> \param md_max ...
15857 : !> \param kbd ...
15858 : !> \param kbc ...
15859 : !> \param kad ...
15860 : !> \param kac ...
15861 : !> \param pbd ...
15862 : !> \param pbc ...
15863 : !> \param pad ...
15864 : !> \param pac ...
15865 : !> \param prim ...
15866 : !> \param scale ...
15867 : ! **************************************************************************************************
15868 73036 : SUBROUTINE block_3_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15869 : INTEGER :: mc_max, md_max
15870 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*mc_max), kad(3*md_max), kac(3*mc_max), pbd(1*md_max), &
15871 : pbc(1*mc_max), pad(3*md_max), pac(3*mc_max), prim(3*1*mc_max*md_max), scale
15872 :
15873 : INTEGER :: ma, mb, mc, md, p_index
15874 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15875 :
15876 257802 : kbd(1:1*md_max) = 0.0_dp
15877 584459 : kbc(1:1*mc_max) = 0.0_dp
15878 627334 : kad(1:3*md_max) = 0.0_dp
15879 1607305 : kac(1:3*mc_max) = 0.0_dp
15880 : p_index = 0
15881 257802 : DO md = 1, md_max
15882 1552195 : DO mc = 1, mc_max
15883 2773552 : DO mb = 1, 1
15884 1294393 : ks_bd = 0.0_dp
15885 1294393 : ks_bc = 0.0_dp
15886 1294393 : p_bd = pbd((md - 1)*1 + mb)
15887 1294393 : p_bc = pbc((mc - 1)*1 + mb)
15888 5177572 : DO ma = 1, 3
15889 3883179 : p_index = p_index + 1
15890 3883179 : tmp = scale*prim(p_index)
15891 3883179 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15892 3883179 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15893 3883179 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15894 5177572 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15895 : END DO
15896 1294393 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15897 2588786 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15898 : END DO
15899 : END DO
15900 : END DO
15901 73036 : END SUBROUTINE block_3_1
15902 : ! **************************************************************************************************
15903 : !> \brief ...
15904 : !> \param kbd ...
15905 : !> \param kbc ...
15906 : !> \param kad ...
15907 : !> \param kac ...
15908 : !> \param pbd ...
15909 : !> \param pbc ...
15910 : !> \param pad ...
15911 : !> \param pac ...
15912 : !> \param prim ...
15913 : !> \param scale ...
15914 : ! **************************************************************************************************
15915 2425 : SUBROUTINE block_3_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15916 : REAL(KIND=dp) :: kbd(2*1), kbc(2*1), kad(3*1), kac(3*1), &
15917 : pbd(2*1), pbc(2*1), pad(3*1), &
15918 : pac(3*1), prim(3*2*1*1), scale
15919 :
15920 : INTEGER :: ma, mb, mc, md, p_index
15921 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15922 :
15923 2425 : kbd(1:2*1) = 0.0_dp
15924 2425 : kbc(1:2*1) = 0.0_dp
15925 2425 : kad(1:3*1) = 0.0_dp
15926 2425 : kac(1:3*1) = 0.0_dp
15927 2425 : p_index = 0
15928 4850 : DO md = 1, 1
15929 7275 : DO mc = 1, 1
15930 9700 : DO mb = 1, 2
15931 4850 : ks_bd = 0.0_dp
15932 4850 : ks_bc = 0.0_dp
15933 4850 : p_bd = pbd((md - 1)*2 + mb)
15934 4850 : p_bc = pbc((mc - 1)*2 + mb)
15935 19400 : DO ma = 1, 3
15936 14550 : p_index = p_index + 1
15937 14550 : tmp = scale*prim(p_index)
15938 14550 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15939 14550 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15940 14550 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15941 19400 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15942 : END DO
15943 4850 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
15944 7275 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
15945 : END DO
15946 : END DO
15947 : END DO
15948 2425 : END SUBROUTINE block_3_2_1_1
15949 : ! **************************************************************************************************
15950 : !> \brief ...
15951 : !> \param kbd ...
15952 : !> \param kbc ...
15953 : !> \param kad ...
15954 : !> \param kac ...
15955 : !> \param pbd ...
15956 : !> \param pbc ...
15957 : !> \param pad ...
15958 : !> \param pac ...
15959 : !> \param prim ...
15960 : !> \param scale ...
15961 : ! **************************************************************************************************
15962 942 : SUBROUTINE block_3_2_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
15963 : REAL(KIND=dp) :: kbd(2*2), kbc(2*1), kad(3*2), kac(3*1), &
15964 : pbd(2*2), pbc(2*1), pad(3*2), &
15965 : pac(3*1), prim(3*2*1*2), scale
15966 :
15967 : INTEGER :: ma, mb, mc, md, p_index
15968 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
15969 :
15970 942 : kbd(1:2*2) = 0.0_dp
15971 942 : kbc(1:2*1) = 0.0_dp
15972 942 : kad(1:3*2) = 0.0_dp
15973 942 : kac(1:3*1) = 0.0_dp
15974 942 : p_index = 0
15975 2826 : DO md = 1, 2
15976 4710 : DO mc = 1, 1
15977 7536 : DO mb = 1, 2
15978 3768 : ks_bd = 0.0_dp
15979 3768 : ks_bc = 0.0_dp
15980 3768 : p_bd = pbd((md - 1)*2 + mb)
15981 3768 : p_bc = pbc((mc - 1)*2 + mb)
15982 15072 : DO ma = 1, 3
15983 11304 : p_index = p_index + 1
15984 11304 : tmp = scale*prim(p_index)
15985 11304 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15986 11304 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15987 11304 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15988 15072 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15989 : END DO
15990 3768 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
15991 5652 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
15992 : END DO
15993 : END DO
15994 : END DO
15995 942 : END SUBROUTINE block_3_2_1_2
15996 : ! **************************************************************************************************
15997 : !> \brief ...
15998 : !> \param kbd ...
15999 : !> \param kbc ...
16000 : !> \param kad ...
16001 : !> \param kac ...
16002 : !> \param pbd ...
16003 : !> \param pbc ...
16004 : !> \param pad ...
16005 : !> \param pac ...
16006 : !> \param prim ...
16007 : !> \param scale ...
16008 : ! **************************************************************************************************
16009 3540 : SUBROUTINE block_3_2_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16010 : REAL(KIND=dp) :: kbd(2*3), kbc(2*1), kad(3*3), kac(3*1), &
16011 : pbd(2*3), pbc(2*1), pad(3*3), &
16012 : pac(3*1), prim(3*2*1*3), scale
16013 :
16014 : INTEGER :: ma, mb, mc, md, p_index
16015 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16016 :
16017 3540 : kbd(1:2*3) = 0.0_dp
16018 3540 : kbc(1:2*1) = 0.0_dp
16019 3540 : kad(1:3*3) = 0.0_dp
16020 3540 : kac(1:3*1) = 0.0_dp
16021 3540 : p_index = 0
16022 14160 : DO md = 1, 3
16023 24780 : DO mc = 1, 1
16024 42480 : DO mb = 1, 2
16025 21240 : ks_bd = 0.0_dp
16026 21240 : ks_bc = 0.0_dp
16027 21240 : p_bd = pbd((md - 1)*2 + mb)
16028 21240 : p_bc = pbc((mc - 1)*2 + mb)
16029 84960 : DO ma = 1, 3
16030 63720 : p_index = p_index + 1
16031 63720 : tmp = scale*prim(p_index)
16032 63720 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16033 63720 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16034 63720 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16035 84960 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16036 : END DO
16037 21240 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
16038 31860 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
16039 : END DO
16040 : END DO
16041 : END DO
16042 3540 : END SUBROUTINE block_3_2_1_3
16043 : ! **************************************************************************************************
16044 : !> \brief ...
16045 : !> \param md_max ...
16046 : !> \param kbd ...
16047 : !> \param kbc ...
16048 : !> \param kad ...
16049 : !> \param kac ...
16050 : !> \param pbd ...
16051 : !> \param pbc ...
16052 : !> \param pad ...
16053 : !> \param pac ...
16054 : !> \param prim ...
16055 : !> \param scale ...
16056 : ! **************************************************************************************************
16057 3367 : SUBROUTINE block_3_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16058 : INTEGER :: md_max
16059 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*1), kad(3*md_max), kac(3*1), pbd(2*md_max), pbc(2*1), &
16060 : pad(3*md_max), pac(3*1), prim(3*2*1*md_max), scale
16061 :
16062 : INTEGER :: ma, mb, mc, md, p_index
16063 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16064 :
16065 40931 : kbd(1:2*md_max) = 0.0_dp
16066 3367 : kbc(1:2*1) = 0.0_dp
16067 59713 : kad(1:3*md_max) = 0.0_dp
16068 3367 : kac(1:3*1) = 0.0_dp
16069 3367 : p_index = 0
16070 22149 : DO md = 1, md_max
16071 40931 : DO mc = 1, 1
16072 75128 : DO mb = 1, 2
16073 37564 : ks_bd = 0.0_dp
16074 37564 : ks_bc = 0.0_dp
16075 37564 : p_bd = pbd((md - 1)*2 + mb)
16076 37564 : p_bc = pbc((mc - 1)*2 + mb)
16077 150256 : DO ma = 1, 3
16078 112692 : p_index = p_index + 1
16079 112692 : tmp = scale*prim(p_index)
16080 112692 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16081 112692 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16082 112692 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16083 150256 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16084 : END DO
16085 37564 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
16086 56346 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
16087 : END DO
16088 : END DO
16089 : END DO
16090 3367 : END SUBROUTINE block_3_2_1
16091 : ! **************************************************************************************************
16092 : !> \brief ...
16093 : !> \param kbd ...
16094 : !> \param kbc ...
16095 : !> \param kad ...
16096 : !> \param kac ...
16097 : !> \param pbd ...
16098 : !> \param pbc ...
16099 : !> \param pad ...
16100 : !> \param pac ...
16101 : !> \param prim ...
16102 : !> \param scale ...
16103 : ! **************************************************************************************************
16104 939 : SUBROUTINE block_3_2_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16105 : REAL(KIND=dp) :: kbd(2*1), kbc(2*2), kad(3*1), kac(3*2), &
16106 : pbd(2*1), pbc(2*2), pad(3*1), &
16107 : pac(3*2), prim(3*2*2*1), scale
16108 :
16109 : INTEGER :: ma, mb, mc, md, p_index
16110 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16111 :
16112 939 : kbd(1:2*1) = 0.0_dp
16113 939 : kbc(1:2*2) = 0.0_dp
16114 939 : kad(1:3*1) = 0.0_dp
16115 939 : kac(1:3*2) = 0.0_dp
16116 939 : p_index = 0
16117 1878 : DO md = 1, 1
16118 3756 : DO mc = 1, 2
16119 6573 : DO mb = 1, 2
16120 3756 : ks_bd = 0.0_dp
16121 3756 : ks_bc = 0.0_dp
16122 3756 : p_bd = pbd((md - 1)*2 + mb)
16123 3756 : p_bc = pbc((mc - 1)*2 + mb)
16124 15024 : DO ma = 1, 3
16125 11268 : p_index = p_index + 1
16126 11268 : tmp = scale*prim(p_index)
16127 11268 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16128 11268 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16129 11268 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16130 15024 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16131 : END DO
16132 3756 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
16133 5634 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
16134 : END DO
16135 : END DO
16136 : END DO
16137 939 : END SUBROUTINE block_3_2_2_1
16138 : ! **************************************************************************************************
16139 : !> \brief ...
16140 : !> \param md_max ...
16141 : !> \param kbd ...
16142 : !> \param kbc ...
16143 : !> \param kad ...
16144 : !> \param kac ...
16145 : !> \param pbd ...
16146 : !> \param pbc ...
16147 : !> \param pad ...
16148 : !> \param pac ...
16149 : !> \param prim ...
16150 : !> \param scale ...
16151 : ! **************************************************************************************************
16152 31511 : SUBROUTINE block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16153 : INTEGER :: md_max
16154 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*2), kad(3*md_max), kac(3*2), pbd(2*md_max), pbc(2*2), &
16155 : pad(3*md_max), pac(3*2), prim(3*2*2*md_max), scale
16156 :
16157 : INTEGER :: ma, mb, mc, md, p_index
16158 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16159 :
16160 196573 : kbd(1:2*md_max) = 0.0_dp
16161 31511 : kbc(1:2*2) = 0.0_dp
16162 279104 : kad(1:3*md_max) = 0.0_dp
16163 31511 : kac(1:3*2) = 0.0_dp
16164 31511 : p_index = 0
16165 114042 : DO md = 1, md_max
16166 279104 : DO mc = 1, 2
16167 577717 : DO mb = 1, 2
16168 330124 : ks_bd = 0.0_dp
16169 330124 : ks_bc = 0.0_dp
16170 330124 : p_bd = pbd((md - 1)*2 + mb)
16171 330124 : p_bc = pbc((mc - 1)*2 + mb)
16172 1320496 : DO ma = 1, 3
16173 990372 : p_index = p_index + 1
16174 990372 : tmp = scale*prim(p_index)
16175 990372 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16176 990372 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16177 990372 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16178 1320496 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16179 : END DO
16180 330124 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
16181 495186 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
16182 : END DO
16183 : END DO
16184 : END DO
16185 31511 : END SUBROUTINE block_3_2_2
16186 : ! **************************************************************************************************
16187 : !> \brief ...
16188 : !> \param kbd ...
16189 : !> \param kbc ...
16190 : !> \param kad ...
16191 : !> \param kac ...
16192 : !> \param pbd ...
16193 : !> \param pbc ...
16194 : !> \param pad ...
16195 : !> \param pac ...
16196 : !> \param prim ...
16197 : !> \param scale ...
16198 : ! **************************************************************************************************
16199 3538 : SUBROUTINE block_3_2_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16200 : REAL(KIND=dp) :: kbd(2*1), kbc(2*3), kad(3*1), kac(3*3), &
16201 : pbd(2*1), pbc(2*3), pad(3*1), &
16202 : pac(3*3), prim(3*2*3*1), scale
16203 :
16204 : INTEGER :: ma, mb, mc, md, p_index
16205 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16206 :
16207 3538 : kbd(1:2*1) = 0.0_dp
16208 3538 : kbc(1:2*3) = 0.0_dp
16209 3538 : kad(1:3*1) = 0.0_dp
16210 3538 : kac(1:3*3) = 0.0_dp
16211 3538 : p_index = 0
16212 7076 : DO md = 1, 1
16213 17690 : DO mc = 1, 3
16214 35380 : DO mb = 1, 2
16215 21228 : ks_bd = 0.0_dp
16216 21228 : ks_bc = 0.0_dp
16217 21228 : p_bd = pbd((md - 1)*2 + mb)
16218 21228 : p_bc = pbc((mc - 1)*2 + mb)
16219 84912 : DO ma = 1, 3
16220 63684 : p_index = p_index + 1
16221 63684 : tmp = scale*prim(p_index)
16222 63684 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16223 63684 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16224 63684 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16225 84912 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16226 : END DO
16227 21228 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
16228 31842 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
16229 : END DO
16230 : END DO
16231 : END DO
16232 3538 : END SUBROUTINE block_3_2_3_1
16233 : ! **************************************************************************************************
16234 : !> \brief ...
16235 : !> \param md_max ...
16236 : !> \param kbd ...
16237 : !> \param kbc ...
16238 : !> \param kad ...
16239 : !> \param kac ...
16240 : !> \param pbd ...
16241 : !> \param pbc ...
16242 : !> \param pad ...
16243 : !> \param pac ...
16244 : !> \param prim ...
16245 : !> \param scale ...
16246 : ! **************************************************************************************************
16247 35771 : SUBROUTINE block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16248 : INTEGER :: md_max
16249 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*3), kad(3*md_max), kac(3*3), pbd(2*md_max), pbc(2*3), &
16250 : pad(3*md_max), pac(3*3), prim(3*2*3*md_max), scale
16251 :
16252 : INTEGER :: ma, mb, mc, md, p_index
16253 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16254 :
16255 245209 : kbd(1:2*md_max) = 0.0_dp
16256 35771 : kbc(1:2*3) = 0.0_dp
16257 349928 : kad(1:3*md_max) = 0.0_dp
16258 35771 : kac(1:3*3) = 0.0_dp
16259 35771 : p_index = 0
16260 140490 : DO md = 1, md_max
16261 454647 : DO mc = 1, 3
16262 1047190 : DO mb = 1, 2
16263 628314 : ks_bd = 0.0_dp
16264 628314 : ks_bc = 0.0_dp
16265 628314 : p_bd = pbd((md - 1)*2 + mb)
16266 628314 : p_bc = pbc((mc - 1)*2 + mb)
16267 2513256 : DO ma = 1, 3
16268 1884942 : p_index = p_index + 1
16269 1884942 : tmp = scale*prim(p_index)
16270 1884942 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16271 1884942 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16272 1884942 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16273 2513256 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16274 : END DO
16275 628314 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
16276 942471 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
16277 : END DO
16278 : END DO
16279 : END DO
16280 35771 : END SUBROUTINE block_3_2_3
16281 : ! **************************************************************************************************
16282 : !> \brief ...
16283 : !> \param mc_max ...
16284 : !> \param md_max ...
16285 : !> \param kbd ...
16286 : !> \param kbc ...
16287 : !> \param kad ...
16288 : !> \param kac ...
16289 : !> \param pbd ...
16290 : !> \param pbc ...
16291 : !> \param pad ...
16292 : !> \param pac ...
16293 : !> \param prim ...
16294 : !> \param scale ...
16295 : ! **************************************************************************************************
16296 40033 : SUBROUTINE block_3_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16297 : INTEGER :: mc_max, md_max
16298 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*mc_max), kad(3*md_max), kac(3*mc_max), pbd(2*md_max), &
16299 : pbc(2*mc_max), pad(3*md_max), pac(3*mc_max), prim(3*2*mc_max*md_max), scale
16300 :
16301 : INTEGER :: ma, mb, mc, md, p_index
16302 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16303 :
16304 351309 : kbd(1:2*md_max) = 0.0_dp
16305 457903 : kbc(1:2*mc_max) = 0.0_dp
16306 506947 : kad(1:3*md_max) = 0.0_dp
16307 666838 : kac(1:3*mc_max) = 0.0_dp
16308 : p_index = 0
16309 195671 : DO md = 1, md_max
16310 1005593 : DO mc = 1, mc_max
16311 2585404 : DO mb = 1, 2
16312 1619844 : ks_bd = 0.0_dp
16313 1619844 : ks_bc = 0.0_dp
16314 1619844 : p_bd = pbd((md - 1)*2 + mb)
16315 1619844 : p_bc = pbc((mc - 1)*2 + mb)
16316 6479376 : DO ma = 1, 3
16317 4859532 : p_index = p_index + 1
16318 4859532 : tmp = scale*prim(p_index)
16319 4859532 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16320 4859532 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16321 4859532 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16322 6479376 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16323 : END DO
16324 1619844 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
16325 2429766 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
16326 : END DO
16327 : END DO
16328 : END DO
16329 40033 : END SUBROUTINE block_3_2
16330 : ! **************************************************************************************************
16331 : !> \brief ...
16332 : !> \param kbd ...
16333 : !> \param kbc ...
16334 : !> \param kad ...
16335 : !> \param kac ...
16336 : !> \param pbd ...
16337 : !> \param pbc ...
16338 : !> \param pad ...
16339 : !> \param pac ...
16340 : !> \param prim ...
16341 : !> \param scale ...
16342 : ! **************************************************************************************************
16343 1573828 : SUBROUTINE block_3_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16344 : REAL(KIND=dp) :: kbd(3*1), kbc(3*1), kad(3*1), kac(3*1), &
16345 : pbd(3*1), pbc(3*1), pad(3*1), &
16346 : pac(3*1), prim(3*3*1*1), scale
16347 :
16348 : INTEGER :: ma, mb, mc, md, p_index
16349 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16350 :
16351 1573828 : kbd(1:3*1) = 0.0_dp
16352 1573828 : kbc(1:3*1) = 0.0_dp
16353 1573828 : kad(1:3*1) = 0.0_dp
16354 1573828 : kac(1:3*1) = 0.0_dp
16355 1573828 : p_index = 0
16356 3147656 : DO md = 1, 1
16357 4721484 : DO mc = 1, 1
16358 7869140 : DO mb = 1, 3
16359 4721484 : ks_bd = 0.0_dp
16360 4721484 : ks_bc = 0.0_dp
16361 4721484 : p_bd = pbd((md - 1)*3 + mb)
16362 4721484 : p_bc = pbc((mc - 1)*3 + mb)
16363 18885936 : DO ma = 1, 3
16364 14164452 : p_index = p_index + 1
16365 14164452 : tmp = scale*prim(p_index)
16366 14164452 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16367 14164452 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16368 14164452 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16369 18885936 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16370 : END DO
16371 4721484 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
16372 6295312 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
16373 : END DO
16374 : END DO
16375 : END DO
16376 1573828 : END SUBROUTINE block_3_3_1_1
16377 : ! **************************************************************************************************
16378 : !> \brief ...
16379 : !> \param kbd ...
16380 : !> \param kbc ...
16381 : !> \param kad ...
16382 : !> \param kac ...
16383 : !> \param pbd ...
16384 : !> \param pbc ...
16385 : !> \param pad ...
16386 : !> \param pac ...
16387 : !> \param prim ...
16388 : !> \param scale ...
16389 : ! **************************************************************************************************
16390 8672 : SUBROUTINE block_3_3_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16391 : REAL(KIND=dp) :: kbd(3*2), kbc(3*1), kad(3*2), kac(3*1), &
16392 : pbd(3*2), pbc(3*1), pad(3*2), &
16393 : pac(3*1), prim(3*3*1*2), scale
16394 :
16395 : INTEGER :: ma, mb, mc, md, p_index
16396 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16397 :
16398 8672 : kbd(1:3*2) = 0.0_dp
16399 8672 : kbc(1:3*1) = 0.0_dp
16400 8672 : kad(1:3*2) = 0.0_dp
16401 8672 : kac(1:3*1) = 0.0_dp
16402 8672 : p_index = 0
16403 26016 : DO md = 1, 2
16404 43360 : DO mc = 1, 1
16405 86720 : DO mb = 1, 3
16406 52032 : ks_bd = 0.0_dp
16407 52032 : ks_bc = 0.0_dp
16408 52032 : p_bd = pbd((md - 1)*3 + mb)
16409 52032 : p_bc = pbc((mc - 1)*3 + mb)
16410 208128 : DO ma = 1, 3
16411 156096 : p_index = p_index + 1
16412 156096 : tmp = scale*prim(p_index)
16413 156096 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16414 156096 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16415 156096 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16416 208128 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16417 : END DO
16418 52032 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
16419 69376 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
16420 : END DO
16421 : END DO
16422 : END DO
16423 8672 : END SUBROUTINE block_3_3_1_2
16424 : ! **************************************************************************************************
16425 : !> \brief ...
16426 : !> \param md_max ...
16427 : !> \param kbd ...
16428 : !> \param kbc ...
16429 : !> \param kad ...
16430 : !> \param kac ...
16431 : !> \param pbd ...
16432 : !> \param pbc ...
16433 : !> \param pad ...
16434 : !> \param pac ...
16435 : !> \param prim ...
16436 : !> \param scale ...
16437 : ! **************************************************************************************************
16438 1490372 : SUBROUTINE block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16439 : INTEGER :: md_max
16440 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*1), kad(3*md_max), kac(3*1), pbd(3*md_max), pbc(3*1), &
16441 : pad(3*md_max), pac(3*1), prim(3*3*1*md_max), scale
16442 :
16443 : INTEGER :: ma, mb, mc, md, p_index
16444 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16445 :
16446 15416939 : kbd(1:3*md_max) = 0.0_dp
16447 1490372 : kbc(1:3*1) = 0.0_dp
16448 15416939 : kad(1:3*md_max) = 0.0_dp
16449 1490372 : kac(1:3*1) = 0.0_dp
16450 1490372 : p_index = 0
16451 6132561 : DO md = 1, md_max
16452 10774750 : DO mc = 1, 1
16453 23210945 : DO mb = 1, 3
16454 13926567 : ks_bd = 0.0_dp
16455 13926567 : ks_bc = 0.0_dp
16456 13926567 : p_bd = pbd((md - 1)*3 + mb)
16457 13926567 : p_bc = pbc((mc - 1)*3 + mb)
16458 55706268 : DO ma = 1, 3
16459 41779701 : p_index = p_index + 1
16460 41779701 : tmp = scale*prim(p_index)
16461 41779701 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16462 41779701 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16463 41779701 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16464 55706268 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16465 : END DO
16466 13926567 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
16467 18568756 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
16468 : END DO
16469 : END DO
16470 : END DO
16471 1490372 : END SUBROUTINE block_3_3_1
16472 : ! **************************************************************************************************
16473 : !> \brief ...
16474 : !> \param kbd ...
16475 : !> \param kbc ...
16476 : !> \param kad ...
16477 : !> \param kac ...
16478 : !> \param pbd ...
16479 : !> \param pbc ...
16480 : !> \param pad ...
16481 : !> \param pac ...
16482 : !> \param prim ...
16483 : !> \param scale ...
16484 : ! **************************************************************************************************
16485 23222 : SUBROUTINE block_3_3_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16486 : REAL(KIND=dp) :: kbd(3*1), kbc(3*2), kad(3*1), kac(3*2), &
16487 : pbd(3*1), pbc(3*2), pad(3*1), &
16488 : pac(3*2), prim(3*3*2*1), scale
16489 :
16490 : INTEGER :: ma, mb, mc, md, p_index
16491 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16492 :
16493 23222 : kbd(1:3*1) = 0.0_dp
16494 23222 : kbc(1:3*2) = 0.0_dp
16495 23222 : kad(1:3*1) = 0.0_dp
16496 23222 : kac(1:3*2) = 0.0_dp
16497 23222 : p_index = 0
16498 46444 : DO md = 1, 1
16499 92888 : DO mc = 1, 2
16500 208998 : DO mb = 1, 3
16501 139332 : ks_bd = 0.0_dp
16502 139332 : ks_bc = 0.0_dp
16503 139332 : p_bd = pbd((md - 1)*3 + mb)
16504 139332 : p_bc = pbc((mc - 1)*3 + mb)
16505 557328 : DO ma = 1, 3
16506 417996 : p_index = p_index + 1
16507 417996 : tmp = scale*prim(p_index)
16508 417996 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16509 417996 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16510 417996 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16511 557328 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16512 : END DO
16513 139332 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
16514 185776 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
16515 : END DO
16516 : END DO
16517 : END DO
16518 23222 : END SUBROUTINE block_3_3_2_1
16519 : ! **************************************************************************************************
16520 : !> \brief ...
16521 : !> \param md_max ...
16522 : !> \param kbd ...
16523 : !> \param kbc ...
16524 : !> \param kad ...
16525 : !> \param kac ...
16526 : !> \param pbd ...
16527 : !> \param pbc ...
16528 : !> \param pad ...
16529 : !> \param pac ...
16530 : !> \param prim ...
16531 : !> \param scale ...
16532 : ! **************************************************************************************************
16533 60934 : SUBROUTINE block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16534 : INTEGER :: md_max
16535 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*2), kad(3*md_max), kac(3*2), pbd(3*md_max), pbc(3*2), &
16536 : pad(3*md_max), pac(3*2), prim(3*3*2*md_max), scale
16537 :
16538 : INTEGER :: ma, mb, mc, md, p_index
16539 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16540 :
16541 625354 : kbd(1:3*md_max) = 0.0_dp
16542 60934 : kbc(1:3*2) = 0.0_dp
16543 625354 : kad(1:3*md_max) = 0.0_dp
16544 60934 : kac(1:3*2) = 0.0_dp
16545 60934 : p_index = 0
16546 249074 : DO md = 1, md_max
16547 625354 : DO mc = 1, 2
16548 1693260 : DO mb = 1, 3
16549 1128840 : ks_bd = 0.0_dp
16550 1128840 : ks_bc = 0.0_dp
16551 1128840 : p_bd = pbd((md - 1)*3 + mb)
16552 1128840 : p_bc = pbc((mc - 1)*3 + mb)
16553 4515360 : DO ma = 1, 3
16554 3386520 : p_index = p_index + 1
16555 3386520 : tmp = scale*prim(p_index)
16556 3386520 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16557 3386520 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16558 3386520 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16559 4515360 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16560 : END DO
16561 1128840 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
16562 1505120 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
16563 : END DO
16564 : END DO
16565 : END DO
16566 60934 : END SUBROUTINE block_3_3_2
16567 : ! **************************************************************************************************
16568 : !> \brief ...
16569 : !> \param mc_max ...
16570 : !> \param md_max ...
16571 : !> \param kbd ...
16572 : !> \param kbc ...
16573 : !> \param kad ...
16574 : !> \param kac ...
16575 : !> \param pbd ...
16576 : !> \param pbc ...
16577 : !> \param pad ...
16578 : !> \param pac ...
16579 : !> \param prim ...
16580 : !> \param scale ...
16581 : ! **************************************************************************************************
16582 3551350 : SUBROUTINE block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16583 : INTEGER :: mc_max, md_max
16584 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*mc_max), kad(3*md_max), kac(3*mc_max), pbd(3*md_max), &
16585 : pbc(3*mc_max), pad(3*md_max), pac(3*mc_max), prim(3*3*mc_max*md_max), scale
16586 :
16587 : INTEGER :: ma, mb, mc, md, p_index
16588 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16589 :
16590 26490700 : kbd(1:3*md_max) = 0.0_dp
16591 38859217 : kbc(1:3*mc_max) = 0.0_dp
16592 26490700 : kad(1:3*md_max) = 0.0_dp
16593 38859217 : kac(1:3*mc_max) = 0.0_dp
16594 : p_index = 0
16595 11197800 : DO md = 1, md_max
16596 37093957 : DO mc = 1, mc_max
16597 111231078 : DO mb = 1, 3
16598 77688471 : ks_bd = 0.0_dp
16599 77688471 : ks_bc = 0.0_dp
16600 77688471 : p_bd = pbd((md - 1)*3 + mb)
16601 77688471 : p_bc = pbc((mc - 1)*3 + mb)
16602 310753884 : DO ma = 1, 3
16603 233065413 : p_index = p_index + 1
16604 233065413 : tmp = scale*prim(p_index)
16605 233065413 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16606 233065413 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16607 233065413 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16608 310753884 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16609 : END DO
16610 77688471 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
16611 103584628 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
16612 : END DO
16613 : END DO
16614 : END DO
16615 3551350 : END SUBROUTINE block_3_3
16616 : ! **************************************************************************************************
16617 : !> \brief ...
16618 : !> \param kbd ...
16619 : !> \param kbc ...
16620 : !> \param kad ...
16621 : !> \param kac ...
16622 : !> \param pbd ...
16623 : !> \param pbc ...
16624 : !> \param pad ...
16625 : !> \param pac ...
16626 : !> \param prim ...
16627 : !> \param scale ...
16628 : ! **************************************************************************************************
16629 30314 : SUBROUTINE block_3_4_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16630 : REAL(KIND=dp) :: kbd(4*1), kbc(4*1), kad(3*1), kac(3*1), &
16631 : pbd(4*1), pbc(4*1), pad(3*1), &
16632 : pac(3*1), prim(3*4*1*1), scale
16633 :
16634 : INTEGER :: ma, mb, mc, md, p_index
16635 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16636 :
16637 30314 : kbd(1:4*1) = 0.0_dp
16638 30314 : kbc(1:4*1) = 0.0_dp
16639 30314 : kad(1:3*1) = 0.0_dp
16640 30314 : kac(1:3*1) = 0.0_dp
16641 30314 : p_index = 0
16642 60628 : DO md = 1, 1
16643 90942 : DO mc = 1, 1
16644 181884 : DO mb = 1, 4
16645 121256 : ks_bd = 0.0_dp
16646 121256 : ks_bc = 0.0_dp
16647 121256 : p_bd = pbd((md - 1)*4 + mb)
16648 121256 : p_bc = pbc((mc - 1)*4 + mb)
16649 485024 : DO ma = 1, 3
16650 363768 : p_index = p_index + 1
16651 363768 : tmp = scale*prim(p_index)
16652 363768 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16653 363768 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16654 363768 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16655 485024 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16656 : END DO
16657 121256 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
16658 151570 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
16659 : END DO
16660 : END DO
16661 : END DO
16662 30314 : END SUBROUTINE block_3_4_1_1
16663 : ! **************************************************************************************************
16664 : !> \brief ...
16665 : !> \param md_max ...
16666 : !> \param kbd ...
16667 : !> \param kbc ...
16668 : !> \param kad ...
16669 : !> \param kac ...
16670 : !> \param pbd ...
16671 : !> \param pbc ...
16672 : !> \param pad ...
16673 : !> \param pac ...
16674 : !> \param prim ...
16675 : !> \param scale ...
16676 : ! **************************************************************************************************
16677 29042 : SUBROUTINE block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16678 : INTEGER :: md_max
16679 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*1), kad(3*md_max), kac(3*1), pbd(4*md_max), pbc(4*1), &
16680 : pad(3*md_max), pac(3*1), prim(3*4*1*md_max), scale
16681 :
16682 : INTEGER :: ma, mb, mc, md, p_index
16683 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16684 :
16685 470634 : kbd(1:4*md_max) = 0.0_dp
16686 29042 : kbc(1:4*1) = 0.0_dp
16687 360236 : kad(1:3*md_max) = 0.0_dp
16688 29042 : kac(1:3*1) = 0.0_dp
16689 29042 : p_index = 0
16690 139440 : DO md = 1, md_max
16691 249838 : DO mc = 1, 1
16692 662388 : DO mb = 1, 4
16693 441592 : ks_bd = 0.0_dp
16694 441592 : ks_bc = 0.0_dp
16695 441592 : p_bd = pbd((md - 1)*4 + mb)
16696 441592 : p_bc = pbc((mc - 1)*4 + mb)
16697 1766368 : DO ma = 1, 3
16698 1324776 : p_index = p_index + 1
16699 1324776 : tmp = scale*prim(p_index)
16700 1324776 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16701 1324776 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16702 1324776 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16703 1766368 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16704 : END DO
16705 441592 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
16706 551990 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
16707 : END DO
16708 : END DO
16709 : END DO
16710 29042 : END SUBROUTINE block_3_4_1
16711 : ! **************************************************************************************************
16712 : !> \brief ...
16713 : !> \param mc_max ...
16714 : !> \param md_max ...
16715 : !> \param kbd ...
16716 : !> \param kbc ...
16717 : !> \param kad ...
16718 : !> \param kac ...
16719 : !> \param pbd ...
16720 : !> \param pbc ...
16721 : !> \param pad ...
16722 : !> \param pac ...
16723 : !> \param prim ...
16724 : !> \param scale ...
16725 : ! **************************************************************************************************
16726 71386 : SUBROUTINE block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16727 : INTEGER :: mc_max, md_max
16728 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*mc_max), kad(3*md_max), kac(3*mc_max), pbd(4*md_max), &
16729 : pbc(4*mc_max), pad(3*md_max), pac(3*mc_max), prim(3*4*mc_max*md_max), scale
16730 :
16731 : INTEGER :: ma, mb, mc, md, p_index
16732 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16733 :
16734 785398 : kbd(1:4*md_max) = 0.0_dp
16735 1199838 : kbc(1:4*mc_max) = 0.0_dp
16736 606895 : kad(1:3*md_max) = 0.0_dp
16737 917725 : kac(1:3*mc_max) = 0.0_dp
16738 : p_index = 0
16739 249889 : DO md = 1, md_max
16740 957534 : DO mc = 1, mc_max
16741 3716728 : DO mb = 1, 4
16742 2830580 : ks_bd = 0.0_dp
16743 2830580 : ks_bc = 0.0_dp
16744 2830580 : p_bd = pbd((md - 1)*4 + mb)
16745 2830580 : p_bc = pbc((mc - 1)*4 + mb)
16746 11322320 : DO ma = 1, 3
16747 8491740 : p_index = p_index + 1
16748 8491740 : tmp = scale*prim(p_index)
16749 8491740 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16750 8491740 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16751 8491740 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16752 11322320 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16753 : END DO
16754 2830580 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
16755 3538225 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
16756 : END DO
16757 : END DO
16758 : END DO
16759 71386 : END SUBROUTINE block_3_4
16760 : ! **************************************************************************************************
16761 : !> \brief ...
16762 : !> \param kbd ...
16763 : !> \param kbc ...
16764 : !> \param kad ...
16765 : !> \param kac ...
16766 : !> \param pbd ...
16767 : !> \param pbc ...
16768 : !> \param pad ...
16769 : !> \param pac ...
16770 : !> \param prim ...
16771 : !> \param scale ...
16772 : ! **************************************************************************************************
16773 40121 : SUBROUTINE block_3_5_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16774 : REAL(KIND=dp) :: kbd(5*1), kbc(5*1), kad(3*1), kac(3*1), &
16775 : pbd(5*1), pbc(5*1), pad(3*1), &
16776 : pac(3*1), prim(3*5*1*1), scale
16777 :
16778 : INTEGER :: ma, mb, mc, md, p_index
16779 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16780 :
16781 40121 : kbd(1:5*1) = 0.0_dp
16782 40121 : kbc(1:5*1) = 0.0_dp
16783 40121 : kad(1:3*1) = 0.0_dp
16784 40121 : kac(1:3*1) = 0.0_dp
16785 40121 : p_index = 0
16786 80242 : DO md = 1, 1
16787 120363 : DO mc = 1, 1
16788 280847 : DO mb = 1, 5
16789 200605 : ks_bd = 0.0_dp
16790 200605 : ks_bc = 0.0_dp
16791 200605 : p_bd = pbd((md - 1)*5 + mb)
16792 200605 : p_bc = pbc((mc - 1)*5 + mb)
16793 802420 : DO ma = 1, 3
16794 601815 : p_index = p_index + 1
16795 601815 : tmp = scale*prim(p_index)
16796 601815 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16797 601815 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16798 601815 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16799 802420 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16800 : END DO
16801 200605 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
16802 240726 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
16803 : END DO
16804 : END DO
16805 : END DO
16806 40121 : END SUBROUTINE block_3_5_1_1
16807 : ! **************************************************************************************************
16808 : !> \brief ...
16809 : !> \param md_max ...
16810 : !> \param kbd ...
16811 : !> \param kbc ...
16812 : !> \param kad ...
16813 : !> \param kac ...
16814 : !> \param pbd ...
16815 : !> \param pbc ...
16816 : !> \param pad ...
16817 : !> \param pac ...
16818 : !> \param prim ...
16819 : !> \param scale ...
16820 : ! **************************************************************************************************
16821 57684 : SUBROUTINE block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16822 : INTEGER :: md_max
16823 : REAL(KIND=dp) :: kbd(5*md_max), kbc(5*1), kad(3*md_max), kac(3*1), pbd(5*md_max), pbc(5*1), &
16824 : pad(3*md_max), pac(3*1), prim(3*5*1*md_max), scale
16825 :
16826 : INTEGER :: ma, mb, mc, md, p_index
16827 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16828 :
16829 1179984 : kbd(1:5*md_max) = 0.0_dp
16830 57684 : kbc(1:5*1) = 0.0_dp
16831 731064 : kad(1:3*md_max) = 0.0_dp
16832 57684 : kac(1:3*1) = 0.0_dp
16833 57684 : p_index = 0
16834 282144 : DO md = 1, md_max
16835 506604 : DO mc = 1, 1
16836 1571220 : DO mb = 1, 5
16837 1122300 : ks_bd = 0.0_dp
16838 1122300 : ks_bc = 0.0_dp
16839 1122300 : p_bd = pbd((md - 1)*5 + mb)
16840 1122300 : p_bc = pbc((mc - 1)*5 + mb)
16841 4489200 : DO ma = 1, 3
16842 3366900 : p_index = p_index + 1
16843 3366900 : tmp = scale*prim(p_index)
16844 3366900 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16845 3366900 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16846 3366900 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16847 4489200 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16848 : END DO
16849 1122300 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
16850 1346760 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
16851 : END DO
16852 : END DO
16853 : END DO
16854 57684 : END SUBROUTINE block_3_5_1
16855 : ! **************************************************************************************************
16856 : !> \brief ...
16857 : !> \param mc_max ...
16858 : !> \param md_max ...
16859 : !> \param kbd ...
16860 : !> \param kbc ...
16861 : !> \param kad ...
16862 : !> \param kac ...
16863 : !> \param pbd ...
16864 : !> \param pbc ...
16865 : !> \param pad ...
16866 : !> \param pac ...
16867 : !> \param prim ...
16868 : !> \param scale ...
16869 : ! **************************************************************************************************
16870 175158 : SUBROUTINE block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16871 : INTEGER :: mc_max, md_max
16872 : REAL(KIND=dp) :: kbd(5*md_max), kbc(5*mc_max), kad(3*md_max), kac(3*mc_max), pbd(5*md_max), &
16873 : pbc(5*mc_max), pad(3*md_max), pac(3*mc_max), prim(3*5*mc_max*md_max), scale
16874 :
16875 : INTEGER :: ma, mb, mc, md, p_index
16876 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16877 :
16878 2766343 : kbd(1:5*md_max) = 0.0_dp
16879 3662238 : kbc(1:5*mc_max) = 0.0_dp
16880 1729869 : kad(1:3*md_max) = 0.0_dp
16881 2267406 : kac(1:3*mc_max) = 0.0_dp
16882 : p_index = 0
16883 693395 : DO md = 1, md_max
16884 2776342 : DO mc = 1, mc_max
16885 13015919 : DO mb = 1, 5
16886 10414735 : ks_bd = 0.0_dp
16887 10414735 : ks_bc = 0.0_dp
16888 10414735 : p_bd = pbd((md - 1)*5 + mb)
16889 10414735 : p_bc = pbc((mc - 1)*5 + mb)
16890 41658940 : DO ma = 1, 3
16891 31244205 : p_index = p_index + 1
16892 31244205 : tmp = scale*prim(p_index)
16893 31244205 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16894 31244205 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16895 31244205 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16896 41658940 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16897 : END DO
16898 10414735 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
16899 12497682 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
16900 : END DO
16901 : END DO
16902 : END DO
16903 175158 : END SUBROUTINE block_3_5
16904 : ! **************************************************************************************************
16905 : !> \brief ...
16906 : !> \param kbd ...
16907 : !> \param kbc ...
16908 : !> \param kad ...
16909 : !> \param kac ...
16910 : !> \param pbd ...
16911 : !> \param pbc ...
16912 : !> \param pad ...
16913 : !> \param pac ...
16914 : !> \param prim ...
16915 : !> \param scale ...
16916 : ! **************************************************************************************************
16917 11 : SUBROUTINE block_3_6_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16918 : REAL(KIND=dp) :: kbd(6*1), kbc(6*1), kad(3*1), kac(3*1), &
16919 : pbd(6*1), pbc(6*1), pad(3*1), &
16920 : pac(3*1), prim(3*6*1*1), scale
16921 :
16922 : INTEGER :: ma, mb, mc, md, p_index
16923 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16924 :
16925 11 : kbd(1:6*1) = 0.0_dp
16926 11 : kbc(1:6*1) = 0.0_dp
16927 11 : kad(1:3*1) = 0.0_dp
16928 11 : kac(1:3*1) = 0.0_dp
16929 11 : p_index = 0
16930 22 : DO md = 1, 1
16931 33 : DO mc = 1, 1
16932 88 : DO mb = 1, 6
16933 66 : ks_bd = 0.0_dp
16934 66 : ks_bc = 0.0_dp
16935 66 : p_bd = pbd((md - 1)*6 + mb)
16936 66 : p_bc = pbc((mc - 1)*6 + mb)
16937 264 : DO ma = 1, 3
16938 198 : p_index = p_index + 1
16939 198 : tmp = scale*prim(p_index)
16940 198 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16941 198 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16942 198 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16943 264 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16944 : END DO
16945 66 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
16946 77 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
16947 : END DO
16948 : END DO
16949 : END DO
16950 11 : END SUBROUTINE block_3_6_1_1
16951 : ! **************************************************************************************************
16952 : !> \brief ...
16953 : !> \param md_max ...
16954 : !> \param kbd ...
16955 : !> \param kbc ...
16956 : !> \param kad ...
16957 : !> \param kac ...
16958 : !> \param pbd ...
16959 : !> \param pbc ...
16960 : !> \param pad ...
16961 : !> \param pac ...
16962 : !> \param prim ...
16963 : !> \param scale ...
16964 : ! **************************************************************************************************
16965 46 : SUBROUTINE block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
16966 : INTEGER :: md_max
16967 : REAL(KIND=dp) :: kbd(6*md_max), kbc(6*1), kad(3*md_max), kac(3*1), pbd(6*md_max), pbc(6*1), &
16968 : pad(3*md_max), pac(3*1), prim(3*6*1*md_max), scale
16969 :
16970 : INTEGER :: ma, mb, mc, md, p_index
16971 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
16972 :
16973 1210 : kbd(1:6*md_max) = 0.0_dp
16974 46 : kbc(1:6*1) = 0.0_dp
16975 628 : kad(1:3*md_max) = 0.0_dp
16976 46 : kac(1:3*1) = 0.0_dp
16977 46 : p_index = 0
16978 240 : DO md = 1, md_max
16979 434 : DO mc = 1, 1
16980 1552 : DO mb = 1, 6
16981 1164 : ks_bd = 0.0_dp
16982 1164 : ks_bc = 0.0_dp
16983 1164 : p_bd = pbd((md - 1)*6 + mb)
16984 1164 : p_bc = pbc((mc - 1)*6 + mb)
16985 4656 : DO ma = 1, 3
16986 3492 : p_index = p_index + 1
16987 3492 : tmp = scale*prim(p_index)
16988 3492 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16989 3492 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16990 3492 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16991 4656 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16992 : END DO
16993 1164 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
16994 1358 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
16995 : END DO
16996 : END DO
16997 : END DO
16998 46 : END SUBROUTINE block_3_6_1
16999 : ! **************************************************************************************************
17000 : !> \brief ...
17001 : !> \param mc_max ...
17002 : !> \param md_max ...
17003 : !> \param kbd ...
17004 : !> \param kbc ...
17005 : !> \param kad ...
17006 : !> \param kac ...
17007 : !> \param pbd ...
17008 : !> \param pbc ...
17009 : !> \param pad ...
17010 : !> \param pac ...
17011 : !> \param prim ...
17012 : !> \param scale ...
17013 : ! **************************************************************************************************
17014 145 : SUBROUTINE block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17015 : INTEGER :: mc_max, md_max
17016 : REAL(KIND=dp) :: kbd(6*md_max), kbc(6*mc_max), kad(3*md_max), kac(3*mc_max), pbd(6*md_max), &
17017 : pbc(6*mc_max), pad(3*md_max), pac(3*mc_max), prim(3*6*mc_max*md_max), scale
17018 :
17019 : INTEGER :: ma, mb, mc, md, p_index
17020 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17021 :
17022 3667 : kbd(1:6*md_max) = 0.0_dp
17023 3061 : kbc(1:6*mc_max) = 0.0_dp
17024 1906 : kad(1:3*md_max) = 0.0_dp
17025 1603 : kac(1:3*mc_max) = 0.0_dp
17026 : p_index = 0
17027 732 : DO md = 1, md_max
17028 2686 : DO mc = 1, mc_max
17029 14265 : DO mb = 1, 6
17030 11724 : ks_bd = 0.0_dp
17031 11724 : ks_bc = 0.0_dp
17032 11724 : p_bd = pbd((md - 1)*6 + mb)
17033 11724 : p_bc = pbc((mc - 1)*6 + mb)
17034 46896 : DO ma = 1, 3
17035 35172 : p_index = p_index + 1
17036 35172 : tmp = scale*prim(p_index)
17037 35172 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
17038 35172 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
17039 35172 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
17040 46896 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
17041 : END DO
17042 11724 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
17043 13678 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
17044 : END DO
17045 : END DO
17046 : END DO
17047 145 : END SUBROUTINE block_3_6
17048 : ! **************************************************************************************************
17049 : !> \brief ...
17050 : !> \param mc_max ...
17051 : !> \param md_max ...
17052 : !> \param kbd ...
17053 : !> \param kbc ...
17054 : !> \param kad ...
17055 : !> \param kac ...
17056 : !> \param pbd ...
17057 : !> \param pbc ...
17058 : !> \param pad ...
17059 : !> \param pac ...
17060 : !> \param prim ...
17061 : !> \param scale ...
17062 : ! **************************************************************************************************
17063 75295 : SUBROUTINE block_3_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17064 : INTEGER :: mc_max, md_max
17065 : REAL(KIND=dp) :: kbd(7*md_max), kbc(7*mc_max), kad(3*md_max), kac(3*mc_max), pbd(7*md_max), &
17066 : pbc(7*mc_max), pad(3*md_max), pac(3*mc_max), prim(3*7*mc_max*md_max), scale
17067 :
17068 : INTEGER :: ma, mb, mc, md, p_index
17069 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17070 :
17071 1842662 : kbd(1:7*md_max) = 0.0_dp
17072 1842039 : kbc(1:7*mc_max) = 0.0_dp
17073 832738 : kad(1:3*md_max) = 0.0_dp
17074 832471 : kac(1:3*mc_max) = 0.0_dp
17075 : p_index = 0
17076 327776 : DO md = 1, md_max
17077 1180119 : DO mc = 1, mc_max
17078 7071225 : DO mb = 1, 7
17079 5966401 : ks_bd = 0.0_dp
17080 5966401 : ks_bc = 0.0_dp
17081 5966401 : p_bd = pbd((md - 1)*7 + mb)
17082 5966401 : p_bc = pbc((mc - 1)*7 + mb)
17083 23865604 : DO ma = 1, 3
17084 17899203 : p_index = p_index + 1
17085 17899203 : tmp = scale*prim(p_index)
17086 17899203 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
17087 17899203 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
17088 17899203 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
17089 23865604 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
17090 : END DO
17091 5966401 : kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
17092 6818744 : kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
17093 : END DO
17094 : END DO
17095 : END DO
17096 75295 : END SUBROUTINE block_3_7
17097 : ! **************************************************************************************************
17098 : !> \brief ...
17099 : !> \param mc_max ...
17100 : !> \param md_max ...
17101 : !> \param kbd ...
17102 : !> \param kbc ...
17103 : !> \param kad ...
17104 : !> \param kac ...
17105 : !> \param pbd ...
17106 : !> \param pbc ...
17107 : !> \param pad ...
17108 : !> \param pac ...
17109 : !> \param prim ...
17110 : !> \param scale ...
17111 : ! **************************************************************************************************
17112 181 : SUBROUTINE block_3_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17113 : INTEGER :: mc_max, md_max
17114 : REAL(KIND=dp) :: kbd(9*md_max), kbc(9*mc_max), kad(3*md_max), kac(3*mc_max), pbd(9*md_max), &
17115 : pbc(9*mc_max), pad(3*md_max), pac(3*mc_max), prim(3*9*mc_max*md_max), scale
17116 :
17117 : INTEGER :: ma, mb, mc, md, p_index
17118 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17119 :
17120 9406 : kbd(1:9*md_max) = 0.0_dp
17121 7813 : kbc(1:9*mc_max) = 0.0_dp
17122 3256 : kad(1:3*md_max) = 0.0_dp
17123 2725 : kac(1:3*mc_max) = 0.0_dp
17124 : p_index = 0
17125 1206 : DO md = 1, md_max
17126 6146 : DO mc = 1, mc_max
17127 50425 : DO mb = 1, 9
17128 44460 : ks_bd = 0.0_dp
17129 44460 : ks_bc = 0.0_dp
17130 44460 : p_bd = pbd((md - 1)*9 + mb)
17131 44460 : p_bc = pbc((mc - 1)*9 + mb)
17132 177840 : DO ma = 1, 3
17133 133380 : p_index = p_index + 1
17134 133380 : tmp = scale*prim(p_index)
17135 133380 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
17136 133380 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
17137 133380 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
17138 177840 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
17139 : END DO
17140 44460 : kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
17141 49400 : kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
17142 : END DO
17143 : END DO
17144 : END DO
17145 181 : END SUBROUTINE block_3_9
17146 : ! **************************************************************************************************
17147 : !> \brief ...
17148 : !> \param mc_max ...
17149 : !> \param md_max ...
17150 : !> \param kbd ...
17151 : !> \param kbc ...
17152 : !> \param kad ...
17153 : !> \param kac ...
17154 : !> \param pbd ...
17155 : !> \param pbc ...
17156 : !> \param pad ...
17157 : !> \param pac ...
17158 : !> \param prim ...
17159 : !> \param scale ...
17160 : ! **************************************************************************************************
17161 94 : SUBROUTINE block_3_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17162 : INTEGER :: mc_max, md_max
17163 : REAL(KIND=dp) :: kbd(10*md_max), kbc(10*mc_max), kad(3*md_max), kac(3*mc_max), &
17164 : pbd(10*md_max), pbc(10*mc_max), pad(3*md_max), pac(3*mc_max), prim(3*10*mc_max*md_max), &
17165 : scale
17166 :
17167 : INTEGER :: ma, mb, mc, md, p_index
17168 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17169 :
17170 5484 : kbd(1:10*md_max) = 0.0_dp
17171 2714 : kbc(1:10*mc_max) = 0.0_dp
17172 1711 : kad(1:3*md_max) = 0.0_dp
17173 880 : kac(1:3*mc_max) = 0.0_dp
17174 : p_index = 0
17175 633 : DO md = 1, md_max
17176 2178 : DO mc = 1, mc_max
17177 17534 : DO mb = 1, 10
17178 15450 : ks_bd = 0.0_dp
17179 15450 : ks_bc = 0.0_dp
17180 15450 : p_bd = pbd((md - 1)*10 + mb)
17181 15450 : p_bc = pbc((mc - 1)*10 + mb)
17182 61800 : DO ma = 1, 3
17183 46350 : p_index = p_index + 1
17184 46350 : tmp = scale*prim(p_index)
17185 46350 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
17186 46350 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
17187 46350 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
17188 61800 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
17189 : END DO
17190 15450 : kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
17191 16995 : kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
17192 : END DO
17193 : END DO
17194 : END DO
17195 94 : END SUBROUTINE block_3_10
17196 : ! **************************************************************************************************
17197 : !> \brief ...
17198 : !> \param mc_max ...
17199 : !> \param md_max ...
17200 : !> \param kbd ...
17201 : !> \param kbc ...
17202 : !> \param kad ...
17203 : !> \param kac ...
17204 : !> \param pbd ...
17205 : !> \param pbc ...
17206 : !> \param pad ...
17207 : !> \param pac ...
17208 : !> \param prim ...
17209 : !> \param scale ...
17210 : ! **************************************************************************************************
17211 123 : SUBROUTINE block_3_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17212 : INTEGER :: mc_max, md_max
17213 : REAL(KIND=dp) :: kbd(11*md_max), kbc(11*mc_max), kad(3*md_max), kac(3*mc_max), &
17214 : pbd(11*md_max), pbc(11*mc_max), pad(3*md_max), pac(3*mc_max), prim(3*11*mc_max*md_max), &
17215 : scale
17216 :
17217 : INTEGER :: ma, mb, mc, md, p_index
17218 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17219 :
17220 9088 : kbd(1:11*md_max) = 0.0_dp
17221 4171 : kbc(1:11*mc_max) = 0.0_dp
17222 2568 : kad(1:3*md_max) = 0.0_dp
17223 1227 : kac(1:3*mc_max) = 0.0_dp
17224 : p_index = 0
17225 938 : DO md = 1, md_max
17226 3387 : DO mc = 1, mc_max
17227 30203 : DO mb = 1, 11
17228 26939 : ks_bd = 0.0_dp
17229 26939 : ks_bc = 0.0_dp
17230 26939 : p_bd = pbd((md - 1)*11 + mb)
17231 26939 : p_bc = pbc((mc - 1)*11 + mb)
17232 107756 : DO ma = 1, 3
17233 80817 : p_index = p_index + 1
17234 80817 : tmp = scale*prim(p_index)
17235 80817 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
17236 80817 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
17237 80817 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
17238 107756 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
17239 : END DO
17240 26939 : kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
17241 29388 : kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
17242 : END DO
17243 : END DO
17244 : END DO
17245 123 : END SUBROUTINE block_3_11
17246 : ! **************************************************************************************************
17247 : !> \brief ...
17248 : !> \param mc_max ...
17249 : !> \param md_max ...
17250 : !> \param kbd ...
17251 : !> \param kbc ...
17252 : !> \param kad ...
17253 : !> \param kac ...
17254 : !> \param pbd ...
17255 : !> \param pbc ...
17256 : !> \param pad ...
17257 : !> \param pac ...
17258 : !> \param prim ...
17259 : !> \param scale ...
17260 : ! **************************************************************************************************
17261 107 : SUBROUTINE block_3_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17262 : INTEGER :: mc_max, md_max
17263 : REAL(KIND=dp) :: kbd(15*md_max), kbc(15*mc_max), kad(3*md_max), kac(3*mc_max), &
17264 : pbd(15*md_max), pbc(15*mc_max), pad(3*md_max), pac(3*mc_max), prim(3*15*mc_max*md_max), &
17265 : scale
17266 :
17267 : INTEGER :: ma, mb, mc, md, p_index
17268 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17269 :
17270 10472 : kbd(1:15*md_max) = 0.0_dp
17271 4682 : kbc(1:15*mc_max) = 0.0_dp
17272 2180 : kad(1:3*md_max) = 0.0_dp
17273 1022 : kac(1:3*mc_max) = 0.0_dp
17274 : p_index = 0
17275 798 : DO md = 1, md_max
17276 2809 : DO mc = 1, mc_max
17277 32867 : DO mb = 1, 15
17278 30165 : ks_bd = 0.0_dp
17279 30165 : ks_bc = 0.0_dp
17280 30165 : p_bd = pbd((md - 1)*15 + mb)
17281 30165 : p_bc = pbc((mc - 1)*15 + mb)
17282 120660 : DO ma = 1, 3
17283 90495 : p_index = p_index + 1
17284 90495 : tmp = scale*prim(p_index)
17285 90495 : ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
17286 90495 : ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
17287 90495 : kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
17288 120660 : kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
17289 : END DO
17290 30165 : kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
17291 32176 : kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
17292 : END DO
17293 : END DO
17294 : END DO
17295 107 : END SUBROUTINE block_3_15
17296 : ! **************************************************************************************************
17297 : !> \brief ...
17298 : !> \param kbd ...
17299 : !> \param kbc ...
17300 : !> \param kad ...
17301 : !> \param kac ...
17302 : !> \param pbd ...
17303 : !> \param pbc ...
17304 : !> \param pad ...
17305 : !> \param pac ...
17306 : !> \param prim ...
17307 : !> \param scale ...
17308 : ! **************************************************************************************************
17309 257417 : SUBROUTINE block_4_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17310 : REAL(KIND=dp) :: kbd(1*1), kbc(1*1), kad(4*1), kac(4*1), &
17311 : pbd(1*1), pbc(1*1), pad(4*1), &
17312 : pac(4*1), prim(4*1*1*1), scale
17313 :
17314 : INTEGER :: ma, mb, mc, md, p_index
17315 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17316 :
17317 257417 : kbd(1:1*1) = 0.0_dp
17318 257417 : kbc(1:1*1) = 0.0_dp
17319 257417 : kad(1:4*1) = 0.0_dp
17320 257417 : kac(1:4*1) = 0.0_dp
17321 257417 : p_index = 0
17322 514834 : DO md = 1, 1
17323 772251 : DO mc = 1, 1
17324 772251 : DO mb = 1, 1
17325 257417 : ks_bd = 0.0_dp
17326 257417 : ks_bc = 0.0_dp
17327 257417 : p_bd = pbd((md - 1)*1 + mb)
17328 257417 : p_bc = pbc((mc - 1)*1 + mb)
17329 1287085 : DO ma = 1, 4
17330 1029668 : p_index = p_index + 1
17331 1029668 : tmp = scale*prim(p_index)
17332 1029668 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17333 1029668 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17334 1029668 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17335 1287085 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17336 : END DO
17337 257417 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17338 514834 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17339 : END DO
17340 : END DO
17341 : END DO
17342 257417 : END SUBROUTINE block_4_1_1_1
17343 : ! **************************************************************************************************
17344 : !> \brief ...
17345 : !> \param kbd ...
17346 : !> \param kbc ...
17347 : !> \param kad ...
17348 : !> \param kac ...
17349 : !> \param pbd ...
17350 : !> \param pbc ...
17351 : !> \param pad ...
17352 : !> \param pac ...
17353 : !> \param prim ...
17354 : !> \param scale ...
17355 : ! **************************************************************************************************
17356 6 : SUBROUTINE block_4_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17357 : REAL(KIND=dp) :: kbd(1*2), kbc(1*1), kad(4*2), kac(4*1), &
17358 : pbd(1*2), pbc(1*1), pad(4*2), &
17359 : pac(4*1), prim(4*1*1*2), scale
17360 :
17361 : INTEGER :: ma, mb, mc, md, p_index
17362 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17363 :
17364 6 : kbd(1:1*2) = 0.0_dp
17365 6 : kbc(1:1*1) = 0.0_dp
17366 6 : kad(1:4*2) = 0.0_dp
17367 6 : kac(1:4*1) = 0.0_dp
17368 6 : p_index = 0
17369 18 : DO md = 1, 2
17370 30 : DO mc = 1, 1
17371 36 : DO mb = 1, 1
17372 12 : ks_bd = 0.0_dp
17373 12 : ks_bc = 0.0_dp
17374 12 : p_bd = pbd((md - 1)*1 + mb)
17375 12 : p_bc = pbc((mc - 1)*1 + mb)
17376 60 : DO ma = 1, 4
17377 48 : p_index = p_index + 1
17378 48 : tmp = scale*prim(p_index)
17379 48 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17380 48 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17381 48 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17382 60 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17383 : END DO
17384 12 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17385 24 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17386 : END DO
17387 : END DO
17388 : END DO
17389 6 : END SUBROUTINE block_4_1_1_2
17390 : ! **************************************************************************************************
17391 : !> \brief ...
17392 : !> \param kbd ...
17393 : !> \param kbc ...
17394 : !> \param kad ...
17395 : !> \param kac ...
17396 : !> \param pbd ...
17397 : !> \param pbc ...
17398 : !> \param pad ...
17399 : !> \param pac ...
17400 : !> \param prim ...
17401 : !> \param scale ...
17402 : ! **************************************************************************************************
17403 87857 : SUBROUTINE block_4_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17404 : REAL(KIND=dp) :: kbd(1*3), kbc(1*1), kad(4*3), kac(4*1), &
17405 : pbd(1*3), pbc(1*1), pad(4*3), &
17406 : pac(4*1), prim(4*1*1*3), scale
17407 :
17408 : INTEGER :: ma, mb, mc, md, p_index
17409 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17410 :
17411 87857 : kbd(1:1*3) = 0.0_dp
17412 87857 : kbc(1:1*1) = 0.0_dp
17413 87857 : kad(1:4*3) = 0.0_dp
17414 87857 : kac(1:4*1) = 0.0_dp
17415 87857 : p_index = 0
17416 351428 : DO md = 1, 3
17417 614999 : DO mc = 1, 1
17418 790713 : DO mb = 1, 1
17419 263571 : ks_bd = 0.0_dp
17420 263571 : ks_bc = 0.0_dp
17421 263571 : p_bd = pbd((md - 1)*1 + mb)
17422 263571 : p_bc = pbc((mc - 1)*1 + mb)
17423 1317855 : DO ma = 1, 4
17424 1054284 : p_index = p_index + 1
17425 1054284 : tmp = scale*prim(p_index)
17426 1054284 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17427 1054284 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17428 1054284 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17429 1317855 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17430 : END DO
17431 263571 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17432 527142 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17433 : END DO
17434 : END DO
17435 : END DO
17436 87857 : END SUBROUTINE block_4_1_1_3
17437 : ! **************************************************************************************************
17438 : !> \brief ...
17439 : !> \param kbd ...
17440 : !> \param kbc ...
17441 : !> \param kad ...
17442 : !> \param kac ...
17443 : !> \param pbd ...
17444 : !> \param pbc ...
17445 : !> \param pad ...
17446 : !> \param pac ...
17447 : !> \param prim ...
17448 : !> \param scale ...
17449 : ! **************************************************************************************************
17450 85426 : SUBROUTINE block_4_1_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17451 : REAL(KIND=dp) :: kbd(1*4), kbc(1*1), kad(4*4), kac(4*1), &
17452 : pbd(1*4), pbc(1*1), pad(4*4), &
17453 : pac(4*1), prim(4*1*1*4), scale
17454 :
17455 : INTEGER :: ma, mb, mc, md, p_index
17456 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17457 :
17458 85426 : kbd(1:1*4) = 0.0_dp
17459 85426 : kbc(1:1*1) = 0.0_dp
17460 85426 : kad(1:4*4) = 0.0_dp
17461 85426 : kac(1:4*1) = 0.0_dp
17462 85426 : p_index = 0
17463 427130 : DO md = 1, 4
17464 768834 : DO mc = 1, 1
17465 1025112 : DO mb = 1, 1
17466 341704 : ks_bd = 0.0_dp
17467 341704 : ks_bc = 0.0_dp
17468 341704 : p_bd = pbd((md - 1)*1 + mb)
17469 341704 : p_bc = pbc((mc - 1)*1 + mb)
17470 1708520 : DO ma = 1, 4
17471 1366816 : p_index = p_index + 1
17472 1366816 : tmp = scale*prim(p_index)
17473 1366816 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17474 1366816 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17475 1366816 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17476 1708520 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17477 : END DO
17478 341704 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17479 683408 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17480 : END DO
17481 : END DO
17482 : END DO
17483 85426 : END SUBROUTINE block_4_1_1_4
17484 : ! **************************************************************************************************
17485 : !> \brief ...
17486 : !> \param md_max ...
17487 : !> \param kbd ...
17488 : !> \param kbc ...
17489 : !> \param kad ...
17490 : !> \param kac ...
17491 : !> \param pbd ...
17492 : !> \param pbc ...
17493 : !> \param pad ...
17494 : !> \param pac ...
17495 : !> \param prim ...
17496 : !> \param scale ...
17497 : ! **************************************************************************************************
17498 30354 : SUBROUTINE block_4_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17499 : INTEGER :: md_max
17500 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*1), kad(4*md_max), kac(4*1), pbd(1*md_max), pbc(1*1), &
17501 : pad(4*md_max), pac(4*1), prim(4*1*1*md_max), scale
17502 :
17503 : INTEGER :: ma, mb, mc, md, p_index
17504 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17505 :
17506 182418 : kbd(1:1*md_max) = 0.0_dp
17507 30354 : kbc(1:1*1) = 0.0_dp
17508 638610 : kad(1:4*md_max) = 0.0_dp
17509 30354 : kac(1:4*1) = 0.0_dp
17510 30354 : p_index = 0
17511 182418 : DO md = 1, md_max
17512 334482 : DO mc = 1, 1
17513 456192 : DO mb = 1, 1
17514 152064 : ks_bd = 0.0_dp
17515 152064 : ks_bc = 0.0_dp
17516 152064 : p_bd = pbd((md - 1)*1 + mb)
17517 152064 : p_bc = pbc((mc - 1)*1 + mb)
17518 760320 : DO ma = 1, 4
17519 608256 : p_index = p_index + 1
17520 608256 : tmp = scale*prim(p_index)
17521 608256 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17522 608256 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17523 608256 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17524 760320 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17525 : END DO
17526 152064 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17527 304128 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17528 : END DO
17529 : END DO
17530 : END DO
17531 30354 : END SUBROUTINE block_4_1_1
17532 : ! **************************************************************************************************
17533 : !> \brief ...
17534 : !> \param kbd ...
17535 : !> \param kbc ...
17536 : !> \param kad ...
17537 : !> \param kac ...
17538 : !> \param pbd ...
17539 : !> \param pbc ...
17540 : !> \param pad ...
17541 : !> \param pac ...
17542 : !> \param prim ...
17543 : !> \param scale ...
17544 : ! **************************************************************************************************
17545 3 : SUBROUTINE block_4_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17546 : REAL(KIND=dp) :: kbd(1*1), kbc(1*2), kad(4*1), kac(4*2), &
17547 : pbd(1*1), pbc(1*2), pad(4*1), &
17548 : pac(4*2), prim(4*1*2*1), scale
17549 :
17550 : INTEGER :: ma, mb, mc, md, p_index
17551 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17552 :
17553 3 : kbd(1:1*1) = 0.0_dp
17554 3 : kbc(1:1*2) = 0.0_dp
17555 3 : kad(1:4*1) = 0.0_dp
17556 3 : kac(1:4*2) = 0.0_dp
17557 3 : p_index = 0
17558 6 : DO md = 1, 1
17559 12 : DO mc = 1, 2
17560 15 : DO mb = 1, 1
17561 6 : ks_bd = 0.0_dp
17562 6 : ks_bc = 0.0_dp
17563 6 : p_bd = pbd((md - 1)*1 + mb)
17564 6 : p_bc = pbc((mc - 1)*1 + mb)
17565 30 : DO ma = 1, 4
17566 24 : p_index = p_index + 1
17567 24 : tmp = scale*prim(p_index)
17568 24 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17569 24 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17570 24 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17571 30 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17572 : END DO
17573 6 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17574 12 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17575 : END DO
17576 : END DO
17577 : END DO
17578 3 : END SUBROUTINE block_4_1_2_1
17579 : ! **************************************************************************************************
17580 : !> \brief ...
17581 : !> \param kbd ...
17582 : !> \param kbc ...
17583 : !> \param kad ...
17584 : !> \param kac ...
17585 : !> \param pbd ...
17586 : !> \param pbc ...
17587 : !> \param pad ...
17588 : !> \param pac ...
17589 : !> \param prim ...
17590 : !> \param scale ...
17591 : ! **************************************************************************************************
17592 5 : SUBROUTINE block_4_1_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17593 : REAL(KIND=dp) :: kbd(1*2), kbc(1*2), kad(4*2), kac(4*2), &
17594 : pbd(1*2), pbc(1*2), pad(4*2), &
17595 : pac(4*2), prim(4*1*2*2), scale
17596 :
17597 : INTEGER :: ma, mb, mc, md, p_index
17598 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17599 :
17600 5 : kbd(1:1*2) = 0.0_dp
17601 5 : kbc(1:1*2) = 0.0_dp
17602 5 : kad(1:4*2) = 0.0_dp
17603 5 : kac(1:4*2) = 0.0_dp
17604 5 : p_index = 0
17605 15 : DO md = 1, 2
17606 35 : DO mc = 1, 2
17607 50 : DO mb = 1, 1
17608 20 : ks_bd = 0.0_dp
17609 20 : ks_bc = 0.0_dp
17610 20 : p_bd = pbd((md - 1)*1 + mb)
17611 20 : p_bc = pbc((mc - 1)*1 + mb)
17612 100 : DO ma = 1, 4
17613 80 : p_index = p_index + 1
17614 80 : tmp = scale*prim(p_index)
17615 80 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17616 80 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17617 80 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17618 100 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17619 : END DO
17620 20 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17621 40 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17622 : END DO
17623 : END DO
17624 : END DO
17625 5 : END SUBROUTINE block_4_1_2_2
17626 : ! **************************************************************************************************
17627 : !> \brief ...
17628 : !> \param md_max ...
17629 : !> \param kbd ...
17630 : !> \param kbc ...
17631 : !> \param kad ...
17632 : !> \param kac ...
17633 : !> \param pbd ...
17634 : !> \param pbc ...
17635 : !> \param pad ...
17636 : !> \param pac ...
17637 : !> \param prim ...
17638 : !> \param scale ...
17639 : ! **************************************************************************************************
17640 25 : SUBROUTINE block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17641 : INTEGER :: md_max
17642 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*2), kad(4*md_max), kac(4*2), pbd(1*md_max), pbc(1*2), &
17643 : pad(4*md_max), pac(4*2), prim(4*1*2*md_max), scale
17644 :
17645 : INTEGER :: ma, mb, mc, md, p_index
17646 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17647 :
17648 207 : kbd(1:1*md_max) = 0.0_dp
17649 25 : kbc(1:1*2) = 0.0_dp
17650 753 : kad(1:4*md_max) = 0.0_dp
17651 25 : kac(1:4*2) = 0.0_dp
17652 25 : p_index = 0
17653 207 : DO md = 1, md_max
17654 571 : DO mc = 1, 2
17655 910 : DO mb = 1, 1
17656 364 : ks_bd = 0.0_dp
17657 364 : ks_bc = 0.0_dp
17658 364 : p_bd = pbd((md - 1)*1 + mb)
17659 364 : p_bc = pbc((mc - 1)*1 + mb)
17660 1820 : DO ma = 1, 4
17661 1456 : p_index = p_index + 1
17662 1456 : tmp = scale*prim(p_index)
17663 1456 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17664 1456 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17665 1456 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17666 1820 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17667 : END DO
17668 364 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17669 728 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17670 : END DO
17671 : END DO
17672 : END DO
17673 25 : END SUBROUTINE block_4_1_2
17674 : ! **************************************************************************************************
17675 : !> \brief ...
17676 : !> \param kbd ...
17677 : !> \param kbc ...
17678 : !> \param kad ...
17679 : !> \param kac ...
17680 : !> \param pbd ...
17681 : !> \param pbc ...
17682 : !> \param pad ...
17683 : !> \param pac ...
17684 : !> \param prim ...
17685 : !> \param scale ...
17686 : ! **************************************************************************************************
17687 76229 : SUBROUTINE block_4_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17688 : REAL(KIND=dp) :: kbd(1*1), kbc(1*3), kad(4*1), kac(4*3), &
17689 : pbd(1*1), pbc(1*3), pad(4*1), &
17690 : pac(4*3), prim(4*1*3*1), scale
17691 :
17692 : INTEGER :: ma, mb, mc, md, p_index
17693 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17694 :
17695 76229 : kbd(1:1*1) = 0.0_dp
17696 76229 : kbc(1:1*3) = 0.0_dp
17697 76229 : kad(1:4*1) = 0.0_dp
17698 76229 : kac(1:4*3) = 0.0_dp
17699 76229 : p_index = 0
17700 152458 : DO md = 1, 1
17701 381145 : DO mc = 1, 3
17702 533603 : DO mb = 1, 1
17703 228687 : ks_bd = 0.0_dp
17704 228687 : ks_bc = 0.0_dp
17705 228687 : p_bd = pbd((md - 1)*1 + mb)
17706 228687 : p_bc = pbc((mc - 1)*1 + mb)
17707 1143435 : DO ma = 1, 4
17708 914748 : p_index = p_index + 1
17709 914748 : tmp = scale*prim(p_index)
17710 914748 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17711 914748 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17712 914748 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17713 1143435 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17714 : END DO
17715 228687 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17716 457374 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17717 : END DO
17718 : END DO
17719 : END DO
17720 76229 : END SUBROUTINE block_4_1_3_1
17721 : ! **************************************************************************************************
17722 : !> \brief ...
17723 : !> \param md_max ...
17724 : !> \param kbd ...
17725 : !> \param kbc ...
17726 : !> \param kad ...
17727 : !> \param kac ...
17728 : !> \param pbd ...
17729 : !> \param pbc ...
17730 : !> \param pad ...
17731 : !> \param pac ...
17732 : !> \param prim ...
17733 : !> \param scale ...
17734 : ! **************************************************************************************************
17735 60781 : SUBROUTINE block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17736 : INTEGER :: md_max
17737 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*3), kad(4*md_max), kac(4*3), pbd(1*md_max), pbc(1*3), &
17738 : pad(4*md_max), pac(4*3), prim(4*1*3*md_max), scale
17739 :
17740 : INTEGER :: ma, mb, mc, md, p_index
17741 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17742 :
17743 276935 : kbd(1:1*md_max) = 0.0_dp
17744 60781 : kbc(1:1*3) = 0.0_dp
17745 925397 : kad(1:4*md_max) = 0.0_dp
17746 60781 : kac(1:4*3) = 0.0_dp
17747 60781 : p_index = 0
17748 276935 : DO md = 1, md_max
17749 925397 : DO mc = 1, 3
17750 1513078 : DO mb = 1, 1
17751 648462 : ks_bd = 0.0_dp
17752 648462 : ks_bc = 0.0_dp
17753 648462 : p_bd = pbd((md - 1)*1 + mb)
17754 648462 : p_bc = pbc((mc - 1)*1 + mb)
17755 3242310 : DO ma = 1, 4
17756 2593848 : p_index = p_index + 1
17757 2593848 : tmp = scale*prim(p_index)
17758 2593848 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17759 2593848 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17760 2593848 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17761 3242310 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17762 : END DO
17763 648462 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17764 1296924 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17765 : END DO
17766 : END DO
17767 : END DO
17768 60781 : END SUBROUTINE block_4_1_3
17769 : ! **************************************************************************************************
17770 : !> \brief ...
17771 : !> \param kbd ...
17772 : !> \param kbc ...
17773 : !> \param kad ...
17774 : !> \param kac ...
17775 : !> \param pbd ...
17776 : !> \param pbc ...
17777 : !> \param pad ...
17778 : !> \param pac ...
17779 : !> \param prim ...
17780 : !> \param scale ...
17781 : ! **************************************************************************************************
17782 313389 : SUBROUTINE block_4_1_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17783 : REAL(KIND=dp) :: kbd(1*1), kbc(1*4), kad(4*1), kac(4*4), &
17784 : pbd(1*1), pbc(1*4), pad(4*1), &
17785 : pac(4*4), prim(4*1*4*1), scale
17786 :
17787 : INTEGER :: ma, mb, mc, md, p_index
17788 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17789 :
17790 313389 : kbd(1:1*1) = 0.0_dp
17791 313389 : kbc(1:1*4) = 0.0_dp
17792 313389 : kad(1:4*1) = 0.0_dp
17793 313389 : kac(1:4*4) = 0.0_dp
17794 313389 : p_index = 0
17795 626778 : DO md = 1, 1
17796 1880334 : DO mc = 1, 4
17797 2820501 : DO mb = 1, 1
17798 1253556 : ks_bd = 0.0_dp
17799 1253556 : ks_bc = 0.0_dp
17800 1253556 : p_bd = pbd((md - 1)*1 + mb)
17801 1253556 : p_bc = pbc((mc - 1)*1 + mb)
17802 6267780 : DO ma = 1, 4
17803 5014224 : p_index = p_index + 1
17804 5014224 : tmp = scale*prim(p_index)
17805 5014224 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17806 5014224 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17807 5014224 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17808 6267780 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17809 : END DO
17810 1253556 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17811 2507112 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17812 : END DO
17813 : END DO
17814 : END DO
17815 313389 : END SUBROUTINE block_4_1_4_1
17816 : ! **************************************************************************************************
17817 : !> \brief ...
17818 : !> \param md_max ...
17819 : !> \param kbd ...
17820 : !> \param kbc ...
17821 : !> \param kad ...
17822 : !> \param kac ...
17823 : !> \param pbd ...
17824 : !> \param pbc ...
17825 : !> \param pad ...
17826 : !> \param pac ...
17827 : !> \param prim ...
17828 : !> \param scale ...
17829 : ! **************************************************************************************************
17830 394598 : SUBROUTINE block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17831 : INTEGER :: md_max
17832 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*4), kad(4*md_max), kac(4*4), pbd(1*md_max), pbc(1*4), &
17833 : pad(4*md_max), pac(4*4), prim(4*1*4*md_max), scale
17834 :
17835 : INTEGER :: ma, mb, mc, md, p_index
17836 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17837 :
17838 1940352 : kbd(1:1*md_max) = 0.0_dp
17839 394598 : kbc(1:1*4) = 0.0_dp
17840 6577614 : kad(1:4*md_max) = 0.0_dp
17841 394598 : kac(1:4*4) = 0.0_dp
17842 394598 : p_index = 0
17843 1940352 : DO md = 1, md_max
17844 8123368 : DO mc = 1, 4
17845 13911786 : DO mb = 1, 1
17846 6183016 : ks_bd = 0.0_dp
17847 6183016 : ks_bc = 0.0_dp
17848 6183016 : p_bd = pbd((md - 1)*1 + mb)
17849 6183016 : p_bc = pbc((mc - 1)*1 + mb)
17850 30915080 : DO ma = 1, 4
17851 24732064 : p_index = p_index + 1
17852 24732064 : tmp = scale*prim(p_index)
17853 24732064 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17854 24732064 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17855 24732064 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17856 30915080 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17857 : END DO
17858 6183016 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17859 12366032 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17860 : END DO
17861 : END DO
17862 : END DO
17863 394598 : END SUBROUTINE block_4_1_4
17864 : ! **************************************************************************************************
17865 : !> \brief ...
17866 : !> \param mc_max ...
17867 : !> \param md_max ...
17868 : !> \param kbd ...
17869 : !> \param kbc ...
17870 : !> \param kad ...
17871 : !> \param kac ...
17872 : !> \param pbd ...
17873 : !> \param pbc ...
17874 : !> \param pad ...
17875 : !> \param pac ...
17876 : !> \param prim ...
17877 : !> \param scale ...
17878 : ! **************************************************************************************************
17879 297995 : SUBROUTINE block_4_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17880 : INTEGER :: mc_max, md_max
17881 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*mc_max), kad(4*md_max), kac(4*mc_max), pbd(1*md_max), &
17882 : pbc(1*mc_max), pad(4*md_max), pac(4*mc_max), prim(4*1*mc_max*md_max), scale
17883 :
17884 : INTEGER :: ma, mb, mc, md, p_index
17885 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17886 :
17887 1087706 : kbd(1:1*md_max) = 0.0_dp
17888 1791096 : kbc(1:1*mc_max) = 0.0_dp
17889 3456839 : kad(1:4*md_max) = 0.0_dp
17890 6270399 : kac(1:4*mc_max) = 0.0_dp
17891 : p_index = 0
17892 1087706 : DO md = 1, md_max
17893 5049347 : DO mc = 1, mc_max
17894 8712993 : DO mb = 1, 1
17895 3961641 : ks_bd = 0.0_dp
17896 3961641 : ks_bc = 0.0_dp
17897 3961641 : p_bd = pbd((md - 1)*1 + mb)
17898 3961641 : p_bc = pbc((mc - 1)*1 + mb)
17899 19808205 : DO ma = 1, 4
17900 15846564 : p_index = p_index + 1
17901 15846564 : tmp = scale*prim(p_index)
17902 15846564 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17903 15846564 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17904 15846564 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17905 19808205 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17906 : END DO
17907 3961641 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17908 7923282 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17909 : END DO
17910 : END DO
17911 : END DO
17912 297995 : END SUBROUTINE block_4_1
17913 : ! **************************************************************************************************
17914 : !> \brief ...
17915 : !> \param kbd ...
17916 : !> \param kbc ...
17917 : !> \param kad ...
17918 : !> \param kac ...
17919 : !> \param pbd ...
17920 : !> \param pbc ...
17921 : !> \param pad ...
17922 : !> \param pac ...
17923 : !> \param prim ...
17924 : !> \param scale ...
17925 : ! **************************************************************************************************
17926 5 : SUBROUTINE block_4_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17927 : REAL(KIND=dp) :: kbd(2*1), kbc(2*1), kad(4*1), kac(4*1), &
17928 : pbd(2*1), pbc(2*1), pad(4*1), &
17929 : pac(4*1), prim(4*2*1*1), scale
17930 :
17931 : INTEGER :: ma, mb, mc, md, p_index
17932 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17933 :
17934 5 : kbd(1:2*1) = 0.0_dp
17935 5 : kbc(1:2*1) = 0.0_dp
17936 5 : kad(1:4*1) = 0.0_dp
17937 5 : kac(1:4*1) = 0.0_dp
17938 5 : p_index = 0
17939 10 : DO md = 1, 1
17940 15 : DO mc = 1, 1
17941 20 : DO mb = 1, 2
17942 10 : ks_bd = 0.0_dp
17943 10 : ks_bc = 0.0_dp
17944 10 : p_bd = pbd((md - 1)*2 + mb)
17945 10 : p_bc = pbc((mc - 1)*2 + mb)
17946 50 : DO ma = 1, 4
17947 40 : p_index = p_index + 1
17948 40 : tmp = scale*prim(p_index)
17949 40 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17950 40 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17951 40 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17952 50 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17953 : END DO
17954 10 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
17955 15 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
17956 : END DO
17957 : END DO
17958 : END DO
17959 5 : END SUBROUTINE block_4_2_1_1
17960 : ! **************************************************************************************************
17961 : !> \brief ...
17962 : !> \param kbd ...
17963 : !> \param kbc ...
17964 : !> \param kad ...
17965 : !> \param kac ...
17966 : !> \param pbd ...
17967 : !> \param pbc ...
17968 : !> \param pad ...
17969 : !> \param pac ...
17970 : !> \param prim ...
17971 : !> \param scale ...
17972 : ! **************************************************************************************************
17973 3 : SUBROUTINE block_4_2_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
17974 : REAL(KIND=dp) :: kbd(2*2), kbc(2*1), kad(4*2), kac(4*1), &
17975 : pbd(2*2), pbc(2*1), pad(4*2), &
17976 : pac(4*1), prim(4*2*1*2), scale
17977 :
17978 : INTEGER :: ma, mb, mc, md, p_index
17979 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
17980 :
17981 3 : kbd(1:2*2) = 0.0_dp
17982 3 : kbc(1:2*1) = 0.0_dp
17983 3 : kad(1:4*2) = 0.0_dp
17984 3 : kac(1:4*1) = 0.0_dp
17985 3 : p_index = 0
17986 9 : DO md = 1, 2
17987 15 : DO mc = 1, 1
17988 24 : DO mb = 1, 2
17989 12 : ks_bd = 0.0_dp
17990 12 : ks_bc = 0.0_dp
17991 12 : p_bd = pbd((md - 1)*2 + mb)
17992 12 : p_bc = pbc((mc - 1)*2 + mb)
17993 60 : DO ma = 1, 4
17994 48 : p_index = p_index + 1
17995 48 : tmp = scale*prim(p_index)
17996 48 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17997 48 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17998 48 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17999 60 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18000 : END DO
18001 12 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
18002 18 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
18003 : END DO
18004 : END DO
18005 : END DO
18006 3 : END SUBROUTINE block_4_2_1_2
18007 : ! **************************************************************************************************
18008 : !> \brief ...
18009 : !> \param md_max ...
18010 : !> \param kbd ...
18011 : !> \param kbc ...
18012 : !> \param kad ...
18013 : !> \param kac ...
18014 : !> \param pbd ...
18015 : !> \param pbc ...
18016 : !> \param pad ...
18017 : !> \param pac ...
18018 : !> \param prim ...
18019 : !> \param scale ...
18020 : ! **************************************************************************************************
18021 15 : SUBROUTINE block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18022 : INTEGER :: md_max
18023 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*1), kad(4*md_max), kac(4*1), pbd(2*md_max), pbc(2*1), &
18024 : pad(4*md_max), pac(4*1), prim(4*2*1*md_max), scale
18025 :
18026 : INTEGER :: ma, mb, mc, md, p_index
18027 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18028 :
18029 205 : kbd(1:2*md_max) = 0.0_dp
18030 15 : kbc(1:2*1) = 0.0_dp
18031 395 : kad(1:4*md_max) = 0.0_dp
18032 15 : kac(1:4*1) = 0.0_dp
18033 15 : p_index = 0
18034 110 : DO md = 1, md_max
18035 205 : DO mc = 1, 1
18036 380 : DO mb = 1, 2
18037 190 : ks_bd = 0.0_dp
18038 190 : ks_bc = 0.0_dp
18039 190 : p_bd = pbd((md - 1)*2 + mb)
18040 190 : p_bc = pbc((mc - 1)*2 + mb)
18041 950 : DO ma = 1, 4
18042 760 : p_index = p_index + 1
18043 760 : tmp = scale*prim(p_index)
18044 760 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18045 760 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18046 760 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18047 950 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18048 : END DO
18049 190 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
18050 285 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
18051 : END DO
18052 : END DO
18053 : END DO
18054 15 : END SUBROUTINE block_4_2_1
18055 : ! **************************************************************************************************
18056 : !> \brief ...
18057 : !> \param kbd ...
18058 : !> \param kbc ...
18059 : !> \param kad ...
18060 : !> \param kac ...
18061 : !> \param pbd ...
18062 : !> \param pbc ...
18063 : !> \param pad ...
18064 : !> \param pac ...
18065 : !> \param prim ...
18066 : !> \param scale ...
18067 : ! **************************************************************************************************
18068 1 : SUBROUTINE block_4_2_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18069 : REAL(KIND=dp) :: kbd(2*1), kbc(2*2), kad(4*1), kac(4*2), &
18070 : pbd(2*1), pbc(2*2), pad(4*1), &
18071 : pac(4*2), prim(4*2*2*1), scale
18072 :
18073 : INTEGER :: ma, mb, mc, md, p_index
18074 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18075 :
18076 1 : kbd(1:2*1) = 0.0_dp
18077 1 : kbc(1:2*2) = 0.0_dp
18078 1 : kad(1:4*1) = 0.0_dp
18079 1 : kac(1:4*2) = 0.0_dp
18080 1 : p_index = 0
18081 2 : DO md = 1, 1
18082 4 : DO mc = 1, 2
18083 7 : DO mb = 1, 2
18084 4 : ks_bd = 0.0_dp
18085 4 : ks_bc = 0.0_dp
18086 4 : p_bd = pbd((md - 1)*2 + mb)
18087 4 : p_bc = pbc((mc - 1)*2 + mb)
18088 20 : DO ma = 1, 4
18089 16 : p_index = p_index + 1
18090 16 : tmp = scale*prim(p_index)
18091 16 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18092 16 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18093 16 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18094 20 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18095 : END DO
18096 4 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
18097 6 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
18098 : END DO
18099 : END DO
18100 : END DO
18101 1 : END SUBROUTINE block_4_2_2_1
18102 : ! **************************************************************************************************
18103 : !> \brief ...
18104 : !> \param md_max ...
18105 : !> \param kbd ...
18106 : !> \param kbc ...
18107 : !> \param kad ...
18108 : !> \param kac ...
18109 : !> \param pbd ...
18110 : !> \param pbc ...
18111 : !> \param pad ...
18112 : !> \param pac ...
18113 : !> \param prim ...
18114 : !> \param scale ...
18115 : ! **************************************************************************************************
18116 7 : SUBROUTINE block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18117 : INTEGER :: md_max
18118 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*2), kad(4*md_max), kac(4*2), pbd(2*md_max), pbc(2*2), &
18119 : pad(4*md_max), pac(4*2), prim(4*2*2*md_max), scale
18120 :
18121 : INTEGER :: ma, mb, mc, md, p_index
18122 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18123 :
18124 57 : kbd(1:2*md_max) = 0.0_dp
18125 7 : kbc(1:2*2) = 0.0_dp
18126 107 : kad(1:4*md_max) = 0.0_dp
18127 7 : kac(1:4*2) = 0.0_dp
18128 7 : p_index = 0
18129 32 : DO md = 1, md_max
18130 82 : DO mc = 1, 2
18131 175 : DO mb = 1, 2
18132 100 : ks_bd = 0.0_dp
18133 100 : ks_bc = 0.0_dp
18134 100 : p_bd = pbd((md - 1)*2 + mb)
18135 100 : p_bc = pbc((mc - 1)*2 + mb)
18136 500 : DO ma = 1, 4
18137 400 : p_index = p_index + 1
18138 400 : tmp = scale*prim(p_index)
18139 400 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18140 400 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18141 400 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18142 500 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18143 : END DO
18144 100 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
18145 150 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
18146 : END DO
18147 : END DO
18148 : END DO
18149 7 : END SUBROUTINE block_4_2_2
18150 : ! **************************************************************************************************
18151 : !> \brief ...
18152 : !> \param mc_max ...
18153 : !> \param md_max ...
18154 : !> \param kbd ...
18155 : !> \param kbc ...
18156 : !> \param kad ...
18157 : !> \param kac ...
18158 : !> \param pbd ...
18159 : !> \param pbc ...
18160 : !> \param pad ...
18161 : !> \param pac ...
18162 : !> \param prim ...
18163 : !> \param scale ...
18164 : ! **************************************************************************************************
18165 81 : SUBROUTINE block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18166 : INTEGER :: mc_max, md_max
18167 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*mc_max), kad(4*md_max), kac(4*mc_max), pbd(2*md_max), &
18168 : pbc(2*mc_max), pad(4*md_max), pac(4*mc_max), prim(4*2*mc_max*md_max), scale
18169 :
18170 : INTEGER :: ma, mb, mc, md, p_index
18171 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18172 :
18173 809 : kbd(1:2*md_max) = 0.0_dp
18174 1361 : kbc(1:2*mc_max) = 0.0_dp
18175 1537 : kad(1:4*md_max) = 0.0_dp
18176 2641 : kac(1:4*mc_max) = 0.0_dp
18177 : p_index = 0
18178 445 : DO md = 1, md_max
18179 3707 : DO mc = 1, mc_max
18180 10150 : DO mb = 1, 2
18181 6524 : ks_bd = 0.0_dp
18182 6524 : ks_bc = 0.0_dp
18183 6524 : p_bd = pbd((md - 1)*2 + mb)
18184 6524 : p_bc = pbc((mc - 1)*2 + mb)
18185 32620 : DO ma = 1, 4
18186 26096 : p_index = p_index + 1
18187 26096 : tmp = scale*prim(p_index)
18188 26096 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18189 26096 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18190 26096 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18191 32620 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18192 : END DO
18193 6524 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
18194 9786 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
18195 : END DO
18196 : END DO
18197 : END DO
18198 81 : END SUBROUTINE block_4_2
18199 : ! **************************************************************************************************
18200 : !> \brief ...
18201 : !> \param kbd ...
18202 : !> \param kbc ...
18203 : !> \param kad ...
18204 : !> \param kac ...
18205 : !> \param pbd ...
18206 : !> \param pbc ...
18207 : !> \param pad ...
18208 : !> \param pac ...
18209 : !> \param prim ...
18210 : !> \param scale ...
18211 : ! **************************************************************************************************
18212 93025 : SUBROUTINE block_4_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18213 : REAL(KIND=dp) :: kbd(3*1), kbc(3*1), kad(4*1), kac(4*1), &
18214 : pbd(3*1), pbc(3*1), pad(4*1), &
18215 : pac(4*1), prim(4*3*1*1), scale
18216 :
18217 : INTEGER :: ma, mb, mc, md, p_index
18218 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18219 :
18220 93025 : kbd(1:3*1) = 0.0_dp
18221 93025 : kbc(1:3*1) = 0.0_dp
18222 93025 : kad(1:4*1) = 0.0_dp
18223 93025 : kac(1:4*1) = 0.0_dp
18224 93025 : p_index = 0
18225 186050 : DO md = 1, 1
18226 279075 : DO mc = 1, 1
18227 465125 : DO mb = 1, 3
18228 279075 : ks_bd = 0.0_dp
18229 279075 : ks_bc = 0.0_dp
18230 279075 : p_bd = pbd((md - 1)*3 + mb)
18231 279075 : p_bc = pbc((mc - 1)*3 + mb)
18232 1395375 : DO ma = 1, 4
18233 1116300 : p_index = p_index + 1
18234 1116300 : tmp = scale*prim(p_index)
18235 1116300 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18236 1116300 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18237 1116300 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18238 1395375 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18239 : END DO
18240 279075 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
18241 372100 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
18242 : END DO
18243 : END DO
18244 : END DO
18245 93025 : END SUBROUTINE block_4_3_1_1
18246 : ! **************************************************************************************************
18247 : !> \brief ...
18248 : !> \param md_max ...
18249 : !> \param kbd ...
18250 : !> \param kbc ...
18251 : !> \param kad ...
18252 : !> \param kac ...
18253 : !> \param pbd ...
18254 : !> \param pbc ...
18255 : !> \param pad ...
18256 : !> \param pac ...
18257 : !> \param prim ...
18258 : !> \param scale ...
18259 : ! **************************************************************************************************
18260 73158 : SUBROUTINE block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18261 : INTEGER :: md_max
18262 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*1), kad(4*md_max), kac(4*1), pbd(3*md_max), pbc(3*1), &
18263 : pad(4*md_max), pac(4*1), prim(4*3*1*md_max), scale
18264 :
18265 : INTEGER :: ma, mb, mc, md, p_index
18266 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18267 :
18268 865848 : kbd(1:3*md_max) = 0.0_dp
18269 73158 : kbc(1:3*1) = 0.0_dp
18270 1130078 : kad(1:4*md_max) = 0.0_dp
18271 73158 : kac(1:4*1) = 0.0_dp
18272 73158 : p_index = 0
18273 337388 : DO md = 1, md_max
18274 601618 : DO mc = 1, 1
18275 1321150 : DO mb = 1, 3
18276 792690 : ks_bd = 0.0_dp
18277 792690 : ks_bc = 0.0_dp
18278 792690 : p_bd = pbd((md - 1)*3 + mb)
18279 792690 : p_bc = pbc((mc - 1)*3 + mb)
18280 3963450 : DO ma = 1, 4
18281 3170760 : p_index = p_index + 1
18282 3170760 : tmp = scale*prim(p_index)
18283 3170760 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18284 3170760 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18285 3170760 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18286 3963450 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18287 : END DO
18288 792690 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
18289 1056920 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
18290 : END DO
18291 : END DO
18292 : END DO
18293 73158 : END SUBROUTINE block_4_3_1
18294 : ! **************************************************************************************************
18295 : !> \brief ...
18296 : !> \param mc_max ...
18297 : !> \param md_max ...
18298 : !> \param kbd ...
18299 : !> \param kbc ...
18300 : !> \param kad ...
18301 : !> \param kac ...
18302 : !> \param pbd ...
18303 : !> \param pbc ...
18304 : !> \param pad ...
18305 : !> \param pac ...
18306 : !> \param prim ...
18307 : !> \param scale ...
18308 : ! **************************************************************************************************
18309 449276 : SUBROUTINE block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18310 : INTEGER :: mc_max, md_max
18311 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*mc_max), kad(4*md_max), kac(4*mc_max), pbd(3*md_max), &
18312 : pbc(3*mc_max), pad(4*md_max), pac(4*mc_max), prim(4*3*mc_max*md_max), scale
18313 :
18314 : INTEGER :: ma, mb, mc, md, p_index
18315 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18316 :
18317 3866681 : kbd(1:3*md_max) = 0.0_dp
18318 6049865 : kbc(1:3*mc_max) = 0.0_dp
18319 5005816 : kad(1:4*md_max) = 0.0_dp
18320 7916728 : kac(1:4*mc_max) = 0.0_dp
18321 : p_index = 0
18322 1588411 : DO md = 1, md_max
18323 6359499 : DO mc = 1, mc_max
18324 20223487 : DO mb = 1, 3
18325 14313264 : ks_bd = 0.0_dp
18326 14313264 : ks_bc = 0.0_dp
18327 14313264 : p_bd = pbd((md - 1)*3 + mb)
18328 14313264 : p_bc = pbc((mc - 1)*3 + mb)
18329 71566320 : DO ma = 1, 4
18330 57253056 : p_index = p_index + 1
18331 57253056 : tmp = scale*prim(p_index)
18332 57253056 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18333 57253056 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18334 57253056 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18335 71566320 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18336 : END DO
18337 14313264 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
18338 19084352 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
18339 : END DO
18340 : END DO
18341 : END DO
18342 449276 : END SUBROUTINE block_4_3
18343 : ! **************************************************************************************************
18344 : !> \brief ...
18345 : !> \param kbd ...
18346 : !> \param kbc ...
18347 : !> \param kad ...
18348 : !> \param kac ...
18349 : !> \param pbd ...
18350 : !> \param pbc ...
18351 : !> \param pad ...
18352 : !> \param pac ...
18353 : !> \param prim ...
18354 : !> \param scale ...
18355 : ! **************************************************************************************************
18356 74653 : SUBROUTINE block_4_4_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18357 : REAL(KIND=dp) :: kbd(4*1), kbc(4*1), kad(4*1), kac(4*1), &
18358 : pbd(4*1), pbc(4*1), pad(4*1), &
18359 : pac(4*1), prim(4*4*1*1), scale
18360 :
18361 : INTEGER :: ma, mb, mc, md, p_index
18362 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18363 :
18364 74653 : kbd(1:4*1) = 0.0_dp
18365 74653 : kbc(1:4*1) = 0.0_dp
18366 74653 : kad(1:4*1) = 0.0_dp
18367 74653 : kac(1:4*1) = 0.0_dp
18368 74653 : p_index = 0
18369 149306 : DO md = 1, 1
18370 223959 : DO mc = 1, 1
18371 447918 : DO mb = 1, 4
18372 298612 : ks_bd = 0.0_dp
18373 298612 : ks_bc = 0.0_dp
18374 298612 : p_bd = pbd((md - 1)*4 + mb)
18375 298612 : p_bc = pbc((mc - 1)*4 + mb)
18376 1493060 : DO ma = 1, 4
18377 1194448 : p_index = p_index + 1
18378 1194448 : tmp = scale*prim(p_index)
18379 1194448 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18380 1194448 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18381 1194448 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18382 1493060 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18383 : END DO
18384 298612 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
18385 373265 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
18386 : END DO
18387 : END DO
18388 : END DO
18389 74653 : END SUBROUTINE block_4_4_1_1
18390 : ! **************************************************************************************************
18391 : !> \brief ...
18392 : !> \param md_max ...
18393 : !> \param kbd ...
18394 : !> \param kbc ...
18395 : !> \param kad ...
18396 : !> \param kac ...
18397 : !> \param pbd ...
18398 : !> \param pbc ...
18399 : !> \param pad ...
18400 : !> \param pac ...
18401 : !> \param prim ...
18402 : !> \param scale ...
18403 : ! **************************************************************************************************
18404 106067 : SUBROUTINE block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18405 : INTEGER :: md_max
18406 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*1), kad(4*md_max), kac(4*1), pbd(4*md_max), pbc(4*1), &
18407 : pad(4*md_max), pac(4*1), prim(4*4*1*md_max), scale
18408 :
18409 : INTEGER :: ma, mb, mc, md, p_index
18410 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18411 :
18412 1792007 : kbd(1:4*md_max) = 0.0_dp
18413 106067 : kbc(1:4*1) = 0.0_dp
18414 1792007 : kad(1:4*md_max) = 0.0_dp
18415 106067 : kac(1:4*1) = 0.0_dp
18416 106067 : p_index = 0
18417 527552 : DO md = 1, md_max
18418 949037 : DO mc = 1, 1
18419 2528910 : DO mb = 1, 4
18420 1685940 : ks_bd = 0.0_dp
18421 1685940 : ks_bc = 0.0_dp
18422 1685940 : p_bd = pbd((md - 1)*4 + mb)
18423 1685940 : p_bc = pbc((mc - 1)*4 + mb)
18424 8429700 : DO ma = 1, 4
18425 6743760 : p_index = p_index + 1
18426 6743760 : tmp = scale*prim(p_index)
18427 6743760 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18428 6743760 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18429 6743760 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18430 8429700 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18431 : END DO
18432 1685940 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
18433 2107425 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
18434 : END DO
18435 : END DO
18436 : END DO
18437 106067 : END SUBROUTINE block_4_4_1
18438 : ! **************************************************************************************************
18439 : !> \brief ...
18440 : !> \param mc_max ...
18441 : !> \param md_max ...
18442 : !> \param kbd ...
18443 : !> \param kbc ...
18444 : !> \param kad ...
18445 : !> \param kac ...
18446 : !> \param pbd ...
18447 : !> \param pbc ...
18448 : !> \param pad ...
18449 : !> \param pac ...
18450 : !> \param prim ...
18451 : !> \param scale ...
18452 : ! **************************************************************************************************
18453 518862 : SUBROUTINE block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18454 : INTEGER :: mc_max, md_max
18455 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*mc_max), kad(4*md_max), kac(4*mc_max), pbd(4*md_max), &
18456 : pbc(4*mc_max), pad(4*md_max), pac(4*mc_max), prim(4*4*mc_max*md_max), scale
18457 :
18458 : INTEGER :: ma, mb, mc, md, p_index
18459 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18460 :
18461 7745578 : kbd(1:4*md_max) = 0.0_dp
18462 9162690 : kbc(1:4*mc_max) = 0.0_dp
18463 7745578 : kad(1:4*md_max) = 0.0_dp
18464 9162690 : kac(1:4*mc_max) = 0.0_dp
18465 : p_index = 0
18466 2325541 : DO md = 1, md_max
18467 9922563 : DO mc = 1, mc_max
18468 39791789 : DO mb = 1, 4
18469 30388088 : ks_bd = 0.0_dp
18470 30388088 : ks_bc = 0.0_dp
18471 30388088 : p_bd = pbd((md - 1)*4 + mb)
18472 30388088 : p_bc = pbc((mc - 1)*4 + mb)
18473 151940440 : DO ma = 1, 4
18474 121552352 : p_index = p_index + 1
18475 121552352 : tmp = scale*prim(p_index)
18476 121552352 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18477 121552352 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18478 121552352 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18479 151940440 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18480 : END DO
18481 30388088 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
18482 37985110 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
18483 : END DO
18484 : END DO
18485 : END DO
18486 518862 : END SUBROUTINE block_4_4
18487 : ! **************************************************************************************************
18488 : !> \brief ...
18489 : !> \param mc_max ...
18490 : !> \param md_max ...
18491 : !> \param kbd ...
18492 : !> \param kbc ...
18493 : !> \param kad ...
18494 : !> \param kac ...
18495 : !> \param pbd ...
18496 : !> \param pbc ...
18497 : !> \param pad ...
18498 : !> \param pac ...
18499 : !> \param prim ...
18500 : !> \param scale ...
18501 : ! **************************************************************************************************
18502 234123 : SUBROUTINE block_4_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18503 : INTEGER :: mc_max, md_max
18504 : REAL(KIND=dp) :: kbd(5*md_max), kbc(5*mc_max), kad(4*md_max), kac(4*mc_max), pbd(5*md_max), &
18505 : pbc(5*mc_max), pad(4*md_max), pac(4*mc_max), prim(4*5*mc_max*md_max), scale
18506 :
18507 : INTEGER :: ma, mb, mc, md, p_index
18508 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18509 :
18510 4216653 : kbd(1:5*md_max) = 0.0_dp
18511 4331268 : kbc(1:5*mc_max) = 0.0_dp
18512 3420147 : kad(1:4*md_max) = 0.0_dp
18513 3511839 : kac(1:4*mc_max) = 0.0_dp
18514 : p_index = 0
18515 1030629 : DO md = 1, md_max
18516 3989533 : DO mc = 1, mc_max
18517 18549930 : DO mb = 1, 5
18518 14794520 : ks_bd = 0.0_dp
18519 14794520 : ks_bc = 0.0_dp
18520 14794520 : p_bd = pbd((md - 1)*5 + mb)
18521 14794520 : p_bc = pbc((mc - 1)*5 + mb)
18522 73972600 : DO ma = 1, 4
18523 59178080 : p_index = p_index + 1
18524 59178080 : tmp = scale*prim(p_index)
18525 59178080 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18526 59178080 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18527 59178080 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18528 73972600 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18529 : END DO
18530 14794520 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
18531 17753424 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
18532 : END DO
18533 : END DO
18534 : END DO
18535 234123 : END SUBROUTINE block_4_5
18536 : ! **************************************************************************************************
18537 : !> \brief ...
18538 : !> \param mc_max ...
18539 : !> \param md_max ...
18540 : !> \param kbd ...
18541 : !> \param kbc ...
18542 : !> \param kad ...
18543 : !> \param kac ...
18544 : !> \param pbd ...
18545 : !> \param pbc ...
18546 : !> \param pad ...
18547 : !> \param pac ...
18548 : !> \param prim ...
18549 : !> \param scale ...
18550 : ! **************************************************************************************************
18551 234 : SUBROUTINE block_4_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18552 : INTEGER :: mc_max, md_max
18553 : REAL(KIND=dp) :: kbd(6*md_max), kbc(6*mc_max), kad(4*md_max), kac(4*mc_max), pbd(6*md_max), &
18554 : pbc(6*mc_max), pad(4*md_max), pac(4*mc_max), prim(4*6*mc_max*md_max), scale
18555 :
18556 : INTEGER :: ma, mb, mc, md, p_index
18557 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18558 :
18559 6216 : kbd(1:6*md_max) = 0.0_dp
18560 4134 : kbc(1:6*mc_max) = 0.0_dp
18561 4222 : kad(1:4*md_max) = 0.0_dp
18562 2834 : kac(1:4*mc_max) = 0.0_dp
18563 : p_index = 0
18564 1231 : DO md = 1, md_max
18565 4045 : DO mc = 1, mc_max
18566 20695 : DO mb = 1, 6
18567 16884 : ks_bd = 0.0_dp
18568 16884 : ks_bc = 0.0_dp
18569 16884 : p_bd = pbd((md - 1)*6 + mb)
18570 16884 : p_bc = pbc((mc - 1)*6 + mb)
18571 84420 : DO ma = 1, 4
18572 67536 : p_index = p_index + 1
18573 67536 : tmp = scale*prim(p_index)
18574 67536 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18575 67536 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18576 67536 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18577 84420 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18578 : END DO
18579 16884 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
18580 19698 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
18581 : END DO
18582 : END DO
18583 : END DO
18584 234 : END SUBROUTINE block_4_6
18585 : ! **************************************************************************************************
18586 : !> \brief ...
18587 : !> \param mc_max ...
18588 : !> \param md_max ...
18589 : !> \param kbd ...
18590 : !> \param kbc ...
18591 : !> \param kad ...
18592 : !> \param kac ...
18593 : !> \param pbd ...
18594 : !> \param pbc ...
18595 : !> \param pad ...
18596 : !> \param pac ...
18597 : !> \param prim ...
18598 : !> \param scale ...
18599 : ! **************************************************************************************************
18600 8056 : SUBROUTINE block_4_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18601 : INTEGER :: mc_max, md_max
18602 : REAL(KIND=dp) :: kbd(7*md_max), kbc(7*mc_max), kad(4*md_max), kac(4*mc_max), pbd(7*md_max), &
18603 : pbc(7*mc_max), pad(4*md_max), pac(4*mc_max), prim(4*7*mc_max*md_max), scale
18604 :
18605 : INTEGER :: ma, mb, mc, md, p_index
18606 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18607 :
18608 253406 : kbd(1:7*md_max) = 0.0_dp
18609 252356 : kbc(1:7*mc_max) = 0.0_dp
18610 148256 : kad(1:4*md_max) = 0.0_dp
18611 147656 : kac(1:4*mc_max) = 0.0_dp
18612 : p_index = 0
18613 43106 : DO md = 1, md_max
18614 194945 : DO mc = 1, mc_max
18615 1249762 : DO mb = 1, 7
18616 1062873 : ks_bd = 0.0_dp
18617 1062873 : ks_bc = 0.0_dp
18618 1062873 : p_bd = pbd((md - 1)*7 + mb)
18619 1062873 : p_bc = pbc((mc - 1)*7 + mb)
18620 5314365 : DO ma = 1, 4
18621 4251492 : p_index = p_index + 1
18622 4251492 : tmp = scale*prim(p_index)
18623 4251492 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18624 4251492 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18625 4251492 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18626 5314365 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18627 : END DO
18628 1062873 : kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
18629 1214712 : kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
18630 : END DO
18631 : END DO
18632 : END DO
18633 8056 : END SUBROUTINE block_4_7
18634 : ! **************************************************************************************************
18635 : !> \brief ...
18636 : !> \param mc_max ...
18637 : !> \param md_max ...
18638 : !> \param kbd ...
18639 : !> \param kbc ...
18640 : !> \param kad ...
18641 : !> \param kac ...
18642 : !> \param pbd ...
18643 : !> \param pbc ...
18644 : !> \param pad ...
18645 : !> \param pac ...
18646 : !> \param prim ...
18647 : !> \param scale ...
18648 : ! **************************************************************************************************
18649 93 : SUBROUTINE block_4_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18650 : INTEGER :: mc_max, md_max
18651 : REAL(KIND=dp) :: kbd(9*md_max), kbc(9*mc_max), kad(4*md_max), kac(4*mc_max), pbd(9*md_max), &
18652 : pbc(9*mc_max), pad(4*md_max), pac(4*mc_max), prim(4*9*mc_max*md_max), scale
18653 :
18654 : INTEGER :: ma, mb, mc, md, p_index
18655 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18656 :
18657 5169 : kbd(1:9*md_max) = 0.0_dp
18658 2460 : kbc(1:9*mc_max) = 0.0_dp
18659 2349 : kad(1:4*md_max) = 0.0_dp
18660 1145 : kac(1:4*mc_max) = 0.0_dp
18661 : p_index = 0
18662 657 : DO md = 1, md_max
18663 2295 : DO mc = 1, mc_max
18664 16944 : DO mb = 1, 9
18665 14742 : ks_bd = 0.0_dp
18666 14742 : ks_bc = 0.0_dp
18667 14742 : p_bd = pbd((md - 1)*9 + mb)
18668 14742 : p_bc = pbc((mc - 1)*9 + mb)
18669 73710 : DO ma = 1, 4
18670 58968 : p_index = p_index + 1
18671 58968 : tmp = scale*prim(p_index)
18672 58968 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18673 58968 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18674 58968 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18675 73710 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18676 : END DO
18677 14742 : kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
18678 16380 : kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
18679 : END DO
18680 : END DO
18681 : END DO
18682 93 : END SUBROUTINE block_4_9
18683 : ! **************************************************************************************************
18684 : !> \brief ...
18685 : !> \param mc_max ...
18686 : !> \param md_max ...
18687 : !> \param kbd ...
18688 : !> \param kbc ...
18689 : !> \param kad ...
18690 : !> \param kac ...
18691 : !> \param pbd ...
18692 : !> \param pbc ...
18693 : !> \param pad ...
18694 : !> \param pac ...
18695 : !> \param prim ...
18696 : !> \param scale ...
18697 : ! **************************************************************************************************
18698 118 : SUBROUTINE block_4_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18699 : INTEGER :: mc_max, md_max
18700 : REAL(KIND=dp) :: kbd(10*md_max), kbc(10*mc_max), kad(4*md_max), kac(4*mc_max), &
18701 : pbd(10*md_max), pbc(10*mc_max), pad(4*md_max), pac(4*mc_max), prim(4*10*mc_max*md_max), &
18702 : scale
18703 :
18704 : INTEGER :: ma, mb, mc, md, p_index
18705 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18706 :
18707 7698 : kbd(1:10*md_max) = 0.0_dp
18708 3638 : kbc(1:10*mc_max) = 0.0_dp
18709 3150 : kad(1:4*md_max) = 0.0_dp
18710 1526 : kac(1:4*mc_max) = 0.0_dp
18711 : p_index = 0
18712 876 : DO md = 1, md_max
18713 3151 : DO mc = 1, mc_max
18714 25783 : DO mb = 1, 10
18715 22750 : ks_bd = 0.0_dp
18716 22750 : ks_bc = 0.0_dp
18717 22750 : p_bd = pbd((md - 1)*10 + mb)
18718 22750 : p_bc = pbc((mc - 1)*10 + mb)
18719 113750 : DO ma = 1, 4
18720 91000 : p_index = p_index + 1
18721 91000 : tmp = scale*prim(p_index)
18722 91000 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18723 91000 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18724 91000 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18725 113750 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18726 : END DO
18727 22750 : kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
18728 25025 : kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
18729 : END DO
18730 : END DO
18731 : END DO
18732 118 : END SUBROUTINE block_4_10
18733 : ! **************************************************************************************************
18734 : !> \brief ...
18735 : !> \param mc_max ...
18736 : !> \param md_max ...
18737 : !> \param kbd ...
18738 : !> \param kbc ...
18739 : !> \param kad ...
18740 : !> \param kac ...
18741 : !> \param pbd ...
18742 : !> \param pbc ...
18743 : !> \param pad ...
18744 : !> \param pac ...
18745 : !> \param prim ...
18746 : !> \param scale ...
18747 : ! **************************************************************************************************
18748 151 : SUBROUTINE block_4_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18749 : INTEGER :: mc_max, md_max
18750 : REAL(KIND=dp) :: kbd(11*md_max), kbc(11*mc_max), kad(4*md_max), kac(4*mc_max), &
18751 : pbd(11*md_max), pbc(11*mc_max), pad(4*md_max), pac(4*mc_max), prim(4*11*mc_max*md_max), &
18752 : scale
18753 :
18754 : INTEGER :: ma, mb, mc, md, p_index
18755 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18756 :
18757 11811 : kbd(1:11*md_max) = 0.0_dp
18758 5651 : kbc(1:11*mc_max) = 0.0_dp
18759 4391 : kad(1:4*md_max) = 0.0_dp
18760 2151 : kac(1:4*mc_max) = 0.0_dp
18761 : p_index = 0
18762 1211 : DO md = 1, md_max
18763 4914 : DO mc = 1, mc_max
18764 45496 : DO mb = 1, 11
18765 40733 : ks_bd = 0.0_dp
18766 40733 : ks_bc = 0.0_dp
18767 40733 : p_bd = pbd((md - 1)*11 + mb)
18768 40733 : p_bc = pbc((mc - 1)*11 + mb)
18769 203665 : DO ma = 1, 4
18770 162932 : p_index = p_index + 1
18771 162932 : tmp = scale*prim(p_index)
18772 162932 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18773 162932 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18774 162932 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18775 203665 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18776 : END DO
18777 40733 : kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
18778 44436 : kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
18779 : END DO
18780 : END DO
18781 : END DO
18782 151 : END SUBROUTINE block_4_11
18783 : ! **************************************************************************************************
18784 : !> \brief ...
18785 : !> \param mc_max ...
18786 : !> \param md_max ...
18787 : !> \param kbd ...
18788 : !> \param kbc ...
18789 : !> \param kad ...
18790 : !> \param kac ...
18791 : !> \param pbd ...
18792 : !> \param pbc ...
18793 : !> \param pad ...
18794 : !> \param pac ...
18795 : !> \param prim ...
18796 : !> \param scale ...
18797 : ! **************************************************************************************************
18798 132 : SUBROUTINE block_4_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18799 : INTEGER :: mc_max, md_max
18800 : REAL(KIND=dp) :: kbd(15*md_max), kbc(15*mc_max), kad(4*md_max), kac(4*mc_max), &
18801 : pbd(15*md_max), pbc(15*mc_max), pad(4*md_max), pac(4*mc_max), prim(4*15*mc_max*md_max), &
18802 : scale
18803 :
18804 : INTEGER :: ma, mb, mc, md, p_index
18805 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18806 :
18807 13947 : kbd(1:15*md_max) = 0.0_dp
18808 6282 : kbc(1:15*mc_max) = 0.0_dp
18809 3816 : kad(1:4*md_max) = 0.0_dp
18810 1772 : kac(1:4*mc_max) = 0.0_dp
18811 : p_index = 0
18812 1053 : DO md = 1, md_max
18813 4070 : DO mc = 1, mc_max
18814 49193 : DO mb = 1, 15
18815 45255 : ks_bd = 0.0_dp
18816 45255 : ks_bc = 0.0_dp
18817 45255 : p_bd = pbd((md - 1)*15 + mb)
18818 45255 : p_bc = pbc((mc - 1)*15 + mb)
18819 226275 : DO ma = 1, 4
18820 181020 : p_index = p_index + 1
18821 181020 : tmp = scale*prim(p_index)
18822 181020 : ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18823 181020 : ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18824 181020 : kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18825 226275 : kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18826 : END DO
18827 45255 : kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
18828 48272 : kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
18829 : END DO
18830 : END DO
18831 : END DO
18832 132 : END SUBROUTINE block_4_15
18833 : ! **************************************************************************************************
18834 : !> \brief ...
18835 : !> \param kbd ...
18836 : !> \param kbc ...
18837 : !> \param kad ...
18838 : !> \param kac ...
18839 : !> \param pbd ...
18840 : !> \param pbc ...
18841 : !> \param pad ...
18842 : !> \param pac ...
18843 : !> \param prim ...
18844 : !> \param scale ...
18845 : ! **************************************************************************************************
18846 244309 : SUBROUTINE block_5_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18847 : REAL(KIND=dp) :: kbd(1*1), kbc(1*1), kad(5*1), kac(5*1), &
18848 : pbd(1*1), pbc(1*1), pad(5*1), &
18849 : pac(5*1), prim(5*1*1*1), scale
18850 :
18851 : INTEGER :: ma, mb, mc, md, p_index
18852 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18853 :
18854 244309 : kbd(1:1*1) = 0.0_dp
18855 244309 : kbc(1:1*1) = 0.0_dp
18856 244309 : kad(1:5*1) = 0.0_dp
18857 244309 : kac(1:5*1) = 0.0_dp
18858 244309 : p_index = 0
18859 488618 : DO md = 1, 1
18860 732927 : DO mc = 1, 1
18861 732927 : DO mb = 1, 1
18862 244309 : ks_bd = 0.0_dp
18863 244309 : ks_bc = 0.0_dp
18864 244309 : p_bd = pbd((md - 1)*1 + mb)
18865 244309 : p_bc = pbc((mc - 1)*1 + mb)
18866 1465854 : DO ma = 1, 5
18867 1221545 : p_index = p_index + 1
18868 1221545 : tmp = scale*prim(p_index)
18869 1221545 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
18870 1221545 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
18871 1221545 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
18872 1465854 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
18873 : END DO
18874 244309 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
18875 488618 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
18876 : END DO
18877 : END DO
18878 : END DO
18879 244309 : END SUBROUTINE block_5_1_1_1
18880 : ! **************************************************************************************************
18881 : !> \brief ...
18882 : !> \param kbd ...
18883 : !> \param kbc ...
18884 : !> \param kad ...
18885 : !> \param kac ...
18886 : !> \param pbd ...
18887 : !> \param pbc ...
18888 : !> \param pad ...
18889 : !> \param pac ...
18890 : !> \param prim ...
18891 : !> \param scale ...
18892 : ! **************************************************************************************************
18893 4134 : SUBROUTINE block_5_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18894 : REAL(KIND=dp) :: kbd(1*2), kbc(1*1), kad(5*2), kac(5*1), &
18895 : pbd(1*2), pbc(1*1), pad(5*2), &
18896 : pac(5*1), prim(5*1*1*2), scale
18897 :
18898 : INTEGER :: ma, mb, mc, md, p_index
18899 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18900 :
18901 4134 : kbd(1:1*2) = 0.0_dp
18902 4134 : kbc(1:1*1) = 0.0_dp
18903 4134 : kad(1:5*2) = 0.0_dp
18904 4134 : kac(1:5*1) = 0.0_dp
18905 4134 : p_index = 0
18906 12402 : DO md = 1, 2
18907 20670 : DO mc = 1, 1
18908 24804 : DO mb = 1, 1
18909 8268 : ks_bd = 0.0_dp
18910 8268 : ks_bc = 0.0_dp
18911 8268 : p_bd = pbd((md - 1)*1 + mb)
18912 8268 : p_bc = pbc((mc - 1)*1 + mb)
18913 49608 : DO ma = 1, 5
18914 41340 : p_index = p_index + 1
18915 41340 : tmp = scale*prim(p_index)
18916 41340 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
18917 41340 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
18918 41340 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
18919 49608 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
18920 : END DO
18921 8268 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
18922 16536 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
18923 : END DO
18924 : END DO
18925 : END DO
18926 4134 : END SUBROUTINE block_5_1_1_2
18927 : ! **************************************************************************************************
18928 : !> \brief ...
18929 : !> \param kbd ...
18930 : !> \param kbc ...
18931 : !> \param kad ...
18932 : !> \param kac ...
18933 : !> \param pbd ...
18934 : !> \param pbc ...
18935 : !> \param pad ...
18936 : !> \param pac ...
18937 : !> \param prim ...
18938 : !> \param scale ...
18939 : ! **************************************************************************************************
18940 125799 : SUBROUTINE block_5_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18941 : REAL(KIND=dp) :: kbd(1*3), kbc(1*1), kad(5*3), kac(5*1), &
18942 : pbd(1*3), pbc(1*1), pad(5*3), &
18943 : pac(5*1), prim(5*1*1*3), scale
18944 :
18945 : INTEGER :: ma, mb, mc, md, p_index
18946 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18947 :
18948 125799 : kbd(1:1*3) = 0.0_dp
18949 125799 : kbc(1:1*1) = 0.0_dp
18950 125799 : kad(1:5*3) = 0.0_dp
18951 125799 : kac(1:5*1) = 0.0_dp
18952 125799 : p_index = 0
18953 503196 : DO md = 1, 3
18954 880593 : DO mc = 1, 1
18955 1132191 : DO mb = 1, 1
18956 377397 : ks_bd = 0.0_dp
18957 377397 : ks_bc = 0.0_dp
18958 377397 : p_bd = pbd((md - 1)*1 + mb)
18959 377397 : p_bc = pbc((mc - 1)*1 + mb)
18960 2264382 : DO ma = 1, 5
18961 1886985 : p_index = p_index + 1
18962 1886985 : tmp = scale*prim(p_index)
18963 1886985 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
18964 1886985 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
18965 1886985 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
18966 2264382 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
18967 : END DO
18968 377397 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
18969 754794 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
18970 : END DO
18971 : END DO
18972 : END DO
18973 125799 : END SUBROUTINE block_5_1_1_3
18974 : ! **************************************************************************************************
18975 : !> \brief ...
18976 : !> \param md_max ...
18977 : !> \param kbd ...
18978 : !> \param kbc ...
18979 : !> \param kad ...
18980 : !> \param kac ...
18981 : !> \param pbd ...
18982 : !> \param pbc ...
18983 : !> \param pad ...
18984 : !> \param pac ...
18985 : !> \param prim ...
18986 : !> \param scale ...
18987 : ! **************************************************************************************************
18988 78740 : SUBROUTINE block_5_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
18989 : INTEGER :: md_max
18990 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*1), kad(5*md_max), kac(5*1), pbd(1*md_max), pbc(1*1), &
18991 : pad(5*md_max), pac(5*1), prim(5*1*1*md_max), scale
18992 :
18993 : INTEGER :: ma, mb, mc, md, p_index
18994 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
18995 :
18996 454955 : kbd(1:1*md_max) = 0.0_dp
18997 78740 : kbc(1:1*1) = 0.0_dp
18998 1959815 : kad(1:5*md_max) = 0.0_dp
18999 78740 : kac(1:5*1) = 0.0_dp
19000 78740 : p_index = 0
19001 454955 : DO md = 1, md_max
19002 831170 : DO mc = 1, 1
19003 1128645 : DO mb = 1, 1
19004 376215 : ks_bd = 0.0_dp
19005 376215 : ks_bc = 0.0_dp
19006 376215 : p_bd = pbd((md - 1)*1 + mb)
19007 376215 : p_bc = pbc((mc - 1)*1 + mb)
19008 2257290 : DO ma = 1, 5
19009 1881075 : p_index = p_index + 1
19010 1881075 : tmp = scale*prim(p_index)
19011 1881075 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19012 1881075 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19013 1881075 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19014 2257290 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19015 : END DO
19016 376215 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
19017 752430 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
19018 : END DO
19019 : END DO
19020 : END DO
19021 78740 : END SUBROUTINE block_5_1_1
19022 : ! **************************************************************************************************
19023 : !> \brief ...
19024 : !> \param kbd ...
19025 : !> \param kbc ...
19026 : !> \param kad ...
19027 : !> \param kac ...
19028 : !> \param pbd ...
19029 : !> \param pbc ...
19030 : !> \param pad ...
19031 : !> \param pac ...
19032 : !> \param prim ...
19033 : !> \param scale ...
19034 : ! **************************************************************************************************
19035 10288 : SUBROUTINE block_5_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19036 : REAL(KIND=dp) :: kbd(1*1), kbc(1*2), kad(5*1), kac(5*2), &
19037 : pbd(1*1), pbc(1*2), pad(5*1), &
19038 : pac(5*2), prim(5*1*2*1), scale
19039 :
19040 : INTEGER :: ma, mb, mc, md, p_index
19041 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19042 :
19043 10288 : kbd(1:1*1) = 0.0_dp
19044 10288 : kbc(1:1*2) = 0.0_dp
19045 10288 : kad(1:5*1) = 0.0_dp
19046 10288 : kac(1:5*2) = 0.0_dp
19047 10288 : p_index = 0
19048 20576 : DO md = 1, 1
19049 41152 : DO mc = 1, 2
19050 51440 : DO mb = 1, 1
19051 20576 : ks_bd = 0.0_dp
19052 20576 : ks_bc = 0.0_dp
19053 20576 : p_bd = pbd((md - 1)*1 + mb)
19054 20576 : p_bc = pbc((mc - 1)*1 + mb)
19055 123456 : DO ma = 1, 5
19056 102880 : p_index = p_index + 1
19057 102880 : tmp = scale*prim(p_index)
19058 102880 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19059 102880 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19060 102880 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19061 123456 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19062 : END DO
19063 20576 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
19064 41152 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
19065 : END DO
19066 : END DO
19067 : END DO
19068 10288 : END SUBROUTINE block_5_1_2_1
19069 : ! **************************************************************************************************
19070 : !> \brief ...
19071 : !> \param md_max ...
19072 : !> \param kbd ...
19073 : !> \param kbc ...
19074 : !> \param kad ...
19075 : !> \param kac ...
19076 : !> \param pbd ...
19077 : !> \param pbc ...
19078 : !> \param pad ...
19079 : !> \param pac ...
19080 : !> \param prim ...
19081 : !> \param scale ...
19082 : ! **************************************************************************************************
19083 17034 : SUBROUTINE block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19084 : INTEGER :: md_max
19085 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*2), kad(5*md_max), kac(5*2), pbd(1*md_max), pbc(1*2), &
19086 : pad(5*md_max), pac(5*2), prim(5*1*2*md_max), scale
19087 :
19088 : INTEGER :: ma, mb, mc, md, p_index
19089 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19090 :
19091 77761 : kbd(1:1*md_max) = 0.0_dp
19092 17034 : kbc(1:1*2) = 0.0_dp
19093 320669 : kad(1:5*md_max) = 0.0_dp
19094 17034 : kac(1:5*2) = 0.0_dp
19095 17034 : p_index = 0
19096 77761 : DO md = 1, md_max
19097 199215 : DO mc = 1, 2
19098 303635 : DO mb = 1, 1
19099 121454 : ks_bd = 0.0_dp
19100 121454 : ks_bc = 0.0_dp
19101 121454 : p_bd = pbd((md - 1)*1 + mb)
19102 121454 : p_bc = pbc((mc - 1)*1 + mb)
19103 728724 : DO ma = 1, 5
19104 607270 : p_index = p_index + 1
19105 607270 : tmp = scale*prim(p_index)
19106 607270 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19107 607270 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19108 607270 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19109 728724 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19110 : END DO
19111 121454 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
19112 242908 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
19113 : END DO
19114 : END DO
19115 : END DO
19116 17034 : END SUBROUTINE block_5_1_2
19117 : ! **************************************************************************************************
19118 : !> \brief ...
19119 : !> \param kbd ...
19120 : !> \param kbc ...
19121 : !> \param kad ...
19122 : !> \param kac ...
19123 : !> \param pbd ...
19124 : !> \param pbc ...
19125 : !> \param pad ...
19126 : !> \param pac ...
19127 : !> \param prim ...
19128 : !> \param scale ...
19129 : ! **************************************************************************************************
19130 154213 : SUBROUTINE block_5_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19131 : REAL(KIND=dp) :: kbd(1*1), kbc(1*3), kad(5*1), kac(5*3), &
19132 : pbd(1*1), pbc(1*3), pad(5*1), &
19133 : pac(5*3), prim(5*1*3*1), scale
19134 :
19135 : INTEGER :: ma, mb, mc, md, p_index
19136 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19137 :
19138 154213 : kbd(1:1*1) = 0.0_dp
19139 154213 : kbc(1:1*3) = 0.0_dp
19140 154213 : kad(1:5*1) = 0.0_dp
19141 154213 : kac(1:5*3) = 0.0_dp
19142 154213 : p_index = 0
19143 308426 : DO md = 1, 1
19144 771065 : DO mc = 1, 3
19145 1079491 : DO mb = 1, 1
19146 462639 : ks_bd = 0.0_dp
19147 462639 : ks_bc = 0.0_dp
19148 462639 : p_bd = pbd((md - 1)*1 + mb)
19149 462639 : p_bc = pbc((mc - 1)*1 + mb)
19150 2775834 : DO ma = 1, 5
19151 2313195 : p_index = p_index + 1
19152 2313195 : tmp = scale*prim(p_index)
19153 2313195 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19154 2313195 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19155 2313195 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19156 2775834 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19157 : END DO
19158 462639 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
19159 925278 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
19160 : END DO
19161 : END DO
19162 : END DO
19163 154213 : END SUBROUTINE block_5_1_3_1
19164 : ! **************************************************************************************************
19165 : !> \brief ...
19166 : !> \param md_max ...
19167 : !> \param kbd ...
19168 : !> \param kbc ...
19169 : !> \param kad ...
19170 : !> \param kac ...
19171 : !> \param pbd ...
19172 : !> \param pbc ...
19173 : !> \param pad ...
19174 : !> \param pac ...
19175 : !> \param prim ...
19176 : !> \param scale ...
19177 : ! **************************************************************************************************
19178 152355 : SUBROUTINE block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19179 : INTEGER :: md_max
19180 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*3), kad(5*md_max), kac(5*3), pbd(1*md_max), pbc(1*3), &
19181 : pad(5*md_max), pac(5*3), prim(5*1*3*md_max), scale
19182 :
19183 : INTEGER :: ma, mb, mc, md, p_index
19184 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19185 :
19186 704440 : kbd(1:1*md_max) = 0.0_dp
19187 152355 : kbc(1:1*3) = 0.0_dp
19188 2912780 : kad(1:5*md_max) = 0.0_dp
19189 152355 : kac(1:5*3) = 0.0_dp
19190 152355 : p_index = 0
19191 704440 : DO md = 1, md_max
19192 2360695 : DO mc = 1, 3
19193 3864595 : DO mb = 1, 1
19194 1656255 : ks_bd = 0.0_dp
19195 1656255 : ks_bc = 0.0_dp
19196 1656255 : p_bd = pbd((md - 1)*1 + mb)
19197 1656255 : p_bc = pbc((mc - 1)*1 + mb)
19198 9937530 : DO ma = 1, 5
19199 8281275 : p_index = p_index + 1
19200 8281275 : tmp = scale*prim(p_index)
19201 8281275 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19202 8281275 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19203 8281275 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19204 9937530 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19205 : END DO
19206 1656255 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
19207 3312510 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
19208 : END DO
19209 : END DO
19210 : END DO
19211 152355 : END SUBROUTINE block_5_1_3
19212 : ! **************************************************************************************************
19213 : !> \brief ...
19214 : !> \param mc_max ...
19215 : !> \param md_max ...
19216 : !> \param kbd ...
19217 : !> \param kbc ...
19218 : !> \param kad ...
19219 : !> \param kac ...
19220 : !> \param pbd ...
19221 : !> \param pbc ...
19222 : !> \param pad ...
19223 : !> \param pac ...
19224 : !> \param prim ...
19225 : !> \param scale ...
19226 : ! **************************************************************************************************
19227 587393 : SUBROUTINE block_5_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19228 : INTEGER :: mc_max, md_max
19229 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*mc_max), kad(5*md_max), kac(5*mc_max), pbd(1*md_max), &
19230 : pbc(1*mc_max), pad(5*md_max), pac(5*mc_max), prim(5*1*mc_max*md_max), scale
19231 :
19232 : INTEGER :: ma, mb, mc, md, p_index
19233 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19234 :
19235 2122942 : kbd(1:1*md_max) = 0.0_dp
19236 3283617 : kbc(1:1*mc_max) = 0.0_dp
19237 8265138 : kad(1:5*md_max) = 0.0_dp
19238 14068513 : kac(1:5*mc_max) = 0.0_dp
19239 : p_index = 0
19240 2122942 : DO md = 1, md_max
19241 9178783 : DO mc = 1, mc_max
19242 15647231 : DO mb = 1, 1
19243 7055841 : ks_bd = 0.0_dp
19244 7055841 : ks_bc = 0.0_dp
19245 7055841 : p_bd = pbd((md - 1)*1 + mb)
19246 7055841 : p_bc = pbc((mc - 1)*1 + mb)
19247 42335046 : DO ma = 1, 5
19248 35279205 : p_index = p_index + 1
19249 35279205 : tmp = scale*prim(p_index)
19250 35279205 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19251 35279205 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19252 35279205 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19253 42335046 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19254 : END DO
19255 7055841 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
19256 14111682 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
19257 : END DO
19258 : END DO
19259 : END DO
19260 587393 : END SUBROUTINE block_5_1
19261 : ! **************************************************************************************************
19262 : !> \brief ...
19263 : !> \param kbd ...
19264 : !> \param kbc ...
19265 : !> \param kad ...
19266 : !> \param kac ...
19267 : !> \param pbd ...
19268 : !> \param pbc ...
19269 : !> \param pad ...
19270 : !> \param pac ...
19271 : !> \param prim ...
19272 : !> \param scale ...
19273 : ! **************************************************************************************************
19274 1724 : SUBROUTINE block_5_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19275 : REAL(KIND=dp) :: kbd(2*1), kbc(2*1), kad(5*1), kac(5*1), &
19276 : pbd(2*1), pbc(2*1), pad(5*1), &
19277 : pac(5*1), prim(5*2*1*1), scale
19278 :
19279 : INTEGER :: ma, mb, mc, md, p_index
19280 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19281 :
19282 1724 : kbd(1:2*1) = 0.0_dp
19283 1724 : kbc(1:2*1) = 0.0_dp
19284 1724 : kad(1:5*1) = 0.0_dp
19285 1724 : kac(1:5*1) = 0.0_dp
19286 1724 : p_index = 0
19287 3448 : DO md = 1, 1
19288 5172 : DO mc = 1, 1
19289 6896 : DO mb = 1, 2
19290 3448 : ks_bd = 0.0_dp
19291 3448 : ks_bc = 0.0_dp
19292 3448 : p_bd = pbd((md - 1)*2 + mb)
19293 3448 : p_bc = pbc((mc - 1)*2 + mb)
19294 20688 : DO ma = 1, 5
19295 17240 : p_index = p_index + 1
19296 17240 : tmp = scale*prim(p_index)
19297 17240 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19298 17240 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19299 17240 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19300 20688 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19301 : END DO
19302 3448 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
19303 5172 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
19304 : END DO
19305 : END DO
19306 : END DO
19307 1724 : END SUBROUTINE block_5_2_1_1
19308 : ! **************************************************************************************************
19309 : !> \brief ...
19310 : !> \param md_max ...
19311 : !> \param kbd ...
19312 : !> \param kbc ...
19313 : !> \param kad ...
19314 : !> \param kac ...
19315 : !> \param pbd ...
19316 : !> \param pbc ...
19317 : !> \param pad ...
19318 : !> \param pac ...
19319 : !> \param prim ...
19320 : !> \param scale ...
19321 : ! **************************************************************************************************
19322 5531 : SUBROUTINE block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19323 : INTEGER :: md_max
19324 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*1), kad(5*md_max), kac(5*1), pbd(2*md_max), pbc(2*1), &
19325 : pad(5*md_max), pac(5*1), prim(5*2*1*md_max), scale
19326 :
19327 : INTEGER :: ma, mb, mc, md, p_index
19328 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19329 :
19330 50247 : kbd(1:2*md_max) = 0.0_dp
19331 5531 : kbc(1:2*1) = 0.0_dp
19332 117321 : kad(1:5*md_max) = 0.0_dp
19333 5531 : kac(1:5*1) = 0.0_dp
19334 5531 : p_index = 0
19335 27889 : DO md = 1, md_max
19336 50247 : DO mc = 1, 1
19337 89432 : DO mb = 1, 2
19338 44716 : ks_bd = 0.0_dp
19339 44716 : ks_bc = 0.0_dp
19340 44716 : p_bd = pbd((md - 1)*2 + mb)
19341 44716 : p_bc = pbc((mc - 1)*2 + mb)
19342 268296 : DO ma = 1, 5
19343 223580 : p_index = p_index + 1
19344 223580 : tmp = scale*prim(p_index)
19345 223580 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19346 223580 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19347 223580 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19348 268296 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19349 : END DO
19350 44716 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
19351 67074 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
19352 : END DO
19353 : END DO
19354 : END DO
19355 5531 : END SUBROUTINE block_5_2_1
19356 : ! **************************************************************************************************
19357 : !> \brief ...
19358 : !> \param mc_max ...
19359 : !> \param md_max ...
19360 : !> \param kbd ...
19361 : !> \param kbc ...
19362 : !> \param kad ...
19363 : !> \param kac ...
19364 : !> \param pbd ...
19365 : !> \param pbc ...
19366 : !> \param pad ...
19367 : !> \param pac ...
19368 : !> \param prim ...
19369 : !> \param scale ...
19370 : ! **************************************************************************************************
19371 77836 : SUBROUTINE block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19372 : INTEGER :: mc_max, md_max
19373 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*mc_max), kad(5*md_max), kac(5*mc_max), pbd(2*md_max), &
19374 : pbc(2*mc_max), pad(5*md_max), pac(5*mc_max), prim(5*2*mc_max*md_max), scale
19375 :
19376 : INTEGER :: ma, mb, mc, md, p_index
19377 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19378 :
19379 699690 : kbd(1:2*md_max) = 0.0_dp
19380 772554 : kbc(1:2*mc_max) = 0.0_dp
19381 1632471 : kad(1:5*md_max) = 0.0_dp
19382 1814631 : kac(1:5*mc_max) = 0.0_dp
19383 : p_index = 0
19384 388763 : DO md = 1, md_max
19385 1827975 : DO mc = 1, mc_max
19386 4628563 : DO mb = 1, 2
19387 2878424 : ks_bd = 0.0_dp
19388 2878424 : ks_bc = 0.0_dp
19389 2878424 : p_bd = pbd((md - 1)*2 + mb)
19390 2878424 : p_bc = pbc((mc - 1)*2 + mb)
19391 17270544 : DO ma = 1, 5
19392 14392120 : p_index = p_index + 1
19393 14392120 : tmp = scale*prim(p_index)
19394 14392120 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19395 14392120 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19396 14392120 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19397 17270544 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19398 : END DO
19399 2878424 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
19400 4317636 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
19401 : END DO
19402 : END DO
19403 : END DO
19404 77836 : END SUBROUTINE block_5_2
19405 : ! **************************************************************************************************
19406 : !> \brief ...
19407 : !> \param kbd ...
19408 : !> \param kbc ...
19409 : !> \param kad ...
19410 : !> \param kac ...
19411 : !> \param pbd ...
19412 : !> \param pbc ...
19413 : !> \param pad ...
19414 : !> \param pac ...
19415 : !> \param prim ...
19416 : !> \param scale ...
19417 : ! **************************************************************************************************
19418 109966 : SUBROUTINE block_5_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19419 : REAL(KIND=dp) :: kbd(3*1), kbc(3*1), kad(5*1), kac(5*1), &
19420 : pbd(3*1), pbc(3*1), pad(5*1), &
19421 : pac(5*1), prim(5*3*1*1), scale
19422 :
19423 : INTEGER :: ma, mb, mc, md, p_index
19424 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19425 :
19426 109966 : kbd(1:3*1) = 0.0_dp
19427 109966 : kbc(1:3*1) = 0.0_dp
19428 109966 : kad(1:5*1) = 0.0_dp
19429 109966 : kac(1:5*1) = 0.0_dp
19430 109966 : p_index = 0
19431 219932 : DO md = 1, 1
19432 329898 : DO mc = 1, 1
19433 549830 : DO mb = 1, 3
19434 329898 : ks_bd = 0.0_dp
19435 329898 : ks_bc = 0.0_dp
19436 329898 : p_bd = pbd((md - 1)*3 + mb)
19437 329898 : p_bc = pbc((mc - 1)*3 + mb)
19438 1979388 : DO ma = 1, 5
19439 1649490 : p_index = p_index + 1
19440 1649490 : tmp = scale*prim(p_index)
19441 1649490 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19442 1649490 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19443 1649490 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19444 1979388 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19445 : END DO
19446 329898 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
19447 439864 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
19448 : END DO
19449 : END DO
19450 : END DO
19451 109966 : END SUBROUTINE block_5_3_1_1
19452 : ! **************************************************************************************************
19453 : !> \brief ...
19454 : !> \param md_max ...
19455 : !> \param kbd ...
19456 : !> \param kbc ...
19457 : !> \param kad ...
19458 : !> \param kac ...
19459 : !> \param pbd ...
19460 : !> \param pbc ...
19461 : !> \param pad ...
19462 : !> \param pac ...
19463 : !> \param prim ...
19464 : !> \param scale ...
19465 : ! **************************************************************************************************
19466 114055 : SUBROUTINE block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19467 : INTEGER :: md_max
19468 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*1), kad(5*md_max), kac(5*1), pbd(3*md_max), pbc(3*1), &
19469 : pad(5*md_max), pac(5*1), prim(5*3*1*md_max), scale
19470 :
19471 : INTEGER :: ma, mb, mc, md, p_index
19472 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19473 :
19474 1370191 : kbd(1:3*md_max) = 0.0_dp
19475 114055 : kbc(1:3*1) = 0.0_dp
19476 2207615 : kad(1:5*md_max) = 0.0_dp
19477 114055 : kac(1:5*1) = 0.0_dp
19478 114055 : p_index = 0
19479 532767 : DO md = 1, md_max
19480 951479 : DO mc = 1, 1
19481 2093560 : DO mb = 1, 3
19482 1256136 : ks_bd = 0.0_dp
19483 1256136 : ks_bc = 0.0_dp
19484 1256136 : p_bd = pbd((md - 1)*3 + mb)
19485 1256136 : p_bc = pbc((mc - 1)*3 + mb)
19486 7536816 : DO ma = 1, 5
19487 6280680 : p_index = p_index + 1
19488 6280680 : tmp = scale*prim(p_index)
19489 6280680 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19490 6280680 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19491 6280680 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19492 7536816 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19493 : END DO
19494 1256136 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
19495 1674848 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
19496 : END DO
19497 : END DO
19498 : END DO
19499 114055 : END SUBROUTINE block_5_3_1
19500 : ! **************************************************************************************************
19501 : !> \brief ...
19502 : !> \param mc_max ...
19503 : !> \param md_max ...
19504 : !> \param kbd ...
19505 : !> \param kbc ...
19506 : !> \param kad ...
19507 : !> \param kac ...
19508 : !> \param pbd ...
19509 : !> \param pbc ...
19510 : !> \param pad ...
19511 : !> \param pac ...
19512 : !> \param prim ...
19513 : !> \param scale ...
19514 : ! **************************************************************************************************
19515 523681 : SUBROUTINE block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19516 : INTEGER :: mc_max, md_max
19517 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*mc_max), kad(5*md_max), kac(5*mc_max), pbd(3*md_max), &
19518 : pbc(3*mc_max), pad(5*md_max), pac(5*mc_max), prim(5*3*mc_max*md_max), scale
19519 :
19520 : INTEGER :: ma, mb, mc, md, p_index
19521 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19522 :
19523 4756708 : kbd(1:3*md_max) = 0.0_dp
19524 6808174 : kbc(1:3*mc_max) = 0.0_dp
19525 7578726 : kad(1:5*md_max) = 0.0_dp
19526 10997836 : kac(1:5*mc_max) = 0.0_dp
19527 : p_index = 0
19528 1934690 : DO md = 1, md_max
19529 7678518 : DO mc = 1, mc_max
19530 24386321 : DO mb = 1, 3
19531 17231484 : ks_bd = 0.0_dp
19532 17231484 : ks_bc = 0.0_dp
19533 17231484 : p_bd = pbd((md - 1)*3 + mb)
19534 17231484 : p_bc = pbc((mc - 1)*3 + mb)
19535 103388904 : DO ma = 1, 5
19536 86157420 : p_index = p_index + 1
19537 86157420 : tmp = scale*prim(p_index)
19538 86157420 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19539 86157420 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19540 86157420 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19541 103388904 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19542 : END DO
19543 17231484 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
19544 22975312 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
19545 : END DO
19546 : END DO
19547 : END DO
19548 523681 : END SUBROUTINE block_5_3
19549 : ! **************************************************************************************************
19550 : !> \brief ...
19551 : !> \param mc_max ...
19552 : !> \param md_max ...
19553 : !> \param kbd ...
19554 : !> \param kbc ...
19555 : !> \param kad ...
19556 : !> \param kac ...
19557 : !> \param pbd ...
19558 : !> \param pbc ...
19559 : !> \param pad ...
19560 : !> \param pac ...
19561 : !> \param prim ...
19562 : !> \param scale ...
19563 : ! **************************************************************************************************
19564 232144 : SUBROUTINE block_5_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19565 : INTEGER :: mc_max, md_max
19566 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*mc_max), kad(5*md_max), kac(5*mc_max), pbd(4*md_max), &
19567 : pbc(4*mc_max), pad(5*md_max), pac(5*mc_max), prim(5*4*mc_max*md_max), scale
19568 :
19569 : INTEGER :: ma, mb, mc, md, p_index
19570 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19571 :
19572 3393620 : kbd(1:4*md_max) = 0.0_dp
19573 3479160 : kbc(1:4*mc_max) = 0.0_dp
19574 4183989 : kad(1:5*md_max) = 0.0_dp
19575 4290914 : kac(1:5*mc_max) = 0.0_dp
19576 : p_index = 0
19577 1022513 : DO md = 1, md_max
19578 3957830 : DO mc = 1, mc_max
19579 15466954 : DO mb = 1, 4
19580 11741268 : ks_bd = 0.0_dp
19581 11741268 : ks_bc = 0.0_dp
19582 11741268 : p_bd = pbd((md - 1)*4 + mb)
19583 11741268 : p_bc = pbc((mc - 1)*4 + mb)
19584 70447608 : DO ma = 1, 5
19585 58706340 : p_index = p_index + 1
19586 58706340 : tmp = scale*prim(p_index)
19587 58706340 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19588 58706340 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19589 58706340 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19590 70447608 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19591 : END DO
19592 11741268 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
19593 14676585 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
19594 : END DO
19595 : END DO
19596 : END DO
19597 232144 : END SUBROUTINE block_5_4
19598 : ! **************************************************************************************************
19599 : !> \brief ...
19600 : !> \param mc_max ...
19601 : !> \param md_max ...
19602 : !> \param kbd ...
19603 : !> \param kbc ...
19604 : !> \param kad ...
19605 : !> \param kac ...
19606 : !> \param pbd ...
19607 : !> \param pbc ...
19608 : !> \param pad ...
19609 : !> \param pac ...
19610 : !> \param prim ...
19611 : !> \param scale ...
19612 : ! **************************************************************************************************
19613 284854 : SUBROUTINE block_5_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19614 : INTEGER :: mc_max, md_max
19615 : REAL(KIND=dp) :: kbd(5*md_max), kbc(5*mc_max), kad(5*md_max), kac(5*mc_max), pbd(5*md_max), &
19616 : pbc(5*mc_max), pad(5*md_max), pac(5*mc_max), prim(5*5*mc_max*md_max), scale
19617 :
19618 : INTEGER :: ma, mb, mc, md, p_index
19619 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19620 :
19621 5538789 : kbd(1:5*md_max) = 0.0_dp
19622 5600799 : kbc(1:5*mc_max) = 0.0_dp
19623 5538789 : kad(1:5*md_max) = 0.0_dp
19624 5600799 : kac(1:5*mc_max) = 0.0_dp
19625 : p_index = 0
19626 1335641 : DO md = 1, md_max
19627 5715298 : DO mc = 1, mc_max
19628 27328729 : DO mb = 1, 5
19629 21898285 : ks_bd = 0.0_dp
19630 21898285 : ks_bc = 0.0_dp
19631 21898285 : p_bd = pbd((md - 1)*5 + mb)
19632 21898285 : p_bc = pbc((mc - 1)*5 + mb)
19633 131389710 : DO ma = 1, 5
19634 109491425 : p_index = p_index + 1
19635 109491425 : tmp = scale*prim(p_index)
19636 109491425 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19637 109491425 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19638 109491425 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19639 131389710 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19640 : END DO
19641 21898285 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
19642 26277942 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
19643 : END DO
19644 : END DO
19645 : END DO
19646 284854 : END SUBROUTINE block_5_5
19647 : ! **************************************************************************************************
19648 : !> \brief ...
19649 : !> \param mc_max ...
19650 : !> \param md_max ...
19651 : !> \param kbd ...
19652 : !> \param kbc ...
19653 : !> \param kad ...
19654 : !> \param kac ...
19655 : !> \param pbd ...
19656 : !> \param pbc ...
19657 : !> \param pad ...
19658 : !> \param pac ...
19659 : !> \param prim ...
19660 : !> \param scale ...
19661 : ! **************************************************************************************************
19662 267 : SUBROUTINE block_5_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19663 : INTEGER :: mc_max, md_max
19664 : REAL(KIND=dp) :: kbd(6*md_max), kbc(6*mc_max), kad(5*md_max), kac(5*mc_max), pbd(6*md_max), &
19665 : pbc(6*mc_max), pad(5*md_max), pac(5*mc_max), prim(5*6*mc_max*md_max), scale
19666 :
19667 : INTEGER :: ma, mb, mc, md, p_index
19668 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19669 :
19670 7569 : kbd(1:6*md_max) = 0.0_dp
19671 4941 : kbc(1:6*mc_max) = 0.0_dp
19672 6352 : kad(1:5*md_max) = 0.0_dp
19673 4162 : kac(1:5*mc_max) = 0.0_dp
19674 : p_index = 0
19675 1484 : DO md = 1, md_max
19676 5207 : DO mc = 1, mc_max
19677 27278 : DO mb = 1, 6
19678 22338 : ks_bd = 0.0_dp
19679 22338 : ks_bc = 0.0_dp
19680 22338 : p_bd = pbd((md - 1)*6 + mb)
19681 22338 : p_bc = pbc((mc - 1)*6 + mb)
19682 134028 : DO ma = 1, 5
19683 111690 : p_index = p_index + 1
19684 111690 : tmp = scale*prim(p_index)
19685 111690 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19686 111690 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19687 111690 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19688 134028 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19689 : END DO
19690 22338 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
19691 26061 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
19692 : END DO
19693 : END DO
19694 : END DO
19695 267 : END SUBROUTINE block_5_6
19696 : ! **************************************************************************************************
19697 : !> \brief ...
19698 : !> \param mc_max ...
19699 : !> \param md_max ...
19700 : !> \param kbd ...
19701 : !> \param kbc ...
19702 : !> \param kad ...
19703 : !> \param kac ...
19704 : !> \param pbd ...
19705 : !> \param pbc ...
19706 : !> \param pad ...
19707 : !> \param pac ...
19708 : !> \param prim ...
19709 : !> \param scale ...
19710 : ! **************************************************************************************************
19711 55006 : SUBROUTINE block_5_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19712 : INTEGER :: mc_max, md_max
19713 : REAL(KIND=dp) :: kbd(7*md_max), kbc(7*mc_max), kad(5*md_max), kac(5*mc_max), pbd(7*md_max), &
19714 : pbc(7*mc_max), pad(5*md_max), pac(5*mc_max), prim(5*7*mc_max*md_max), scale
19715 :
19716 : INTEGER :: ma, mb, mc, md, p_index
19717 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19718 :
19719 1410759 : kbd(1:7*md_max) = 0.0_dp
19720 1409800 : kbc(1:7*mc_max) = 0.0_dp
19721 1023401 : kad(1:5*md_max) = 0.0_dp
19722 1022716 : kac(1:5*mc_max) = 0.0_dp
19723 : p_index = 0
19724 248685 : DO md = 1, md_max
19725 936798 : DO mc = 1, mc_max
19726 5698583 : DO mb = 1, 7
19727 4816791 : ks_bd = 0.0_dp
19728 4816791 : ks_bc = 0.0_dp
19729 4816791 : p_bd = pbd((md - 1)*7 + mb)
19730 4816791 : p_bc = pbc((mc - 1)*7 + mb)
19731 28900746 : DO ma = 1, 5
19732 24083955 : p_index = p_index + 1
19733 24083955 : tmp = scale*prim(p_index)
19734 24083955 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19735 24083955 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19736 24083955 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19737 28900746 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19738 : END DO
19739 4816791 : kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
19740 5504904 : kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
19741 : END DO
19742 : END DO
19743 : END DO
19744 55006 : END SUBROUTINE block_5_7
19745 : ! **************************************************************************************************
19746 : !> \brief ...
19747 : !> \param mc_max ...
19748 : !> \param md_max ...
19749 : !> \param kbd ...
19750 : !> \param kbc ...
19751 : !> \param kad ...
19752 : !> \param kac ...
19753 : !> \param pbd ...
19754 : !> \param pbc ...
19755 : !> \param pad ...
19756 : !> \param pac ...
19757 : !> \param prim ...
19758 : !> \param scale ...
19759 : ! **************************************************************************************************
19760 77 : SUBROUTINE block_5_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19761 : INTEGER :: mc_max, md_max
19762 : REAL(KIND=dp) :: kbd(9*md_max), kbc(9*mc_max), kad(5*md_max), kac(5*mc_max), pbd(9*md_max), &
19763 : pbc(9*mc_max), pad(5*md_max), pac(5*mc_max), prim(5*9*mc_max*md_max), scale
19764 :
19765 : INTEGER :: ma, mb, mc, md, p_index
19766 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19767 :
19768 4604 : kbd(1:9*md_max) = 0.0_dp
19769 2003 : kbc(1:9*mc_max) = 0.0_dp
19770 2592 : kad(1:5*md_max) = 0.0_dp
19771 1147 : kac(1:5*mc_max) = 0.0_dp
19772 : p_index = 0
19773 580 : DO md = 1, md_max
19774 1982 : DO mc = 1, mc_max
19775 14523 : DO mb = 1, 9
19776 12618 : ks_bd = 0.0_dp
19777 12618 : ks_bc = 0.0_dp
19778 12618 : p_bd = pbd((md - 1)*9 + mb)
19779 12618 : p_bc = pbc((mc - 1)*9 + mb)
19780 75708 : DO ma = 1, 5
19781 63090 : p_index = p_index + 1
19782 63090 : tmp = scale*prim(p_index)
19783 63090 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19784 63090 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19785 63090 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19786 75708 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19787 : END DO
19788 12618 : kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
19789 14020 : kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
19790 : END DO
19791 : END DO
19792 : END DO
19793 77 : END SUBROUTINE block_5_9
19794 : ! **************************************************************************************************
19795 : !> \brief ...
19796 : !> \param mc_max ...
19797 : !> \param md_max ...
19798 : !> \param kbd ...
19799 : !> \param kbc ...
19800 : !> \param kad ...
19801 : !> \param kac ...
19802 : !> \param pbd ...
19803 : !> \param pbc ...
19804 : !> \param pad ...
19805 : !> \param pac ...
19806 : !> \param prim ...
19807 : !> \param scale ...
19808 : ! **************************************************************************************************
19809 143 : SUBROUTINE block_5_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19810 : INTEGER :: mc_max, md_max
19811 : REAL(KIND=dp) :: kbd(10*md_max), kbc(10*mc_max), kad(5*md_max), kac(5*mc_max), &
19812 : pbd(10*md_max), pbc(10*mc_max), pad(5*md_max), pac(5*mc_max), prim(5*10*mc_max*md_max), &
19813 : scale
19814 :
19815 : INTEGER :: ma, mb, mc, md, p_index
19816 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19817 :
19818 9823 : kbd(1:10*md_max) = 0.0_dp
19819 5103 : kbc(1:10*mc_max) = 0.0_dp
19820 4983 : kad(1:5*md_max) = 0.0_dp
19821 2623 : kac(1:5*mc_max) = 0.0_dp
19822 : p_index = 0
19823 1111 : DO md = 1, md_max
19824 4678 : DO mc = 1, mc_max
19825 40205 : DO mb = 1, 10
19826 35670 : ks_bd = 0.0_dp
19827 35670 : ks_bc = 0.0_dp
19828 35670 : p_bd = pbd((md - 1)*10 + mb)
19829 35670 : p_bc = pbc((mc - 1)*10 + mb)
19830 214020 : DO ma = 1, 5
19831 178350 : p_index = p_index + 1
19832 178350 : tmp = scale*prim(p_index)
19833 178350 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19834 178350 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19835 178350 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19836 214020 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19837 : END DO
19838 35670 : kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
19839 39237 : kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
19840 : END DO
19841 : END DO
19842 : END DO
19843 143 : END SUBROUTINE block_5_10
19844 : ! **************************************************************************************************
19845 : !> \brief ...
19846 : !> \param mc_max ...
19847 : !> \param md_max ...
19848 : !> \param kbd ...
19849 : !> \param kbc ...
19850 : !> \param kad ...
19851 : !> \param kac ...
19852 : !> \param pbd ...
19853 : !> \param pbc ...
19854 : !> \param pad ...
19855 : !> \param pac ...
19856 : !> \param prim ...
19857 : !> \param scale ...
19858 : ! **************************************************************************************************
19859 172 : SUBROUTINE block_5_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19860 : INTEGER :: mc_max, md_max
19861 : REAL(KIND=dp) :: kbd(11*md_max), kbc(11*mc_max), kad(5*md_max), kac(5*mc_max), &
19862 : pbd(11*md_max), pbc(11*mc_max), pad(5*md_max), pac(5*mc_max), prim(5*11*mc_max*md_max), &
19863 : scale
19864 :
19865 : INTEGER :: ma, mb, mc, md, p_index
19866 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19867 :
19868 13834 : kbd(1:11*md_max) = 0.0_dp
19869 7157 : kbc(1:11*mc_max) = 0.0_dp
19870 6382 : kad(1:5*md_max) = 0.0_dp
19871 3347 : kac(1:5*mc_max) = 0.0_dp
19872 : p_index = 0
19873 1414 : DO md = 1, md_max
19874 6224 : DO mc = 1, mc_max
19875 58962 : DO mb = 1, 11
19876 52910 : ks_bd = 0.0_dp
19877 52910 : ks_bc = 0.0_dp
19878 52910 : p_bd = pbd((md - 1)*11 + mb)
19879 52910 : p_bc = pbc((mc - 1)*11 + mb)
19880 317460 : DO ma = 1, 5
19881 264550 : p_index = p_index + 1
19882 264550 : tmp = scale*prim(p_index)
19883 264550 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19884 264550 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19885 264550 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19886 317460 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19887 : END DO
19888 52910 : kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
19889 57720 : kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
19890 : END DO
19891 : END DO
19892 : END DO
19893 172 : END SUBROUTINE block_5_11
19894 : ! **************************************************************************************************
19895 : !> \brief ...
19896 : !> \param mc_max ...
19897 : !> \param md_max ...
19898 : !> \param kbd ...
19899 : !> \param kbc ...
19900 : !> \param kad ...
19901 : !> \param kac ...
19902 : !> \param pbd ...
19903 : !> \param pbc ...
19904 : !> \param pad ...
19905 : !> \param pac ...
19906 : !> \param prim ...
19907 : !> \param scale ...
19908 : ! **************************************************************************************************
19909 158 : SUBROUTINE block_5_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19910 : INTEGER :: mc_max, md_max
19911 : REAL(KIND=dp) :: kbd(15*md_max), kbc(15*mc_max), kad(5*md_max), kac(5*mc_max), &
19912 : pbd(15*md_max), pbc(15*mc_max), pad(5*md_max), pac(5*mc_max), prim(5*15*mc_max*md_max), &
19913 : scale
19914 :
19915 : INTEGER :: ma, mb, mc, md, p_index
19916 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19917 :
19918 17078 : kbd(1:15*md_max) = 0.0_dp
19919 8198 : kbc(1:15*mc_max) = 0.0_dp
19920 5798 : kad(1:5*md_max) = 0.0_dp
19921 2838 : kac(1:5*mc_max) = 0.0_dp
19922 : p_index = 0
19923 1286 : DO md = 1, md_max
19924 5315 : DO mc = 1, mc_max
19925 65592 : DO mb = 1, 15
19926 60435 : ks_bd = 0.0_dp
19927 60435 : ks_bc = 0.0_dp
19928 60435 : p_bd = pbd((md - 1)*15 + mb)
19929 60435 : p_bc = pbc((mc - 1)*15 + mb)
19930 362610 : DO ma = 1, 5
19931 302175 : p_index = p_index + 1
19932 302175 : tmp = scale*prim(p_index)
19933 302175 : ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19934 302175 : ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19935 302175 : kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19936 362610 : kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19937 : END DO
19938 60435 : kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
19939 64464 : kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
19940 : END DO
19941 : END DO
19942 : END DO
19943 158 : END SUBROUTINE block_5_15
19944 : ! **************************************************************************************************
19945 : !> \brief ...
19946 : !> \param kbd ...
19947 : !> \param kbc ...
19948 : !> \param kad ...
19949 : !> \param kac ...
19950 : !> \param pbd ...
19951 : !> \param pbc ...
19952 : !> \param pad ...
19953 : !> \param pac ...
19954 : !> \param prim ...
19955 : !> \param scale ...
19956 : ! **************************************************************************************************
19957 10 : SUBROUTINE block_6_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
19958 : REAL(KIND=dp) :: kbd(1*1), kbc(1*1), kad(6*1), kac(6*1), &
19959 : pbd(1*1), pbc(1*1), pad(6*1), &
19960 : pac(6*1), prim(6*1*1*1), scale
19961 :
19962 : INTEGER :: ma, mb, mc, md, p_index
19963 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
19964 :
19965 10 : kbd(1:1*1) = 0.0_dp
19966 10 : kbc(1:1*1) = 0.0_dp
19967 10 : kad(1:6*1) = 0.0_dp
19968 10 : kac(1:6*1) = 0.0_dp
19969 10 : p_index = 0
19970 20 : DO md = 1, 1
19971 30 : DO mc = 1, 1
19972 30 : DO mb = 1, 1
19973 10 : ks_bd = 0.0_dp
19974 10 : ks_bc = 0.0_dp
19975 10 : p_bd = pbd((md - 1)*1 + mb)
19976 10 : p_bc = pbc((mc - 1)*1 + mb)
19977 70 : DO ma = 1, 6
19978 60 : p_index = p_index + 1
19979 60 : tmp = scale*prim(p_index)
19980 60 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
19981 60 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
19982 60 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
19983 70 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
19984 : END DO
19985 10 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
19986 20 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
19987 : END DO
19988 : END DO
19989 : END DO
19990 10 : END SUBROUTINE block_6_1_1_1
19991 : ! **************************************************************************************************
19992 : !> \brief ...
19993 : !> \param kbd ...
19994 : !> \param kbc ...
19995 : !> \param kad ...
19996 : !> \param kac ...
19997 : !> \param pbd ...
19998 : !> \param pbc ...
19999 : !> \param pad ...
20000 : !> \param pac ...
20001 : !> \param prim ...
20002 : !> \param scale ...
20003 : ! **************************************************************************************************
20004 6 : SUBROUTINE block_6_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20005 : REAL(KIND=dp) :: kbd(1*2), kbc(1*1), kad(6*2), kac(6*1), &
20006 : pbd(1*2), pbc(1*1), pad(6*2), &
20007 : pac(6*1), prim(6*1*1*2), scale
20008 :
20009 : INTEGER :: ma, mb, mc, md, p_index
20010 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20011 :
20012 6 : kbd(1:1*2) = 0.0_dp
20013 6 : kbc(1:1*1) = 0.0_dp
20014 6 : kad(1:6*2) = 0.0_dp
20015 6 : kac(1:6*1) = 0.0_dp
20016 6 : p_index = 0
20017 18 : DO md = 1, 2
20018 30 : DO mc = 1, 1
20019 36 : DO mb = 1, 1
20020 12 : ks_bd = 0.0_dp
20021 12 : ks_bc = 0.0_dp
20022 12 : p_bd = pbd((md - 1)*1 + mb)
20023 12 : p_bc = pbc((mc - 1)*1 + mb)
20024 84 : DO ma = 1, 6
20025 72 : p_index = p_index + 1
20026 72 : tmp = scale*prim(p_index)
20027 72 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20028 72 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20029 72 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20030 84 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20031 : END DO
20032 12 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
20033 24 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
20034 : END DO
20035 : END DO
20036 : END DO
20037 6 : END SUBROUTINE block_6_1_1_2
20038 : ! **************************************************************************************************
20039 : !> \brief ...
20040 : !> \param kbd ...
20041 : !> \param kbc ...
20042 : !> \param kad ...
20043 : !> \param kac ...
20044 : !> \param pbd ...
20045 : !> \param pbc ...
20046 : !> \param pad ...
20047 : !> \param pac ...
20048 : !> \param prim ...
20049 : !> \param scale ...
20050 : ! **************************************************************************************************
20051 5 : SUBROUTINE block_6_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20052 : REAL(KIND=dp) :: kbd(1*3), kbc(1*1), kad(6*3), kac(6*1), &
20053 : pbd(1*3), pbc(1*1), pad(6*3), &
20054 : pac(6*1), prim(6*1*1*3), scale
20055 :
20056 : INTEGER :: ma, mb, mc, md, p_index
20057 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20058 :
20059 5 : kbd(1:1*3) = 0.0_dp
20060 5 : kbc(1:1*1) = 0.0_dp
20061 5 : kad(1:6*3) = 0.0_dp
20062 5 : kac(1:6*1) = 0.0_dp
20063 5 : p_index = 0
20064 20 : DO md = 1, 3
20065 35 : DO mc = 1, 1
20066 45 : DO mb = 1, 1
20067 15 : ks_bd = 0.0_dp
20068 15 : ks_bc = 0.0_dp
20069 15 : p_bd = pbd((md - 1)*1 + mb)
20070 15 : p_bc = pbc((mc - 1)*1 + mb)
20071 105 : DO ma = 1, 6
20072 90 : p_index = p_index + 1
20073 90 : tmp = scale*prim(p_index)
20074 90 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20075 90 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20076 90 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20077 105 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20078 : END DO
20079 15 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
20080 30 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
20081 : END DO
20082 : END DO
20083 : END DO
20084 5 : END SUBROUTINE block_6_1_1_3
20085 : ! **************************************************************************************************
20086 : !> \brief ...
20087 : !> \param md_max ...
20088 : !> \param kbd ...
20089 : !> \param kbc ...
20090 : !> \param kad ...
20091 : !> \param kac ...
20092 : !> \param pbd ...
20093 : !> \param pbc ...
20094 : !> \param pad ...
20095 : !> \param pac ...
20096 : !> \param prim ...
20097 : !> \param scale ...
20098 : ! **************************************************************************************************
20099 36 : SUBROUTINE block_6_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20100 : INTEGER :: md_max
20101 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*1), kad(6*md_max), kac(6*1), pbd(1*md_max), pbc(1*1), &
20102 : pad(6*md_max), pac(6*1), prim(6*1*1*md_max), scale
20103 :
20104 : INTEGER :: ma, mb, mc, md, p_index
20105 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20106 :
20107 324 : kbd(1:1*md_max) = 0.0_dp
20108 36 : kbc(1:1*1) = 0.0_dp
20109 1764 : kad(1:6*md_max) = 0.0_dp
20110 36 : kac(1:6*1) = 0.0_dp
20111 36 : p_index = 0
20112 324 : DO md = 1, md_max
20113 612 : DO mc = 1, 1
20114 864 : DO mb = 1, 1
20115 288 : ks_bd = 0.0_dp
20116 288 : ks_bc = 0.0_dp
20117 288 : p_bd = pbd((md - 1)*1 + mb)
20118 288 : p_bc = pbc((mc - 1)*1 + mb)
20119 2016 : DO ma = 1, 6
20120 1728 : p_index = p_index + 1
20121 1728 : tmp = scale*prim(p_index)
20122 1728 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20123 1728 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20124 1728 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20125 2016 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20126 : END DO
20127 288 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
20128 576 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
20129 : END DO
20130 : END DO
20131 : END DO
20132 36 : END SUBROUTINE block_6_1_1
20133 : ! **************************************************************************************************
20134 : !> \brief ...
20135 : !> \param kbd ...
20136 : !> \param kbc ...
20137 : !> \param kad ...
20138 : !> \param kac ...
20139 : !> \param pbd ...
20140 : !> \param pbc ...
20141 : !> \param pad ...
20142 : !> \param pac ...
20143 : !> \param prim ...
20144 : !> \param scale ...
20145 : ! **************************************************************************************************
20146 4 : SUBROUTINE block_6_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20147 : REAL(KIND=dp) :: kbd(1*1), kbc(1*2), kad(6*1), kac(6*2), &
20148 : pbd(1*1), pbc(1*2), pad(6*1), &
20149 : pac(6*2), prim(6*1*2*1), scale
20150 :
20151 : INTEGER :: ma, mb, mc, md, p_index
20152 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20153 :
20154 4 : kbd(1:1*1) = 0.0_dp
20155 4 : kbc(1:1*2) = 0.0_dp
20156 4 : kad(1:6*1) = 0.0_dp
20157 4 : kac(1:6*2) = 0.0_dp
20158 4 : p_index = 0
20159 8 : DO md = 1, 1
20160 16 : DO mc = 1, 2
20161 20 : DO mb = 1, 1
20162 8 : ks_bd = 0.0_dp
20163 8 : ks_bc = 0.0_dp
20164 8 : p_bd = pbd((md - 1)*1 + mb)
20165 8 : p_bc = pbc((mc - 1)*1 + mb)
20166 56 : DO ma = 1, 6
20167 48 : p_index = p_index + 1
20168 48 : tmp = scale*prim(p_index)
20169 48 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20170 48 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20171 48 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20172 56 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20173 : END DO
20174 8 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
20175 16 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
20176 : END DO
20177 : END DO
20178 : END DO
20179 4 : END SUBROUTINE block_6_1_2_1
20180 : ! **************************************************************************************************
20181 : !> \brief ...
20182 : !> \param md_max ...
20183 : !> \param kbd ...
20184 : !> \param kbc ...
20185 : !> \param kad ...
20186 : !> \param kac ...
20187 : !> \param pbd ...
20188 : !> \param pbc ...
20189 : !> \param pad ...
20190 : !> \param pac ...
20191 : !> \param prim ...
20192 : !> \param scale ...
20193 : ! **************************************************************************************************
20194 35 : SUBROUTINE block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20195 : INTEGER :: md_max
20196 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*2), kad(6*md_max), kac(6*2), pbd(1*md_max), pbc(1*2), &
20197 : pad(6*md_max), pac(6*2), prim(6*1*2*md_max), scale
20198 :
20199 : INTEGER :: ma, mb, mc, md, p_index
20200 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20201 :
20202 270 : kbd(1:1*md_max) = 0.0_dp
20203 35 : kbc(1:1*2) = 0.0_dp
20204 1445 : kad(1:6*md_max) = 0.0_dp
20205 35 : kac(1:6*2) = 0.0_dp
20206 35 : p_index = 0
20207 270 : DO md = 1, md_max
20208 740 : DO mc = 1, 2
20209 1175 : DO mb = 1, 1
20210 470 : ks_bd = 0.0_dp
20211 470 : ks_bc = 0.0_dp
20212 470 : p_bd = pbd((md - 1)*1 + mb)
20213 470 : p_bc = pbc((mc - 1)*1 + mb)
20214 3290 : DO ma = 1, 6
20215 2820 : p_index = p_index + 1
20216 2820 : tmp = scale*prim(p_index)
20217 2820 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20218 2820 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20219 2820 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20220 3290 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20221 : END DO
20222 470 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
20223 940 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
20224 : END DO
20225 : END DO
20226 : END DO
20227 35 : END SUBROUTINE block_6_1_2
20228 : ! **************************************************************************************************
20229 : !> \brief ...
20230 : !> \param kbd ...
20231 : !> \param kbc ...
20232 : !> \param kad ...
20233 : !> \param kac ...
20234 : !> \param pbd ...
20235 : !> \param pbc ...
20236 : !> \param pad ...
20237 : !> \param pac ...
20238 : !> \param prim ...
20239 : !> \param scale ...
20240 : ! **************************************************************************************************
20241 5 : SUBROUTINE block_6_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20242 : REAL(KIND=dp) :: kbd(1*1), kbc(1*3), kad(6*1), kac(6*3), &
20243 : pbd(1*1), pbc(1*3), pad(6*1), &
20244 : pac(6*3), prim(6*1*3*1), scale
20245 :
20246 : INTEGER :: ma, mb, mc, md, p_index
20247 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20248 :
20249 5 : kbd(1:1*1) = 0.0_dp
20250 5 : kbc(1:1*3) = 0.0_dp
20251 5 : kad(1:6*1) = 0.0_dp
20252 5 : kac(1:6*3) = 0.0_dp
20253 5 : p_index = 0
20254 10 : DO md = 1, 1
20255 25 : DO mc = 1, 3
20256 35 : DO mb = 1, 1
20257 15 : ks_bd = 0.0_dp
20258 15 : ks_bc = 0.0_dp
20259 15 : p_bd = pbd((md - 1)*1 + mb)
20260 15 : p_bc = pbc((mc - 1)*1 + mb)
20261 105 : DO ma = 1, 6
20262 90 : p_index = p_index + 1
20263 90 : tmp = scale*prim(p_index)
20264 90 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20265 90 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20266 90 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20267 105 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20268 : END DO
20269 15 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
20270 30 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
20271 : END DO
20272 : END DO
20273 : END DO
20274 5 : END SUBROUTINE block_6_1_3_1
20275 : ! **************************************************************************************************
20276 : !> \brief ...
20277 : !> \param md_max ...
20278 : !> \param kbd ...
20279 : !> \param kbc ...
20280 : !> \param kad ...
20281 : !> \param kac ...
20282 : !> \param pbd ...
20283 : !> \param pbc ...
20284 : !> \param pad ...
20285 : !> \param pac ...
20286 : !> \param prim ...
20287 : !> \param scale ...
20288 : ! **************************************************************************************************
20289 35 : SUBROUTINE block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20290 : INTEGER :: md_max
20291 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*3), kad(6*md_max), kac(6*3), pbd(1*md_max), pbc(1*3), &
20292 : pad(6*md_max), pac(6*3), prim(6*1*3*md_max), scale
20293 :
20294 : INTEGER :: ma, mb, mc, md, p_index
20295 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20296 :
20297 272 : kbd(1:1*md_max) = 0.0_dp
20298 35 : kbc(1:1*3) = 0.0_dp
20299 1457 : kad(1:6*md_max) = 0.0_dp
20300 35 : kac(1:6*3) = 0.0_dp
20301 35 : p_index = 0
20302 272 : DO md = 1, md_max
20303 983 : DO mc = 1, 3
20304 1659 : DO mb = 1, 1
20305 711 : ks_bd = 0.0_dp
20306 711 : ks_bc = 0.0_dp
20307 711 : p_bd = pbd((md - 1)*1 + mb)
20308 711 : p_bc = pbc((mc - 1)*1 + mb)
20309 4977 : DO ma = 1, 6
20310 4266 : p_index = p_index + 1
20311 4266 : tmp = scale*prim(p_index)
20312 4266 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20313 4266 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20314 4266 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20315 4977 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20316 : END DO
20317 711 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
20318 1422 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
20319 : END DO
20320 : END DO
20321 : END DO
20322 35 : END SUBROUTINE block_6_1_3
20323 : ! **************************************************************************************************
20324 : !> \brief ...
20325 : !> \param mc_max ...
20326 : !> \param md_max ...
20327 : !> \param kbd ...
20328 : !> \param kbc ...
20329 : !> \param kad ...
20330 : !> \param kac ...
20331 : !> \param pbd ...
20332 : !> \param pbc ...
20333 : !> \param pad ...
20334 : !> \param pac ...
20335 : !> \param prim ...
20336 : !> \param scale ...
20337 : ! **************************************************************************************************
20338 169 : SUBROUTINE block_6_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20339 : INTEGER :: mc_max, md_max
20340 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*mc_max), kad(6*md_max), kac(6*mc_max), pbd(1*md_max), &
20341 : pbc(1*mc_max), pad(6*md_max), pac(6*mc_max), prim(6*1*mc_max*md_max), scale
20342 :
20343 : INTEGER :: ma, mb, mc, md, p_index
20344 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20345 :
20346 1330 : kbd(1:1*md_max) = 0.0_dp
20347 1383 : kbc(1:1*mc_max) = 0.0_dp
20348 7135 : kad(1:6*md_max) = 0.0_dp
20349 7453 : kac(1:6*mc_max) = 0.0_dp
20350 : p_index = 0
20351 1330 : DO md = 1, md_max
20352 9761 : DO mc = 1, mc_max
20353 18023 : DO mb = 1, 1
20354 8431 : ks_bd = 0.0_dp
20355 8431 : ks_bc = 0.0_dp
20356 8431 : p_bd = pbd((md - 1)*1 + mb)
20357 8431 : p_bc = pbc((mc - 1)*1 + mb)
20358 59017 : DO ma = 1, 6
20359 50586 : p_index = p_index + 1
20360 50586 : tmp = scale*prim(p_index)
20361 50586 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20362 50586 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20363 50586 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20364 59017 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20365 : END DO
20366 8431 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
20367 16862 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
20368 : END DO
20369 : END DO
20370 : END DO
20371 169 : END SUBROUTINE block_6_1
20372 : ! **************************************************************************************************
20373 : !> \brief ...
20374 : !> \param kbd ...
20375 : !> \param kbc ...
20376 : !> \param kad ...
20377 : !> \param kac ...
20378 : !> \param pbd ...
20379 : !> \param pbc ...
20380 : !> \param pad ...
20381 : !> \param pac ...
20382 : !> \param prim ...
20383 : !> \param scale ...
20384 : ! **************************************************************************************************
20385 5 : SUBROUTINE block_6_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20386 : REAL(KIND=dp) :: kbd(2*1), kbc(2*1), kad(6*1), kac(6*1), &
20387 : pbd(2*1), pbc(2*1), pad(6*1), &
20388 : pac(6*1), prim(6*2*1*1), scale
20389 :
20390 : INTEGER :: ma, mb, mc, md, p_index
20391 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20392 :
20393 5 : kbd(1:2*1) = 0.0_dp
20394 5 : kbc(1:2*1) = 0.0_dp
20395 5 : kad(1:6*1) = 0.0_dp
20396 5 : kac(1:6*1) = 0.0_dp
20397 5 : p_index = 0
20398 10 : DO md = 1, 1
20399 15 : DO mc = 1, 1
20400 20 : DO mb = 1, 2
20401 10 : ks_bd = 0.0_dp
20402 10 : ks_bc = 0.0_dp
20403 10 : p_bd = pbd((md - 1)*2 + mb)
20404 10 : p_bc = pbc((mc - 1)*2 + mb)
20405 70 : DO ma = 1, 6
20406 60 : p_index = p_index + 1
20407 60 : tmp = scale*prim(p_index)
20408 60 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20409 60 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20410 60 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20411 70 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20412 : END DO
20413 10 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
20414 15 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
20415 : END DO
20416 : END DO
20417 : END DO
20418 5 : END SUBROUTINE block_6_2_1_1
20419 : ! **************************************************************************************************
20420 : !> \brief ...
20421 : !> \param md_max ...
20422 : !> \param kbd ...
20423 : !> \param kbc ...
20424 : !> \param kad ...
20425 : !> \param kac ...
20426 : !> \param pbd ...
20427 : !> \param pbc ...
20428 : !> \param pad ...
20429 : !> \param pac ...
20430 : !> \param prim ...
20431 : !> \param scale ...
20432 : ! **************************************************************************************************
20433 20 : SUBROUTINE block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20434 : INTEGER :: md_max
20435 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*1), kad(6*md_max), kac(6*1), pbd(2*md_max), pbc(2*1), &
20436 : pad(6*md_max), pac(6*1), prim(6*2*1*md_max), scale
20437 :
20438 : INTEGER :: ma, mb, mc, md, p_index
20439 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20440 :
20441 244 : kbd(1:2*md_max) = 0.0_dp
20442 20 : kbc(1:2*1) = 0.0_dp
20443 692 : kad(1:6*md_max) = 0.0_dp
20444 20 : kac(1:6*1) = 0.0_dp
20445 20 : p_index = 0
20446 132 : DO md = 1, md_max
20447 244 : DO mc = 1, 1
20448 448 : DO mb = 1, 2
20449 224 : ks_bd = 0.0_dp
20450 224 : ks_bc = 0.0_dp
20451 224 : p_bd = pbd((md - 1)*2 + mb)
20452 224 : p_bc = pbc((mc - 1)*2 + mb)
20453 1568 : DO ma = 1, 6
20454 1344 : p_index = p_index + 1
20455 1344 : tmp = scale*prim(p_index)
20456 1344 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20457 1344 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20458 1344 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20459 1568 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20460 : END DO
20461 224 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
20462 336 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
20463 : END DO
20464 : END DO
20465 : END DO
20466 20 : END SUBROUTINE block_6_2_1
20467 : ! **************************************************************************************************
20468 : !> \brief ...
20469 : !> \param mc_max ...
20470 : !> \param md_max ...
20471 : !> \param kbd ...
20472 : !> \param kbc ...
20473 : !> \param kad ...
20474 : !> \param kac ...
20475 : !> \param pbd ...
20476 : !> \param pbc ...
20477 : !> \param pad ...
20478 : !> \param pac ...
20479 : !> \param prim ...
20480 : !> \param scale ...
20481 : ! **************************************************************************************************
20482 84 : SUBROUTINE block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20483 : INTEGER :: mc_max, md_max
20484 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*mc_max), kad(6*md_max), kac(6*mc_max), pbd(2*md_max), &
20485 : pbc(2*mc_max), pad(6*md_max), pac(6*mc_max), prim(6*2*mc_max*md_max), scale
20486 :
20487 : INTEGER :: ma, mb, mc, md, p_index
20488 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20489 :
20490 854 : kbd(1:2*md_max) = 0.0_dp
20491 1352 : kbc(1:2*mc_max) = 0.0_dp
20492 2394 : kad(1:6*md_max) = 0.0_dp
20493 3888 : kac(1:6*mc_max) = 0.0_dp
20494 : p_index = 0
20495 469 : DO md = 1, md_max
20496 3752 : DO mc = 1, mc_max
20497 10234 : DO mb = 1, 2
20498 6566 : ks_bd = 0.0_dp
20499 6566 : ks_bc = 0.0_dp
20500 6566 : p_bd = pbd((md - 1)*2 + mb)
20501 6566 : p_bc = pbc((mc - 1)*2 + mb)
20502 45962 : DO ma = 1, 6
20503 39396 : p_index = p_index + 1
20504 39396 : tmp = scale*prim(p_index)
20505 39396 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20506 39396 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20507 39396 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20508 45962 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20509 : END DO
20510 6566 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
20511 9849 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
20512 : END DO
20513 : END DO
20514 : END DO
20515 84 : END SUBROUTINE block_6_2
20516 : ! **************************************************************************************************
20517 : !> \brief ...
20518 : !> \param kbd ...
20519 : !> \param kbc ...
20520 : !> \param kad ...
20521 : !> \param kac ...
20522 : !> \param pbd ...
20523 : !> \param pbc ...
20524 : !> \param pad ...
20525 : !> \param pac ...
20526 : !> \param prim ...
20527 : !> \param scale ...
20528 : ! **************************************************************************************************
20529 5 : SUBROUTINE block_6_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20530 : REAL(KIND=dp) :: kbd(3*1), kbc(3*1), kad(6*1), kac(6*1), &
20531 : pbd(3*1), pbc(3*1), pad(6*1), &
20532 : pac(6*1), prim(6*3*1*1), scale
20533 :
20534 : INTEGER :: ma, mb, mc, md, p_index
20535 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20536 :
20537 5 : kbd(1:3*1) = 0.0_dp
20538 5 : kbc(1:3*1) = 0.0_dp
20539 5 : kad(1:6*1) = 0.0_dp
20540 5 : kac(1:6*1) = 0.0_dp
20541 5 : p_index = 0
20542 10 : DO md = 1, 1
20543 15 : DO mc = 1, 1
20544 25 : DO mb = 1, 3
20545 15 : ks_bd = 0.0_dp
20546 15 : ks_bc = 0.0_dp
20547 15 : p_bd = pbd((md - 1)*3 + mb)
20548 15 : p_bc = pbc((mc - 1)*3 + mb)
20549 105 : DO ma = 1, 6
20550 90 : p_index = p_index + 1
20551 90 : tmp = scale*prim(p_index)
20552 90 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20553 90 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20554 90 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20555 105 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20556 : END DO
20557 15 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
20558 20 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
20559 : END DO
20560 : END DO
20561 : END DO
20562 5 : END SUBROUTINE block_6_3_1_1
20563 : ! **************************************************************************************************
20564 : !> \brief ...
20565 : !> \param md_max ...
20566 : !> \param kbd ...
20567 : !> \param kbc ...
20568 : !> \param kad ...
20569 : !> \param kac ...
20570 : !> \param pbd ...
20571 : !> \param pbc ...
20572 : !> \param pad ...
20573 : !> \param pac ...
20574 : !> \param prim ...
20575 : !> \param scale ...
20576 : ! **************************************************************************************************
20577 21 : SUBROUTINE block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20578 : INTEGER :: md_max
20579 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*1), kad(6*md_max), kac(6*1), pbd(3*md_max), pbc(3*1), &
20580 : pad(6*md_max), pac(6*1), prim(6*3*1*md_max), scale
20581 :
20582 : INTEGER :: ma, mb, mc, md, p_index
20583 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20584 :
20585 363 : kbd(1:3*md_max) = 0.0_dp
20586 21 : kbc(1:3*1) = 0.0_dp
20587 705 : kad(1:6*md_max) = 0.0_dp
20588 21 : kac(1:6*1) = 0.0_dp
20589 21 : p_index = 0
20590 135 : DO md = 1, md_max
20591 249 : DO mc = 1, 1
20592 570 : DO mb = 1, 3
20593 342 : ks_bd = 0.0_dp
20594 342 : ks_bc = 0.0_dp
20595 342 : p_bd = pbd((md - 1)*3 + mb)
20596 342 : p_bc = pbc((mc - 1)*3 + mb)
20597 2394 : DO ma = 1, 6
20598 2052 : p_index = p_index + 1
20599 2052 : tmp = scale*prim(p_index)
20600 2052 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20601 2052 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20602 2052 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20603 2394 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20604 : END DO
20605 342 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
20606 456 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
20607 : END DO
20608 : END DO
20609 : END DO
20610 21 : END SUBROUTINE block_6_3_1
20611 : ! **************************************************************************************************
20612 : !> \brief ...
20613 : !> \param mc_max ...
20614 : !> \param md_max ...
20615 : !> \param kbd ...
20616 : !> \param kbc ...
20617 : !> \param kad ...
20618 : !> \param kac ...
20619 : !> \param pbd ...
20620 : !> \param pbc ...
20621 : !> \param pad ...
20622 : !> \param pac ...
20623 : !> \param prim ...
20624 : !> \param scale ...
20625 : ! **************************************************************************************************
20626 84 : SUBROUTINE block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20627 : INTEGER :: mc_max, md_max
20628 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*mc_max), kad(6*md_max), kac(6*mc_max), pbd(3*md_max), &
20629 : pbc(3*mc_max), pad(6*md_max), pac(6*mc_max), prim(6*3*mc_max*md_max), scale
20630 :
20631 : INTEGER :: ma, mb, mc, md, p_index
20632 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20633 :
20634 1266 : kbd(1:3*md_max) = 0.0_dp
20635 1953 : kbc(1:3*mc_max) = 0.0_dp
20636 2448 : kad(1:6*md_max) = 0.0_dp
20637 3822 : kac(1:6*mc_max) = 0.0_dp
20638 : p_index = 0
20639 478 : DO md = 1, md_max
20640 3771 : DO mc = 1, mc_max
20641 13566 : DO mb = 1, 3
20642 9879 : ks_bd = 0.0_dp
20643 9879 : ks_bc = 0.0_dp
20644 9879 : p_bd = pbd((md - 1)*3 + mb)
20645 9879 : p_bc = pbc((mc - 1)*3 + mb)
20646 69153 : DO ma = 1, 6
20647 59274 : p_index = p_index + 1
20648 59274 : tmp = scale*prim(p_index)
20649 59274 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20650 59274 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20651 59274 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20652 69153 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20653 : END DO
20654 9879 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
20655 13172 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
20656 : END DO
20657 : END DO
20658 : END DO
20659 84 : END SUBROUTINE block_6_3
20660 : ! **************************************************************************************************
20661 : !> \brief ...
20662 : !> \param mc_max ...
20663 : !> \param md_max ...
20664 : !> \param kbd ...
20665 : !> \param kbc ...
20666 : !> \param kad ...
20667 : !> \param kac ...
20668 : !> \param pbd ...
20669 : !> \param pbc ...
20670 : !> \param pad ...
20671 : !> \param pac ...
20672 : !> \param prim ...
20673 : !> \param scale ...
20674 : ! **************************************************************************************************
20675 111 : SUBROUTINE block_6_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20676 : INTEGER :: mc_max, md_max
20677 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*mc_max), kad(6*md_max), kac(6*mc_max), pbd(4*md_max), &
20678 : pbc(4*mc_max), pad(6*md_max), pac(6*mc_max), prim(6*4*mc_max*md_max), scale
20679 :
20680 : INTEGER :: ma, mb, mc, md, p_index
20681 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20682 :
20683 2207 : kbd(1:4*md_max) = 0.0_dp
20684 2643 : kbc(1:4*mc_max) = 0.0_dp
20685 3255 : kad(1:6*md_max) = 0.0_dp
20686 3909 : kac(1:6*mc_max) = 0.0_dp
20687 : p_index = 0
20688 635 : DO md = 1, md_max
20689 4049 : DO mc = 1, mc_max
20690 17594 : DO mb = 1, 4
20691 13656 : ks_bd = 0.0_dp
20692 13656 : ks_bc = 0.0_dp
20693 13656 : p_bd = pbd((md - 1)*4 + mb)
20694 13656 : p_bc = pbc((mc - 1)*4 + mb)
20695 95592 : DO ma = 1, 6
20696 81936 : p_index = p_index + 1
20697 81936 : tmp = scale*prim(p_index)
20698 81936 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20699 81936 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20700 81936 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20701 95592 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20702 : END DO
20703 13656 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
20704 17070 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
20705 : END DO
20706 : END DO
20707 : END DO
20708 111 : END SUBROUTINE block_6_4
20709 : ! **************************************************************************************************
20710 : !> \brief ...
20711 : !> \param mc_max ...
20712 : !> \param md_max ...
20713 : !> \param kbd ...
20714 : !> \param kbc ...
20715 : !> \param kad ...
20716 : !> \param kac ...
20717 : !> \param pbd ...
20718 : !> \param pbc ...
20719 : !> \param pad ...
20720 : !> \param pac ...
20721 : !> \param prim ...
20722 : !> \param scale ...
20723 : ! **************************************************************************************************
20724 110 : SUBROUTINE block_6_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20725 : INTEGER :: mc_max, md_max
20726 : REAL(KIND=dp) :: kbd(5*md_max), kbc(5*mc_max), kad(6*md_max), kac(6*mc_max), pbd(5*md_max), &
20727 : pbc(5*mc_max), pad(6*md_max), pac(6*mc_max), prim(6*5*mc_max*md_max), scale
20728 :
20729 : INTEGER :: ma, mb, mc, md, p_index
20730 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20731 :
20732 2750 : kbd(1:5*md_max) = 0.0_dp
20733 3125 : kbc(1:5*mc_max) = 0.0_dp
20734 3278 : kad(1:6*md_max) = 0.0_dp
20735 3728 : kac(1:6*mc_max) = 0.0_dp
20736 : p_index = 0
20737 638 : DO md = 1, md_max
20738 4006 : DO mc = 1, mc_max
20739 20736 : DO mb = 1, 5
20740 16840 : ks_bd = 0.0_dp
20741 16840 : ks_bc = 0.0_dp
20742 16840 : p_bd = pbd((md - 1)*5 + mb)
20743 16840 : p_bc = pbc((mc - 1)*5 + mb)
20744 117880 : DO ma = 1, 6
20745 101040 : p_index = p_index + 1
20746 101040 : tmp = scale*prim(p_index)
20747 101040 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20748 101040 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20749 101040 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20750 117880 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20751 : END DO
20752 16840 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
20753 20208 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
20754 : END DO
20755 : END DO
20756 : END DO
20757 110 : END SUBROUTINE block_6_5
20758 : ! **************************************************************************************************
20759 : !> \brief ...
20760 : !> \param mc_max ...
20761 : !> \param md_max ...
20762 : !> \param kbd ...
20763 : !> \param kbc ...
20764 : !> \param kad ...
20765 : !> \param kac ...
20766 : !> \param pbd ...
20767 : !> \param pbc ...
20768 : !> \param pad ...
20769 : !> \param pac ...
20770 : !> \param prim ...
20771 : !> \param scale ...
20772 : ! **************************************************************************************************
20773 346 : SUBROUTINE block_6_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20774 : INTEGER :: mc_max, md_max
20775 : REAL(KIND=dp) :: kbd(6*md_max), kbc(6*mc_max), kad(6*md_max), kac(6*mc_max), pbd(6*md_max), &
20776 : pbc(6*mc_max), pad(6*md_max), pac(6*mc_max), prim(6*6*mc_max*md_max), scale
20777 :
20778 : INTEGER :: ma, mb, mc, md, p_index
20779 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20780 :
20781 11032 : kbd(1:6*md_max) = 0.0_dp
20782 8002 : kbc(1:6*mc_max) = 0.0_dp
20783 11032 : kad(1:6*md_max) = 0.0_dp
20784 8002 : kac(1:6*mc_max) = 0.0_dp
20785 : p_index = 0
20786 2127 : DO md = 1, md_max
20787 9356 : DO mc = 1, mc_max
20788 52384 : DO mb = 1, 6
20789 43374 : ks_bd = 0.0_dp
20790 43374 : ks_bc = 0.0_dp
20791 43374 : p_bd = pbd((md - 1)*6 + mb)
20792 43374 : p_bc = pbc((mc - 1)*6 + mb)
20793 303618 : DO ma = 1, 6
20794 260244 : p_index = p_index + 1
20795 260244 : tmp = scale*prim(p_index)
20796 260244 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20797 260244 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20798 260244 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20799 303618 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20800 : END DO
20801 43374 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
20802 50603 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
20803 : END DO
20804 : END DO
20805 : END DO
20806 346 : END SUBROUTINE block_6_6
20807 : ! **************************************************************************************************
20808 : !> \brief ...
20809 : !> \param mc_max ...
20810 : !> \param md_max ...
20811 : !> \param kbd ...
20812 : !> \param kbc ...
20813 : !> \param kad ...
20814 : !> \param kac ...
20815 : !> \param pbd ...
20816 : !> \param pbc ...
20817 : !> \param pad ...
20818 : !> \param pac ...
20819 : !> \param prim ...
20820 : !> \param scale ...
20821 : ! **************************************************************************************************
20822 37 : SUBROUTINE block_6_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20823 : INTEGER :: mc_max, md_max
20824 : REAL(KIND=dp) :: kbd(7*md_max), kbc(7*mc_max), kad(6*md_max), kac(6*mc_max), pbd(7*md_max), &
20825 : pbc(7*mc_max), pad(6*md_max), pac(6*mc_max), prim(6*7*mc_max*md_max), scale
20826 :
20827 : INTEGER :: ma, mb, mc, md, p_index
20828 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20829 :
20830 1689 : kbd(1:7*md_max) = 0.0_dp
20831 716 : kbc(1:7*mc_max) = 0.0_dp
20832 1453 : kad(1:6*md_max) = 0.0_dp
20833 619 : kac(1:6*mc_max) = 0.0_dp
20834 : p_index = 0
20835 273 : DO md = 1, md_max
20836 884 : DO mc = 1, mc_max
20837 5124 : DO mb = 1, 7
20838 4277 : ks_bd = 0.0_dp
20839 4277 : ks_bc = 0.0_dp
20840 4277 : p_bd = pbd((md - 1)*7 + mb)
20841 4277 : p_bc = pbc((mc - 1)*7 + mb)
20842 29939 : DO ma = 1, 6
20843 25662 : p_index = p_index + 1
20844 25662 : tmp = scale*prim(p_index)
20845 25662 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20846 25662 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20847 25662 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20848 29939 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20849 : END DO
20850 4277 : kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
20851 4888 : kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
20852 : END DO
20853 : END DO
20854 : END DO
20855 37 : END SUBROUTINE block_6_7
20856 : ! **************************************************************************************************
20857 : !> \brief ...
20858 : !> \param mc_max ...
20859 : !> \param md_max ...
20860 : !> \param kbd ...
20861 : !> \param kbc ...
20862 : !> \param kad ...
20863 : !> \param kac ...
20864 : !> \param pbd ...
20865 : !> \param pbc ...
20866 : !> \param pad ...
20867 : !> \param pac ...
20868 : !> \param prim ...
20869 : !> \param scale ...
20870 : ! **************************************************************************************************
20871 99 : SUBROUTINE block_6_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20872 : INTEGER :: mc_max, md_max
20873 : REAL(KIND=dp) :: kbd(9*md_max), kbc(9*mc_max), kad(6*md_max), kac(6*mc_max), pbd(9*md_max), &
20874 : pbc(9*mc_max), pad(6*md_max), pac(6*mc_max), prim(6*9*mc_max*md_max), scale
20875 :
20876 : INTEGER :: ma, mb, mc, md, p_index
20877 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20878 :
20879 6399 : kbd(1:9*md_max) = 0.0_dp
20880 2889 : kbc(1:9*mc_max) = 0.0_dp
20881 4299 : kad(1:6*md_max) = 0.0_dp
20882 1959 : kac(1:6*mc_max) = 0.0_dp
20883 : p_index = 0
20884 799 : DO md = 1, md_max
20885 3108 : DO mc = 1, mc_max
20886 23790 : DO mb = 1, 9
20887 20781 : ks_bd = 0.0_dp
20888 20781 : ks_bc = 0.0_dp
20889 20781 : p_bd = pbd((md - 1)*9 + mb)
20890 20781 : p_bc = pbc((mc - 1)*9 + mb)
20891 145467 : DO ma = 1, 6
20892 124686 : p_index = p_index + 1
20893 124686 : tmp = scale*prim(p_index)
20894 124686 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20895 124686 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20896 124686 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20897 145467 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20898 : END DO
20899 20781 : kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
20900 23090 : kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
20901 : END DO
20902 : END DO
20903 : END DO
20904 99 : END SUBROUTINE block_6_9
20905 : ! **************************************************************************************************
20906 : !> \brief ...
20907 : !> \param mc_max ...
20908 : !> \param md_max ...
20909 : !> \param kbd ...
20910 : !> \param kbc ...
20911 : !> \param kad ...
20912 : !> \param kac ...
20913 : !> \param pbd ...
20914 : !> \param pbc ...
20915 : !> \param pad ...
20916 : !> \param pac ...
20917 : !> \param prim ...
20918 : !> \param scale ...
20919 : ! **************************************************************************************************
20920 167 : SUBROUTINE block_6_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20921 : INTEGER :: mc_max, md_max
20922 : REAL(KIND=dp) :: kbd(10*md_max), kbc(10*mc_max), kad(6*md_max), kac(6*mc_max), &
20923 : pbd(10*md_max), pbc(10*mc_max), pad(6*md_max), pac(6*mc_max), prim(6*10*mc_max*md_max), &
20924 : scale
20925 :
20926 : INTEGER :: ma, mb, mc, md, p_index
20927 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20928 :
20929 12017 : kbd(1:10*md_max) = 0.0_dp
20930 6257 : kbc(1:10*mc_max) = 0.0_dp
20931 7277 : kad(1:6*md_max) = 0.0_dp
20932 3821 : kac(1:6*mc_max) = 0.0_dp
20933 : p_index = 0
20934 1352 : DO md = 1, md_max
20935 5874 : DO mc = 1, mc_max
20936 50927 : DO mb = 1, 10
20937 45220 : ks_bd = 0.0_dp
20938 45220 : ks_bc = 0.0_dp
20939 45220 : p_bd = pbd((md - 1)*10 + mb)
20940 45220 : p_bc = pbc((mc - 1)*10 + mb)
20941 316540 : DO ma = 1, 6
20942 271320 : p_index = p_index + 1
20943 271320 : tmp = scale*prim(p_index)
20944 271320 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20945 271320 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20946 271320 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20947 316540 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20948 : END DO
20949 45220 : kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
20950 49742 : kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
20951 : END DO
20952 : END DO
20953 : END DO
20954 167 : END SUBROUTINE block_6_10
20955 : ! **************************************************************************************************
20956 : !> \brief ...
20957 : !> \param mc_max ...
20958 : !> \param md_max ...
20959 : !> \param kbd ...
20960 : !> \param kbc ...
20961 : !> \param kad ...
20962 : !> \param kac ...
20963 : !> \param pbd ...
20964 : !> \param pbc ...
20965 : !> \param pad ...
20966 : !> \param pac ...
20967 : !> \param prim ...
20968 : !> \param scale ...
20969 : ! **************************************************************************************************
20970 193 : SUBROUTINE block_6_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
20971 : INTEGER :: mc_max, md_max
20972 : REAL(KIND=dp) :: kbd(11*md_max), kbc(11*mc_max), kad(6*md_max), kac(6*mc_max), &
20973 : pbd(11*md_max), pbc(11*mc_max), pad(6*md_max), pac(6*mc_max), prim(6*11*mc_max*md_max), &
20974 : scale
20975 :
20976 : INTEGER :: ma, mb, mc, md, p_index
20977 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
20978 :
20979 15901 : kbd(1:11*md_max) = 0.0_dp
20980 8685 : kbc(1:11*mc_max) = 0.0_dp
20981 8761 : kad(1:6*md_max) = 0.0_dp
20982 4825 : kac(1:6*mc_max) = 0.0_dp
20983 : p_index = 0
20984 1621 : DO md = 1, md_max
20985 7796 : DO mc = 1, mc_max
20986 75528 : DO mb = 1, 11
20987 67925 : ks_bd = 0.0_dp
20988 67925 : ks_bc = 0.0_dp
20989 67925 : p_bd = pbd((md - 1)*11 + mb)
20990 67925 : p_bc = pbc((mc - 1)*11 + mb)
20991 475475 : DO ma = 1, 6
20992 407550 : p_index = p_index + 1
20993 407550 : tmp = scale*prim(p_index)
20994 407550 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20995 407550 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20996 407550 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20997 475475 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20998 : END DO
20999 67925 : kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
21000 74100 : kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
21001 : END DO
21002 : END DO
21003 : END DO
21004 193 : END SUBROUTINE block_6_11
21005 : ! **************************************************************************************************
21006 : !> \brief ...
21007 : !> \param mc_max ...
21008 : !> \param md_max ...
21009 : !> \param kbd ...
21010 : !> \param kbc ...
21011 : !> \param kad ...
21012 : !> \param kac ...
21013 : !> \param pbd ...
21014 : !> \param pbc ...
21015 : !> \param pad ...
21016 : !> \param pac ...
21017 : !> \param prim ...
21018 : !> \param scale ...
21019 : ! **************************************************************************************************
21020 180 : SUBROUTINE block_6_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21021 : INTEGER :: mc_max, md_max
21022 : REAL(KIND=dp) :: kbd(15*md_max), kbc(15*mc_max), kad(6*md_max), kac(6*mc_max), &
21023 : pbd(15*md_max), pbc(15*mc_max), pad(6*md_max), pac(6*mc_max), prim(6*15*mc_max*md_max), &
21024 : scale
21025 :
21026 : INTEGER :: ma, mb, mc, md, p_index
21027 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21028 :
21029 20130 : kbd(1:15*md_max) = 0.0_dp
21030 10125 : kbc(1:15*mc_max) = 0.0_dp
21031 8160 : kad(1:6*md_max) = 0.0_dp
21032 4158 : kac(1:6*mc_max) = 0.0_dp
21033 : p_index = 0
21034 1510 : DO md = 1, md_max
21035 6744 : DO mc = 1, mc_max
21036 85074 : DO mb = 1, 15
21037 78510 : ks_bd = 0.0_dp
21038 78510 : ks_bc = 0.0_dp
21039 78510 : p_bd = pbd((md - 1)*15 + mb)
21040 78510 : p_bc = pbc((mc - 1)*15 + mb)
21041 549570 : DO ma = 1, 6
21042 471060 : p_index = p_index + 1
21043 471060 : tmp = scale*prim(p_index)
21044 471060 : ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
21045 471060 : ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
21046 471060 : kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
21047 549570 : kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
21048 : END DO
21049 78510 : kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
21050 83744 : kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
21051 : END DO
21052 : END DO
21053 : END DO
21054 180 : END SUBROUTINE block_6_15
21055 : ! **************************************************************************************************
21056 : !> \brief ...
21057 : !> \param kbd ...
21058 : !> \param kbc ...
21059 : !> \param kad ...
21060 : !> \param kac ...
21061 : !> \param pbd ...
21062 : !> \param pbc ...
21063 : !> \param pad ...
21064 : !> \param pac ...
21065 : !> \param prim ...
21066 : !> \param scale ...
21067 : ! **************************************************************************************************
21068 27817 : SUBROUTINE block_7_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21069 : REAL(KIND=dp) :: kbd(1*1), kbc(1*1), kad(7*1), kac(7*1), &
21070 : pbd(1*1), pbc(1*1), pad(7*1), &
21071 : pac(7*1), prim(7*1*1*1), scale
21072 :
21073 : INTEGER :: ma, mb, mc, md, p_index
21074 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21075 :
21076 27817 : kbd(1:1*1) = 0.0_dp
21077 27817 : kbc(1:1*1) = 0.0_dp
21078 27817 : kad(1:7*1) = 0.0_dp
21079 27817 : kac(1:7*1) = 0.0_dp
21080 27817 : p_index = 0
21081 55634 : DO md = 1, 1
21082 83451 : DO mc = 1, 1
21083 83451 : DO mb = 1, 1
21084 27817 : ks_bd = 0.0_dp
21085 27817 : ks_bc = 0.0_dp
21086 27817 : p_bd = pbd((md - 1)*1 + mb)
21087 27817 : p_bc = pbc((mc - 1)*1 + mb)
21088 222536 : DO ma = 1, 7
21089 194719 : p_index = p_index + 1
21090 194719 : tmp = scale*prim(p_index)
21091 194719 : ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21092 194719 : ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21093 194719 : kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21094 222536 : kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21095 : END DO
21096 27817 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
21097 55634 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
21098 : END DO
21099 : END DO
21100 : END DO
21101 27817 : END SUBROUTINE block_7_1_1_1
21102 : ! **************************************************************************************************
21103 : !> \brief ...
21104 : !> \param kbd ...
21105 : !> \param kbc ...
21106 : !> \param kad ...
21107 : !> \param kac ...
21108 : !> \param pbd ...
21109 : !> \param pbc ...
21110 : !> \param pad ...
21111 : !> \param pac ...
21112 : !> \param prim ...
21113 : !> \param scale ...
21114 : ! **************************************************************************************************
21115 716 : SUBROUTINE block_7_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21116 : REAL(KIND=dp) :: kbd(1*2), kbc(1*1), kad(7*2), kac(7*1), &
21117 : pbd(1*2), pbc(1*1), pad(7*2), &
21118 : pac(7*1), prim(7*1*1*2), scale
21119 :
21120 : INTEGER :: ma, mb, mc, md, p_index
21121 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21122 :
21123 716 : kbd(1:1*2) = 0.0_dp
21124 716 : kbc(1:1*1) = 0.0_dp
21125 716 : kad(1:7*2) = 0.0_dp
21126 716 : kac(1:7*1) = 0.0_dp
21127 716 : p_index = 0
21128 2148 : DO md = 1, 2
21129 3580 : DO mc = 1, 1
21130 4296 : DO mb = 1, 1
21131 1432 : ks_bd = 0.0_dp
21132 1432 : ks_bc = 0.0_dp
21133 1432 : p_bd = pbd((md - 1)*1 + mb)
21134 1432 : p_bc = pbc((mc - 1)*1 + mb)
21135 11456 : DO ma = 1, 7
21136 10024 : p_index = p_index + 1
21137 10024 : tmp = scale*prim(p_index)
21138 10024 : ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21139 10024 : ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21140 10024 : kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21141 11456 : kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21142 : END DO
21143 1432 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
21144 2864 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
21145 : END DO
21146 : END DO
21147 : END DO
21148 716 : END SUBROUTINE block_7_1_1_2
21149 : ! **************************************************************************************************
21150 : !> \brief ...
21151 : !> \param md_max ...
21152 : !> \param kbd ...
21153 : !> \param kbc ...
21154 : !> \param kad ...
21155 : !> \param kac ...
21156 : !> \param pbd ...
21157 : !> \param pbc ...
21158 : !> \param pad ...
21159 : !> \param pac ...
21160 : !> \param prim ...
21161 : !> \param scale ...
21162 : ! **************************************************************************************************
21163 28237 : SUBROUTINE block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21164 : INTEGER :: md_max
21165 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*1), kad(7*md_max), kac(7*1), pbd(1*md_max), pbc(1*1), &
21166 : pad(7*md_max), pac(7*1), prim(7*1*1*md_max), scale
21167 :
21168 : INTEGER :: ma, mb, mc, md, p_index
21169 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21170 :
21171 139940 : kbd(1:1*md_max) = 0.0_dp
21172 28237 : kbc(1:1*1) = 0.0_dp
21173 810158 : kad(1:7*md_max) = 0.0_dp
21174 28237 : kac(1:7*1) = 0.0_dp
21175 28237 : p_index = 0
21176 139940 : DO md = 1, md_max
21177 251643 : DO mc = 1, 1
21178 335109 : DO mb = 1, 1
21179 111703 : ks_bd = 0.0_dp
21180 111703 : ks_bc = 0.0_dp
21181 111703 : p_bd = pbd((md - 1)*1 + mb)
21182 111703 : p_bc = pbc((mc - 1)*1 + mb)
21183 893624 : DO ma = 1, 7
21184 781921 : p_index = p_index + 1
21185 781921 : tmp = scale*prim(p_index)
21186 781921 : ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21187 781921 : ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21188 781921 : kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21189 893624 : kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21190 : END DO
21191 111703 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
21192 223406 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
21193 : END DO
21194 : END DO
21195 : END DO
21196 28237 : END SUBROUTINE block_7_1_1
21197 : ! **************************************************************************************************
21198 : !> \brief ...
21199 : !> \param kbd ...
21200 : !> \param kbc ...
21201 : !> \param kad ...
21202 : !> \param kac ...
21203 : !> \param pbd ...
21204 : !> \param pbc ...
21205 : !> \param pad ...
21206 : !> \param pac ...
21207 : !> \param prim ...
21208 : !> \param scale ...
21209 : ! **************************************************************************************************
21210 715 : SUBROUTINE block_7_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21211 : REAL(KIND=dp) :: kbd(1*1), kbc(1*2), kad(7*1), kac(7*2), &
21212 : pbd(1*1), pbc(1*2), pad(7*1), &
21213 : pac(7*2), prim(7*1*2*1), scale
21214 :
21215 : INTEGER :: ma, mb, mc, md, p_index
21216 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21217 :
21218 715 : kbd(1:1*1) = 0.0_dp
21219 715 : kbc(1:1*2) = 0.0_dp
21220 715 : kad(1:7*1) = 0.0_dp
21221 715 : kac(1:7*2) = 0.0_dp
21222 715 : p_index = 0
21223 1430 : DO md = 1, 1
21224 2860 : DO mc = 1, 2
21225 3575 : DO mb = 1, 1
21226 1430 : ks_bd = 0.0_dp
21227 1430 : ks_bc = 0.0_dp
21228 1430 : p_bd = pbd((md - 1)*1 + mb)
21229 1430 : p_bc = pbc((mc - 1)*1 + mb)
21230 11440 : DO ma = 1, 7
21231 10010 : p_index = p_index + 1
21232 10010 : tmp = scale*prim(p_index)
21233 10010 : ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21234 10010 : ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21235 10010 : kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21236 11440 : kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21237 : END DO
21238 1430 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
21239 2860 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
21240 : END DO
21241 : END DO
21242 : END DO
21243 715 : END SUBROUTINE block_7_1_2_1
21244 : ! **************************************************************************************************
21245 : !> \brief ...
21246 : !> \param md_max ...
21247 : !> \param kbd ...
21248 : !> \param kbc ...
21249 : !> \param kad ...
21250 : !> \param kac ...
21251 : !> \param pbd ...
21252 : !> \param pbc ...
21253 : !> \param pad ...
21254 : !> \param pac ...
21255 : !> \param prim ...
21256 : !> \param scale ...
21257 : ! **************************************************************************************************
21258 2425 : SUBROUTINE block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21259 : INTEGER :: md_max
21260 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*2), kad(7*md_max), kac(7*2), pbd(1*md_max), pbc(1*2), &
21261 : pad(7*md_max), pac(7*2), prim(7*1*2*md_max), scale
21262 :
21263 : INTEGER :: ma, mb, mc, md, p_index
21264 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21265 :
21266 12922 : kbd(1:1*md_max) = 0.0_dp
21267 2425 : kbc(1:1*2) = 0.0_dp
21268 75904 : kad(1:7*md_max) = 0.0_dp
21269 2425 : kac(1:7*2) = 0.0_dp
21270 2425 : p_index = 0
21271 12922 : DO md = 1, md_max
21272 33916 : DO mc = 1, 2
21273 52485 : DO mb = 1, 1
21274 20994 : ks_bd = 0.0_dp
21275 20994 : ks_bc = 0.0_dp
21276 20994 : p_bd = pbd((md - 1)*1 + mb)
21277 20994 : p_bc = pbc((mc - 1)*1 + mb)
21278 167952 : DO ma = 1, 7
21279 146958 : p_index = p_index + 1
21280 146958 : tmp = scale*prim(p_index)
21281 146958 : ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21282 146958 : ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21283 146958 : kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21284 167952 : kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21285 : END DO
21286 20994 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
21287 41988 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
21288 : END DO
21289 : END DO
21290 : END DO
21291 2425 : END SUBROUTINE block_7_1_2
21292 : ! **************************************************************************************************
21293 : !> \brief ...
21294 : !> \param mc_max ...
21295 : !> \param md_max ...
21296 : !> \param kbd ...
21297 : !> \param kbc ...
21298 : !> \param kad ...
21299 : !> \param kac ...
21300 : !> \param pbd ...
21301 : !> \param pbc ...
21302 : !> \param pad ...
21303 : !> \param pac ...
21304 : !> \param prim ...
21305 : !> \param scale ...
21306 : ! **************************************************************************************************
21307 98961 : SUBROUTINE block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21308 : INTEGER :: mc_max, md_max
21309 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*mc_max), kad(7*md_max), kac(7*mc_max), pbd(1*md_max), &
21310 : pbc(1*mc_max), pad(7*md_max), pac(7*mc_max), prim(7*1*mc_max*md_max), scale
21311 :
21312 : INTEGER :: ma, mb, mc, md, p_index
21313 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21314 :
21315 370965 : kbd(1:1*md_max) = 0.0_dp
21316 511608 : kbc(1:1*mc_max) = 0.0_dp
21317 2002989 : kad(1:7*md_max) = 0.0_dp
21318 2987490 : kac(1:7*mc_max) = 0.0_dp
21319 : p_index = 0
21320 370965 : DO md = 1, md_max
21321 1528281 : DO mc = 1, mc_max
21322 2586636 : DO mb = 1, 1
21323 1157316 : ks_bd = 0.0_dp
21324 1157316 : ks_bc = 0.0_dp
21325 1157316 : p_bd = pbd((md - 1)*1 + mb)
21326 1157316 : p_bc = pbc((mc - 1)*1 + mb)
21327 9258528 : DO ma = 1, 7
21328 8101212 : p_index = p_index + 1
21329 8101212 : tmp = scale*prim(p_index)
21330 8101212 : ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21331 8101212 : ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21332 8101212 : kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21333 9258528 : kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21334 : END DO
21335 1157316 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
21336 2314632 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
21337 : END DO
21338 : END DO
21339 : END DO
21340 98961 : END SUBROUTINE block_7_1
21341 : ! **************************************************************************************************
21342 : !> \brief ...
21343 : !> \param kbd ...
21344 : !> \param kbc ...
21345 : !> \param kad ...
21346 : !> \param kac ...
21347 : !> \param pbd ...
21348 : !> \param pbc ...
21349 : !> \param pad ...
21350 : !> \param pac ...
21351 : !> \param prim ...
21352 : !> \param scale ...
21353 : ! **************************************************************************************************
21354 738 : SUBROUTINE block_7_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21355 : REAL(KIND=dp) :: kbd(2*1), kbc(2*1), kad(7*1), kac(7*1), &
21356 : pbd(2*1), pbc(2*1), pad(7*1), &
21357 : pac(7*1), prim(7*2*1*1), scale
21358 :
21359 : INTEGER :: ma, mb, mc, md, p_index
21360 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21361 :
21362 738 : kbd(1:2*1) = 0.0_dp
21363 738 : kbc(1:2*1) = 0.0_dp
21364 738 : kad(1:7*1) = 0.0_dp
21365 738 : kac(1:7*1) = 0.0_dp
21366 738 : p_index = 0
21367 1476 : DO md = 1, 1
21368 2214 : DO mc = 1, 1
21369 2952 : DO mb = 1, 2
21370 1476 : ks_bd = 0.0_dp
21371 1476 : ks_bc = 0.0_dp
21372 1476 : p_bd = pbd((md - 1)*2 + mb)
21373 1476 : p_bc = pbc((mc - 1)*2 + mb)
21374 11808 : DO ma = 1, 7
21375 10332 : p_index = p_index + 1
21376 10332 : tmp = scale*prim(p_index)
21377 10332 : ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21378 10332 : ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21379 10332 : kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21380 11808 : kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21381 : END DO
21382 1476 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
21383 2214 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
21384 : END DO
21385 : END DO
21386 : END DO
21387 738 : END SUBROUTINE block_7_2_1_1
21388 : ! **************************************************************************************************
21389 : !> \brief ...
21390 : !> \param md_max ...
21391 : !> \param kbd ...
21392 : !> \param kbc ...
21393 : !> \param kad ...
21394 : !> \param kac ...
21395 : !> \param pbd ...
21396 : !> \param pbc ...
21397 : !> \param pad ...
21398 : !> \param pac ...
21399 : !> \param prim ...
21400 : !> \param scale ...
21401 : ! **************************************************************************************************
21402 2474 : SUBROUTINE block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21403 : INTEGER :: md_max
21404 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*1), kad(7*md_max), kac(7*1), pbd(2*md_max), pbc(2*1), &
21405 : pad(7*md_max), pac(7*1), prim(7*2*1*md_max), scale
21406 :
21407 : INTEGER :: ma, mb, mc, md, p_index
21408 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21409 :
21410 23818 : kbd(1:2*md_max) = 0.0_dp
21411 2474 : kbc(1:2*1) = 0.0_dp
21412 77178 : kad(1:7*md_max) = 0.0_dp
21413 2474 : kac(1:7*1) = 0.0_dp
21414 2474 : p_index = 0
21415 13146 : DO md = 1, md_max
21416 23818 : DO mc = 1, 1
21417 42688 : DO mb = 1, 2
21418 21344 : ks_bd = 0.0_dp
21419 21344 : ks_bc = 0.0_dp
21420 21344 : p_bd = pbd((md - 1)*2 + mb)
21421 21344 : p_bc = pbc((mc - 1)*2 + mb)
21422 170752 : DO ma = 1, 7
21423 149408 : p_index = p_index + 1
21424 149408 : tmp = scale*prim(p_index)
21425 149408 : ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21426 149408 : ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21427 149408 : kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21428 170752 : kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21429 : END DO
21430 21344 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
21431 32016 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
21432 : END DO
21433 : END DO
21434 : END DO
21435 2474 : END SUBROUTINE block_7_2_1
21436 : ! **************************************************************************************************
21437 : !> \brief ...
21438 : !> \param mc_max ...
21439 : !> \param md_max ...
21440 : !> \param kbd ...
21441 : !> \param kbc ...
21442 : !> \param kad ...
21443 : !> \param kac ...
21444 : !> \param pbd ...
21445 : !> \param pbc ...
21446 : !> \param pad ...
21447 : !> \param pac ...
21448 : !> \param prim ...
21449 : !> \param scale ...
21450 : ! **************************************************************************************************
21451 10841 : SUBROUTINE block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21452 : INTEGER :: mc_max, md_max
21453 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*mc_max), kad(7*md_max), kac(7*mc_max), pbd(2*md_max), &
21454 : pbc(2*mc_max), pad(7*md_max), pac(7*mc_max), prim(7*2*mc_max*md_max), scale
21455 :
21456 : INTEGER :: ma, mb, mc, md, p_index
21457 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21458 :
21459 87489 : kbd(1:2*md_max) = 0.0_dp
21460 104233 : kbc(1:2*mc_max) = 0.0_dp
21461 279109 : kad(1:7*md_max) = 0.0_dp
21462 337713 : kac(1:7*mc_max) = 0.0_dp
21463 : p_index = 0
21464 49165 : DO md = 1, md_max
21465 214690 : DO mc = 1, mc_max
21466 534899 : DO mb = 1, 2
21467 331050 : ks_bd = 0.0_dp
21468 331050 : ks_bc = 0.0_dp
21469 331050 : p_bd = pbd((md - 1)*2 + mb)
21470 331050 : p_bc = pbc((mc - 1)*2 + mb)
21471 2648400 : DO ma = 1, 7
21472 2317350 : p_index = p_index + 1
21473 2317350 : tmp = scale*prim(p_index)
21474 2317350 : ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21475 2317350 : ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21476 2317350 : kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21477 2648400 : kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21478 : END DO
21479 331050 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
21480 496575 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
21481 : END DO
21482 : END DO
21483 : END DO
21484 10841 : END SUBROUTINE block_7_2
21485 : ! **************************************************************************************************
21486 : !> \brief ...
21487 : !> \param mc_max ...
21488 : !> \param md_max ...
21489 : !> \param kbd ...
21490 : !> \param kbc ...
21491 : !> \param kad ...
21492 : !> \param kac ...
21493 : !> \param pbd ...
21494 : !> \param pbc ...
21495 : !> \param pad ...
21496 : !> \param pac ...
21497 : !> \param prim ...
21498 : !> \param scale ...
21499 : ! **************************************************************************************************
21500 107528 : SUBROUTINE block_7_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21501 : INTEGER :: mc_max, md_max
21502 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*mc_max), kad(7*md_max), kac(7*mc_max), pbd(3*md_max), &
21503 : pbc(3*mc_max), pad(7*md_max), pac(7*mc_max), prim(7*3*mc_max*md_max), scale
21504 :
21505 : INTEGER :: ma, mb, mc, md, p_index
21506 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21507 :
21508 1080038 : kbd(1:3*md_max) = 0.0_dp
21509 1134101 : kbc(1:3*mc_max) = 0.0_dp
21510 2376718 : kad(1:7*md_max) = 0.0_dp
21511 2502865 : kac(1:7*mc_max) = 0.0_dp
21512 : p_index = 0
21513 431698 : DO md = 1, md_max
21514 1489321 : DO mc = 1, mc_max
21515 4554662 : DO mb = 1, 3
21516 3172869 : ks_bd = 0.0_dp
21517 3172869 : ks_bc = 0.0_dp
21518 3172869 : p_bd = pbd((md - 1)*3 + mb)
21519 3172869 : p_bc = pbc((mc - 1)*3 + mb)
21520 25382952 : DO ma = 1, 7
21521 22210083 : p_index = p_index + 1
21522 22210083 : tmp = scale*prim(p_index)
21523 22210083 : ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21524 22210083 : ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21525 22210083 : kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21526 25382952 : kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21527 : END DO
21528 3172869 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
21529 4230492 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
21530 : END DO
21531 : END DO
21532 : END DO
21533 107528 : END SUBROUTINE block_7_3
21534 : ! **************************************************************************************************
21535 : !> \brief ...
21536 : !> \param mc_max ...
21537 : !> \param md_max ...
21538 : !> \param kbd ...
21539 : !> \param kbc ...
21540 : !> \param kad ...
21541 : !> \param kac ...
21542 : !> \param pbd ...
21543 : !> \param pbc ...
21544 : !> \param pad ...
21545 : !> \param pac ...
21546 : !> \param prim ...
21547 : !> \param scale ...
21548 : ! **************************************************************************************************
21549 8042 : SUBROUTINE block_7_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21550 : INTEGER :: mc_max, md_max
21551 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*mc_max), kad(7*md_max), kac(7*mc_max), pbd(4*md_max), &
21552 : pbc(4*mc_max), pad(7*md_max), pac(7*mc_max), prim(7*4*mc_max*md_max), scale
21553 :
21554 : INTEGER :: ma, mb, mc, md, p_index
21555 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21556 :
21557 148250 : kbd(1:4*md_max) = 0.0_dp
21558 148726 : kbc(1:4*mc_max) = 0.0_dp
21559 253406 : kad(1:7*md_max) = 0.0_dp
21560 254239 : kac(1:7*mc_max) = 0.0_dp
21561 : p_index = 0
21562 43094 : DO md = 1, md_max
21563 196891 : DO mc = 1, mc_max
21564 804037 : DO mb = 1, 4
21565 615188 : ks_bd = 0.0_dp
21566 615188 : ks_bc = 0.0_dp
21567 615188 : p_bd = pbd((md - 1)*4 + mb)
21568 615188 : p_bc = pbc((mc - 1)*4 + mb)
21569 4921504 : DO ma = 1, 7
21570 4306316 : p_index = p_index + 1
21571 4306316 : tmp = scale*prim(p_index)
21572 4306316 : ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21573 4306316 : ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21574 4306316 : kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21575 4921504 : kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21576 : END DO
21577 615188 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
21578 768985 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
21579 : END DO
21580 : END DO
21581 : END DO
21582 8042 : END SUBROUTINE block_7_4
21583 : ! **************************************************************************************************
21584 : !> \brief ...
21585 : !> \param mc_max ...
21586 : !> \param md_max ...
21587 : !> \param kbd ...
21588 : !> \param kbc ...
21589 : !> \param kad ...
21590 : !> \param kac ...
21591 : !> \param pbd ...
21592 : !> \param pbc ...
21593 : !> \param pad ...
21594 : !> \param pac ...
21595 : !> \param prim ...
21596 : !> \param scale ...
21597 : ! **************************************************************************************************
21598 55460 : SUBROUTINE block_7_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21599 : INTEGER :: mc_max, md_max
21600 : REAL(KIND=dp) :: kbd(5*md_max), kbc(5*mc_max), kad(7*md_max), kac(7*mc_max), pbd(5*md_max), &
21601 : pbc(5*mc_max), pad(7*md_max), pac(7*mc_max), prim(7*5*mc_max*md_max), scale
21602 :
21603 : INTEGER :: ma, mb, mc, md, p_index
21604 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21605 :
21606 1031650 : kbd(1:5*md_max) = 0.0_dp
21607 1034435 : kbc(1:5*mc_max) = 0.0_dp
21608 1422126 : kad(1:7*md_max) = 0.0_dp
21609 1426025 : kac(1:7*mc_max) = 0.0_dp
21610 : p_index = 0
21611 250698 : DO md = 1, md_max
21612 947519 : DO mc = 1, mc_max
21613 4376164 : DO mb = 1, 5
21614 3484105 : ks_bd = 0.0_dp
21615 3484105 : ks_bc = 0.0_dp
21616 3484105 : p_bd = pbd((md - 1)*5 + mb)
21617 3484105 : p_bc = pbc((mc - 1)*5 + mb)
21618 27872840 : DO ma = 1, 7
21619 24388735 : p_index = p_index + 1
21620 24388735 : tmp = scale*prim(p_index)
21621 24388735 : ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21622 24388735 : ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21623 24388735 : kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21624 27872840 : kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21625 : END DO
21626 3484105 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
21627 4180926 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
21628 : END DO
21629 : END DO
21630 : END DO
21631 55460 : END SUBROUTINE block_7_5
21632 : ! **************************************************************************************************
21633 : !> \brief ...
21634 : !> \param mc_max ...
21635 : !> \param md_max ...
21636 : !> \param kbd ...
21637 : !> \param kbc ...
21638 : !> \param kad ...
21639 : !> \param kac ...
21640 : !> \param pbd ...
21641 : !> \param pbc ...
21642 : !> \param pad ...
21643 : !> \param pac ...
21644 : !> \param prim ...
21645 : !> \param scale ...
21646 : ! **************************************************************************************************
21647 112 : SUBROUTINE block_7_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21648 : INTEGER :: mc_max, md_max
21649 : REAL(KIND=dp) :: kbd(6*md_max), kbc(6*mc_max), kad(7*md_max), kac(7*mc_max), pbd(6*md_max), &
21650 : pbc(6*mc_max), pad(7*md_max), pac(7*mc_max), prim(7*6*mc_max*md_max), scale
21651 :
21652 : INTEGER :: ma, mb, mc, md, p_index
21653 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21654 :
21655 4516 : kbd(1:6*md_max) = 0.0_dp
21656 3406 : kbc(1:6*mc_max) = 0.0_dp
21657 5250 : kad(1:7*md_max) = 0.0_dp
21658 3955 : kac(1:7*mc_max) = 0.0_dp
21659 : p_index = 0
21660 846 : DO md = 1, md_max
21661 4668 : DO mc = 1, mc_max
21662 27488 : DO mb = 1, 6
21663 22932 : ks_bd = 0.0_dp
21664 22932 : ks_bc = 0.0_dp
21665 22932 : p_bd = pbd((md - 1)*6 + mb)
21666 22932 : p_bc = pbc((mc - 1)*6 + mb)
21667 183456 : DO ma = 1, 7
21668 160524 : p_index = p_index + 1
21669 160524 : tmp = scale*prim(p_index)
21670 160524 : ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21671 160524 : ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21672 160524 : kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21673 183456 : kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21674 : END DO
21675 22932 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
21676 26754 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
21677 : END DO
21678 : END DO
21679 : END DO
21680 112 : END SUBROUTINE block_7_6
21681 : ! **************************************************************************************************
21682 : !> \brief ...
21683 : !> \param mc_max ...
21684 : !> \param md_max ...
21685 : !> \param kbd ...
21686 : !> \param kbc ...
21687 : !> \param kad ...
21688 : !> \param kac ...
21689 : !> \param pbd ...
21690 : !> \param pbc ...
21691 : !> \param pad ...
21692 : !> \param pac ...
21693 : !> \param prim ...
21694 : !> \param scale ...
21695 : ! **************************************************************************************************
21696 33242 : SUBROUTINE block_7_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21697 : INTEGER :: mc_max, md_max
21698 : REAL(KIND=dp) :: kbd(7*md_max), kbc(7*mc_max), kad(7*md_max), kac(7*mc_max), pbd(7*md_max), &
21699 : pbc(7*mc_max), pad(7*md_max), pac(7*mc_max), prim(7*7*mc_max*md_max), scale
21700 :
21701 : INTEGER :: ma, mb, mc, md, p_index
21702 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21703 :
21704 849512 : kbd(1:7*md_max) = 0.0_dp
21705 847447 : kbc(1:7*mc_max) = 0.0_dp
21706 849512 : kad(1:7*md_max) = 0.0_dp
21707 847447 : kac(1:7*mc_max) = 0.0_dp
21708 : p_index = 0
21709 149852 : DO md = 1, md_max
21710 563000 : DO mc = 1, mc_max
21711 3421794 : DO mb = 1, 7
21712 2892036 : ks_bd = 0.0_dp
21713 2892036 : ks_bc = 0.0_dp
21714 2892036 : p_bd = pbd((md - 1)*7 + mb)
21715 2892036 : p_bc = pbc((mc - 1)*7 + mb)
21716 23136288 : DO ma = 1, 7
21717 20244252 : p_index = p_index + 1
21718 20244252 : tmp = scale*prim(p_index)
21719 20244252 : ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21720 20244252 : ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21721 20244252 : kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21722 23136288 : kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21723 : END DO
21724 2892036 : kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
21725 3305184 : kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
21726 : END DO
21727 : END DO
21728 : END DO
21729 33242 : END SUBROUTINE block_7_7
21730 : ! **************************************************************************************************
21731 : !> \brief ...
21732 : !> \param mc_max ...
21733 : !> \param md_max ...
21734 : !> \param kbd ...
21735 : !> \param kbc ...
21736 : !> \param kad ...
21737 : !> \param kac ...
21738 : !> \param pbd ...
21739 : !> \param pbc ...
21740 : !> \param pad ...
21741 : !> \param pac ...
21742 : !> \param prim ...
21743 : !> \param scale ...
21744 : ! **************************************************************************************************
21745 196 : SUBROUTINE block_7_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21746 : INTEGER :: mc_max, md_max
21747 : REAL(KIND=dp) :: kbd(9*md_max), kbc(9*mc_max), kad(7*md_max), kac(7*mc_max), pbd(9*md_max), &
21748 : pbc(9*mc_max), pad(7*md_max), pac(7*mc_max), prim(7*9*mc_max*md_max), scale
21749 :
21750 : INTEGER :: ma, mb, mc, md, p_index
21751 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21752 :
21753 13498 : kbd(1:9*md_max) = 0.0_dp
21754 9304 : kbc(1:9*mc_max) = 0.0_dp
21755 10542 : kad(1:7*md_max) = 0.0_dp
21756 7280 : kac(1:7*mc_max) = 0.0_dp
21757 : p_index = 0
21758 1674 : DO md = 1, md_max
21759 10094 : DO mc = 1, mc_max
21760 85678 : DO mb = 1, 9
21761 75780 : ks_bd = 0.0_dp
21762 75780 : ks_bc = 0.0_dp
21763 75780 : p_bd = pbd((md - 1)*9 + mb)
21764 75780 : p_bc = pbc((mc - 1)*9 + mb)
21765 606240 : DO ma = 1, 7
21766 530460 : p_index = p_index + 1
21767 530460 : tmp = scale*prim(p_index)
21768 530460 : ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21769 530460 : ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21770 530460 : kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21771 606240 : kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21772 : END DO
21773 75780 : kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
21774 84200 : kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
21775 : END DO
21776 : END DO
21777 : END DO
21778 196 : END SUBROUTINE block_7_9
21779 : ! **************************************************************************************************
21780 : !> \brief ...
21781 : !> \param mc_max ...
21782 : !> \param md_max ...
21783 : !> \param kbd ...
21784 : !> \param kbc ...
21785 : !> \param kad ...
21786 : !> \param kac ...
21787 : !> \param pbd ...
21788 : !> \param pbc ...
21789 : !> \param pad ...
21790 : !> \param pac ...
21791 : !> \param prim ...
21792 : !> \param scale ...
21793 : ! **************************************************************************************************
21794 240 : SUBROUTINE block_7_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21795 : INTEGER :: mc_max, md_max
21796 : REAL(KIND=dp) :: kbd(10*md_max), kbc(10*mc_max), kad(7*md_max), kac(7*mc_max), &
21797 : pbd(10*md_max), pbc(10*mc_max), pad(7*md_max), pac(7*mc_max), prim(7*10*mc_max*md_max), &
21798 : scale
21799 :
21800 : INTEGER :: ma, mb, mc, md, p_index
21801 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21802 :
21803 18640 : kbd(1:10*md_max) = 0.0_dp
21804 13050 : kbc(1:10*mc_max) = 0.0_dp
21805 13120 : kad(1:7*md_max) = 0.0_dp
21806 9207 : kac(1:7*mc_max) = 0.0_dp
21807 : p_index = 0
21808 2080 : DO md = 1, md_max
21809 12759 : DO mc = 1, mc_max
21810 119309 : DO mb = 1, 10
21811 106790 : ks_bd = 0.0_dp
21812 106790 : ks_bc = 0.0_dp
21813 106790 : p_bd = pbd((md - 1)*10 + mb)
21814 106790 : p_bc = pbc((mc - 1)*10 + mb)
21815 854320 : DO ma = 1, 7
21816 747530 : p_index = p_index + 1
21817 747530 : tmp = scale*prim(p_index)
21818 747530 : ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21819 747530 : ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21820 747530 : kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21821 854320 : kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21822 : END DO
21823 106790 : kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
21824 117469 : kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
21825 : END DO
21826 : END DO
21827 : END DO
21828 240 : END SUBROUTINE block_7_10
21829 : ! **************************************************************************************************
21830 : !> \brief ...
21831 : !> \param mc_max ...
21832 : !> \param md_max ...
21833 : !> \param kbd ...
21834 : !> \param kbc ...
21835 : !> \param kad ...
21836 : !> \param kac ...
21837 : !> \param pbd ...
21838 : !> \param pbc ...
21839 : !> \param pad ...
21840 : !> \param pac ...
21841 : !> \param prim ...
21842 : !> \param scale ...
21843 : ! **************************************************************************************************
21844 279 : SUBROUTINE block_7_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21845 : INTEGER :: mc_max, md_max
21846 : REAL(KIND=dp) :: kbd(11*md_max), kbc(11*mc_max), kad(7*md_max), kac(7*mc_max), &
21847 : pbd(11*md_max), pbc(11*mc_max), pad(7*md_max), pac(7*mc_max), prim(7*11*mc_max*md_max), &
21848 : scale
21849 :
21850 : INTEGER :: ma, mb, mc, md, p_index
21851 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21852 :
21853 24545 : kbd(1:11*md_max) = 0.0_dp
21854 17274 : kbc(1:11*mc_max) = 0.0_dp
21855 15721 : kad(1:7*md_max) = 0.0_dp
21856 11094 : kac(1:7*mc_max) = 0.0_dp
21857 : p_index = 0
21858 2485 : DO md = 1, md_max
21859 15631 : DO mc = 1, mc_max
21860 159958 : DO mb = 1, 11
21861 144606 : ks_bd = 0.0_dp
21862 144606 : ks_bc = 0.0_dp
21863 144606 : p_bd = pbd((md - 1)*11 + mb)
21864 144606 : p_bc = pbc((mc - 1)*11 + mb)
21865 1156848 : DO ma = 1, 7
21866 1012242 : p_index = p_index + 1
21867 1012242 : tmp = scale*prim(p_index)
21868 1012242 : ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21869 1012242 : ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21870 1012242 : kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21871 1156848 : kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21872 : END DO
21873 144606 : kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
21874 157752 : kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
21875 : END DO
21876 : END DO
21877 : END DO
21878 279 : END SUBROUTINE block_7_11
21879 : ! **************************************************************************************************
21880 : !> \brief ...
21881 : !> \param mc_max ...
21882 : !> \param md_max ...
21883 : !> \param kbd ...
21884 : !> \param kbc ...
21885 : !> \param kad ...
21886 : !> \param kac ...
21887 : !> \param pbd ...
21888 : !> \param pbc ...
21889 : !> \param pad ...
21890 : !> \param pac ...
21891 : !> \param prim ...
21892 : !> \param scale ...
21893 : ! **************************************************************************************************
21894 276 : SUBROUTINE block_7_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21895 : INTEGER :: mc_max, md_max
21896 : REAL(KIND=dp) :: kbd(15*md_max), kbc(15*mc_max), kad(7*md_max), kac(7*mc_max), &
21897 : pbd(15*md_max), pbc(15*mc_max), pad(7*md_max), pac(7*mc_max), prim(7*15*mc_max*md_max), &
21898 : scale
21899 :
21900 : INTEGER :: ma, mb, mc, md, p_index
21901 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21902 :
21903 33381 : kbd(1:15*md_max) = 0.0_dp
21904 24036 : kbc(1:15*mc_max) = 0.0_dp
21905 15725 : kad(1:7*md_max) = 0.0_dp
21906 11364 : kac(1:7*mc_max) = 0.0_dp
21907 : p_index = 0
21908 2483 : DO md = 1, md_max
21909 16136 : DO mc = 1, mc_max
21910 220655 : DO mb = 1, 15
21911 204795 : ks_bd = 0.0_dp
21912 204795 : ks_bc = 0.0_dp
21913 204795 : p_bd = pbd((md - 1)*15 + mb)
21914 204795 : p_bc = pbc((mc - 1)*15 + mb)
21915 1638360 : DO ma = 1, 7
21916 1433565 : p_index = p_index + 1
21917 1433565 : tmp = scale*prim(p_index)
21918 1433565 : ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21919 1433565 : ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21920 1433565 : kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21921 1638360 : kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21922 : END DO
21923 204795 : kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
21924 218448 : kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
21925 : END DO
21926 : END DO
21927 : END DO
21928 276 : END SUBROUTINE block_7_15
21929 : ! **************************************************************************************************
21930 : !> \brief ...
21931 : !> \param kbd ...
21932 : !> \param kbc ...
21933 : !> \param kad ...
21934 : !> \param kac ...
21935 : !> \param pbd ...
21936 : !> \param pbc ...
21937 : !> \param pad ...
21938 : !> \param pac ...
21939 : !> \param prim ...
21940 : !> \param scale ...
21941 : ! **************************************************************************************************
21942 11 : SUBROUTINE block_9_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21943 : REAL(KIND=dp) :: kbd(1*1), kbc(1*1), kad(9*1), kac(9*1), &
21944 : pbd(1*1), pbc(1*1), pad(9*1), &
21945 : pac(9*1), prim(9*1*1*1), scale
21946 :
21947 : INTEGER :: ma, mb, mc, md, p_index
21948 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21949 :
21950 11 : kbd(1:1*1) = 0.0_dp
21951 11 : kbc(1:1*1) = 0.0_dp
21952 11 : kad(1:9*1) = 0.0_dp
21953 11 : kac(1:9*1) = 0.0_dp
21954 11 : p_index = 0
21955 22 : DO md = 1, 1
21956 33 : DO mc = 1, 1
21957 33 : DO mb = 1, 1
21958 11 : ks_bd = 0.0_dp
21959 11 : ks_bc = 0.0_dp
21960 11 : p_bd = pbd((md - 1)*1 + mb)
21961 11 : p_bc = pbc((mc - 1)*1 + mb)
21962 110 : DO ma = 1, 9
21963 99 : p_index = p_index + 1
21964 99 : tmp = scale*prim(p_index)
21965 99 : ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
21966 99 : ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
21967 99 : kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
21968 110 : kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
21969 : END DO
21970 11 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
21971 22 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
21972 : END DO
21973 : END DO
21974 : END DO
21975 11 : END SUBROUTINE block_9_1_1_1
21976 : ! **************************************************************************************************
21977 : !> \brief ...
21978 : !> \param kbd ...
21979 : !> \param kbc ...
21980 : !> \param kad ...
21981 : !> \param kac ...
21982 : !> \param pbd ...
21983 : !> \param pbc ...
21984 : !> \param pad ...
21985 : !> \param pac ...
21986 : !> \param prim ...
21987 : !> \param scale ...
21988 : ! **************************************************************************************************
21989 4 : SUBROUTINE block_9_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
21990 : REAL(KIND=dp) :: kbd(1*2), kbc(1*1), kad(9*2), kac(9*1), &
21991 : pbd(1*2), pbc(1*1), pad(9*2), &
21992 : pac(9*1), prim(9*1*1*2), scale
21993 :
21994 : INTEGER :: ma, mb, mc, md, p_index
21995 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
21996 :
21997 4 : kbd(1:1*2) = 0.0_dp
21998 4 : kbc(1:1*1) = 0.0_dp
21999 4 : kad(1:9*2) = 0.0_dp
22000 4 : kac(1:9*1) = 0.0_dp
22001 4 : p_index = 0
22002 12 : DO md = 1, 2
22003 20 : DO mc = 1, 1
22004 24 : DO mb = 1, 1
22005 8 : ks_bd = 0.0_dp
22006 8 : ks_bc = 0.0_dp
22007 8 : p_bd = pbd((md - 1)*1 + mb)
22008 8 : p_bc = pbc((mc - 1)*1 + mb)
22009 80 : DO ma = 1, 9
22010 72 : p_index = p_index + 1
22011 72 : tmp = scale*prim(p_index)
22012 72 : ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22013 72 : ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22014 72 : kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22015 80 : kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22016 : END DO
22017 8 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
22018 16 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
22019 : END DO
22020 : END DO
22021 : END DO
22022 4 : END SUBROUTINE block_9_1_1_2
22023 : ! **************************************************************************************************
22024 : !> \brief ...
22025 : !> \param md_max ...
22026 : !> \param kbd ...
22027 : !> \param kbc ...
22028 : !> \param kad ...
22029 : !> \param kac ...
22030 : !> \param pbd ...
22031 : !> \param pbc ...
22032 : !> \param pad ...
22033 : !> \param pac ...
22034 : !> \param prim ...
22035 : !> \param scale ...
22036 : ! **************************************************************************************************
22037 41 : SUBROUTINE block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22038 : INTEGER :: md_max
22039 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*1), kad(9*md_max), kac(9*1), pbd(1*md_max), pbc(1*1), &
22040 : pad(9*md_max), pac(9*1), prim(9*1*1*md_max), scale
22041 :
22042 : INTEGER :: ma, mb, mc, md, p_index
22043 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22044 :
22045 382 : kbd(1:1*md_max) = 0.0_dp
22046 41 : kbc(1:1*1) = 0.0_dp
22047 3110 : kad(1:9*md_max) = 0.0_dp
22048 41 : kac(1:9*1) = 0.0_dp
22049 41 : p_index = 0
22050 382 : DO md = 1, md_max
22051 723 : DO mc = 1, 1
22052 1023 : DO mb = 1, 1
22053 341 : ks_bd = 0.0_dp
22054 341 : ks_bc = 0.0_dp
22055 341 : p_bd = pbd((md - 1)*1 + mb)
22056 341 : p_bc = pbc((mc - 1)*1 + mb)
22057 3410 : DO ma = 1, 9
22058 3069 : p_index = p_index + 1
22059 3069 : tmp = scale*prim(p_index)
22060 3069 : ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22061 3069 : ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22062 3069 : kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22063 3410 : kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22064 : END DO
22065 341 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
22066 682 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
22067 : END DO
22068 : END DO
22069 : END DO
22070 41 : END SUBROUTINE block_9_1_1
22071 : ! **************************************************************************************************
22072 : !> \brief ...
22073 : !> \param kbd ...
22074 : !> \param kbc ...
22075 : !> \param kad ...
22076 : !> \param kac ...
22077 : !> \param pbd ...
22078 : !> \param pbc ...
22079 : !> \param pad ...
22080 : !> \param pac ...
22081 : !> \param prim ...
22082 : !> \param scale ...
22083 : ! **************************************************************************************************
22084 3 : SUBROUTINE block_9_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22085 : REAL(KIND=dp) :: kbd(1*1), kbc(1*2), kad(9*1), kac(9*2), &
22086 : pbd(1*1), pbc(1*2), pad(9*1), &
22087 : pac(9*2), prim(9*1*2*1), scale
22088 :
22089 : INTEGER :: ma, mb, mc, md, p_index
22090 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22091 :
22092 3 : kbd(1:1*1) = 0.0_dp
22093 3 : kbc(1:1*2) = 0.0_dp
22094 3 : kad(1:9*1) = 0.0_dp
22095 3 : kac(1:9*2) = 0.0_dp
22096 3 : p_index = 0
22097 6 : DO md = 1, 1
22098 12 : DO mc = 1, 2
22099 15 : DO mb = 1, 1
22100 6 : ks_bd = 0.0_dp
22101 6 : ks_bc = 0.0_dp
22102 6 : p_bd = pbd((md - 1)*1 + mb)
22103 6 : p_bc = pbc((mc - 1)*1 + mb)
22104 60 : DO ma = 1, 9
22105 54 : p_index = p_index + 1
22106 54 : tmp = scale*prim(p_index)
22107 54 : ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22108 54 : ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22109 54 : kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22110 60 : kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22111 : END DO
22112 6 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
22113 12 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
22114 : END DO
22115 : END DO
22116 : END DO
22117 3 : END SUBROUTINE block_9_1_2_1
22118 : ! **************************************************************************************************
22119 : !> \brief ...
22120 : !> \param md_max ...
22121 : !> \param kbd ...
22122 : !> \param kbc ...
22123 : !> \param kad ...
22124 : !> \param kac ...
22125 : !> \param pbd ...
22126 : !> \param pbc ...
22127 : !> \param pad ...
22128 : !> \param pac ...
22129 : !> \param prim ...
22130 : !> \param scale ...
22131 : ! **************************************************************************************************
22132 26 : SUBROUTINE block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22133 : INTEGER :: md_max
22134 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*2), kad(9*md_max), kac(9*2), pbd(1*md_max), pbc(1*2), &
22135 : pad(9*md_max), pac(9*2), prim(9*1*2*md_max), scale
22136 :
22137 : INTEGER :: ma, mb, mc, md, p_index
22138 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22139 :
22140 221 : kbd(1:1*md_max) = 0.0_dp
22141 26 : kbc(1:1*2) = 0.0_dp
22142 1781 : kad(1:9*md_max) = 0.0_dp
22143 26 : kac(1:9*2) = 0.0_dp
22144 26 : p_index = 0
22145 221 : DO md = 1, md_max
22146 611 : DO mc = 1, 2
22147 975 : DO mb = 1, 1
22148 390 : ks_bd = 0.0_dp
22149 390 : ks_bc = 0.0_dp
22150 390 : p_bd = pbd((md - 1)*1 + mb)
22151 390 : p_bc = pbc((mc - 1)*1 + mb)
22152 3900 : DO ma = 1, 9
22153 3510 : p_index = p_index + 1
22154 3510 : tmp = scale*prim(p_index)
22155 3510 : ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22156 3510 : ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22157 3510 : kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22158 3900 : kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22159 : END DO
22160 390 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
22161 780 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
22162 : END DO
22163 : END DO
22164 : END DO
22165 26 : END SUBROUTINE block_9_1_2
22166 : ! **************************************************************************************************
22167 : !> \brief ...
22168 : !> \param mc_max ...
22169 : !> \param md_max ...
22170 : !> \param kbd ...
22171 : !> \param kbc ...
22172 : !> \param kad ...
22173 : !> \param kac ...
22174 : !> \param pbd ...
22175 : !> \param pbc ...
22176 : !> \param pad ...
22177 : !> \param pac ...
22178 : !> \param prim ...
22179 : !> \param scale ...
22180 : ! **************************************************************************************************
22181 314 : SUBROUTINE block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22182 : INTEGER :: mc_max, md_max
22183 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*mc_max), kad(9*md_max), kac(9*mc_max), pbd(1*md_max), &
22184 : pbc(1*mc_max), pad(9*md_max), pac(9*mc_max), prim(9*1*mc_max*md_max), scale
22185 :
22186 : INTEGER :: ma, mb, mc, md, p_index
22187 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22188 :
22189 2813 : kbd(1:1*md_max) = 0.0_dp
22190 2792 : kbc(1:1*mc_max) = 0.0_dp
22191 22805 : kad(1:9*md_max) = 0.0_dp
22192 22616 : kac(1:9*mc_max) = 0.0_dp
22193 : p_index = 0
22194 2813 : DO md = 1, md_max
22195 23009 : DO mc = 1, mc_max
22196 42891 : DO mb = 1, 1
22197 20196 : ks_bd = 0.0_dp
22198 20196 : ks_bc = 0.0_dp
22199 20196 : p_bd = pbd((md - 1)*1 + mb)
22200 20196 : p_bc = pbc((mc - 1)*1 + mb)
22201 201960 : DO ma = 1, 9
22202 181764 : p_index = p_index + 1
22203 181764 : tmp = scale*prim(p_index)
22204 181764 : ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22205 181764 : ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22206 181764 : kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22207 201960 : kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22208 : END DO
22209 20196 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
22210 40392 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
22211 : END DO
22212 : END DO
22213 : END DO
22214 314 : END SUBROUTINE block_9_1
22215 : ! **************************************************************************************************
22216 : !> \brief ...
22217 : !> \param kbd ...
22218 : !> \param kbc ...
22219 : !> \param kad ...
22220 : !> \param kac ...
22221 : !> \param pbd ...
22222 : !> \param pbc ...
22223 : !> \param pad ...
22224 : !> \param pac ...
22225 : !> \param prim ...
22226 : !> \param scale ...
22227 : ! **************************************************************************************************
22228 2 : SUBROUTINE block_9_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22229 : REAL(KIND=dp) :: kbd(2*1), kbc(2*1), kad(9*1), kac(9*1), &
22230 : pbd(2*1), pbc(2*1), pad(9*1), &
22231 : pac(9*1), prim(9*2*1*1), scale
22232 :
22233 : INTEGER :: ma, mb, mc, md, p_index
22234 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22235 :
22236 2 : kbd(1:2*1) = 0.0_dp
22237 2 : kbc(1:2*1) = 0.0_dp
22238 2 : kad(1:9*1) = 0.0_dp
22239 2 : kac(1:9*1) = 0.0_dp
22240 2 : p_index = 0
22241 4 : DO md = 1, 1
22242 6 : DO mc = 1, 1
22243 8 : DO mb = 1, 2
22244 4 : ks_bd = 0.0_dp
22245 4 : ks_bc = 0.0_dp
22246 4 : p_bd = pbd((md - 1)*2 + mb)
22247 4 : p_bc = pbc((mc - 1)*2 + mb)
22248 40 : DO ma = 1, 9
22249 36 : p_index = p_index + 1
22250 36 : tmp = scale*prim(p_index)
22251 36 : ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22252 36 : ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22253 36 : kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22254 40 : kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22255 : END DO
22256 4 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
22257 6 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
22258 : END DO
22259 : END DO
22260 : END DO
22261 2 : END SUBROUTINE block_9_2_1_1
22262 : ! **************************************************************************************************
22263 : !> \brief ...
22264 : !> \param md_max ...
22265 : !> \param kbd ...
22266 : !> \param kbc ...
22267 : !> \param kad ...
22268 : !> \param kac ...
22269 : !> \param pbd ...
22270 : !> \param pbc ...
22271 : !> \param pad ...
22272 : !> \param pac ...
22273 : !> \param prim ...
22274 : !> \param scale ...
22275 : ! **************************************************************************************************
22276 10 : SUBROUTINE block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22277 : INTEGER :: md_max
22278 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*1), kad(9*md_max), kac(9*1), pbd(2*md_max), pbc(2*1), &
22279 : pad(9*md_max), pac(9*1), prim(9*2*1*md_max), scale
22280 :
22281 : INTEGER :: ma, mb, mc, md, p_index
22282 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22283 :
22284 154 : kbd(1:2*md_max) = 0.0_dp
22285 10 : kbc(1:2*1) = 0.0_dp
22286 658 : kad(1:9*md_max) = 0.0_dp
22287 10 : kac(1:9*1) = 0.0_dp
22288 10 : p_index = 0
22289 82 : DO md = 1, md_max
22290 154 : DO mc = 1, 1
22291 288 : DO mb = 1, 2
22292 144 : ks_bd = 0.0_dp
22293 144 : ks_bc = 0.0_dp
22294 144 : p_bd = pbd((md - 1)*2 + mb)
22295 144 : p_bc = pbc((mc - 1)*2 + mb)
22296 1440 : DO ma = 1, 9
22297 1296 : p_index = p_index + 1
22298 1296 : tmp = scale*prim(p_index)
22299 1296 : ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22300 1296 : ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22301 1296 : kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22302 1440 : kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22303 : END DO
22304 144 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
22305 216 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
22306 : END DO
22307 : END DO
22308 : END DO
22309 10 : END SUBROUTINE block_9_2_1
22310 : ! **************************************************************************************************
22311 : !> \brief ...
22312 : !> \param mc_max ...
22313 : !> \param md_max ...
22314 : !> \param kbd ...
22315 : !> \param kbc ...
22316 : !> \param kad ...
22317 : !> \param kac ...
22318 : !> \param pbd ...
22319 : !> \param pbc ...
22320 : !> \param pad ...
22321 : !> \param pac ...
22322 : !> \param prim ...
22323 : !> \param scale ...
22324 : ! **************************************************************************************************
22325 45 : SUBROUTINE block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22326 : INTEGER :: mc_max, md_max
22327 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*mc_max), kad(9*md_max), kac(9*mc_max), pbd(2*md_max), &
22328 : pbc(2*mc_max), pad(9*md_max), pac(9*mc_max), prim(9*2*mc_max*md_max), scale
22329 :
22330 : INTEGER :: ma, mb, mc, md, p_index
22331 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22332 :
22333 561 : kbd(1:2*md_max) = 0.0_dp
22334 997 : kbc(1:2*mc_max) = 0.0_dp
22335 2367 : kad(1:9*md_max) = 0.0_dp
22336 4329 : kac(1:9*mc_max) = 0.0_dp
22337 : p_index = 0
22338 303 : DO md = 1, md_max
22339 3110 : DO mc = 1, mc_max
22340 8679 : DO mb = 1, 2
22341 5614 : ks_bd = 0.0_dp
22342 5614 : ks_bc = 0.0_dp
22343 5614 : p_bd = pbd((md - 1)*2 + mb)
22344 5614 : p_bc = pbc((mc - 1)*2 + mb)
22345 56140 : DO ma = 1, 9
22346 50526 : p_index = p_index + 1
22347 50526 : tmp = scale*prim(p_index)
22348 50526 : ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22349 50526 : ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22350 50526 : kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22351 56140 : kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22352 : END DO
22353 5614 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
22354 8421 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
22355 : END DO
22356 : END DO
22357 : END DO
22358 45 : END SUBROUTINE block_9_2
22359 : ! **************************************************************************************************
22360 : !> \brief ...
22361 : !> \param mc_max ...
22362 : !> \param md_max ...
22363 : !> \param kbd ...
22364 : !> \param kbc ...
22365 : !> \param kad ...
22366 : !> \param kac ...
22367 : !> \param pbd ...
22368 : !> \param pbc ...
22369 : !> \param pad ...
22370 : !> \param pac ...
22371 : !> \param prim ...
22372 : !> \param scale ...
22373 : ! **************************************************************************************************
22374 583 : SUBROUTINE block_9_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22375 : INTEGER :: mc_max, md_max
22376 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*mc_max), kad(9*md_max), kac(9*mc_max), pbd(3*md_max), &
22377 : pbc(3*mc_max), pad(9*md_max), pac(9*mc_max), prim(9*3*mc_max*md_max), scale
22378 :
22379 : INTEGER :: ma, mb, mc, md, p_index
22380 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22381 :
22382 9340 : kbd(1:3*md_max) = 0.0_dp
22383 11227 : kbc(1:3*mc_max) = 0.0_dp
22384 26854 : kad(1:9*md_max) = 0.0_dp
22385 32515 : kac(1:9*mc_max) = 0.0_dp
22386 : p_index = 0
22387 3502 : DO md = 1, md_max
22388 21636 : DO mc = 1, mc_max
22389 75455 : DO mb = 1, 3
22390 54402 : ks_bd = 0.0_dp
22391 54402 : ks_bc = 0.0_dp
22392 54402 : p_bd = pbd((md - 1)*3 + mb)
22393 54402 : p_bc = pbc((mc - 1)*3 + mb)
22394 544020 : DO ma = 1, 9
22395 489618 : p_index = p_index + 1
22396 489618 : tmp = scale*prim(p_index)
22397 489618 : ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22398 489618 : ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22399 489618 : kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22400 544020 : kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22401 : END DO
22402 54402 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
22403 72536 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
22404 : END DO
22405 : END DO
22406 : END DO
22407 583 : END SUBROUTINE block_9_3
22408 : ! **************************************************************************************************
22409 : !> \brief ...
22410 : !> \param mc_max ...
22411 : !> \param md_max ...
22412 : !> \param kbd ...
22413 : !> \param kbc ...
22414 : !> \param kad ...
22415 : !> \param kac ...
22416 : !> \param pbd ...
22417 : !> \param pbc ...
22418 : !> \param pad ...
22419 : !> \param pac ...
22420 : !> \param prim ...
22421 : !> \param scale ...
22422 : ! **************************************************************************************************
22423 45 : SUBROUTINE block_9_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22424 : INTEGER :: mc_max, md_max
22425 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*mc_max), kad(9*md_max), kac(9*mc_max), pbd(4*md_max), &
22426 : pbc(4*mc_max), pad(9*md_max), pac(9*mc_max), prim(9*4*mc_max*md_max), scale
22427 :
22428 : INTEGER :: ma, mb, mc, md, p_index
22429 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22430 :
22431 1233 : kbd(1:4*md_max) = 0.0_dp
22432 1573 : kbc(1:4*mc_max) = 0.0_dp
22433 2718 : kad(1:9*md_max) = 0.0_dp
22434 3483 : kac(1:9*mc_max) = 0.0_dp
22435 : p_index = 0
22436 342 : DO md = 1, md_max
22437 2952 : DO mc = 1, mc_max
22438 13347 : DO mb = 1, 4
22439 10440 : ks_bd = 0.0_dp
22440 10440 : ks_bc = 0.0_dp
22441 10440 : p_bd = pbd((md - 1)*4 + mb)
22442 10440 : p_bc = pbc((mc - 1)*4 + mb)
22443 104400 : DO ma = 1, 9
22444 93960 : p_index = p_index + 1
22445 93960 : tmp = scale*prim(p_index)
22446 93960 : ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22447 93960 : ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22448 93960 : kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22449 104400 : kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22450 : END DO
22451 10440 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
22452 13050 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
22453 : END DO
22454 : END DO
22455 : END DO
22456 45 : END SUBROUTINE block_9_4
22457 : ! **************************************************************************************************
22458 : !> \brief ...
22459 : !> \param mc_max ...
22460 : !> \param md_max ...
22461 : !> \param kbd ...
22462 : !> \param kbc ...
22463 : !> \param kad ...
22464 : !> \param kac ...
22465 : !> \param pbd ...
22466 : !> \param pbc ...
22467 : !> \param pad ...
22468 : !> \param pac ...
22469 : !> \param prim ...
22470 : !> \param scale ...
22471 : ! **************************************************************************************************
22472 75 : SUBROUTINE block_9_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22473 : INTEGER :: mc_max, md_max
22474 : REAL(KIND=dp) :: kbd(5*md_max), kbc(5*mc_max), kad(9*md_max), kac(9*mc_max), pbd(5*md_max), &
22475 : pbc(5*mc_max), pad(9*md_max), pac(9*mc_max), prim(9*5*mc_max*md_max), scale
22476 :
22477 : INTEGER :: ma, mb, mc, md, p_index
22478 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22479 :
22480 2545 : kbd(1:5*md_max) = 0.0_dp
22481 2315 : kbc(1:5*mc_max) = 0.0_dp
22482 4521 : kad(1:9*md_max) = 0.0_dp
22483 4107 : kac(1:9*mc_max) = 0.0_dp
22484 : p_index = 0
22485 569 : DO md = 1, md_max
22486 3733 : DO mc = 1, mc_max
22487 19478 : DO mb = 1, 5
22488 15820 : ks_bd = 0.0_dp
22489 15820 : ks_bc = 0.0_dp
22490 15820 : p_bd = pbd((md - 1)*5 + mb)
22491 15820 : p_bc = pbc((mc - 1)*5 + mb)
22492 158200 : DO ma = 1, 9
22493 142380 : p_index = p_index + 1
22494 142380 : tmp = scale*prim(p_index)
22495 142380 : ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22496 142380 : ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22497 142380 : kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22498 158200 : kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22499 : END DO
22500 15820 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
22501 18984 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
22502 : END DO
22503 : END DO
22504 : END DO
22505 75 : END SUBROUTINE block_9_5
22506 : ! **************************************************************************************************
22507 : !> \brief ...
22508 : !> \param mc_max ...
22509 : !> \param md_max ...
22510 : !> \param kbd ...
22511 : !> \param kbc ...
22512 : !> \param kad ...
22513 : !> \param kac ...
22514 : !> \param pbd ...
22515 : !> \param pbc ...
22516 : !> \param pad ...
22517 : !> \param pac ...
22518 : !> \param prim ...
22519 : !> \param scale ...
22520 : ! **************************************************************************************************
22521 76 : SUBROUTINE block_9_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22522 : INTEGER :: mc_max, md_max
22523 : REAL(KIND=dp) :: kbd(6*md_max), kbc(6*mc_max), kad(9*md_max), kac(9*mc_max), pbd(6*md_max), &
22524 : pbc(6*mc_max), pad(9*md_max), pac(9*mc_max), prim(9*6*mc_max*md_max), scale
22525 :
22526 : INTEGER :: ma, mb, mc, md, p_index
22527 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22528 :
22529 3214 : kbd(1:6*md_max) = 0.0_dp
22530 2632 : kbc(1:6*mc_max) = 0.0_dp
22531 4783 : kad(1:9*md_max) = 0.0_dp
22532 3910 : kac(1:9*mc_max) = 0.0_dp
22533 : p_index = 0
22534 599 : DO md = 1, md_max
22535 3760 : DO mc = 1, mc_max
22536 22650 : DO mb = 1, 6
22537 18966 : ks_bd = 0.0_dp
22538 18966 : ks_bc = 0.0_dp
22539 18966 : p_bd = pbd((md - 1)*6 + mb)
22540 18966 : p_bc = pbc((mc - 1)*6 + mb)
22541 189660 : DO ma = 1, 9
22542 170694 : p_index = p_index + 1
22543 170694 : tmp = scale*prim(p_index)
22544 170694 : ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22545 170694 : ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22546 170694 : kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22547 189660 : kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22548 : END DO
22549 18966 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
22550 22127 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
22551 : END DO
22552 : END DO
22553 : END DO
22554 76 : END SUBROUTINE block_9_6
22555 : ! **************************************************************************************************
22556 : !> \brief ...
22557 : !> \param mc_max ...
22558 : !> \param md_max ...
22559 : !> \param kbd ...
22560 : !> \param kbc ...
22561 : !> \param kad ...
22562 : !> \param kac ...
22563 : !> \param pbd ...
22564 : !> \param pbc ...
22565 : !> \param pad ...
22566 : !> \param pac ...
22567 : !> \param prim ...
22568 : !> \param scale ...
22569 : ! **************************************************************************************************
22570 45 : SUBROUTINE block_9_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22571 : INTEGER :: mc_max, md_max
22572 : REAL(KIND=dp) :: kbd(7*md_max), kbc(7*mc_max), kad(9*md_max), kac(9*mc_max), pbd(7*md_max), &
22573 : pbc(7*mc_max), pad(9*md_max), pac(9*mc_max), prim(9*7*mc_max*md_max), scale
22574 :
22575 : INTEGER :: ma, mb, mc, md, p_index
22576 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22577 :
22578 2789 : kbd(1:7*md_max) = 0.0_dp
22579 2719 : kbc(1:7*mc_max) = 0.0_dp
22580 3573 : kad(1:9*md_max) = 0.0_dp
22581 3483 : kac(1:9*mc_max) = 0.0_dp
22582 : p_index = 0
22583 437 : DO md = 1, md_max
22584 3880 : DO mc = 1, mc_max
22585 27936 : DO mb = 1, 7
22586 24101 : ks_bd = 0.0_dp
22587 24101 : ks_bc = 0.0_dp
22588 24101 : p_bd = pbd((md - 1)*7 + mb)
22589 24101 : p_bc = pbc((mc - 1)*7 + mb)
22590 241010 : DO ma = 1, 9
22591 216909 : p_index = p_index + 1
22592 216909 : tmp = scale*prim(p_index)
22593 216909 : ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22594 216909 : ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22595 216909 : kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22596 241010 : kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22597 : END DO
22598 24101 : kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
22599 27544 : kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
22600 : END DO
22601 : END DO
22602 : END DO
22603 45 : END SUBROUTINE block_9_7
22604 : ! **************************************************************************************************
22605 : !> \brief ...
22606 : !> \param mc_max ...
22607 : !> \param md_max ...
22608 : !> \param kbd ...
22609 : !> \param kbc ...
22610 : !> \param kad ...
22611 : !> \param kac ...
22612 : !> \param pbd ...
22613 : !> \param pbc ...
22614 : !> \param pad ...
22615 : !> \param pac ...
22616 : !> \param prim ...
22617 : !> \param scale ...
22618 : ! **************************************************************************************************
22619 362 : SUBROUTINE block_9_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22620 : INTEGER :: mc_max, md_max
22621 : REAL(KIND=dp) :: kbd(9*md_max), kbc(9*mc_max), kad(9*md_max), kac(9*mc_max), pbd(9*md_max), &
22622 : pbc(9*mc_max), pad(9*md_max), pac(9*mc_max), prim(9*9*mc_max*md_max), scale
22623 :
22624 : INTEGER :: ma, mb, mc, md, p_index
22625 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22626 :
22627 23978 : kbd(1:9*md_max) = 0.0_dp
22628 19082 : kbc(1:9*mc_max) = 0.0_dp
22629 23978 : kad(1:9*md_max) = 0.0_dp
22630 19082 : kac(1:9*mc_max) = 0.0_dp
22631 : p_index = 0
22632 2986 : DO md = 1, md_max
22633 19135 : DO mc = 1, mc_max
22634 164114 : DO mb = 1, 9
22635 145341 : ks_bd = 0.0_dp
22636 145341 : ks_bc = 0.0_dp
22637 145341 : p_bd = pbd((md - 1)*9 + mb)
22638 145341 : p_bc = pbc((mc - 1)*9 + mb)
22639 1453410 : DO ma = 1, 9
22640 1308069 : p_index = p_index + 1
22641 1308069 : tmp = scale*prim(p_index)
22642 1308069 : ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22643 1308069 : ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22644 1308069 : kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22645 1453410 : kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22646 : END DO
22647 145341 : kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
22648 161490 : kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
22649 : END DO
22650 : END DO
22651 : END DO
22652 362 : END SUBROUTINE block_9_9
22653 : ! **************************************************************************************************
22654 : !> \brief ...
22655 : !> \param mc_max ...
22656 : !> \param md_max ...
22657 : !> \param kbd ...
22658 : !> \param kbc ...
22659 : !> \param kad ...
22660 : !> \param kac ...
22661 : !> \param pbd ...
22662 : !> \param pbc ...
22663 : !> \param pad ...
22664 : !> \param pac ...
22665 : !> \param prim ...
22666 : !> \param scale ...
22667 : ! **************************************************************************************************
22668 213 : SUBROUTINE block_9_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22669 : INTEGER :: mc_max, md_max
22670 : REAL(KIND=dp) :: kbd(10*md_max), kbc(10*mc_max), kad(9*md_max), kac(9*mc_max), &
22671 : pbd(10*md_max), pbc(10*mc_max), pad(9*md_max), pac(9*mc_max), prim(9*10*mc_max*md_max), &
22672 : scale
22673 :
22674 : INTEGER :: ma, mb, mc, md, p_index
22675 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22676 :
22677 17083 : kbd(1:10*md_max) = 0.0_dp
22678 13073 : kbc(1:10*mc_max) = 0.0_dp
22679 15396 : kad(1:9*md_max) = 0.0_dp
22680 11787 : kac(1:9*mc_max) = 0.0_dp
22681 : p_index = 0
22682 1900 : DO md = 1, md_max
22683 12804 : DO mc = 1, mc_max
22684 121631 : DO mb = 1, 10
22685 109040 : ks_bd = 0.0_dp
22686 109040 : ks_bc = 0.0_dp
22687 109040 : p_bd = pbd((md - 1)*10 + mb)
22688 109040 : p_bc = pbc((mc - 1)*10 + mb)
22689 1090400 : DO ma = 1, 9
22690 981360 : p_index = p_index + 1
22691 981360 : tmp = scale*prim(p_index)
22692 981360 : ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22693 981360 : ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22694 981360 : kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22695 1090400 : kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22696 : END DO
22697 109040 : kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
22698 119944 : kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
22699 : END DO
22700 : END DO
22701 : END DO
22702 213 : END SUBROUTINE block_9_10
22703 : ! **************************************************************************************************
22704 : !> \brief ...
22705 : !> \param mc_max ...
22706 : !> \param md_max ...
22707 : !> \param kbd ...
22708 : !> \param kbc ...
22709 : !> \param kad ...
22710 : !> \param kac ...
22711 : !> \param pbd ...
22712 : !> \param pbc ...
22713 : !> \param pad ...
22714 : !> \param pac ...
22715 : !> \param prim ...
22716 : !> \param scale ...
22717 : ! **************************************************************************************************
22718 308 : SUBROUTINE block_9_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22719 : INTEGER :: mc_max, md_max
22720 : REAL(KIND=dp) :: kbd(11*md_max), kbc(11*mc_max), kad(9*md_max), kac(9*mc_max), &
22721 : pbd(11*md_max), pbc(11*mc_max), pad(9*md_max), pac(9*mc_max), prim(9*11*mc_max*md_max), &
22722 : scale
22723 :
22724 : INTEGER :: ma, mb, mc, md, p_index
22725 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22726 :
22727 27434 : kbd(1:11*md_max) = 0.0_dp
22728 20053 : kbc(1:11*mc_max) = 0.0_dp
22729 22502 : kad(1:9*md_max) = 0.0_dp
22730 16463 : kac(1:9*mc_max) = 0.0_dp
22731 : p_index = 0
22732 2774 : DO md = 1, md_max
22733 18309 : DO mc = 1, mc_max
22734 188886 : DO mb = 1, 11
22735 170885 : ks_bd = 0.0_dp
22736 170885 : ks_bc = 0.0_dp
22737 170885 : p_bd = pbd((md - 1)*11 + mb)
22738 170885 : p_bc = pbc((mc - 1)*11 + mb)
22739 1708850 : DO ma = 1, 9
22740 1537965 : p_index = p_index + 1
22741 1537965 : tmp = scale*prim(p_index)
22742 1537965 : ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22743 1537965 : ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22744 1537965 : kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22745 1708850 : kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22746 : END DO
22747 170885 : kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
22748 186420 : kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
22749 : END DO
22750 : END DO
22751 : END DO
22752 308 : END SUBROUTINE block_9_11
22753 : ! **************************************************************************************************
22754 : !> \brief ...
22755 : !> \param mc_max ...
22756 : !> \param md_max ...
22757 : !> \param kbd ...
22758 : !> \param kbc ...
22759 : !> \param kad ...
22760 : !> \param kac ...
22761 : !> \param pbd ...
22762 : !> \param pbc ...
22763 : !> \param pad ...
22764 : !> \param pac ...
22765 : !> \param prim ...
22766 : !> \param scale ...
22767 : ! **************************************************************************************************
22768 305 : SUBROUTINE block_9_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22769 : INTEGER :: mc_max, md_max
22770 : REAL(KIND=dp) :: kbd(15*md_max), kbc(15*mc_max), kad(9*md_max), kac(9*mc_max), &
22771 : pbd(15*md_max), pbc(15*mc_max), pad(9*md_max), pac(9*mc_max), prim(9*15*mc_max*md_max), &
22772 : scale
22773 :
22774 : INTEGER :: ma, mb, mc, md, p_index
22775 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22776 :
22777 37520 : kbd(1:15*md_max) = 0.0_dp
22778 27185 : kbc(1:15*mc_max) = 0.0_dp
22779 22634 : kad(1:9*md_max) = 0.0_dp
22780 16433 : kac(1:9*mc_max) = 0.0_dp
22781 : p_index = 0
22782 2786 : DO md = 1, md_max
22783 18648 : DO mc = 1, mc_max
22784 256273 : DO mb = 1, 15
22785 237930 : ks_bd = 0.0_dp
22786 237930 : ks_bc = 0.0_dp
22787 237930 : p_bd = pbd((md - 1)*15 + mb)
22788 237930 : p_bc = pbc((mc - 1)*15 + mb)
22789 2379300 : DO ma = 1, 9
22790 2141370 : p_index = p_index + 1
22791 2141370 : tmp = scale*prim(p_index)
22792 2141370 : ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22793 2141370 : ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22794 2141370 : kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22795 2379300 : kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22796 : END DO
22797 237930 : kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
22798 253792 : kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
22799 : END DO
22800 : END DO
22801 : END DO
22802 305 : END SUBROUTINE block_9_15
22803 : ! **************************************************************************************************
22804 : !> \brief ...
22805 : !> \param kbd ...
22806 : !> \param kbc ...
22807 : !> \param kad ...
22808 : !> \param kac ...
22809 : !> \param pbd ...
22810 : !> \param pbc ...
22811 : !> \param pad ...
22812 : !> \param pac ...
22813 : !> \param prim ...
22814 : !> \param scale ...
22815 : ! **************************************************************************************************
22816 9 : SUBROUTINE block_10_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22817 : REAL(KIND=dp) :: kbd(1*1), kbc(1*1), kad(10*1), &
22818 : kac(10*1), pbd(1*1), pbc(1*1), &
22819 : pad(10*1), pac(10*1), prim(10*1*1*1), &
22820 : scale
22821 :
22822 : INTEGER :: ma, mb, mc, md, p_index
22823 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22824 :
22825 9 : kbd(1:1*1) = 0.0_dp
22826 9 : kbc(1:1*1) = 0.0_dp
22827 9 : kad(1:10*1) = 0.0_dp
22828 9 : kac(1:10*1) = 0.0_dp
22829 9 : p_index = 0
22830 18 : DO md = 1, 1
22831 27 : DO mc = 1, 1
22832 27 : DO mb = 1, 1
22833 9 : ks_bd = 0.0_dp
22834 9 : ks_bc = 0.0_dp
22835 9 : p_bd = pbd((md - 1)*1 + mb)
22836 9 : p_bc = pbc((mc - 1)*1 + mb)
22837 99 : DO ma = 1, 10
22838 90 : p_index = p_index + 1
22839 90 : tmp = scale*prim(p_index)
22840 90 : ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
22841 90 : ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
22842 90 : kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
22843 99 : kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
22844 : END DO
22845 9 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
22846 18 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
22847 : END DO
22848 : END DO
22849 : END DO
22850 9 : END SUBROUTINE block_10_1_1_1
22851 : ! **************************************************************************************************
22852 : !> \brief ...
22853 : !> \param md_max ...
22854 : !> \param kbd ...
22855 : !> \param kbc ...
22856 : !> \param kad ...
22857 : !> \param kac ...
22858 : !> \param pbd ...
22859 : !> \param pbc ...
22860 : !> \param pad ...
22861 : !> \param pac ...
22862 : !> \param prim ...
22863 : !> \param scale ...
22864 : ! **************************************************************************************************
22865 38 : SUBROUTINE block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22866 : INTEGER :: md_max
22867 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*1), kad(10*md_max), kac(10*1), pbd(1*md_max), &
22868 : pbc(1*1), pad(10*md_max), pac(10*1), prim(10*1*1*md_max), scale
22869 :
22870 : INTEGER :: ma, mb, mc, md, p_index
22871 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22872 :
22873 332 : kbd(1:1*md_max) = 0.0_dp
22874 38 : kbc(1:1*1) = 0.0_dp
22875 2978 : kad(1:10*md_max) = 0.0_dp
22876 38 : kac(1:10*1) = 0.0_dp
22877 38 : p_index = 0
22878 332 : DO md = 1, md_max
22879 626 : DO mc = 1, 1
22880 882 : DO mb = 1, 1
22881 294 : ks_bd = 0.0_dp
22882 294 : ks_bc = 0.0_dp
22883 294 : p_bd = pbd((md - 1)*1 + mb)
22884 294 : p_bc = pbc((mc - 1)*1 + mb)
22885 3234 : DO ma = 1, 10
22886 2940 : p_index = p_index + 1
22887 2940 : tmp = scale*prim(p_index)
22888 2940 : ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
22889 2940 : ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
22890 2940 : kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
22891 3234 : kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
22892 : END DO
22893 294 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
22894 588 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
22895 : END DO
22896 : END DO
22897 : END DO
22898 38 : END SUBROUTINE block_10_1_1
22899 : ! **************************************************************************************************
22900 : !> \brief ...
22901 : !> \param mc_max ...
22902 : !> \param md_max ...
22903 : !> \param kbd ...
22904 : !> \param kbc ...
22905 : !> \param kad ...
22906 : !> \param kac ...
22907 : !> \param pbd ...
22908 : !> \param pbc ...
22909 : !> \param pad ...
22910 : !> \param pac ...
22911 : !> \param prim ...
22912 : !> \param scale ...
22913 : ! **************************************************************************************************
22914 302 : SUBROUTINE block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22915 : INTEGER :: mc_max, md_max
22916 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*mc_max), kad(10*md_max), kac(10*mc_max), &
22917 : pbd(1*md_max), pbc(1*mc_max), pad(10*md_max), pac(10*mc_max), prim(10*1*mc_max*md_max), &
22918 : scale
22919 :
22920 : INTEGER :: ma, mb, mc, md, p_index
22921 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22922 :
22923 2757 : kbd(1:1*md_max) = 0.0_dp
22924 2696 : kbc(1:1*mc_max) = 0.0_dp
22925 24852 : kad(1:10*md_max) = 0.0_dp
22926 24242 : kac(1:10*mc_max) = 0.0_dp
22927 : p_index = 0
22928 2757 : DO md = 1, md_max
22929 22684 : DO mc = 1, mc_max
22930 42309 : DO mb = 1, 1
22931 19927 : ks_bd = 0.0_dp
22932 19927 : ks_bc = 0.0_dp
22933 19927 : p_bd = pbd((md - 1)*1 + mb)
22934 19927 : p_bc = pbc((mc - 1)*1 + mb)
22935 219197 : DO ma = 1, 10
22936 199270 : p_index = p_index + 1
22937 199270 : tmp = scale*prim(p_index)
22938 199270 : ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
22939 199270 : ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
22940 199270 : kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
22941 219197 : kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
22942 : END DO
22943 19927 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
22944 39854 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
22945 : END DO
22946 : END DO
22947 : END DO
22948 302 : END SUBROUTINE block_10_1
22949 : ! **************************************************************************************************
22950 : !> \brief ...
22951 : !> \param mc_max ...
22952 : !> \param md_max ...
22953 : !> \param kbd ...
22954 : !> \param kbc ...
22955 : !> \param kad ...
22956 : !> \param kac ...
22957 : !> \param pbd ...
22958 : !> \param pbc ...
22959 : !> \param pad ...
22960 : !> \param pac ...
22961 : !> \param prim ...
22962 : !> \param scale ...
22963 : ! **************************************************************************************************
22964 52 : SUBROUTINE block_10_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
22965 : INTEGER :: mc_max, md_max
22966 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*mc_max), kad(10*md_max), kac(10*mc_max), &
22967 : pbd(2*md_max), pbc(2*mc_max), pad(10*md_max), pac(10*mc_max), prim(10*2*mc_max*md_max), &
22968 : scale
22969 :
22970 : INTEGER :: ma, mb, mc, md, p_index
22971 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
22972 :
22973 686 : kbd(1:2*md_max) = 0.0_dp
22974 952 : kbc(1:2*mc_max) = 0.0_dp
22975 3222 : kad(1:10*md_max) = 0.0_dp
22976 4552 : kac(1:10*mc_max) = 0.0_dp
22977 : p_index = 0
22978 369 : DO md = 1, md_max
22979 3151 : DO mc = 1, mc_max
22980 8663 : DO mb = 1, 2
22981 5564 : ks_bd = 0.0_dp
22982 5564 : ks_bc = 0.0_dp
22983 5564 : p_bd = pbd((md - 1)*2 + mb)
22984 5564 : p_bc = pbc((mc - 1)*2 + mb)
22985 61204 : DO ma = 1, 10
22986 55640 : p_index = p_index + 1
22987 55640 : tmp = scale*prim(p_index)
22988 55640 : ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
22989 55640 : ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
22990 55640 : kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
22991 61204 : kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
22992 : END DO
22993 5564 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
22994 8346 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
22995 : END DO
22996 : END DO
22997 : END DO
22998 52 : END SUBROUTINE block_10_2
22999 : ! **************************************************************************************************
23000 : !> \brief ...
23001 : !> \param mc_max ...
23002 : !> \param md_max ...
23003 : !> \param kbd ...
23004 : !> \param kbc ...
23005 : !> \param kad ...
23006 : !> \param kac ...
23007 : !> \param pbd ...
23008 : !> \param pbc ...
23009 : !> \param pad ...
23010 : !> \param pac ...
23011 : !> \param prim ...
23012 : !> \param scale ...
23013 : ! **************************************************************************************************
23014 46 : SUBROUTINE block_10_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23015 : INTEGER :: mc_max, md_max
23016 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*mc_max), kad(10*md_max), kac(10*mc_max), &
23017 : pbd(3*md_max), pbc(3*mc_max), pad(10*md_max), pac(10*mc_max), prim(10*3*mc_max*md_max), &
23018 : scale
23019 :
23020 : INTEGER :: ma, mb, mc, md, p_index
23021 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23022 :
23023 946 : kbd(1:3*md_max) = 0.0_dp
23024 1222 : kbc(1:3*mc_max) = 0.0_dp
23025 3046 : kad(1:10*md_max) = 0.0_dp
23026 3966 : kac(1:10*mc_max) = 0.0_dp
23027 : p_index = 0
23028 346 : DO md = 1, md_max
23029 2986 : DO mc = 1, mc_max
23030 10860 : DO mb = 1, 3
23031 7920 : ks_bd = 0.0_dp
23032 7920 : ks_bc = 0.0_dp
23033 7920 : p_bd = pbd((md - 1)*3 + mb)
23034 7920 : p_bc = pbc((mc - 1)*3 + mb)
23035 87120 : DO ma = 1, 10
23036 79200 : p_index = p_index + 1
23037 79200 : tmp = scale*prim(p_index)
23038 79200 : ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
23039 79200 : ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
23040 79200 : kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
23041 87120 : kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
23042 : END DO
23043 7920 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
23044 10560 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
23045 : END DO
23046 : END DO
23047 : END DO
23048 46 : END SUBROUTINE block_10_3
23049 : ! **************************************************************************************************
23050 : !> \brief ...
23051 : !> \param mc_max ...
23052 : !> \param md_max ...
23053 : !> \param kbd ...
23054 : !> \param kbc ...
23055 : !> \param kad ...
23056 : !> \param kac ...
23057 : !> \param pbd ...
23058 : !> \param pbc ...
23059 : !> \param pad ...
23060 : !> \param pac ...
23061 : !> \param prim ...
23062 : !> \param scale ...
23063 : ! **************************************************************************************************
23064 39 : SUBROUTINE block_10_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23065 : INTEGER :: mc_max, md_max
23066 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*mc_max), kad(10*md_max), kac(10*mc_max), &
23067 : pbd(4*md_max), pbc(4*mc_max), pad(10*md_max), pac(10*mc_max), prim(10*4*mc_max*md_max), &
23068 : scale
23069 :
23070 : INTEGER :: ma, mb, mc, md, p_index
23071 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23072 :
23073 1143 : kbd(1:4*md_max) = 0.0_dp
23074 1371 : kbc(1:4*mc_max) = 0.0_dp
23075 2799 : kad(1:10*md_max) = 0.0_dp
23076 3369 : kac(1:10*mc_max) = 0.0_dp
23077 : p_index = 0
23078 315 : DO md = 1, md_max
23079 2754 : DO mc = 1, mc_max
23080 12471 : DO mb = 1, 4
23081 9756 : ks_bd = 0.0_dp
23082 9756 : ks_bc = 0.0_dp
23083 9756 : p_bd = pbd((md - 1)*4 + mb)
23084 9756 : p_bc = pbc((mc - 1)*4 + mb)
23085 107316 : DO ma = 1, 10
23086 97560 : p_index = p_index + 1
23087 97560 : tmp = scale*prim(p_index)
23088 97560 : ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
23089 97560 : ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
23090 97560 : kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
23091 107316 : kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
23092 : END DO
23093 9756 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
23094 12195 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
23095 : END DO
23096 : END DO
23097 : END DO
23098 39 : END SUBROUTINE block_10_4
23099 : ! **************************************************************************************************
23100 : !> \brief ...
23101 : !> \param mc_max ...
23102 : !> \param md_max ...
23103 : !> \param kbd ...
23104 : !> \param kbc ...
23105 : !> \param kad ...
23106 : !> \param kac ...
23107 : !> \param pbd ...
23108 : !> \param pbc ...
23109 : !> \param pad ...
23110 : !> \param pac ...
23111 : !> \param prim ...
23112 : !> \param scale ...
23113 : ! **************************************************************************************************
23114 33 : SUBROUTINE block_10_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23115 : INTEGER :: mc_max, md_max
23116 : REAL(KIND=dp) :: kbd(5*md_max), kbc(5*mc_max), kad(10*md_max), kac(10*mc_max), &
23117 : pbd(5*md_max), pbc(5*mc_max), pad(10*md_max), pac(10*mc_max), prim(10*5*mc_max*md_max), &
23118 : scale
23119 :
23120 : INTEGER :: ma, mb, mc, md, p_index
23121 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23122 :
23123 1293 : kbd(1:5*md_max) = 0.0_dp
23124 1433 : kbc(1:5*mc_max) = 0.0_dp
23125 2553 : kad(1:10*md_max) = 0.0_dp
23126 2833 : kac(1:10*mc_max) = 0.0_dp
23127 : p_index = 0
23128 285 : DO md = 1, md_max
23129 2506 : DO mc = 1, mc_max
23130 13578 : DO mb = 1, 5
23131 11105 : ks_bd = 0.0_dp
23132 11105 : ks_bc = 0.0_dp
23133 11105 : p_bd = pbd((md - 1)*5 + mb)
23134 11105 : p_bc = pbc((mc - 1)*5 + mb)
23135 122155 : DO ma = 1, 10
23136 111050 : p_index = p_index + 1
23137 111050 : tmp = scale*prim(p_index)
23138 111050 : ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
23139 111050 : ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
23140 111050 : kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
23141 122155 : kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
23142 : END DO
23143 11105 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
23144 13326 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
23145 : END DO
23146 : END DO
23147 : END DO
23148 33 : END SUBROUTINE block_10_5
23149 : ! **************************************************************************************************
23150 : !> \brief ...
23151 : !> \param mc_max ...
23152 : !> \param md_max ...
23153 : !> \param kbd ...
23154 : !> \param kbc ...
23155 : !> \param kad ...
23156 : !> \param kac ...
23157 : !> \param pbd ...
23158 : !> \param pbc ...
23159 : !> \param pad ...
23160 : !> \param pac ...
23161 : !> \param prim ...
23162 : !> \param scale ...
23163 : ! **************************************************************************************************
23164 27 : SUBROUTINE block_10_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23165 : INTEGER :: mc_max, md_max
23166 : REAL(KIND=dp) :: kbd(6*md_max), kbc(6*mc_max), kad(10*md_max), kac(10*mc_max), &
23167 : pbd(6*md_max), pbc(6*mc_max), pad(10*md_max), pac(10*mc_max), prim(10*6*mc_max*md_max), &
23168 : scale
23169 :
23170 : INTEGER :: ma, mb, mc, md, p_index
23171 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23172 :
23173 1359 : kbd(1:6*md_max) = 0.0_dp
23174 1389 : kbc(1:6*mc_max) = 0.0_dp
23175 2247 : kad(1:10*md_max) = 0.0_dp
23176 2297 : kac(1:10*mc_max) = 0.0_dp
23177 : p_index = 0
23178 249 : DO md = 1, md_max
23179 2199 : DO mc = 1, mc_max
23180 13872 : DO mb = 1, 6
23181 11700 : ks_bd = 0.0_dp
23182 11700 : ks_bc = 0.0_dp
23183 11700 : p_bd = pbd((md - 1)*6 + mb)
23184 11700 : p_bc = pbc((mc - 1)*6 + mb)
23185 128700 : DO ma = 1, 10
23186 117000 : p_index = p_index + 1
23187 117000 : tmp = scale*prim(p_index)
23188 117000 : ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
23189 117000 : ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
23190 117000 : kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
23191 128700 : kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
23192 : END DO
23193 11700 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
23194 13650 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
23195 : END DO
23196 : END DO
23197 : END DO
23198 27 : END SUBROUTINE block_10_6
23199 : ! **************************************************************************************************
23200 : !> \brief ...
23201 : !> \param mc_max ...
23202 : !> \param md_max ...
23203 : !> \param kbd ...
23204 : !> \param kbc ...
23205 : !> \param kad ...
23206 : !> \param kac ...
23207 : !> \param pbd ...
23208 : !> \param pbc ...
23209 : !> \param pad ...
23210 : !> \param pac ...
23211 : !> \param prim ...
23212 : !> \param scale ...
23213 : ! **************************************************************************************************
23214 45 : SUBROUTINE block_10_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23215 : INTEGER :: mc_max, md_max
23216 : REAL(KIND=dp) :: kbd(7*md_max), kbc(7*mc_max), kad(10*md_max), kac(10*mc_max), &
23217 : pbd(7*md_max), pbc(7*mc_max), pad(10*md_max), pac(10*mc_max), prim(10*7*mc_max*md_max), &
23218 : scale
23219 :
23220 : INTEGER :: ma, mb, mc, md, p_index
23221 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23222 :
23223 2859 : kbd(1:7*md_max) = 0.0_dp
23224 2768 : kbc(1:7*mc_max) = 0.0_dp
23225 4065 : kad(1:10*md_max) = 0.0_dp
23226 3935 : kac(1:10*mc_max) = 0.0_dp
23227 : p_index = 0
23228 447 : DO md = 1, md_max
23229 4051 : DO mc = 1, mc_max
23230 29234 : DO mb = 1, 7
23231 25228 : ks_bd = 0.0_dp
23232 25228 : ks_bc = 0.0_dp
23233 25228 : p_bd = pbd((md - 1)*7 + mb)
23234 25228 : p_bc = pbc((mc - 1)*7 + mb)
23235 277508 : DO ma = 1, 10
23236 252280 : p_index = p_index + 1
23237 252280 : tmp = scale*prim(p_index)
23238 252280 : ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
23239 252280 : ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
23240 252280 : kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
23241 277508 : kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
23242 : END DO
23243 25228 : kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
23244 28832 : kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
23245 : END DO
23246 : END DO
23247 : END DO
23248 45 : END SUBROUTINE block_10_7
23249 : ! **************************************************************************************************
23250 : !> \brief ...
23251 : !> \param mc_max ...
23252 : !> \param md_max ...
23253 : !> \param kbd ...
23254 : !> \param kbc ...
23255 : !> \param kad ...
23256 : !> \param kac ...
23257 : !> \param pbd ...
23258 : !> \param pbc ...
23259 : !> \param pad ...
23260 : !> \param pac ...
23261 : !> \param prim ...
23262 : !> \param scale ...
23263 : ! **************************************************************************************************
23264 104 : SUBROUTINE block_10_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23265 : INTEGER :: mc_max, md_max
23266 : REAL(KIND=dp) :: kbd(9*md_max), kbc(9*mc_max), kad(10*md_max), kac(10*mc_max), &
23267 : pbd(9*md_max), pbc(9*mc_max), pad(10*md_max), pac(10*mc_max), prim(10*9*mc_max*md_max), &
23268 : scale
23269 :
23270 : INTEGER :: ma, mb, mc, md, p_index
23271 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23272 :
23273 7682 : kbd(1:9*md_max) = 0.0_dp
23274 5558 : kbc(1:9*mc_max) = 0.0_dp
23275 8524 : kad(1:10*md_max) = 0.0_dp
23276 6164 : kac(1:10*mc_max) = 0.0_dp
23277 : p_index = 0
23278 946 : DO md = 1, md_max
23279 6250 : DO mc = 1, mc_max
23280 53882 : DO mb = 1, 9
23281 47736 : ks_bd = 0.0_dp
23282 47736 : ks_bc = 0.0_dp
23283 47736 : p_bd = pbd((md - 1)*9 + mb)
23284 47736 : p_bc = pbc((mc - 1)*9 + mb)
23285 525096 : DO ma = 1, 10
23286 477360 : p_index = p_index + 1
23287 477360 : tmp = scale*prim(p_index)
23288 477360 : ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
23289 477360 : ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
23290 477360 : kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
23291 525096 : kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
23292 : END DO
23293 47736 : kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
23294 53040 : kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
23295 : END DO
23296 : END DO
23297 : END DO
23298 104 : END SUBROUTINE block_10_9
23299 : ! **************************************************************************************************
23300 : !> \brief ...
23301 : !> \param mc_max ...
23302 : !> \param md_max ...
23303 : !> \param kbd ...
23304 : !> \param kbc ...
23305 : !> \param kad ...
23306 : !> \param kac ...
23307 : !> \param pbd ...
23308 : !> \param pbc ...
23309 : !> \param pad ...
23310 : !> \param pac ...
23311 : !> \param prim ...
23312 : !> \param scale ...
23313 : ! **************************************************************************************************
23314 309 : SUBROUTINE block_10_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23315 : INTEGER :: mc_max, md_max
23316 : REAL(KIND=dp) :: kbd(10*md_max), kbc(10*mc_max), kad(10*md_max), kac(10*mc_max), &
23317 : pbd(10*md_max), pbc(10*mc_max), pad(10*md_max), pac(10*mc_max), &
23318 : prim(10*10*mc_max*md_max), scale
23319 :
23320 : INTEGER :: ma, mb, mc, md, p_index
23321 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23322 :
23323 24959 : kbd(1:10*md_max) = 0.0_dp
23324 18319 : kbc(1:10*mc_max) = 0.0_dp
23325 24959 : kad(1:10*md_max) = 0.0_dp
23326 18319 : kac(1:10*mc_max) = 0.0_dp
23327 : p_index = 0
23328 2774 : DO md = 1, md_max
23329 18246 : DO mc = 1, mc_max
23330 172657 : DO mb = 1, 10
23331 154720 : ks_bd = 0.0_dp
23332 154720 : ks_bc = 0.0_dp
23333 154720 : p_bd = pbd((md - 1)*10 + mb)
23334 154720 : p_bc = pbc((mc - 1)*10 + mb)
23335 1701920 : DO ma = 1, 10
23336 1547200 : p_index = p_index + 1
23337 1547200 : tmp = scale*prim(p_index)
23338 1547200 : ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
23339 1547200 : ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
23340 1547200 : kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
23341 1701920 : kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
23342 : END DO
23343 154720 : kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
23344 170192 : kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
23345 : END DO
23346 : END DO
23347 : END DO
23348 309 : END SUBROUTINE block_10_10
23349 : ! **************************************************************************************************
23350 : !> \brief ...
23351 : !> \param mc_max ...
23352 : !> \param md_max ...
23353 : !> \param kbd ...
23354 : !> \param kbc ...
23355 : !> \param kad ...
23356 : !> \param kac ...
23357 : !> \param pbd ...
23358 : !> \param pbc ...
23359 : !> \param pad ...
23360 : !> \param pac ...
23361 : !> \param prim ...
23362 : !> \param scale ...
23363 : ! **************************************************************************************************
23364 329 : SUBROUTINE block_10_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23365 : INTEGER :: mc_max, md_max
23366 : REAL(KIND=dp) :: kbd(11*md_max), kbc(11*mc_max), kad(10*md_max), kac(10*mc_max), &
23367 : pbd(11*md_max), pbc(11*mc_max), pad(10*md_max), pac(10*mc_max), &
23368 : prim(10*11*mc_max*md_max), scale
23369 :
23370 : INTEGER :: ma, mb, mc, md, p_index
23371 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23372 :
23373 29677 : kbd(1:11*md_max) = 0.0_dp
23374 21801 : kbc(1:11*mc_max) = 0.0_dp
23375 27009 : kad(1:10*md_max) = 0.0_dp
23376 19849 : kac(1:10*mc_max) = 0.0_dp
23377 : p_index = 0
23378 2997 : DO md = 1, md_max
23379 20064 : DO mc = 1, mc_max
23380 207472 : DO mb = 1, 11
23381 187737 : ks_bd = 0.0_dp
23382 187737 : ks_bc = 0.0_dp
23383 187737 : p_bd = pbd((md - 1)*11 + mb)
23384 187737 : p_bc = pbc((mc - 1)*11 + mb)
23385 2065107 : DO ma = 1, 10
23386 1877370 : p_index = p_index + 1
23387 1877370 : tmp = scale*prim(p_index)
23388 1877370 : ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
23389 1877370 : ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
23390 1877370 : kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
23391 2065107 : kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
23392 : END DO
23393 187737 : kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
23394 204804 : kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
23395 : END DO
23396 : END DO
23397 : END DO
23398 329 : END SUBROUTINE block_10_11
23399 : ! **************************************************************************************************
23400 : !> \brief ...
23401 : !> \param mc_max ...
23402 : !> \param md_max ...
23403 : !> \param kbd ...
23404 : !> \param kbc ...
23405 : !> \param kad ...
23406 : !> \param kac ...
23407 : !> \param pbd ...
23408 : !> \param pbc ...
23409 : !> \param pad ...
23410 : !> \param pac ...
23411 : !> \param prim ...
23412 : !> \param scale ...
23413 : ! **************************************************************************************************
23414 267 : SUBROUTINE block_10_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23415 : INTEGER :: mc_max, md_max
23416 : REAL(KIND=dp) :: kbd(15*md_max), kbc(15*mc_max), kad(10*md_max), kac(10*mc_max), &
23417 : pbd(15*md_max), pbc(15*mc_max), pad(10*md_max), pac(10*mc_max), &
23418 : prim(10*15*mc_max*md_max), scale
23419 :
23420 : INTEGER :: ma, mb, mc, md, p_index
23421 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23422 :
23423 34077 : kbd(1:15*md_max) = 0.0_dp
23424 26082 : kbc(1:15*mc_max) = 0.0_dp
23425 22807 : kad(1:10*md_max) = 0.0_dp
23426 17477 : kac(1:10*mc_max) = 0.0_dp
23427 : p_index = 0
23428 2521 : DO md = 1, md_max
23429 18179 : DO mc = 1, mc_max
23430 252782 : DO mb = 1, 15
23431 234870 : ks_bd = 0.0_dp
23432 234870 : ks_bc = 0.0_dp
23433 234870 : p_bd = pbd((md - 1)*15 + mb)
23434 234870 : p_bc = pbc((mc - 1)*15 + mb)
23435 2583570 : DO ma = 1, 10
23436 2348700 : p_index = p_index + 1
23437 2348700 : tmp = scale*prim(p_index)
23438 2348700 : ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
23439 2348700 : ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
23440 2348700 : kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
23441 2583570 : kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
23442 : END DO
23443 234870 : kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
23444 250528 : kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
23445 : END DO
23446 : END DO
23447 : END DO
23448 267 : END SUBROUTINE block_10_15
23449 : ! **************************************************************************************************
23450 : !> \brief ...
23451 : !> \param kbd ...
23452 : !> \param kbc ...
23453 : !> \param kad ...
23454 : !> \param kac ...
23455 : !> \param pbd ...
23456 : !> \param pbc ...
23457 : !> \param pad ...
23458 : !> \param pac ...
23459 : !> \param prim ...
23460 : !> \param scale ...
23461 : ! **************************************************************************************************
23462 9 : SUBROUTINE block_11_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23463 : REAL(KIND=dp) :: kbd(1*1), kbc(1*1), kad(11*1), &
23464 : kac(11*1), pbd(1*1), pbc(1*1), &
23465 : pad(11*1), pac(11*1), prim(11*1*1*1), &
23466 : scale
23467 :
23468 : INTEGER :: ma, mb, mc, md, p_index
23469 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23470 :
23471 9 : kbd(1:1*1) = 0.0_dp
23472 9 : kbc(1:1*1) = 0.0_dp
23473 9 : kad(1:11*1) = 0.0_dp
23474 9 : kac(1:11*1) = 0.0_dp
23475 9 : p_index = 0
23476 18 : DO md = 1, 1
23477 27 : DO mc = 1, 1
23478 27 : DO mb = 1, 1
23479 9 : ks_bd = 0.0_dp
23480 9 : ks_bc = 0.0_dp
23481 9 : p_bd = pbd((md - 1)*1 + mb)
23482 9 : p_bc = pbc((mc - 1)*1 + mb)
23483 108 : DO ma = 1, 11
23484 99 : p_index = p_index + 1
23485 99 : tmp = scale*prim(p_index)
23486 99 : ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23487 99 : ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23488 99 : kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23489 108 : kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23490 : END DO
23491 9 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
23492 18 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
23493 : END DO
23494 : END DO
23495 : END DO
23496 9 : END SUBROUTINE block_11_1_1_1
23497 : ! **************************************************************************************************
23498 : !> \brief ...
23499 : !> \param md_max ...
23500 : !> \param kbd ...
23501 : !> \param kbc ...
23502 : !> \param kad ...
23503 : !> \param kac ...
23504 : !> \param pbd ...
23505 : !> \param pbc ...
23506 : !> \param pad ...
23507 : !> \param pac ...
23508 : !> \param prim ...
23509 : !> \param scale ...
23510 : ! **************************************************************************************************
23511 39 : SUBROUTINE block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23512 : INTEGER :: md_max
23513 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*1), kad(11*md_max), kac(11*1), pbd(1*md_max), &
23514 : pbc(1*1), pad(11*md_max), pac(11*1), prim(11*1*1*md_max), scale
23515 :
23516 : INTEGER :: ma, mb, mc, md, p_index
23517 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23518 :
23519 344 : kbd(1:1*md_max) = 0.0_dp
23520 39 : kbc(1:1*1) = 0.0_dp
23521 3394 : kad(1:11*md_max) = 0.0_dp
23522 39 : kac(1:11*1) = 0.0_dp
23523 39 : p_index = 0
23524 344 : DO md = 1, md_max
23525 649 : DO mc = 1, 1
23526 915 : DO mb = 1, 1
23527 305 : ks_bd = 0.0_dp
23528 305 : ks_bc = 0.0_dp
23529 305 : p_bd = pbd((md - 1)*1 + mb)
23530 305 : p_bc = pbc((mc - 1)*1 + mb)
23531 3660 : DO ma = 1, 11
23532 3355 : p_index = p_index + 1
23533 3355 : tmp = scale*prim(p_index)
23534 3355 : ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23535 3355 : ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23536 3355 : kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23537 3660 : kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23538 : END DO
23539 305 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
23540 610 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
23541 : END DO
23542 : END DO
23543 : END DO
23544 39 : END SUBROUTINE block_11_1_1
23545 : ! **************************************************************************************************
23546 : !> \brief ...
23547 : !> \param mc_max ...
23548 : !> \param md_max ...
23549 : !> \param kbd ...
23550 : !> \param kbc ...
23551 : !> \param kad ...
23552 : !> \param kac ...
23553 : !> \param pbd ...
23554 : !> \param pbc ...
23555 : !> \param pad ...
23556 : !> \param pac ...
23557 : !> \param prim ...
23558 : !> \param scale ...
23559 : ! **************************************************************************************************
23560 314 : SUBROUTINE block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23561 : INTEGER :: mc_max, md_max
23562 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*mc_max), kad(11*md_max), kac(11*mc_max), &
23563 : pbd(1*md_max), pbc(1*mc_max), pad(11*md_max), pac(11*mc_max), prim(11*1*mc_max*md_max), &
23564 : scale
23565 :
23566 : INTEGER :: ma, mb, mc, md, p_index
23567 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23568 :
23569 2878 : kbd(1:1*md_max) = 0.0_dp
23570 2868 : kbc(1:1*mc_max) = 0.0_dp
23571 28518 : kad(1:11*md_max) = 0.0_dp
23572 28408 : kac(1:11*mc_max) = 0.0_dp
23573 : p_index = 0
23574 2878 : DO md = 1, md_max
23575 24249 : DO mc = 1, mc_max
23576 45306 : DO mb = 1, 1
23577 21371 : ks_bd = 0.0_dp
23578 21371 : ks_bc = 0.0_dp
23579 21371 : p_bd = pbd((md - 1)*1 + mb)
23580 21371 : p_bc = pbc((mc - 1)*1 + mb)
23581 256452 : DO ma = 1, 11
23582 235081 : p_index = p_index + 1
23583 235081 : tmp = scale*prim(p_index)
23584 235081 : ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23585 235081 : ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23586 235081 : kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23587 256452 : kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23588 : END DO
23589 21371 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
23590 42742 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
23591 : END DO
23592 : END DO
23593 : END DO
23594 314 : END SUBROUTINE block_11_1
23595 : ! **************************************************************************************************
23596 : !> \brief ...
23597 : !> \param mc_max ...
23598 : !> \param md_max ...
23599 : !> \param kbd ...
23600 : !> \param kbc ...
23601 : !> \param kad ...
23602 : !> \param kac ...
23603 : !> \param pbd ...
23604 : !> \param pbc ...
23605 : !> \param pad ...
23606 : !> \param pac ...
23607 : !> \param prim ...
23608 : !> \param scale ...
23609 : ! **************************************************************************************************
23610 47 : SUBROUTINE block_11_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23611 : INTEGER :: mc_max, md_max
23612 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*mc_max), kad(11*md_max), kac(11*mc_max), &
23613 : pbd(2*md_max), pbc(2*mc_max), pad(11*md_max), pac(11*mc_max), prim(11*2*mc_max*md_max), &
23614 : scale
23615 :
23616 : INTEGER :: ma, mb, mc, md, p_index
23617 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23618 :
23619 651 : kbd(1:2*md_max) = 0.0_dp
23620 853 : kbc(1:2*mc_max) = 0.0_dp
23621 3369 : kad(1:11*md_max) = 0.0_dp
23622 4480 : kac(1:11*mc_max) = 0.0_dp
23623 : p_index = 0
23624 349 : DO md = 1, md_max
23625 3011 : DO mc = 1, mc_max
23626 8288 : DO mb = 1, 2
23627 5324 : ks_bd = 0.0_dp
23628 5324 : ks_bc = 0.0_dp
23629 5324 : p_bd = pbd((md - 1)*2 + mb)
23630 5324 : p_bc = pbc((mc - 1)*2 + mb)
23631 63888 : DO ma = 1, 11
23632 58564 : p_index = p_index + 1
23633 58564 : tmp = scale*prim(p_index)
23634 58564 : ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23635 58564 : ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23636 58564 : kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23637 63888 : kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23638 : END DO
23639 5324 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
23640 7986 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
23641 : END DO
23642 : END DO
23643 : END DO
23644 47 : END SUBROUTINE block_11_2
23645 : ! **************************************************************************************************
23646 : !> \brief ...
23647 : !> \param mc_max ...
23648 : !> \param md_max ...
23649 : !> \param kbd ...
23650 : !> \param kbc ...
23651 : !> \param kad ...
23652 : !> \param kac ...
23653 : !> \param pbd ...
23654 : !> \param pbc ...
23655 : !> \param pad ...
23656 : !> \param pac ...
23657 : !> \param prim ...
23658 : !> \param scale ...
23659 : ! **************************************************************************************************
23660 40 : SUBROUTINE block_11_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23661 : INTEGER :: mc_max, md_max
23662 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*mc_max), kad(11*md_max), kac(11*mc_max), &
23663 : pbd(3*md_max), pbc(3*mc_max), pad(11*md_max), pac(11*mc_max), prim(11*3*mc_max*md_max), &
23664 : scale
23665 :
23666 : INTEGER :: ma, mb, mc, md, p_index
23667 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23668 :
23669 877 : kbd(1:3*md_max) = 0.0_dp
23670 1072 : kbc(1:3*mc_max) = 0.0_dp
23671 3109 : kad(1:11*md_max) = 0.0_dp
23672 3824 : kac(1:11*mc_max) = 0.0_dp
23673 : p_index = 0
23674 319 : DO md = 1, md_max
23675 2791 : DO mc = 1, mc_max
23676 10167 : DO mb = 1, 3
23677 7416 : ks_bd = 0.0_dp
23678 7416 : ks_bc = 0.0_dp
23679 7416 : p_bd = pbd((md - 1)*3 + mb)
23680 7416 : p_bc = pbc((mc - 1)*3 + mb)
23681 88992 : DO ma = 1, 11
23682 81576 : p_index = p_index + 1
23683 81576 : tmp = scale*prim(p_index)
23684 81576 : ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23685 81576 : ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23686 81576 : kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23687 88992 : kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23688 : END DO
23689 7416 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
23690 9888 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
23691 : END DO
23692 : END DO
23693 : END DO
23694 40 : END SUBROUTINE block_11_3
23695 : ! **************************************************************************************************
23696 : !> \brief ...
23697 : !> \param mc_max ...
23698 : !> \param md_max ...
23699 : !> \param kbd ...
23700 : !> \param kbc ...
23701 : !> \param kad ...
23702 : !> \param kac ...
23703 : !> \param pbd ...
23704 : !> \param pbc ...
23705 : !> \param pad ...
23706 : !> \param pac ...
23707 : !> \param prim ...
23708 : !> \param scale ...
23709 : ! **************************************************************************************************
23710 34 : SUBROUTINE block_11_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23711 : INTEGER :: mc_max, md_max
23712 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*mc_max), kad(11*md_max), kac(11*mc_max), &
23713 : pbd(4*md_max), pbc(4*mc_max), pad(11*md_max), pac(11*mc_max), prim(11*4*mc_max*md_max), &
23714 : scale
23715 :
23716 : INTEGER :: ma, mb, mc, md, p_index
23717 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23718 :
23719 1058 : kbd(1:4*md_max) = 0.0_dp
23720 1198 : kbc(1:4*mc_max) = 0.0_dp
23721 2850 : kad(1:11*md_max) = 0.0_dp
23722 3235 : kac(1:11*mc_max) = 0.0_dp
23723 : p_index = 0
23724 290 : DO md = 1, md_max
23725 2555 : DO mc = 1, mc_max
23726 11581 : DO mb = 1, 4
23727 9060 : ks_bd = 0.0_dp
23728 9060 : ks_bc = 0.0_dp
23729 9060 : p_bd = pbd((md - 1)*4 + mb)
23730 9060 : p_bc = pbc((mc - 1)*4 + mb)
23731 108720 : DO ma = 1, 11
23732 99660 : p_index = p_index + 1
23733 99660 : tmp = scale*prim(p_index)
23734 99660 : ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23735 99660 : ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23736 99660 : kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23737 108720 : kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23738 : END DO
23739 9060 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
23740 11325 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
23741 : END DO
23742 : END DO
23743 : END DO
23744 34 : END SUBROUTINE block_11_4
23745 : ! **************************************************************************************************
23746 : !> \brief ...
23747 : !> \param mc_max ...
23748 : !> \param md_max ...
23749 : !> \param kbd ...
23750 : !> \param kbc ...
23751 : !> \param kad ...
23752 : !> \param kac ...
23753 : !> \param pbd ...
23754 : !> \param pbc ...
23755 : !> \param pad ...
23756 : !> \param pac ...
23757 : !> \param prim ...
23758 : !> \param scale ...
23759 : ! **************************************************************************************************
23760 28 : SUBROUTINE block_11_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23761 : INTEGER :: mc_max, md_max
23762 : REAL(KIND=dp) :: kbd(5*md_max), kbc(5*mc_max), kad(11*md_max), kac(11*mc_max), &
23763 : pbd(5*md_max), pbc(5*mc_max), pad(11*md_max), pac(11*mc_max), prim(11*5*mc_max*md_max), &
23764 : scale
23765 :
23766 : INTEGER :: ma, mb, mc, md, p_index
23767 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23768 :
23769 1163 : kbd(1:5*md_max) = 0.0_dp
23770 1218 : kbc(1:5*mc_max) = 0.0_dp
23771 2525 : kad(1:11*md_max) = 0.0_dp
23772 2646 : kac(1:11*mc_max) = 0.0_dp
23773 : p_index = 0
23774 255 : DO md = 1, md_max
23775 2260 : DO mc = 1, mc_max
23776 12257 : DO mb = 1, 5
23777 10025 : ks_bd = 0.0_dp
23778 10025 : ks_bc = 0.0_dp
23779 10025 : p_bd = pbd((md - 1)*5 + mb)
23780 10025 : p_bc = pbc((mc - 1)*5 + mb)
23781 120300 : DO ma = 1, 11
23782 110275 : p_index = p_index + 1
23783 110275 : tmp = scale*prim(p_index)
23784 110275 : ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23785 110275 : ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23786 110275 : kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23787 120300 : kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23788 : END DO
23789 10025 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
23790 12030 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
23791 : END DO
23792 : END DO
23793 : END DO
23794 28 : END SUBROUTINE block_11_5
23795 : ! **************************************************************************************************
23796 : !> \brief ...
23797 : !> \param mc_max ...
23798 : !> \param md_max ...
23799 : !> \param kbd ...
23800 : !> \param kbc ...
23801 : !> \param kad ...
23802 : !> \param kac ...
23803 : !> \param pbd ...
23804 : !> \param pbc ...
23805 : !> \param pad ...
23806 : !> \param pac ...
23807 : !> \param prim ...
23808 : !> \param scale ...
23809 : ! **************************************************************************************************
23810 23 : SUBROUTINE block_11_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23811 : INTEGER :: mc_max, md_max
23812 : REAL(KIND=dp) :: kbd(6*md_max), kbc(6*mc_max), kad(11*md_max), kac(11*mc_max), &
23813 : pbd(6*md_max), pbc(6*mc_max), pad(11*md_max), pac(11*mc_max), prim(11*6*mc_max*md_max), &
23814 : scale
23815 :
23816 : INTEGER :: ma, mb, mc, md, p_index
23817 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23818 :
23819 1223 : kbd(1:6*md_max) = 0.0_dp
23820 1175 : kbc(1:6*mc_max) = 0.0_dp
23821 2223 : kad(1:11*md_max) = 0.0_dp
23822 2135 : kac(1:11*mc_max) = 0.0_dp
23823 : p_index = 0
23824 223 : DO md = 1, md_max
23825 1971 : DO mc = 1, mc_max
23826 12436 : DO mb = 1, 6
23827 10488 : ks_bd = 0.0_dp
23828 10488 : ks_bc = 0.0_dp
23829 10488 : p_bd = pbd((md - 1)*6 + mb)
23830 10488 : p_bc = pbc((mc - 1)*6 + mb)
23831 125856 : DO ma = 1, 11
23832 115368 : p_index = p_index + 1
23833 115368 : tmp = scale*prim(p_index)
23834 115368 : ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23835 115368 : ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23836 115368 : kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23837 125856 : kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23838 : END DO
23839 10488 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
23840 12236 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
23841 : END DO
23842 : END DO
23843 : END DO
23844 23 : END SUBROUTINE block_11_6
23845 : ! **************************************************************************************************
23846 : !> \brief ...
23847 : !> \param mc_max ...
23848 : !> \param md_max ...
23849 : !> \param kbd ...
23850 : !> \param kbc ...
23851 : !> \param kad ...
23852 : !> \param kac ...
23853 : !> \param pbd ...
23854 : !> \param pbc ...
23855 : !> \param pad ...
23856 : !> \param pac ...
23857 : !> \param prim ...
23858 : !> \param scale ...
23859 : ! **************************************************************************************************
23860 45 : SUBROUTINE block_11_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23861 : INTEGER :: mc_max, md_max
23862 : REAL(KIND=dp) :: kbd(7*md_max), kbc(7*mc_max), kad(11*md_max), kac(11*mc_max), &
23863 : pbd(7*md_max), pbc(7*mc_max), pad(11*md_max), pac(11*mc_max), prim(11*7*mc_max*md_max), &
23864 : scale
23865 :
23866 : INTEGER :: ma, mb, mc, md, p_index
23867 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23868 :
23869 2859 : kbd(1:7*md_max) = 0.0_dp
23870 2817 : kbc(1:7*mc_max) = 0.0_dp
23871 4467 : kad(1:11*md_max) = 0.0_dp
23872 4401 : kac(1:11*mc_max) = 0.0_dp
23873 : p_index = 0
23874 447 : DO md = 1, md_max
23875 4048 : DO mc = 1, mc_max
23876 29210 : DO mb = 1, 7
23877 25207 : ks_bd = 0.0_dp
23878 25207 : ks_bc = 0.0_dp
23879 25207 : p_bd = pbd((md - 1)*7 + mb)
23880 25207 : p_bc = pbc((mc - 1)*7 + mb)
23881 302484 : DO ma = 1, 11
23882 277277 : p_index = p_index + 1
23883 277277 : tmp = scale*prim(p_index)
23884 277277 : ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23885 277277 : ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23886 277277 : kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23887 302484 : kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23888 : END DO
23889 25207 : kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
23890 28808 : kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
23891 : END DO
23892 : END DO
23893 : END DO
23894 45 : END SUBROUTINE block_11_7
23895 : ! **************************************************************************************************
23896 : !> \brief ...
23897 : !> \param mc_max ...
23898 : !> \param md_max ...
23899 : !> \param kbd ...
23900 : !> \param kbc ...
23901 : !> \param kad ...
23902 : !> \param kac ...
23903 : !> \param pbd ...
23904 : !> \param pbc ...
23905 : !> \param pad ...
23906 : !> \param pac ...
23907 : !> \param prim ...
23908 : !> \param scale ...
23909 : ! **************************************************************************************************
23910 47 : SUBROUTINE block_11_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23911 : INTEGER :: mc_max, md_max
23912 : REAL(KIND=dp) :: kbd(9*md_max), kbc(9*mc_max), kad(11*md_max), kac(11*mc_max), &
23913 : pbd(9*md_max), pbc(9*mc_max), pad(11*md_max), pac(11*mc_max), prim(11*9*mc_max*md_max), &
23914 : scale
23915 :
23916 : INTEGER :: ma, mb, mc, md, p_index
23917 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23918 :
23919 3827 : kbd(1:9*md_max) = 0.0_dp
23920 3755 : kbc(1:9*mc_max) = 0.0_dp
23921 4667 : kad(1:11*md_max) = 0.0_dp
23922 4579 : kac(1:11*mc_max) = 0.0_dp
23923 : p_index = 0
23924 467 : DO md = 1, md_max
23925 4252 : DO mc = 1, mc_max
23926 38270 : DO mb = 1, 9
23927 34065 : ks_bd = 0.0_dp
23928 34065 : ks_bc = 0.0_dp
23929 34065 : p_bd = pbd((md - 1)*9 + mb)
23930 34065 : p_bc = pbc((mc - 1)*9 + mb)
23931 408780 : DO ma = 1, 11
23932 374715 : p_index = p_index + 1
23933 374715 : tmp = scale*prim(p_index)
23934 374715 : ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23935 374715 : ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23936 374715 : kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23937 408780 : kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23938 : END DO
23939 34065 : kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
23940 37850 : kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
23941 : END DO
23942 : END DO
23943 : END DO
23944 47 : END SUBROUTINE block_11_9
23945 : ! **************************************************************************************************
23946 : !> \brief ...
23947 : !> \param mc_max ...
23948 : !> \param md_max ...
23949 : !> \param kbd ...
23950 : !> \param kbc ...
23951 : !> \param kad ...
23952 : !> \param kac ...
23953 : !> \param pbd ...
23954 : !> \param pbc ...
23955 : !> \param pad ...
23956 : !> \param pac ...
23957 : !> \param prim ...
23958 : !> \param scale ...
23959 : ! **************************************************************************************************
23960 49 : SUBROUTINE block_11_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
23961 : INTEGER :: mc_max, md_max
23962 : REAL(KIND=dp) :: kbd(10*md_max), kbc(10*mc_max), kad(11*md_max), kac(11*mc_max), &
23963 : pbd(10*md_max), pbc(10*mc_max), pad(11*md_max), pac(11*mc_max), &
23964 : prim(11*10*mc_max*md_max), scale
23965 :
23966 : INTEGER :: ma, mb, mc, md, p_index
23967 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
23968 :
23969 4519 : kbd(1:10*md_max) = 0.0_dp
23970 4329 : kbc(1:10*mc_max) = 0.0_dp
23971 4966 : kad(1:11*md_max) = 0.0_dp
23972 4757 : kac(1:11*mc_max) = 0.0_dp
23973 : p_index = 0
23974 496 : DO md = 1, md_max
23975 4496 : DO mc = 1, mc_max
23976 44447 : DO mb = 1, 10
23977 40000 : ks_bd = 0.0_dp
23978 40000 : ks_bc = 0.0_dp
23979 40000 : p_bd = pbd((md - 1)*10 + mb)
23980 40000 : p_bc = pbc((mc - 1)*10 + mb)
23981 480000 : DO ma = 1, 11
23982 440000 : p_index = p_index + 1
23983 440000 : tmp = scale*prim(p_index)
23984 440000 : ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23985 440000 : ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23986 440000 : kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23987 480000 : kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23988 : END DO
23989 40000 : kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
23990 44000 : kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
23991 : END DO
23992 : END DO
23993 : END DO
23994 49 : END SUBROUTINE block_11_10
23995 : ! **************************************************************************************************
23996 : !> \brief ...
23997 : !> \param mc_max ...
23998 : !> \param md_max ...
23999 : !> \param kbd ...
24000 : !> \param kbc ...
24001 : !> \param kad ...
24002 : !> \param kac ...
24003 : !> \param pbd ...
24004 : !> \param pbc ...
24005 : !> \param pad ...
24006 : !> \param pac ...
24007 : !> \param prim ...
24008 : !> \param scale ...
24009 : ! **************************************************************************************************
24010 359 : SUBROUTINE block_11_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
24011 : INTEGER :: mc_max, md_max
24012 : REAL(KIND=dp) :: kbd(11*md_max), kbc(11*mc_max), kad(11*md_max), kac(11*mc_max), &
24013 : pbd(11*md_max), pbc(11*mc_max), pad(11*md_max), pac(11*mc_max), &
24014 : prim(11*11*mc_max*md_max), scale
24015 :
24016 : INTEGER :: ma, mb, mc, md, p_index
24017 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
24018 :
24019 32677 : kbd(1:11*md_max) = 0.0_dp
24020 24713 : kbc(1:11*mc_max) = 0.0_dp
24021 32677 : kad(1:11*md_max) = 0.0_dp
24022 24713 : kac(1:11*mc_max) = 0.0_dp
24023 : p_index = 0
24024 3297 : DO md = 1, md_max
24025 22928 : DO mc = 1, mc_max
24026 238510 : DO mb = 1, 11
24027 215941 : ks_bd = 0.0_dp
24028 215941 : ks_bc = 0.0_dp
24029 215941 : p_bd = pbd((md - 1)*11 + mb)
24030 215941 : p_bc = pbc((mc - 1)*11 + mb)
24031 2591292 : DO ma = 1, 11
24032 2375351 : p_index = p_index + 1
24033 2375351 : tmp = scale*prim(p_index)
24034 2375351 : ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
24035 2375351 : ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
24036 2375351 : kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
24037 2591292 : kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
24038 : END DO
24039 215941 : kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
24040 235572 : kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
24041 : END DO
24042 : END DO
24043 : END DO
24044 359 : END SUBROUTINE block_11_11
24045 : ! **************************************************************************************************
24046 : !> \brief ...
24047 : !> \param mc_max ...
24048 : !> \param md_max ...
24049 : !> \param kbd ...
24050 : !> \param kbc ...
24051 : !> \param kad ...
24052 : !> \param kac ...
24053 : !> \param pbd ...
24054 : !> \param pbc ...
24055 : !> \param pad ...
24056 : !> \param pac ...
24057 : !> \param prim ...
24058 : !> \param scale ...
24059 : ! **************************************************************************************************
24060 215 : SUBROUTINE block_11_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
24061 : INTEGER :: mc_max, md_max
24062 : REAL(KIND=dp) :: kbd(15*md_max), kbc(15*mc_max), kad(11*md_max), kac(11*mc_max), &
24063 : pbd(15*md_max), pbc(15*mc_max), pad(11*md_max), pac(11*mc_max), &
24064 : prim(11*15*mc_max*md_max), scale
24065 :
24066 : INTEGER :: ma, mb, mc, md, p_index
24067 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
24068 :
24069 28205 : kbd(1:15*md_max) = 0.0_dp
24070 23975 : kbc(1:15*mc_max) = 0.0_dp
24071 20741 : kad(1:11*md_max) = 0.0_dp
24072 17639 : kac(1:11*mc_max) = 0.0_dp
24073 : p_index = 0
24074 2081 : DO md = 1, md_max
24075 16630 : DO mc = 1, mc_max
24076 234650 : DO mb = 1, 15
24077 218235 : ks_bd = 0.0_dp
24078 218235 : ks_bc = 0.0_dp
24079 218235 : p_bd = pbd((md - 1)*15 + mb)
24080 218235 : p_bc = pbc((mc - 1)*15 + mb)
24081 2618820 : DO ma = 1, 11
24082 2400585 : p_index = p_index + 1
24083 2400585 : tmp = scale*prim(p_index)
24084 2400585 : ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
24085 2400585 : ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
24086 2400585 : kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
24087 2618820 : kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
24088 : END DO
24089 218235 : kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
24090 232784 : kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
24091 : END DO
24092 : END DO
24093 : END DO
24094 215 : END SUBROUTINE block_11_15
24095 : ! **************************************************************************************************
24096 : !> \brief ...
24097 : !> \param kbd ...
24098 : !> \param kbc ...
24099 : !> \param kad ...
24100 : !> \param kac ...
24101 : !> \param pbd ...
24102 : !> \param pbc ...
24103 : !> \param pad ...
24104 : !> \param pac ...
24105 : !> \param prim ...
24106 : !> \param scale ...
24107 : ! **************************************************************************************************
24108 11 : SUBROUTINE block_15_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
24109 : REAL(KIND=dp) :: kbd(1*1), kbc(1*1), kad(15*1), &
24110 : kac(15*1), pbd(1*1), pbc(1*1), &
24111 : pad(15*1), pac(15*1), prim(15*1*1*1), &
24112 : scale
24113 :
24114 : INTEGER :: ma, mb, mc, md, p_index
24115 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
24116 :
24117 11 : kbd(1:1*1) = 0.0_dp
24118 11 : kbc(1:1*1) = 0.0_dp
24119 11 : kad(1:15*1) = 0.0_dp
24120 11 : kac(1:15*1) = 0.0_dp
24121 11 : p_index = 0
24122 22 : DO md = 1, 1
24123 33 : DO mc = 1, 1
24124 33 : DO mb = 1, 1
24125 11 : ks_bd = 0.0_dp
24126 11 : ks_bc = 0.0_dp
24127 11 : p_bd = pbd((md - 1)*1 + mb)
24128 11 : p_bc = pbc((mc - 1)*1 + mb)
24129 176 : DO ma = 1, 15
24130 165 : p_index = p_index + 1
24131 165 : tmp = scale*prim(p_index)
24132 165 : ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24133 165 : ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24134 165 : kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24135 176 : kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24136 : END DO
24137 11 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
24138 22 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
24139 : END DO
24140 : END DO
24141 : END DO
24142 11 : END SUBROUTINE block_15_1_1_1
24143 : ! **************************************************************************************************
24144 : !> \brief ...
24145 : !> \param md_max ...
24146 : !> \param kbd ...
24147 : !> \param kbc ...
24148 : !> \param kad ...
24149 : !> \param kac ...
24150 : !> \param pbd ...
24151 : !> \param pbc ...
24152 : !> \param pad ...
24153 : !> \param pac ...
24154 : !> \param prim ...
24155 : !> \param scale ...
24156 : ! **************************************************************************************************
24157 48 : SUBROUTINE block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
24158 : INTEGER :: md_max
24159 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*1), kad(15*md_max), kac(15*1), pbd(1*md_max), &
24160 : pbc(1*1), pad(15*md_max), pac(15*1), prim(15*1*1*md_max), scale
24161 :
24162 : INTEGER :: ma, mb, mc, md, p_index
24163 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
24164 :
24165 433 : kbd(1:1*md_max) = 0.0_dp
24166 48 : kbc(1:1*1) = 0.0_dp
24167 5823 : kad(1:15*md_max) = 0.0_dp
24168 48 : kac(1:15*1) = 0.0_dp
24169 48 : p_index = 0
24170 433 : DO md = 1, md_max
24171 818 : DO mc = 1, 1
24172 1155 : DO mb = 1, 1
24173 385 : ks_bd = 0.0_dp
24174 385 : ks_bc = 0.0_dp
24175 385 : p_bd = pbd((md - 1)*1 + mb)
24176 385 : p_bc = pbc((mc - 1)*1 + mb)
24177 6160 : DO ma = 1, 15
24178 5775 : p_index = p_index + 1
24179 5775 : tmp = scale*prim(p_index)
24180 5775 : ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24181 5775 : ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24182 5775 : kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24183 6160 : kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24184 : END DO
24185 385 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
24186 770 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
24187 : END DO
24188 : END DO
24189 : END DO
24190 48 : END SUBROUTINE block_15_1_1
24191 : ! **************************************************************************************************
24192 : !> \brief ...
24193 : !> \param mc_max ...
24194 : !> \param md_max ...
24195 : !> \param kbd ...
24196 : !> \param kbc ...
24197 : !> \param kad ...
24198 : !> \param kac ...
24199 : !> \param pbd ...
24200 : !> \param pbc ...
24201 : !> \param pad ...
24202 : !> \param pac ...
24203 : !> \param prim ...
24204 : !> \param scale ...
24205 : ! **************************************************************************************************
24206 374 : SUBROUTINE block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
24207 : INTEGER :: mc_max, md_max
24208 : REAL(KIND=dp) :: kbd(1*md_max), kbc(1*mc_max), kad(15*md_max), kac(15*mc_max), &
24209 : pbd(1*md_max), pbc(1*mc_max), pad(15*md_max), pac(15*mc_max), prim(15*1*mc_max*md_max), &
24210 : scale
24211 :
24212 : INTEGER :: ma, mb, mc, md, p_index
24213 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
24214 :
24215 3380 : kbd(1:1*md_max) = 0.0_dp
24216 3266 : kbc(1:1*mc_max) = 0.0_dp
24217 45464 : kad(1:15*md_max) = 0.0_dp
24218 43754 : kac(1:15*mc_max) = 0.0_dp
24219 : p_index = 0
24220 3380 : DO md = 1, md_max
24221 27228 : DO mc = 1, mc_max
24222 50702 : DO mb = 1, 1
24223 23848 : ks_bd = 0.0_dp
24224 23848 : ks_bc = 0.0_dp
24225 23848 : p_bd = pbd((md - 1)*1 + mb)
24226 23848 : p_bc = pbc((mc - 1)*1 + mb)
24227 381568 : DO ma = 1, 15
24228 357720 : p_index = p_index + 1
24229 357720 : tmp = scale*prim(p_index)
24230 357720 : ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24231 357720 : ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24232 357720 : kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24233 381568 : kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24234 : END DO
24235 23848 : kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
24236 47696 : kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
24237 : END DO
24238 : END DO
24239 : END DO
24240 374 : END SUBROUTINE block_15_1
24241 : ! **************************************************************************************************
24242 : !> \brief ...
24243 : !> \param mc_max ...
24244 : !> \param md_max ...
24245 : !> \param kbd ...
24246 : !> \param kbc ...
24247 : !> \param kad ...
24248 : !> \param kac ...
24249 : !> \param pbd ...
24250 : !> \param pbc ...
24251 : !> \param pad ...
24252 : !> \param pac ...
24253 : !> \param prim ...
24254 : !> \param scale ...
24255 : ! **************************************************************************************************
24256 41 : SUBROUTINE block_15_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
24257 : INTEGER :: mc_max, md_max
24258 : REAL(KIND=dp) :: kbd(2*md_max), kbc(2*mc_max), kad(15*md_max), kac(15*mc_max), &
24259 : pbd(2*md_max), pbc(2*mc_max), pad(15*md_max), pac(15*mc_max), prim(15*2*mc_max*md_max), &
24260 : scale
24261 :
24262 : INTEGER :: ma, mb, mc, md, p_index
24263 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
24264 :
24265 603 : kbd(1:2*md_max) = 0.0_dp
24266 759 : kbc(1:2*mc_max) = 0.0_dp
24267 4256 : kad(1:15*md_max) = 0.0_dp
24268 5426 : kac(1:15*mc_max) = 0.0_dp
24269 : p_index = 0
24270 322 : DO md = 1, md_max
24271 2824 : DO mc = 1, mc_max
24272 7787 : DO mb = 1, 2
24273 5004 : ks_bd = 0.0_dp
24274 5004 : ks_bc = 0.0_dp
24275 5004 : p_bd = pbd((md - 1)*2 + mb)
24276 5004 : p_bc = pbc((mc - 1)*2 + mb)
24277 80064 : DO ma = 1, 15
24278 75060 : p_index = p_index + 1
24279 75060 : tmp = scale*prim(p_index)
24280 75060 : ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24281 75060 : ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24282 75060 : kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24283 80064 : kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24284 : END DO
24285 5004 : kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
24286 7506 : kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
24287 : END DO
24288 : END DO
24289 : END DO
24290 41 : END SUBROUTINE block_15_2
24291 : ! **************************************************************************************************
24292 : !> \brief ...
24293 : !> \param mc_max ...
24294 : !> \param md_max ...
24295 : !> \param kbd ...
24296 : !> \param kbc ...
24297 : !> \param kad ...
24298 : !> \param kac ...
24299 : !> \param pbd ...
24300 : !> \param pbc ...
24301 : !> \param pad ...
24302 : !> \param pac ...
24303 : !> \param prim ...
24304 : !> \param scale ...
24305 : ! **************************************************************************************************
24306 35 : SUBROUTINE block_15_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
24307 : INTEGER :: mc_max, md_max
24308 : REAL(KIND=dp) :: kbd(3*md_max), kbc(3*mc_max), kad(15*md_max), kac(15*mc_max), &
24309 : pbd(3*md_max), pbc(3*mc_max), pad(15*md_max), pac(15*mc_max), prim(15*3*mc_max*md_max), &
24310 : scale
24311 :
24312 : INTEGER :: ma, mb, mc, md, p_index
24313 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
24314 :
24315 812 : kbd(1:3*md_max) = 0.0_dp
24316 953 : kbc(1:3*mc_max) = 0.0_dp
24317 3920 : kad(1:15*md_max) = 0.0_dp
24318 4625 : kac(1:15*mc_max) = 0.0_dp
24319 : p_index = 0
24320 294 : DO md = 1, md_max
24321 2604 : DO mc = 1, mc_max
24322 9499 : DO mb = 1, 3
24323 6930 : ks_bd = 0.0_dp
24324 6930 : ks_bc = 0.0_dp
24325 6930 : p_bd = pbd((md - 1)*3 + mb)
24326 6930 : p_bc = pbc((mc - 1)*3 + mb)
24327 110880 : DO ma = 1, 15
24328 103950 : p_index = p_index + 1
24329 103950 : tmp = scale*prim(p_index)
24330 103950 : ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24331 103950 : ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24332 103950 : kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24333 110880 : kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24334 : END DO
24335 6930 : kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
24336 9240 : kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
24337 : END DO
24338 : END DO
24339 : END DO
24340 35 : END SUBROUTINE block_15_3
24341 : ! **************************************************************************************************
24342 : !> \brief ...
24343 : !> \param mc_max ...
24344 : !> \param md_max ...
24345 : !> \param kbd ...
24346 : !> \param kbc ...
24347 : !> \param kad ...
24348 : !> \param kac ...
24349 : !> \param pbd ...
24350 : !> \param pbc ...
24351 : !> \param pad ...
24352 : !> \param pac ...
24353 : !> \param prim ...
24354 : !> \param scale ...
24355 : ! **************************************************************************************************
24356 29 : SUBROUTINE block_15_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
24357 : INTEGER :: mc_max, md_max
24358 : REAL(KIND=dp) :: kbd(4*md_max), kbc(4*mc_max), kad(15*md_max), kac(15*mc_max), &
24359 : pbd(4*md_max), pbc(4*mc_max), pad(15*md_max), pac(15*mc_max), prim(15*4*mc_max*md_max), &
24360 : scale
24361 :
24362 : INTEGER :: ma, mb, mc, md, p_index
24363 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
24364 :
24365 953 : kbd(1:4*md_max) = 0.0_dp
24366 1041 : kbc(1:4*mc_max) = 0.0_dp
24367 3494 : kad(1:15*md_max) = 0.0_dp
24368 3824 : kac(1:15*mc_max) = 0.0_dp
24369 : p_index = 0
24370 260 : DO md = 1, md_max
24371 2325 : DO mc = 1, mc_max
24372 10556 : DO mb = 1, 4
24373 8260 : ks_bd = 0.0_dp
24374 8260 : ks_bc = 0.0_dp
24375 8260 : p_bd = pbd((md - 1)*4 + mb)
24376 8260 : p_bc = pbc((mc - 1)*4 + mb)
24377 132160 : DO ma = 1, 15
24378 123900 : p_index = p_index + 1
24379 123900 : tmp = scale*prim(p_index)
24380 123900 : ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24381 123900 : ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24382 123900 : kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24383 132160 : kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24384 : END DO
24385 8260 : kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
24386 10325 : kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
24387 : END DO
24388 : END DO
24389 : END DO
24390 29 : END SUBROUTINE block_15_4
24391 : ! **************************************************************************************************
24392 : !> \brief ...
24393 : !> \param mc_max ...
24394 : !> \param md_max ...
24395 : !> \param kbd ...
24396 : !> \param kbc ...
24397 : !> \param kad ...
24398 : !> \param kac ...
24399 : !> \param pbd ...
24400 : !> \param pbc ...
24401 : !> \param pad ...
24402 : !> \param pac ...
24403 : !> \param prim ...
24404 : !> \param scale ...
24405 : ! **************************************************************************************************
24406 24 : SUBROUTINE block_15_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
24407 : INTEGER :: mc_max, md_max
24408 : REAL(KIND=dp) :: kbd(5*md_max), kbc(5*mc_max), kad(15*md_max), kac(15*mc_max), &
24409 : pbd(5*md_max), pbc(5*mc_max), pad(15*md_max), pac(15*mc_max), prim(15*5*mc_max*md_max), &
24410 : scale
24411 :
24412 : INTEGER :: ma, mb, mc, md, p_index
24413 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
24414 :
24415 1049 : kbd(1:5*md_max) = 0.0_dp
24416 1059 : kbc(1:5*mc_max) = 0.0_dp
24417 3099 : kad(1:15*md_max) = 0.0_dp
24418 3129 : kac(1:15*mc_max) = 0.0_dp
24419 : p_index = 0
24420 229 : DO md = 1, md_max
24421 2052 : DO mc = 1, mc_max
24422 11143 : DO mb = 1, 5
24423 9115 : ks_bd = 0.0_dp
24424 9115 : ks_bc = 0.0_dp
24425 9115 : p_bd = pbd((md - 1)*5 + mb)
24426 9115 : p_bc = pbc((mc - 1)*5 + mb)
24427 145840 : DO ma = 1, 15
24428 136725 : p_index = p_index + 1
24429 136725 : tmp = scale*prim(p_index)
24430 136725 : ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24431 136725 : ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24432 136725 : kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24433 145840 : kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24434 : END DO
24435 9115 : kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
24436 10938 : kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
24437 : END DO
24438 : END DO
24439 : END DO
24440 24 : END SUBROUTINE block_15_5
24441 : ! **************************************************************************************************
24442 : !> \brief ...
24443 : !> \param mc_max ...
24444 : !> \param md_max ...
24445 : !> \param kbd ...
24446 : !> \param kbc ...
24447 : !> \param kad ...
24448 : !> \param kac ...
24449 : !> \param pbd ...
24450 : !> \param pbc ...
24451 : !> \param pad ...
24452 : !> \param pac ...
24453 : !> \param prim ...
24454 : !> \param scale ...
24455 : ! **************************************************************************************************
24456 19 : SUBROUTINE block_15_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
24457 : INTEGER :: mc_max, md_max
24458 : REAL(KIND=dp) :: kbd(6*md_max), kbc(6*mc_max), kad(15*md_max), kac(15*mc_max), &
24459 : pbd(6*md_max), pbc(6*mc_max), pad(15*md_max), pac(15*mc_max), prim(15*6*mc_max*md_max), &
24460 : scale
24461 :
24462 : INTEGER :: ma, mb, mc, md, p_index
24463 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
24464 :
24465 1057 : kbd(1:6*md_max) = 0.0_dp
24466 985 : kbc(1:6*mc_max) = 0.0_dp
24467 2614 : kad(1:15*md_max) = 0.0_dp
24468 2434 : kac(1:15*mc_max) = 0.0_dp
24469 : p_index = 0
24470 192 : DO md = 1, md_max
24471 1718 : DO mc = 1, mc_max
24472 10855 : DO mb = 1, 6
24473 9156 : ks_bd = 0.0_dp
24474 9156 : ks_bc = 0.0_dp
24475 9156 : p_bd = pbd((md - 1)*6 + mb)
24476 9156 : p_bc = pbc((mc - 1)*6 + mb)
24477 146496 : DO ma = 1, 15
24478 137340 : p_index = p_index + 1
24479 137340 : tmp = scale*prim(p_index)
24480 137340 : ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24481 137340 : ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24482 137340 : kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24483 146496 : kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24484 : END DO
24485 9156 : kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
24486 10682 : kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
24487 : END DO
24488 : END DO
24489 : END DO
24490 19 : END SUBROUTINE block_15_6
24491 : ! **************************************************************************************************
24492 : !> \brief ...
24493 : !> \param mc_max ...
24494 : !> \param md_max ...
24495 : !> \param kbd ...
24496 : !> \param kbc ...
24497 : !> \param kad ...
24498 : !> \param kac ...
24499 : !> \param pbd ...
24500 : !> \param pbc ...
24501 : !> \param pad ...
24502 : !> \param pac ...
24503 : !> \param prim ...
24504 : !> \param scale ...
24505 : ! **************************************************************************************************
24506 47 : SUBROUTINE block_15_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
24507 : INTEGER :: mc_max, md_max
24508 : REAL(KIND=dp) :: kbd(7*md_max), kbc(7*mc_max), kad(15*md_max), kac(15*mc_max), &
24509 : pbd(7*md_max), pbc(7*mc_max), pad(15*md_max), pac(15*mc_max), prim(15*7*mc_max*md_max), &
24510 : scale
24511 :
24512 : INTEGER :: ma, mb, mc, md, p_index
24513 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
24514 :
24515 2973 : kbd(1:7*md_max) = 0.0_dp
24516 2959 : kbc(1:7*mc_max) = 0.0_dp
24517 6317 : kad(1:15*md_max) = 0.0_dp
24518 6287 : kac(1:15*mc_max) = 0.0_dp
24519 : p_index = 0
24520 465 : DO md = 1, md_max
24521 4256 : DO mc = 1, mc_max
24522 30746 : DO mb = 1, 7
24523 26537 : ks_bd = 0.0_dp
24524 26537 : ks_bc = 0.0_dp
24525 26537 : p_bd = pbd((md - 1)*7 + mb)
24526 26537 : p_bc = pbc((mc - 1)*7 + mb)
24527 424592 : DO ma = 1, 15
24528 398055 : p_index = p_index + 1
24529 398055 : tmp = scale*prim(p_index)
24530 398055 : ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24531 398055 : ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24532 398055 : kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24533 424592 : kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24534 : END DO
24535 26537 : kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
24536 30328 : kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
24537 : END DO
24538 : END DO
24539 : END DO
24540 47 : END SUBROUTINE block_15_7
24541 : ! **************************************************************************************************
24542 : !> \brief ...
24543 : !> \param mc_max ...
24544 : !> \param md_max ...
24545 : !> \param kbd ...
24546 : !> \param kbc ...
24547 : !> \param kad ...
24548 : !> \param kac ...
24549 : !> \param pbd ...
24550 : !> \param pbc ...
24551 : !> \param pad ...
24552 : !> \param pac ...
24553 : !> \param prim ...
24554 : !> \param scale ...
24555 : ! **************************************************************************************************
24556 49 : SUBROUTINE block_15_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
24557 : INTEGER :: mc_max, md_max
24558 : REAL(KIND=dp) :: kbd(9*md_max), kbc(9*mc_max), kad(15*md_max), kac(15*mc_max), &
24559 : pbd(9*md_max), pbc(9*mc_max), pad(15*md_max), pac(15*mc_max), prim(15*9*mc_max*md_max), &
24560 : scale
24561 :
24562 : INTEGER :: ma, mb, mc, md, p_index
24563 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
24564 :
24565 4063 : kbd(1:9*md_max) = 0.0_dp
24566 3937 : kbc(1:9*mc_max) = 0.0_dp
24567 6739 : kad(1:15*md_max) = 0.0_dp
24568 6529 : kac(1:15*mc_max) = 0.0_dp
24569 : p_index = 0
24570 495 : DO md = 1, md_max
24571 4520 : DO mc = 1, mc_max
24572 40696 : DO mb = 1, 9
24573 36225 : ks_bd = 0.0_dp
24574 36225 : ks_bc = 0.0_dp
24575 36225 : p_bd = pbd((md - 1)*9 + mb)
24576 36225 : p_bc = pbc((mc - 1)*9 + mb)
24577 579600 : DO ma = 1, 15
24578 543375 : p_index = p_index + 1
24579 543375 : tmp = scale*prim(p_index)
24580 543375 : ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24581 543375 : ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24582 543375 : kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24583 579600 : kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24584 : END DO
24585 36225 : kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
24586 40250 : kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
24587 : END DO
24588 : END DO
24589 : END DO
24590 49 : END SUBROUTINE block_15_9
24591 : ! **************************************************************************************************
24592 : !> \brief ...
24593 : !> \param mc_max ...
24594 : !> \param md_max ...
24595 : !> \param kbd ...
24596 : !> \param kbc ...
24597 : !> \param kad ...
24598 : !> \param kac ...
24599 : !> \param pbd ...
24600 : !> \param pbc ...
24601 : !> \param pad ...
24602 : !> \param pac ...
24603 : !> \param prim ...
24604 : !> \param scale ...
24605 : ! **************************************************************************************************
24606 124 : SUBROUTINE block_15_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
24607 : INTEGER :: mc_max, md_max
24608 : REAL(KIND=dp) :: kbd(10*md_max), kbc(10*mc_max), kad(15*md_max), kac(15*mc_max), &
24609 : pbd(10*md_max), pbc(10*mc_max), pad(15*md_max), pac(15*mc_max), &
24610 : prim(15*10*mc_max*md_max), scale
24611 :
24612 : INTEGER :: ma, mb, mc, md, p_index
24613 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
24614 :
24615 9994 : kbd(1:10*md_max) = 0.0_dp
24616 8044 : kbc(1:10*mc_max) = 0.0_dp
24617 14929 : kad(1:15*md_max) = 0.0_dp
24618 12004 : kac(1:15*mc_max) = 0.0_dp
24619 : p_index = 0
24620 1111 : DO md = 1, md_max
24621 7941 : DO mc = 1, mc_max
24622 76117 : DO mb = 1, 10
24623 68300 : ks_bd = 0.0_dp
24624 68300 : ks_bc = 0.0_dp
24625 68300 : p_bd = pbd((md - 1)*10 + mb)
24626 68300 : p_bc = pbc((mc - 1)*10 + mb)
24627 1092800 : DO ma = 1, 15
24628 1024500 : p_index = p_index + 1
24629 1024500 : tmp = scale*prim(p_index)
24630 1024500 : ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24631 1024500 : ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24632 1024500 : kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24633 1092800 : kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24634 : END DO
24635 68300 : kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
24636 75130 : kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
24637 : END DO
24638 : END DO
24639 : END DO
24640 124 : END SUBROUTINE block_15_10
24641 : ! **************************************************************************************************
24642 : !> \brief ...
24643 : !> \param mc_max ...
24644 : !> \param md_max ...
24645 : !> \param kbd ...
24646 : !> \param kbc ...
24647 : !> \param kad ...
24648 : !> \param kac ...
24649 : !> \param pbd ...
24650 : !> \param pbc ...
24651 : !> \param pad ...
24652 : !> \param pac ...
24653 : !> \param prim ...
24654 : !> \param scale ...
24655 : ! **************************************************************************************************
24656 203 : SUBROUTINE block_15_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
24657 : INTEGER :: mc_max, md_max
24658 : REAL(KIND=dp) :: kbd(11*md_max), kbc(11*mc_max), kad(15*md_max), kac(15*mc_max), &
24659 : pbd(11*md_max), pbc(11*mc_max), pad(15*md_max), pac(15*mc_max), &
24660 : prim(15*11*mc_max*md_max), scale
24661 :
24662 : INTEGER :: ma, mb, mc, md, p_index
24663 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
24664 :
24665 17924 : kbd(1:11*md_max) = 0.0_dp
24666 13117 : kbc(1:11*mc_max) = 0.0_dp
24667 24368 : kad(1:15*md_max) = 0.0_dp
24668 17813 : kac(1:15*mc_max) = 0.0_dp
24669 : p_index = 0
24670 1814 : DO md = 1, md_max
24671 12037 : DO mc = 1, mc_max
24672 124287 : DO mb = 1, 11
24673 112453 : ks_bd = 0.0_dp
24674 112453 : ks_bc = 0.0_dp
24675 112453 : p_bd = pbd((md - 1)*11 + mb)
24676 112453 : p_bc = pbc((mc - 1)*11 + mb)
24677 1799248 : DO ma = 1, 15
24678 1686795 : p_index = p_index + 1
24679 1686795 : tmp = scale*prim(p_index)
24680 1686795 : ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24681 1686795 : ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24682 1686795 : kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24683 1799248 : kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24684 : END DO
24685 112453 : kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
24686 122676 : kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
24687 : END DO
24688 : END DO
24689 : END DO
24690 203 : END SUBROUTINE block_15_11
24691 : ! **************************************************************************************************
24692 : !> \brief ...
24693 : !> \param mc_max ...
24694 : !> \param md_max ...
24695 : !> \param kbd ...
24696 : !> \param kbc ...
24697 : !> \param kad ...
24698 : !> \param kac ...
24699 : !> \param pbd ...
24700 : !> \param pbc ...
24701 : !> \param pad ...
24702 : !> \param pac ...
24703 : !> \param prim ...
24704 : !> \param scale ...
24705 : ! **************************************************************************************************
24706 364 : SUBROUTINE block_15_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
24707 : INTEGER :: mc_max, md_max
24708 : REAL(KIND=dp) :: kbd(15*md_max), kbc(15*mc_max), kad(15*md_max), kac(15*mc_max), &
24709 : pbd(15*md_max), pbc(15*mc_max), pad(15*md_max), pac(15*mc_max), &
24710 : prim(15*15*mc_max*md_max), scale
24711 :
24712 : INTEGER :: ma, mb, mc, md, p_index
24713 : REAL(KIND=dp) :: ks_bc, ks_bd, p_bc, p_bd, tmp
24714 :
24715 45379 : kbd(1:15*md_max) = 0.0_dp
24716 34849 : kbc(1:15*mc_max) = 0.0_dp
24717 45379 : kad(1:15*md_max) = 0.0_dp
24718 34849 : kac(1:15*mc_max) = 0.0_dp
24719 : p_index = 0
24720 3365 : DO md = 1, md_max
24721 24077 : DO mc = 1, mc_max
24722 334393 : DO mb = 1, 15
24723 310680 : ks_bd = 0.0_dp
24724 310680 : ks_bc = 0.0_dp
24725 310680 : p_bd = pbd((md - 1)*15 + mb)
24726 310680 : p_bc = pbc((mc - 1)*15 + mb)
24727 4970880 : DO ma = 1, 15
24728 4660200 : p_index = p_index + 1
24729 4660200 : tmp = scale*prim(p_index)
24730 4660200 : ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24731 4660200 : ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24732 4660200 : kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24733 4970880 : kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24734 : END DO
24735 310680 : kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
24736 331392 : kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
24737 : END DO
24738 : END DO
24739 : END DO
24740 364 : END SUBROUTINE block_15_15
24741 : #endif
24742 : END MODULE hfx_contract_block
|
