(git:374b731)
Loading...
Searching...
No Matches
hfx_contract_block.F
Go to the documentation of this file.
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! **************************************************************************************************
15MODULE 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
23CONTAINS
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 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 SELECT CASE (ma_max)
66 CASE (1)
67 SELECT CASE (mb_max)
68 CASE (1)
69 SELECT CASE (mc_max)
70 CASE (1)
71 SELECT CASE (md_max)
72 CASE (1)
73 CALL block_1_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
74 CASE (2)
75 CALL block_1_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
76 CASE (3)
77 CALL block_1_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
78 CASE (4)
79 CALL block_1_1_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
80 CASE (5)
81 CALL block_1_1_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
82 CASE (6)
83 CALL block_1_1_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
84 CASE (7)
85 CALL block_1_1_1_7(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
86 CASE (9)
87 CALL block_1_1_1_9(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
88 CASE (10)
89 CALL block_1_1_1_10(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
90 CASE (11)
91 CALL block_1_1_1_11(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
92 CASE (15)
93 CALL block_1_1_1_15(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
94 CASE DEFAULT
95 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 SELECT CASE (md_max)
99 CASE (1)
100 CALL block_1_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
101 CASE (2)
102 CALL block_1_1_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
103 CASE (3)
104 CALL block_1_1_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
105 CASE (4)
106 CALL block_1_1_2_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
107 CASE (5)
108 CALL block_1_1_2_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
109 CASE (6)
110 CALL block_1_1_2_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
111 CASE (7)
112 CALL block_1_1_2_7(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
113 CASE (9)
114 CALL block_1_1_2_9(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
115 CASE (10)
116 CALL block_1_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
117 CASE (11)
118 CALL block_1_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
119 CASE (15)
120 CALL block_1_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
121 CASE DEFAULT
122 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 SELECT CASE (md_max)
126 CASE (1)
127 CALL block_1_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
128 CASE (2)
129 CALL block_1_1_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
130 CASE (3)
131 CALL block_1_1_3_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
132 CASE (4)
133 CALL block_1_1_3_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
134 CASE (5)
135 CALL block_1_1_3_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
136 CASE (6)
137 CALL block_1_1_3_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
138 CASE (7)
139 CALL block_1_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
140 CASE (9)
141 CALL block_1_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
142 CASE (10)
143 CALL block_1_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
144 CASE (11)
145 CALL block_1_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
146 CASE (15)
147 CALL block_1_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
148 CASE DEFAULT
149 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 SELECT CASE (md_max)
153 CASE (1)
154 CALL block_1_1_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
155 CASE (2)
156 CALL block_1_1_4_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
157 CASE (3)
158 CALL block_1_1_4_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
159 CASE (4)
160 CALL block_1_1_4_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
161 CASE (5)
162 CALL block_1_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
163 CASE (6)
164 CALL block_1_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
165 CASE (7)
166 CALL block_1_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
167 CASE (9)
168 CALL block_1_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
169 CASE (10)
170 CALL block_1_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
171 CASE (11)
172 CALL block_1_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
173 CASE (15)
174 CALL block_1_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
175 CASE DEFAULT
176 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 SELECT CASE (md_max)
180 CASE (1)
181 CALL block_1_1_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
182 CASE (2)
183 CALL block_1_1_5_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
184 CASE (3)
185 CALL block_1_1_5_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
186 CASE (4)
187 CALL block_1_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
188 CASE (5)
189 CALL block_1_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
190 CASE (6)
191 CALL block_1_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
192 CASE (7)
193 CALL block_1_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
194 CASE (9)
195 CALL block_1_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
196 CASE (10)
197 CALL block_1_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
198 CASE (11)
199 CALL block_1_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
200 CASE (15)
201 CALL block_1_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
202 CASE DEFAULT
203 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 SELECT CASE (md_max)
207 CASE (1)
208 CALL block_1_1_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
209 CASE (2)
210 CALL block_1_1_6_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
211 CASE (3)
212 CALL block_1_1_6_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
213 CASE (4)
214 CALL block_1_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
215 CASE (5)
216 CALL block_1_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
217 CASE (6)
218 CALL block_1_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
219 CASE (7)
220 CALL block_1_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
221 CASE (9)
222 CALL block_1_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
223 CASE (10)
224 CALL block_1_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
225 CASE (11)
226 CALL block_1_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
227 CASE (15)
228 CALL block_1_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
229 CASE DEFAULT
230 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 SELECT CASE (md_max)
234 CASE (1)
235 CALL block_1_1_7_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
236 CASE (2)
237 CALL block_1_1_7_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
238 CASE (3)
239 CALL block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
240 CASE (4)
241 CALL block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
242 CASE (5)
243 CALL block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
244 CASE (6)
245 CALL block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
246 CASE (7)
247 CALL block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
248 CASE (9)
249 CALL block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
250 CASE (10)
251 CALL block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
252 CASE (11)
253 CALL block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
254 CASE (15)
255 CALL block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
256 CASE DEFAULT
257 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 SELECT CASE (md_max)
261 CASE (1)
262 CALL block_1_1_9_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
263 CASE (2)
264 CALL block_1_1_9_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
265 CASE (3)
266 CALL block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
267 CASE (4)
268 CALL block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
269 CASE (5)
270 CALL block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
271 CASE (6)
272 CALL block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
273 CASE (7)
274 CALL block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
275 CASE (9)
276 CALL block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
277 CASE (10)
278 CALL block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
279 CASE (11)
280 CALL block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
281 CASE (15)
282 CALL block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
283 CASE DEFAULT
284 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 SELECT CASE (md_max)
288 CASE (1)
289 CALL block_1_1_10_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
290 CASE (2)
291 CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
292 CASE (3)
293 CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
294 CASE (4)
295 CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
296 CASE (5)
297 CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
298 CASE (6)
299 CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
300 CASE (7)
301 CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
302 CASE (9)
303 CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
304 CASE (10)
305 CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
306 CASE (11)
307 CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
308 CASE (15)
309 CALL block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
310 CASE DEFAULT
311 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 SELECT CASE (md_max)
315 CASE (1)
316 CALL block_1_1_11_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
317 CASE (2)
318 CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
319 CASE (3)
320 CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
321 CASE (4)
322 CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
323 CASE (5)
324 CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
325 CASE (6)
326 CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
327 CASE (7)
328 CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
329 CASE (9)
330 CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
331 CASE (10)
332 CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
333 CASE (11)
334 CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
335 CASE (15)
336 CALL block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
337 CASE DEFAULT
338 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 SELECT CASE (md_max)
342 CASE (1)
343 CALL block_1_1_15_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
344 CASE (2)
345 CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
346 CASE (3)
347 CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
348 CASE (4)
349 CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
350 CASE (5)
351 CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
352 CASE (6)
353 CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
354 CASE (7)
355 CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
356 CASE (9)
357 CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
358 CASE (10)
359 CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
360 CASE (11)
361 CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
362 CASE (15)
363 CALL block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
364 CASE DEFAULT
365 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 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 SELECT CASE (mc_max)
372 CASE (1)
373 SELECT CASE (md_max)
374 CASE (1)
375 CALL block_1_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
376 CASE (2)
377 CALL block_1_2_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
378 CASE (3)
379 CALL block_1_2_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
380 CASE (4)
381 CALL block_1_2_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
382 CASE (5)
383 CALL block_1_2_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
384 CASE (6)
385 CALL block_1_2_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
386 CASE (7)
387 CALL block_1_2_1_7(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
388 CASE (9)
389 CALL block_1_2_1_9(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
390 CASE (10)
391 CALL block_1_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
392 CASE (11)
393 CALL block_1_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
394 CASE (15)
395 CALL block_1_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
396 CASE DEFAULT
397 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 SELECT CASE (md_max)
401 CASE (1)
402 CALL block_1_2_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
403 CASE (2)
404 CALL block_1_2_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
405 CASE (3)
406 CALL block_1_2_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
407 CASE (4)
408 CALL block_1_2_2_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
409 CASE (5)
410 CALL block_1_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
411 CASE (6)
412 CALL block_1_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
413 CASE (7)
414 CALL block_1_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
415 CASE (9)
416 CALL block_1_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
417 CASE (10)
418 CALL block_1_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
419 CASE (11)
420 CALL block_1_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
421 CASE (15)
422 CALL block_1_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
423 CASE DEFAULT
424 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 SELECT CASE (md_max)
428 CASE (1)
429 CALL block_1_2_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
430 CASE (2)
431 CALL block_1_2_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
432 CASE (3)
433 CALL block_1_2_3_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
434 CASE (4)
435 CALL block_1_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
436 CASE (5)
437 CALL block_1_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
438 CASE (6)
439 CALL block_1_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
440 CASE (7)
441 CALL block_1_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
442 CASE (9)
443 CALL block_1_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
444 CASE (10)
445 CALL block_1_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
446 CASE (11)
447 CALL block_1_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
448 CASE (15)
449 CALL block_1_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
450 CASE DEFAULT
451 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 SELECT CASE (md_max)
455 CASE (1)
456 CALL block_1_2_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
457 CASE (2)
458 CALL block_1_2_4_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
459 CASE (3)
460 CALL block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
461 CASE (4)
462 CALL block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
463 CASE (5)
464 CALL block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
465 CASE (6)
466 CALL block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
467 CASE (7)
468 CALL block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
469 CASE (9)
470 CALL block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
471 CASE (10)
472 CALL block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
473 CASE (11)
474 CALL block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
475 CASE (15)
476 CALL block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
477 CASE DEFAULT
478 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 SELECT CASE (md_max)
482 CASE (1)
483 CALL block_1_2_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
484 CASE (2)
485 CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
486 CASE (3)
487 CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
488 CASE (4)
489 CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
490 CASE (5)
491 CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
492 CASE (6)
493 CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
494 CASE (7)
495 CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
496 CASE (9)
497 CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
498 CASE (10)
499 CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
500 CASE (11)
501 CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
502 CASE (15)
503 CALL block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
504 CASE DEFAULT
505 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 SELECT CASE (md_max)
509 CASE (1)
510 CALL block_1_2_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
511 CASE (2)
512 CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
513 CASE (3)
514 CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
515 CASE (4)
516 CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
517 CASE (5)
518 CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
519 CASE (6)
520 CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
521 CASE (7)
522 CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
523 CASE (9)
524 CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
525 CASE (10)
526 CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
527 CASE (11)
528 CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
529 CASE (15)
530 CALL block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
531 CASE DEFAULT
532 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 SELECT CASE (md_max)
536 CASE (1)
537 CALL block_1_2_7_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
538 CASE (2)
539 CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
540 CASE (3)
541 CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
542 CASE (4)
543 CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
544 CASE (5)
545 CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
546 CASE (6)
547 CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
548 CASE (7)
549 CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
550 CASE (9)
551 CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
552 CASE (10)
553 CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
554 CASE (11)
555 CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
556 CASE (15)
557 CALL block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
558 CASE DEFAULT
559 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 SELECT CASE (md_max)
563 CASE (1)
564 CALL block_1_2_9_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
565 CASE (2)
566 CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
567 CASE (3)
568 CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
569 CASE (4)
570 CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
571 CASE (5)
572 CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
573 CASE (6)
574 CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
575 CASE (7)
576 CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
577 CASE (9)
578 CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
579 CASE (10)
580 CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
581 CASE (11)
582 CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
583 CASE (15)
584 CALL block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
585 CASE DEFAULT
586 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 CALL block_1_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
590 CASE (11)
591 CALL block_1_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
592 CASE (15)
593 CALL block_1_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
594 CASE DEFAULT
595 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 SELECT CASE (mc_max)
599 CASE (1)
600 SELECT CASE (md_max)
601 CASE (1)
602 CALL block_1_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
603 CASE (2)
604 CALL block_1_3_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
605 CASE (3)
606 CALL block_1_3_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
607 CASE (4)
608 CALL block_1_3_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
609 CASE (5)
610 CALL block_1_3_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
611 CASE (6)
612 CALL block_1_3_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
613 CASE (7)
614 CALL block_1_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
615 CASE (9)
616 CALL block_1_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
617 CASE (10)
618 CALL block_1_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
619 CASE (11)
620 CALL block_1_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
621 CASE (15)
622 CALL block_1_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
623 CASE DEFAULT
624 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 SELECT CASE (md_max)
628 CASE (1)
629 CALL block_1_3_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
630 CASE (2)
631 CALL block_1_3_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
632 CASE (3)
633 CALL block_1_3_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
634 CASE (4)
635 CALL block_1_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
636 CASE (5)
637 CALL block_1_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
638 CASE (6)
639 CALL block_1_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
640 CASE (7)
641 CALL block_1_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
642 CASE (9)
643 CALL block_1_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
644 CASE (10)
645 CALL block_1_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
646 CASE (11)
647 CALL block_1_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
648 CASE (15)
649 CALL block_1_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
650 CASE DEFAULT
651 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 SELECT CASE (md_max)
655 CASE (1)
656 CALL block_1_3_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
657 CASE (2)
658 CALL block_1_3_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
659 CASE (3)
660 CALL block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
661 CASE (4)
662 CALL block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
663 CASE (5)
664 CALL block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
665 CASE (6)
666 CALL block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
667 CASE (7)
668 CALL block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
669 CASE (9)
670 CALL block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
671 CASE (10)
672 CALL block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
673 CASE (11)
674 CALL block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
675 CASE (15)
676 CALL block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
677 CASE DEFAULT
678 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 SELECT CASE (md_max)
682 CASE (1)
683 CALL block_1_3_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
684 CASE (2)
685 CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
686 CASE (3)
687 CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
688 CASE (4)
689 CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
690 CASE (5)
691 CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
692 CASE (6)
693 CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
694 CASE (7)
695 CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
696 CASE (9)
697 CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
698 CASE (10)
699 CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
700 CASE (11)
701 CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
702 CASE (15)
703 CALL block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
704 CASE DEFAULT
705 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 SELECT CASE (md_max)
709 CASE (1)
710 CALL block_1_3_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
711 CASE (2)
712 CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
713 CASE (3)
714 CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
715 CASE (4)
716 CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
717 CASE (5)
718 CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
719 CASE (6)
720 CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
721 CASE (7)
722 CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
723 CASE (9)
724 CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
725 CASE (10)
726 CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
727 CASE (11)
728 CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
729 CASE (15)
730 CALL block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
731 CASE DEFAULT
732 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 SELECT CASE (md_max)
736 CASE (1)
737 CALL block_1_3_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
738 CASE (2)
739 CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
740 CASE (3)
741 CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
742 CASE (4)
743 CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
744 CASE (5)
745 CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
746 CASE (6)
747 CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
748 CASE (7)
749 CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
750 CASE (9)
751 CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
752 CASE (10)
753 CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
754 CASE (11)
755 CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
756 CASE (15)
757 CALL block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
758 CASE DEFAULT
759 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 CALL block_1_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
763 CASE (9)
764 CALL block_1_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
765 CASE (10)
766 CALL block_1_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
767 CASE (11)
768 CALL block_1_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
769 CASE (15)
770 CALL block_1_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
771 CASE DEFAULT
772 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 SELECT CASE (mc_max)
776 CASE (1)
777 SELECT CASE (md_max)
778 CASE (1)
779 CALL block_1_4_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
780 CASE (2)
781 CALL block_1_4_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
782 CASE (3)
783 CALL block_1_4_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
784 CASE (4)
785 CALL block_1_4_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
786 CASE (5)
787 CALL block_1_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
788 CASE (6)
789 CALL block_1_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
790 CASE (7)
791 CALL block_1_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
792 CASE (9)
793 CALL block_1_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
794 CASE (10)
795 CALL block_1_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
796 CASE (11)
797 CALL block_1_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
798 CASE (15)
799 CALL block_1_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
800 CASE DEFAULT
801 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 SELECT CASE (md_max)
805 CASE (1)
806 CALL block_1_4_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
807 CASE (2)
808 CALL block_1_4_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
809 CASE (3)
810 CALL block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
811 CASE (4)
812 CALL block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
813 CASE (5)
814 CALL block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
815 CASE (6)
816 CALL block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
817 CASE (7)
818 CALL block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
819 CASE (9)
820 CALL block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
821 CASE (10)
822 CALL block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
823 CASE (11)
824 CALL block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
825 CASE (15)
826 CALL block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
827 CASE DEFAULT
828 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 SELECT CASE (md_max)
832 CASE (1)
833 CALL block_1_4_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
834 CASE (2)
835 CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
836 CASE (3)
837 CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
838 CASE (4)
839 CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
840 CASE (5)
841 CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
842 CASE (6)
843 CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
844 CASE (7)
845 CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
846 CASE (9)
847 CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
848 CASE (10)
849 CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
850 CASE (11)
851 CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
852 CASE (15)
853 CALL block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
854 CASE DEFAULT
855 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 SELECT CASE (md_max)
859 CASE (1)
860 CALL block_1_4_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
861 CASE (2)
862 CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
863 CASE (3)
864 CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
865 CASE (4)
866 CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
867 CASE (5)
868 CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
869 CASE (6)
870 CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
871 CASE (7)
872 CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
873 CASE (9)
874 CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
875 CASE (10)
876 CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
877 CASE (11)
878 CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
879 CASE (15)
880 CALL block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
881 CASE DEFAULT
882 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 CALL block_1_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
886 CASE (6)
887 CALL block_1_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
888 CASE (7)
889 CALL block_1_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
890 CASE (9)
891 CALL block_1_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
892 CASE (10)
893 CALL block_1_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
894 CASE (11)
895 CALL block_1_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
896 CASE (15)
897 CALL block_1_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
898 CASE DEFAULT
899 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 SELECT CASE (mc_max)
903 CASE (1)
904 SELECT CASE (md_max)
905 CASE (1)
906 CALL block_1_5_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
907 CASE (2)
908 CALL block_1_5_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
909 CASE (3)
910 CALL block_1_5_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
911 CASE (4)
912 CALL block_1_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
913 CASE (5)
914 CALL block_1_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
915 CASE (6)
916 CALL block_1_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
917 CASE (7)
918 CALL block_1_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
919 CASE (9)
920 CALL block_1_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
921 CASE (10)
922 CALL block_1_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
923 CASE (11)
924 CALL block_1_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
925 CASE (15)
926 CALL block_1_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
927 CASE DEFAULT
928 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 SELECT CASE (md_max)
932 CASE (1)
933 CALL block_1_5_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
934 CASE (2)
935 CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
936 CASE (3)
937 CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
938 CASE (4)
939 CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
940 CASE (5)
941 CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
942 CASE (6)
943 CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
944 CASE (7)
945 CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
946 CASE (9)
947 CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
948 CASE (10)
949 CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
950 CASE (11)
951 CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
952 CASE (15)
953 CALL block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
954 CASE DEFAULT
955 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 SELECT CASE (md_max)
959 CASE (1)
960 CALL block_1_5_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
961 CASE (2)
962 CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
963 CASE (3)
964 CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
965 CASE (4)
966 CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
967 CASE (5)
968 CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
969 CASE (6)
970 CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
971 CASE (7)
972 CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
973 CASE (9)
974 CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
975 CASE (10)
976 CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
977 CASE (11)
978 CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
979 CASE (15)
980 CALL block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
981 CASE DEFAULT
982 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 CALL block_1_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
986 CASE (5)
987 CALL block_1_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
988 CASE (6)
989 CALL block_1_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
990 CASE (7)
991 CALL block_1_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
992 CASE (9)
993 CALL block_1_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
994 CASE (10)
995 CALL block_1_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
996 CASE (11)
997 CALL block_1_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
998 CASE (15)
999 CALL block_1_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1000 CASE DEFAULT
1001 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 SELECT CASE (mc_max)
1005 CASE (1)
1006 SELECT CASE (md_max)
1007 CASE (1)
1008 CALL block_1_6_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1009 CASE (2)
1010 CALL block_1_6_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1011 CASE (3)
1012 CALL block_1_6_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1013 CASE (4)
1014 CALL block_1_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1015 CASE (5)
1016 CALL block_1_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1017 CASE (6)
1018 CALL block_1_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1019 CASE (7)
1020 CALL block_1_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1021 CASE (9)
1022 CALL block_1_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1023 CASE (10)
1024 CALL block_1_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1025 CASE (11)
1026 CALL block_1_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1027 CASE (15)
1028 CALL block_1_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1029 CASE DEFAULT
1030 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 SELECT CASE (md_max)
1034 CASE (1)
1035 CALL block_1_6_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1036 CASE (2)
1037 CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1038 CASE (3)
1039 CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1040 CASE (4)
1041 CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1042 CASE (5)
1043 CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1044 CASE (6)
1045 CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1046 CASE (7)
1047 CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1048 CASE (9)
1049 CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1050 CASE (10)
1051 CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1052 CASE (11)
1053 CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1054 CASE (15)
1055 CALL block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1056 CASE DEFAULT
1057 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 SELECT CASE (md_max)
1061 CASE (1)
1062 CALL block_1_6_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1063 CASE (2)
1064 CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1065 CASE (3)
1066 CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1067 CASE (4)
1068 CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1069 CASE (5)
1070 CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1071 CASE (6)
1072 CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1073 CASE (7)
1074 CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1075 CASE (9)
1076 CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1077 CASE (10)
1078 CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1079 CASE (11)
1080 CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1081 CASE (15)
1082 CALL block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1083 CASE DEFAULT
1084 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 CALL block_1_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1088 CASE (5)
1089 CALL block_1_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1090 CASE (6)
1091 CALL block_1_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1092 CASE (7)
1093 CALL block_1_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1094 CASE (9)
1095 CALL block_1_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1096 CASE (10)
1097 CALL block_1_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1098 CASE (11)
1099 CALL block_1_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1100 CASE (15)
1101 CALL block_1_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1102 CASE DEFAULT
1103 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 SELECT CASE (mc_max)
1107 CASE (1)
1108 SELECT CASE (md_max)
1109 CASE (1)
1110 CALL block_1_7_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1111 CASE (2)
1112 CALL block_1_7_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1113 CASE (3)
1114 CALL block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1115 CASE (4)
1116 CALL block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1117 CASE (5)
1118 CALL block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1119 CASE (6)
1120 CALL block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1121 CASE (7)
1122 CALL block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1123 CASE (9)
1124 CALL block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1125 CASE (10)
1126 CALL block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1127 CASE (11)
1128 CALL block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1129 CASE (15)
1130 CALL block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1131 CASE DEFAULT
1132 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 SELECT CASE (md_max)
1136 CASE (1)
1137 CALL block_1_7_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1138 CASE (2)
1139 CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1140 CASE (3)
1141 CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1142 CASE (4)
1143 CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1144 CASE (5)
1145 CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1146 CASE (6)
1147 CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1148 CASE (7)
1149 CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1150 CASE (9)
1151 CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1152 CASE (10)
1153 CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1154 CASE (11)
1155 CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1156 CASE (15)
1157 CALL block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1158 CASE DEFAULT
1159 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 CALL block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1163 CASE (4)
1164 CALL block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1165 CASE (5)
1166 CALL block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1167 CASE (6)
1168 CALL block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1169 CASE (7)
1170 CALL block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1171 CASE (9)
1172 CALL block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1173 CASE (10)
1174 CALL block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1175 CASE (11)
1176 CALL block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1177 CASE (15)
1178 CALL block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1179 CASE DEFAULT
1180 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 SELECT CASE (mc_max)
1184 CASE (1)
1185 SELECT CASE (md_max)
1186 CASE (1)
1187 CALL block_1_9_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1188 CASE (2)
1189 CALL block_1_9_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1190 CASE (3)
1191 CALL block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1192 CASE (4)
1193 CALL block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1194 CASE (5)
1195 CALL block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1196 CASE (6)
1197 CALL block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1198 CASE (7)
1199 CALL block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1200 CASE (9)
1201 CALL block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1202 CASE (10)
1203 CALL block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1204 CASE (11)
1205 CALL block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1206 CASE (15)
1207 CALL block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1208 CASE DEFAULT
1209 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 SELECT CASE (md_max)
1213 CASE (1)
1214 CALL block_1_9_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1215 CASE (2)
1216 CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1217 CASE (3)
1218 CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1219 CASE (4)
1220 CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1221 CASE (5)
1222 CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1223 CASE (6)
1224 CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1225 CASE (7)
1226 CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1227 CASE (9)
1228 CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1229 CASE (10)
1230 CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1231 CASE (11)
1232 CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1233 CASE (15)
1234 CALL block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1235 CASE DEFAULT
1236 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 CALL block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1240 CASE (4)
1241 CALL block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1242 CASE (5)
1243 CALL block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1244 CASE (6)
1245 CALL block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1246 CASE (7)
1247 CALL block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1248 CASE (9)
1249 CALL block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1250 CASE (10)
1251 CALL block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1252 CASE (11)
1253 CALL block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1254 CASE (15)
1255 CALL block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1256 CASE DEFAULT
1257 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 SELECT CASE (mc_max)
1261 CASE (1)
1262 SELECT CASE (md_max)
1263 CASE (1)
1264 CALL block_1_10_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1265 CASE (2)
1266 CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1267 CASE (3)
1268 CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1269 CASE (4)
1270 CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1271 CASE (5)
1272 CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1273 CASE (6)
1274 CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1275 CASE (7)
1276 CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1277 CASE (9)
1278 CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1279 CASE (10)
1280 CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1281 CASE (11)
1282 CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1283 CASE (15)
1284 CALL block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1285 CASE DEFAULT
1286 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 CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1290 CASE (3)
1291 CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1292 CASE (4)
1293 CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1294 CASE (5)
1295 CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1296 CASE (6)
1297 CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1298 CASE (7)
1299 CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1300 CASE (9)
1301 CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1302 CASE (10)
1303 CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1304 CASE (11)
1305 CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1306 CASE (15)
1307 CALL block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1308 CASE DEFAULT
1309 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 SELECT CASE (mc_max)
1313 CASE (1)
1314 SELECT CASE (md_max)
1315 CASE (1)
1316 CALL block_1_11_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1317 CASE (2)
1318 CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1319 CASE (3)
1320 CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1321 CASE (4)
1322 CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1323 CASE (5)
1324 CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1325 CASE (6)
1326 CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1327 CASE (7)
1328 CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1329 CASE (9)
1330 CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1331 CASE (10)
1332 CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1333 CASE (11)
1334 CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1335 CASE (15)
1336 CALL block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1337 CASE DEFAULT
1338 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 CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1342 CASE (3)
1343 CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1344 CASE (4)
1345 CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1346 CASE (5)
1347 CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1348 CASE (6)
1349 CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1350 CASE (7)
1351 CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1352 CASE (9)
1353 CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1354 CASE (10)
1355 CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1356 CASE (11)
1357 CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1358 CASE (15)
1359 CALL block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1360 CASE DEFAULT
1361 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 SELECT CASE (mc_max)
1365 CASE (1)
1366 SELECT CASE (md_max)
1367 CASE (1)
1368 CALL block_1_15_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1369 CASE (2)
1370 CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1371 CASE (3)
1372 CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1373 CASE (4)
1374 CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1375 CASE (5)
1376 CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1377 CASE (6)
1378 CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1379 CASE (7)
1380 CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1381 CASE (9)
1382 CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1383 CASE (10)
1384 CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1385 CASE (11)
1386 CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1387 CASE (15)
1388 CALL block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1389 CASE DEFAULT
1390 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 CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1394 CASE (3)
1395 CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1396 CASE (4)
1397 CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1398 CASE (5)
1399 CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1400 CASE (6)
1401 CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1402 CASE (7)
1403 CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1404 CASE (9)
1405 CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1406 CASE (10)
1407 CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1408 CASE (11)
1409 CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1410 CASE (15)
1411 CALL block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1412 CASE DEFAULT
1413 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 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 SELECT CASE (mb_max)
1420 CASE (1)
1421 SELECT CASE (mc_max)
1422 CASE (1)
1423 SELECT CASE (md_max)
1424 CASE (1)
1425 CALL block_2_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1426 CASE (2)
1427 CALL block_2_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1428 CASE (3)
1429 CALL block_2_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1430 CASE (4)
1431 CALL block_2_1_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1432 CASE (5)
1433 CALL block_2_1_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1434 CASE (6)
1435 CALL block_2_1_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1436 CASE (7)
1437 CALL block_2_1_1_7(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1438 CASE (9)
1439 CALL block_2_1_1_9(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1440 CASE (10)
1441 CALL block_2_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1442 CASE (11)
1443 CALL block_2_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1444 CASE (15)
1445 CALL block_2_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1446 CASE DEFAULT
1447 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 SELECT CASE (md_max)
1451 CASE (1)
1452 CALL block_2_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1453 CASE (2)
1454 CALL block_2_1_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1455 CASE (3)
1456 CALL block_2_1_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1457 CASE (4)
1458 CALL block_2_1_2_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1459 CASE (5)
1460 CALL block_2_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1461 CASE (6)
1462 CALL block_2_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1463 CASE (7)
1464 CALL block_2_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1465 CASE (9)
1466 CALL block_2_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1467 CASE (10)
1468 CALL block_2_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1469 CASE (11)
1470 CALL block_2_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1471 CASE (15)
1472 CALL block_2_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1473 CASE DEFAULT
1474 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 SELECT CASE (md_max)
1478 CASE (1)
1479 CALL block_2_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1480 CASE (2)
1481 CALL block_2_1_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1482 CASE (3)
1483 CALL block_2_1_3_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1484 CASE (4)
1485 CALL block_2_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1486 CASE (5)
1487 CALL block_2_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1488 CASE (6)
1489 CALL block_2_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1490 CASE (7)
1491 CALL block_2_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1492 CASE (9)
1493 CALL block_2_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1494 CASE (10)
1495 CALL block_2_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1496 CASE (11)
1497 CALL block_2_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1498 CASE (15)
1499 CALL block_2_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1500 CASE DEFAULT
1501 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 SELECT CASE (md_max)
1505 CASE (1)
1506 CALL block_2_1_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1507 CASE (2)
1508 CALL block_2_1_4_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1509 CASE (3)
1510 CALL block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1511 CASE (4)
1512 CALL block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1513 CASE (5)
1514 CALL block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1515 CASE (6)
1516 CALL block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1517 CASE (7)
1518 CALL block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1519 CASE (9)
1520 CALL block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1521 CASE (10)
1522 CALL block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1523 CASE (11)
1524 CALL block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1525 CASE (15)
1526 CALL block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1527 CASE DEFAULT
1528 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 SELECT CASE (md_max)
1532 CASE (1)
1533 CALL block_2_1_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1534 CASE (2)
1535 CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1536 CASE (3)
1537 CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1538 CASE (4)
1539 CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1540 CASE (5)
1541 CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1542 CASE (6)
1543 CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1544 CASE (7)
1545 CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1546 CASE (9)
1547 CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1548 CASE (10)
1549 CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1550 CASE (11)
1551 CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1552 CASE (15)
1553 CALL block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1554 CASE DEFAULT
1555 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 SELECT CASE (md_max)
1559 CASE (1)
1560 CALL block_2_1_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1561 CASE (2)
1562 CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1563 CASE (3)
1564 CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1565 CASE (4)
1566 CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1567 CASE (5)
1568 CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1569 CASE (6)
1570 CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1571 CASE (7)
1572 CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1573 CASE (9)
1574 CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1575 CASE (10)
1576 CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1577 CASE (11)
1578 CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1579 CASE (15)
1580 CALL block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1581 CASE DEFAULT
1582 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 SELECT CASE (md_max)
1586 CASE (1)
1587 CALL block_2_1_7_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1588 CASE (2)
1589 CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1590 CASE (3)
1591 CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1592 CASE (4)
1593 CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1594 CASE (5)
1595 CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1596 CASE (6)
1597 CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1598 CASE (7)
1599 CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1600 CASE (9)
1601 CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1602 CASE (10)
1603 CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1604 CASE (11)
1605 CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1606 CASE (15)
1607 CALL block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1608 CASE DEFAULT
1609 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 SELECT CASE (md_max)
1613 CASE (1)
1614 CALL block_2_1_9_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1615 CASE (2)
1616 CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1617 CASE (3)
1618 CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1619 CASE (4)
1620 CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1621 CASE (5)
1622 CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1623 CASE (6)
1624 CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1625 CASE (7)
1626 CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1627 CASE (9)
1628 CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1629 CASE (10)
1630 CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1631 CASE (11)
1632 CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1633 CASE (15)
1634 CALL block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1635 CASE DEFAULT
1636 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 CALL block_2_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1640 CASE (11)
1641 CALL block_2_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1642 CASE (15)
1643 CALL block_2_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1644 CASE DEFAULT
1645 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 SELECT CASE (mc_max)
1649 CASE (1)
1650 SELECT CASE (md_max)
1651 CASE (1)
1652 CALL block_2_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1653 CASE (2)
1654 CALL block_2_2_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1655 CASE (3)
1656 CALL block_2_2_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1657 CASE (4)
1658 CALL block_2_2_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1659 CASE (5)
1660 CALL block_2_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1661 CASE (6)
1662 CALL block_2_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1663 CASE (7)
1664 CALL block_2_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1665 CASE (9)
1666 CALL block_2_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1667 CASE (10)
1668 CALL block_2_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1669 CASE (11)
1670 CALL block_2_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1671 CASE (15)
1672 CALL block_2_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1673 CASE DEFAULT
1674 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 SELECT CASE (md_max)
1678 CASE (1)
1679 CALL block_2_2_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1680 CASE (2)
1681 CALL block_2_2_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1682 CASE (3)
1683 CALL block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1684 CASE (4)
1685 CALL block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1686 CASE (5)
1687 CALL block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1688 CASE (6)
1689 CALL block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1690 CASE (7)
1691 CALL block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1692 CASE (9)
1693 CALL block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1694 CASE (10)
1695 CALL block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1696 CASE (11)
1697 CALL block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1698 CASE (15)
1699 CALL block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1700 CASE DEFAULT
1701 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 SELECT CASE (md_max)
1705 CASE (1)
1706 CALL block_2_2_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1707 CASE (2)
1708 CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1709 CASE (3)
1710 CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1711 CASE (4)
1712 CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1713 CASE (5)
1714 CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1715 CASE (6)
1716 CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1717 CASE (7)
1718 CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1719 CASE (9)
1720 CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1721 CASE (10)
1722 CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1723 CASE (11)
1724 CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1725 CASE (15)
1726 CALL block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1727 CASE DEFAULT
1728 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 SELECT CASE (md_max)
1732 CASE (1)
1733 CALL block_2_2_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1734 CASE (2)
1735 CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1736 CASE (3)
1737 CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1738 CASE (4)
1739 CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1740 CASE (5)
1741 CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1742 CASE (6)
1743 CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1744 CASE (7)
1745 CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1746 CASE (9)
1747 CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1748 CASE (10)
1749 CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1750 CASE (11)
1751 CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1752 CASE (15)
1753 CALL block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1754 CASE DEFAULT
1755 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 CALL block_2_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1759 CASE (6)
1760 CALL block_2_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1761 CASE (7)
1762 CALL block_2_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1763 CASE (9)
1764 CALL block_2_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1765 CASE (10)
1766 CALL block_2_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1767 CASE (11)
1768 CALL block_2_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1769 CASE (15)
1770 CALL block_2_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1771 CASE DEFAULT
1772 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 SELECT CASE (mc_max)
1776 CASE (1)
1777 SELECT CASE (md_max)
1778 CASE (1)
1779 CALL block_2_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1780 CASE (2)
1781 CALL block_2_3_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1782 CASE (3)
1783 CALL block_2_3_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1784 CASE (4)
1785 CALL block_2_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1786 CASE (5)
1787 CALL block_2_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1788 CASE (6)
1789 CALL block_2_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1790 CASE (7)
1791 CALL block_2_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1792 CASE (9)
1793 CALL block_2_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1794 CASE (10)
1795 CALL block_2_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1796 CASE (11)
1797 CALL block_2_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1798 CASE (15)
1799 CALL block_2_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1800 CASE DEFAULT
1801 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 SELECT CASE (md_max)
1805 CASE (1)
1806 CALL block_2_3_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1807 CASE (2)
1808 CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1809 CASE (3)
1810 CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1811 CASE (4)
1812 CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1813 CASE (5)
1814 CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1815 CASE (6)
1816 CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1817 CASE (7)
1818 CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1819 CASE (9)
1820 CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1821 CASE (10)
1822 CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1823 CASE (11)
1824 CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1825 CASE (15)
1826 CALL block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1827 CASE DEFAULT
1828 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 SELECT CASE (md_max)
1832 CASE (1)
1833 CALL block_2_3_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1834 CASE (2)
1835 CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1836 CASE (3)
1837 CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1838 CASE (4)
1839 CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1840 CASE (5)
1841 CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1842 CASE (6)
1843 CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1844 CASE (7)
1845 CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1846 CASE (9)
1847 CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1848 CASE (10)
1849 CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1850 CASE (11)
1851 CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1852 CASE (15)
1853 CALL block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1854 CASE DEFAULT
1855 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 CALL block_2_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1859 CASE (5)
1860 CALL block_2_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1861 CASE (6)
1862 CALL block_2_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1863 CASE (7)
1864 CALL block_2_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1865 CASE (9)
1866 CALL block_2_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1867 CASE (10)
1868 CALL block_2_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1869 CASE (11)
1870 CALL block_2_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1871 CASE (15)
1872 CALL block_2_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1873 CASE DEFAULT
1874 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 SELECT CASE (mc_max)
1878 CASE (1)
1879 SELECT CASE (md_max)
1880 CASE (1)
1881 CALL block_2_4_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1882 CASE (2)
1883 CALL block_2_4_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1884 CASE (3)
1885 CALL block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1886 CASE (4)
1887 CALL block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1888 CASE (5)
1889 CALL block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1890 CASE (6)
1891 CALL block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1892 CASE (7)
1893 CALL block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1894 CASE (9)
1895 CALL block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1896 CASE (10)
1897 CALL block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1898 CASE (11)
1899 CALL block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1900 CASE (15)
1901 CALL block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1902 CASE DEFAULT
1903 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 SELECT CASE (md_max)
1907 CASE (1)
1908 CALL block_2_4_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1909 CASE (2)
1910 CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1911 CASE (3)
1912 CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1913 CASE (4)
1914 CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1915 CASE (5)
1916 CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1917 CASE (6)
1918 CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1919 CASE (7)
1920 CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1921 CASE (9)
1922 CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1923 CASE (10)
1924 CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1925 CASE (11)
1926 CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1927 CASE (15)
1928 CALL block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1929 CASE DEFAULT
1930 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 CALL block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1934 CASE (4)
1935 CALL block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1936 CASE (5)
1937 CALL block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1938 CASE (6)
1939 CALL block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1940 CASE (7)
1941 CALL block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1942 CASE (9)
1943 CALL block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1944 CASE (10)
1945 CALL block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1946 CASE (11)
1947 CALL block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1948 CASE (15)
1949 CALL block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1950 CASE DEFAULT
1951 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 SELECT CASE (mc_max)
1955 CASE (1)
1956 SELECT CASE (md_max)
1957 CASE (1)
1958 CALL block_2_5_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1959 CASE (2)
1960 CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1961 CASE (3)
1962 CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1963 CASE (4)
1964 CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1965 CASE (5)
1966 CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1967 CASE (6)
1968 CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1969 CASE (7)
1970 CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1971 CASE (9)
1972 CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1973 CASE (10)
1974 CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1975 CASE (11)
1976 CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1977 CASE (15)
1978 CALL block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1979 CASE DEFAULT
1980 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 CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1984 CASE (3)
1985 CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1986 CASE (4)
1987 CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1988 CASE (5)
1989 CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1990 CASE (6)
1991 CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1992 CASE (7)
1993 CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1994 CASE (9)
1995 CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1996 CASE (10)
1997 CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
1998 CASE (11)
1999 CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2000 CASE (15)
2001 CALL block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2002 CASE DEFAULT
2003 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 SELECT CASE (mc_max)
2007 CASE (1)
2008 SELECT CASE (md_max)
2009 CASE (1)
2010 CALL block_2_6_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2011 CASE (2)
2012 CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2013 CASE (3)
2014 CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2015 CASE (4)
2016 CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2017 CASE (5)
2018 CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2019 CASE (6)
2020 CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2021 CASE (7)
2022 CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2023 CASE (9)
2024 CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2025 CASE (10)
2026 CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2027 CASE (11)
2028 CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2029 CASE (15)
2030 CALL block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2031 CASE DEFAULT
2032 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 CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2036 CASE (3)
2037 CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2038 CASE (4)
2039 CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2040 CASE (5)
2041 CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2042 CASE (6)
2043 CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2044 CASE (7)
2045 CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2046 CASE (9)
2047 CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2048 CASE (10)
2049 CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2050 CASE (11)
2051 CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2052 CASE (15)
2053 CALL block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2054 CASE DEFAULT
2055 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 SELECT CASE (mc_max)
2059 CASE (1)
2060 SELECT CASE (md_max)
2061 CASE (1)
2062 CALL block_2_7_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2063 CASE (2)
2064 CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2065 CASE (3)
2066 CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2067 CASE (4)
2068 CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2069 CASE (5)
2070 CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2071 CASE (6)
2072 CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2073 CASE (7)
2074 CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2075 CASE (9)
2076 CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2077 CASE (10)
2078 CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2079 CASE (11)
2080 CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2081 CASE (15)
2082 CALL block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2083 CASE DEFAULT
2084 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 CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2088 CASE (3)
2089 CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2090 CASE (4)
2091 CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2092 CASE (5)
2093 CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2094 CASE (6)
2095 CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2096 CASE (7)
2097 CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2098 CASE (9)
2099 CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2100 CASE (10)
2101 CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2102 CASE (11)
2103 CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2104 CASE (15)
2105 CALL block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2106 CASE DEFAULT
2107 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 SELECT CASE (mc_max)
2111 CASE (1)
2112 SELECT CASE (md_max)
2113 CASE (1)
2114 CALL block_2_9_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2115 CASE (2)
2116 CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2117 CASE (3)
2118 CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2119 CASE (4)
2120 CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2121 CASE (5)
2122 CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2123 CASE (6)
2124 CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2125 CASE (7)
2126 CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2127 CASE (9)
2128 CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2129 CASE (10)
2130 CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2131 CASE (11)
2132 CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2133 CASE (15)
2134 CALL block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2135 CASE DEFAULT
2136 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 CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2140 CASE (3)
2141 CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2142 CASE (4)
2143 CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2144 CASE (5)
2145 CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2146 CASE (6)
2147 CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2148 CASE (7)
2149 CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2150 CASE (9)
2151 CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2152 CASE (10)
2153 CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2154 CASE (11)
2155 CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2156 CASE (15)
2157 CALL block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2158 CASE DEFAULT
2159 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 CALL block_2_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2163 CASE (11)
2164 CALL block_2_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2165 CASE (15)
2166 CALL block_2_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2167 CASE DEFAULT
2168 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 SELECT CASE (mb_max)
2172 CASE (1)
2173 SELECT CASE (mc_max)
2174 CASE (1)
2175 SELECT CASE (md_max)
2176 CASE (1)
2177 CALL block_3_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2178 CASE (2)
2179 CALL block_3_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2180 CASE (3)
2181 CALL block_3_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2182 CASE (4)
2183 CALL block_3_1_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2184 CASE (5)
2185 CALL block_3_1_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2186 CASE (6)
2187 CALL block_3_1_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2188 CASE (7)
2189 CALL block_3_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2190 CASE (9)
2191 CALL block_3_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2192 CASE (10)
2193 CALL block_3_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2194 CASE (11)
2195 CALL block_3_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2196 CASE (15)
2197 CALL block_3_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2198 CASE DEFAULT
2199 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 SELECT CASE (md_max)
2203 CASE (1)
2204 CALL block_3_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2205 CASE (2)
2206 CALL block_3_1_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2207 CASE (3)
2208 CALL block_3_1_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2209 CASE (4)
2210 CALL block_3_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2211 CASE (5)
2212 CALL block_3_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2213 CASE (6)
2214 CALL block_3_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2215 CASE (7)
2216 CALL block_3_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2217 CASE (9)
2218 CALL block_3_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2219 CASE (10)
2220 CALL block_3_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2221 CASE (11)
2222 CALL block_3_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2223 CASE (15)
2224 CALL block_3_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2225 CASE DEFAULT
2226 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 SELECT CASE (md_max)
2230 CASE (1)
2231 CALL block_3_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2232 CASE (2)
2233 CALL block_3_1_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2234 CASE (3)
2235 CALL block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2236 CASE (4)
2237 CALL block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2238 CASE (5)
2239 CALL block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2240 CASE (6)
2241 CALL block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2242 CASE (7)
2243 CALL block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2244 CASE (9)
2245 CALL block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2246 CASE (10)
2247 CALL block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2248 CASE (11)
2249 CALL block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2250 CASE (15)
2251 CALL block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2252 CASE DEFAULT
2253 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 SELECT CASE (md_max)
2257 CASE (1)
2258 CALL block_3_1_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2259 CASE (2)
2260 CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2261 CASE (3)
2262 CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2263 CASE (4)
2264 CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2265 CASE (5)
2266 CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2267 CASE (6)
2268 CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2269 CASE (7)
2270 CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2271 CASE (9)
2272 CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2273 CASE (10)
2274 CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2275 CASE (11)
2276 CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2277 CASE (15)
2278 CALL block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2279 CASE DEFAULT
2280 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 SELECT CASE (md_max)
2284 CASE (1)
2285 CALL block_3_1_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2286 CASE (2)
2287 CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2288 CASE (3)
2289 CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2290 CASE (4)
2291 CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2292 CASE (5)
2293 CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2294 CASE (6)
2295 CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2296 CASE (7)
2297 CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2298 CASE (9)
2299 CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2300 CASE (10)
2301 CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2302 CASE (11)
2303 CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2304 CASE (15)
2305 CALL block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2306 CASE DEFAULT
2307 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 SELECT CASE (md_max)
2311 CASE (1)
2312 CALL block_3_1_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2313 CASE (2)
2314 CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2315 CASE (3)
2316 CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2317 CASE (4)
2318 CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2319 CASE (5)
2320 CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2321 CASE (6)
2322 CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2323 CASE (7)
2324 CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2325 CASE (9)
2326 CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2327 CASE (10)
2328 CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2329 CASE (11)
2330 CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2331 CASE (15)
2332 CALL block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2333 CASE DEFAULT
2334 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 CALL block_3_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2338 CASE (9)
2339 CALL block_3_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2340 CASE (10)
2341 CALL block_3_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2342 CASE (11)
2343 CALL block_3_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2344 CASE (15)
2345 CALL block_3_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2346 CASE DEFAULT
2347 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 SELECT CASE (mc_max)
2351 CASE (1)
2352 SELECT CASE (md_max)
2353 CASE (1)
2354 CALL block_3_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2355 CASE (2)
2356 CALL block_3_2_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2357 CASE (3)
2358 CALL block_3_2_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2359 CASE (4)
2360 CALL block_3_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2361 CASE (5)
2362 CALL block_3_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2363 CASE (6)
2364 CALL block_3_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2365 CASE (7)
2366 CALL block_3_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2367 CASE (9)
2368 CALL block_3_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2369 CASE (10)
2370 CALL block_3_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2371 CASE (11)
2372 CALL block_3_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2373 CASE (15)
2374 CALL block_3_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2375 CASE DEFAULT
2376 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 SELECT CASE (md_max)
2380 CASE (1)
2381 CALL block_3_2_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2382 CASE (2)
2383 CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2384 CASE (3)
2385 CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2386 CASE (4)
2387 CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2388 CASE (5)
2389 CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2390 CASE (6)
2391 CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2392 CASE (7)
2393 CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2394 CASE (9)
2395 CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2396 CASE (10)
2397 CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2398 CASE (11)
2399 CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2400 CASE (15)
2401 CALL block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2402 CASE DEFAULT
2403 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 SELECT CASE (md_max)
2407 CASE (1)
2408 CALL block_3_2_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2409 CASE (2)
2410 CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2411 CASE (3)
2412 CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2413 CASE (4)
2414 CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2415 CASE (5)
2416 CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2417 CASE (6)
2418 CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2419 CASE (7)
2420 CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2421 CASE (9)
2422 CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2423 CASE (10)
2424 CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2425 CASE (11)
2426 CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2427 CASE (15)
2428 CALL block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2429 CASE DEFAULT
2430 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 CALL block_3_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2434 CASE (5)
2435 CALL block_3_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2436 CASE (6)
2437 CALL block_3_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2438 CASE (7)
2439 CALL block_3_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2440 CASE (9)
2441 CALL block_3_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2442 CASE (10)
2443 CALL block_3_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2444 CASE (11)
2445 CALL block_3_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2446 CASE (15)
2447 CALL block_3_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2448 CASE DEFAULT
2449 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 SELECT CASE (mc_max)
2453 CASE (1)
2454 SELECT CASE (md_max)
2455 CASE (1)
2456 CALL block_3_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2457 CASE (2)
2458 CALL block_3_3_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2459 CASE (3)
2460 CALL block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2461 CASE (4)
2462 CALL block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2463 CASE (5)
2464 CALL block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2465 CASE (6)
2466 CALL block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2467 CASE (7)
2468 CALL block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2469 CASE (9)
2470 CALL block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2471 CASE (10)
2472 CALL block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2473 CASE (11)
2474 CALL block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2475 CASE (15)
2476 CALL block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2477 CASE DEFAULT
2478 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 SELECT CASE (md_max)
2482 CASE (1)
2483 CALL block_3_3_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2484 CASE (2)
2485 CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2486 CASE (3)
2487 CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2488 CASE (4)
2489 CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2490 CASE (5)
2491 CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2492 CASE (6)
2493 CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2494 CASE (7)
2495 CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2496 CASE (9)
2497 CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2498 CASE (10)
2499 CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2500 CASE (11)
2501 CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2502 CASE (15)
2503 CALL block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2504 CASE DEFAULT
2505 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 CALL block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2509 CASE (4)
2510 CALL block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2511 CASE (5)
2512 CALL block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2513 CASE (6)
2514 CALL block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2515 CASE (7)
2516 CALL block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2517 CASE (9)
2518 CALL block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2519 CASE (10)
2520 CALL block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2521 CASE (11)
2522 CALL block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2523 CASE (15)
2524 CALL block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2525 CASE DEFAULT
2526 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 SELECT CASE (mc_max)
2530 CASE (1)
2531 SELECT CASE (md_max)
2532 CASE (1)
2533 CALL block_3_4_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2534 CASE (2)
2535 CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2536 CASE (3)
2537 CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2538 CASE (4)
2539 CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2540 CASE (5)
2541 CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2542 CASE (6)
2543 CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2544 CASE (7)
2545 CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2546 CASE (9)
2547 CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2548 CASE (10)
2549 CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2550 CASE (11)
2551 CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2552 CASE (15)
2553 CALL block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2554 CASE DEFAULT
2555 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 CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2559 CASE (3)
2560 CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2561 CASE (4)
2562 CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2563 CASE (5)
2564 CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2565 CASE (6)
2566 CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2567 CASE (7)
2568 CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2569 CASE (9)
2570 CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2571 CASE (10)
2572 CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2573 CASE (11)
2574 CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2575 CASE (15)
2576 CALL block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2577 CASE DEFAULT
2578 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 SELECT CASE (mc_max)
2582 CASE (1)
2583 SELECT CASE (md_max)
2584 CASE (1)
2585 CALL block_3_5_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2586 CASE (2)
2587 CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2588 CASE (3)
2589 CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2590 CASE (4)
2591 CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2592 CASE (5)
2593 CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2594 CASE (6)
2595 CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2596 CASE (7)
2597 CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2598 CASE (9)
2599 CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2600 CASE (10)
2601 CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2602 CASE (11)
2603 CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2604 CASE (15)
2605 CALL block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2606 CASE DEFAULT
2607 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 CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2611 CASE (3)
2612 CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2613 CASE (4)
2614 CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2615 CASE (5)
2616 CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2617 CASE (6)
2618 CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2619 CASE (7)
2620 CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2621 CASE (9)
2622 CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2623 CASE (10)
2624 CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2625 CASE (11)
2626 CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2627 CASE (15)
2628 CALL block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2629 CASE DEFAULT
2630 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 SELECT CASE (mc_max)
2634 CASE (1)
2635 SELECT CASE (md_max)
2636 CASE (1)
2637 CALL block_3_6_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2638 CASE (2)
2639 CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2640 CASE (3)
2641 CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2642 CASE (4)
2643 CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2644 CASE (5)
2645 CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2646 CASE (6)
2647 CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2648 CASE (7)
2649 CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2650 CASE (9)
2651 CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2652 CASE (10)
2653 CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2654 CASE (11)
2655 CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2656 CASE (15)
2657 CALL block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2658 CASE DEFAULT
2659 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 CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2663 CASE (3)
2664 CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2665 CASE (4)
2666 CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2667 CASE (5)
2668 CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2669 CASE (6)
2670 CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2671 CASE (7)
2672 CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2673 CASE (9)
2674 CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2675 CASE (10)
2676 CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2677 CASE (11)
2678 CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2679 CASE (15)
2680 CALL block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2681 CASE DEFAULT
2682 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 CALL block_3_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2686 CASE (9)
2687 CALL block_3_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2688 CASE (10)
2689 CALL block_3_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2690 CASE (11)
2691 CALL block_3_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2692 CASE (15)
2693 CALL block_3_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2694 CASE DEFAULT
2695 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 SELECT CASE (mb_max)
2699 CASE (1)
2700 SELECT CASE (mc_max)
2701 CASE (1)
2702 SELECT CASE (md_max)
2703 CASE (1)
2704 CALL block_4_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2705 CASE (2)
2706 CALL block_4_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2707 CASE (3)
2708 CALL block_4_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2709 CASE (4)
2710 CALL block_4_1_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2711 CASE (5)
2712 CALL block_4_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2713 CASE (6)
2714 CALL block_4_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2715 CASE (7)
2716 CALL block_4_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2717 CASE (9)
2718 CALL block_4_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2719 CASE (10)
2720 CALL block_4_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2721 CASE (11)
2722 CALL block_4_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2723 CASE (15)
2724 CALL block_4_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2725 CASE DEFAULT
2726 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 SELECT CASE (md_max)
2730 CASE (1)
2731 CALL block_4_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2732 CASE (2)
2733 CALL block_4_1_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2734 CASE (3)
2735 CALL block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2736 CASE (4)
2737 CALL block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2738 CASE (5)
2739 CALL block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2740 CASE (6)
2741 CALL block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2742 CASE (7)
2743 CALL block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2744 CASE (9)
2745 CALL block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2746 CASE (10)
2747 CALL block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2748 CASE (11)
2749 CALL block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2750 CASE (15)
2751 CALL block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2752 CASE DEFAULT
2753 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 SELECT CASE (md_max)
2757 CASE (1)
2758 CALL block_4_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2759 CASE (2)
2760 CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2761 CASE (3)
2762 CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2763 CASE (4)
2764 CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2765 CASE (5)
2766 CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2767 CASE (6)
2768 CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2769 CASE (7)
2770 CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2771 CASE (9)
2772 CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2773 CASE (10)
2774 CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2775 CASE (11)
2776 CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2777 CASE (15)
2778 CALL block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2779 CASE DEFAULT
2780 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 SELECT CASE (md_max)
2784 CASE (1)
2785 CALL block_4_1_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2786 CASE (2)
2787 CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2788 CASE (3)
2789 CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2790 CASE (4)
2791 CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2792 CASE (5)
2793 CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2794 CASE (6)
2795 CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2796 CASE (7)
2797 CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2798 CASE (9)
2799 CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2800 CASE (10)
2801 CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2802 CASE (11)
2803 CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2804 CASE (15)
2805 CALL block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2806 CASE DEFAULT
2807 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 CALL block_4_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2811 CASE (6)
2812 CALL block_4_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2813 CASE (7)
2814 CALL block_4_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2815 CASE (9)
2816 CALL block_4_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2817 CASE (10)
2818 CALL block_4_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2819 CASE (11)
2820 CALL block_4_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2821 CASE (15)
2822 CALL block_4_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2823 CASE DEFAULT
2824 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 SELECT CASE (mc_max)
2828 CASE (1)
2829 SELECT CASE (md_max)
2830 CASE (1)
2831 CALL block_4_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2832 CASE (2)
2833 CALL block_4_2_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2834 CASE (3)
2835 CALL block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2836 CASE (4)
2837 CALL block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2838 CASE (5)
2839 CALL block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2840 CASE (6)
2841 CALL block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2842 CASE (7)
2843 CALL block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2844 CASE (9)
2845 CALL block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2846 CASE (10)
2847 CALL block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2848 CASE (11)
2849 CALL block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2850 CASE (15)
2851 CALL block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2852 CASE DEFAULT
2853 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 SELECT CASE (md_max)
2857 CASE (1)
2858 CALL block_4_2_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2859 CASE (2)
2860 CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2861 CASE (3)
2862 CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2863 CASE (4)
2864 CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2865 CASE (5)
2866 CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2867 CASE (6)
2868 CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2869 CASE (7)
2870 CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2871 CASE (9)
2872 CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2873 CASE (10)
2874 CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2875 CASE (11)
2876 CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2877 CASE (15)
2878 CALL block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2879 CASE DEFAULT
2880 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 CALL block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2884 CASE (4)
2885 CALL block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2886 CASE (5)
2887 CALL block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2888 CASE (6)
2889 CALL block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2890 CASE (7)
2891 CALL block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2892 CASE (9)
2893 CALL block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2894 CASE (10)
2895 CALL block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2896 CASE (11)
2897 CALL block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2898 CASE (15)
2899 CALL block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2900 CASE DEFAULT
2901 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 SELECT CASE (mc_max)
2905 CASE (1)
2906 SELECT CASE (md_max)
2907 CASE (1)
2908 CALL block_4_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2909 CASE (2)
2910 CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2911 CASE (3)
2912 CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2913 CASE (4)
2914 CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2915 CASE (5)
2916 CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2917 CASE (6)
2918 CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2919 CASE (7)
2920 CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2921 CASE (9)
2922 CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2923 CASE (10)
2924 CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2925 CASE (11)
2926 CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2927 CASE (15)
2928 CALL block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2929 CASE DEFAULT
2930 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 CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2934 CASE (3)
2935 CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2936 CASE (4)
2937 CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2938 CASE (5)
2939 CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2940 CASE (6)
2941 CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2942 CASE (7)
2943 CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2944 CASE (9)
2945 CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2946 CASE (10)
2947 CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2948 CASE (11)
2949 CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2950 CASE (15)
2951 CALL block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2952 CASE DEFAULT
2953 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 SELECT CASE (mc_max)
2957 CASE (1)
2958 SELECT CASE (md_max)
2959 CASE (1)
2960 CALL block_4_4_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2961 CASE (2)
2962 CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2963 CASE (3)
2964 CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2965 CASE (4)
2966 CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2967 CASE (5)
2968 CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2969 CASE (6)
2970 CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2971 CASE (7)
2972 CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2973 CASE (9)
2974 CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2975 CASE (10)
2976 CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2977 CASE (11)
2978 CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2979 CASE (15)
2980 CALL block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2981 CASE DEFAULT
2982 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 CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2986 CASE (3)
2987 CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2988 CASE (4)
2989 CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2990 CASE (5)
2991 CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2992 CASE (6)
2993 CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2994 CASE (7)
2995 CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2996 CASE (9)
2997 CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
2998 CASE (10)
2999 CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3000 CASE (11)
3001 CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3002 CASE (15)
3003 CALL block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3004 CASE DEFAULT
3005 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 CALL block_4_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3009 CASE (6)
3010 CALL block_4_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3011 CASE (7)
3012 CALL block_4_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3013 CASE (9)
3014 CALL block_4_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3015 CASE (10)
3016 CALL block_4_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3017 CASE (11)
3018 CALL block_4_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3019 CASE (15)
3020 CALL block_4_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3021 CASE DEFAULT
3022 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 SELECT CASE (mb_max)
3026 CASE (1)
3027 SELECT CASE (mc_max)
3028 CASE (1)
3029 SELECT CASE (md_max)
3030 CASE (1)
3031 CALL block_5_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3032 CASE (2)
3033 CALL block_5_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3034 CASE (3)
3035 CALL block_5_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3036 CASE (4)
3037 CALL block_5_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3038 CASE (5)
3039 CALL block_5_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3040 CASE (6)
3041 CALL block_5_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3042 CASE (7)
3043 CALL block_5_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3044 CASE (9)
3045 CALL block_5_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3046 CASE (10)
3047 CALL block_5_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3048 CASE (11)
3049 CALL block_5_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3050 CASE (15)
3051 CALL block_5_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3052 CASE DEFAULT
3053 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 SELECT CASE (md_max)
3057 CASE (1)
3058 CALL block_5_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3059 CASE (2)
3060 CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3061 CASE (3)
3062 CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3063 CASE (4)
3064 CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3065 CASE (5)
3066 CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3067 CASE (6)
3068 CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3069 CASE (7)
3070 CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3071 CASE (9)
3072 CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3073 CASE (10)
3074 CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3075 CASE (11)
3076 CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3077 CASE (15)
3078 CALL block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3079 CASE DEFAULT
3080 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 SELECT CASE (md_max)
3084 CASE (1)
3085 CALL block_5_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3086 CASE (2)
3087 CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3088 CASE (3)
3089 CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3090 CASE (4)
3091 CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3092 CASE (5)
3093 CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3094 CASE (6)
3095 CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3096 CASE (7)
3097 CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3098 CASE (9)
3099 CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3100 CASE (10)
3101 CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3102 CASE (11)
3103 CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3104 CASE (15)
3105 CALL block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3106 CASE DEFAULT
3107 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 CALL block_5_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3111 CASE (5)
3112 CALL block_5_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3113 CASE (6)
3114 CALL block_5_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3115 CASE (7)
3116 CALL block_5_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3117 CASE (9)
3118 CALL block_5_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3119 CASE (10)
3120 CALL block_5_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3121 CASE (11)
3122 CALL block_5_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3123 CASE (15)
3124 CALL block_5_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3125 CASE DEFAULT
3126 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 SELECT CASE (mc_max)
3130 CASE (1)
3131 SELECT CASE (md_max)
3132 CASE (1)
3133 CALL block_5_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3134 CASE (2)
3135 CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3136 CASE (3)
3137 CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3138 CASE (4)
3139 CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3140 CASE (5)
3141 CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3142 CASE (6)
3143 CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3144 CASE (7)
3145 CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3146 CASE (9)
3147 CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3148 CASE (10)
3149 CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3150 CASE (11)
3151 CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3152 CASE (15)
3153 CALL block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3154 CASE DEFAULT
3155 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 CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3159 CASE (3)
3160 CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3161 CASE (4)
3162 CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3163 CASE (5)
3164 CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3165 CASE (6)
3166 CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3167 CASE (7)
3168 CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3169 CASE (9)
3170 CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3171 CASE (10)
3172 CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3173 CASE (11)
3174 CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3175 CASE (15)
3176 CALL block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3177 CASE DEFAULT
3178 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 SELECT CASE (mc_max)
3182 CASE (1)
3183 SELECT CASE (md_max)
3184 CASE (1)
3185 CALL block_5_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3186 CASE (2)
3187 CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3188 CASE (3)
3189 CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3190 CASE (4)
3191 CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3192 CASE (5)
3193 CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3194 CASE (6)
3195 CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3196 CASE (7)
3197 CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3198 CASE (9)
3199 CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3200 CASE (10)
3201 CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3202 CASE (11)
3203 CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3204 CASE (15)
3205 CALL block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3206 CASE DEFAULT
3207 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 CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3211 CASE (3)
3212 CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3213 CASE (4)
3214 CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3215 CASE (5)
3216 CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3217 CASE (6)
3218 CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3219 CASE (7)
3220 CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3221 CASE (9)
3222 CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3223 CASE (10)
3224 CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3225 CASE (11)
3226 CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3227 CASE (15)
3228 CALL block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3229 CASE DEFAULT
3230 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 CALL block_5_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3234 CASE (5)
3235 CALL block_5_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3236 CASE (6)
3237 CALL block_5_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3238 CASE (7)
3239 CALL block_5_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3240 CASE (9)
3241 CALL block_5_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3242 CASE (10)
3243 CALL block_5_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3244 CASE (11)
3245 CALL block_5_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3246 CASE (15)
3247 CALL block_5_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3248 CASE DEFAULT
3249 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 SELECT CASE (mb_max)
3253 CASE (1)
3254 SELECT CASE (mc_max)
3255 CASE (1)
3256 SELECT CASE (md_max)
3257 CASE (1)
3258 CALL block_6_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3259 CASE (2)
3260 CALL block_6_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3261 CASE (3)
3262 CALL block_6_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3263 CASE (4)
3264 CALL block_6_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3265 CASE (5)
3266 CALL block_6_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3267 CASE (6)
3268 CALL block_6_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3269 CASE (7)
3270 CALL block_6_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3271 CASE (9)
3272 CALL block_6_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3273 CASE (10)
3274 CALL block_6_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3275 CASE (11)
3276 CALL block_6_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3277 CASE (15)
3278 CALL block_6_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3279 CASE DEFAULT
3280 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 SELECT CASE (md_max)
3284 CASE (1)
3285 CALL block_6_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3286 CASE (2)
3287 CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3288 CASE (3)
3289 CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3290 CASE (4)
3291 CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3292 CASE (5)
3293 CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3294 CASE (6)
3295 CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3296 CASE (7)
3297 CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3298 CASE (9)
3299 CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3300 CASE (10)
3301 CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3302 CASE (11)
3303 CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3304 CASE (15)
3305 CALL block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3306 CASE DEFAULT
3307 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 SELECT CASE (md_max)
3311 CASE (1)
3312 CALL block_6_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3313 CASE (2)
3314 CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3315 CASE (3)
3316 CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3317 CASE (4)
3318 CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3319 CASE (5)
3320 CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3321 CASE (6)
3322 CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3323 CASE (7)
3324 CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3325 CASE (9)
3326 CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3327 CASE (10)
3328 CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3329 CASE (11)
3330 CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3331 CASE (15)
3332 CALL block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3333 CASE DEFAULT
3334 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 CALL block_6_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3338 CASE (5)
3339 CALL block_6_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3340 CASE (6)
3341 CALL block_6_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3342 CASE (7)
3343 CALL block_6_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3344 CASE (9)
3345 CALL block_6_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3346 CASE (10)
3347 CALL block_6_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3348 CASE (11)
3349 CALL block_6_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3350 CASE (15)
3351 CALL block_6_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3352 CASE DEFAULT
3353 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 SELECT CASE (mc_max)
3357 CASE (1)
3358 SELECT CASE (md_max)
3359 CASE (1)
3360 CALL block_6_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3361 CASE (2)
3362 CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3363 CASE (3)
3364 CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3365 CASE (4)
3366 CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3367 CASE (5)
3368 CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3369 CASE (6)
3370 CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3371 CASE (7)
3372 CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3373 CASE (9)
3374 CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3375 CASE (10)
3376 CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3377 CASE (11)
3378 CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3379 CASE (15)
3380 CALL block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3381 CASE DEFAULT
3382 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 CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3386 CASE (3)
3387 CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3388 CASE (4)
3389 CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3390 CASE (5)
3391 CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3392 CASE (6)
3393 CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3394 CASE (7)
3395 CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3396 CASE (9)
3397 CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3398 CASE (10)
3399 CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3400 CASE (11)
3401 CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3402 CASE (15)
3403 CALL block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3404 CASE DEFAULT
3405 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 SELECT CASE (mc_max)
3409 CASE (1)
3410 SELECT CASE (md_max)
3411 CASE (1)
3412 CALL block_6_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3413 CASE (2)
3414 CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3415 CASE (3)
3416 CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3417 CASE (4)
3418 CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3419 CASE (5)
3420 CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3421 CASE (6)
3422 CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3423 CASE (7)
3424 CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3425 CASE (9)
3426 CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3427 CASE (10)
3428 CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3429 CASE (11)
3430 CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3431 CASE (15)
3432 CALL block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3433 CASE DEFAULT
3434 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 CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3438 CASE (3)
3439 CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3440 CASE (4)
3441 CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3442 CASE (5)
3443 CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3444 CASE (6)
3445 CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3446 CASE (7)
3447 CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3448 CASE (9)
3449 CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3450 CASE (10)
3451 CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3452 CASE (11)
3453 CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3454 CASE (15)
3455 CALL block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3456 CASE DEFAULT
3457 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 CALL block_6_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3461 CASE (5)
3462 CALL block_6_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3463 CASE (6)
3464 CALL block_6_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3465 CASE (7)
3466 CALL block_6_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3467 CASE (9)
3468 CALL block_6_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3469 CASE (10)
3470 CALL block_6_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3471 CASE (11)
3472 CALL block_6_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3473 CASE (15)
3474 CALL block_6_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3475 CASE DEFAULT
3476 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 SELECT CASE (mb_max)
3480 CASE (1)
3481 SELECT CASE (mc_max)
3482 CASE (1)
3483 SELECT CASE (md_max)
3484 CASE (1)
3485 CALL block_7_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3486 CASE (2)
3487 CALL block_7_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3488 CASE (3)
3489 CALL block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3490 CASE (4)
3491 CALL block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3492 CASE (5)
3493 CALL block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3494 CASE (6)
3495 CALL block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3496 CASE (7)
3497 CALL block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3498 CASE (9)
3499 CALL block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3500 CASE (10)
3501 CALL block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3502 CASE (11)
3503 CALL block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3504 CASE (15)
3505 CALL block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3506 CASE DEFAULT
3507 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 SELECT CASE (md_max)
3511 CASE (1)
3512 CALL block_7_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3513 CASE (2)
3514 CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3515 CASE (3)
3516 CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3517 CASE (4)
3518 CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3519 CASE (5)
3520 CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3521 CASE (6)
3522 CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3523 CASE (7)
3524 CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3525 CASE (9)
3526 CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3527 CASE (10)
3528 CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3529 CASE (11)
3530 CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3531 CASE (15)
3532 CALL block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3533 CASE DEFAULT
3534 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 CALL block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3538 CASE (4)
3539 CALL block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3540 CASE (5)
3541 CALL block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3542 CASE (6)
3543 CALL block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3544 CASE (7)
3545 CALL block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3546 CASE (9)
3547 CALL block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3548 CASE (10)
3549 CALL block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3550 CASE (11)
3551 CALL block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3552 CASE (15)
3553 CALL block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3554 CASE DEFAULT
3555 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 SELECT CASE (mc_max)
3559 CASE (1)
3560 SELECT CASE (md_max)
3561 CASE (1)
3562 CALL block_7_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3563 CASE (2)
3564 CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3565 CASE (3)
3566 CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3567 CASE (4)
3568 CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3569 CASE (5)
3570 CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3571 CASE (6)
3572 CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3573 CASE (7)
3574 CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3575 CASE (9)
3576 CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3577 CASE (10)
3578 CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3579 CASE (11)
3580 CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3581 CASE (15)
3582 CALL block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3583 CASE DEFAULT
3584 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 CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3588 CASE (3)
3589 CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3590 CASE (4)
3591 CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3592 CASE (5)
3593 CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3594 CASE (6)
3595 CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3596 CASE (7)
3597 CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3598 CASE (9)
3599 CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3600 CASE (10)
3601 CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3602 CASE (11)
3603 CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3604 CASE (15)
3605 CALL block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3606 CASE DEFAULT
3607 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 CALL block_7_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3611 CASE (4)
3612 CALL block_7_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3613 CASE (5)
3614 CALL block_7_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3615 CASE (6)
3616 CALL block_7_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3617 CASE (7)
3618 CALL block_7_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3619 CASE (9)
3620 CALL block_7_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3621 CASE (10)
3622 CALL block_7_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3623 CASE (11)
3624 CALL block_7_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3625 CASE (15)
3626 CALL block_7_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3627 CASE DEFAULT
3628 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 SELECT CASE (mb_max)
3632 CASE (1)
3633 SELECT CASE (mc_max)
3634 CASE (1)
3635 SELECT CASE (md_max)
3636 CASE (1)
3637 CALL block_9_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3638 CASE (2)
3639 CALL block_9_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3640 CASE (3)
3641 CALL block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3642 CASE (4)
3643 CALL block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3644 CASE (5)
3645 CALL block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3646 CASE (6)
3647 CALL block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3648 CASE (7)
3649 CALL block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3650 CASE (9)
3651 CALL block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3652 CASE (10)
3653 CALL block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3654 CASE (11)
3655 CALL block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3656 CASE (15)
3657 CALL block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3658 CASE DEFAULT
3659 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 SELECT CASE (md_max)
3663 CASE (1)
3664 CALL block_9_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3665 CASE (2)
3666 CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3667 CASE (3)
3668 CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3669 CASE (4)
3670 CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3671 CASE (5)
3672 CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3673 CASE (6)
3674 CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3675 CASE (7)
3676 CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3677 CASE (9)
3678 CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3679 CASE (10)
3680 CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3681 CASE (11)
3682 CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3683 CASE (15)
3684 CALL block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3685 CASE DEFAULT
3686 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 CALL block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3690 CASE (4)
3691 CALL block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3692 CASE (5)
3693 CALL block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3694 CASE (6)
3695 CALL block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3696 CASE (7)
3697 CALL block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3698 CASE (9)
3699 CALL block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3700 CASE (10)
3701 CALL block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3702 CASE (11)
3703 CALL block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3704 CASE (15)
3705 CALL block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3706 CASE DEFAULT
3707 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 SELECT CASE (mc_max)
3711 CASE (1)
3712 SELECT CASE (md_max)
3713 CASE (1)
3714 CALL block_9_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3715 CASE (2)
3716 CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3717 CASE (3)
3718 CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3719 CASE (4)
3720 CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3721 CASE (5)
3722 CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3723 CASE (6)
3724 CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3725 CASE (7)
3726 CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3727 CASE (9)
3728 CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3729 CASE (10)
3730 CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3731 CASE (11)
3732 CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3733 CASE (15)
3734 CALL block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3735 CASE DEFAULT
3736 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 CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3740 CASE (3)
3741 CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3742 CASE (4)
3743 CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3744 CASE (5)
3745 CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3746 CASE (6)
3747 CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3748 CASE (7)
3749 CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3750 CASE (9)
3751 CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3752 CASE (10)
3753 CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3754 CASE (11)
3755 CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3756 CASE (15)
3757 CALL block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3758 CASE DEFAULT
3759 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 CALL block_9_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3763 CASE (4)
3764 CALL block_9_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3765 CASE (5)
3766 CALL block_9_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3767 CASE (6)
3768 CALL block_9_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3769 CASE (7)
3770 CALL block_9_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3771 CASE (9)
3772 CALL block_9_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3773 CASE (10)
3774 CALL block_9_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3775 CASE (11)
3776 CALL block_9_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3777 CASE (15)
3778 CALL block_9_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3779 CASE DEFAULT
3780 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 SELECT CASE (mb_max)
3784 CASE (1)
3785 SELECT CASE (mc_max)
3786 CASE (1)
3787 SELECT CASE (md_max)
3788 CASE (1)
3789 CALL block_10_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3790 CASE (2)
3791 CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3792 CASE (3)
3793 CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3794 CASE (4)
3795 CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3796 CASE (5)
3797 CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3798 CASE (6)
3799 CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3800 CASE (7)
3801 CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3802 CASE (9)
3803 CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3804 CASE (10)
3805 CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3806 CASE (11)
3807 CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3808 CASE (15)
3809 CALL block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3810 CASE DEFAULT
3811 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 CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3815 CASE (3)
3816 CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3817 CASE (4)
3818 CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3819 CASE (5)
3820 CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3821 CASE (6)
3822 CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3823 CASE (7)
3824 CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3825 CASE (9)
3826 CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3827 CASE (10)
3828 CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3829 CASE (11)
3830 CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3831 CASE (15)
3832 CALL block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3833 CASE DEFAULT
3834 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 CALL block_10_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3838 CASE (3)
3839 CALL block_10_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3840 CASE (4)
3841 CALL block_10_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3842 CASE (5)
3843 CALL block_10_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3844 CASE (6)
3845 CALL block_10_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3846 CASE (7)
3847 CALL block_10_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3848 CASE (9)
3849 CALL block_10_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3850 CASE (10)
3851 CALL block_10_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3852 CASE (11)
3853 CALL block_10_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3854 CASE (15)
3855 CALL block_10_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3856 CASE DEFAULT
3857 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 SELECT CASE (mb_max)
3861 CASE (1)
3862 SELECT CASE (mc_max)
3863 CASE (1)
3864 SELECT CASE (md_max)
3865 CASE (1)
3866 CALL block_11_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3867 CASE (2)
3868 CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3869 CASE (3)
3870 CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3871 CASE (4)
3872 CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3873 CASE (5)
3874 CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3875 CASE (6)
3876 CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3877 CASE (7)
3878 CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3879 CASE (9)
3880 CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3881 CASE (10)
3882 CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3883 CASE (11)
3884 CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3885 CASE (15)
3886 CALL block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3887 CASE DEFAULT
3888 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 CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3892 CASE (3)
3893 CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3894 CASE (4)
3895 CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3896 CASE (5)
3897 CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3898 CASE (6)
3899 CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3900 CASE (7)
3901 CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3902 CASE (9)
3903 CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3904 CASE (10)
3905 CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3906 CASE (11)
3907 CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3908 CASE (15)
3909 CALL block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3910 CASE DEFAULT
3911 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 CALL block_11_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3915 CASE (3)
3916 CALL block_11_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3917 CASE (4)
3918 CALL block_11_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3919 CASE (5)
3920 CALL block_11_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3921 CASE (6)
3922 CALL block_11_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3923 CASE (7)
3924 CALL block_11_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3925 CASE (9)
3926 CALL block_11_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3927 CASE (10)
3928 CALL block_11_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3929 CASE (11)
3930 CALL block_11_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3931 CASE (15)
3932 CALL block_11_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3933 CASE DEFAULT
3934 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 SELECT CASE (mb_max)
3938 CASE (1)
3939 SELECT CASE (mc_max)
3940 CASE (1)
3941 SELECT CASE (md_max)
3942 CASE (1)
3943 CALL block_15_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3944 CASE (2)
3945 CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3946 CASE (3)
3947 CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3948 CASE (4)
3949 CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3950 CASE (5)
3951 CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3952 CASE (6)
3953 CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3954 CASE (7)
3955 CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3956 CASE (9)
3957 CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3958 CASE (10)
3959 CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3960 CASE (11)
3961 CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3962 CASE (15)
3963 CALL block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3964 CASE DEFAULT
3965 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 CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3969 CASE (3)
3970 CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3971 CASE (4)
3972 CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3973 CASE (5)
3974 CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3975 CASE (6)
3976 CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3977 CASE (7)
3978 CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3979 CASE (9)
3980 CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3981 CASE (10)
3982 CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3983 CASE (11)
3984 CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3985 CASE (15)
3986 CALL block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3987 CASE DEFAULT
3988 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 CALL block_15_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3992 CASE (3)
3993 CALL block_15_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3994 CASE (4)
3995 CALL block_15_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3996 CASE (5)
3997 CALL block_15_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
3998 CASE (6)
3999 CALL block_15_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4000 CASE (7)
4001 CALL block_15_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4002 CASE (9)
4003 CALL block_15_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4004 CASE (10)
4005 CALL block_15_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4006 CASE (11)
4007 CALL block_15_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4008 CASE (15)
4009 CALL block_15_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
4010 CASE DEFAULT
4011 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 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 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 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 kbd(1:mb_max*md_max) = 0.0_dp
4047 kbc(1:mb_max*mc_max) = 0.0_dp
4048 kad(1:ma_max*md_max) = 0.0_dp
4049 kac(1:ma_max*mc_max) = 0.0_dp
4050 p_index = 0
4051 DO md = 1, md_max
4052 DO mc = 1, mc_max
4053 DO mb = 1, mb_max
4054 ks_bd = 0.0_dp
4055 ks_bc = 0.0_dp
4056 p_bd = pbd((md - 1)*mb_max + mb)
4057 p_bc = pbc((mc - 1)*mb_max + mb)
4058 DO ma = 1, ma_max
4059 p_index = p_index + 1
4060 tmp = scale*prim(p_index)
4061 ks_bc = ks_bc + tmp*pad((md - 1)*ma_max + ma)
4062 ks_bd = ks_bd + tmp*pac((mc - 1)*ma_max + ma)
4063 kad((md - 1)*ma_max + ma) = kad((md - 1)*ma_max + ma) - tmp*p_bc
4064 kac((mc - 1)*ma_max + ma) = kac((mc - 1)*ma_max + ma) - tmp*p_bd
4065 END DO
4066 kbd((md - 1)*mb_max + mb) = kbd((md - 1)*mb_max + mb) - ks_bd
4067 kbc((mc - 1)*mb_max + mb) = kbc((mc - 1)*mb_max + mb) - ks_bc
4068 END DO
4069 END DO
4070 END DO
4071 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 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 kbd(1:1*1) = 0.0_dp
4094 kbc(1:1*1) = 0.0_dp
4095 kad(1:1*1) = 0.0_dp
4096 kac(1:1*1) = 0.0_dp
4097 p_index = 0
4098 DO md = 1, 1
4099 DO mc = 1, 1
4100 DO mb = 1, 1
4101 ks_bd = 0.0_dp
4102 ks_bc = 0.0_dp
4103 p_bd = pbd((md - 1)*1 + mb)
4104 p_bc = pbc((mc - 1)*1 + mb)
4105 DO ma = 1, 1
4106 p_index = p_index + 1
4107 tmp = scale*prim(p_index)
4108 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4109 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4110 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4111 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4112 END DO
4113 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4114 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4115 END DO
4116 END DO
4117 END DO
4118 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 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 kbd(1:1*2) = 0.0_dp
4141 kbc(1:1*1) = 0.0_dp
4142 kad(1:1*2) = 0.0_dp
4143 kac(1:1*1) = 0.0_dp
4144 p_index = 0
4145 DO md = 1, 2
4146 DO mc = 1, 1
4147 DO mb = 1, 1
4148 ks_bd = 0.0_dp
4149 ks_bc = 0.0_dp
4150 p_bd = pbd((md - 1)*1 + mb)
4151 p_bc = pbc((mc - 1)*1 + mb)
4152 DO ma = 1, 1
4153 p_index = p_index + 1
4154 tmp = scale*prim(p_index)
4155 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4156 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4157 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4158 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4159 END DO
4160 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4161 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4162 END DO
4163 END DO
4164 END DO
4165 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 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 kbd(1:1*3) = 0.0_dp
4188 kbc(1:1*1) = 0.0_dp
4189 kad(1:1*3) = 0.0_dp
4190 kac(1:1*1) = 0.0_dp
4191 p_index = 0
4192 DO md = 1, 3
4193 DO mc = 1, 1
4194 DO mb = 1, 1
4195 ks_bd = 0.0_dp
4196 ks_bc = 0.0_dp
4197 p_bd = pbd((md - 1)*1 + mb)
4198 p_bc = pbc((mc - 1)*1 + mb)
4199 DO ma = 1, 1
4200 p_index = p_index + 1
4201 tmp = scale*prim(p_index)
4202 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4203 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4204 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4205 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4206 END DO
4207 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4208 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4209 END DO
4210 END DO
4211 END DO
4212 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 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 kbd(1:1*4) = 0.0_dp
4235 kbc(1:1*1) = 0.0_dp
4236 kad(1:1*4) = 0.0_dp
4237 kac(1:1*1) = 0.0_dp
4238 p_index = 0
4239 DO md = 1, 4
4240 DO mc = 1, 1
4241 DO mb = 1, 1
4242 ks_bd = 0.0_dp
4243 ks_bc = 0.0_dp
4244 p_bd = pbd((md - 1)*1 + mb)
4245 p_bc = pbc((mc - 1)*1 + mb)
4246 DO ma = 1, 1
4247 p_index = p_index + 1
4248 tmp = scale*prim(p_index)
4249 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4250 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4251 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4252 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4253 END DO
4254 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4255 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4256 END DO
4257 END DO
4258 END DO
4259 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 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 kbd(1:1*5) = 0.0_dp
4282 kbc(1:1*1) = 0.0_dp
4283 kad(1:1*5) = 0.0_dp
4284 kac(1:1*1) = 0.0_dp
4285 p_index = 0
4286 DO md = 1, 5
4287 DO mc = 1, 1
4288 DO mb = 1, 1
4289 ks_bd = 0.0_dp
4290 ks_bc = 0.0_dp
4291 p_bd = pbd((md - 1)*1 + mb)
4292 p_bc = pbc((mc - 1)*1 + mb)
4293 DO ma = 1, 1
4294 p_index = p_index + 1
4295 tmp = scale*prim(p_index)
4296 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4297 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4298 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4299 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4300 END DO
4301 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4302 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4303 END DO
4304 END DO
4305 END DO
4306 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 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 kbd(1:1*6) = 0.0_dp
4329 kbc(1:1*1) = 0.0_dp
4330 kad(1:1*6) = 0.0_dp
4331 kac(1:1*1) = 0.0_dp
4332 p_index = 0
4333 DO md = 1, 6
4334 DO mc = 1, 1
4335 DO mb = 1, 1
4336 ks_bd = 0.0_dp
4337 ks_bc = 0.0_dp
4338 p_bd = pbd((md - 1)*1 + mb)
4339 p_bc = pbc((mc - 1)*1 + mb)
4340 DO ma = 1, 1
4341 p_index = p_index + 1
4342 tmp = scale*prim(p_index)
4343 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4344 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4345 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4346 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4347 END DO
4348 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4349 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4350 END DO
4351 END DO
4352 END DO
4353 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 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 kbd(1:1*7) = 0.0_dp
4376 kbc(1:1*1) = 0.0_dp
4377 kad(1:1*7) = 0.0_dp
4378 kac(1:1*1) = 0.0_dp
4379 p_index = 0
4380 DO md = 1, 7
4381 DO mc = 1, 1
4382 DO mb = 1, 1
4383 ks_bd = 0.0_dp
4384 ks_bc = 0.0_dp
4385 p_bd = pbd((md - 1)*1 + mb)
4386 p_bc = pbc((mc - 1)*1 + mb)
4387 DO ma = 1, 1
4388 p_index = p_index + 1
4389 tmp = scale*prim(p_index)
4390 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4391 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4392 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4393 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4394 END DO
4395 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4396 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4397 END DO
4398 END DO
4399 END DO
4400 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 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 kbd(1:1*9) = 0.0_dp
4423 kbc(1:1*1) = 0.0_dp
4424 kad(1:1*9) = 0.0_dp
4425 kac(1:1*1) = 0.0_dp
4426 p_index = 0
4427 DO md = 1, 9
4428 DO mc = 1, 1
4429 DO mb = 1, 1
4430 ks_bd = 0.0_dp
4431 ks_bc = 0.0_dp
4432 p_bd = pbd((md - 1)*1 + mb)
4433 p_bc = pbc((mc - 1)*1 + mb)
4434 DO ma = 1, 1
4435 p_index = p_index + 1
4436 tmp = scale*prim(p_index)
4437 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4438 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4439 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4440 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4441 END DO
4442 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4443 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4444 END DO
4445 END DO
4446 END DO
4447 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 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 kbd(1:1*10) = 0.0_dp
4471 kbc(1:1*1) = 0.0_dp
4472 kad(1:1*10) = 0.0_dp
4473 kac(1:1*1) = 0.0_dp
4474 p_index = 0
4475 DO md = 1, 10
4476 DO mc = 1, 1
4477 DO mb = 1, 1
4478 ks_bd = 0.0_dp
4479 ks_bc = 0.0_dp
4480 p_bd = pbd((md - 1)*1 + mb)
4481 p_bc = pbc((mc - 1)*1 + mb)
4482 DO ma = 1, 1
4483 p_index = p_index + 1
4484 tmp = scale*prim(p_index)
4485 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4486 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4487 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4488 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4489 END DO
4490 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4491 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4492 END DO
4493 END DO
4494 END DO
4495 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 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 kbd(1:1*11) = 0.0_dp
4519 kbc(1:1*1) = 0.0_dp
4520 kad(1:1*11) = 0.0_dp
4521 kac(1:1*1) = 0.0_dp
4522 p_index = 0
4523 DO md = 1, 11
4524 DO mc = 1, 1
4525 DO mb = 1, 1
4526 ks_bd = 0.0_dp
4527 ks_bc = 0.0_dp
4528 p_bd = pbd((md - 1)*1 + mb)
4529 p_bc = pbc((mc - 1)*1 + mb)
4530 DO ma = 1, 1
4531 p_index = p_index + 1
4532 tmp = scale*prim(p_index)
4533 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4534 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4535 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4536 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4537 END DO
4538 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4539 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4540 END DO
4541 END DO
4542 END DO
4543 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 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 kbd(1:1*15) = 0.0_dp
4567 kbc(1:1*1) = 0.0_dp
4568 kad(1:1*15) = 0.0_dp
4569 kac(1:1*1) = 0.0_dp
4570 p_index = 0
4571 DO md = 1, 15
4572 DO mc = 1, 1
4573 DO mb = 1, 1
4574 ks_bd = 0.0_dp
4575 ks_bc = 0.0_dp
4576 p_bd = pbd((md - 1)*1 + mb)
4577 p_bc = pbc((mc - 1)*1 + mb)
4578 DO ma = 1, 1
4579 p_index = p_index + 1
4580 tmp = scale*prim(p_index)
4581 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4582 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4583 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4584 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4585 END DO
4586 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4587 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4588 END DO
4589 END DO
4590 END DO
4591 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 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 kbd(1:1*1) = 0.0_dp
4614 kbc(1:1*2) = 0.0_dp
4615 kad(1:1*1) = 0.0_dp
4616 kac(1:1*2) = 0.0_dp
4617 p_index = 0
4618 DO md = 1, 1
4619 DO mc = 1, 2
4620 DO mb = 1, 1
4621 ks_bd = 0.0_dp
4622 ks_bc = 0.0_dp
4623 p_bd = pbd((md - 1)*1 + mb)
4624 p_bc = pbc((mc - 1)*1 + mb)
4625 DO ma = 1, 1
4626 p_index = p_index + 1
4627 tmp = scale*prim(p_index)
4628 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4629 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4630 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4631 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4632 END DO
4633 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4634 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4635 END DO
4636 END DO
4637 END DO
4638 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 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 kbd(1:1*2) = 0.0_dp
4661 kbc(1:1*2) = 0.0_dp
4662 kad(1:1*2) = 0.0_dp
4663 kac(1:1*2) = 0.0_dp
4664 p_index = 0
4665 DO md = 1, 2
4666 DO mc = 1, 2
4667 DO mb = 1, 1
4668 ks_bd = 0.0_dp
4669 ks_bc = 0.0_dp
4670 p_bd = pbd((md - 1)*1 + mb)
4671 p_bc = pbc((mc - 1)*1 + mb)
4672 DO ma = 1, 1
4673 p_index = p_index + 1
4674 tmp = scale*prim(p_index)
4675 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4676 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4677 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4678 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4679 END DO
4680 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4681 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4682 END DO
4683 END DO
4684 END DO
4685 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 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 kbd(1:1*3) = 0.0_dp
4708 kbc(1:1*2) = 0.0_dp
4709 kad(1:1*3) = 0.0_dp
4710 kac(1:1*2) = 0.0_dp
4711 p_index = 0
4712 DO md = 1, 3
4713 DO mc = 1, 2
4714 DO mb = 1, 1
4715 ks_bd = 0.0_dp
4716 ks_bc = 0.0_dp
4717 p_bd = pbd((md - 1)*1 + mb)
4718 p_bc = pbc((mc - 1)*1 + mb)
4719 DO ma = 1, 1
4720 p_index = p_index + 1
4721 tmp = scale*prim(p_index)
4722 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4723 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4724 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4725 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4726 END DO
4727 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4728 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4729 END DO
4730 END DO
4731 END DO
4732 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 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 kbd(1:1*4) = 0.0_dp
4755 kbc(1:1*2) = 0.0_dp
4756 kad(1:1*4) = 0.0_dp
4757 kac(1:1*2) = 0.0_dp
4758 p_index = 0
4759 DO md = 1, 4
4760 DO mc = 1, 2
4761 DO mb = 1, 1
4762 ks_bd = 0.0_dp
4763 ks_bc = 0.0_dp
4764 p_bd = pbd((md - 1)*1 + mb)
4765 p_bc = pbc((mc - 1)*1 + mb)
4766 DO ma = 1, 1
4767 p_index = p_index + 1
4768 tmp = scale*prim(p_index)
4769 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4770 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4771 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4772 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4773 END DO
4774 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4775 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4776 END DO
4777 END DO
4778 END DO
4779 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 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 kbd(1:1*5) = 0.0_dp
4802 kbc(1:1*2) = 0.0_dp
4803 kad(1:1*5) = 0.0_dp
4804 kac(1:1*2) = 0.0_dp
4805 p_index = 0
4806 DO md = 1, 5
4807 DO mc = 1, 2
4808 DO mb = 1, 1
4809 ks_bd = 0.0_dp
4810 ks_bc = 0.0_dp
4811 p_bd = pbd((md - 1)*1 + mb)
4812 p_bc = pbc((mc - 1)*1 + mb)
4813 DO ma = 1, 1
4814 p_index = p_index + 1
4815 tmp = scale*prim(p_index)
4816 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4817 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4818 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4819 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4820 END DO
4821 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4822 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4823 END DO
4824 END DO
4825 END DO
4826 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 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 kbd(1:1*6) = 0.0_dp
4849 kbc(1:1*2) = 0.0_dp
4850 kad(1:1*6) = 0.0_dp
4851 kac(1:1*2) = 0.0_dp
4852 p_index = 0
4853 DO md = 1, 6
4854 DO mc = 1, 2
4855 DO mb = 1, 1
4856 ks_bd = 0.0_dp
4857 ks_bc = 0.0_dp
4858 p_bd = pbd((md - 1)*1 + mb)
4859 p_bc = pbc((mc - 1)*1 + mb)
4860 DO ma = 1, 1
4861 p_index = p_index + 1
4862 tmp = scale*prim(p_index)
4863 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4864 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4865 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4866 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4867 END DO
4868 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4869 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4870 END DO
4871 END DO
4872 END DO
4873 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 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 kbd(1:1*7) = 0.0_dp
4896 kbc(1:1*2) = 0.0_dp
4897 kad(1:1*7) = 0.0_dp
4898 kac(1:1*2) = 0.0_dp
4899 p_index = 0
4900 DO md = 1, 7
4901 DO mc = 1, 2
4902 DO mb = 1, 1
4903 ks_bd = 0.0_dp
4904 ks_bc = 0.0_dp
4905 p_bd = pbd((md - 1)*1 + mb)
4906 p_bc = pbc((mc - 1)*1 + mb)
4907 DO ma = 1, 1
4908 p_index = p_index + 1
4909 tmp = scale*prim(p_index)
4910 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4911 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4912 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4913 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4914 END DO
4915 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4916 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4917 END DO
4918 END DO
4919 END DO
4920 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 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 kbd(1:1*9) = 0.0_dp
4943 kbc(1:1*2) = 0.0_dp
4944 kad(1:1*9) = 0.0_dp
4945 kac(1:1*2) = 0.0_dp
4946 p_index = 0
4947 DO md = 1, 9
4948 DO mc = 1, 2
4949 DO mb = 1, 1
4950 ks_bd = 0.0_dp
4951 ks_bc = 0.0_dp
4952 p_bd = pbd((md - 1)*1 + mb)
4953 p_bc = pbc((mc - 1)*1 + mb)
4954 DO ma = 1, 1
4955 p_index = p_index + 1
4956 tmp = scale*prim(p_index)
4957 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
4958 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
4959 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
4960 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
4961 END DO
4962 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
4963 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
4964 END DO
4965 END DO
4966 END DO
4967 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 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 kbd(1:1*md_max) = 0.0_dp
4991 kbc(1:1*2) = 0.0_dp
4992 kad(1:1*md_max) = 0.0_dp
4993 kac(1:1*2) = 0.0_dp
4994 p_index = 0
4995 DO md = 1, md_max
4996 DO mc = 1, 2
4997 DO mb = 1, 1
4998 ks_bd = 0.0_dp
4999 ks_bc = 0.0_dp
5000 p_bd = pbd((md - 1)*1 + mb)
5001 p_bc = pbc((mc - 1)*1 + mb)
5002 DO ma = 1, 1
5003 p_index = p_index + 1
5004 tmp = scale*prim(p_index)
5005 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5006 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5007 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5008 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5009 END DO
5010 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5011 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5012 END DO
5013 END DO
5014 END DO
5015 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 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 kbd(1:1*1) = 0.0_dp
5038 kbc(1:1*3) = 0.0_dp
5039 kad(1:1*1) = 0.0_dp
5040 kac(1:1*3) = 0.0_dp
5041 p_index = 0
5042 DO md = 1, 1
5043 DO mc = 1, 3
5044 DO mb = 1, 1
5045 ks_bd = 0.0_dp
5046 ks_bc = 0.0_dp
5047 p_bd = pbd((md - 1)*1 + mb)
5048 p_bc = pbc((mc - 1)*1 + mb)
5049 DO ma = 1, 1
5050 p_index = p_index + 1
5051 tmp = scale*prim(p_index)
5052 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5053 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5054 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5055 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5056 END DO
5057 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5058 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5059 END DO
5060 END DO
5061 END DO
5062 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 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 kbd(1:1*2) = 0.0_dp
5085 kbc(1:1*3) = 0.0_dp
5086 kad(1:1*2) = 0.0_dp
5087 kac(1:1*3) = 0.0_dp
5088 p_index = 0
5089 DO md = 1, 2
5090 DO mc = 1, 3
5091 DO mb = 1, 1
5092 ks_bd = 0.0_dp
5093 ks_bc = 0.0_dp
5094 p_bd = pbd((md - 1)*1 + mb)
5095 p_bc = pbc((mc - 1)*1 + mb)
5096 DO ma = 1, 1
5097 p_index = p_index + 1
5098 tmp = scale*prim(p_index)
5099 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5100 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5101 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5102 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5103 END DO
5104 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5105 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5106 END DO
5107 END DO
5108 END DO
5109 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 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 kbd(1:1*3) = 0.0_dp
5132 kbc(1:1*3) = 0.0_dp
5133 kad(1:1*3) = 0.0_dp
5134 kac(1:1*3) = 0.0_dp
5135 p_index = 0
5136 DO md = 1, 3
5137 DO mc = 1, 3
5138 DO mb = 1, 1
5139 ks_bd = 0.0_dp
5140 ks_bc = 0.0_dp
5141 p_bd = pbd((md - 1)*1 + mb)
5142 p_bc = pbc((mc - 1)*1 + mb)
5143 DO ma = 1, 1
5144 p_index = p_index + 1
5145 tmp = scale*prim(p_index)
5146 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5147 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5148 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5149 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5150 END DO
5151 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5152 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5153 END DO
5154 END DO
5155 END DO
5156 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 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 kbd(1:1*4) = 0.0_dp
5179 kbc(1:1*3) = 0.0_dp
5180 kad(1:1*4) = 0.0_dp
5181 kac(1:1*3) = 0.0_dp
5182 p_index = 0
5183 DO md = 1, 4
5184 DO mc = 1, 3
5185 DO mb = 1, 1
5186 ks_bd = 0.0_dp
5187 ks_bc = 0.0_dp
5188 p_bd = pbd((md - 1)*1 + mb)
5189 p_bc = pbc((mc - 1)*1 + mb)
5190 DO ma = 1, 1
5191 p_index = p_index + 1
5192 tmp = scale*prim(p_index)
5193 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5194 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5195 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5196 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5197 END DO
5198 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5199 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5200 END DO
5201 END DO
5202 END DO
5203 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 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 kbd(1:1*5) = 0.0_dp
5226 kbc(1:1*3) = 0.0_dp
5227 kad(1:1*5) = 0.0_dp
5228 kac(1:1*3) = 0.0_dp
5229 p_index = 0
5230 DO md = 1, 5
5231 DO mc = 1, 3
5232 DO mb = 1, 1
5233 ks_bd = 0.0_dp
5234 ks_bc = 0.0_dp
5235 p_bd = pbd((md - 1)*1 + mb)
5236 p_bc = pbc((mc - 1)*1 + mb)
5237 DO ma = 1, 1
5238 p_index = p_index + 1
5239 tmp = scale*prim(p_index)
5240 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5241 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5242 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5243 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5244 END DO
5245 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5246 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5247 END DO
5248 END DO
5249 END DO
5250 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 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 kbd(1:1*6) = 0.0_dp
5273 kbc(1:1*3) = 0.0_dp
5274 kad(1:1*6) = 0.0_dp
5275 kac(1:1*3) = 0.0_dp
5276 p_index = 0
5277 DO md = 1, 6
5278 DO mc = 1, 3
5279 DO mb = 1, 1
5280 ks_bd = 0.0_dp
5281 ks_bc = 0.0_dp
5282 p_bd = pbd((md - 1)*1 + mb)
5283 p_bc = pbc((mc - 1)*1 + mb)
5284 DO ma = 1, 1
5285 p_index = p_index + 1
5286 tmp = scale*prim(p_index)
5287 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5288 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5289 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5290 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5291 END DO
5292 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5293 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5294 END DO
5295 END DO
5296 END DO
5297 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 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 kbd(1:1*md_max) = 0.0_dp
5321 kbc(1:1*3) = 0.0_dp
5322 kad(1:1*md_max) = 0.0_dp
5323 kac(1:1*3) = 0.0_dp
5324 p_index = 0
5325 DO md = 1, md_max
5326 DO mc = 1, 3
5327 DO mb = 1, 1
5328 ks_bd = 0.0_dp
5329 ks_bc = 0.0_dp
5330 p_bd = pbd((md - 1)*1 + mb)
5331 p_bc = pbc((mc - 1)*1 + mb)
5332 DO ma = 1, 1
5333 p_index = p_index + 1
5334 tmp = scale*prim(p_index)
5335 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5336 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5337 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5338 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5339 END DO
5340 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5341 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5342 END DO
5343 END DO
5344 END DO
5345 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 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 kbd(1:1*1) = 0.0_dp
5368 kbc(1:1*4) = 0.0_dp
5369 kad(1:1*1) = 0.0_dp
5370 kac(1:1*4) = 0.0_dp
5371 p_index = 0
5372 DO md = 1, 1
5373 DO mc = 1, 4
5374 DO mb = 1, 1
5375 ks_bd = 0.0_dp
5376 ks_bc = 0.0_dp
5377 p_bd = pbd((md - 1)*1 + mb)
5378 p_bc = pbc((mc - 1)*1 + mb)
5379 DO ma = 1, 1
5380 p_index = p_index + 1
5381 tmp = scale*prim(p_index)
5382 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5383 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5384 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5385 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5386 END DO
5387 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5388 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5389 END DO
5390 END DO
5391 END DO
5392 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 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 kbd(1:1*2) = 0.0_dp
5415 kbc(1:1*4) = 0.0_dp
5416 kad(1:1*2) = 0.0_dp
5417 kac(1:1*4) = 0.0_dp
5418 p_index = 0
5419 DO md = 1, 2
5420 DO mc = 1, 4
5421 DO mb = 1, 1
5422 ks_bd = 0.0_dp
5423 ks_bc = 0.0_dp
5424 p_bd = pbd((md - 1)*1 + mb)
5425 p_bc = pbc((mc - 1)*1 + mb)
5426 DO ma = 1, 1
5427 p_index = p_index + 1
5428 tmp = scale*prim(p_index)
5429 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5430 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5431 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5432 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5433 END DO
5434 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5435 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5436 END DO
5437 END DO
5438 END DO
5439 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 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 kbd(1:1*3) = 0.0_dp
5462 kbc(1:1*4) = 0.0_dp
5463 kad(1:1*3) = 0.0_dp
5464 kac(1:1*4) = 0.0_dp
5465 p_index = 0
5466 DO md = 1, 3
5467 DO mc = 1, 4
5468 DO mb = 1, 1
5469 ks_bd = 0.0_dp
5470 ks_bc = 0.0_dp
5471 p_bd = pbd((md - 1)*1 + mb)
5472 p_bc = pbc((mc - 1)*1 + mb)
5473 DO ma = 1, 1
5474 p_index = p_index + 1
5475 tmp = scale*prim(p_index)
5476 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5477 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5478 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5479 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5480 END DO
5481 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5482 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5483 END DO
5484 END DO
5485 END DO
5486 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 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 kbd(1:1*4) = 0.0_dp
5509 kbc(1:1*4) = 0.0_dp
5510 kad(1:1*4) = 0.0_dp
5511 kac(1:1*4) = 0.0_dp
5512 p_index = 0
5513 DO md = 1, 4
5514 DO mc = 1, 4
5515 DO mb = 1, 1
5516 ks_bd = 0.0_dp
5517 ks_bc = 0.0_dp
5518 p_bd = pbd((md - 1)*1 + mb)
5519 p_bc = pbc((mc - 1)*1 + mb)
5520 DO ma = 1, 1
5521 p_index = p_index + 1
5522 tmp = scale*prim(p_index)
5523 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5524 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5525 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5526 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5527 END DO
5528 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5529 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5530 END DO
5531 END DO
5532 END DO
5533 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 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 kbd(1:1*md_max) = 0.0_dp
5557 kbc(1:1*4) = 0.0_dp
5558 kad(1:1*md_max) = 0.0_dp
5559 kac(1:1*4) = 0.0_dp
5560 p_index = 0
5561 DO md = 1, md_max
5562 DO mc = 1, 4
5563 DO mb = 1, 1
5564 ks_bd = 0.0_dp
5565 ks_bc = 0.0_dp
5566 p_bd = pbd((md - 1)*1 + mb)
5567 p_bc = pbc((mc - 1)*1 + mb)
5568 DO ma = 1, 1
5569 p_index = p_index + 1
5570 tmp = scale*prim(p_index)
5571 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5572 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5573 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5574 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5575 END DO
5576 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5577 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5578 END DO
5579 END DO
5580 END DO
5581 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 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 kbd(1:1*1) = 0.0_dp
5604 kbc(1:1*5) = 0.0_dp
5605 kad(1:1*1) = 0.0_dp
5606 kac(1:1*5) = 0.0_dp
5607 p_index = 0
5608 DO md = 1, 1
5609 DO mc = 1, 5
5610 DO mb = 1, 1
5611 ks_bd = 0.0_dp
5612 ks_bc = 0.0_dp
5613 p_bd = pbd((md - 1)*1 + mb)
5614 p_bc = pbc((mc - 1)*1 + mb)
5615 DO ma = 1, 1
5616 p_index = p_index + 1
5617 tmp = scale*prim(p_index)
5618 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5619 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5620 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5621 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5622 END DO
5623 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5624 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5625 END DO
5626 END DO
5627 END DO
5628 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 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 kbd(1:1*2) = 0.0_dp
5651 kbc(1:1*5) = 0.0_dp
5652 kad(1:1*2) = 0.0_dp
5653 kac(1:1*5) = 0.0_dp
5654 p_index = 0
5655 DO md = 1, 2
5656 DO mc = 1, 5
5657 DO mb = 1, 1
5658 ks_bd = 0.0_dp
5659 ks_bc = 0.0_dp
5660 p_bd = pbd((md - 1)*1 + mb)
5661 p_bc = pbc((mc - 1)*1 + mb)
5662 DO ma = 1, 1
5663 p_index = p_index + 1
5664 tmp = scale*prim(p_index)
5665 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5666 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5667 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5668 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5669 END DO
5670 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5671 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5672 END DO
5673 END DO
5674 END DO
5675 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 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 kbd(1:1*3) = 0.0_dp
5698 kbc(1:1*5) = 0.0_dp
5699 kad(1:1*3) = 0.0_dp
5700 kac(1:1*5) = 0.0_dp
5701 p_index = 0
5702 DO md = 1, 3
5703 DO mc = 1, 5
5704 DO mb = 1, 1
5705 ks_bd = 0.0_dp
5706 ks_bc = 0.0_dp
5707 p_bd = pbd((md - 1)*1 + mb)
5708 p_bc = pbc((mc - 1)*1 + mb)
5709 DO ma = 1, 1
5710 p_index = p_index + 1
5711 tmp = scale*prim(p_index)
5712 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5713 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5714 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5715 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5716 END DO
5717 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5718 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5719 END DO
5720 END DO
5721 END DO
5722 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 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 kbd(1:1*md_max) = 0.0_dp
5746 kbc(1:1*5) = 0.0_dp
5747 kad(1:1*md_max) = 0.0_dp
5748 kac(1:1*5) = 0.0_dp
5749 p_index = 0
5750 DO md = 1, md_max
5751 DO mc = 1, 5
5752 DO mb = 1, 1
5753 ks_bd = 0.0_dp
5754 ks_bc = 0.0_dp
5755 p_bd = pbd((md - 1)*1 + mb)
5756 p_bc = pbc((mc - 1)*1 + mb)
5757 DO ma = 1, 1
5758 p_index = p_index + 1
5759 tmp = scale*prim(p_index)
5760 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5761 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5762 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5763 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5764 END DO
5765 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5766 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5767 END DO
5768 END DO
5769 END DO
5770 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 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 kbd(1:1*1) = 0.0_dp
5793 kbc(1:1*6) = 0.0_dp
5794 kad(1:1*1) = 0.0_dp
5795 kac(1:1*6) = 0.0_dp
5796 p_index = 0
5797 DO md = 1, 1
5798 DO mc = 1, 6
5799 DO mb = 1, 1
5800 ks_bd = 0.0_dp
5801 ks_bc = 0.0_dp
5802 p_bd = pbd((md - 1)*1 + mb)
5803 p_bc = pbc((mc - 1)*1 + mb)
5804 DO ma = 1, 1
5805 p_index = p_index + 1
5806 tmp = scale*prim(p_index)
5807 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5808 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5809 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5810 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5811 END DO
5812 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5813 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5814 END DO
5815 END DO
5816 END DO
5817 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 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 kbd(1:1*2) = 0.0_dp
5840 kbc(1:1*6) = 0.0_dp
5841 kad(1:1*2) = 0.0_dp
5842 kac(1:1*6) = 0.0_dp
5843 p_index = 0
5844 DO md = 1, 2
5845 DO mc = 1, 6
5846 DO mb = 1, 1
5847 ks_bd = 0.0_dp
5848 ks_bc = 0.0_dp
5849 p_bd = pbd((md - 1)*1 + mb)
5850 p_bc = pbc((mc - 1)*1 + mb)
5851 DO ma = 1, 1
5852 p_index = p_index + 1
5853 tmp = scale*prim(p_index)
5854 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5855 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5856 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5857 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5858 END DO
5859 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5860 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5861 END DO
5862 END DO
5863 END DO
5864 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 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 kbd(1:1*3) = 0.0_dp
5887 kbc(1:1*6) = 0.0_dp
5888 kad(1:1*3) = 0.0_dp
5889 kac(1:1*6) = 0.0_dp
5890 p_index = 0
5891 DO md = 1, 3
5892 DO mc = 1, 6
5893 DO mb = 1, 1
5894 ks_bd = 0.0_dp
5895 ks_bc = 0.0_dp
5896 p_bd = pbd((md - 1)*1 + mb)
5897 p_bc = pbc((mc - 1)*1 + mb)
5898 DO ma = 1, 1
5899 p_index = p_index + 1
5900 tmp = scale*prim(p_index)
5901 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5902 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5903 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5904 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5905 END DO
5906 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5907 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5908 END DO
5909 END DO
5910 END DO
5911 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 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 kbd(1:1*md_max) = 0.0_dp
5935 kbc(1:1*6) = 0.0_dp
5936 kad(1:1*md_max) = 0.0_dp
5937 kac(1:1*6) = 0.0_dp
5938 p_index = 0
5939 DO md = 1, md_max
5940 DO mc = 1, 6
5941 DO mb = 1, 1
5942 ks_bd = 0.0_dp
5943 ks_bc = 0.0_dp
5944 p_bd = pbd((md - 1)*1 + mb)
5945 p_bc = pbc((mc - 1)*1 + mb)
5946 DO ma = 1, 1
5947 p_index = p_index + 1
5948 tmp = scale*prim(p_index)
5949 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5950 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5951 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5952 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
5953 END DO
5954 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
5955 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
5956 END DO
5957 END DO
5958 END DO
5959 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 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 kbd(1:1*1) = 0.0_dp
5982 kbc(1:1*7) = 0.0_dp
5983 kad(1:1*1) = 0.0_dp
5984 kac(1:1*7) = 0.0_dp
5985 p_index = 0
5986 DO md = 1, 1
5987 DO mc = 1, 7
5988 DO mb = 1, 1
5989 ks_bd = 0.0_dp
5990 ks_bc = 0.0_dp
5991 p_bd = pbd((md - 1)*1 + mb)
5992 p_bc = pbc((mc - 1)*1 + mb)
5993 DO ma = 1, 1
5994 p_index = p_index + 1
5995 tmp = scale*prim(p_index)
5996 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
5997 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
5998 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
5999 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6000 END DO
6001 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6002 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6003 END DO
6004 END DO
6005 END DO
6006 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 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 kbd(1:1*2) = 0.0_dp
6029 kbc(1:1*7) = 0.0_dp
6030 kad(1:1*2) = 0.0_dp
6031 kac(1:1*7) = 0.0_dp
6032 p_index = 0
6033 DO md = 1, 2
6034 DO mc = 1, 7
6035 DO mb = 1, 1
6036 ks_bd = 0.0_dp
6037 ks_bc = 0.0_dp
6038 p_bd = pbd((md - 1)*1 + mb)
6039 p_bc = pbc((mc - 1)*1 + mb)
6040 DO ma = 1, 1
6041 p_index = p_index + 1
6042 tmp = scale*prim(p_index)
6043 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6044 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6045 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6046 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6047 END DO
6048 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6049 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6050 END DO
6051 END DO
6052 END DO
6053 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 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 kbd(1:1*md_max) = 0.0_dp
6077 kbc(1:1*7) = 0.0_dp
6078 kad(1:1*md_max) = 0.0_dp
6079 kac(1:1*7) = 0.0_dp
6080 p_index = 0
6081 DO md = 1, md_max
6082 DO mc = 1, 7
6083 DO mb = 1, 1
6084 ks_bd = 0.0_dp
6085 ks_bc = 0.0_dp
6086 p_bd = pbd((md - 1)*1 + mb)
6087 p_bc = pbc((mc - 1)*1 + mb)
6088 DO ma = 1, 1
6089 p_index = p_index + 1
6090 tmp = scale*prim(p_index)
6091 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6092 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6093 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6094 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6095 END DO
6096 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6097 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6098 END DO
6099 END DO
6100 END DO
6101 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 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 kbd(1:1*1) = 0.0_dp
6124 kbc(1:1*9) = 0.0_dp
6125 kad(1:1*1) = 0.0_dp
6126 kac(1:1*9) = 0.0_dp
6127 p_index = 0
6128 DO md = 1, 1
6129 DO mc = 1, 9
6130 DO mb = 1, 1
6131 ks_bd = 0.0_dp
6132 ks_bc = 0.0_dp
6133 p_bd = pbd((md - 1)*1 + mb)
6134 p_bc = pbc((mc - 1)*1 + mb)
6135 DO ma = 1, 1
6136 p_index = p_index + 1
6137 tmp = scale*prim(p_index)
6138 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6139 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6140 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6141 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6142 END DO
6143 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6144 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6145 END DO
6146 END DO
6147 END DO
6148 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 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 kbd(1:1*2) = 0.0_dp
6171 kbc(1:1*9) = 0.0_dp
6172 kad(1:1*2) = 0.0_dp
6173 kac(1:1*9) = 0.0_dp
6174 p_index = 0
6175 DO md = 1, 2
6176 DO mc = 1, 9
6177 DO mb = 1, 1
6178 ks_bd = 0.0_dp
6179 ks_bc = 0.0_dp
6180 p_bd = pbd((md - 1)*1 + mb)
6181 p_bc = pbc((mc - 1)*1 + mb)
6182 DO ma = 1, 1
6183 p_index = p_index + 1
6184 tmp = scale*prim(p_index)
6185 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6186 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6187 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6188 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6189 END DO
6190 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6191 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6192 END DO
6193 END DO
6194 END DO
6195 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 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 kbd(1:1*md_max) = 0.0_dp
6219 kbc(1:1*9) = 0.0_dp
6220 kad(1:1*md_max) = 0.0_dp
6221 kac(1:1*9) = 0.0_dp
6222 p_index = 0
6223 DO md = 1, md_max
6224 DO mc = 1, 9
6225 DO mb = 1, 1
6226 ks_bd = 0.0_dp
6227 ks_bc = 0.0_dp
6228 p_bd = pbd((md - 1)*1 + mb)
6229 p_bc = pbc((mc - 1)*1 + mb)
6230 DO ma = 1, 1
6231 p_index = p_index + 1
6232 tmp = scale*prim(p_index)
6233 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6234 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6235 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6236 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6237 END DO
6238 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6239 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6240 END DO
6241 END DO
6242 END DO
6243 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 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 kbd(1:1*1) = 0.0_dp
6267 kbc(1:1*10) = 0.0_dp
6268 kad(1:1*1) = 0.0_dp
6269 kac(1:1*10) = 0.0_dp
6270 p_index = 0
6271 DO md = 1, 1
6272 DO mc = 1, 10
6273 DO mb = 1, 1
6274 ks_bd = 0.0_dp
6275 ks_bc = 0.0_dp
6276 p_bd = pbd((md - 1)*1 + mb)
6277 p_bc = pbc((mc - 1)*1 + mb)
6278 DO ma = 1, 1
6279 p_index = p_index + 1
6280 tmp = scale*prim(p_index)
6281 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6282 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6283 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6284 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6285 END DO
6286 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6287 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6288 END DO
6289 END DO
6290 END DO
6291 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 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 kbd(1:1*md_max) = 0.0_dp
6315 kbc(1:1*10) = 0.0_dp
6316 kad(1:1*md_max) = 0.0_dp
6317 kac(1:1*10) = 0.0_dp
6318 p_index = 0
6319 DO md = 1, md_max
6320 DO mc = 1, 10
6321 DO mb = 1, 1
6322 ks_bd = 0.0_dp
6323 ks_bc = 0.0_dp
6324 p_bd = pbd((md - 1)*1 + mb)
6325 p_bc = pbc((mc - 1)*1 + mb)
6326 DO ma = 1, 1
6327 p_index = p_index + 1
6328 tmp = scale*prim(p_index)
6329 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6330 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6331 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6332 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6333 END DO
6334 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6335 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6336 END DO
6337 END DO
6338 END DO
6339 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 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 kbd(1:1*1) = 0.0_dp
6363 kbc(1:1*11) = 0.0_dp
6364 kad(1:1*1) = 0.0_dp
6365 kac(1:1*11) = 0.0_dp
6366 p_index = 0
6367 DO md = 1, 1
6368 DO mc = 1, 11
6369 DO mb = 1, 1
6370 ks_bd = 0.0_dp
6371 ks_bc = 0.0_dp
6372 p_bd = pbd((md - 1)*1 + mb)
6373 p_bc = pbc((mc - 1)*1 + mb)
6374 DO ma = 1, 1
6375 p_index = p_index + 1
6376 tmp = scale*prim(p_index)
6377 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6378 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6379 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6380 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6381 END DO
6382 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6383 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6384 END DO
6385 END DO
6386 END DO
6387 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 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 kbd(1:1*md_max) = 0.0_dp
6411 kbc(1:1*11) = 0.0_dp
6412 kad(1:1*md_max) = 0.0_dp
6413 kac(1:1*11) = 0.0_dp
6414 p_index = 0
6415 DO md = 1, md_max
6416 DO mc = 1, 11
6417 DO mb = 1, 1
6418 ks_bd = 0.0_dp
6419 ks_bc = 0.0_dp
6420 p_bd = pbd((md - 1)*1 + mb)
6421 p_bc = pbc((mc - 1)*1 + mb)
6422 DO ma = 1, 1
6423 p_index = p_index + 1
6424 tmp = scale*prim(p_index)
6425 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6426 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6427 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6428 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6429 END DO
6430 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6431 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6432 END DO
6433 END DO
6434 END DO
6435 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 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 kbd(1:1*1) = 0.0_dp
6459 kbc(1:1*15) = 0.0_dp
6460 kad(1:1*1) = 0.0_dp
6461 kac(1:1*15) = 0.0_dp
6462 p_index = 0
6463 DO md = 1, 1
6464 DO mc = 1, 15
6465 DO mb = 1, 1
6466 ks_bd = 0.0_dp
6467 ks_bc = 0.0_dp
6468 p_bd = pbd((md - 1)*1 + mb)
6469 p_bc = pbc((mc - 1)*1 + mb)
6470 DO ma = 1, 1
6471 p_index = p_index + 1
6472 tmp = scale*prim(p_index)
6473 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6474 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6475 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6476 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6477 END DO
6478 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6479 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6480 END DO
6481 END DO
6482 END DO
6483 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 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 kbd(1:1*md_max) = 0.0_dp
6507 kbc(1:1*15) = 0.0_dp
6508 kad(1:1*md_max) = 0.0_dp
6509 kac(1:1*15) = 0.0_dp
6510 p_index = 0
6511 DO md = 1, md_max
6512 DO mc = 1, 15
6513 DO mb = 1, 1
6514 ks_bd = 0.0_dp
6515 ks_bc = 0.0_dp
6516 p_bd = pbd((md - 1)*1 + mb)
6517 p_bc = pbc((mc - 1)*1 + mb)
6518 DO ma = 1, 1
6519 p_index = p_index + 1
6520 tmp = scale*prim(p_index)
6521 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6522 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6523 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6524 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6525 END DO
6526 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
6527 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
6528 END DO
6529 END DO
6530 END DO
6531 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 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 kbd(1:2*1) = 0.0_dp
6554 kbc(1:2*1) = 0.0_dp
6555 kad(1:1*1) = 0.0_dp
6556 kac(1:1*1) = 0.0_dp
6557 p_index = 0
6558 DO md = 1, 1
6559 DO mc = 1, 1
6560 DO mb = 1, 2
6561 ks_bd = 0.0_dp
6562 ks_bc = 0.0_dp
6563 p_bd = pbd((md - 1)*2 + mb)
6564 p_bc = pbc((mc - 1)*2 + mb)
6565 DO ma = 1, 1
6566 p_index = p_index + 1
6567 tmp = scale*prim(p_index)
6568 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6569 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6570 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6571 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6572 END DO
6573 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6574 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6575 END DO
6576 END DO
6577 END DO
6578 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 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 kbd(1:2*2) = 0.0_dp
6601 kbc(1:2*1) = 0.0_dp
6602 kad(1:1*2) = 0.0_dp
6603 kac(1:1*1) = 0.0_dp
6604 p_index = 0
6605 DO md = 1, 2
6606 DO mc = 1, 1
6607 DO mb = 1, 2
6608 ks_bd = 0.0_dp
6609 ks_bc = 0.0_dp
6610 p_bd = pbd((md - 1)*2 + mb)
6611 p_bc = pbc((mc - 1)*2 + mb)
6612 DO ma = 1, 1
6613 p_index = p_index + 1
6614 tmp = scale*prim(p_index)
6615 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6616 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6617 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6618 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6619 END DO
6620 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6621 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6622 END DO
6623 END DO
6624 END DO
6625 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 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 kbd(1:2*3) = 0.0_dp
6648 kbc(1:2*1) = 0.0_dp
6649 kad(1:1*3) = 0.0_dp
6650 kac(1:1*1) = 0.0_dp
6651 p_index = 0
6652 DO md = 1, 3
6653 DO mc = 1, 1
6654 DO mb = 1, 2
6655 ks_bd = 0.0_dp
6656 ks_bc = 0.0_dp
6657 p_bd = pbd((md - 1)*2 + mb)
6658 p_bc = pbc((mc - 1)*2 + mb)
6659 DO ma = 1, 1
6660 p_index = p_index + 1
6661 tmp = scale*prim(p_index)
6662 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6663 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6664 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6665 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6666 END DO
6667 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6668 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6669 END DO
6670 END DO
6671 END DO
6672 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 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 kbd(1:2*4) = 0.0_dp
6695 kbc(1:2*1) = 0.0_dp
6696 kad(1:1*4) = 0.0_dp
6697 kac(1:1*1) = 0.0_dp
6698 p_index = 0
6699 DO md = 1, 4
6700 DO mc = 1, 1
6701 DO mb = 1, 2
6702 ks_bd = 0.0_dp
6703 ks_bc = 0.0_dp
6704 p_bd = pbd((md - 1)*2 + mb)
6705 p_bc = pbc((mc - 1)*2 + mb)
6706 DO ma = 1, 1
6707 p_index = p_index + 1
6708 tmp = scale*prim(p_index)
6709 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6710 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6711 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6712 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6713 END DO
6714 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6715 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6716 END DO
6717 END DO
6718 END DO
6719 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 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 kbd(1:2*5) = 0.0_dp
6742 kbc(1:2*1) = 0.0_dp
6743 kad(1:1*5) = 0.0_dp
6744 kac(1:1*1) = 0.0_dp
6745 p_index = 0
6746 DO md = 1, 5
6747 DO mc = 1, 1
6748 DO mb = 1, 2
6749 ks_bd = 0.0_dp
6750 ks_bc = 0.0_dp
6751 p_bd = pbd((md - 1)*2 + mb)
6752 p_bc = pbc((mc - 1)*2 + mb)
6753 DO ma = 1, 1
6754 p_index = p_index + 1
6755 tmp = scale*prim(p_index)
6756 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6757 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6758 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6759 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6760 END DO
6761 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6762 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6763 END DO
6764 END DO
6765 END DO
6766 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 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 kbd(1:2*6) = 0.0_dp
6789 kbc(1:2*1) = 0.0_dp
6790 kad(1:1*6) = 0.0_dp
6791 kac(1:1*1) = 0.0_dp
6792 p_index = 0
6793 DO md = 1, 6
6794 DO mc = 1, 1
6795 DO mb = 1, 2
6796 ks_bd = 0.0_dp
6797 ks_bc = 0.0_dp
6798 p_bd = pbd((md - 1)*2 + mb)
6799 p_bc = pbc((mc - 1)*2 + mb)
6800 DO ma = 1, 1
6801 p_index = p_index + 1
6802 tmp = scale*prim(p_index)
6803 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6804 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6805 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6806 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6807 END DO
6808 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6809 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6810 END DO
6811 END DO
6812 END DO
6813 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 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 kbd(1:2*7) = 0.0_dp
6836 kbc(1:2*1) = 0.0_dp
6837 kad(1:1*7) = 0.0_dp
6838 kac(1:1*1) = 0.0_dp
6839 p_index = 0
6840 DO md = 1, 7
6841 DO mc = 1, 1
6842 DO mb = 1, 2
6843 ks_bd = 0.0_dp
6844 ks_bc = 0.0_dp
6845 p_bd = pbd((md - 1)*2 + mb)
6846 p_bc = pbc((mc - 1)*2 + mb)
6847 DO ma = 1, 1
6848 p_index = p_index + 1
6849 tmp = scale*prim(p_index)
6850 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6851 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6852 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6853 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6854 END DO
6855 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6856 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6857 END DO
6858 END DO
6859 END DO
6860 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 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 kbd(1:2*9) = 0.0_dp
6883 kbc(1:2*1) = 0.0_dp
6884 kad(1:1*9) = 0.0_dp
6885 kac(1:1*1) = 0.0_dp
6886 p_index = 0
6887 DO md = 1, 9
6888 DO mc = 1, 1
6889 DO mb = 1, 2
6890 ks_bd = 0.0_dp
6891 ks_bc = 0.0_dp
6892 p_bd = pbd((md - 1)*2 + mb)
6893 p_bc = pbc((mc - 1)*2 + mb)
6894 DO ma = 1, 1
6895 p_index = p_index + 1
6896 tmp = scale*prim(p_index)
6897 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6898 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6899 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6900 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6901 END DO
6902 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6903 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6904 END DO
6905 END DO
6906 END DO
6907 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 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 kbd(1:2*md_max) = 0.0_dp
6931 kbc(1:2*1) = 0.0_dp
6932 kad(1:1*md_max) = 0.0_dp
6933 kac(1:1*1) = 0.0_dp
6934 p_index = 0
6935 DO md = 1, md_max
6936 DO mc = 1, 1
6937 DO mb = 1, 2
6938 ks_bd = 0.0_dp
6939 ks_bc = 0.0_dp
6940 p_bd = pbd((md - 1)*2 + mb)
6941 p_bc = pbc((mc - 1)*2 + mb)
6942 DO ma = 1, 1
6943 p_index = p_index + 1
6944 tmp = scale*prim(p_index)
6945 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6946 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6947 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6948 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6949 END DO
6950 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6951 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6952 END DO
6953 END DO
6954 END DO
6955 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 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 kbd(1:2*1) = 0.0_dp
6978 kbc(1:2*2) = 0.0_dp
6979 kad(1:1*1) = 0.0_dp
6980 kac(1:1*2) = 0.0_dp
6981 p_index = 0
6982 DO md = 1, 1
6983 DO mc = 1, 2
6984 DO mb = 1, 2
6985 ks_bd = 0.0_dp
6986 ks_bc = 0.0_dp
6987 p_bd = pbd((md - 1)*2 + mb)
6988 p_bc = pbc((mc - 1)*2 + mb)
6989 DO ma = 1, 1
6990 p_index = p_index + 1
6991 tmp = scale*prim(p_index)
6992 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
6993 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
6994 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
6995 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
6996 END DO
6997 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
6998 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
6999 END DO
7000 END DO
7001 END DO
7002 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 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 kbd(1:2*2) = 0.0_dp
7025 kbc(1:2*2) = 0.0_dp
7026 kad(1:1*2) = 0.0_dp
7027 kac(1:1*2) = 0.0_dp
7028 p_index = 0
7029 DO md = 1, 2
7030 DO mc = 1, 2
7031 DO mb = 1, 2
7032 ks_bd = 0.0_dp
7033 ks_bc = 0.0_dp
7034 p_bd = pbd((md - 1)*2 + mb)
7035 p_bc = pbc((mc - 1)*2 + mb)
7036 DO ma = 1, 1
7037 p_index = p_index + 1
7038 tmp = scale*prim(p_index)
7039 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7040 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7041 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7042 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7043 END DO
7044 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7045 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7046 END DO
7047 END DO
7048 END DO
7049 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 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 kbd(1:2*3) = 0.0_dp
7072 kbc(1:2*2) = 0.0_dp
7073 kad(1:1*3) = 0.0_dp
7074 kac(1:1*2) = 0.0_dp
7075 p_index = 0
7076 DO md = 1, 3
7077 DO mc = 1, 2
7078 DO mb = 1, 2
7079 ks_bd = 0.0_dp
7080 ks_bc = 0.0_dp
7081 p_bd = pbd((md - 1)*2 + mb)
7082 p_bc = pbc((mc - 1)*2 + mb)
7083 DO ma = 1, 1
7084 p_index = p_index + 1
7085 tmp = scale*prim(p_index)
7086 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7087 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7088 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7089 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7090 END DO
7091 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7092 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7093 END DO
7094 END DO
7095 END DO
7096 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 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 kbd(1:2*4) = 0.0_dp
7119 kbc(1:2*2) = 0.0_dp
7120 kad(1:1*4) = 0.0_dp
7121 kac(1:1*2) = 0.0_dp
7122 p_index = 0
7123 DO md = 1, 4
7124 DO mc = 1, 2
7125 DO mb = 1, 2
7126 ks_bd = 0.0_dp
7127 ks_bc = 0.0_dp
7128 p_bd = pbd((md - 1)*2 + mb)
7129 p_bc = pbc((mc - 1)*2 + mb)
7130 DO ma = 1, 1
7131 p_index = p_index + 1
7132 tmp = scale*prim(p_index)
7133 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7134 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7135 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7136 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7137 END DO
7138 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7139 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7140 END DO
7141 END DO
7142 END DO
7143 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 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 kbd(1:2*md_max) = 0.0_dp
7167 kbc(1:2*2) = 0.0_dp
7168 kad(1:1*md_max) = 0.0_dp
7169 kac(1:1*2) = 0.0_dp
7170 p_index = 0
7171 DO md = 1, md_max
7172 DO mc = 1, 2
7173 DO mb = 1, 2
7174 ks_bd = 0.0_dp
7175 ks_bc = 0.0_dp
7176 p_bd = pbd((md - 1)*2 + mb)
7177 p_bc = pbc((mc - 1)*2 + mb)
7178 DO ma = 1, 1
7179 p_index = p_index + 1
7180 tmp = scale*prim(p_index)
7181 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7182 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7183 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7184 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7185 END DO
7186 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7187 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7188 END DO
7189 END DO
7190 END DO
7191 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 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 kbd(1:2*1) = 0.0_dp
7214 kbc(1:2*3) = 0.0_dp
7215 kad(1:1*1) = 0.0_dp
7216 kac(1:1*3) = 0.0_dp
7217 p_index = 0
7218 DO md = 1, 1
7219 DO mc = 1, 3
7220 DO mb = 1, 2
7221 ks_bd = 0.0_dp
7222 ks_bc = 0.0_dp
7223 p_bd = pbd((md - 1)*2 + mb)
7224 p_bc = pbc((mc - 1)*2 + mb)
7225 DO ma = 1, 1
7226 p_index = p_index + 1
7227 tmp = scale*prim(p_index)
7228 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7229 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7230 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7231 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7232 END DO
7233 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7234 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7235 END DO
7236 END DO
7237 END DO
7238 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 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 kbd(1:2*2) = 0.0_dp
7261 kbc(1:2*3) = 0.0_dp
7262 kad(1:1*2) = 0.0_dp
7263 kac(1:1*3) = 0.0_dp
7264 p_index = 0
7265 DO md = 1, 2
7266 DO mc = 1, 3
7267 DO mb = 1, 2
7268 ks_bd = 0.0_dp
7269 ks_bc = 0.0_dp
7270 p_bd = pbd((md - 1)*2 + mb)
7271 p_bc = pbc((mc - 1)*2 + mb)
7272 DO ma = 1, 1
7273 p_index = p_index + 1
7274 tmp = scale*prim(p_index)
7275 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7276 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7277 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7278 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7279 END DO
7280 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7281 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7282 END DO
7283 END DO
7284 END DO
7285 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 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 kbd(1:2*3) = 0.0_dp
7308 kbc(1:2*3) = 0.0_dp
7309 kad(1:1*3) = 0.0_dp
7310 kac(1:1*3) = 0.0_dp
7311 p_index = 0
7312 DO md = 1, 3
7313 DO mc = 1, 3
7314 DO mb = 1, 2
7315 ks_bd = 0.0_dp
7316 ks_bc = 0.0_dp
7317 p_bd = pbd((md - 1)*2 + mb)
7318 p_bc = pbc((mc - 1)*2 + mb)
7319 DO ma = 1, 1
7320 p_index = p_index + 1
7321 tmp = scale*prim(p_index)
7322 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7323 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7324 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7325 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7326 END DO
7327 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7328 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7329 END DO
7330 END DO
7331 END DO
7332 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 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 kbd(1:2*md_max) = 0.0_dp
7356 kbc(1:2*3) = 0.0_dp
7357 kad(1:1*md_max) = 0.0_dp
7358 kac(1:1*3) = 0.0_dp
7359 p_index = 0
7360 DO md = 1, md_max
7361 DO mc = 1, 3
7362 DO mb = 1, 2
7363 ks_bd = 0.0_dp
7364 ks_bc = 0.0_dp
7365 p_bd = pbd((md - 1)*2 + mb)
7366 p_bc = pbc((mc - 1)*2 + mb)
7367 DO ma = 1, 1
7368 p_index = p_index + 1
7369 tmp = scale*prim(p_index)
7370 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7371 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7372 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7373 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7374 END DO
7375 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7376 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7377 END DO
7378 END DO
7379 END DO
7380 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 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 kbd(1:2*1) = 0.0_dp
7403 kbc(1:2*4) = 0.0_dp
7404 kad(1:1*1) = 0.0_dp
7405 kac(1:1*4) = 0.0_dp
7406 p_index = 0
7407 DO md = 1, 1
7408 DO mc = 1, 4
7409 DO mb = 1, 2
7410 ks_bd = 0.0_dp
7411 ks_bc = 0.0_dp
7412 p_bd = pbd((md - 1)*2 + mb)
7413 p_bc = pbc((mc - 1)*2 + mb)
7414 DO ma = 1, 1
7415 p_index = p_index + 1
7416 tmp = scale*prim(p_index)
7417 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7418 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7419 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7420 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7421 END DO
7422 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7423 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7424 END DO
7425 END DO
7426 END DO
7427 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 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 kbd(1:2*2) = 0.0_dp
7450 kbc(1:2*4) = 0.0_dp
7451 kad(1:1*2) = 0.0_dp
7452 kac(1:1*4) = 0.0_dp
7453 p_index = 0
7454 DO md = 1, 2
7455 DO mc = 1, 4
7456 DO mb = 1, 2
7457 ks_bd = 0.0_dp
7458 ks_bc = 0.0_dp
7459 p_bd = pbd((md - 1)*2 + mb)
7460 p_bc = pbc((mc - 1)*2 + mb)
7461 DO ma = 1, 1
7462 p_index = p_index + 1
7463 tmp = scale*prim(p_index)
7464 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7465 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7466 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7467 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7468 END DO
7469 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7470 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7471 END DO
7472 END DO
7473 END DO
7474 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 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 kbd(1:2*md_max) = 0.0_dp
7498 kbc(1:2*4) = 0.0_dp
7499 kad(1:1*md_max) = 0.0_dp
7500 kac(1:1*4) = 0.0_dp
7501 p_index = 0
7502 DO md = 1, md_max
7503 DO mc = 1, 4
7504 DO mb = 1, 2
7505 ks_bd = 0.0_dp
7506 ks_bc = 0.0_dp
7507 p_bd = pbd((md - 1)*2 + mb)
7508 p_bc = pbc((mc - 1)*2 + mb)
7509 DO ma = 1, 1
7510 p_index = p_index + 1
7511 tmp = scale*prim(p_index)
7512 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7513 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7514 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7515 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7516 END DO
7517 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7518 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7519 END DO
7520 END DO
7521 END DO
7522 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 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 kbd(1:2*1) = 0.0_dp
7545 kbc(1:2*5) = 0.0_dp
7546 kad(1:1*1) = 0.0_dp
7547 kac(1:1*5) = 0.0_dp
7548 p_index = 0
7549 DO md = 1, 1
7550 DO mc = 1, 5
7551 DO mb = 1, 2
7552 ks_bd = 0.0_dp
7553 ks_bc = 0.0_dp
7554 p_bd = pbd((md - 1)*2 + mb)
7555 p_bc = pbc((mc - 1)*2 + mb)
7556 DO ma = 1, 1
7557 p_index = p_index + 1
7558 tmp = scale*prim(p_index)
7559 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7560 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7561 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7562 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7563 END DO
7564 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7565 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7566 END DO
7567 END DO
7568 END DO
7569 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 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 kbd(1:2*md_max) = 0.0_dp
7593 kbc(1:2*5) = 0.0_dp
7594 kad(1:1*md_max) = 0.0_dp
7595 kac(1:1*5) = 0.0_dp
7596 p_index = 0
7597 DO md = 1, md_max
7598 DO mc = 1, 5
7599 DO mb = 1, 2
7600 ks_bd = 0.0_dp
7601 ks_bc = 0.0_dp
7602 p_bd = pbd((md - 1)*2 + mb)
7603 p_bc = pbc((mc - 1)*2 + mb)
7604 DO ma = 1, 1
7605 p_index = p_index + 1
7606 tmp = scale*prim(p_index)
7607 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7608 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7609 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7610 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7611 END DO
7612 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7613 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7614 END DO
7615 END DO
7616 END DO
7617 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 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 kbd(1:2*1) = 0.0_dp
7640 kbc(1:2*6) = 0.0_dp
7641 kad(1:1*1) = 0.0_dp
7642 kac(1:1*6) = 0.0_dp
7643 p_index = 0
7644 DO md = 1, 1
7645 DO mc = 1, 6
7646 DO mb = 1, 2
7647 ks_bd = 0.0_dp
7648 ks_bc = 0.0_dp
7649 p_bd = pbd((md - 1)*2 + mb)
7650 p_bc = pbc((mc - 1)*2 + mb)
7651 DO ma = 1, 1
7652 p_index = p_index + 1
7653 tmp = scale*prim(p_index)
7654 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7655 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7656 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7657 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7658 END DO
7659 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7660 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7661 END DO
7662 END DO
7663 END DO
7664 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 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 kbd(1:2*md_max) = 0.0_dp
7688 kbc(1:2*6) = 0.0_dp
7689 kad(1:1*md_max) = 0.0_dp
7690 kac(1:1*6) = 0.0_dp
7691 p_index = 0
7692 DO md = 1, md_max
7693 DO mc = 1, 6
7694 DO mb = 1, 2
7695 ks_bd = 0.0_dp
7696 ks_bc = 0.0_dp
7697 p_bd = pbd((md - 1)*2 + mb)
7698 p_bc = pbc((mc - 1)*2 + mb)
7699 DO ma = 1, 1
7700 p_index = p_index + 1
7701 tmp = scale*prim(p_index)
7702 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7703 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7704 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7705 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7706 END DO
7707 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7708 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7709 END DO
7710 END DO
7711 END DO
7712 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 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 kbd(1:2*1) = 0.0_dp
7735 kbc(1:2*7) = 0.0_dp
7736 kad(1:1*1) = 0.0_dp
7737 kac(1:1*7) = 0.0_dp
7738 p_index = 0
7739 DO md = 1, 1
7740 DO mc = 1, 7
7741 DO mb = 1, 2
7742 ks_bd = 0.0_dp
7743 ks_bc = 0.0_dp
7744 p_bd = pbd((md - 1)*2 + mb)
7745 p_bc = pbc((mc - 1)*2 + mb)
7746 DO ma = 1, 1
7747 p_index = p_index + 1
7748 tmp = scale*prim(p_index)
7749 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7750 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7751 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7752 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7753 END DO
7754 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7755 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7756 END DO
7757 END DO
7758 END DO
7759 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 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 kbd(1:2*md_max) = 0.0_dp
7783 kbc(1:2*7) = 0.0_dp
7784 kad(1:1*md_max) = 0.0_dp
7785 kac(1:1*7) = 0.0_dp
7786 p_index = 0
7787 DO md = 1, md_max
7788 DO mc = 1, 7
7789 DO mb = 1, 2
7790 ks_bd = 0.0_dp
7791 ks_bc = 0.0_dp
7792 p_bd = pbd((md - 1)*2 + mb)
7793 p_bc = pbc((mc - 1)*2 + mb)
7794 DO ma = 1, 1
7795 p_index = p_index + 1
7796 tmp = scale*prim(p_index)
7797 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7798 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7799 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7800 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7801 END DO
7802 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7803 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7804 END DO
7805 END DO
7806 END DO
7807 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 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 kbd(1:2*1) = 0.0_dp
7830 kbc(1:2*9) = 0.0_dp
7831 kad(1:1*1) = 0.0_dp
7832 kac(1:1*9) = 0.0_dp
7833 p_index = 0
7834 DO md = 1, 1
7835 DO mc = 1, 9
7836 DO mb = 1, 2
7837 ks_bd = 0.0_dp
7838 ks_bc = 0.0_dp
7839 p_bd = pbd((md - 1)*2 + mb)
7840 p_bc = pbc((mc - 1)*2 + mb)
7841 DO ma = 1, 1
7842 p_index = p_index + 1
7843 tmp = scale*prim(p_index)
7844 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7845 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7846 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7847 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7848 END DO
7849 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7850 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7851 END DO
7852 END DO
7853 END DO
7854 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 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 kbd(1:2*md_max) = 0.0_dp
7878 kbc(1:2*9) = 0.0_dp
7879 kad(1:1*md_max) = 0.0_dp
7880 kac(1:1*9) = 0.0_dp
7881 p_index = 0
7882 DO md = 1, md_max
7883 DO mc = 1, 9
7884 DO mb = 1, 2
7885 ks_bd = 0.0_dp
7886 ks_bc = 0.0_dp
7887 p_bd = pbd((md - 1)*2 + mb)
7888 p_bc = pbc((mc - 1)*2 + mb)
7889 DO ma = 1, 1
7890 p_index = p_index + 1
7891 tmp = scale*prim(p_index)
7892 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7893 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7894 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7895 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7896 END DO
7897 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7898 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7899 END DO
7900 END DO
7901 END DO
7902 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 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 kbd(1:2*md_max) = 0.0_dp
7927 kbc(1:2*mc_max) = 0.0_dp
7928 kad(1:1*md_max) = 0.0_dp
7929 kac(1:1*mc_max) = 0.0_dp
7930 p_index = 0
7931 DO md = 1, md_max
7932 DO mc = 1, mc_max
7933 DO mb = 1, 2
7934 ks_bd = 0.0_dp
7935 ks_bc = 0.0_dp
7936 p_bd = pbd((md - 1)*2 + mb)
7937 p_bc = pbc((mc - 1)*2 + mb)
7938 DO ma = 1, 1
7939 p_index = p_index + 1
7940 tmp = scale*prim(p_index)
7941 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7942 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7943 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7944 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7945 END DO
7946 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
7947 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
7948 END DO
7949 END DO
7950 END DO
7951 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 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 kbd(1:3*1) = 0.0_dp
7974 kbc(1:3*1) = 0.0_dp
7975 kad(1:1*1) = 0.0_dp
7976 kac(1:1*1) = 0.0_dp
7977 p_index = 0
7978 DO md = 1, 1
7979 DO mc = 1, 1
7980 DO mb = 1, 3
7981 ks_bd = 0.0_dp
7982 ks_bc = 0.0_dp
7983 p_bd = pbd((md - 1)*3 + mb)
7984 p_bc = pbc((mc - 1)*3 + mb)
7985 DO ma = 1, 1
7986 p_index = p_index + 1
7987 tmp = scale*prim(p_index)
7988 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
7989 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
7990 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
7991 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
7992 END DO
7993 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
7994 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
7995 END DO
7996 END DO
7997 END DO
7998 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 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 kbd(1:3*2) = 0.0_dp
8021 kbc(1:3*1) = 0.0_dp
8022 kad(1:1*2) = 0.0_dp
8023 kac(1:1*1) = 0.0_dp
8024 p_index = 0
8025 DO md = 1, 2
8026 DO mc = 1, 1
8027 DO mb = 1, 3
8028 ks_bd = 0.0_dp
8029 ks_bc = 0.0_dp
8030 p_bd = pbd((md - 1)*3 + mb)
8031 p_bc = pbc((mc - 1)*3 + mb)
8032 DO ma = 1, 1
8033 p_index = p_index + 1
8034 tmp = scale*prim(p_index)
8035 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8036 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8037 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8038 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8039 END DO
8040 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8041 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8042 END DO
8043 END DO
8044 END DO
8045 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 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 kbd(1:3*3) = 0.0_dp
8068 kbc(1:3*1) = 0.0_dp
8069 kad(1:1*3) = 0.0_dp
8070 kac(1:1*1) = 0.0_dp
8071 p_index = 0
8072 DO md = 1, 3
8073 DO mc = 1, 1
8074 DO mb = 1, 3
8075 ks_bd = 0.0_dp
8076 ks_bc = 0.0_dp
8077 p_bd = pbd((md - 1)*3 + mb)
8078 p_bc = pbc((mc - 1)*3 + mb)
8079 DO ma = 1, 1
8080 p_index = p_index + 1
8081 tmp = scale*prim(p_index)
8082 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8083 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8084 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8085 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8086 END DO
8087 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8088 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8089 END DO
8090 END DO
8091 END DO
8092 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 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 kbd(1:3*4) = 0.0_dp
8115 kbc(1:3*1) = 0.0_dp
8116 kad(1:1*4) = 0.0_dp
8117 kac(1:1*1) = 0.0_dp
8118 p_index = 0
8119 DO md = 1, 4
8120 DO mc = 1, 1
8121 DO mb = 1, 3
8122 ks_bd = 0.0_dp
8123 ks_bc = 0.0_dp
8124 p_bd = pbd((md - 1)*3 + mb)
8125 p_bc = pbc((mc - 1)*3 + mb)
8126 DO ma = 1, 1
8127 p_index = p_index + 1
8128 tmp = scale*prim(p_index)
8129 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8130 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8131 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8132 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8133 END DO
8134 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8135 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8136 END DO
8137 END DO
8138 END DO
8139 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 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 kbd(1:3*5) = 0.0_dp
8162 kbc(1:3*1) = 0.0_dp
8163 kad(1:1*5) = 0.0_dp
8164 kac(1:1*1) = 0.0_dp
8165 p_index = 0
8166 DO md = 1, 5
8167 DO mc = 1, 1
8168 DO mb = 1, 3
8169 ks_bd = 0.0_dp
8170 ks_bc = 0.0_dp
8171 p_bd = pbd((md - 1)*3 + mb)
8172 p_bc = pbc((mc - 1)*3 + mb)
8173 DO ma = 1, 1
8174 p_index = p_index + 1
8175 tmp = scale*prim(p_index)
8176 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8177 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8178 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8179 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8180 END DO
8181 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8182 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8183 END DO
8184 END DO
8185 END DO
8186 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 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 kbd(1:3*6) = 0.0_dp
8209 kbc(1:3*1) = 0.0_dp
8210 kad(1:1*6) = 0.0_dp
8211 kac(1:1*1) = 0.0_dp
8212 p_index = 0
8213 DO md = 1, 6
8214 DO mc = 1, 1
8215 DO mb = 1, 3
8216 ks_bd = 0.0_dp
8217 ks_bc = 0.0_dp
8218 p_bd = pbd((md - 1)*3 + mb)
8219 p_bc = pbc((mc - 1)*3 + mb)
8220 DO ma = 1, 1
8221 p_index = p_index + 1
8222 tmp = scale*prim(p_index)
8223 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8224 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8225 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8226 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8227 END DO
8228 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8229 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8230 END DO
8231 END DO
8232 END DO
8233 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 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 kbd(1:3*md_max) = 0.0_dp
8257 kbc(1:3*1) = 0.0_dp
8258 kad(1:1*md_max) = 0.0_dp
8259 kac(1:1*1) = 0.0_dp
8260 p_index = 0
8261 DO md = 1, md_max
8262 DO mc = 1, 1
8263 DO mb = 1, 3
8264 ks_bd = 0.0_dp
8265 ks_bc = 0.0_dp
8266 p_bd = pbd((md - 1)*3 + mb)
8267 p_bc = pbc((mc - 1)*3 + mb)
8268 DO ma = 1, 1
8269 p_index = p_index + 1
8270 tmp = scale*prim(p_index)
8271 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8272 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8273 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8274 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8275 END DO
8276 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8277 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8278 END DO
8279 END DO
8280 END DO
8281 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 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 kbd(1:3*1) = 0.0_dp
8304 kbc(1:3*2) = 0.0_dp
8305 kad(1:1*1) = 0.0_dp
8306 kac(1:1*2) = 0.0_dp
8307 p_index = 0
8308 DO md = 1, 1
8309 DO mc = 1, 2
8310 DO mb = 1, 3
8311 ks_bd = 0.0_dp
8312 ks_bc = 0.0_dp
8313 p_bd = pbd((md - 1)*3 + mb)
8314 p_bc = pbc((mc - 1)*3 + mb)
8315 DO ma = 1, 1
8316 p_index = p_index + 1
8317 tmp = scale*prim(p_index)
8318 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8319 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8320 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8321 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8322 END DO
8323 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8324 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8325 END DO
8326 END DO
8327 END DO
8328 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 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 kbd(1:3*2) = 0.0_dp
8351 kbc(1:3*2) = 0.0_dp
8352 kad(1:1*2) = 0.0_dp
8353 kac(1:1*2) = 0.0_dp
8354 p_index = 0
8355 DO md = 1, 2
8356 DO mc = 1, 2
8357 DO mb = 1, 3
8358 ks_bd = 0.0_dp
8359 ks_bc = 0.0_dp
8360 p_bd = pbd((md - 1)*3 + mb)
8361 p_bc = pbc((mc - 1)*3 + mb)
8362 DO ma = 1, 1
8363 p_index = p_index + 1
8364 tmp = scale*prim(p_index)
8365 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8366 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8367 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8368 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8369 END DO
8370 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8371 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8372 END DO
8373 END DO
8374 END DO
8375 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 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 kbd(1:3*3) = 0.0_dp
8398 kbc(1:3*2) = 0.0_dp
8399 kad(1:1*3) = 0.0_dp
8400 kac(1:1*2) = 0.0_dp
8401 p_index = 0
8402 DO md = 1, 3
8403 DO mc = 1, 2
8404 DO mb = 1, 3
8405 ks_bd = 0.0_dp
8406 ks_bc = 0.0_dp
8407 p_bd = pbd((md - 1)*3 + mb)
8408 p_bc = pbc((mc - 1)*3 + mb)
8409 DO ma = 1, 1
8410 p_index = p_index + 1
8411 tmp = scale*prim(p_index)
8412 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8413 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8414 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8415 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8416 END DO
8417 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8418 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8419 END DO
8420 END DO
8421 END DO
8422 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 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 kbd(1:3*md_max) = 0.0_dp
8446 kbc(1:3*2) = 0.0_dp
8447 kad(1:1*md_max) = 0.0_dp
8448 kac(1:1*2) = 0.0_dp
8449 p_index = 0
8450 DO md = 1, md_max
8451 DO mc = 1, 2
8452 DO mb = 1, 3
8453 ks_bd = 0.0_dp
8454 ks_bc = 0.0_dp
8455 p_bd = pbd((md - 1)*3 + mb)
8456 p_bc = pbc((mc - 1)*3 + mb)
8457 DO ma = 1, 1
8458 p_index = p_index + 1
8459 tmp = scale*prim(p_index)
8460 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8461 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8462 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8463 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8464 END DO
8465 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8466 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8467 END DO
8468 END DO
8469 END DO
8470 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 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 kbd(1:3*1) = 0.0_dp
8493 kbc(1:3*3) = 0.0_dp
8494 kad(1:1*1) = 0.0_dp
8495 kac(1:1*3) = 0.0_dp
8496 p_index = 0
8497 DO md = 1, 1
8498 DO mc = 1, 3
8499 DO mb = 1, 3
8500 ks_bd = 0.0_dp
8501 ks_bc = 0.0_dp
8502 p_bd = pbd((md - 1)*3 + mb)
8503 p_bc = pbc((mc - 1)*3 + mb)
8504 DO ma = 1, 1
8505 p_index = p_index + 1
8506 tmp = scale*prim(p_index)
8507 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8508 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8509 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8510 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8511 END DO
8512 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8513 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8514 END DO
8515 END DO
8516 END DO
8517 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 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 kbd(1:3*2) = 0.0_dp
8540 kbc(1:3*3) = 0.0_dp
8541 kad(1:1*2) = 0.0_dp
8542 kac(1:1*3) = 0.0_dp
8543 p_index = 0
8544 DO md = 1, 2
8545 DO mc = 1, 3
8546 DO mb = 1, 3
8547 ks_bd = 0.0_dp
8548 ks_bc = 0.0_dp
8549 p_bd = pbd((md - 1)*3 + mb)
8550 p_bc = pbc((mc - 1)*3 + mb)
8551 DO ma = 1, 1
8552 p_index = p_index + 1
8553 tmp = scale*prim(p_index)
8554 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8555 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8556 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8557 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8558 END DO
8559 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8560 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8561 END DO
8562 END DO
8563 END DO
8564 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 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 kbd(1:3*md_max) = 0.0_dp
8588 kbc(1:3*3) = 0.0_dp
8589 kad(1:1*md_max) = 0.0_dp
8590 kac(1:1*3) = 0.0_dp
8591 p_index = 0
8592 DO md = 1, md_max
8593 DO mc = 1, 3
8594 DO mb = 1, 3
8595 ks_bd = 0.0_dp
8596 ks_bc = 0.0_dp
8597 p_bd = pbd((md - 1)*3 + mb)
8598 p_bc = pbc((mc - 1)*3 + mb)
8599 DO ma = 1, 1
8600 p_index = p_index + 1
8601 tmp = scale*prim(p_index)
8602 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8603 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8604 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8605 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8606 END DO
8607 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8608 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8609 END DO
8610 END DO
8611 END DO
8612 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 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 kbd(1:3*1) = 0.0_dp
8635 kbc(1:3*4) = 0.0_dp
8636 kad(1:1*1) = 0.0_dp
8637 kac(1:1*4) = 0.0_dp
8638 p_index = 0
8639 DO md = 1, 1
8640 DO mc = 1, 4
8641 DO mb = 1, 3
8642 ks_bd = 0.0_dp
8643 ks_bc = 0.0_dp
8644 p_bd = pbd((md - 1)*3 + mb)
8645 p_bc = pbc((mc - 1)*3 + mb)
8646 DO ma = 1, 1
8647 p_index = p_index + 1
8648 tmp = scale*prim(p_index)
8649 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8650 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8651 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8652 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8653 END DO
8654 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8655 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8656 END DO
8657 END DO
8658 END DO
8659 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 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 kbd(1:3*md_max) = 0.0_dp
8683 kbc(1:3*4) = 0.0_dp
8684 kad(1:1*md_max) = 0.0_dp
8685 kac(1:1*4) = 0.0_dp
8686 p_index = 0
8687 DO md = 1, md_max
8688 DO mc = 1, 4
8689 DO mb = 1, 3
8690 ks_bd = 0.0_dp
8691 ks_bc = 0.0_dp
8692 p_bd = pbd((md - 1)*3 + mb)
8693 p_bc = pbc((mc - 1)*3 + mb)
8694 DO ma = 1, 1
8695 p_index = p_index + 1
8696 tmp = scale*prim(p_index)
8697 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8698 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8699 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8700 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8701 END DO
8702 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8703 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8704 END DO
8705 END DO
8706 END DO
8707 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 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 kbd(1:3*1) = 0.0_dp
8730 kbc(1:3*5) = 0.0_dp
8731 kad(1:1*1) = 0.0_dp
8732 kac(1:1*5) = 0.0_dp
8733 p_index = 0
8734 DO md = 1, 1
8735 DO mc = 1, 5
8736 DO mb = 1, 3
8737 ks_bd = 0.0_dp
8738 ks_bc = 0.0_dp
8739 p_bd = pbd((md - 1)*3 + mb)
8740 p_bc = pbc((mc - 1)*3 + mb)
8741 DO ma = 1, 1
8742 p_index = p_index + 1
8743 tmp = scale*prim(p_index)
8744 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8745 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8746 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8747 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8748 END DO
8749 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8750 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8751 END DO
8752 END DO
8753 END DO
8754 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 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 kbd(1:3*md_max) = 0.0_dp
8778 kbc(1:3*5) = 0.0_dp
8779 kad(1:1*md_max) = 0.0_dp
8780 kac(1:1*5) = 0.0_dp
8781 p_index = 0
8782 DO md = 1, md_max
8783 DO mc = 1, 5
8784 DO mb = 1, 3
8785 ks_bd = 0.0_dp
8786 ks_bc = 0.0_dp
8787 p_bd = pbd((md - 1)*3 + mb)
8788 p_bc = pbc((mc - 1)*3 + mb)
8789 DO ma = 1, 1
8790 p_index = p_index + 1
8791 tmp = scale*prim(p_index)
8792 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8793 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8794 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8795 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8796 END DO
8797 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8798 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8799 END DO
8800 END DO
8801 END DO
8802 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 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 kbd(1:3*1) = 0.0_dp
8825 kbc(1:3*6) = 0.0_dp
8826 kad(1:1*1) = 0.0_dp
8827 kac(1:1*6) = 0.0_dp
8828 p_index = 0
8829 DO md = 1, 1
8830 DO mc = 1, 6
8831 DO mb = 1, 3
8832 ks_bd = 0.0_dp
8833 ks_bc = 0.0_dp
8834 p_bd = pbd((md - 1)*3 + mb)
8835 p_bc = pbc((mc - 1)*3 + mb)
8836 DO ma = 1, 1
8837 p_index = p_index + 1
8838 tmp = scale*prim(p_index)
8839 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8840 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8841 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8842 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8843 END DO
8844 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8845 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8846 END DO
8847 END DO
8848 END DO
8849 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 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 kbd(1:3*md_max) = 0.0_dp
8873 kbc(1:3*6) = 0.0_dp
8874 kad(1:1*md_max) = 0.0_dp
8875 kac(1:1*6) = 0.0_dp
8876 p_index = 0
8877 DO md = 1, md_max
8878 DO mc = 1, 6
8879 DO mb = 1, 3
8880 ks_bd = 0.0_dp
8881 ks_bc = 0.0_dp
8882 p_bd = pbd((md - 1)*3 + mb)
8883 p_bc = pbc((mc - 1)*3 + mb)
8884 DO ma = 1, 1
8885 p_index = p_index + 1
8886 tmp = scale*prim(p_index)
8887 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8888 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8889 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8890 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8891 END DO
8892 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8893 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8894 END DO
8895 END DO
8896 END DO
8897 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 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 kbd(1:3*md_max) = 0.0_dp
8922 kbc(1:3*mc_max) = 0.0_dp
8923 kad(1:1*md_max) = 0.0_dp
8924 kac(1:1*mc_max) = 0.0_dp
8925 p_index = 0
8926 DO md = 1, md_max
8927 DO mc = 1, mc_max
8928 DO mb = 1, 3
8929 ks_bd = 0.0_dp
8930 ks_bc = 0.0_dp
8931 p_bd = pbd((md - 1)*3 + mb)
8932 p_bc = pbc((mc - 1)*3 + mb)
8933 DO ma = 1, 1
8934 p_index = p_index + 1
8935 tmp = scale*prim(p_index)
8936 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8937 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8938 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8939 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8940 END DO
8941 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
8942 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
8943 END DO
8944 END DO
8945 END DO
8946 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 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 kbd(1:4*1) = 0.0_dp
8969 kbc(1:4*1) = 0.0_dp
8970 kad(1:1*1) = 0.0_dp
8971 kac(1:1*1) = 0.0_dp
8972 p_index = 0
8973 DO md = 1, 1
8974 DO mc = 1, 1
8975 DO mb = 1, 4
8976 ks_bd = 0.0_dp
8977 ks_bc = 0.0_dp
8978 p_bd = pbd((md - 1)*4 + mb)
8979 p_bc = pbc((mc - 1)*4 + mb)
8980 DO ma = 1, 1
8981 p_index = p_index + 1
8982 tmp = scale*prim(p_index)
8983 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
8984 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
8985 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
8986 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
8987 END DO
8988 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
8989 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
8990 END DO
8991 END DO
8992 END DO
8993 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 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 kbd(1:4*2) = 0.0_dp
9016 kbc(1:4*1) = 0.0_dp
9017 kad(1:1*2) = 0.0_dp
9018 kac(1:1*1) = 0.0_dp
9019 p_index = 0
9020 DO md = 1, 2
9021 DO mc = 1, 1
9022 DO mb = 1, 4
9023 ks_bd = 0.0_dp
9024 ks_bc = 0.0_dp
9025 p_bd = pbd((md - 1)*4 + mb)
9026 p_bc = pbc((mc - 1)*4 + mb)
9027 DO ma = 1, 1
9028 p_index = p_index + 1
9029 tmp = scale*prim(p_index)
9030 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9031 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9032 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9033 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9034 END DO
9035 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9036 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9037 END DO
9038 END DO
9039 END DO
9040 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 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 kbd(1:4*3) = 0.0_dp
9063 kbc(1:4*1) = 0.0_dp
9064 kad(1:1*3) = 0.0_dp
9065 kac(1:1*1) = 0.0_dp
9066 p_index = 0
9067 DO md = 1, 3
9068 DO mc = 1, 1
9069 DO mb = 1, 4
9070 ks_bd = 0.0_dp
9071 ks_bc = 0.0_dp
9072 p_bd = pbd((md - 1)*4 + mb)
9073 p_bc = pbc((mc - 1)*4 + mb)
9074 DO ma = 1, 1
9075 p_index = p_index + 1
9076 tmp = scale*prim(p_index)
9077 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9078 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9079 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9080 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9081 END DO
9082 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9083 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9084 END DO
9085 END DO
9086 END DO
9087 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 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 kbd(1:4*4) = 0.0_dp
9110 kbc(1:4*1) = 0.0_dp
9111 kad(1:1*4) = 0.0_dp
9112 kac(1:1*1) = 0.0_dp
9113 p_index = 0
9114 DO md = 1, 4
9115 DO mc = 1, 1
9116 DO mb = 1, 4
9117 ks_bd = 0.0_dp
9118 ks_bc = 0.0_dp
9119 p_bd = pbd((md - 1)*4 + mb)
9120 p_bc = pbc((mc - 1)*4 + mb)
9121 DO ma = 1, 1
9122 p_index = p_index + 1
9123 tmp = scale*prim(p_index)
9124 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9125 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9126 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9127 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9128 END DO
9129 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9130 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9131 END DO
9132 END DO
9133 END DO
9134 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 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 kbd(1:4*md_max) = 0.0_dp
9158 kbc(1:4*1) = 0.0_dp
9159 kad(1:1*md_max) = 0.0_dp
9160 kac(1:1*1) = 0.0_dp
9161 p_index = 0
9162 DO md = 1, md_max
9163 DO mc = 1, 1
9164 DO mb = 1, 4
9165 ks_bd = 0.0_dp
9166 ks_bc = 0.0_dp
9167 p_bd = pbd((md - 1)*4 + mb)
9168 p_bc = pbc((mc - 1)*4 + mb)
9169 DO ma = 1, 1
9170 p_index = p_index + 1
9171 tmp = scale*prim(p_index)
9172 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9173 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9174 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9175 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9176 END DO
9177 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9178 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9179 END DO
9180 END DO
9181 END DO
9182 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 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 kbd(1:4*1) = 0.0_dp
9205 kbc(1:4*2) = 0.0_dp
9206 kad(1:1*1) = 0.0_dp
9207 kac(1:1*2) = 0.0_dp
9208 p_index = 0
9209 DO md = 1, 1
9210 DO mc = 1, 2
9211 DO mb = 1, 4
9212 ks_bd = 0.0_dp
9213 ks_bc = 0.0_dp
9214 p_bd = pbd((md - 1)*4 + mb)
9215 p_bc = pbc((mc - 1)*4 + mb)
9216 DO ma = 1, 1
9217 p_index = p_index + 1
9218 tmp = scale*prim(p_index)
9219 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9220 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9221 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9222 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9223 END DO
9224 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9225 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9226 END DO
9227 END DO
9228 END DO
9229 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 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 kbd(1:4*2) = 0.0_dp
9252 kbc(1:4*2) = 0.0_dp
9253 kad(1:1*2) = 0.0_dp
9254 kac(1:1*2) = 0.0_dp
9255 p_index = 0
9256 DO md = 1, 2
9257 DO mc = 1, 2
9258 DO mb = 1, 4
9259 ks_bd = 0.0_dp
9260 ks_bc = 0.0_dp
9261 p_bd = pbd((md - 1)*4 + mb)
9262 p_bc = pbc((mc - 1)*4 + mb)
9263 DO ma = 1, 1
9264 p_index = p_index + 1
9265 tmp = scale*prim(p_index)
9266 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9267 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9268 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9269 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9270 END DO
9271 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9272 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9273 END DO
9274 END DO
9275 END DO
9276 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 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 kbd(1:4*md_max) = 0.0_dp
9300 kbc(1:4*2) = 0.0_dp
9301 kad(1:1*md_max) = 0.0_dp
9302 kac(1:1*2) = 0.0_dp
9303 p_index = 0
9304 DO md = 1, md_max
9305 DO mc = 1, 2
9306 DO mb = 1, 4
9307 ks_bd = 0.0_dp
9308 ks_bc = 0.0_dp
9309 p_bd = pbd((md - 1)*4 + mb)
9310 p_bc = pbc((mc - 1)*4 + mb)
9311 DO ma = 1, 1
9312 p_index = p_index + 1
9313 tmp = scale*prim(p_index)
9314 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9315 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9316 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9317 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9318 END DO
9319 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9320 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9321 END DO
9322 END DO
9323 END DO
9324 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 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 kbd(1:4*1) = 0.0_dp
9347 kbc(1:4*3) = 0.0_dp
9348 kad(1:1*1) = 0.0_dp
9349 kac(1:1*3) = 0.0_dp
9350 p_index = 0
9351 DO md = 1, 1
9352 DO mc = 1, 3
9353 DO mb = 1, 4
9354 ks_bd = 0.0_dp
9355 ks_bc = 0.0_dp
9356 p_bd = pbd((md - 1)*4 + mb)
9357 p_bc = pbc((mc - 1)*4 + mb)
9358 DO ma = 1, 1
9359 p_index = p_index + 1
9360 tmp = scale*prim(p_index)
9361 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9362 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9363 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9364 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9365 END DO
9366 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9367 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9368 END DO
9369 END DO
9370 END DO
9371 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 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 kbd(1:4*md_max) = 0.0_dp
9395 kbc(1:4*3) = 0.0_dp
9396 kad(1:1*md_max) = 0.0_dp
9397 kac(1:1*3) = 0.0_dp
9398 p_index = 0
9399 DO md = 1, md_max
9400 DO mc = 1, 3
9401 DO mb = 1, 4
9402 ks_bd = 0.0_dp
9403 ks_bc = 0.0_dp
9404 p_bd = pbd((md - 1)*4 + mb)
9405 p_bc = pbc((mc - 1)*4 + mb)
9406 DO ma = 1, 1
9407 p_index = p_index + 1
9408 tmp = scale*prim(p_index)
9409 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9410 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9411 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9412 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9413 END DO
9414 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9415 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9416 END DO
9417 END DO
9418 END DO
9419 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 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 kbd(1:4*1) = 0.0_dp
9442 kbc(1:4*4) = 0.0_dp
9443 kad(1:1*1) = 0.0_dp
9444 kac(1:1*4) = 0.0_dp
9445 p_index = 0
9446 DO md = 1, 1
9447 DO mc = 1, 4
9448 DO mb = 1, 4
9449 ks_bd = 0.0_dp
9450 ks_bc = 0.0_dp
9451 p_bd = pbd((md - 1)*4 + mb)
9452 p_bc = pbc((mc - 1)*4 + mb)
9453 DO ma = 1, 1
9454 p_index = p_index + 1
9455 tmp = scale*prim(p_index)
9456 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9457 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9458 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9459 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9460 END DO
9461 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9462 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9463 END DO
9464 END DO
9465 END DO
9466 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 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 kbd(1:4*md_max) = 0.0_dp
9490 kbc(1:4*4) = 0.0_dp
9491 kad(1:1*md_max) = 0.0_dp
9492 kac(1:1*4) = 0.0_dp
9493 p_index = 0
9494 DO md = 1, md_max
9495 DO mc = 1, 4
9496 DO mb = 1, 4
9497 ks_bd = 0.0_dp
9498 ks_bc = 0.0_dp
9499 p_bd = pbd((md - 1)*4 + mb)
9500 p_bc = pbc((mc - 1)*4 + mb)
9501 DO ma = 1, 1
9502 p_index = p_index + 1
9503 tmp = scale*prim(p_index)
9504 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9505 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9506 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9507 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9508 END DO
9509 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9510 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9511 END DO
9512 END DO
9513 END DO
9514 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 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 kbd(1:4*md_max) = 0.0_dp
9539 kbc(1:4*mc_max) = 0.0_dp
9540 kad(1:1*md_max) = 0.0_dp
9541 kac(1:1*mc_max) = 0.0_dp
9542 p_index = 0
9543 DO md = 1, md_max
9544 DO mc = 1, mc_max
9545 DO mb = 1, 4
9546 ks_bd = 0.0_dp
9547 ks_bc = 0.0_dp
9548 p_bd = pbd((md - 1)*4 + mb)
9549 p_bc = pbc((mc - 1)*4 + mb)
9550 DO ma = 1, 1
9551 p_index = p_index + 1
9552 tmp = scale*prim(p_index)
9553 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9554 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9555 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9556 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9557 END DO
9558 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
9559 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
9560 END DO
9561 END DO
9562 END DO
9563 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 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 kbd(1:5*1) = 0.0_dp
9586 kbc(1:5*1) = 0.0_dp
9587 kad(1:1*1) = 0.0_dp
9588 kac(1:1*1) = 0.0_dp
9589 p_index = 0
9590 DO md = 1, 1
9591 DO mc = 1, 1
9592 DO mb = 1, 5
9593 ks_bd = 0.0_dp
9594 ks_bc = 0.0_dp
9595 p_bd = pbd((md - 1)*5 + mb)
9596 p_bc = pbc((mc - 1)*5 + mb)
9597 DO ma = 1, 1
9598 p_index = p_index + 1
9599 tmp = scale*prim(p_index)
9600 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9601 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9602 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9603 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9604 END DO
9605 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
9606 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
9607 END DO
9608 END DO
9609 END DO
9610 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 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 kbd(1:5*2) = 0.0_dp
9633 kbc(1:5*1) = 0.0_dp
9634 kad(1:1*2) = 0.0_dp
9635 kac(1:1*1) = 0.0_dp
9636 p_index = 0
9637 DO md = 1, 2
9638 DO mc = 1, 1
9639 DO mb = 1, 5
9640 ks_bd = 0.0_dp
9641 ks_bc = 0.0_dp
9642 p_bd = pbd((md - 1)*5 + mb)
9643 p_bc = pbc((mc - 1)*5 + mb)
9644 DO ma = 1, 1
9645 p_index = p_index + 1
9646 tmp = scale*prim(p_index)
9647 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9648 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9649 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9650 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9651 END DO
9652 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
9653 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
9654 END DO
9655 END DO
9656 END DO
9657 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 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 kbd(1:5*3) = 0.0_dp
9680 kbc(1:5*1) = 0.0_dp
9681 kad(1:1*3) = 0.0_dp
9682 kac(1:1*1) = 0.0_dp
9683 p_index = 0
9684 DO md = 1, 3
9685 DO mc = 1, 1
9686 DO mb = 1, 5
9687 ks_bd = 0.0_dp
9688 ks_bc = 0.0_dp
9689 p_bd = pbd((md - 1)*5 + mb)
9690 p_bc = pbc((mc - 1)*5 + mb)
9691 DO ma = 1, 1
9692 p_index = p_index + 1
9693 tmp = scale*prim(p_index)
9694 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9695 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9696 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9697 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9698 END DO
9699 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
9700 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
9701 END DO
9702 END DO
9703 END DO
9704 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 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 kbd(1:5*md_max) = 0.0_dp
9728 kbc(1:5*1) = 0.0_dp
9729 kad(1:1*md_max) = 0.0_dp
9730 kac(1:1*1) = 0.0_dp
9731 p_index = 0
9732 DO md = 1, md_max
9733 DO mc = 1, 1
9734 DO mb = 1, 5
9735 ks_bd = 0.0_dp
9736 ks_bc = 0.0_dp
9737 p_bd = pbd((md - 1)*5 + mb)
9738 p_bc = pbc((mc - 1)*5 + mb)
9739 DO ma = 1, 1
9740 p_index = p_index + 1
9741 tmp = scale*prim(p_index)
9742 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9743 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9744 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9745 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9746 END DO
9747 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
9748 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
9749 END DO
9750 END DO
9751 END DO
9752 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 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 kbd(1:5*1) = 0.0_dp
9775 kbc(1:5*2) = 0.0_dp
9776 kad(1:1*1) = 0.0_dp
9777 kac(1:1*2) = 0.0_dp
9778 p_index = 0
9779 DO md = 1, 1
9780 DO mc = 1, 2
9781 DO mb = 1, 5
9782 ks_bd = 0.0_dp
9783 ks_bc = 0.0_dp
9784 p_bd = pbd((md - 1)*5 + mb)
9785 p_bc = pbc((mc - 1)*5 + mb)
9786 DO ma = 1, 1
9787 p_index = p_index + 1
9788 tmp = scale*prim(p_index)
9789 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9790 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9791 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9792 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9793 END DO
9794 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
9795 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
9796 END DO
9797 END DO
9798 END DO
9799 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 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 kbd(1:5*md_max) = 0.0_dp
9823 kbc(1:5*2) = 0.0_dp
9824 kad(1:1*md_max) = 0.0_dp
9825 kac(1:1*2) = 0.0_dp
9826 p_index = 0
9827 DO md = 1, md_max
9828 DO mc = 1, 2
9829 DO mb = 1, 5
9830 ks_bd = 0.0_dp
9831 ks_bc = 0.0_dp
9832 p_bd = pbd((md - 1)*5 + mb)
9833 p_bc = pbc((mc - 1)*5 + mb)
9834 DO ma = 1, 1
9835 p_index = p_index + 1
9836 tmp = scale*prim(p_index)
9837 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9838 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9839 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9840 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9841 END DO
9842 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
9843 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
9844 END DO
9845 END DO
9846 END DO
9847 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 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 kbd(1:5*1) = 0.0_dp
9870 kbc(1:5*3) = 0.0_dp
9871 kad(1:1*1) = 0.0_dp
9872 kac(1:1*3) = 0.0_dp
9873 p_index = 0
9874 DO md = 1, 1
9875 DO mc = 1, 3
9876 DO mb = 1, 5
9877 ks_bd = 0.0_dp
9878 ks_bc = 0.0_dp
9879 p_bd = pbd((md - 1)*5 + mb)
9880 p_bc = pbc((mc - 1)*5 + mb)
9881 DO ma = 1, 1
9882 p_index = p_index + 1
9883 tmp = scale*prim(p_index)
9884 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9885 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9886 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9887 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9888 END DO
9889 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
9890 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
9891 END DO
9892 END DO
9893 END DO
9894 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 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 kbd(1:5*md_max) = 0.0_dp
9918 kbc(1:5*3) = 0.0_dp
9919 kad(1:1*md_max) = 0.0_dp
9920 kac(1:1*3) = 0.0_dp
9921 p_index = 0
9922 DO md = 1, md_max
9923 DO mc = 1, 3
9924 DO mb = 1, 5
9925 ks_bd = 0.0_dp
9926 ks_bc = 0.0_dp
9927 p_bd = pbd((md - 1)*5 + mb)
9928 p_bc = pbc((mc - 1)*5 + mb)
9929 DO ma = 1, 1
9930 p_index = p_index + 1
9931 tmp = scale*prim(p_index)
9932 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9933 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9934 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9935 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9936 END DO
9937 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
9938 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
9939 END DO
9940 END DO
9941 END DO
9942 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 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 kbd(1:5*md_max) = 0.0_dp
9967 kbc(1:5*mc_max) = 0.0_dp
9968 kad(1:1*md_max) = 0.0_dp
9969 kac(1:1*mc_max) = 0.0_dp
9970 p_index = 0
9971 DO md = 1, md_max
9972 DO mc = 1, mc_max
9973 DO mb = 1, 5
9974 ks_bd = 0.0_dp
9975 ks_bc = 0.0_dp
9976 p_bd = pbd((md - 1)*5 + mb)
9977 p_bc = pbc((mc - 1)*5 + mb)
9978 DO ma = 1, 1
9979 p_index = p_index + 1
9980 tmp = scale*prim(p_index)
9981 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
9982 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
9983 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
9984 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
9985 END DO
9986 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
9987 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
9988 END DO
9989 END DO
9990 END DO
9991 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 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 kbd(1:6*1) = 0.0_dp
10014 kbc(1:6*1) = 0.0_dp
10015 kad(1:1*1) = 0.0_dp
10016 kac(1:1*1) = 0.0_dp
10017 p_index = 0
10018 DO md = 1, 1
10019 DO mc = 1, 1
10020 DO mb = 1, 6
10021 ks_bd = 0.0_dp
10022 ks_bc = 0.0_dp
10023 p_bd = pbd((md - 1)*6 + mb)
10024 p_bc = pbc((mc - 1)*6 + mb)
10025 DO ma = 1, 1
10026 p_index = p_index + 1
10027 tmp = scale*prim(p_index)
10028 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10029 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10030 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10031 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10032 END DO
10033 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
10034 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
10035 END DO
10036 END DO
10037 END DO
10038 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 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 kbd(1:6*2) = 0.0_dp
10061 kbc(1:6*1) = 0.0_dp
10062 kad(1:1*2) = 0.0_dp
10063 kac(1:1*1) = 0.0_dp
10064 p_index = 0
10065 DO md = 1, 2
10066 DO mc = 1, 1
10067 DO mb = 1, 6
10068 ks_bd = 0.0_dp
10069 ks_bc = 0.0_dp
10070 p_bd = pbd((md - 1)*6 + mb)
10071 p_bc = pbc((mc - 1)*6 + mb)
10072 DO ma = 1, 1
10073 p_index = p_index + 1
10074 tmp = scale*prim(p_index)
10075 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10076 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10077 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10078 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10079 END DO
10080 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
10081 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
10082 END DO
10083 END DO
10084 END DO
10085 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 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 kbd(1:6*3) = 0.0_dp
10108 kbc(1:6*1) = 0.0_dp
10109 kad(1:1*3) = 0.0_dp
10110 kac(1:1*1) = 0.0_dp
10111 p_index = 0
10112 DO md = 1, 3
10113 DO mc = 1, 1
10114 DO mb = 1, 6
10115 ks_bd = 0.0_dp
10116 ks_bc = 0.0_dp
10117 p_bd = pbd((md - 1)*6 + mb)
10118 p_bc = pbc((mc - 1)*6 + mb)
10119 DO ma = 1, 1
10120 p_index = p_index + 1
10121 tmp = scale*prim(p_index)
10122 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10123 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10124 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10125 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10126 END DO
10127 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
10128 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
10129 END DO
10130 END DO
10131 END DO
10132 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 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 kbd(1:6*md_max) = 0.0_dp
10156 kbc(1:6*1) = 0.0_dp
10157 kad(1:1*md_max) = 0.0_dp
10158 kac(1:1*1) = 0.0_dp
10159 p_index = 0
10160 DO md = 1, md_max
10161 DO mc = 1, 1
10162 DO mb = 1, 6
10163 ks_bd = 0.0_dp
10164 ks_bc = 0.0_dp
10165 p_bd = pbd((md - 1)*6 + mb)
10166 p_bc = pbc((mc - 1)*6 + mb)
10167 DO ma = 1, 1
10168 p_index = p_index + 1
10169 tmp = scale*prim(p_index)
10170 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10171 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10172 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10173 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10174 END DO
10175 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
10176 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
10177 END DO
10178 END DO
10179 END DO
10180 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 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 kbd(1:6*1) = 0.0_dp
10203 kbc(1:6*2) = 0.0_dp
10204 kad(1:1*1) = 0.0_dp
10205 kac(1:1*2) = 0.0_dp
10206 p_index = 0
10207 DO md = 1, 1
10208 DO mc = 1, 2
10209 DO mb = 1, 6
10210 ks_bd = 0.0_dp
10211 ks_bc = 0.0_dp
10212 p_bd = pbd((md - 1)*6 + mb)
10213 p_bc = pbc((mc - 1)*6 + mb)
10214 DO ma = 1, 1
10215 p_index = p_index + 1
10216 tmp = scale*prim(p_index)
10217 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10218 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10219 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10220 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10221 END DO
10222 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
10223 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
10224 END DO
10225 END DO
10226 END DO
10227 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 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 kbd(1:6*md_max) = 0.0_dp
10251 kbc(1:6*2) = 0.0_dp
10252 kad(1:1*md_max) = 0.0_dp
10253 kac(1:1*2) = 0.0_dp
10254 p_index = 0
10255 DO md = 1, md_max
10256 DO mc = 1, 2
10257 DO mb = 1, 6
10258 ks_bd = 0.0_dp
10259 ks_bc = 0.0_dp
10260 p_bd = pbd((md - 1)*6 + mb)
10261 p_bc = pbc((mc - 1)*6 + mb)
10262 DO ma = 1, 1
10263 p_index = p_index + 1
10264 tmp = scale*prim(p_index)
10265 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10266 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10267 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10268 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10269 END DO
10270 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
10271 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
10272 END DO
10273 END DO
10274 END DO
10275 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 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 kbd(1:6*1) = 0.0_dp
10298 kbc(1:6*3) = 0.0_dp
10299 kad(1:1*1) = 0.0_dp
10300 kac(1:1*3) = 0.0_dp
10301 p_index = 0
10302 DO md = 1, 1
10303 DO mc = 1, 3
10304 DO mb = 1, 6
10305 ks_bd = 0.0_dp
10306 ks_bc = 0.0_dp
10307 p_bd = pbd((md - 1)*6 + mb)
10308 p_bc = pbc((mc - 1)*6 + mb)
10309 DO ma = 1, 1
10310 p_index = p_index + 1
10311 tmp = scale*prim(p_index)
10312 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10313 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10314 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10315 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10316 END DO
10317 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
10318 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
10319 END DO
10320 END DO
10321 END DO
10322 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 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 kbd(1:6*md_max) = 0.0_dp
10346 kbc(1:6*3) = 0.0_dp
10347 kad(1:1*md_max) = 0.0_dp
10348 kac(1:1*3) = 0.0_dp
10349 p_index = 0
10350 DO md = 1, md_max
10351 DO mc = 1, 3
10352 DO mb = 1, 6
10353 ks_bd = 0.0_dp
10354 ks_bc = 0.0_dp
10355 p_bd = pbd((md - 1)*6 + mb)
10356 p_bc = pbc((mc - 1)*6 + mb)
10357 DO ma = 1, 1
10358 p_index = p_index + 1
10359 tmp = scale*prim(p_index)
10360 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10361 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10362 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10363 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10364 END DO
10365 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
10366 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
10367 END DO
10368 END DO
10369 END DO
10370 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 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 kbd(1:6*md_max) = 0.0_dp
10395 kbc(1:6*mc_max) = 0.0_dp
10396 kad(1:1*md_max) = 0.0_dp
10397 kac(1:1*mc_max) = 0.0_dp
10398 p_index = 0
10399 DO md = 1, md_max
10400 DO mc = 1, mc_max
10401 DO mb = 1, 6
10402 ks_bd = 0.0_dp
10403 ks_bc = 0.0_dp
10404 p_bd = pbd((md - 1)*6 + mb)
10405 p_bc = pbc((mc - 1)*6 + mb)
10406 DO ma = 1, 1
10407 p_index = p_index + 1
10408 tmp = scale*prim(p_index)
10409 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10410 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10411 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10412 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10413 END DO
10414 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
10415 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
10416 END DO
10417 END DO
10418 END DO
10419 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 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 kbd(1:7*1) = 0.0_dp
10442 kbc(1:7*1) = 0.0_dp
10443 kad(1:1*1) = 0.0_dp
10444 kac(1:1*1) = 0.0_dp
10445 p_index = 0
10446 DO md = 1, 1
10447 DO mc = 1, 1
10448 DO mb = 1, 7
10449 ks_bd = 0.0_dp
10450 ks_bc = 0.0_dp
10451 p_bd = pbd((md - 1)*7 + mb)
10452 p_bc = pbc((mc - 1)*7 + mb)
10453 DO ma = 1, 1
10454 p_index = p_index + 1
10455 tmp = scale*prim(p_index)
10456 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10457 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10458 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10459 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10460 END DO
10461 kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
10462 kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
10463 END DO
10464 END DO
10465 END DO
10466 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 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 kbd(1:7*2) = 0.0_dp
10489 kbc(1:7*1) = 0.0_dp
10490 kad(1:1*2) = 0.0_dp
10491 kac(1:1*1) = 0.0_dp
10492 p_index = 0
10493 DO md = 1, 2
10494 DO mc = 1, 1
10495 DO mb = 1, 7
10496 ks_bd = 0.0_dp
10497 ks_bc = 0.0_dp
10498 p_bd = pbd((md - 1)*7 + mb)
10499 p_bc = pbc((mc - 1)*7 + mb)
10500 DO ma = 1, 1
10501 p_index = p_index + 1
10502 tmp = scale*prim(p_index)
10503 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10504 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10505 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10506 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10507 END DO
10508 kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
10509 kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
10510 END DO
10511 END DO
10512 END DO
10513 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 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 kbd(1:7*md_max) = 0.0_dp
10537 kbc(1:7*1) = 0.0_dp
10538 kad(1:1*md_max) = 0.0_dp
10539 kac(1:1*1) = 0.0_dp
10540 p_index = 0
10541 DO md = 1, md_max
10542 DO mc = 1, 1
10543 DO mb = 1, 7
10544 ks_bd = 0.0_dp
10545 ks_bc = 0.0_dp
10546 p_bd = pbd((md - 1)*7 + mb)
10547 p_bc = pbc((mc - 1)*7 + mb)
10548 DO ma = 1, 1
10549 p_index = p_index + 1
10550 tmp = scale*prim(p_index)
10551 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10552 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10553 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10554 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10555 END DO
10556 kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
10557 kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
10558 END DO
10559 END DO
10560 END DO
10561 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 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 kbd(1:7*1) = 0.0_dp
10584 kbc(1:7*2) = 0.0_dp
10585 kad(1:1*1) = 0.0_dp
10586 kac(1:1*2) = 0.0_dp
10587 p_index = 0
10588 DO md = 1, 1
10589 DO mc = 1, 2
10590 DO mb = 1, 7
10591 ks_bd = 0.0_dp
10592 ks_bc = 0.0_dp
10593 p_bd = pbd((md - 1)*7 + mb)
10594 p_bc = pbc((mc - 1)*7 + mb)
10595 DO ma = 1, 1
10596 p_index = p_index + 1
10597 tmp = scale*prim(p_index)
10598 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10599 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10600 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10601 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10602 END DO
10603 kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
10604 kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
10605 END DO
10606 END DO
10607 END DO
10608 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 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 kbd(1:7*md_max) = 0.0_dp
10632 kbc(1:7*2) = 0.0_dp
10633 kad(1:1*md_max) = 0.0_dp
10634 kac(1:1*2) = 0.0_dp
10635 p_index = 0
10636 DO md = 1, md_max
10637 DO mc = 1, 2
10638 DO mb = 1, 7
10639 ks_bd = 0.0_dp
10640 ks_bc = 0.0_dp
10641 p_bd = pbd((md - 1)*7 + mb)
10642 p_bc = pbc((mc - 1)*7 + mb)
10643 DO ma = 1, 1
10644 p_index = p_index + 1
10645 tmp = scale*prim(p_index)
10646 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10647 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10648 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10649 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10650 END DO
10651 kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
10652 kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
10653 END DO
10654 END DO
10655 END DO
10656 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 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 kbd(1:7*md_max) = 0.0_dp
10681 kbc(1:7*mc_max) = 0.0_dp
10682 kad(1:1*md_max) = 0.0_dp
10683 kac(1:1*mc_max) = 0.0_dp
10684 p_index = 0
10685 DO md = 1, md_max
10686 DO mc = 1, mc_max
10687 DO mb = 1, 7
10688 ks_bd = 0.0_dp
10689 ks_bc = 0.0_dp
10690 p_bd = pbd((md - 1)*7 + mb)
10691 p_bc = pbc((mc - 1)*7 + mb)
10692 DO ma = 1, 1
10693 p_index = p_index + 1
10694 tmp = scale*prim(p_index)
10695 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10696 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10697 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10698 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10699 END DO
10700 kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
10701 kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
10702 END DO
10703 END DO
10704 END DO
10705 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 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 kbd(1:9*1) = 0.0_dp
10728 kbc(1:9*1) = 0.0_dp
10729 kad(1:1*1) = 0.0_dp
10730 kac(1:1*1) = 0.0_dp
10731 p_index = 0
10732 DO md = 1, 1
10733 DO mc = 1, 1
10734 DO mb = 1, 9
10735 ks_bd = 0.0_dp
10736 ks_bc = 0.0_dp
10737 p_bd = pbd((md - 1)*9 + mb)
10738 p_bc = pbc((mc - 1)*9 + mb)
10739 DO ma = 1, 1
10740 p_index = p_index + 1
10741 tmp = scale*prim(p_index)
10742 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10743 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10744 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10745 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10746 END DO
10747 kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
10748 kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
10749 END DO
10750 END DO
10751 END DO
10752 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 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 kbd(1:9*2) = 0.0_dp
10775 kbc(1:9*1) = 0.0_dp
10776 kad(1:1*2) = 0.0_dp
10777 kac(1:1*1) = 0.0_dp
10778 p_index = 0
10779 DO md = 1, 2
10780 DO mc = 1, 1
10781 DO mb = 1, 9
10782 ks_bd = 0.0_dp
10783 ks_bc = 0.0_dp
10784 p_bd = pbd((md - 1)*9 + mb)
10785 p_bc = pbc((mc - 1)*9 + mb)
10786 DO ma = 1, 1
10787 p_index = p_index + 1
10788 tmp = scale*prim(p_index)
10789 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10790 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10791 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10792 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10793 END DO
10794 kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
10795 kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
10796 END DO
10797 END DO
10798 END DO
10799 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 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 kbd(1:9*md_max) = 0.0_dp
10823 kbc(1:9*1) = 0.0_dp
10824 kad(1:1*md_max) = 0.0_dp
10825 kac(1:1*1) = 0.0_dp
10826 p_index = 0
10827 DO md = 1, md_max
10828 DO mc = 1, 1
10829 DO mb = 1, 9
10830 ks_bd = 0.0_dp
10831 ks_bc = 0.0_dp
10832 p_bd = pbd((md - 1)*9 + mb)
10833 p_bc = pbc((mc - 1)*9 + mb)
10834 DO ma = 1, 1
10835 p_index = p_index + 1
10836 tmp = scale*prim(p_index)
10837 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10838 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10839 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10840 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10841 END DO
10842 kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
10843 kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
10844 END DO
10845 END DO
10846 END DO
10847 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 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 kbd(1:9*1) = 0.0_dp
10870 kbc(1:9*2) = 0.0_dp
10871 kad(1:1*1) = 0.0_dp
10872 kac(1:1*2) = 0.0_dp
10873 p_index = 0
10874 DO md = 1, 1
10875 DO mc = 1, 2
10876 DO mb = 1, 9
10877 ks_bd = 0.0_dp
10878 ks_bc = 0.0_dp
10879 p_bd = pbd((md - 1)*9 + mb)
10880 p_bc = pbc((mc - 1)*9 + mb)
10881 DO ma = 1, 1
10882 p_index = p_index + 1
10883 tmp = scale*prim(p_index)
10884 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10885 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10886 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10887 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10888 END DO
10889 kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
10890 kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
10891 END DO
10892 END DO
10893 END DO
10894 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 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 kbd(1:9*md_max) = 0.0_dp
10918 kbc(1:9*2) = 0.0_dp
10919 kad(1:1*md_max) = 0.0_dp
10920 kac(1:1*2) = 0.0_dp
10921 p_index = 0
10922 DO md = 1, md_max
10923 DO mc = 1, 2
10924 DO mb = 1, 9
10925 ks_bd = 0.0_dp
10926 ks_bc = 0.0_dp
10927 p_bd = pbd((md - 1)*9 + mb)
10928 p_bc = pbc((mc - 1)*9 + mb)
10929 DO ma = 1, 1
10930 p_index = p_index + 1
10931 tmp = scale*prim(p_index)
10932 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10933 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10934 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10935 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10936 END DO
10937 kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
10938 kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
10939 END DO
10940 END DO
10941 END DO
10942 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 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 kbd(1:9*md_max) = 0.0_dp
10967 kbc(1:9*mc_max) = 0.0_dp
10968 kad(1:1*md_max) = 0.0_dp
10969 kac(1:1*mc_max) = 0.0_dp
10970 p_index = 0
10971 DO md = 1, md_max
10972 DO mc = 1, mc_max
10973 DO mb = 1, 9
10974 ks_bd = 0.0_dp
10975 ks_bc = 0.0_dp
10976 p_bd = pbd((md - 1)*9 + mb)
10977 p_bc = pbc((mc - 1)*9 + mb)
10978 DO ma = 1, 1
10979 p_index = p_index + 1
10980 tmp = scale*prim(p_index)
10981 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
10982 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
10983 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
10984 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
10985 END DO
10986 kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
10987 kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
10988 END DO
10989 END DO
10990 END DO
10991 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 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 kbd(1:10*1) = 0.0_dp
11015 kbc(1:10*1) = 0.0_dp
11016 kad(1:1*1) = 0.0_dp
11017 kac(1:1*1) = 0.0_dp
11018 p_index = 0
11019 DO md = 1, 1
11020 DO mc = 1, 1
11021 DO mb = 1, 10
11022 ks_bd = 0.0_dp
11023 ks_bc = 0.0_dp
11024 p_bd = pbd((md - 1)*10 + mb)
11025 p_bc = pbc((mc - 1)*10 + mb)
11026 DO ma = 1, 1
11027 p_index = p_index + 1
11028 tmp = scale*prim(p_index)
11029 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
11030 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
11031 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
11032 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
11033 END DO
11034 kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
11035 kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
11036 END DO
11037 END DO
11038 END DO
11039 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 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 kbd(1:10*md_max) = 0.0_dp
11063 kbc(1:10*1) = 0.0_dp
11064 kad(1:1*md_max) = 0.0_dp
11065 kac(1:1*1) = 0.0_dp
11066 p_index = 0
11067 DO md = 1, md_max
11068 DO mc = 1, 1
11069 DO mb = 1, 10
11070 ks_bd = 0.0_dp
11071 ks_bc = 0.0_dp
11072 p_bd = pbd((md - 1)*10 + mb)
11073 p_bc = pbc((mc - 1)*10 + mb)
11074 DO ma = 1, 1
11075 p_index = p_index + 1
11076 tmp = scale*prim(p_index)
11077 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
11078 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
11079 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
11080 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
11081 END DO
11082 kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
11083 kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
11084 END DO
11085 END DO
11086 END DO
11087 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 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 kbd(1:10*md_max) = 0.0_dp
11113 kbc(1:10*mc_max) = 0.0_dp
11114 kad(1:1*md_max) = 0.0_dp
11115 kac(1:1*mc_max) = 0.0_dp
11116 p_index = 0
11117 DO md = 1, md_max
11118 DO mc = 1, mc_max
11119 DO mb = 1, 10
11120 ks_bd = 0.0_dp
11121 ks_bc = 0.0_dp
11122 p_bd = pbd((md - 1)*10 + mb)
11123 p_bc = pbc((mc - 1)*10 + mb)
11124 DO ma = 1, 1
11125 p_index = p_index + 1
11126 tmp = scale*prim(p_index)
11127 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
11128 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
11129 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
11130 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
11131 END DO
11132 kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
11133 kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
11134 END DO
11135 END DO
11136 END DO
11137 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 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 kbd(1:11*1) = 0.0_dp
11161 kbc(1:11*1) = 0.0_dp
11162 kad(1:1*1) = 0.0_dp
11163 kac(1:1*1) = 0.0_dp
11164 p_index = 0
11165 DO md = 1, 1
11166 DO mc = 1, 1
11167 DO mb = 1, 11
11168 ks_bd = 0.0_dp
11169 ks_bc = 0.0_dp
11170 p_bd = pbd((md - 1)*11 + mb)
11171 p_bc = pbc((mc - 1)*11 + mb)
11172 DO ma = 1, 1
11173 p_index = p_index + 1
11174 tmp = scale*prim(p_index)
11175 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
11176 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
11177 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
11178 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
11179 END DO
11180 kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
11181 kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
11182 END DO
11183 END DO
11184 END DO
11185 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 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 kbd(1:11*md_max) = 0.0_dp
11209 kbc(1:11*1) = 0.0_dp
11210 kad(1:1*md_max) = 0.0_dp
11211 kac(1:1*1) = 0.0_dp
11212 p_index = 0
11213 DO md = 1, md_max
11214 DO mc = 1, 1
11215 DO mb = 1, 11
11216 ks_bd = 0.0_dp
11217 ks_bc = 0.0_dp
11218 p_bd = pbd((md - 1)*11 + mb)
11219 p_bc = pbc((mc - 1)*11 + mb)
11220 DO ma = 1, 1
11221 p_index = p_index + 1
11222 tmp = scale*prim(p_index)
11223 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
11224 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
11225 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
11226 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
11227 END DO
11228 kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
11229 kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
11230 END DO
11231 END DO
11232 END DO
11233 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 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 kbd(1:11*md_max) = 0.0_dp
11259 kbc(1:11*mc_max) = 0.0_dp
11260 kad(1:1*md_max) = 0.0_dp
11261 kac(1:1*mc_max) = 0.0_dp
11262 p_index = 0
11263 DO md = 1, md_max
11264 DO mc = 1, mc_max
11265 DO mb = 1, 11
11266 ks_bd = 0.0_dp
11267 ks_bc = 0.0_dp
11268 p_bd = pbd((md - 1)*11 + mb)
11269 p_bc = pbc((mc - 1)*11 + mb)
11270 DO ma = 1, 1
11271 p_index = p_index + 1
11272 tmp = scale*prim(p_index)
11273 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
11274 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
11275 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
11276 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
11277 END DO
11278 kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
11279 kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
11280 END DO
11281 END DO
11282 END DO
11283 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 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 kbd(1:15*1) = 0.0_dp
11307 kbc(1:15*1) = 0.0_dp
11308 kad(1:1*1) = 0.0_dp
11309 kac(1:1*1) = 0.0_dp
11310 p_index = 0
11311 DO md = 1, 1
11312 DO mc = 1, 1
11313 DO mb = 1, 15
11314 ks_bd = 0.0_dp
11315 ks_bc = 0.0_dp
11316 p_bd = pbd((md - 1)*15 + mb)
11317 p_bc = pbc((mc - 1)*15 + mb)
11318 DO ma = 1, 1
11319 p_index = p_index + 1
11320 tmp = scale*prim(p_index)
11321 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
11322 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
11323 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
11324 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
11325 END DO
11326 kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
11327 kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
11328 END DO
11329 END DO
11330 END DO
11331 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 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 kbd(1:15*md_max) = 0.0_dp
11355 kbc(1:15*1) = 0.0_dp
11356 kad(1:1*md_max) = 0.0_dp
11357 kac(1:1*1) = 0.0_dp
11358 p_index = 0
11359 DO md = 1, md_max
11360 DO mc = 1, 1
11361 DO mb = 1, 15
11362 ks_bd = 0.0_dp
11363 ks_bc = 0.0_dp
11364 p_bd = pbd((md - 1)*15 + mb)
11365 p_bc = pbc((mc - 1)*15 + mb)
11366 DO ma = 1, 1
11367 p_index = p_index + 1
11368 tmp = scale*prim(p_index)
11369 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
11370 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
11371 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
11372 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
11373 END DO
11374 kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
11375 kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
11376 END DO
11377 END DO
11378 END DO
11379 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 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 kbd(1:15*md_max) = 0.0_dp
11405 kbc(1:15*mc_max) = 0.0_dp
11406 kad(1:1*md_max) = 0.0_dp
11407 kac(1:1*mc_max) = 0.0_dp
11408 p_index = 0
11409 DO md = 1, md_max
11410 DO mc = 1, mc_max
11411 DO mb = 1, 15
11412 ks_bd = 0.0_dp
11413 ks_bc = 0.0_dp
11414 p_bd = pbd((md - 1)*15 + mb)
11415 p_bc = pbc((mc - 1)*15 + mb)
11416 DO ma = 1, 1
11417 p_index = p_index + 1
11418 tmp = scale*prim(p_index)
11419 ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma)
11420 ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma)
11421 kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc
11422 kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd
11423 END DO
11424 kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
11425 kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
11426 END DO
11427 END DO
11428 END DO
11429 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 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 kbd(1:1*1) = 0.0_dp
11452 kbc(1:1*1) = 0.0_dp
11453 kad(1:2*1) = 0.0_dp
11454 kac(1:2*1) = 0.0_dp
11455 p_index = 0
11456 DO md = 1, 1
11457 DO mc = 1, 1
11458 DO mb = 1, 1
11459 ks_bd = 0.0_dp
11460 ks_bc = 0.0_dp
11461 p_bd = pbd((md - 1)*1 + mb)
11462 p_bc = pbc((mc - 1)*1 + mb)
11463 DO ma = 1, 2
11464 p_index = p_index + 1
11465 tmp = scale*prim(p_index)
11466 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11467 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11468 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11469 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11470 END DO
11471 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11472 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11473 END DO
11474 END DO
11475 END DO
11476 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 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 kbd(1:1*2) = 0.0_dp
11499 kbc(1:1*1) = 0.0_dp
11500 kad(1:2*2) = 0.0_dp
11501 kac(1:2*1) = 0.0_dp
11502 p_index = 0
11503 DO md = 1, 2
11504 DO mc = 1, 1
11505 DO mb = 1, 1
11506 ks_bd = 0.0_dp
11507 ks_bc = 0.0_dp
11508 p_bd = pbd((md - 1)*1 + mb)
11509 p_bc = pbc((mc - 1)*1 + mb)
11510 DO ma = 1, 2
11511 p_index = p_index + 1
11512 tmp = scale*prim(p_index)
11513 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11514 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11515 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11516 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11517 END DO
11518 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11519 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11520 END DO
11521 END DO
11522 END DO
11523 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 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 kbd(1:1*3) = 0.0_dp
11546 kbc(1:1*1) = 0.0_dp
11547 kad(1:2*3) = 0.0_dp
11548 kac(1:2*1) = 0.0_dp
11549 p_index = 0
11550 DO md = 1, 3
11551 DO mc = 1, 1
11552 DO mb = 1, 1
11553 ks_bd = 0.0_dp
11554 ks_bc = 0.0_dp
11555 p_bd = pbd((md - 1)*1 + mb)
11556 p_bc = pbc((mc - 1)*1 + mb)
11557 DO ma = 1, 2
11558 p_index = p_index + 1
11559 tmp = scale*prim(p_index)
11560 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11561 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11562 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11563 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11564 END DO
11565 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11566 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11567 END DO
11568 END DO
11569 END DO
11570 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 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 kbd(1:1*4) = 0.0_dp
11593 kbc(1:1*1) = 0.0_dp
11594 kad(1:2*4) = 0.0_dp
11595 kac(1:2*1) = 0.0_dp
11596 p_index = 0
11597 DO md = 1, 4
11598 DO mc = 1, 1
11599 DO mb = 1, 1
11600 ks_bd = 0.0_dp
11601 ks_bc = 0.0_dp
11602 p_bd = pbd((md - 1)*1 + mb)
11603 p_bc = pbc((mc - 1)*1 + mb)
11604 DO ma = 1, 2
11605 p_index = p_index + 1
11606 tmp = scale*prim(p_index)
11607 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11608 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11609 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11610 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11611 END DO
11612 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11613 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11614 END DO
11615 END DO
11616 END DO
11617 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 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 kbd(1:1*5) = 0.0_dp
11640 kbc(1:1*1) = 0.0_dp
11641 kad(1:2*5) = 0.0_dp
11642 kac(1:2*1) = 0.0_dp
11643 p_index = 0
11644 DO md = 1, 5
11645 DO mc = 1, 1
11646 DO mb = 1, 1
11647 ks_bd = 0.0_dp
11648 ks_bc = 0.0_dp
11649 p_bd = pbd((md - 1)*1 + mb)
11650 p_bc = pbc((mc - 1)*1 + mb)
11651 DO ma = 1, 2
11652 p_index = p_index + 1
11653 tmp = scale*prim(p_index)
11654 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11655 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11656 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11657 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11658 END DO
11659 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11660 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11661 END DO
11662 END DO
11663 END DO
11664 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 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 kbd(1:1*6) = 0.0_dp
11687 kbc(1:1*1) = 0.0_dp
11688 kad(1:2*6) = 0.0_dp
11689 kac(1:2*1) = 0.0_dp
11690 p_index = 0
11691 DO md = 1, 6
11692 DO mc = 1, 1
11693 DO mb = 1, 1
11694 ks_bd = 0.0_dp
11695 ks_bc = 0.0_dp
11696 p_bd = pbd((md - 1)*1 + mb)
11697 p_bc = pbc((mc - 1)*1 + mb)
11698 DO ma = 1, 2
11699 p_index = p_index + 1
11700 tmp = scale*prim(p_index)
11701 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11702 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11703 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11704 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11705 END DO
11706 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11707 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11708 END DO
11709 END DO
11710 END DO
11711 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 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 kbd(1:1*7) = 0.0_dp
11734 kbc(1:1*1) = 0.0_dp
11735 kad(1:2*7) = 0.0_dp
11736 kac(1:2*1) = 0.0_dp
11737 p_index = 0
11738 DO md = 1, 7
11739 DO mc = 1, 1
11740 DO mb = 1, 1
11741 ks_bd = 0.0_dp
11742 ks_bc = 0.0_dp
11743 p_bd = pbd((md - 1)*1 + mb)
11744 p_bc = pbc((mc - 1)*1 + mb)
11745 DO ma = 1, 2
11746 p_index = p_index + 1
11747 tmp = scale*prim(p_index)
11748 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11749 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11750 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11751 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11752 END DO
11753 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11754 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11755 END DO
11756 END DO
11757 END DO
11758 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 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 kbd(1:1*9) = 0.0_dp
11781 kbc(1:1*1) = 0.0_dp
11782 kad(1:2*9) = 0.0_dp
11783 kac(1:2*1) = 0.0_dp
11784 p_index = 0
11785 DO md = 1, 9
11786 DO mc = 1, 1
11787 DO mb = 1, 1
11788 ks_bd = 0.0_dp
11789 ks_bc = 0.0_dp
11790 p_bd = pbd((md - 1)*1 + mb)
11791 p_bc = pbc((mc - 1)*1 + mb)
11792 DO ma = 1, 2
11793 p_index = p_index + 1
11794 tmp = scale*prim(p_index)
11795 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11796 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11797 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11798 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11799 END DO
11800 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11801 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11802 END DO
11803 END DO
11804 END DO
11805 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 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 kbd(1:1*md_max) = 0.0_dp
11829 kbc(1:1*1) = 0.0_dp
11830 kad(1:2*md_max) = 0.0_dp
11831 kac(1:2*1) = 0.0_dp
11832 p_index = 0
11833 DO md = 1, md_max
11834 DO mc = 1, 1
11835 DO mb = 1, 1
11836 ks_bd = 0.0_dp
11837 ks_bc = 0.0_dp
11838 p_bd = pbd((md - 1)*1 + mb)
11839 p_bc = pbc((mc - 1)*1 + mb)
11840 DO ma = 1, 2
11841 p_index = p_index + 1
11842 tmp = scale*prim(p_index)
11843 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11844 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11845 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11846 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11847 END DO
11848 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11849 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11850 END DO
11851 END DO
11852 END DO
11853 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 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 kbd(1:1*1) = 0.0_dp
11876 kbc(1:1*2) = 0.0_dp
11877 kad(1:2*1) = 0.0_dp
11878 kac(1:2*2) = 0.0_dp
11879 p_index = 0
11880 DO md = 1, 1
11881 DO mc = 1, 2
11882 DO mb = 1, 1
11883 ks_bd = 0.0_dp
11884 ks_bc = 0.0_dp
11885 p_bd = pbd((md - 1)*1 + mb)
11886 p_bc = pbc((mc - 1)*1 + mb)
11887 DO ma = 1, 2
11888 p_index = p_index + 1
11889 tmp = scale*prim(p_index)
11890 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11891 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11892 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11893 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11894 END DO
11895 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11896 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11897 END DO
11898 END DO
11899 END DO
11900 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 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 kbd(1:1*2) = 0.0_dp
11923 kbc(1:1*2) = 0.0_dp
11924 kad(1:2*2) = 0.0_dp
11925 kac(1:2*2) = 0.0_dp
11926 p_index = 0
11927 DO md = 1, 2
11928 DO mc = 1, 2
11929 DO mb = 1, 1
11930 ks_bd = 0.0_dp
11931 ks_bc = 0.0_dp
11932 p_bd = pbd((md - 1)*1 + mb)
11933 p_bc = pbc((mc - 1)*1 + mb)
11934 DO ma = 1, 2
11935 p_index = p_index + 1
11936 tmp = scale*prim(p_index)
11937 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11938 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11939 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11940 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11941 END DO
11942 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11943 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11944 END DO
11945 END DO
11946 END DO
11947 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 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 kbd(1:1*3) = 0.0_dp
11970 kbc(1:1*2) = 0.0_dp
11971 kad(1:2*3) = 0.0_dp
11972 kac(1:2*2) = 0.0_dp
11973 p_index = 0
11974 DO md = 1, 3
11975 DO mc = 1, 2
11976 DO mb = 1, 1
11977 ks_bd = 0.0_dp
11978 ks_bc = 0.0_dp
11979 p_bd = pbd((md - 1)*1 + mb)
11980 p_bc = pbc((mc - 1)*1 + mb)
11981 DO ma = 1, 2
11982 p_index = p_index + 1
11983 tmp = scale*prim(p_index)
11984 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
11985 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
11986 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
11987 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
11988 END DO
11989 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
11990 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
11991 END DO
11992 END DO
11993 END DO
11994 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 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 kbd(1:1*4) = 0.0_dp
12017 kbc(1:1*2) = 0.0_dp
12018 kad(1:2*4) = 0.0_dp
12019 kac(1:2*2) = 0.0_dp
12020 p_index = 0
12021 DO md = 1, 4
12022 DO mc = 1, 2
12023 DO mb = 1, 1
12024 ks_bd = 0.0_dp
12025 ks_bc = 0.0_dp
12026 p_bd = pbd((md - 1)*1 + mb)
12027 p_bc = pbc((mc - 1)*1 + mb)
12028 DO ma = 1, 2
12029 p_index = p_index + 1
12030 tmp = scale*prim(p_index)
12031 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12032 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12033 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12034 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12035 END DO
12036 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12037 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12038 END DO
12039 END DO
12040 END DO
12041 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 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 kbd(1:1*md_max) = 0.0_dp
12065 kbc(1:1*2) = 0.0_dp
12066 kad(1:2*md_max) = 0.0_dp
12067 kac(1:2*2) = 0.0_dp
12068 p_index = 0
12069 DO md = 1, md_max
12070 DO mc = 1, 2
12071 DO mb = 1, 1
12072 ks_bd = 0.0_dp
12073 ks_bc = 0.0_dp
12074 p_bd = pbd((md - 1)*1 + mb)
12075 p_bc = pbc((mc - 1)*1 + mb)
12076 DO ma = 1, 2
12077 p_index = p_index + 1
12078 tmp = scale*prim(p_index)
12079 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12080 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12081 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12082 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12083 END DO
12084 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12085 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12086 END DO
12087 END DO
12088 END DO
12089 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 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 kbd(1:1*1) = 0.0_dp
12112 kbc(1:1*3) = 0.0_dp
12113 kad(1:2*1) = 0.0_dp
12114 kac(1:2*3) = 0.0_dp
12115 p_index = 0
12116 DO md = 1, 1
12117 DO mc = 1, 3
12118 DO mb = 1, 1
12119 ks_bd = 0.0_dp
12120 ks_bc = 0.0_dp
12121 p_bd = pbd((md - 1)*1 + mb)
12122 p_bc = pbc((mc - 1)*1 + mb)
12123 DO ma = 1, 2
12124 p_index = p_index + 1
12125 tmp = scale*prim(p_index)
12126 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12127 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12128 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12129 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12130 END DO
12131 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12132 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12133 END DO
12134 END DO
12135 END DO
12136 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 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 kbd(1:1*2) = 0.0_dp
12159 kbc(1:1*3) = 0.0_dp
12160 kad(1:2*2) = 0.0_dp
12161 kac(1:2*3) = 0.0_dp
12162 p_index = 0
12163 DO md = 1, 2
12164 DO mc = 1, 3
12165 DO mb = 1, 1
12166 ks_bd = 0.0_dp
12167 ks_bc = 0.0_dp
12168 p_bd = pbd((md - 1)*1 + mb)
12169 p_bc = pbc((mc - 1)*1 + mb)
12170 DO ma = 1, 2
12171 p_index = p_index + 1
12172 tmp = scale*prim(p_index)
12173 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12174 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12175 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12176 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12177 END DO
12178 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12179 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12180 END DO
12181 END DO
12182 END DO
12183 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 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 kbd(1:1*3) = 0.0_dp
12206 kbc(1:1*3) = 0.0_dp
12207 kad(1:2*3) = 0.0_dp
12208 kac(1:2*3) = 0.0_dp
12209 p_index = 0
12210 DO md = 1, 3
12211 DO mc = 1, 3
12212 DO mb = 1, 1
12213 ks_bd = 0.0_dp
12214 ks_bc = 0.0_dp
12215 p_bd = pbd((md - 1)*1 + mb)
12216 p_bc = pbc((mc - 1)*1 + mb)
12217 DO ma = 1, 2
12218 p_index = p_index + 1
12219 tmp = scale*prim(p_index)
12220 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12221 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12222 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12223 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12224 END DO
12225 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12226 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12227 END DO
12228 END DO
12229 END DO
12230 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 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 kbd(1:1*md_max) = 0.0_dp
12254 kbc(1:1*3) = 0.0_dp
12255 kad(1:2*md_max) = 0.0_dp
12256 kac(1:2*3) = 0.0_dp
12257 p_index = 0
12258 DO md = 1, md_max
12259 DO mc = 1, 3
12260 DO mb = 1, 1
12261 ks_bd = 0.0_dp
12262 ks_bc = 0.0_dp
12263 p_bd = pbd((md - 1)*1 + mb)
12264 p_bc = pbc((mc - 1)*1 + mb)
12265 DO ma = 1, 2
12266 p_index = p_index + 1
12267 tmp = scale*prim(p_index)
12268 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12269 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12270 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12271 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12272 END DO
12273 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12274 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12275 END DO
12276 END DO
12277 END DO
12278 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 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 kbd(1:1*1) = 0.0_dp
12301 kbc(1:1*4) = 0.0_dp
12302 kad(1:2*1) = 0.0_dp
12303 kac(1:2*4) = 0.0_dp
12304 p_index = 0
12305 DO md = 1, 1
12306 DO mc = 1, 4
12307 DO mb = 1, 1
12308 ks_bd = 0.0_dp
12309 ks_bc = 0.0_dp
12310 p_bd = pbd((md - 1)*1 + mb)
12311 p_bc = pbc((mc - 1)*1 + mb)
12312 DO ma = 1, 2
12313 p_index = p_index + 1
12314 tmp = scale*prim(p_index)
12315 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12316 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12317 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12318 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12319 END DO
12320 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12321 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12322 END DO
12323 END DO
12324 END DO
12325 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 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 kbd(1:1*2) = 0.0_dp
12348 kbc(1:1*4) = 0.0_dp
12349 kad(1:2*2) = 0.0_dp
12350 kac(1:2*4) = 0.0_dp
12351 p_index = 0
12352 DO md = 1, 2
12353 DO mc = 1, 4
12354 DO mb = 1, 1
12355 ks_bd = 0.0_dp
12356 ks_bc = 0.0_dp
12357 p_bd = pbd((md - 1)*1 + mb)
12358 p_bc = pbc((mc - 1)*1 + mb)
12359 DO ma = 1, 2
12360 p_index = p_index + 1
12361 tmp = scale*prim(p_index)
12362 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12363 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12364 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12365 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12366 END DO
12367 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12368 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12369 END DO
12370 END DO
12371 END DO
12372 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 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 kbd(1:1*md_max) = 0.0_dp
12396 kbc(1:1*4) = 0.0_dp
12397 kad(1:2*md_max) = 0.0_dp
12398 kac(1:2*4) = 0.0_dp
12399 p_index = 0
12400 DO md = 1, md_max
12401 DO mc = 1, 4
12402 DO mb = 1, 1
12403 ks_bd = 0.0_dp
12404 ks_bc = 0.0_dp
12405 p_bd = pbd((md - 1)*1 + mb)
12406 p_bc = pbc((mc - 1)*1 + mb)
12407 DO ma = 1, 2
12408 p_index = p_index + 1
12409 tmp = scale*prim(p_index)
12410 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12411 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12412 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12413 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12414 END DO
12415 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12416 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12417 END DO
12418 END DO
12419 END DO
12420 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 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 kbd(1:1*1) = 0.0_dp
12443 kbc(1:1*5) = 0.0_dp
12444 kad(1:2*1) = 0.0_dp
12445 kac(1:2*5) = 0.0_dp
12446 p_index = 0
12447 DO md = 1, 1
12448 DO mc = 1, 5
12449 DO mb = 1, 1
12450 ks_bd = 0.0_dp
12451 ks_bc = 0.0_dp
12452 p_bd = pbd((md - 1)*1 + mb)
12453 p_bc = pbc((mc - 1)*1 + mb)
12454 DO ma = 1, 2
12455 p_index = p_index + 1
12456 tmp = scale*prim(p_index)
12457 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12458 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12459 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12460 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12461 END DO
12462 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12463 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12464 END DO
12465 END DO
12466 END DO
12467 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 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 kbd(1:1*md_max) = 0.0_dp
12491 kbc(1:1*5) = 0.0_dp
12492 kad(1:2*md_max) = 0.0_dp
12493 kac(1:2*5) = 0.0_dp
12494 p_index = 0
12495 DO md = 1, md_max
12496 DO mc = 1, 5
12497 DO mb = 1, 1
12498 ks_bd = 0.0_dp
12499 ks_bc = 0.0_dp
12500 p_bd = pbd((md - 1)*1 + mb)
12501 p_bc = pbc((mc - 1)*1 + mb)
12502 DO ma = 1, 2
12503 p_index = p_index + 1
12504 tmp = scale*prim(p_index)
12505 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12506 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12507 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12508 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12509 END DO
12510 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12511 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12512 END DO
12513 END DO
12514 END DO
12515 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 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 kbd(1:1*1) = 0.0_dp
12538 kbc(1:1*6) = 0.0_dp
12539 kad(1:2*1) = 0.0_dp
12540 kac(1:2*6) = 0.0_dp
12541 p_index = 0
12542 DO md = 1, 1
12543 DO mc = 1, 6
12544 DO mb = 1, 1
12545 ks_bd = 0.0_dp
12546 ks_bc = 0.0_dp
12547 p_bd = pbd((md - 1)*1 + mb)
12548 p_bc = pbc((mc - 1)*1 + mb)
12549 DO ma = 1, 2
12550 p_index = p_index + 1
12551 tmp = scale*prim(p_index)
12552 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12553 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12554 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12555 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12556 END DO
12557 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12558 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12559 END DO
12560 END DO
12561 END DO
12562 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 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 kbd(1:1*md_max) = 0.0_dp
12586 kbc(1:1*6) = 0.0_dp
12587 kad(1:2*md_max) = 0.0_dp
12588 kac(1:2*6) = 0.0_dp
12589 p_index = 0
12590 DO md = 1, md_max
12591 DO mc = 1, 6
12592 DO mb = 1, 1
12593 ks_bd = 0.0_dp
12594 ks_bc = 0.0_dp
12595 p_bd = pbd((md - 1)*1 + mb)
12596 p_bc = pbc((mc - 1)*1 + mb)
12597 DO ma = 1, 2
12598 p_index = p_index + 1
12599 tmp = scale*prim(p_index)
12600 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12601 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12602 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12603 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12604 END DO
12605 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12606 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12607 END DO
12608 END DO
12609 END DO
12610 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 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 kbd(1:1*1) = 0.0_dp
12633 kbc(1:1*7) = 0.0_dp
12634 kad(1:2*1) = 0.0_dp
12635 kac(1:2*7) = 0.0_dp
12636 p_index = 0
12637 DO md = 1, 1
12638 DO mc = 1, 7
12639 DO mb = 1, 1
12640 ks_bd = 0.0_dp
12641 ks_bc = 0.0_dp
12642 p_bd = pbd((md - 1)*1 + mb)
12643 p_bc = pbc((mc - 1)*1 + mb)
12644 DO ma = 1, 2
12645 p_index = p_index + 1
12646 tmp = scale*prim(p_index)
12647 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12648 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12649 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12650 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12651 END DO
12652 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12653 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12654 END DO
12655 END DO
12656 END DO
12657 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 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 kbd(1:1*md_max) = 0.0_dp
12681 kbc(1:1*7) = 0.0_dp
12682 kad(1:2*md_max) = 0.0_dp
12683 kac(1:2*7) = 0.0_dp
12684 p_index = 0
12685 DO md = 1, md_max
12686 DO mc = 1, 7
12687 DO mb = 1, 1
12688 ks_bd = 0.0_dp
12689 ks_bc = 0.0_dp
12690 p_bd = pbd((md - 1)*1 + mb)
12691 p_bc = pbc((mc - 1)*1 + mb)
12692 DO ma = 1, 2
12693 p_index = p_index + 1
12694 tmp = scale*prim(p_index)
12695 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12696 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12697 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12698 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12699 END DO
12700 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12701 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12702 END DO
12703 END DO
12704 END DO
12705 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 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 kbd(1:1*1) = 0.0_dp
12728 kbc(1:1*9) = 0.0_dp
12729 kad(1:2*1) = 0.0_dp
12730 kac(1:2*9) = 0.0_dp
12731 p_index = 0
12732 DO md = 1, 1
12733 DO mc = 1, 9
12734 DO mb = 1, 1
12735 ks_bd = 0.0_dp
12736 ks_bc = 0.0_dp
12737 p_bd = pbd((md - 1)*1 + mb)
12738 p_bc = pbc((mc - 1)*1 + mb)
12739 DO ma = 1, 2
12740 p_index = p_index + 1
12741 tmp = scale*prim(p_index)
12742 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12743 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12744 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12745 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12746 END DO
12747 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12748 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12749 END DO
12750 END DO
12751 END DO
12752 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 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 kbd(1:1*md_max) = 0.0_dp
12776 kbc(1:1*9) = 0.0_dp
12777 kad(1:2*md_max) = 0.0_dp
12778 kac(1:2*9) = 0.0_dp
12779 p_index = 0
12780 DO md = 1, md_max
12781 DO mc = 1, 9
12782 DO mb = 1, 1
12783 ks_bd = 0.0_dp
12784 ks_bc = 0.0_dp
12785 p_bd = pbd((md - 1)*1 + mb)
12786 p_bc = pbc((mc - 1)*1 + mb)
12787 DO ma = 1, 2
12788 p_index = p_index + 1
12789 tmp = scale*prim(p_index)
12790 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12791 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12792 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12793 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12794 END DO
12795 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12796 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12797 END DO
12798 END DO
12799 END DO
12800 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 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 kbd(1:1*md_max) = 0.0_dp
12825 kbc(1:1*mc_max) = 0.0_dp
12826 kad(1:2*md_max) = 0.0_dp
12827 kac(1:2*mc_max) = 0.0_dp
12828 p_index = 0
12829 DO md = 1, md_max
12830 DO mc = 1, mc_max
12831 DO mb = 1, 1
12832 ks_bd = 0.0_dp
12833 ks_bc = 0.0_dp
12834 p_bd = pbd((md - 1)*1 + mb)
12835 p_bc = pbc((mc - 1)*1 + mb)
12836 DO ma = 1, 2
12837 p_index = p_index + 1
12838 tmp = scale*prim(p_index)
12839 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12840 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12841 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12842 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12843 END DO
12844 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
12845 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
12846 END DO
12847 END DO
12848 END DO
12849 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 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 kbd(1:2*1) = 0.0_dp
12872 kbc(1:2*1) = 0.0_dp
12873 kad(1:2*1) = 0.0_dp
12874 kac(1:2*1) = 0.0_dp
12875 p_index = 0
12876 DO md = 1, 1
12877 DO mc = 1, 1
12878 DO mb = 1, 2
12879 ks_bd = 0.0_dp
12880 ks_bc = 0.0_dp
12881 p_bd = pbd((md - 1)*2 + mb)
12882 p_bc = pbc((mc - 1)*2 + mb)
12883 DO ma = 1, 2
12884 p_index = p_index + 1
12885 tmp = scale*prim(p_index)
12886 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12887 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12888 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12889 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12890 END DO
12891 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
12892 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
12893 END DO
12894 END DO
12895 END DO
12896 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 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 kbd(1:2*2) = 0.0_dp
12919 kbc(1:2*1) = 0.0_dp
12920 kad(1:2*2) = 0.0_dp
12921 kac(1:2*1) = 0.0_dp
12922 p_index = 0
12923 DO md = 1, 2
12924 DO mc = 1, 1
12925 DO mb = 1, 2
12926 ks_bd = 0.0_dp
12927 ks_bc = 0.0_dp
12928 p_bd = pbd((md - 1)*2 + mb)
12929 p_bc = pbc((mc - 1)*2 + mb)
12930 DO ma = 1, 2
12931 p_index = p_index + 1
12932 tmp = scale*prim(p_index)
12933 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12934 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12935 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12936 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12937 END DO
12938 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
12939 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
12940 END DO
12941 END DO
12942 END DO
12943 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 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 kbd(1:2*3) = 0.0_dp
12966 kbc(1:2*1) = 0.0_dp
12967 kad(1:2*3) = 0.0_dp
12968 kac(1:2*1) = 0.0_dp
12969 p_index = 0
12970 DO md = 1, 3
12971 DO mc = 1, 1
12972 DO mb = 1, 2
12973 ks_bd = 0.0_dp
12974 ks_bc = 0.0_dp
12975 p_bd = pbd((md - 1)*2 + mb)
12976 p_bc = pbc((mc - 1)*2 + mb)
12977 DO ma = 1, 2
12978 p_index = p_index + 1
12979 tmp = scale*prim(p_index)
12980 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
12981 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
12982 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
12983 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
12984 END DO
12985 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
12986 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
12987 END DO
12988 END DO
12989 END DO
12990 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 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 kbd(1:2*4) = 0.0_dp
13013 kbc(1:2*1) = 0.0_dp
13014 kad(1:2*4) = 0.0_dp
13015 kac(1:2*1) = 0.0_dp
13016 p_index = 0
13017 DO md = 1, 4
13018 DO mc = 1, 1
13019 DO mb = 1, 2
13020 ks_bd = 0.0_dp
13021 ks_bc = 0.0_dp
13022 p_bd = pbd((md - 1)*2 + mb)
13023 p_bc = pbc((mc - 1)*2 + mb)
13024 DO ma = 1, 2
13025 p_index = p_index + 1
13026 tmp = scale*prim(p_index)
13027 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13028 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13029 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13030 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13031 END DO
13032 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13033 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13034 END DO
13035 END DO
13036 END DO
13037 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 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 kbd(1:2*md_max) = 0.0_dp
13061 kbc(1:2*1) = 0.0_dp
13062 kad(1:2*md_max) = 0.0_dp
13063 kac(1:2*1) = 0.0_dp
13064 p_index = 0
13065 DO md = 1, md_max
13066 DO mc = 1, 1
13067 DO mb = 1, 2
13068 ks_bd = 0.0_dp
13069 ks_bc = 0.0_dp
13070 p_bd = pbd((md - 1)*2 + mb)
13071 p_bc = pbc((mc - 1)*2 + mb)
13072 DO ma = 1, 2
13073 p_index = p_index + 1
13074 tmp = scale*prim(p_index)
13075 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13076 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13077 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13078 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13079 END DO
13080 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13081 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13082 END DO
13083 END DO
13084 END DO
13085 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 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 kbd(1:2*1) = 0.0_dp
13108 kbc(1:2*2) = 0.0_dp
13109 kad(1:2*1) = 0.0_dp
13110 kac(1:2*2) = 0.0_dp
13111 p_index = 0
13112 DO md = 1, 1
13113 DO mc = 1, 2
13114 DO mb = 1, 2
13115 ks_bd = 0.0_dp
13116 ks_bc = 0.0_dp
13117 p_bd = pbd((md - 1)*2 + mb)
13118 p_bc = pbc((mc - 1)*2 + mb)
13119 DO ma = 1, 2
13120 p_index = p_index + 1
13121 tmp = scale*prim(p_index)
13122 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13123 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13124 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13125 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13126 END DO
13127 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13128 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13129 END DO
13130 END DO
13131 END DO
13132 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 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 kbd(1:2*2) = 0.0_dp
13155 kbc(1:2*2) = 0.0_dp
13156 kad(1:2*2) = 0.0_dp
13157 kac(1:2*2) = 0.0_dp
13158 p_index = 0
13159 DO md = 1, 2
13160 DO mc = 1, 2
13161 DO mb = 1, 2
13162 ks_bd = 0.0_dp
13163 ks_bc = 0.0_dp
13164 p_bd = pbd((md - 1)*2 + mb)
13165 p_bc = pbc((mc - 1)*2 + mb)
13166 DO ma = 1, 2
13167 p_index = p_index + 1
13168 tmp = scale*prim(p_index)
13169 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13170 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13171 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13172 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13173 END DO
13174 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13175 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13176 END DO
13177 END DO
13178 END DO
13179 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 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 kbd(1:2*md_max) = 0.0_dp
13203 kbc(1:2*2) = 0.0_dp
13204 kad(1:2*md_max) = 0.0_dp
13205 kac(1:2*2) = 0.0_dp
13206 p_index = 0
13207 DO md = 1, md_max
13208 DO mc = 1, 2
13209 DO mb = 1, 2
13210 ks_bd = 0.0_dp
13211 ks_bc = 0.0_dp
13212 p_bd = pbd((md - 1)*2 + mb)
13213 p_bc = pbc((mc - 1)*2 + mb)
13214 DO ma = 1, 2
13215 p_index = p_index + 1
13216 tmp = scale*prim(p_index)
13217 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13218 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13219 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13220 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13221 END DO
13222 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13223 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13224 END DO
13225 END DO
13226 END DO
13227 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 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 kbd(1:2*1) = 0.0_dp
13250 kbc(1:2*3) = 0.0_dp
13251 kad(1:2*1) = 0.0_dp
13252 kac(1:2*3) = 0.0_dp
13253 p_index = 0
13254 DO md = 1, 1
13255 DO mc = 1, 3
13256 DO mb = 1, 2
13257 ks_bd = 0.0_dp
13258 ks_bc = 0.0_dp
13259 p_bd = pbd((md - 1)*2 + mb)
13260 p_bc = pbc((mc - 1)*2 + mb)
13261 DO ma = 1, 2
13262 p_index = p_index + 1
13263 tmp = scale*prim(p_index)
13264 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13265 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13266 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13267 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13268 END DO
13269 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13270 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13271 END DO
13272 END DO
13273 END DO
13274 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 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 kbd(1:2*md_max) = 0.0_dp
13298 kbc(1:2*3) = 0.0_dp
13299 kad(1:2*md_max) = 0.0_dp
13300 kac(1:2*3) = 0.0_dp
13301 p_index = 0
13302 DO md = 1, md_max
13303 DO mc = 1, 3
13304 DO mb = 1, 2
13305 ks_bd = 0.0_dp
13306 ks_bc = 0.0_dp
13307 p_bd = pbd((md - 1)*2 + mb)
13308 p_bc = pbc((mc - 1)*2 + mb)
13309 DO ma = 1, 2
13310 p_index = p_index + 1
13311 tmp = scale*prim(p_index)
13312 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13313 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13314 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13315 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13316 END DO
13317 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13318 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13319 END DO
13320 END DO
13321 END DO
13322 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 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 kbd(1:2*1) = 0.0_dp
13345 kbc(1:2*4) = 0.0_dp
13346 kad(1:2*1) = 0.0_dp
13347 kac(1:2*4) = 0.0_dp
13348 p_index = 0
13349 DO md = 1, 1
13350 DO mc = 1, 4
13351 DO mb = 1, 2
13352 ks_bd = 0.0_dp
13353 ks_bc = 0.0_dp
13354 p_bd = pbd((md - 1)*2 + mb)
13355 p_bc = pbc((mc - 1)*2 + mb)
13356 DO ma = 1, 2
13357 p_index = p_index + 1
13358 tmp = scale*prim(p_index)
13359 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13360 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13361 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13362 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13363 END DO
13364 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13365 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13366 END DO
13367 END DO
13368 END DO
13369 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 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 kbd(1:2*md_max) = 0.0_dp
13393 kbc(1:2*4) = 0.0_dp
13394 kad(1:2*md_max) = 0.0_dp
13395 kac(1:2*4) = 0.0_dp
13396 p_index = 0
13397 DO md = 1, md_max
13398 DO mc = 1, 4
13399 DO mb = 1, 2
13400 ks_bd = 0.0_dp
13401 ks_bc = 0.0_dp
13402 p_bd = pbd((md - 1)*2 + mb)
13403 p_bc = pbc((mc - 1)*2 + mb)
13404 DO ma = 1, 2
13405 p_index = p_index + 1
13406 tmp = scale*prim(p_index)
13407 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13408 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13409 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13410 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13411 END DO
13412 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13413 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13414 END DO
13415 END DO
13416 END DO
13417 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 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 kbd(1:2*md_max) = 0.0_dp
13442 kbc(1:2*mc_max) = 0.0_dp
13443 kad(1:2*md_max) = 0.0_dp
13444 kac(1:2*mc_max) = 0.0_dp
13445 p_index = 0
13446 DO md = 1, md_max
13447 DO mc = 1, mc_max
13448 DO mb = 1, 2
13449 ks_bd = 0.0_dp
13450 ks_bc = 0.0_dp
13451 p_bd = pbd((md - 1)*2 + mb)
13452 p_bc = pbc((mc - 1)*2 + mb)
13453 DO ma = 1, 2
13454 p_index = p_index + 1
13455 tmp = scale*prim(p_index)
13456 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13457 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13458 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13459 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13460 END DO
13461 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
13462 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
13463 END DO
13464 END DO
13465 END DO
13466 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 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 kbd(1:3*1) = 0.0_dp
13489 kbc(1:3*1) = 0.0_dp
13490 kad(1:2*1) = 0.0_dp
13491 kac(1:2*1) = 0.0_dp
13492 p_index = 0
13493 DO md = 1, 1
13494 DO mc = 1, 1
13495 DO mb = 1, 3
13496 ks_bd = 0.0_dp
13497 ks_bc = 0.0_dp
13498 p_bd = pbd((md - 1)*3 + mb)
13499 p_bc = pbc((mc - 1)*3 + mb)
13500 DO ma = 1, 2
13501 p_index = p_index + 1
13502 tmp = scale*prim(p_index)
13503 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13504 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13505 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13506 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13507 END DO
13508 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
13509 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
13510 END DO
13511 END DO
13512 END DO
13513 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 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 kbd(1:3*2) = 0.0_dp
13536 kbc(1:3*1) = 0.0_dp
13537 kad(1:2*2) = 0.0_dp
13538 kac(1:2*1) = 0.0_dp
13539 p_index = 0
13540 DO md = 1, 2
13541 DO mc = 1, 1
13542 DO mb = 1, 3
13543 ks_bd = 0.0_dp
13544 ks_bc = 0.0_dp
13545 p_bd = pbd((md - 1)*3 + mb)
13546 p_bc = pbc((mc - 1)*3 + mb)
13547 DO ma = 1, 2
13548 p_index = p_index + 1
13549 tmp = scale*prim(p_index)
13550 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13551 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13552 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13553 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13554 END DO
13555 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
13556 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
13557 END DO
13558 END DO
13559 END DO
13560 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 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 kbd(1:3*3) = 0.0_dp
13583 kbc(1:3*1) = 0.0_dp
13584 kad(1:2*3) = 0.0_dp
13585 kac(1:2*1) = 0.0_dp
13586 p_index = 0
13587 DO md = 1, 3
13588 DO mc = 1, 1
13589 DO mb = 1, 3
13590 ks_bd = 0.0_dp
13591 ks_bc = 0.0_dp
13592 p_bd = pbd((md - 1)*3 + mb)
13593 p_bc = pbc((mc - 1)*3 + mb)
13594 DO ma = 1, 2
13595 p_index = p_index + 1
13596 tmp = scale*prim(p_index)
13597 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13598 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13599 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13600 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13601 END DO
13602 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
13603 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
13604 END DO
13605 END DO
13606 END DO
13607 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 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 kbd(1:3*md_max) = 0.0_dp
13631 kbc(1:3*1) = 0.0_dp
13632 kad(1:2*md_max) = 0.0_dp
13633 kac(1:2*1) = 0.0_dp
13634 p_index = 0
13635 DO md = 1, md_max
13636 DO mc = 1, 1
13637 DO mb = 1, 3
13638 ks_bd = 0.0_dp
13639 ks_bc = 0.0_dp
13640 p_bd = pbd((md - 1)*3 + mb)
13641 p_bc = pbc((mc - 1)*3 + mb)
13642 DO ma = 1, 2
13643 p_index = p_index + 1
13644 tmp = scale*prim(p_index)
13645 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13646 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13647 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13648 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13649 END DO
13650 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
13651 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
13652 END DO
13653 END DO
13654 END DO
13655 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 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 kbd(1:3*1) = 0.0_dp
13678 kbc(1:3*2) = 0.0_dp
13679 kad(1:2*1) = 0.0_dp
13680 kac(1:2*2) = 0.0_dp
13681 p_index = 0
13682 DO md = 1, 1
13683 DO mc = 1, 2
13684 DO mb = 1, 3
13685 ks_bd = 0.0_dp
13686 ks_bc = 0.0_dp
13687 p_bd = pbd((md - 1)*3 + mb)
13688 p_bc = pbc((mc - 1)*3 + mb)
13689 DO ma = 1, 2
13690 p_index = p_index + 1
13691 tmp = scale*prim(p_index)
13692 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13693 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13694 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13695 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13696 END DO
13697 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
13698 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
13699 END DO
13700 END DO
13701 END DO
13702 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 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 kbd(1:3*md_max) = 0.0_dp
13726 kbc(1:3*2) = 0.0_dp
13727 kad(1:2*md_max) = 0.0_dp
13728 kac(1:2*2) = 0.0_dp
13729 p_index = 0
13730 DO md = 1, md_max
13731 DO mc = 1, 2
13732 DO mb = 1, 3
13733 ks_bd = 0.0_dp
13734 ks_bc = 0.0_dp
13735 p_bd = pbd((md - 1)*3 + mb)
13736 p_bc = pbc((mc - 1)*3 + mb)
13737 DO ma = 1, 2
13738 p_index = p_index + 1
13739 tmp = scale*prim(p_index)
13740 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13741 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13742 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13743 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13744 END DO
13745 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
13746 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
13747 END DO
13748 END DO
13749 END DO
13750 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 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 kbd(1:3*1) = 0.0_dp
13773 kbc(1:3*3) = 0.0_dp
13774 kad(1:2*1) = 0.0_dp
13775 kac(1:2*3) = 0.0_dp
13776 p_index = 0
13777 DO md = 1, 1
13778 DO mc = 1, 3
13779 DO mb = 1, 3
13780 ks_bd = 0.0_dp
13781 ks_bc = 0.0_dp
13782 p_bd = pbd((md - 1)*3 + mb)
13783 p_bc = pbc((mc - 1)*3 + mb)
13784 DO ma = 1, 2
13785 p_index = p_index + 1
13786 tmp = scale*prim(p_index)
13787 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13788 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13789 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13790 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13791 END DO
13792 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
13793 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
13794 END DO
13795 END DO
13796 END DO
13797 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 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 kbd(1:3*md_max) = 0.0_dp
13821 kbc(1:3*3) = 0.0_dp
13822 kad(1:2*md_max) = 0.0_dp
13823 kac(1:2*3) = 0.0_dp
13824 p_index = 0
13825 DO md = 1, md_max
13826 DO mc = 1, 3
13827 DO mb = 1, 3
13828 ks_bd = 0.0_dp
13829 ks_bc = 0.0_dp
13830 p_bd = pbd((md - 1)*3 + mb)
13831 p_bc = pbc((mc - 1)*3 + mb)
13832 DO ma = 1, 2
13833 p_index = p_index + 1
13834 tmp = scale*prim(p_index)
13835 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13836 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13837 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13838 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13839 END DO
13840 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
13841 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
13842 END DO
13843 END DO
13844 END DO
13845 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 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 kbd(1:3*md_max) = 0.0_dp
13870 kbc(1:3*mc_max) = 0.0_dp
13871 kad(1:2*md_max) = 0.0_dp
13872 kac(1:2*mc_max) = 0.0_dp
13873 p_index = 0
13874 DO md = 1, md_max
13875 DO mc = 1, mc_max
13876 DO mb = 1, 3
13877 ks_bd = 0.0_dp
13878 ks_bc = 0.0_dp
13879 p_bd = pbd((md - 1)*3 + mb)
13880 p_bc = pbc((mc - 1)*3 + mb)
13881 DO ma = 1, 2
13882 p_index = p_index + 1
13883 tmp = scale*prim(p_index)
13884 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13885 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13886 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13887 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13888 END DO
13889 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
13890 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
13891 END DO
13892 END DO
13893 END DO
13894 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 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 kbd(1:4*1) = 0.0_dp
13917 kbc(1:4*1) = 0.0_dp
13918 kad(1:2*1) = 0.0_dp
13919 kac(1:2*1) = 0.0_dp
13920 p_index = 0
13921 DO md = 1, 1
13922 DO mc = 1, 1
13923 DO mb = 1, 4
13924 ks_bd = 0.0_dp
13925 ks_bc = 0.0_dp
13926 p_bd = pbd((md - 1)*4 + mb)
13927 p_bc = pbc((mc - 1)*4 + mb)
13928 DO ma = 1, 2
13929 p_index = p_index + 1
13930 tmp = scale*prim(p_index)
13931 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13932 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13933 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13934 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13935 END DO
13936 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
13937 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
13938 END DO
13939 END DO
13940 END DO
13941 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 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 kbd(1:4*2) = 0.0_dp
13964 kbc(1:4*1) = 0.0_dp
13965 kad(1:2*2) = 0.0_dp
13966 kac(1:2*1) = 0.0_dp
13967 p_index = 0
13968 DO md = 1, 2
13969 DO mc = 1, 1
13970 DO mb = 1, 4
13971 ks_bd = 0.0_dp
13972 ks_bc = 0.0_dp
13973 p_bd = pbd((md - 1)*4 + mb)
13974 p_bc = pbc((mc - 1)*4 + mb)
13975 DO ma = 1, 2
13976 p_index = p_index + 1
13977 tmp = scale*prim(p_index)
13978 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
13979 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
13980 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
13981 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
13982 END DO
13983 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
13984 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
13985 END DO
13986 END DO
13987 END DO
13988 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 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 kbd(1:4*md_max) = 0.0_dp
14012 kbc(1:4*1) = 0.0_dp
14013 kad(1:2*md_max) = 0.0_dp
14014 kac(1:2*1) = 0.0_dp
14015 p_index = 0
14016 DO md = 1, md_max
14017 DO mc = 1, 1
14018 DO mb = 1, 4
14019 ks_bd = 0.0_dp
14020 ks_bc = 0.0_dp
14021 p_bd = pbd((md - 1)*4 + mb)
14022 p_bc = pbc((mc - 1)*4 + mb)
14023 DO ma = 1, 2
14024 p_index = p_index + 1
14025 tmp = scale*prim(p_index)
14026 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14027 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14028 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14029 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14030 END DO
14031 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
14032 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
14033 END DO
14034 END DO
14035 END DO
14036 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 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 kbd(1:4*1) = 0.0_dp
14059 kbc(1:4*2) = 0.0_dp
14060 kad(1:2*1) = 0.0_dp
14061 kac(1:2*2) = 0.0_dp
14062 p_index = 0
14063 DO md = 1, 1
14064 DO mc = 1, 2
14065 DO mb = 1, 4
14066 ks_bd = 0.0_dp
14067 ks_bc = 0.0_dp
14068 p_bd = pbd((md - 1)*4 + mb)
14069 p_bc = pbc((mc - 1)*4 + mb)
14070 DO ma = 1, 2
14071 p_index = p_index + 1
14072 tmp = scale*prim(p_index)
14073 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14074 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14075 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14076 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14077 END DO
14078 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
14079 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
14080 END DO
14081 END DO
14082 END DO
14083 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 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 kbd(1:4*md_max) = 0.0_dp
14107 kbc(1:4*2) = 0.0_dp
14108 kad(1:2*md_max) = 0.0_dp
14109 kac(1:2*2) = 0.0_dp
14110 p_index = 0
14111 DO md = 1, md_max
14112 DO mc = 1, 2
14113 DO mb = 1, 4
14114 ks_bd = 0.0_dp
14115 ks_bc = 0.0_dp
14116 p_bd = pbd((md - 1)*4 + mb)
14117 p_bc = pbc((mc - 1)*4 + mb)
14118 DO ma = 1, 2
14119 p_index = p_index + 1
14120 tmp = scale*prim(p_index)
14121 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14122 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14123 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14124 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14125 END DO
14126 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
14127 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
14128 END DO
14129 END DO
14130 END DO
14131 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 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 kbd(1:4*md_max) = 0.0_dp
14156 kbc(1:4*mc_max) = 0.0_dp
14157 kad(1:2*md_max) = 0.0_dp
14158 kac(1:2*mc_max) = 0.0_dp
14159 p_index = 0
14160 DO md = 1, md_max
14161 DO mc = 1, mc_max
14162 DO mb = 1, 4
14163 ks_bd = 0.0_dp
14164 ks_bc = 0.0_dp
14165 p_bd = pbd((md - 1)*4 + mb)
14166 p_bc = pbc((mc - 1)*4 + mb)
14167 DO ma = 1, 2
14168 p_index = p_index + 1
14169 tmp = scale*prim(p_index)
14170 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14171 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14172 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14173 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14174 END DO
14175 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
14176 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
14177 END DO
14178 END DO
14179 END DO
14180 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 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 kbd(1:5*1) = 0.0_dp
14203 kbc(1:5*1) = 0.0_dp
14204 kad(1:2*1) = 0.0_dp
14205 kac(1:2*1) = 0.0_dp
14206 p_index = 0
14207 DO md = 1, 1
14208 DO mc = 1, 1
14209 DO mb = 1, 5
14210 ks_bd = 0.0_dp
14211 ks_bc = 0.0_dp
14212 p_bd = pbd((md - 1)*5 + mb)
14213 p_bc = pbc((mc - 1)*5 + mb)
14214 DO ma = 1, 2
14215 p_index = p_index + 1
14216 tmp = scale*prim(p_index)
14217 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14218 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14219 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14220 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14221 END DO
14222 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
14223 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
14224 END DO
14225 END DO
14226 END DO
14227 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 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 kbd(1:5*md_max) = 0.0_dp
14251 kbc(1:5*1) = 0.0_dp
14252 kad(1:2*md_max) = 0.0_dp
14253 kac(1:2*1) = 0.0_dp
14254 p_index = 0
14255 DO md = 1, md_max
14256 DO mc = 1, 1
14257 DO mb = 1, 5
14258 ks_bd = 0.0_dp
14259 ks_bc = 0.0_dp
14260 p_bd = pbd((md - 1)*5 + mb)
14261 p_bc = pbc((mc - 1)*5 + mb)
14262 DO ma = 1, 2
14263 p_index = p_index + 1
14264 tmp = scale*prim(p_index)
14265 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14266 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14267 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14268 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14269 END DO
14270 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
14271 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
14272 END DO
14273 END DO
14274 END DO
14275 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 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 kbd(1:5*md_max) = 0.0_dp
14300 kbc(1:5*mc_max) = 0.0_dp
14301 kad(1:2*md_max) = 0.0_dp
14302 kac(1:2*mc_max) = 0.0_dp
14303 p_index = 0
14304 DO md = 1, md_max
14305 DO mc = 1, mc_max
14306 DO mb = 1, 5
14307 ks_bd = 0.0_dp
14308 ks_bc = 0.0_dp
14309 p_bd = pbd((md - 1)*5 + mb)
14310 p_bc = pbc((mc - 1)*5 + mb)
14311 DO ma = 1, 2
14312 p_index = p_index + 1
14313 tmp = scale*prim(p_index)
14314 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14315 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14316 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14317 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14318 END DO
14319 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
14320 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
14321 END DO
14322 END DO
14323 END DO
14324 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 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 kbd(1:6*1) = 0.0_dp
14347 kbc(1:6*1) = 0.0_dp
14348 kad(1:2*1) = 0.0_dp
14349 kac(1:2*1) = 0.0_dp
14350 p_index = 0
14351 DO md = 1, 1
14352 DO mc = 1, 1
14353 DO mb = 1, 6
14354 ks_bd = 0.0_dp
14355 ks_bc = 0.0_dp
14356 p_bd = pbd((md - 1)*6 + mb)
14357 p_bc = pbc((mc - 1)*6 + mb)
14358 DO ma = 1, 2
14359 p_index = p_index + 1
14360 tmp = scale*prim(p_index)
14361 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14362 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14363 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14364 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14365 END DO
14366 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
14367 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
14368 END DO
14369 END DO
14370 END DO
14371 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 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 kbd(1:6*md_max) = 0.0_dp
14395 kbc(1:6*1) = 0.0_dp
14396 kad(1:2*md_max) = 0.0_dp
14397 kac(1:2*1) = 0.0_dp
14398 p_index = 0
14399 DO md = 1, md_max
14400 DO mc = 1, 1
14401 DO mb = 1, 6
14402 ks_bd = 0.0_dp
14403 ks_bc = 0.0_dp
14404 p_bd = pbd((md - 1)*6 + mb)
14405 p_bc = pbc((mc - 1)*6 + mb)
14406 DO ma = 1, 2
14407 p_index = p_index + 1
14408 tmp = scale*prim(p_index)
14409 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14410 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14411 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14412 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14413 END DO
14414 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
14415 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
14416 END DO
14417 END DO
14418 END DO
14419 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 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 kbd(1:6*md_max) = 0.0_dp
14444 kbc(1:6*mc_max) = 0.0_dp
14445 kad(1:2*md_max) = 0.0_dp
14446 kac(1:2*mc_max) = 0.0_dp
14447 p_index = 0
14448 DO md = 1, md_max
14449 DO mc = 1, mc_max
14450 DO mb = 1, 6
14451 ks_bd = 0.0_dp
14452 ks_bc = 0.0_dp
14453 p_bd = pbd((md - 1)*6 + mb)
14454 p_bc = pbc((mc - 1)*6 + mb)
14455 DO ma = 1, 2
14456 p_index = p_index + 1
14457 tmp = scale*prim(p_index)
14458 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14459 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14460 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14461 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14462 END DO
14463 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
14464 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
14465 END DO
14466 END DO
14467 END DO
14468 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 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 kbd(1:7*1) = 0.0_dp
14491 kbc(1:7*1) = 0.0_dp
14492 kad(1:2*1) = 0.0_dp
14493 kac(1:2*1) = 0.0_dp
14494 p_index = 0
14495 DO md = 1, 1
14496 DO mc = 1, 1
14497 DO mb = 1, 7
14498 ks_bd = 0.0_dp
14499 ks_bc = 0.0_dp
14500 p_bd = pbd((md - 1)*7 + mb)
14501 p_bc = pbc((mc - 1)*7 + mb)
14502 DO ma = 1, 2
14503 p_index = p_index + 1
14504 tmp = scale*prim(p_index)
14505 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14506 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14507 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14508 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14509 END DO
14510 kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
14511 kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
14512 END DO
14513 END DO
14514 END DO
14515 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 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 kbd(1:7*md_max) = 0.0_dp
14539 kbc(1:7*1) = 0.0_dp
14540 kad(1:2*md_max) = 0.0_dp
14541 kac(1:2*1) = 0.0_dp
14542 p_index = 0
14543 DO md = 1, md_max
14544 DO mc = 1, 1
14545 DO mb = 1, 7
14546 ks_bd = 0.0_dp
14547 ks_bc = 0.0_dp
14548 p_bd = pbd((md - 1)*7 + mb)
14549 p_bc = pbc((mc - 1)*7 + mb)
14550 DO ma = 1, 2
14551 p_index = p_index + 1
14552 tmp = scale*prim(p_index)
14553 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14554 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14555 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14556 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14557 END DO
14558 kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
14559 kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
14560 END DO
14561 END DO
14562 END DO
14563 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 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 kbd(1:7*md_max) = 0.0_dp
14588 kbc(1:7*mc_max) = 0.0_dp
14589 kad(1:2*md_max) = 0.0_dp
14590 kac(1:2*mc_max) = 0.0_dp
14591 p_index = 0
14592 DO md = 1, md_max
14593 DO mc = 1, mc_max
14594 DO mb = 1, 7
14595 ks_bd = 0.0_dp
14596 ks_bc = 0.0_dp
14597 p_bd = pbd((md - 1)*7 + mb)
14598 p_bc = pbc((mc - 1)*7 + mb)
14599 DO ma = 1, 2
14600 p_index = p_index + 1
14601 tmp = scale*prim(p_index)
14602 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14603 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14604 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14605 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14606 END DO
14607 kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
14608 kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
14609 END DO
14610 END DO
14611 END DO
14612 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 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 kbd(1:9*1) = 0.0_dp
14635 kbc(1:9*1) = 0.0_dp
14636 kad(1:2*1) = 0.0_dp
14637 kac(1:2*1) = 0.0_dp
14638 p_index = 0
14639 DO md = 1, 1
14640 DO mc = 1, 1
14641 DO mb = 1, 9
14642 ks_bd = 0.0_dp
14643 ks_bc = 0.0_dp
14644 p_bd = pbd((md - 1)*9 + mb)
14645 p_bc = pbc((mc - 1)*9 + mb)
14646 DO ma = 1, 2
14647 p_index = p_index + 1
14648 tmp = scale*prim(p_index)
14649 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14650 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14651 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14652 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14653 END DO
14654 kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
14655 kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
14656 END DO
14657 END DO
14658 END DO
14659 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 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 kbd(1:9*md_max) = 0.0_dp
14683 kbc(1:9*1) = 0.0_dp
14684 kad(1:2*md_max) = 0.0_dp
14685 kac(1:2*1) = 0.0_dp
14686 p_index = 0
14687 DO md = 1, md_max
14688 DO mc = 1, 1
14689 DO mb = 1, 9
14690 ks_bd = 0.0_dp
14691 ks_bc = 0.0_dp
14692 p_bd = pbd((md - 1)*9 + mb)
14693 p_bc = pbc((mc - 1)*9 + mb)
14694 DO ma = 1, 2
14695 p_index = p_index + 1
14696 tmp = scale*prim(p_index)
14697 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14698 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14699 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14700 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14701 END DO
14702 kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
14703 kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
14704 END DO
14705 END DO
14706 END DO
14707 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 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 kbd(1:9*md_max) = 0.0_dp
14732 kbc(1:9*mc_max) = 0.0_dp
14733 kad(1:2*md_max) = 0.0_dp
14734 kac(1:2*mc_max) = 0.0_dp
14735 p_index = 0
14736 DO md = 1, md_max
14737 DO mc = 1, mc_max
14738 DO mb = 1, 9
14739 ks_bd = 0.0_dp
14740 ks_bc = 0.0_dp
14741 p_bd = pbd((md - 1)*9 + mb)
14742 p_bc = pbc((mc - 1)*9 + mb)
14743 DO ma = 1, 2
14744 p_index = p_index + 1
14745 tmp = scale*prim(p_index)
14746 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14747 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14748 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14749 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14750 END DO
14751 kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
14752 kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
14753 END DO
14754 END DO
14755 END DO
14756 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 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 kbd(1:10*md_max) = 0.0_dp
14782 kbc(1:10*mc_max) = 0.0_dp
14783 kad(1:2*md_max) = 0.0_dp
14784 kac(1:2*mc_max) = 0.0_dp
14785 p_index = 0
14786 DO md = 1, md_max
14787 DO mc = 1, mc_max
14788 DO mb = 1, 10
14789 ks_bd = 0.0_dp
14790 ks_bc = 0.0_dp
14791 p_bd = pbd((md - 1)*10 + mb)
14792 p_bc = pbc((mc - 1)*10 + mb)
14793 DO ma = 1, 2
14794 p_index = p_index + 1
14795 tmp = scale*prim(p_index)
14796 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14797 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14798 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14799 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14800 END DO
14801 kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
14802 kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
14803 END DO
14804 END DO
14805 END DO
14806 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 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 kbd(1:11*md_max) = 0.0_dp
14832 kbc(1:11*mc_max) = 0.0_dp
14833 kad(1:2*md_max) = 0.0_dp
14834 kac(1:2*mc_max) = 0.0_dp
14835 p_index = 0
14836 DO md = 1, md_max
14837 DO mc = 1, mc_max
14838 DO mb = 1, 11
14839 ks_bd = 0.0_dp
14840 ks_bc = 0.0_dp
14841 p_bd = pbd((md - 1)*11 + mb)
14842 p_bc = pbc((mc - 1)*11 + mb)
14843 DO ma = 1, 2
14844 p_index = p_index + 1
14845 tmp = scale*prim(p_index)
14846 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14847 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14848 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14849 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14850 END DO
14851 kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
14852 kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
14853 END DO
14854 END DO
14855 END DO
14856 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 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 kbd(1:15*md_max) = 0.0_dp
14882 kbc(1:15*mc_max) = 0.0_dp
14883 kad(1:2*md_max) = 0.0_dp
14884 kac(1:2*mc_max) = 0.0_dp
14885 p_index = 0
14886 DO md = 1, md_max
14887 DO mc = 1, mc_max
14888 DO mb = 1, 15
14889 ks_bd = 0.0_dp
14890 ks_bc = 0.0_dp
14891 p_bd = pbd((md - 1)*15 + mb)
14892 p_bc = pbc((mc - 1)*15 + mb)
14893 DO ma = 1, 2
14894 p_index = p_index + 1
14895 tmp = scale*prim(p_index)
14896 ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma)
14897 ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma)
14898 kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc
14899 kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd
14900 END DO
14901 kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
14902 kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
14903 END DO
14904 END DO
14905 END DO
14906 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 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 kbd(1:1*1) = 0.0_dp
14929 kbc(1:1*1) = 0.0_dp
14930 kad(1:3*1) = 0.0_dp
14931 kac(1:3*1) = 0.0_dp
14932 p_index = 0
14933 DO md = 1, 1
14934 DO mc = 1, 1
14935 DO mb = 1, 1
14936 ks_bd = 0.0_dp
14937 ks_bc = 0.0_dp
14938 p_bd = pbd((md - 1)*1 + mb)
14939 p_bc = pbc((mc - 1)*1 + mb)
14940 DO ma = 1, 3
14941 p_index = p_index + 1
14942 tmp = scale*prim(p_index)
14943 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
14944 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
14945 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
14946 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
14947 END DO
14948 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
14949 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
14950 END DO
14951 END DO
14952 END DO
14953 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 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 kbd(1:1*2) = 0.0_dp
14976 kbc(1:1*1) = 0.0_dp
14977 kad(1:3*2) = 0.0_dp
14978 kac(1:3*1) = 0.0_dp
14979 p_index = 0
14980 DO md = 1, 2
14981 DO mc = 1, 1
14982 DO mb = 1, 1
14983 ks_bd = 0.0_dp
14984 ks_bc = 0.0_dp
14985 p_bd = pbd((md - 1)*1 + mb)
14986 p_bc = pbc((mc - 1)*1 + mb)
14987 DO ma = 1, 3
14988 p_index = p_index + 1
14989 tmp = scale*prim(p_index)
14990 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
14991 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
14992 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
14993 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
14994 END DO
14995 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
14996 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
14997 END DO
14998 END DO
14999 END DO
15000 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 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 kbd(1:1*3) = 0.0_dp
15023 kbc(1:1*1) = 0.0_dp
15024 kad(1:3*3) = 0.0_dp
15025 kac(1:3*1) = 0.0_dp
15026 p_index = 0
15027 DO md = 1, 3
15028 DO mc = 1, 1
15029 DO mb = 1, 1
15030 ks_bd = 0.0_dp
15031 ks_bc = 0.0_dp
15032 p_bd = pbd((md - 1)*1 + mb)
15033 p_bc = pbc((mc - 1)*1 + mb)
15034 DO ma = 1, 3
15035 p_index = p_index + 1
15036 tmp = scale*prim(p_index)
15037 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15038 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15039 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15040 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15041 END DO
15042 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15043 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15044 END DO
15045 END DO
15046 END DO
15047 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 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 kbd(1:1*4) = 0.0_dp
15070 kbc(1:1*1) = 0.0_dp
15071 kad(1:3*4) = 0.0_dp
15072 kac(1:3*1) = 0.0_dp
15073 p_index = 0
15074 DO md = 1, 4
15075 DO mc = 1, 1
15076 DO mb = 1, 1
15077 ks_bd = 0.0_dp
15078 ks_bc = 0.0_dp
15079 p_bd = pbd((md - 1)*1 + mb)
15080 p_bc = pbc((mc - 1)*1 + mb)
15081 DO ma = 1, 3
15082 p_index = p_index + 1
15083 tmp = scale*prim(p_index)
15084 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15085 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15086 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15087 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15088 END DO
15089 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15090 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15091 END DO
15092 END DO
15093 END DO
15094 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 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 kbd(1:1*5) = 0.0_dp
15117 kbc(1:1*1) = 0.0_dp
15118 kad(1:3*5) = 0.0_dp
15119 kac(1:3*1) = 0.0_dp
15120 p_index = 0
15121 DO md = 1, 5
15122 DO mc = 1, 1
15123 DO mb = 1, 1
15124 ks_bd = 0.0_dp
15125 ks_bc = 0.0_dp
15126 p_bd = pbd((md - 1)*1 + mb)
15127 p_bc = pbc((mc - 1)*1 + mb)
15128 DO ma = 1, 3
15129 p_index = p_index + 1
15130 tmp = scale*prim(p_index)
15131 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15132 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15133 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15134 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15135 END DO
15136 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15137 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15138 END DO
15139 END DO
15140 END DO
15141 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 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 kbd(1:1*6) = 0.0_dp
15164 kbc(1:1*1) = 0.0_dp
15165 kad(1:3*6) = 0.0_dp
15166 kac(1:3*1) = 0.0_dp
15167 p_index = 0
15168 DO md = 1, 6
15169 DO mc = 1, 1
15170 DO mb = 1, 1
15171 ks_bd = 0.0_dp
15172 ks_bc = 0.0_dp
15173 p_bd = pbd((md - 1)*1 + mb)
15174 p_bc = pbc((mc - 1)*1 + mb)
15175 DO ma = 1, 3
15176 p_index = p_index + 1
15177 tmp = scale*prim(p_index)
15178 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15179 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15180 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15181 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15182 END DO
15183 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15184 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15185 END DO
15186 END DO
15187 END DO
15188 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 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 kbd(1:1*md_max) = 0.0_dp
15212 kbc(1:1*1) = 0.0_dp
15213 kad(1:3*md_max) = 0.0_dp
15214 kac(1:3*1) = 0.0_dp
15215 p_index = 0
15216 DO md = 1, md_max
15217 DO mc = 1, 1
15218 DO mb = 1, 1
15219 ks_bd = 0.0_dp
15220 ks_bc = 0.0_dp
15221 p_bd = pbd((md - 1)*1 + mb)
15222 p_bc = pbc((mc - 1)*1 + mb)
15223 DO ma = 1, 3
15224 p_index = p_index + 1
15225 tmp = scale*prim(p_index)
15226 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15227 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15228 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15229 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15230 END DO
15231 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15232 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15233 END DO
15234 END DO
15235 END DO
15236 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 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 kbd(1:1*1) = 0.0_dp
15259 kbc(1:1*2) = 0.0_dp
15260 kad(1:3*1) = 0.0_dp
15261 kac(1:3*2) = 0.0_dp
15262 p_index = 0
15263 DO md = 1, 1
15264 DO mc = 1, 2
15265 DO mb = 1, 1
15266 ks_bd = 0.0_dp
15267 ks_bc = 0.0_dp
15268 p_bd = pbd((md - 1)*1 + mb)
15269 p_bc = pbc((mc - 1)*1 + mb)
15270 DO ma = 1, 3
15271 p_index = p_index + 1
15272 tmp = scale*prim(p_index)
15273 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15274 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15275 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15276 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15277 END DO
15278 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15279 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15280 END DO
15281 END DO
15282 END DO
15283 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 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 kbd(1:1*2) = 0.0_dp
15306 kbc(1:1*2) = 0.0_dp
15307 kad(1:3*2) = 0.0_dp
15308 kac(1:3*2) = 0.0_dp
15309 p_index = 0
15310 DO md = 1, 2
15311 DO mc = 1, 2
15312 DO mb = 1, 1
15313 ks_bd = 0.0_dp
15314 ks_bc = 0.0_dp
15315 p_bd = pbd((md - 1)*1 + mb)
15316 p_bc = pbc((mc - 1)*1 + mb)
15317 DO ma = 1, 3
15318 p_index = p_index + 1
15319 tmp = scale*prim(p_index)
15320 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15321 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15322 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15323 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15324 END DO
15325 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15326 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15327 END DO
15328 END DO
15329 END DO
15330 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 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 kbd(1:1*3) = 0.0_dp
15353 kbc(1:1*2) = 0.0_dp
15354 kad(1:3*3) = 0.0_dp
15355 kac(1:3*2) = 0.0_dp
15356 p_index = 0
15357 DO md = 1, 3
15358 DO mc = 1, 2
15359 DO mb = 1, 1
15360 ks_bd = 0.0_dp
15361 ks_bc = 0.0_dp
15362 p_bd = pbd((md - 1)*1 + mb)
15363 p_bc = pbc((mc - 1)*1 + mb)
15364 DO ma = 1, 3
15365 p_index = p_index + 1
15366 tmp = scale*prim(p_index)
15367 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15368 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15369 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15370 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15371 END DO
15372 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15373 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15374 END DO
15375 END DO
15376 END DO
15377 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 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 kbd(1:1*md_max) = 0.0_dp
15401 kbc(1:1*2) = 0.0_dp
15402 kad(1:3*md_max) = 0.0_dp
15403 kac(1:3*2) = 0.0_dp
15404 p_index = 0
15405 DO md = 1, md_max
15406 DO mc = 1, 2
15407 DO mb = 1, 1
15408 ks_bd = 0.0_dp
15409 ks_bc = 0.0_dp
15410 p_bd = pbd((md - 1)*1 + mb)
15411 p_bc = pbc((mc - 1)*1 + mb)
15412 DO ma = 1, 3
15413 p_index = p_index + 1
15414 tmp = scale*prim(p_index)
15415 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15416 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15417 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15418 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15419 END DO
15420 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15421 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15422 END DO
15423 END DO
15424 END DO
15425 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 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 kbd(1:1*1) = 0.0_dp
15448 kbc(1:1*3) = 0.0_dp
15449 kad(1:3*1) = 0.0_dp
15450 kac(1:3*3) = 0.0_dp
15451 p_index = 0
15452 DO md = 1, 1
15453 DO mc = 1, 3
15454 DO mb = 1, 1
15455 ks_bd = 0.0_dp
15456 ks_bc = 0.0_dp
15457 p_bd = pbd((md - 1)*1 + mb)
15458 p_bc = pbc((mc - 1)*1 + mb)
15459 DO ma = 1, 3
15460 p_index = p_index + 1
15461 tmp = scale*prim(p_index)
15462 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15463 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15464 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15465 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15466 END DO
15467 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15468 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15469 END DO
15470 END DO
15471 END DO
15472 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 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 kbd(1:1*2) = 0.0_dp
15495 kbc(1:1*3) = 0.0_dp
15496 kad(1:3*2) = 0.0_dp
15497 kac(1:3*3) = 0.0_dp
15498 p_index = 0
15499 DO md = 1, 2
15500 DO mc = 1, 3
15501 DO mb = 1, 1
15502 ks_bd = 0.0_dp
15503 ks_bc = 0.0_dp
15504 p_bd = pbd((md - 1)*1 + mb)
15505 p_bc = pbc((mc - 1)*1 + mb)
15506 DO ma = 1, 3
15507 p_index = p_index + 1
15508 tmp = scale*prim(p_index)
15509 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15510 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15511 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15512 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15513 END DO
15514 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15515 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15516 END DO
15517 END DO
15518 END DO
15519 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 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 kbd(1:1*md_max) = 0.0_dp
15543 kbc(1:1*3) = 0.0_dp
15544 kad(1:3*md_max) = 0.0_dp
15545 kac(1:3*3) = 0.0_dp
15546 p_index = 0
15547 DO md = 1, md_max
15548 DO mc = 1, 3
15549 DO mb = 1, 1
15550 ks_bd = 0.0_dp
15551 ks_bc = 0.0_dp
15552 p_bd = pbd((md - 1)*1 + mb)
15553 p_bc = pbc((mc - 1)*1 + mb)
15554 DO ma = 1, 3
15555 p_index = p_index + 1
15556 tmp = scale*prim(p_index)
15557 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15558 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15559 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15560 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15561 END DO
15562 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15563 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15564 END DO
15565 END DO
15566 END DO
15567 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 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 kbd(1:1*1) = 0.0_dp
15590 kbc(1:1*4) = 0.0_dp
15591 kad(1:3*1) = 0.0_dp
15592 kac(1:3*4) = 0.0_dp
15593 p_index = 0
15594 DO md = 1, 1
15595 DO mc = 1, 4
15596 DO mb = 1, 1
15597 ks_bd = 0.0_dp
15598 ks_bc = 0.0_dp
15599 p_bd = pbd((md - 1)*1 + mb)
15600 p_bc = pbc((mc - 1)*1 + mb)
15601 DO ma = 1, 3
15602 p_index = p_index + 1
15603 tmp = scale*prim(p_index)
15604 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15605 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15606 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15607 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15608 END DO
15609 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15610 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15611 END DO
15612 END DO
15613 END DO
15614 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 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 kbd(1:1*md_max) = 0.0_dp
15638 kbc(1:1*4) = 0.0_dp
15639 kad(1:3*md_max) = 0.0_dp
15640 kac(1:3*4) = 0.0_dp
15641 p_index = 0
15642 DO md = 1, md_max
15643 DO mc = 1, 4
15644 DO mb = 1, 1
15645 ks_bd = 0.0_dp
15646 ks_bc = 0.0_dp
15647 p_bd = pbd((md - 1)*1 + mb)
15648 p_bc = pbc((mc - 1)*1 + mb)
15649 DO ma = 1, 3
15650 p_index = p_index + 1
15651 tmp = scale*prim(p_index)
15652 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15653 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15654 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15655 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15656 END DO
15657 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15658 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15659 END DO
15660 END DO
15661 END DO
15662 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 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 kbd(1:1*1) = 0.0_dp
15685 kbc(1:1*5) = 0.0_dp
15686 kad(1:3*1) = 0.0_dp
15687 kac(1:3*5) = 0.0_dp
15688 p_index = 0
15689 DO md = 1, 1
15690 DO mc = 1, 5
15691 DO mb = 1, 1
15692 ks_bd = 0.0_dp
15693 ks_bc = 0.0_dp
15694 p_bd = pbd((md - 1)*1 + mb)
15695 p_bc = pbc((mc - 1)*1 + mb)
15696 DO ma = 1, 3
15697 p_index = p_index + 1
15698 tmp = scale*prim(p_index)
15699 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15700 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15701 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15702 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15703 END DO
15704 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15705 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15706 END DO
15707 END DO
15708 END DO
15709 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 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 kbd(1:1*md_max) = 0.0_dp
15733 kbc(1:1*5) = 0.0_dp
15734 kad(1:3*md_max) = 0.0_dp
15735 kac(1:3*5) = 0.0_dp
15736 p_index = 0
15737 DO md = 1, md_max
15738 DO mc = 1, 5
15739 DO mb = 1, 1
15740 ks_bd = 0.0_dp
15741 ks_bc = 0.0_dp
15742 p_bd = pbd((md - 1)*1 + mb)
15743 p_bc = pbc((mc - 1)*1 + mb)
15744 DO ma = 1, 3
15745 p_index = p_index + 1
15746 tmp = scale*prim(p_index)
15747 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15748 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15749 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15750 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15751 END DO
15752 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15753 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15754 END DO
15755 END DO
15756 END DO
15757 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 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 kbd(1:1*1) = 0.0_dp
15780 kbc(1:1*6) = 0.0_dp
15781 kad(1:3*1) = 0.0_dp
15782 kac(1:3*6) = 0.0_dp
15783 p_index = 0
15784 DO md = 1, 1
15785 DO mc = 1, 6
15786 DO mb = 1, 1
15787 ks_bd = 0.0_dp
15788 ks_bc = 0.0_dp
15789 p_bd = pbd((md - 1)*1 + mb)
15790 p_bc = pbc((mc - 1)*1 + mb)
15791 DO ma = 1, 3
15792 p_index = p_index + 1
15793 tmp = scale*prim(p_index)
15794 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15795 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15796 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15797 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15798 END DO
15799 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15800 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15801 END DO
15802 END DO
15803 END DO
15804 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 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 kbd(1:1*md_max) = 0.0_dp
15828 kbc(1:1*6) = 0.0_dp
15829 kad(1:3*md_max) = 0.0_dp
15830 kac(1:3*6) = 0.0_dp
15831 p_index = 0
15832 DO md = 1, md_max
15833 DO mc = 1, 6
15834 DO mb = 1, 1
15835 ks_bd = 0.0_dp
15836 ks_bc = 0.0_dp
15837 p_bd = pbd((md - 1)*1 + mb)
15838 p_bc = pbc((mc - 1)*1 + mb)
15839 DO ma = 1, 3
15840 p_index = p_index + 1
15841 tmp = scale*prim(p_index)
15842 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15843 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15844 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15845 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15846 END DO
15847 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15848 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15849 END DO
15850 END DO
15851 END DO
15852 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 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 kbd(1:1*md_max) = 0.0_dp
15877 kbc(1:1*mc_max) = 0.0_dp
15878 kad(1:3*md_max) = 0.0_dp
15879 kac(1:3*mc_max) = 0.0_dp
15880 p_index = 0
15881 DO md = 1, md_max
15882 DO mc = 1, mc_max
15883 DO mb = 1, 1
15884 ks_bd = 0.0_dp
15885 ks_bc = 0.0_dp
15886 p_bd = pbd((md - 1)*1 + mb)
15887 p_bc = pbc((mc - 1)*1 + mb)
15888 DO ma = 1, 3
15889 p_index = p_index + 1
15890 tmp = scale*prim(p_index)
15891 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15892 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15893 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15894 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15895 END DO
15896 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
15897 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
15898 END DO
15899 END DO
15900 END DO
15901 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 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 kbd(1:2*1) = 0.0_dp
15924 kbc(1:2*1) = 0.0_dp
15925 kad(1:3*1) = 0.0_dp
15926 kac(1:3*1) = 0.0_dp
15927 p_index = 0
15928 DO md = 1, 1
15929 DO mc = 1, 1
15930 DO mb = 1, 2
15931 ks_bd = 0.0_dp
15932 ks_bc = 0.0_dp
15933 p_bd = pbd((md - 1)*2 + mb)
15934 p_bc = pbc((mc - 1)*2 + mb)
15935 DO ma = 1, 3
15936 p_index = p_index + 1
15937 tmp = scale*prim(p_index)
15938 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15939 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15940 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15941 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15942 END DO
15943 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
15944 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
15945 END DO
15946 END DO
15947 END DO
15948 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 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 kbd(1:2*2) = 0.0_dp
15971 kbc(1:2*1) = 0.0_dp
15972 kad(1:3*2) = 0.0_dp
15973 kac(1:3*1) = 0.0_dp
15974 p_index = 0
15975 DO md = 1, 2
15976 DO mc = 1, 1
15977 DO mb = 1, 2
15978 ks_bd = 0.0_dp
15979 ks_bc = 0.0_dp
15980 p_bd = pbd((md - 1)*2 + mb)
15981 p_bc = pbc((mc - 1)*2 + mb)
15982 DO ma = 1, 3
15983 p_index = p_index + 1
15984 tmp = scale*prim(p_index)
15985 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
15986 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
15987 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
15988 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
15989 END DO
15990 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
15991 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
15992 END DO
15993 END DO
15994 END DO
15995 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 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 kbd(1:2*3) = 0.0_dp
16018 kbc(1:2*1) = 0.0_dp
16019 kad(1:3*3) = 0.0_dp
16020 kac(1:3*1) = 0.0_dp
16021 p_index = 0
16022 DO md = 1, 3
16023 DO mc = 1, 1
16024 DO mb = 1, 2
16025 ks_bd = 0.0_dp
16026 ks_bc = 0.0_dp
16027 p_bd = pbd((md - 1)*2 + mb)
16028 p_bc = pbc((mc - 1)*2 + mb)
16029 DO ma = 1, 3
16030 p_index = p_index + 1
16031 tmp = scale*prim(p_index)
16032 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16033 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16034 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16035 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16036 END DO
16037 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
16038 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
16039 END DO
16040 END DO
16041 END DO
16042 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 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 kbd(1:2*md_max) = 0.0_dp
16066 kbc(1:2*1) = 0.0_dp
16067 kad(1:3*md_max) = 0.0_dp
16068 kac(1:3*1) = 0.0_dp
16069 p_index = 0
16070 DO md = 1, md_max
16071 DO mc = 1, 1
16072 DO mb = 1, 2
16073 ks_bd = 0.0_dp
16074 ks_bc = 0.0_dp
16075 p_bd = pbd((md - 1)*2 + mb)
16076 p_bc = pbc((mc - 1)*2 + mb)
16077 DO ma = 1, 3
16078 p_index = p_index + 1
16079 tmp = scale*prim(p_index)
16080 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16081 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16082 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16083 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16084 END DO
16085 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
16086 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
16087 END DO
16088 END DO
16089 END DO
16090 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 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 kbd(1:2*1) = 0.0_dp
16113 kbc(1:2*2) = 0.0_dp
16114 kad(1:3*1) = 0.0_dp
16115 kac(1:3*2) = 0.0_dp
16116 p_index = 0
16117 DO md = 1, 1
16118 DO mc = 1, 2
16119 DO mb = 1, 2
16120 ks_bd = 0.0_dp
16121 ks_bc = 0.0_dp
16122 p_bd = pbd((md - 1)*2 + mb)
16123 p_bc = pbc((mc - 1)*2 + mb)
16124 DO ma = 1, 3
16125 p_index = p_index + 1
16126 tmp = scale*prim(p_index)
16127 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16128 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16129 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16130 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16131 END DO
16132 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
16133 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
16134 END DO
16135 END DO
16136 END DO
16137 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 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 kbd(1:2*md_max) = 0.0_dp
16161 kbc(1:2*2) = 0.0_dp
16162 kad(1:3*md_max) = 0.0_dp
16163 kac(1:3*2) = 0.0_dp
16164 p_index = 0
16165 DO md = 1, md_max
16166 DO mc = 1, 2
16167 DO mb = 1, 2
16168 ks_bd = 0.0_dp
16169 ks_bc = 0.0_dp
16170 p_bd = pbd((md - 1)*2 + mb)
16171 p_bc = pbc((mc - 1)*2 + mb)
16172 DO ma = 1, 3
16173 p_index = p_index + 1
16174 tmp = scale*prim(p_index)
16175 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16176 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16177 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16178 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16179 END DO
16180 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
16181 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
16182 END DO
16183 END DO
16184 END DO
16185 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 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 kbd(1:2*1) = 0.0_dp
16208 kbc(1:2*3) = 0.0_dp
16209 kad(1:3*1) = 0.0_dp
16210 kac(1:3*3) = 0.0_dp
16211 p_index = 0
16212 DO md = 1, 1
16213 DO mc = 1, 3
16214 DO mb = 1, 2
16215 ks_bd = 0.0_dp
16216 ks_bc = 0.0_dp
16217 p_bd = pbd((md - 1)*2 + mb)
16218 p_bc = pbc((mc - 1)*2 + mb)
16219 DO ma = 1, 3
16220 p_index = p_index + 1
16221 tmp = scale*prim(p_index)
16222 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16223 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16224 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16225 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16226 END DO
16227 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
16228 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
16229 END DO
16230 END DO
16231 END DO
16232 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 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 kbd(1:2*md_max) = 0.0_dp
16256 kbc(1:2*3) = 0.0_dp
16257 kad(1:3*md_max) = 0.0_dp
16258 kac(1:3*3) = 0.0_dp
16259 p_index = 0
16260 DO md = 1, md_max
16261 DO mc = 1, 3
16262 DO mb = 1, 2
16263 ks_bd = 0.0_dp
16264 ks_bc = 0.0_dp
16265 p_bd = pbd((md - 1)*2 + mb)
16266 p_bc = pbc((mc - 1)*2 + mb)
16267 DO ma = 1, 3
16268 p_index = p_index + 1
16269 tmp = scale*prim(p_index)
16270 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16271 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16272 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16273 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16274 END DO
16275 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
16276 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
16277 END DO
16278 END DO
16279 END DO
16280 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 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 kbd(1:2*md_max) = 0.0_dp
16305 kbc(1:2*mc_max) = 0.0_dp
16306 kad(1:3*md_max) = 0.0_dp
16307 kac(1:3*mc_max) = 0.0_dp
16308 p_index = 0
16309 DO md = 1, md_max
16310 DO mc = 1, mc_max
16311 DO mb = 1, 2
16312 ks_bd = 0.0_dp
16313 ks_bc = 0.0_dp
16314 p_bd = pbd((md - 1)*2 + mb)
16315 p_bc = pbc((mc - 1)*2 + mb)
16316 DO ma = 1, 3
16317 p_index = p_index + 1
16318 tmp = scale*prim(p_index)
16319 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16320 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16321 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16322 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16323 END DO
16324 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
16325 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
16326 END DO
16327 END DO
16328 END DO
16329 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 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 kbd(1:3*1) = 0.0_dp
16352 kbc(1:3*1) = 0.0_dp
16353 kad(1:3*1) = 0.0_dp
16354 kac(1:3*1) = 0.0_dp
16355 p_index = 0
16356 DO md = 1, 1
16357 DO mc = 1, 1
16358 DO mb = 1, 3
16359 ks_bd = 0.0_dp
16360 ks_bc = 0.0_dp
16361 p_bd = pbd((md - 1)*3 + mb)
16362 p_bc = pbc((mc - 1)*3 + mb)
16363 DO ma = 1, 3
16364 p_index = p_index + 1
16365 tmp = scale*prim(p_index)
16366 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16367 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16368 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16369 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16370 END DO
16371 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
16372 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
16373 END DO
16374 END DO
16375 END DO
16376 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 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 kbd(1:3*2) = 0.0_dp
16399 kbc(1:3*1) = 0.0_dp
16400 kad(1:3*2) = 0.0_dp
16401 kac(1:3*1) = 0.0_dp
16402 p_index = 0
16403 DO md = 1, 2
16404 DO mc = 1, 1
16405 DO mb = 1, 3
16406 ks_bd = 0.0_dp
16407 ks_bc = 0.0_dp
16408 p_bd = pbd((md - 1)*3 + mb)
16409 p_bc = pbc((mc - 1)*3 + mb)
16410 DO ma = 1, 3
16411 p_index = p_index + 1
16412 tmp = scale*prim(p_index)
16413 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16414 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16415 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16416 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16417 END DO
16418 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
16419 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
16420 END DO
16421 END DO
16422 END DO
16423 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 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 kbd(1:3*md_max) = 0.0_dp
16447 kbc(1:3*1) = 0.0_dp
16448 kad(1:3*md_max) = 0.0_dp
16449 kac(1:3*1) = 0.0_dp
16450 p_index = 0
16451 DO md = 1, md_max
16452 DO mc = 1, 1
16453 DO mb = 1, 3
16454 ks_bd = 0.0_dp
16455 ks_bc = 0.0_dp
16456 p_bd = pbd((md - 1)*3 + mb)
16457 p_bc = pbc((mc - 1)*3 + mb)
16458 DO ma = 1, 3
16459 p_index = p_index + 1
16460 tmp = scale*prim(p_index)
16461 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16462 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16463 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16464 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16465 END DO
16466 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
16467 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
16468 END DO
16469 END DO
16470 END DO
16471 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 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 kbd(1:3*1) = 0.0_dp
16494 kbc(1:3*2) = 0.0_dp
16495 kad(1:3*1) = 0.0_dp
16496 kac(1:3*2) = 0.0_dp
16497 p_index = 0
16498 DO md = 1, 1
16499 DO mc = 1, 2
16500 DO mb = 1, 3
16501 ks_bd = 0.0_dp
16502 ks_bc = 0.0_dp
16503 p_bd = pbd((md - 1)*3 + mb)
16504 p_bc = pbc((mc - 1)*3 + mb)
16505 DO ma = 1, 3
16506 p_index = p_index + 1
16507 tmp = scale*prim(p_index)
16508 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16509 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16510 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16511 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16512 END DO
16513 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
16514 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
16515 END DO
16516 END DO
16517 END DO
16518 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 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 kbd(1:3*md_max) = 0.0_dp
16542 kbc(1:3*2) = 0.0_dp
16543 kad(1:3*md_max) = 0.0_dp
16544 kac(1:3*2) = 0.0_dp
16545 p_index = 0
16546 DO md = 1, md_max
16547 DO mc = 1, 2
16548 DO mb = 1, 3
16549 ks_bd = 0.0_dp
16550 ks_bc = 0.0_dp
16551 p_bd = pbd((md - 1)*3 + mb)
16552 p_bc = pbc((mc - 1)*3 + mb)
16553 DO ma = 1, 3
16554 p_index = p_index + 1
16555 tmp = scale*prim(p_index)
16556 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16557 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16558 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16559 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16560 END DO
16561 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
16562 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
16563 END DO
16564 END DO
16565 END DO
16566 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 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 kbd(1:3*md_max) = 0.0_dp
16591 kbc(1:3*mc_max) = 0.0_dp
16592 kad(1:3*md_max) = 0.0_dp
16593 kac(1:3*mc_max) = 0.0_dp
16594 p_index = 0
16595 DO md = 1, md_max
16596 DO mc = 1, mc_max
16597 DO mb = 1, 3
16598 ks_bd = 0.0_dp
16599 ks_bc = 0.0_dp
16600 p_bd = pbd((md - 1)*3 + mb)
16601 p_bc = pbc((mc - 1)*3 + mb)
16602 DO ma = 1, 3
16603 p_index = p_index + 1
16604 tmp = scale*prim(p_index)
16605 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16606 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16607 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16608 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16609 END DO
16610 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
16611 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
16612 END DO
16613 END DO
16614 END DO
16615 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 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 kbd(1:4*1) = 0.0_dp
16638 kbc(1:4*1) = 0.0_dp
16639 kad(1:3*1) = 0.0_dp
16640 kac(1:3*1) = 0.0_dp
16641 p_index = 0
16642 DO md = 1, 1
16643 DO mc = 1, 1
16644 DO mb = 1, 4
16645 ks_bd = 0.0_dp
16646 ks_bc = 0.0_dp
16647 p_bd = pbd((md - 1)*4 + mb)
16648 p_bc = pbc((mc - 1)*4 + mb)
16649 DO ma = 1, 3
16650 p_index = p_index + 1
16651 tmp = scale*prim(p_index)
16652 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16653 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16654 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16655 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16656 END DO
16657 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
16658 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
16659 END DO
16660 END DO
16661 END DO
16662 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 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 kbd(1:4*md_max) = 0.0_dp
16686 kbc(1:4*1) = 0.0_dp
16687 kad(1:3*md_max) = 0.0_dp
16688 kac(1:3*1) = 0.0_dp
16689 p_index = 0
16690 DO md = 1, md_max
16691 DO mc = 1, 1
16692 DO mb = 1, 4
16693 ks_bd = 0.0_dp
16694 ks_bc = 0.0_dp
16695 p_bd = pbd((md - 1)*4 + mb)
16696 p_bc = pbc((mc - 1)*4 + mb)
16697 DO ma = 1, 3
16698 p_index = p_index + 1
16699 tmp = scale*prim(p_index)
16700 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16701 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16702 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16703 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16704 END DO
16705 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
16706 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
16707 END DO
16708 END DO
16709 END DO
16710 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 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 kbd(1:4*md_max) = 0.0_dp
16735 kbc(1:4*mc_max) = 0.0_dp
16736 kad(1:3*md_max) = 0.0_dp
16737 kac(1:3*mc_max) = 0.0_dp
16738 p_index = 0
16739 DO md = 1, md_max
16740 DO mc = 1, mc_max
16741 DO mb = 1, 4
16742 ks_bd = 0.0_dp
16743 ks_bc = 0.0_dp
16744 p_bd = pbd((md - 1)*4 + mb)
16745 p_bc = pbc((mc - 1)*4 + mb)
16746 DO ma = 1, 3
16747 p_index = p_index + 1
16748 tmp = scale*prim(p_index)
16749 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16750 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16751 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16752 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16753 END DO
16754 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
16755 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
16756 END DO
16757 END DO
16758 END DO
16759 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 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 kbd(1:5*1) = 0.0_dp
16782 kbc(1:5*1) = 0.0_dp
16783 kad(1:3*1) = 0.0_dp
16784 kac(1:3*1) = 0.0_dp
16785 p_index = 0
16786 DO md = 1, 1
16787 DO mc = 1, 1
16788 DO mb = 1, 5
16789 ks_bd = 0.0_dp
16790 ks_bc = 0.0_dp
16791 p_bd = pbd((md - 1)*5 + mb)
16792 p_bc = pbc((mc - 1)*5 + mb)
16793 DO ma = 1, 3
16794 p_index = p_index + 1
16795 tmp = scale*prim(p_index)
16796 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16797 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16798 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16799 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16800 END DO
16801 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
16802 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
16803 END DO
16804 END DO
16805 END DO
16806 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 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 kbd(1:5*md_max) = 0.0_dp
16830 kbc(1:5*1) = 0.0_dp
16831 kad(1:3*md_max) = 0.0_dp
16832 kac(1:3*1) = 0.0_dp
16833 p_index = 0
16834 DO md = 1, md_max
16835 DO mc = 1, 1
16836 DO mb = 1, 5
16837 ks_bd = 0.0_dp
16838 ks_bc = 0.0_dp
16839 p_bd = pbd((md - 1)*5 + mb)
16840 p_bc = pbc((mc - 1)*5 + mb)
16841 DO ma = 1, 3
16842 p_index = p_index + 1
16843 tmp = scale*prim(p_index)
16844 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16845 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16846 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16847 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16848 END DO
16849 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
16850 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
16851 END DO
16852 END DO
16853 END DO
16854 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 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 kbd(1:5*md_max) = 0.0_dp
16879 kbc(1:5*mc_max) = 0.0_dp
16880 kad(1:3*md_max) = 0.0_dp
16881 kac(1:3*mc_max) = 0.0_dp
16882 p_index = 0
16883 DO md = 1, md_max
16884 DO mc = 1, mc_max
16885 DO mb = 1, 5
16886 ks_bd = 0.0_dp
16887 ks_bc = 0.0_dp
16888 p_bd = pbd((md - 1)*5 + mb)
16889 p_bc = pbc((mc - 1)*5 + mb)
16890 DO ma = 1, 3
16891 p_index = p_index + 1
16892 tmp = scale*prim(p_index)
16893 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16894 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16895 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16896 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16897 END DO
16898 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
16899 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
16900 END DO
16901 END DO
16902 END DO
16903 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 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 kbd(1:6*1) = 0.0_dp
16926 kbc(1:6*1) = 0.0_dp
16927 kad(1:3*1) = 0.0_dp
16928 kac(1:3*1) = 0.0_dp
16929 p_index = 0
16930 DO md = 1, 1
16931 DO mc = 1, 1
16932 DO mb = 1, 6
16933 ks_bd = 0.0_dp
16934 ks_bc = 0.0_dp
16935 p_bd = pbd((md - 1)*6 + mb)
16936 p_bc = pbc((mc - 1)*6 + mb)
16937 DO ma = 1, 3
16938 p_index = p_index + 1
16939 tmp = scale*prim(p_index)
16940 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16941 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16942 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16943 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16944 END DO
16945 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
16946 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
16947 END DO
16948 END DO
16949 END DO
16950 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 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 kbd(1:6*md_max) = 0.0_dp
16974 kbc(1:6*1) = 0.0_dp
16975 kad(1:3*md_max) = 0.0_dp
16976 kac(1:3*1) = 0.0_dp
16977 p_index = 0
16978 DO md = 1, md_max
16979 DO mc = 1, 1
16980 DO mb = 1, 6
16981 ks_bd = 0.0_dp
16982 ks_bc = 0.0_dp
16983 p_bd = pbd((md - 1)*6 + mb)
16984 p_bc = pbc((mc - 1)*6 + mb)
16985 DO ma = 1, 3
16986 p_index = p_index + 1
16987 tmp = scale*prim(p_index)
16988 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
16989 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
16990 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
16991 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
16992 END DO
16993 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
16994 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
16995 END DO
16996 END DO
16997 END DO
16998 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 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 kbd(1:6*md_max) = 0.0_dp
17023 kbc(1:6*mc_max) = 0.0_dp
17024 kad(1:3*md_max) = 0.0_dp
17025 kac(1:3*mc_max) = 0.0_dp
17026 p_index = 0
17027 DO md = 1, md_max
17028 DO mc = 1, mc_max
17029 DO mb = 1, 6
17030 ks_bd = 0.0_dp
17031 ks_bc = 0.0_dp
17032 p_bd = pbd((md - 1)*6 + mb)
17033 p_bc = pbc((mc - 1)*6 + mb)
17034 DO ma = 1, 3
17035 p_index = p_index + 1
17036 tmp = scale*prim(p_index)
17037 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
17038 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
17039 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
17040 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
17041 END DO
17042 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
17043 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
17044 END DO
17045 END DO
17046 END DO
17047 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 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 kbd(1:7*md_max) = 0.0_dp
17072 kbc(1:7*mc_max) = 0.0_dp
17073 kad(1:3*md_max) = 0.0_dp
17074 kac(1:3*mc_max) = 0.0_dp
17075 p_index = 0
17076 DO md = 1, md_max
17077 DO mc = 1, mc_max
17078 DO mb = 1, 7
17079 ks_bd = 0.0_dp
17080 ks_bc = 0.0_dp
17081 p_bd = pbd((md - 1)*7 + mb)
17082 p_bc = pbc((mc - 1)*7 + mb)
17083 DO ma = 1, 3
17084 p_index = p_index + 1
17085 tmp = scale*prim(p_index)
17086 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
17087 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
17088 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
17089 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
17090 END DO
17091 kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
17092 kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
17093 END DO
17094 END DO
17095 END DO
17096 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 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 kbd(1:9*md_max) = 0.0_dp
17121 kbc(1:9*mc_max) = 0.0_dp
17122 kad(1:3*md_max) = 0.0_dp
17123 kac(1:3*mc_max) = 0.0_dp
17124 p_index = 0
17125 DO md = 1, md_max
17126 DO mc = 1, mc_max
17127 DO mb = 1, 9
17128 ks_bd = 0.0_dp
17129 ks_bc = 0.0_dp
17130 p_bd = pbd((md - 1)*9 + mb)
17131 p_bc = pbc((mc - 1)*9 + mb)
17132 DO ma = 1, 3
17133 p_index = p_index + 1
17134 tmp = scale*prim(p_index)
17135 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
17136 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
17137 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
17138 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
17139 END DO
17140 kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
17141 kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
17142 END DO
17143 END DO
17144 END DO
17145 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 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 kbd(1:10*md_max) = 0.0_dp
17171 kbc(1:10*mc_max) = 0.0_dp
17172 kad(1:3*md_max) = 0.0_dp
17173 kac(1:3*mc_max) = 0.0_dp
17174 p_index = 0
17175 DO md = 1, md_max
17176 DO mc = 1, mc_max
17177 DO mb = 1, 10
17178 ks_bd = 0.0_dp
17179 ks_bc = 0.0_dp
17180 p_bd = pbd((md - 1)*10 + mb)
17181 p_bc = pbc((mc - 1)*10 + mb)
17182 DO ma = 1, 3
17183 p_index = p_index + 1
17184 tmp = scale*prim(p_index)
17185 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
17186 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
17187 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
17188 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
17189 END DO
17190 kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
17191 kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
17192 END DO
17193 END DO
17194 END DO
17195 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 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 kbd(1:11*md_max) = 0.0_dp
17221 kbc(1:11*mc_max) = 0.0_dp
17222 kad(1:3*md_max) = 0.0_dp
17223 kac(1:3*mc_max) = 0.0_dp
17224 p_index = 0
17225 DO md = 1, md_max
17226 DO mc = 1, mc_max
17227 DO mb = 1, 11
17228 ks_bd = 0.0_dp
17229 ks_bc = 0.0_dp
17230 p_bd = pbd((md - 1)*11 + mb)
17231 p_bc = pbc((mc - 1)*11 + mb)
17232 DO ma = 1, 3
17233 p_index = p_index + 1
17234 tmp = scale*prim(p_index)
17235 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
17236 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
17237 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
17238 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
17239 END DO
17240 kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
17241 kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
17242 END DO
17243 END DO
17244 END DO
17245 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 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 kbd(1:15*md_max) = 0.0_dp
17271 kbc(1:15*mc_max) = 0.0_dp
17272 kad(1:3*md_max) = 0.0_dp
17273 kac(1:3*mc_max) = 0.0_dp
17274 p_index = 0
17275 DO md = 1, md_max
17276 DO mc = 1, mc_max
17277 DO mb = 1, 15
17278 ks_bd = 0.0_dp
17279 ks_bc = 0.0_dp
17280 p_bd = pbd((md - 1)*15 + mb)
17281 p_bc = pbc((mc - 1)*15 + mb)
17282 DO ma = 1, 3
17283 p_index = p_index + 1
17284 tmp = scale*prim(p_index)
17285 ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma)
17286 ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma)
17287 kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc
17288 kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd
17289 END DO
17290 kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
17291 kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
17292 END DO
17293 END DO
17294 END DO
17295 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 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 kbd(1:1*1) = 0.0_dp
17318 kbc(1:1*1) = 0.0_dp
17319 kad(1:4*1) = 0.0_dp
17320 kac(1:4*1) = 0.0_dp
17321 p_index = 0
17322 DO md = 1, 1
17323 DO mc = 1, 1
17324 DO mb = 1, 1
17325 ks_bd = 0.0_dp
17326 ks_bc = 0.0_dp
17327 p_bd = pbd((md - 1)*1 + mb)
17328 p_bc = pbc((mc - 1)*1 + mb)
17329 DO ma = 1, 4
17330 p_index = p_index + 1
17331 tmp = scale*prim(p_index)
17332 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17333 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17334 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17335 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17336 END DO
17337 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17338 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17339 END DO
17340 END DO
17341 END DO
17342 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 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 kbd(1:1*2) = 0.0_dp
17365 kbc(1:1*1) = 0.0_dp
17366 kad(1:4*2) = 0.0_dp
17367 kac(1:4*1) = 0.0_dp
17368 p_index = 0
17369 DO md = 1, 2
17370 DO mc = 1, 1
17371 DO mb = 1, 1
17372 ks_bd = 0.0_dp
17373 ks_bc = 0.0_dp
17374 p_bd = pbd((md - 1)*1 + mb)
17375 p_bc = pbc((mc - 1)*1 + mb)
17376 DO ma = 1, 4
17377 p_index = p_index + 1
17378 tmp = scale*prim(p_index)
17379 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17380 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17381 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17382 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17383 END DO
17384 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17385 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17386 END DO
17387 END DO
17388 END DO
17389 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 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 kbd(1:1*3) = 0.0_dp
17412 kbc(1:1*1) = 0.0_dp
17413 kad(1:4*3) = 0.0_dp
17414 kac(1:4*1) = 0.0_dp
17415 p_index = 0
17416 DO md = 1, 3
17417 DO mc = 1, 1
17418 DO mb = 1, 1
17419 ks_bd = 0.0_dp
17420 ks_bc = 0.0_dp
17421 p_bd = pbd((md - 1)*1 + mb)
17422 p_bc = pbc((mc - 1)*1 + mb)
17423 DO ma = 1, 4
17424 p_index = p_index + 1
17425 tmp = scale*prim(p_index)
17426 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17427 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17428 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17429 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17430 END DO
17431 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17432 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17433 END DO
17434 END DO
17435 END DO
17436 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 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 kbd(1:1*4) = 0.0_dp
17459 kbc(1:1*1) = 0.0_dp
17460 kad(1:4*4) = 0.0_dp
17461 kac(1:4*1) = 0.0_dp
17462 p_index = 0
17463 DO md = 1, 4
17464 DO mc = 1, 1
17465 DO mb = 1, 1
17466 ks_bd = 0.0_dp
17467 ks_bc = 0.0_dp
17468 p_bd = pbd((md - 1)*1 + mb)
17469 p_bc = pbc((mc - 1)*1 + mb)
17470 DO ma = 1, 4
17471 p_index = p_index + 1
17472 tmp = scale*prim(p_index)
17473 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17474 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17475 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17476 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17477 END DO
17478 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17479 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17480 END DO
17481 END DO
17482 END DO
17483 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 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 kbd(1:1*md_max) = 0.0_dp
17507 kbc(1:1*1) = 0.0_dp
17508 kad(1:4*md_max) = 0.0_dp
17509 kac(1:4*1) = 0.0_dp
17510 p_index = 0
17511 DO md = 1, md_max
17512 DO mc = 1, 1
17513 DO mb = 1, 1
17514 ks_bd = 0.0_dp
17515 ks_bc = 0.0_dp
17516 p_bd = pbd((md - 1)*1 + mb)
17517 p_bc = pbc((mc - 1)*1 + mb)
17518 DO ma = 1, 4
17519 p_index = p_index + 1
17520 tmp = scale*prim(p_index)
17521 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17522 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17523 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17524 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17525 END DO
17526 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17527 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17528 END DO
17529 END DO
17530 END DO
17531 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 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 kbd(1:1*1) = 0.0_dp
17554 kbc(1:1*2) = 0.0_dp
17555 kad(1:4*1) = 0.0_dp
17556 kac(1:4*2) = 0.0_dp
17557 p_index = 0
17558 DO md = 1, 1
17559 DO mc = 1, 2
17560 DO mb = 1, 1
17561 ks_bd = 0.0_dp
17562 ks_bc = 0.0_dp
17563 p_bd = pbd((md - 1)*1 + mb)
17564 p_bc = pbc((mc - 1)*1 + mb)
17565 DO ma = 1, 4
17566 p_index = p_index + 1
17567 tmp = scale*prim(p_index)
17568 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17569 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17570 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17571 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17572 END DO
17573 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17574 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17575 END DO
17576 END DO
17577 END DO
17578 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 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 kbd(1:1*2) = 0.0_dp
17601 kbc(1:1*2) = 0.0_dp
17602 kad(1:4*2) = 0.0_dp
17603 kac(1:4*2) = 0.0_dp
17604 p_index = 0
17605 DO md = 1, 2
17606 DO mc = 1, 2
17607 DO mb = 1, 1
17608 ks_bd = 0.0_dp
17609 ks_bc = 0.0_dp
17610 p_bd = pbd((md - 1)*1 + mb)
17611 p_bc = pbc((mc - 1)*1 + mb)
17612 DO ma = 1, 4
17613 p_index = p_index + 1
17614 tmp = scale*prim(p_index)
17615 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17616 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17617 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17618 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17619 END DO
17620 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17621 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17622 END DO
17623 END DO
17624 END DO
17625 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 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 kbd(1:1*md_max) = 0.0_dp
17649 kbc(1:1*2) = 0.0_dp
17650 kad(1:4*md_max) = 0.0_dp
17651 kac(1:4*2) = 0.0_dp
17652 p_index = 0
17653 DO md = 1, md_max
17654 DO mc = 1, 2
17655 DO mb = 1, 1
17656 ks_bd = 0.0_dp
17657 ks_bc = 0.0_dp
17658 p_bd = pbd((md - 1)*1 + mb)
17659 p_bc = pbc((mc - 1)*1 + mb)
17660 DO ma = 1, 4
17661 p_index = p_index + 1
17662 tmp = scale*prim(p_index)
17663 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17664 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17665 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17666 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17667 END DO
17668 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17669 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17670 END DO
17671 END DO
17672 END DO
17673 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 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 kbd(1:1*1) = 0.0_dp
17696 kbc(1:1*3) = 0.0_dp
17697 kad(1:4*1) = 0.0_dp
17698 kac(1:4*3) = 0.0_dp
17699 p_index = 0
17700 DO md = 1, 1
17701 DO mc = 1, 3
17702 DO mb = 1, 1
17703 ks_bd = 0.0_dp
17704 ks_bc = 0.0_dp
17705 p_bd = pbd((md - 1)*1 + mb)
17706 p_bc = pbc((mc - 1)*1 + mb)
17707 DO ma = 1, 4
17708 p_index = p_index + 1
17709 tmp = scale*prim(p_index)
17710 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17711 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17712 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17713 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17714 END DO
17715 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17716 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17717 END DO
17718 END DO
17719 END DO
17720 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 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 kbd(1:1*md_max) = 0.0_dp
17744 kbc(1:1*3) = 0.0_dp
17745 kad(1:4*md_max) = 0.0_dp
17746 kac(1:4*3) = 0.0_dp
17747 p_index = 0
17748 DO md = 1, md_max
17749 DO mc = 1, 3
17750 DO mb = 1, 1
17751 ks_bd = 0.0_dp
17752 ks_bc = 0.0_dp
17753 p_bd = pbd((md - 1)*1 + mb)
17754 p_bc = pbc((mc - 1)*1 + mb)
17755 DO ma = 1, 4
17756 p_index = p_index + 1
17757 tmp = scale*prim(p_index)
17758 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17759 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17760 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17761 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17762 END DO
17763 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17764 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17765 END DO
17766 END DO
17767 END DO
17768 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 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 kbd(1:1*1) = 0.0_dp
17791 kbc(1:1*4) = 0.0_dp
17792 kad(1:4*1) = 0.0_dp
17793 kac(1:4*4) = 0.0_dp
17794 p_index = 0
17795 DO md = 1, 1
17796 DO mc = 1, 4
17797 DO mb = 1, 1
17798 ks_bd = 0.0_dp
17799 ks_bc = 0.0_dp
17800 p_bd = pbd((md - 1)*1 + mb)
17801 p_bc = pbc((mc - 1)*1 + mb)
17802 DO ma = 1, 4
17803 p_index = p_index + 1
17804 tmp = scale*prim(p_index)
17805 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17806 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17807 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17808 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17809 END DO
17810 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17811 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17812 END DO
17813 END DO
17814 END DO
17815 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 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 kbd(1:1*md_max) = 0.0_dp
17839 kbc(1:1*4) = 0.0_dp
17840 kad(1:4*md_max) = 0.0_dp
17841 kac(1:4*4) = 0.0_dp
17842 p_index = 0
17843 DO md = 1, md_max
17844 DO mc = 1, 4
17845 DO mb = 1, 1
17846 ks_bd = 0.0_dp
17847 ks_bc = 0.0_dp
17848 p_bd = pbd((md - 1)*1 + mb)
17849 p_bc = pbc((mc - 1)*1 + mb)
17850 DO ma = 1, 4
17851 p_index = p_index + 1
17852 tmp = scale*prim(p_index)
17853 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17854 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17855 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17856 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17857 END DO
17858 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17859 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17860 END DO
17861 END DO
17862 END DO
17863 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 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 kbd(1:1*md_max) = 0.0_dp
17888 kbc(1:1*mc_max) = 0.0_dp
17889 kad(1:4*md_max) = 0.0_dp
17890 kac(1:4*mc_max) = 0.0_dp
17891 p_index = 0
17892 DO md = 1, md_max
17893 DO mc = 1, mc_max
17894 DO mb = 1, 1
17895 ks_bd = 0.0_dp
17896 ks_bc = 0.0_dp
17897 p_bd = pbd((md - 1)*1 + mb)
17898 p_bc = pbc((mc - 1)*1 + mb)
17899 DO ma = 1, 4
17900 p_index = p_index + 1
17901 tmp = scale*prim(p_index)
17902 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17903 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17904 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17905 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17906 END DO
17907 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
17908 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
17909 END DO
17910 END DO
17911 END DO
17912 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 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 kbd(1:2*1) = 0.0_dp
17935 kbc(1:2*1) = 0.0_dp
17936 kad(1:4*1) = 0.0_dp
17937 kac(1:4*1) = 0.0_dp
17938 p_index = 0
17939 DO md = 1, 1
17940 DO mc = 1, 1
17941 DO mb = 1, 2
17942 ks_bd = 0.0_dp
17943 ks_bc = 0.0_dp
17944 p_bd = pbd((md - 1)*2 + mb)
17945 p_bc = pbc((mc - 1)*2 + mb)
17946 DO ma = 1, 4
17947 p_index = p_index + 1
17948 tmp = scale*prim(p_index)
17949 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17950 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17951 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17952 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
17953 END DO
17954 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
17955 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
17956 END DO
17957 END DO
17958 END DO
17959 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 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 kbd(1:2*2) = 0.0_dp
17982 kbc(1:2*1) = 0.0_dp
17983 kad(1:4*2) = 0.0_dp
17984 kac(1:4*1) = 0.0_dp
17985 p_index = 0
17986 DO md = 1, 2
17987 DO mc = 1, 1
17988 DO mb = 1, 2
17989 ks_bd = 0.0_dp
17990 ks_bc = 0.0_dp
17991 p_bd = pbd((md - 1)*2 + mb)
17992 p_bc = pbc((mc - 1)*2 + mb)
17993 DO ma = 1, 4
17994 p_index = p_index + 1
17995 tmp = scale*prim(p_index)
17996 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
17997 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
17998 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
17999 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18000 END DO
18001 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
18002 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
18003 END DO
18004 END DO
18005 END DO
18006 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 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 kbd(1:2*md_max) = 0.0_dp
18030 kbc(1:2*1) = 0.0_dp
18031 kad(1:4*md_max) = 0.0_dp
18032 kac(1:4*1) = 0.0_dp
18033 p_index = 0
18034 DO md = 1, md_max
18035 DO mc = 1, 1
18036 DO mb = 1, 2
18037 ks_bd = 0.0_dp
18038 ks_bc = 0.0_dp
18039 p_bd = pbd((md - 1)*2 + mb)
18040 p_bc = pbc((mc - 1)*2 + mb)
18041 DO ma = 1, 4
18042 p_index = p_index + 1
18043 tmp = scale*prim(p_index)
18044 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18045 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18046 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18047 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18048 END DO
18049 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
18050 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
18051 END DO
18052 END DO
18053 END DO
18054 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 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 kbd(1:2*1) = 0.0_dp
18077 kbc(1:2*2) = 0.0_dp
18078 kad(1:4*1) = 0.0_dp
18079 kac(1:4*2) = 0.0_dp
18080 p_index = 0
18081 DO md = 1, 1
18082 DO mc = 1, 2
18083 DO mb = 1, 2
18084 ks_bd = 0.0_dp
18085 ks_bc = 0.0_dp
18086 p_bd = pbd((md - 1)*2 + mb)
18087 p_bc = pbc((mc - 1)*2 + mb)
18088 DO ma = 1, 4
18089 p_index = p_index + 1
18090 tmp = scale*prim(p_index)
18091 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18092 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18093 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18094 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18095 END DO
18096 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
18097 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
18098 END DO
18099 END DO
18100 END DO
18101 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 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 kbd(1:2*md_max) = 0.0_dp
18125 kbc(1:2*2) = 0.0_dp
18126 kad(1:4*md_max) = 0.0_dp
18127 kac(1:4*2) = 0.0_dp
18128 p_index = 0
18129 DO md = 1, md_max
18130 DO mc = 1, 2
18131 DO mb = 1, 2
18132 ks_bd = 0.0_dp
18133 ks_bc = 0.0_dp
18134 p_bd = pbd((md - 1)*2 + mb)
18135 p_bc = pbc((mc - 1)*2 + mb)
18136 DO ma = 1, 4
18137 p_index = p_index + 1
18138 tmp = scale*prim(p_index)
18139 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18140 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18141 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18142 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18143 END DO
18144 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
18145 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
18146 END DO
18147 END DO
18148 END DO
18149 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 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 kbd(1:2*md_max) = 0.0_dp
18174 kbc(1:2*mc_max) = 0.0_dp
18175 kad(1:4*md_max) = 0.0_dp
18176 kac(1:4*mc_max) = 0.0_dp
18177 p_index = 0
18178 DO md = 1, md_max
18179 DO mc = 1, mc_max
18180 DO mb = 1, 2
18181 ks_bd = 0.0_dp
18182 ks_bc = 0.0_dp
18183 p_bd = pbd((md - 1)*2 + mb)
18184 p_bc = pbc((mc - 1)*2 + mb)
18185 DO ma = 1, 4
18186 p_index = p_index + 1
18187 tmp = scale*prim(p_index)
18188 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18189 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18190 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18191 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18192 END DO
18193 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
18194 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
18195 END DO
18196 END DO
18197 END DO
18198 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 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 kbd(1:3*1) = 0.0_dp
18221 kbc(1:3*1) = 0.0_dp
18222 kad(1:4*1) = 0.0_dp
18223 kac(1:4*1) = 0.0_dp
18224 p_index = 0
18225 DO md = 1, 1
18226 DO mc = 1, 1
18227 DO mb = 1, 3
18228 ks_bd = 0.0_dp
18229 ks_bc = 0.0_dp
18230 p_bd = pbd((md - 1)*3 + mb)
18231 p_bc = pbc((mc - 1)*3 + mb)
18232 DO ma = 1, 4
18233 p_index = p_index + 1
18234 tmp = scale*prim(p_index)
18235 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18236 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18237 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18238 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18239 END DO
18240 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
18241 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
18242 END DO
18243 END DO
18244 END DO
18245 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 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 kbd(1:3*md_max) = 0.0_dp
18269 kbc(1:3*1) = 0.0_dp
18270 kad(1:4*md_max) = 0.0_dp
18271 kac(1:4*1) = 0.0_dp
18272 p_index = 0
18273 DO md = 1, md_max
18274 DO mc = 1, 1
18275 DO mb = 1, 3
18276 ks_bd = 0.0_dp
18277 ks_bc = 0.0_dp
18278 p_bd = pbd((md - 1)*3 + mb)
18279 p_bc = pbc((mc - 1)*3 + mb)
18280 DO ma = 1, 4
18281 p_index = p_index + 1
18282 tmp = scale*prim(p_index)
18283 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18284 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18285 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18286 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18287 END DO
18288 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
18289 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
18290 END DO
18291 END DO
18292 END DO
18293 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 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 kbd(1:3*md_max) = 0.0_dp
18318 kbc(1:3*mc_max) = 0.0_dp
18319 kad(1:4*md_max) = 0.0_dp
18320 kac(1:4*mc_max) = 0.0_dp
18321 p_index = 0
18322 DO md = 1, md_max
18323 DO mc = 1, mc_max
18324 DO mb = 1, 3
18325 ks_bd = 0.0_dp
18326 ks_bc = 0.0_dp
18327 p_bd = pbd((md - 1)*3 + mb)
18328 p_bc = pbc((mc - 1)*3 + mb)
18329 DO ma = 1, 4
18330 p_index = p_index + 1
18331 tmp = scale*prim(p_index)
18332 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18333 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18334 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18335 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18336 END DO
18337 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
18338 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
18339 END DO
18340 END DO
18341 END DO
18342 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 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 kbd(1:4*1) = 0.0_dp
18365 kbc(1:4*1) = 0.0_dp
18366 kad(1:4*1) = 0.0_dp
18367 kac(1:4*1) = 0.0_dp
18368 p_index = 0
18369 DO md = 1, 1
18370 DO mc = 1, 1
18371 DO mb = 1, 4
18372 ks_bd = 0.0_dp
18373 ks_bc = 0.0_dp
18374 p_bd = pbd((md - 1)*4 + mb)
18375 p_bc = pbc((mc - 1)*4 + mb)
18376 DO ma = 1, 4
18377 p_index = p_index + 1
18378 tmp = scale*prim(p_index)
18379 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18380 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18381 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18382 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18383 END DO
18384 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
18385 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
18386 END DO
18387 END DO
18388 END DO
18389 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 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 kbd(1:4*md_max) = 0.0_dp
18413 kbc(1:4*1) = 0.0_dp
18414 kad(1:4*md_max) = 0.0_dp
18415 kac(1:4*1) = 0.0_dp
18416 p_index = 0
18417 DO md = 1, md_max
18418 DO mc = 1, 1
18419 DO mb = 1, 4
18420 ks_bd = 0.0_dp
18421 ks_bc = 0.0_dp
18422 p_bd = pbd((md - 1)*4 + mb)
18423 p_bc = pbc((mc - 1)*4 + mb)
18424 DO ma = 1, 4
18425 p_index = p_index + 1
18426 tmp = scale*prim(p_index)
18427 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18428 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18429 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18430 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18431 END DO
18432 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
18433 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
18434 END DO
18435 END DO
18436 END DO
18437 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 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 kbd(1:4*md_max) = 0.0_dp
18462 kbc(1:4*mc_max) = 0.0_dp
18463 kad(1:4*md_max) = 0.0_dp
18464 kac(1:4*mc_max) = 0.0_dp
18465 p_index = 0
18466 DO md = 1, md_max
18467 DO mc = 1, mc_max
18468 DO mb = 1, 4
18469 ks_bd = 0.0_dp
18470 ks_bc = 0.0_dp
18471 p_bd = pbd((md - 1)*4 + mb)
18472 p_bc = pbc((mc - 1)*4 + mb)
18473 DO ma = 1, 4
18474 p_index = p_index + 1
18475 tmp = scale*prim(p_index)
18476 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18477 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18478 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18479 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18480 END DO
18481 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
18482 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
18483 END DO
18484 END DO
18485 END DO
18486 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 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 kbd(1:5*md_max) = 0.0_dp
18511 kbc(1:5*mc_max) = 0.0_dp
18512 kad(1:4*md_max) = 0.0_dp
18513 kac(1:4*mc_max) = 0.0_dp
18514 p_index = 0
18515 DO md = 1, md_max
18516 DO mc = 1, mc_max
18517 DO mb = 1, 5
18518 ks_bd = 0.0_dp
18519 ks_bc = 0.0_dp
18520 p_bd = pbd((md - 1)*5 + mb)
18521 p_bc = pbc((mc - 1)*5 + mb)
18522 DO ma = 1, 4
18523 p_index = p_index + 1
18524 tmp = scale*prim(p_index)
18525 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18526 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18527 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18528 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18529 END DO
18530 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
18531 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
18532 END DO
18533 END DO
18534 END DO
18535 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 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 kbd(1:6*md_max) = 0.0_dp
18560 kbc(1:6*mc_max) = 0.0_dp
18561 kad(1:4*md_max) = 0.0_dp
18562 kac(1:4*mc_max) = 0.0_dp
18563 p_index = 0
18564 DO md = 1, md_max
18565 DO mc = 1, mc_max
18566 DO mb = 1, 6
18567 ks_bd = 0.0_dp
18568 ks_bc = 0.0_dp
18569 p_bd = pbd((md - 1)*6 + mb)
18570 p_bc = pbc((mc - 1)*6 + mb)
18571 DO ma = 1, 4
18572 p_index = p_index + 1
18573 tmp = scale*prim(p_index)
18574 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18575 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18576 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18577 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18578 END DO
18579 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
18580 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
18581 END DO
18582 END DO
18583 END DO
18584 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 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 kbd(1:7*md_max) = 0.0_dp
18609 kbc(1:7*mc_max) = 0.0_dp
18610 kad(1:4*md_max) = 0.0_dp
18611 kac(1:4*mc_max) = 0.0_dp
18612 p_index = 0
18613 DO md = 1, md_max
18614 DO mc = 1, mc_max
18615 DO mb = 1, 7
18616 ks_bd = 0.0_dp
18617 ks_bc = 0.0_dp
18618 p_bd = pbd((md - 1)*7 + mb)
18619 p_bc = pbc((mc - 1)*7 + mb)
18620 DO ma = 1, 4
18621 p_index = p_index + 1
18622 tmp = scale*prim(p_index)
18623 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18624 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18625 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18626 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18627 END DO
18628 kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
18629 kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
18630 END DO
18631 END DO
18632 END DO
18633 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 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 kbd(1:9*md_max) = 0.0_dp
18658 kbc(1:9*mc_max) = 0.0_dp
18659 kad(1:4*md_max) = 0.0_dp
18660 kac(1:4*mc_max) = 0.0_dp
18661 p_index = 0
18662 DO md = 1, md_max
18663 DO mc = 1, mc_max
18664 DO mb = 1, 9
18665 ks_bd = 0.0_dp
18666 ks_bc = 0.0_dp
18667 p_bd = pbd((md - 1)*9 + mb)
18668 p_bc = pbc((mc - 1)*9 + mb)
18669 DO ma = 1, 4
18670 p_index = p_index + 1
18671 tmp = scale*prim(p_index)
18672 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18673 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18674 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18675 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18676 END DO
18677 kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
18678 kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
18679 END DO
18680 END DO
18681 END DO
18682 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 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 kbd(1:10*md_max) = 0.0_dp
18708 kbc(1:10*mc_max) = 0.0_dp
18709 kad(1:4*md_max) = 0.0_dp
18710 kac(1:4*mc_max) = 0.0_dp
18711 p_index = 0
18712 DO md = 1, md_max
18713 DO mc = 1, mc_max
18714 DO mb = 1, 10
18715 ks_bd = 0.0_dp
18716 ks_bc = 0.0_dp
18717 p_bd = pbd((md - 1)*10 + mb)
18718 p_bc = pbc((mc - 1)*10 + mb)
18719 DO ma = 1, 4
18720 p_index = p_index + 1
18721 tmp = scale*prim(p_index)
18722 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18723 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18724 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18725 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18726 END DO
18727 kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
18728 kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
18729 END DO
18730 END DO
18731 END DO
18732 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 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 kbd(1:11*md_max) = 0.0_dp
18758 kbc(1:11*mc_max) = 0.0_dp
18759 kad(1:4*md_max) = 0.0_dp
18760 kac(1:4*mc_max) = 0.0_dp
18761 p_index = 0
18762 DO md = 1, md_max
18763 DO mc = 1, mc_max
18764 DO mb = 1, 11
18765 ks_bd = 0.0_dp
18766 ks_bc = 0.0_dp
18767 p_bd = pbd((md - 1)*11 + mb)
18768 p_bc = pbc((mc - 1)*11 + mb)
18769 DO ma = 1, 4
18770 p_index = p_index + 1
18771 tmp = scale*prim(p_index)
18772 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18773 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18774 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18775 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18776 END DO
18777 kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
18778 kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
18779 END DO
18780 END DO
18781 END DO
18782 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 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 kbd(1:15*md_max) = 0.0_dp
18808 kbc(1:15*mc_max) = 0.0_dp
18809 kad(1:4*md_max) = 0.0_dp
18810 kac(1:4*mc_max) = 0.0_dp
18811 p_index = 0
18812 DO md = 1, md_max
18813 DO mc = 1, mc_max
18814 DO mb = 1, 15
18815 ks_bd = 0.0_dp
18816 ks_bc = 0.0_dp
18817 p_bd = pbd((md - 1)*15 + mb)
18818 p_bc = pbc((mc - 1)*15 + mb)
18819 DO ma = 1, 4
18820 p_index = p_index + 1
18821 tmp = scale*prim(p_index)
18822 ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma)
18823 ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma)
18824 kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc
18825 kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd
18826 END DO
18827 kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
18828 kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
18829 END DO
18830 END DO
18831 END DO
18832 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 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 kbd(1:1*1) = 0.0_dp
18855 kbc(1:1*1) = 0.0_dp
18856 kad(1:5*1) = 0.0_dp
18857 kac(1:5*1) = 0.0_dp
18858 p_index = 0
18859 DO md = 1, 1
18860 DO mc = 1, 1
18861 DO mb = 1, 1
18862 ks_bd = 0.0_dp
18863 ks_bc = 0.0_dp
18864 p_bd = pbd((md - 1)*1 + mb)
18865 p_bc = pbc((mc - 1)*1 + mb)
18866 DO ma = 1, 5
18867 p_index = p_index + 1
18868 tmp = scale*prim(p_index)
18869 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
18870 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
18871 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
18872 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
18873 END DO
18874 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
18875 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
18876 END DO
18877 END DO
18878 END DO
18879 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 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 kbd(1:1*2) = 0.0_dp
18902 kbc(1:1*1) = 0.0_dp
18903 kad(1:5*2) = 0.0_dp
18904 kac(1:5*1) = 0.0_dp
18905 p_index = 0
18906 DO md = 1, 2
18907 DO mc = 1, 1
18908 DO mb = 1, 1
18909 ks_bd = 0.0_dp
18910 ks_bc = 0.0_dp
18911 p_bd = pbd((md - 1)*1 + mb)
18912 p_bc = pbc((mc - 1)*1 + mb)
18913 DO ma = 1, 5
18914 p_index = p_index + 1
18915 tmp = scale*prim(p_index)
18916 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
18917 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
18918 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
18919 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
18920 END DO
18921 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
18922 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
18923 END DO
18924 END DO
18925 END DO
18926 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 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 kbd(1:1*3) = 0.0_dp
18949 kbc(1:1*1) = 0.0_dp
18950 kad(1:5*3) = 0.0_dp
18951 kac(1:5*1) = 0.0_dp
18952 p_index = 0
18953 DO md = 1, 3
18954 DO mc = 1, 1
18955 DO mb = 1, 1
18956 ks_bd = 0.0_dp
18957 ks_bc = 0.0_dp
18958 p_bd = pbd((md - 1)*1 + mb)
18959 p_bc = pbc((mc - 1)*1 + mb)
18960 DO ma = 1, 5
18961 p_index = p_index + 1
18962 tmp = scale*prim(p_index)
18963 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
18964 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
18965 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
18966 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
18967 END DO
18968 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
18969 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
18970 END DO
18971 END DO
18972 END DO
18973 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 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 kbd(1:1*md_max) = 0.0_dp
18997 kbc(1:1*1) = 0.0_dp
18998 kad(1:5*md_max) = 0.0_dp
18999 kac(1:5*1) = 0.0_dp
19000 p_index = 0
19001 DO md = 1, md_max
19002 DO mc = 1, 1
19003 DO mb = 1, 1
19004 ks_bd = 0.0_dp
19005 ks_bc = 0.0_dp
19006 p_bd = pbd((md - 1)*1 + mb)
19007 p_bc = pbc((mc - 1)*1 + mb)
19008 DO ma = 1, 5
19009 p_index = p_index + 1
19010 tmp = scale*prim(p_index)
19011 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19012 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19013 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19014 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19015 END DO
19016 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
19017 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
19018 END DO
19019 END DO
19020 END DO
19021 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 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 kbd(1:1*1) = 0.0_dp
19044 kbc(1:1*2) = 0.0_dp
19045 kad(1:5*1) = 0.0_dp
19046 kac(1:5*2) = 0.0_dp
19047 p_index = 0
19048 DO md = 1, 1
19049 DO mc = 1, 2
19050 DO mb = 1, 1
19051 ks_bd = 0.0_dp
19052 ks_bc = 0.0_dp
19053 p_bd = pbd((md - 1)*1 + mb)
19054 p_bc = pbc((mc - 1)*1 + mb)
19055 DO ma = 1, 5
19056 p_index = p_index + 1
19057 tmp = scale*prim(p_index)
19058 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19059 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19060 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19061 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19062 END DO
19063 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
19064 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
19065 END DO
19066 END DO
19067 END DO
19068 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 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 kbd(1:1*md_max) = 0.0_dp
19092 kbc(1:1*2) = 0.0_dp
19093 kad(1:5*md_max) = 0.0_dp
19094 kac(1:5*2) = 0.0_dp
19095 p_index = 0
19096 DO md = 1, md_max
19097 DO mc = 1, 2
19098 DO mb = 1, 1
19099 ks_bd = 0.0_dp
19100 ks_bc = 0.0_dp
19101 p_bd = pbd((md - 1)*1 + mb)
19102 p_bc = pbc((mc - 1)*1 + mb)
19103 DO ma = 1, 5
19104 p_index = p_index + 1
19105 tmp = scale*prim(p_index)
19106 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19107 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19108 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19109 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19110 END DO
19111 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
19112 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
19113 END DO
19114 END DO
19115 END DO
19116 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 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 kbd(1:1*1) = 0.0_dp
19139 kbc(1:1*3) = 0.0_dp
19140 kad(1:5*1) = 0.0_dp
19141 kac(1:5*3) = 0.0_dp
19142 p_index = 0
19143 DO md = 1, 1
19144 DO mc = 1, 3
19145 DO mb = 1, 1
19146 ks_bd = 0.0_dp
19147 ks_bc = 0.0_dp
19148 p_bd = pbd((md - 1)*1 + mb)
19149 p_bc = pbc((mc - 1)*1 + mb)
19150 DO ma = 1, 5
19151 p_index = p_index + 1
19152 tmp = scale*prim(p_index)
19153 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19154 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19155 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19156 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19157 END DO
19158 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
19159 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
19160 END DO
19161 END DO
19162 END DO
19163 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 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 kbd(1:1*md_max) = 0.0_dp
19187 kbc(1:1*3) = 0.0_dp
19188 kad(1:5*md_max) = 0.0_dp
19189 kac(1:5*3) = 0.0_dp
19190 p_index = 0
19191 DO md = 1, md_max
19192 DO mc = 1, 3
19193 DO mb = 1, 1
19194 ks_bd = 0.0_dp
19195 ks_bc = 0.0_dp
19196 p_bd = pbd((md - 1)*1 + mb)
19197 p_bc = pbc((mc - 1)*1 + mb)
19198 DO ma = 1, 5
19199 p_index = p_index + 1
19200 tmp = scale*prim(p_index)
19201 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19202 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19203 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19204 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19205 END DO
19206 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
19207 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
19208 END DO
19209 END DO
19210 END DO
19211 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 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 kbd(1:1*md_max) = 0.0_dp
19236 kbc(1:1*mc_max) = 0.0_dp
19237 kad(1:5*md_max) = 0.0_dp
19238 kac(1:5*mc_max) = 0.0_dp
19239 p_index = 0
19240 DO md = 1, md_max
19241 DO mc = 1, mc_max
19242 DO mb = 1, 1
19243 ks_bd = 0.0_dp
19244 ks_bc = 0.0_dp
19245 p_bd = pbd((md - 1)*1 + mb)
19246 p_bc = pbc((mc - 1)*1 + mb)
19247 DO ma = 1, 5
19248 p_index = p_index + 1
19249 tmp = scale*prim(p_index)
19250 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19251 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19252 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19253 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19254 END DO
19255 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
19256 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
19257 END DO
19258 END DO
19259 END DO
19260 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 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 kbd(1:2*1) = 0.0_dp
19283 kbc(1:2*1) = 0.0_dp
19284 kad(1:5*1) = 0.0_dp
19285 kac(1:5*1) = 0.0_dp
19286 p_index = 0
19287 DO md = 1, 1
19288 DO mc = 1, 1
19289 DO mb = 1, 2
19290 ks_bd = 0.0_dp
19291 ks_bc = 0.0_dp
19292 p_bd = pbd((md - 1)*2 + mb)
19293 p_bc = pbc((mc - 1)*2 + mb)
19294 DO ma = 1, 5
19295 p_index = p_index + 1
19296 tmp = scale*prim(p_index)
19297 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19298 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19299 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19300 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19301 END DO
19302 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
19303 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
19304 END DO
19305 END DO
19306 END DO
19307 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 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 kbd(1:2*md_max) = 0.0_dp
19331 kbc(1:2*1) = 0.0_dp
19332 kad(1:5*md_max) = 0.0_dp
19333 kac(1:5*1) = 0.0_dp
19334 p_index = 0
19335 DO md = 1, md_max
19336 DO mc = 1, 1
19337 DO mb = 1, 2
19338 ks_bd = 0.0_dp
19339 ks_bc = 0.0_dp
19340 p_bd = pbd((md - 1)*2 + mb)
19341 p_bc = pbc((mc - 1)*2 + mb)
19342 DO ma = 1, 5
19343 p_index = p_index + 1
19344 tmp = scale*prim(p_index)
19345 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19346 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19347 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19348 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19349 END DO
19350 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
19351 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
19352 END DO
19353 END DO
19354 END DO
19355 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 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 kbd(1:2*md_max) = 0.0_dp
19380 kbc(1:2*mc_max) = 0.0_dp
19381 kad(1:5*md_max) = 0.0_dp
19382 kac(1:5*mc_max) = 0.0_dp
19383 p_index = 0
19384 DO md = 1, md_max
19385 DO mc = 1, mc_max
19386 DO mb = 1, 2
19387 ks_bd = 0.0_dp
19388 ks_bc = 0.0_dp
19389 p_bd = pbd((md - 1)*2 + mb)
19390 p_bc = pbc((mc - 1)*2 + mb)
19391 DO ma = 1, 5
19392 p_index = p_index + 1
19393 tmp = scale*prim(p_index)
19394 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19395 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19396 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19397 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19398 END DO
19399 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
19400 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
19401 END DO
19402 END DO
19403 END DO
19404 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 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 kbd(1:3*1) = 0.0_dp
19427 kbc(1:3*1) = 0.0_dp
19428 kad(1:5*1) = 0.0_dp
19429 kac(1:5*1) = 0.0_dp
19430 p_index = 0
19431 DO md = 1, 1
19432 DO mc = 1, 1
19433 DO mb = 1, 3
19434 ks_bd = 0.0_dp
19435 ks_bc = 0.0_dp
19436 p_bd = pbd((md - 1)*3 + mb)
19437 p_bc = pbc((mc - 1)*3 + mb)
19438 DO ma = 1, 5
19439 p_index = p_index + 1
19440 tmp = scale*prim(p_index)
19441 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19442 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19443 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19444 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19445 END DO
19446 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
19447 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
19448 END DO
19449 END DO
19450 END DO
19451 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 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 kbd(1:3*md_max) = 0.0_dp
19475 kbc(1:3*1) = 0.0_dp
19476 kad(1:5*md_max) = 0.0_dp
19477 kac(1:5*1) = 0.0_dp
19478 p_index = 0
19479 DO md = 1, md_max
19480 DO mc = 1, 1
19481 DO mb = 1, 3
19482 ks_bd = 0.0_dp
19483 ks_bc = 0.0_dp
19484 p_bd = pbd((md - 1)*3 + mb)
19485 p_bc = pbc((mc - 1)*3 + mb)
19486 DO ma = 1, 5
19487 p_index = p_index + 1
19488 tmp = scale*prim(p_index)
19489 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19490 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19491 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19492 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19493 END DO
19494 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
19495 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
19496 END DO
19497 END DO
19498 END DO
19499 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 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 kbd(1:3*md_max) = 0.0_dp
19524 kbc(1:3*mc_max) = 0.0_dp
19525 kad(1:5*md_max) = 0.0_dp
19526 kac(1:5*mc_max) = 0.0_dp
19527 p_index = 0
19528 DO md = 1, md_max
19529 DO mc = 1, mc_max
19530 DO mb = 1, 3
19531 ks_bd = 0.0_dp
19532 ks_bc = 0.0_dp
19533 p_bd = pbd((md - 1)*3 + mb)
19534 p_bc = pbc((mc - 1)*3 + mb)
19535 DO ma = 1, 5
19536 p_index = p_index + 1
19537 tmp = scale*prim(p_index)
19538 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19539 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19540 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19541 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19542 END DO
19543 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
19544 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
19545 END DO
19546 END DO
19547 END DO
19548 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 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 kbd(1:4*md_max) = 0.0_dp
19573 kbc(1:4*mc_max) = 0.0_dp
19574 kad(1:5*md_max) = 0.0_dp
19575 kac(1:5*mc_max) = 0.0_dp
19576 p_index = 0
19577 DO md = 1, md_max
19578 DO mc = 1, mc_max
19579 DO mb = 1, 4
19580 ks_bd = 0.0_dp
19581 ks_bc = 0.0_dp
19582 p_bd = pbd((md - 1)*4 + mb)
19583 p_bc = pbc((mc - 1)*4 + mb)
19584 DO ma = 1, 5
19585 p_index = p_index + 1
19586 tmp = scale*prim(p_index)
19587 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19588 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19589 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19590 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19591 END DO
19592 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
19593 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
19594 END DO
19595 END DO
19596 END DO
19597 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 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 kbd(1:5*md_max) = 0.0_dp
19622 kbc(1:5*mc_max) = 0.0_dp
19623 kad(1:5*md_max) = 0.0_dp
19624 kac(1:5*mc_max) = 0.0_dp
19625 p_index = 0
19626 DO md = 1, md_max
19627 DO mc = 1, mc_max
19628 DO mb = 1, 5
19629 ks_bd = 0.0_dp
19630 ks_bc = 0.0_dp
19631 p_bd = pbd((md - 1)*5 + mb)
19632 p_bc = pbc((mc - 1)*5 + mb)
19633 DO ma = 1, 5
19634 p_index = p_index + 1
19635 tmp = scale*prim(p_index)
19636 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19637 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19638 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19639 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19640 END DO
19641 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
19642 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
19643 END DO
19644 END DO
19645 END DO
19646 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 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 kbd(1:6*md_max) = 0.0_dp
19671 kbc(1:6*mc_max) = 0.0_dp
19672 kad(1:5*md_max) = 0.0_dp
19673 kac(1:5*mc_max) = 0.0_dp
19674 p_index = 0
19675 DO md = 1, md_max
19676 DO mc = 1, mc_max
19677 DO mb = 1, 6
19678 ks_bd = 0.0_dp
19679 ks_bc = 0.0_dp
19680 p_bd = pbd((md - 1)*6 + mb)
19681 p_bc = pbc((mc - 1)*6 + mb)
19682 DO ma = 1, 5
19683 p_index = p_index + 1
19684 tmp = scale*prim(p_index)
19685 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19686 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19687 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19688 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19689 END DO
19690 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
19691 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
19692 END DO
19693 END DO
19694 END DO
19695 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 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 kbd(1:7*md_max) = 0.0_dp
19720 kbc(1:7*mc_max) = 0.0_dp
19721 kad(1:5*md_max) = 0.0_dp
19722 kac(1:5*mc_max) = 0.0_dp
19723 p_index = 0
19724 DO md = 1, md_max
19725 DO mc = 1, mc_max
19726 DO mb = 1, 7
19727 ks_bd = 0.0_dp
19728 ks_bc = 0.0_dp
19729 p_bd = pbd((md - 1)*7 + mb)
19730 p_bc = pbc((mc - 1)*7 + mb)
19731 DO ma = 1, 5
19732 p_index = p_index + 1
19733 tmp = scale*prim(p_index)
19734 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19735 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19736 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19737 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19738 END DO
19739 kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
19740 kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
19741 END DO
19742 END DO
19743 END DO
19744 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 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 kbd(1:9*md_max) = 0.0_dp
19769 kbc(1:9*mc_max) = 0.0_dp
19770 kad(1:5*md_max) = 0.0_dp
19771 kac(1:5*mc_max) = 0.0_dp
19772 p_index = 0
19773 DO md = 1, md_max
19774 DO mc = 1, mc_max
19775 DO mb = 1, 9
19776 ks_bd = 0.0_dp
19777 ks_bc = 0.0_dp
19778 p_bd = pbd((md - 1)*9 + mb)
19779 p_bc = pbc((mc - 1)*9 + mb)
19780 DO ma = 1, 5
19781 p_index = p_index + 1
19782 tmp = scale*prim(p_index)
19783 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19784 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19785 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19786 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19787 END DO
19788 kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
19789 kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
19790 END DO
19791 END DO
19792 END DO
19793 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 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 kbd(1:10*md_max) = 0.0_dp
19819 kbc(1:10*mc_max) = 0.0_dp
19820 kad(1:5*md_max) = 0.0_dp
19821 kac(1:5*mc_max) = 0.0_dp
19822 p_index = 0
19823 DO md = 1, md_max
19824 DO mc = 1, mc_max
19825 DO mb = 1, 10
19826 ks_bd = 0.0_dp
19827 ks_bc = 0.0_dp
19828 p_bd = pbd((md - 1)*10 + mb)
19829 p_bc = pbc((mc - 1)*10 + mb)
19830 DO ma = 1, 5
19831 p_index = p_index + 1
19832 tmp = scale*prim(p_index)
19833 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19834 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19835 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19836 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19837 END DO
19838 kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
19839 kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
19840 END DO
19841 END DO
19842 END DO
19843 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 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 kbd(1:11*md_max) = 0.0_dp
19869 kbc(1:11*mc_max) = 0.0_dp
19870 kad(1:5*md_max) = 0.0_dp
19871 kac(1:5*mc_max) = 0.0_dp
19872 p_index = 0
19873 DO md = 1, md_max
19874 DO mc = 1, mc_max
19875 DO mb = 1, 11
19876 ks_bd = 0.0_dp
19877 ks_bc = 0.0_dp
19878 p_bd = pbd((md - 1)*11 + mb)
19879 p_bc = pbc((mc - 1)*11 + mb)
19880 DO ma = 1, 5
19881 p_index = p_index + 1
19882 tmp = scale*prim(p_index)
19883 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19884 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19885 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19886 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19887 END DO
19888 kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
19889 kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
19890 END DO
19891 END DO
19892 END DO
19893 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 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 kbd(1:15*md_max) = 0.0_dp
19919 kbc(1:15*mc_max) = 0.0_dp
19920 kad(1:5*md_max) = 0.0_dp
19921 kac(1:5*mc_max) = 0.0_dp
19922 p_index = 0
19923 DO md = 1, md_max
19924 DO mc = 1, mc_max
19925 DO mb = 1, 15
19926 ks_bd = 0.0_dp
19927 ks_bc = 0.0_dp
19928 p_bd = pbd((md - 1)*15 + mb)
19929 p_bc = pbc((mc - 1)*15 + mb)
19930 DO ma = 1, 5
19931 p_index = p_index + 1
19932 tmp = scale*prim(p_index)
19933 ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma)
19934 ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma)
19935 kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc
19936 kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd
19937 END DO
19938 kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
19939 kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
19940 END DO
19941 END DO
19942 END DO
19943 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 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 kbd(1:1*1) = 0.0_dp
19966 kbc(1:1*1) = 0.0_dp
19967 kad(1:6*1) = 0.0_dp
19968 kac(1:6*1) = 0.0_dp
19969 p_index = 0
19970 DO md = 1, 1
19971 DO mc = 1, 1
19972 DO mb = 1, 1
19973 ks_bd = 0.0_dp
19974 ks_bc = 0.0_dp
19975 p_bd = pbd((md - 1)*1 + mb)
19976 p_bc = pbc((mc - 1)*1 + mb)
19977 DO ma = 1, 6
19978 p_index = p_index + 1
19979 tmp = scale*prim(p_index)
19980 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
19981 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
19982 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
19983 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
19984 END DO
19985 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
19986 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
19987 END DO
19988 END DO
19989 END DO
19990 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 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 kbd(1:1*2) = 0.0_dp
20013 kbc(1:1*1) = 0.0_dp
20014 kad(1:6*2) = 0.0_dp
20015 kac(1:6*1) = 0.0_dp
20016 p_index = 0
20017 DO md = 1, 2
20018 DO mc = 1, 1
20019 DO mb = 1, 1
20020 ks_bd = 0.0_dp
20021 ks_bc = 0.0_dp
20022 p_bd = pbd((md - 1)*1 + mb)
20023 p_bc = pbc((mc - 1)*1 + mb)
20024 DO ma = 1, 6
20025 p_index = p_index + 1
20026 tmp = scale*prim(p_index)
20027 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20028 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20029 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20030 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20031 END DO
20032 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
20033 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
20034 END DO
20035 END DO
20036 END DO
20037 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 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 kbd(1:1*3) = 0.0_dp
20060 kbc(1:1*1) = 0.0_dp
20061 kad(1:6*3) = 0.0_dp
20062 kac(1:6*1) = 0.0_dp
20063 p_index = 0
20064 DO md = 1, 3
20065 DO mc = 1, 1
20066 DO mb = 1, 1
20067 ks_bd = 0.0_dp
20068 ks_bc = 0.0_dp
20069 p_bd = pbd((md - 1)*1 + mb)
20070 p_bc = pbc((mc - 1)*1 + mb)
20071 DO ma = 1, 6
20072 p_index = p_index + 1
20073 tmp = scale*prim(p_index)
20074 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20075 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20076 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20077 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20078 END DO
20079 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
20080 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
20081 END DO
20082 END DO
20083 END DO
20084 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 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 kbd(1:1*md_max) = 0.0_dp
20108 kbc(1:1*1) = 0.0_dp
20109 kad(1:6*md_max) = 0.0_dp
20110 kac(1:6*1) = 0.0_dp
20111 p_index = 0
20112 DO md = 1, md_max
20113 DO mc = 1, 1
20114 DO mb = 1, 1
20115 ks_bd = 0.0_dp
20116 ks_bc = 0.0_dp
20117 p_bd = pbd((md - 1)*1 + mb)
20118 p_bc = pbc((mc - 1)*1 + mb)
20119 DO ma = 1, 6
20120 p_index = p_index + 1
20121 tmp = scale*prim(p_index)
20122 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20123 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20124 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20125 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20126 END DO
20127 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
20128 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
20129 END DO
20130 END DO
20131 END DO
20132 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 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 kbd(1:1*1) = 0.0_dp
20155 kbc(1:1*2) = 0.0_dp
20156 kad(1:6*1) = 0.0_dp
20157 kac(1:6*2) = 0.0_dp
20158 p_index = 0
20159 DO md = 1, 1
20160 DO mc = 1, 2
20161 DO mb = 1, 1
20162 ks_bd = 0.0_dp
20163 ks_bc = 0.0_dp
20164 p_bd = pbd((md - 1)*1 + mb)
20165 p_bc = pbc((mc - 1)*1 + mb)
20166 DO ma = 1, 6
20167 p_index = p_index + 1
20168 tmp = scale*prim(p_index)
20169 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20170 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20171 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20172 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20173 END DO
20174 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
20175 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
20176 END DO
20177 END DO
20178 END DO
20179 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 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 kbd(1:1*md_max) = 0.0_dp
20203 kbc(1:1*2) = 0.0_dp
20204 kad(1:6*md_max) = 0.0_dp
20205 kac(1:6*2) = 0.0_dp
20206 p_index = 0
20207 DO md = 1, md_max
20208 DO mc = 1, 2
20209 DO mb = 1, 1
20210 ks_bd = 0.0_dp
20211 ks_bc = 0.0_dp
20212 p_bd = pbd((md - 1)*1 + mb)
20213 p_bc = pbc((mc - 1)*1 + mb)
20214 DO ma = 1, 6
20215 p_index = p_index + 1
20216 tmp = scale*prim(p_index)
20217 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20218 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20219 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20220 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20221 END DO
20222 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
20223 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
20224 END DO
20225 END DO
20226 END DO
20227 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 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 kbd(1:1*1) = 0.0_dp
20250 kbc(1:1*3) = 0.0_dp
20251 kad(1:6*1) = 0.0_dp
20252 kac(1:6*3) = 0.0_dp
20253 p_index = 0
20254 DO md = 1, 1
20255 DO mc = 1, 3
20256 DO mb = 1, 1
20257 ks_bd = 0.0_dp
20258 ks_bc = 0.0_dp
20259 p_bd = pbd((md - 1)*1 + mb)
20260 p_bc = pbc((mc - 1)*1 + mb)
20261 DO ma = 1, 6
20262 p_index = p_index + 1
20263 tmp = scale*prim(p_index)
20264 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20265 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20266 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20267 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20268 END DO
20269 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
20270 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
20271 END DO
20272 END DO
20273 END DO
20274 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 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 kbd(1:1*md_max) = 0.0_dp
20298 kbc(1:1*3) = 0.0_dp
20299 kad(1:6*md_max) = 0.0_dp
20300 kac(1:6*3) = 0.0_dp
20301 p_index = 0
20302 DO md = 1, md_max
20303 DO mc = 1, 3
20304 DO mb = 1, 1
20305 ks_bd = 0.0_dp
20306 ks_bc = 0.0_dp
20307 p_bd = pbd((md - 1)*1 + mb)
20308 p_bc = pbc((mc - 1)*1 + mb)
20309 DO ma = 1, 6
20310 p_index = p_index + 1
20311 tmp = scale*prim(p_index)
20312 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20313 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20314 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20315 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20316 END DO
20317 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
20318 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
20319 END DO
20320 END DO
20321 END DO
20322 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 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 kbd(1:1*md_max) = 0.0_dp
20347 kbc(1:1*mc_max) = 0.0_dp
20348 kad(1:6*md_max) = 0.0_dp
20349 kac(1:6*mc_max) = 0.0_dp
20350 p_index = 0
20351 DO md = 1, md_max
20352 DO mc = 1, mc_max
20353 DO mb = 1, 1
20354 ks_bd = 0.0_dp
20355 ks_bc = 0.0_dp
20356 p_bd = pbd((md - 1)*1 + mb)
20357 p_bc = pbc((mc - 1)*1 + mb)
20358 DO ma = 1, 6
20359 p_index = p_index + 1
20360 tmp = scale*prim(p_index)
20361 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20362 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20363 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20364 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20365 END DO
20366 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
20367 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
20368 END DO
20369 END DO
20370 END DO
20371 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 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 kbd(1:2*1) = 0.0_dp
20394 kbc(1:2*1) = 0.0_dp
20395 kad(1:6*1) = 0.0_dp
20396 kac(1:6*1) = 0.0_dp
20397 p_index = 0
20398 DO md = 1, 1
20399 DO mc = 1, 1
20400 DO mb = 1, 2
20401 ks_bd = 0.0_dp
20402 ks_bc = 0.0_dp
20403 p_bd = pbd((md - 1)*2 + mb)
20404 p_bc = pbc((mc - 1)*2 + mb)
20405 DO ma = 1, 6
20406 p_index = p_index + 1
20407 tmp = scale*prim(p_index)
20408 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20409 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20410 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20411 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20412 END DO
20413 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
20414 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
20415 END DO
20416 END DO
20417 END DO
20418 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 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 kbd(1:2*md_max) = 0.0_dp
20442 kbc(1:2*1) = 0.0_dp
20443 kad(1:6*md_max) = 0.0_dp
20444 kac(1:6*1) = 0.0_dp
20445 p_index = 0
20446 DO md = 1, md_max
20447 DO mc = 1, 1
20448 DO mb = 1, 2
20449 ks_bd = 0.0_dp
20450 ks_bc = 0.0_dp
20451 p_bd = pbd((md - 1)*2 + mb)
20452 p_bc = pbc((mc - 1)*2 + mb)
20453 DO ma = 1, 6
20454 p_index = p_index + 1
20455 tmp = scale*prim(p_index)
20456 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20457 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20458 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20459 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20460 END DO
20461 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
20462 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
20463 END DO
20464 END DO
20465 END DO
20466 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 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 kbd(1:2*md_max) = 0.0_dp
20491 kbc(1:2*mc_max) = 0.0_dp
20492 kad(1:6*md_max) = 0.0_dp
20493 kac(1:6*mc_max) = 0.0_dp
20494 p_index = 0
20495 DO md = 1, md_max
20496 DO mc = 1, mc_max
20497 DO mb = 1, 2
20498 ks_bd = 0.0_dp
20499 ks_bc = 0.0_dp
20500 p_bd = pbd((md - 1)*2 + mb)
20501 p_bc = pbc((mc - 1)*2 + mb)
20502 DO ma = 1, 6
20503 p_index = p_index + 1
20504 tmp = scale*prim(p_index)
20505 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20506 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20507 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20508 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20509 END DO
20510 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
20511 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
20512 END DO
20513 END DO
20514 END DO
20515 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 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 kbd(1:3*1) = 0.0_dp
20538 kbc(1:3*1) = 0.0_dp
20539 kad(1:6*1) = 0.0_dp
20540 kac(1:6*1) = 0.0_dp
20541 p_index = 0
20542 DO md = 1, 1
20543 DO mc = 1, 1
20544 DO mb = 1, 3
20545 ks_bd = 0.0_dp
20546 ks_bc = 0.0_dp
20547 p_bd = pbd((md - 1)*3 + mb)
20548 p_bc = pbc((mc - 1)*3 + mb)
20549 DO ma = 1, 6
20550 p_index = p_index + 1
20551 tmp = scale*prim(p_index)
20552 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20553 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20554 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20555 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20556 END DO
20557 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
20558 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
20559 END DO
20560 END DO
20561 END DO
20562 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 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 kbd(1:3*md_max) = 0.0_dp
20586 kbc(1:3*1) = 0.0_dp
20587 kad(1:6*md_max) = 0.0_dp
20588 kac(1:6*1) = 0.0_dp
20589 p_index = 0
20590 DO md = 1, md_max
20591 DO mc = 1, 1
20592 DO mb = 1, 3
20593 ks_bd = 0.0_dp
20594 ks_bc = 0.0_dp
20595 p_bd = pbd((md - 1)*3 + mb)
20596 p_bc = pbc((mc - 1)*3 + mb)
20597 DO ma = 1, 6
20598 p_index = p_index + 1
20599 tmp = scale*prim(p_index)
20600 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20601 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20602 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20603 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20604 END DO
20605 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
20606 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
20607 END DO
20608 END DO
20609 END DO
20610 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 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 kbd(1:3*md_max) = 0.0_dp
20635 kbc(1:3*mc_max) = 0.0_dp
20636 kad(1:6*md_max) = 0.0_dp
20637 kac(1:6*mc_max) = 0.0_dp
20638 p_index = 0
20639 DO md = 1, md_max
20640 DO mc = 1, mc_max
20641 DO mb = 1, 3
20642 ks_bd = 0.0_dp
20643 ks_bc = 0.0_dp
20644 p_bd = pbd((md - 1)*3 + mb)
20645 p_bc = pbc((mc - 1)*3 + mb)
20646 DO ma = 1, 6
20647 p_index = p_index + 1
20648 tmp = scale*prim(p_index)
20649 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20650 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20651 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20652 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20653 END DO
20654 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
20655 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
20656 END DO
20657 END DO
20658 END DO
20659 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 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 kbd(1:4*md_max) = 0.0_dp
20684 kbc(1:4*mc_max) = 0.0_dp
20685 kad(1:6*md_max) = 0.0_dp
20686 kac(1:6*mc_max) = 0.0_dp
20687 p_index = 0
20688 DO md = 1, md_max
20689 DO mc = 1, mc_max
20690 DO mb = 1, 4
20691 ks_bd = 0.0_dp
20692 ks_bc = 0.0_dp
20693 p_bd = pbd((md - 1)*4 + mb)
20694 p_bc = pbc((mc - 1)*4 + mb)
20695 DO ma = 1, 6
20696 p_index = p_index + 1
20697 tmp = scale*prim(p_index)
20698 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20699 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20700 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20701 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20702 END DO
20703 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
20704 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
20705 END DO
20706 END DO
20707 END DO
20708 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 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 kbd(1:5*md_max) = 0.0_dp
20733 kbc(1:5*mc_max) = 0.0_dp
20734 kad(1:6*md_max) = 0.0_dp
20735 kac(1:6*mc_max) = 0.0_dp
20736 p_index = 0
20737 DO md = 1, md_max
20738 DO mc = 1, mc_max
20739 DO mb = 1, 5
20740 ks_bd = 0.0_dp
20741 ks_bc = 0.0_dp
20742 p_bd = pbd((md - 1)*5 + mb)
20743 p_bc = pbc((mc - 1)*5 + mb)
20744 DO ma = 1, 6
20745 p_index = p_index + 1
20746 tmp = scale*prim(p_index)
20747 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20748 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20749 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20750 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20751 END DO
20752 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
20753 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
20754 END DO
20755 END DO
20756 END DO
20757 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 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 kbd(1:6*md_max) = 0.0_dp
20782 kbc(1:6*mc_max) = 0.0_dp
20783 kad(1:6*md_max) = 0.0_dp
20784 kac(1:6*mc_max) = 0.0_dp
20785 p_index = 0
20786 DO md = 1, md_max
20787 DO mc = 1, mc_max
20788 DO mb = 1, 6
20789 ks_bd = 0.0_dp
20790 ks_bc = 0.0_dp
20791 p_bd = pbd((md - 1)*6 + mb)
20792 p_bc = pbc((mc - 1)*6 + mb)
20793 DO ma = 1, 6
20794 p_index = p_index + 1
20795 tmp = scale*prim(p_index)
20796 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20797 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20798 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20799 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20800 END DO
20801 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
20802 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
20803 END DO
20804 END DO
20805 END DO
20806 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 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 kbd(1:7*md_max) = 0.0_dp
20831 kbc(1:7*mc_max) = 0.0_dp
20832 kad(1:6*md_max) = 0.0_dp
20833 kac(1:6*mc_max) = 0.0_dp
20834 p_index = 0
20835 DO md = 1, md_max
20836 DO mc = 1, mc_max
20837 DO mb = 1, 7
20838 ks_bd = 0.0_dp
20839 ks_bc = 0.0_dp
20840 p_bd = pbd((md - 1)*7 + mb)
20841 p_bc = pbc((mc - 1)*7 + mb)
20842 DO ma = 1, 6
20843 p_index = p_index + 1
20844 tmp = scale*prim(p_index)
20845 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20846 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20847 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20848 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20849 END DO
20850 kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
20851 kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
20852 END DO
20853 END DO
20854 END DO
20855 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 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 kbd(1:9*md_max) = 0.0_dp
20880 kbc(1:9*mc_max) = 0.0_dp
20881 kad(1:6*md_max) = 0.0_dp
20882 kac(1:6*mc_max) = 0.0_dp
20883 p_index = 0
20884 DO md = 1, md_max
20885 DO mc = 1, mc_max
20886 DO mb = 1, 9
20887 ks_bd = 0.0_dp
20888 ks_bc = 0.0_dp
20889 p_bd = pbd((md - 1)*9 + mb)
20890 p_bc = pbc((mc - 1)*9 + mb)
20891 DO ma = 1, 6
20892 p_index = p_index + 1
20893 tmp = scale*prim(p_index)
20894 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20895 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20896 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20897 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20898 END DO
20899 kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
20900 kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
20901 END DO
20902 END DO
20903 END DO
20904 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 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 kbd(1:10*md_max) = 0.0_dp
20930 kbc(1:10*mc_max) = 0.0_dp
20931 kad(1:6*md_max) = 0.0_dp
20932 kac(1:6*mc_max) = 0.0_dp
20933 p_index = 0
20934 DO md = 1, md_max
20935 DO mc = 1, mc_max
20936 DO mb = 1, 10
20937 ks_bd = 0.0_dp
20938 ks_bc = 0.0_dp
20939 p_bd = pbd((md - 1)*10 + mb)
20940 p_bc = pbc((mc - 1)*10 + mb)
20941 DO ma = 1, 6
20942 p_index = p_index + 1
20943 tmp = scale*prim(p_index)
20944 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20945 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20946 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20947 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20948 END DO
20949 kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
20950 kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
20951 END DO
20952 END DO
20953 END DO
20954 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 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 kbd(1:11*md_max) = 0.0_dp
20980 kbc(1:11*mc_max) = 0.0_dp
20981 kad(1:6*md_max) = 0.0_dp
20982 kac(1:6*mc_max) = 0.0_dp
20983 p_index = 0
20984 DO md = 1, md_max
20985 DO mc = 1, mc_max
20986 DO mb = 1, 11
20987 ks_bd = 0.0_dp
20988 ks_bc = 0.0_dp
20989 p_bd = pbd((md - 1)*11 + mb)
20990 p_bc = pbc((mc - 1)*11 + mb)
20991 DO ma = 1, 6
20992 p_index = p_index + 1
20993 tmp = scale*prim(p_index)
20994 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
20995 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
20996 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
20997 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
20998 END DO
20999 kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
21000 kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
21001 END DO
21002 END DO
21003 END DO
21004 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 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 kbd(1:15*md_max) = 0.0_dp
21030 kbc(1:15*mc_max) = 0.0_dp
21031 kad(1:6*md_max) = 0.0_dp
21032 kac(1:6*mc_max) = 0.0_dp
21033 p_index = 0
21034 DO md = 1, md_max
21035 DO mc = 1, mc_max
21036 DO mb = 1, 15
21037 ks_bd = 0.0_dp
21038 ks_bc = 0.0_dp
21039 p_bd = pbd((md - 1)*15 + mb)
21040 p_bc = pbc((mc - 1)*15 + mb)
21041 DO ma = 1, 6
21042 p_index = p_index + 1
21043 tmp = scale*prim(p_index)
21044 ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma)
21045 ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma)
21046 kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc
21047 kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd
21048 END DO
21049 kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
21050 kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
21051 END DO
21052 END DO
21053 END DO
21054 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 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 kbd(1:1*1) = 0.0_dp
21077 kbc(1:1*1) = 0.0_dp
21078 kad(1:7*1) = 0.0_dp
21079 kac(1:7*1) = 0.0_dp
21080 p_index = 0
21081 DO md = 1, 1
21082 DO mc = 1, 1
21083 DO mb = 1, 1
21084 ks_bd = 0.0_dp
21085 ks_bc = 0.0_dp
21086 p_bd = pbd((md - 1)*1 + mb)
21087 p_bc = pbc((mc - 1)*1 + mb)
21088 DO ma = 1, 7
21089 p_index = p_index + 1
21090 tmp = scale*prim(p_index)
21091 ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21092 ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21093 kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21094 kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21095 END DO
21096 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
21097 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
21098 END DO
21099 END DO
21100 END DO
21101 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 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 kbd(1:1*2) = 0.0_dp
21124 kbc(1:1*1) = 0.0_dp
21125 kad(1:7*2) = 0.0_dp
21126 kac(1:7*1) = 0.0_dp
21127 p_index = 0
21128 DO md = 1, 2
21129 DO mc = 1, 1
21130 DO mb = 1, 1
21131 ks_bd = 0.0_dp
21132 ks_bc = 0.0_dp
21133 p_bd = pbd((md - 1)*1 + mb)
21134 p_bc = pbc((mc - 1)*1 + mb)
21135 DO ma = 1, 7
21136 p_index = p_index + 1
21137 tmp = scale*prim(p_index)
21138 ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21139 ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21140 kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21141 kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21142 END DO
21143 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
21144 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
21145 END DO
21146 END DO
21147 END DO
21148 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 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 kbd(1:1*md_max) = 0.0_dp
21172 kbc(1:1*1) = 0.0_dp
21173 kad(1:7*md_max) = 0.0_dp
21174 kac(1:7*1) = 0.0_dp
21175 p_index = 0
21176 DO md = 1, md_max
21177 DO mc = 1, 1
21178 DO mb = 1, 1
21179 ks_bd = 0.0_dp
21180 ks_bc = 0.0_dp
21181 p_bd = pbd((md - 1)*1 + mb)
21182 p_bc = pbc((mc - 1)*1 + mb)
21183 DO ma = 1, 7
21184 p_index = p_index + 1
21185 tmp = scale*prim(p_index)
21186 ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21187 ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21188 kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21189 kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21190 END DO
21191 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
21192 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
21193 END DO
21194 END DO
21195 END DO
21196 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 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 kbd(1:1*1) = 0.0_dp
21219 kbc(1:1*2) = 0.0_dp
21220 kad(1:7*1) = 0.0_dp
21221 kac(1:7*2) = 0.0_dp
21222 p_index = 0
21223 DO md = 1, 1
21224 DO mc = 1, 2
21225 DO mb = 1, 1
21226 ks_bd = 0.0_dp
21227 ks_bc = 0.0_dp
21228 p_bd = pbd((md - 1)*1 + mb)
21229 p_bc = pbc((mc - 1)*1 + mb)
21230 DO ma = 1, 7
21231 p_index = p_index + 1
21232 tmp = scale*prim(p_index)
21233 ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21234 ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21235 kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21236 kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21237 END DO
21238 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
21239 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
21240 END DO
21241 END DO
21242 END DO
21243 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 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 kbd(1:1*md_max) = 0.0_dp
21267 kbc(1:1*2) = 0.0_dp
21268 kad(1:7*md_max) = 0.0_dp
21269 kac(1:7*2) = 0.0_dp
21270 p_index = 0
21271 DO md = 1, md_max
21272 DO mc = 1, 2
21273 DO mb = 1, 1
21274 ks_bd = 0.0_dp
21275 ks_bc = 0.0_dp
21276 p_bd = pbd((md - 1)*1 + mb)
21277 p_bc = pbc((mc - 1)*1 + mb)
21278 DO ma = 1, 7
21279 p_index = p_index + 1
21280 tmp = scale*prim(p_index)
21281 ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21282 ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21283 kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21284 kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21285 END DO
21286 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
21287 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
21288 END DO
21289 END DO
21290 END DO
21291 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 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 kbd(1:1*md_max) = 0.0_dp
21316 kbc(1:1*mc_max) = 0.0_dp
21317 kad(1:7*md_max) = 0.0_dp
21318 kac(1:7*mc_max) = 0.0_dp
21319 p_index = 0
21320 DO md = 1, md_max
21321 DO mc = 1, mc_max
21322 DO mb = 1, 1
21323 ks_bd = 0.0_dp
21324 ks_bc = 0.0_dp
21325 p_bd = pbd((md - 1)*1 + mb)
21326 p_bc = pbc((mc - 1)*1 + mb)
21327 DO ma = 1, 7
21328 p_index = p_index + 1
21329 tmp = scale*prim(p_index)
21330 ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21331 ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21332 kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21333 kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21334 END DO
21335 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
21336 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
21337 END DO
21338 END DO
21339 END DO
21340 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 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 kbd(1:2*1) = 0.0_dp
21363 kbc(1:2*1) = 0.0_dp
21364 kad(1:7*1) = 0.0_dp
21365 kac(1:7*1) = 0.0_dp
21366 p_index = 0
21367 DO md = 1, 1
21368 DO mc = 1, 1
21369 DO mb = 1, 2
21370 ks_bd = 0.0_dp
21371 ks_bc = 0.0_dp
21372 p_bd = pbd((md - 1)*2 + mb)
21373 p_bc = pbc((mc - 1)*2 + mb)
21374 DO ma = 1, 7
21375 p_index = p_index + 1
21376 tmp = scale*prim(p_index)
21377 ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21378 ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21379 kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21380 kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21381 END DO
21382 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
21383 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
21384 END DO
21385 END DO
21386 END DO
21387 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 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 kbd(1:2*md_max) = 0.0_dp
21411 kbc(1:2*1) = 0.0_dp
21412 kad(1:7*md_max) = 0.0_dp
21413 kac(1:7*1) = 0.0_dp
21414 p_index = 0
21415 DO md = 1, md_max
21416 DO mc = 1, 1
21417 DO mb = 1, 2
21418 ks_bd = 0.0_dp
21419 ks_bc = 0.0_dp
21420 p_bd = pbd((md - 1)*2 + mb)
21421 p_bc = pbc((mc - 1)*2 + mb)
21422 DO ma = 1, 7
21423 p_index = p_index + 1
21424 tmp = scale*prim(p_index)
21425 ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21426 ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21427 kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21428 kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21429 END DO
21430 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
21431 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
21432 END DO
21433 END DO
21434 END DO
21435 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 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 kbd(1:2*md_max) = 0.0_dp
21460 kbc(1:2*mc_max) = 0.0_dp
21461 kad(1:7*md_max) = 0.0_dp
21462 kac(1:7*mc_max) = 0.0_dp
21463 p_index = 0
21464 DO md = 1, md_max
21465 DO mc = 1, mc_max
21466 DO mb = 1, 2
21467 ks_bd = 0.0_dp
21468 ks_bc = 0.0_dp
21469 p_bd = pbd((md - 1)*2 + mb)
21470 p_bc = pbc((mc - 1)*2 + mb)
21471 DO ma = 1, 7
21472 p_index = p_index + 1
21473 tmp = scale*prim(p_index)
21474 ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21475 ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21476 kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21477 kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21478 END DO
21479 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
21480 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
21481 END DO
21482 END DO
21483 END DO
21484 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 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 kbd(1:3*md_max) = 0.0_dp
21509 kbc(1:3*mc_max) = 0.0_dp
21510 kad(1:7*md_max) = 0.0_dp
21511 kac(1:7*mc_max) = 0.0_dp
21512 p_index = 0
21513 DO md = 1, md_max
21514 DO mc = 1, mc_max
21515 DO mb = 1, 3
21516 ks_bd = 0.0_dp
21517 ks_bc = 0.0_dp
21518 p_bd = pbd((md - 1)*3 + mb)
21519 p_bc = pbc((mc - 1)*3 + mb)
21520 DO ma = 1, 7
21521 p_index = p_index + 1
21522 tmp = scale*prim(p_index)
21523 ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21524 ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21525 kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21526 kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21527 END DO
21528 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
21529 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
21530 END DO
21531 END DO
21532 END DO
21533 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 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 kbd(1:4*md_max) = 0.0_dp
21558 kbc(1:4*mc_max) = 0.0_dp
21559 kad(1:7*md_max) = 0.0_dp
21560 kac(1:7*mc_max) = 0.0_dp
21561 p_index = 0
21562 DO md = 1, md_max
21563 DO mc = 1, mc_max
21564 DO mb = 1, 4
21565 ks_bd = 0.0_dp
21566 ks_bc = 0.0_dp
21567 p_bd = pbd((md - 1)*4 + mb)
21568 p_bc = pbc((mc - 1)*4 + mb)
21569 DO ma = 1, 7
21570 p_index = p_index + 1
21571 tmp = scale*prim(p_index)
21572 ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21573 ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21574 kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21575 kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21576 END DO
21577 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
21578 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
21579 END DO
21580 END DO
21581 END DO
21582 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 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 kbd(1:5*md_max) = 0.0_dp
21607 kbc(1:5*mc_max) = 0.0_dp
21608 kad(1:7*md_max) = 0.0_dp
21609 kac(1:7*mc_max) = 0.0_dp
21610 p_index = 0
21611 DO md = 1, md_max
21612 DO mc = 1, mc_max
21613 DO mb = 1, 5
21614 ks_bd = 0.0_dp
21615 ks_bc = 0.0_dp
21616 p_bd = pbd((md - 1)*5 + mb)
21617 p_bc = pbc((mc - 1)*5 + mb)
21618 DO ma = 1, 7
21619 p_index = p_index + 1
21620 tmp = scale*prim(p_index)
21621 ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21622 ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21623 kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21624 kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21625 END DO
21626 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
21627 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
21628 END DO
21629 END DO
21630 END DO
21631 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 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 kbd(1:6*md_max) = 0.0_dp
21656 kbc(1:6*mc_max) = 0.0_dp
21657 kad(1:7*md_max) = 0.0_dp
21658 kac(1:7*mc_max) = 0.0_dp
21659 p_index = 0
21660 DO md = 1, md_max
21661 DO mc = 1, mc_max
21662 DO mb = 1, 6
21663 ks_bd = 0.0_dp
21664 ks_bc = 0.0_dp
21665 p_bd = pbd((md - 1)*6 + mb)
21666 p_bc = pbc((mc - 1)*6 + mb)
21667 DO ma = 1, 7
21668 p_index = p_index + 1
21669 tmp = scale*prim(p_index)
21670 ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21671 ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21672 kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21673 kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21674 END DO
21675 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
21676 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
21677 END DO
21678 END DO
21679 END DO
21680 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 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 kbd(1:7*md_max) = 0.0_dp
21705 kbc(1:7*mc_max) = 0.0_dp
21706 kad(1:7*md_max) = 0.0_dp
21707 kac(1:7*mc_max) = 0.0_dp
21708 p_index = 0
21709 DO md = 1, md_max
21710 DO mc = 1, mc_max
21711 DO mb = 1, 7
21712 ks_bd = 0.0_dp
21713 ks_bc = 0.0_dp
21714 p_bd = pbd((md - 1)*7 + mb)
21715 p_bc = pbc((mc - 1)*7 + mb)
21716 DO ma = 1, 7
21717 p_index = p_index + 1
21718 tmp = scale*prim(p_index)
21719 ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21720 ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21721 kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21722 kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21723 END DO
21724 kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
21725 kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
21726 END DO
21727 END DO
21728 END DO
21729 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 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 kbd(1:9*md_max) = 0.0_dp
21754 kbc(1:9*mc_max) = 0.0_dp
21755 kad(1:7*md_max) = 0.0_dp
21756 kac(1:7*mc_max) = 0.0_dp
21757 p_index = 0
21758 DO md = 1, md_max
21759 DO mc = 1, mc_max
21760 DO mb = 1, 9
21761 ks_bd = 0.0_dp
21762 ks_bc = 0.0_dp
21763 p_bd = pbd((md - 1)*9 + mb)
21764 p_bc = pbc((mc - 1)*9 + mb)
21765 DO ma = 1, 7
21766 p_index = p_index + 1
21767 tmp = scale*prim(p_index)
21768 ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21769 ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21770 kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21771 kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21772 END DO
21773 kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
21774 kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
21775 END DO
21776 END DO
21777 END DO
21778 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 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 kbd(1:10*md_max) = 0.0_dp
21804 kbc(1:10*mc_max) = 0.0_dp
21805 kad(1:7*md_max) = 0.0_dp
21806 kac(1:7*mc_max) = 0.0_dp
21807 p_index = 0
21808 DO md = 1, md_max
21809 DO mc = 1, mc_max
21810 DO mb = 1, 10
21811 ks_bd = 0.0_dp
21812 ks_bc = 0.0_dp
21813 p_bd = pbd((md - 1)*10 + mb)
21814 p_bc = pbc((mc - 1)*10 + mb)
21815 DO ma = 1, 7
21816 p_index = p_index + 1
21817 tmp = scale*prim(p_index)
21818 ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21819 ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21820 kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21821 kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21822 END DO
21823 kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
21824 kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
21825 END DO
21826 END DO
21827 END DO
21828 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 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 kbd(1:11*md_max) = 0.0_dp
21854 kbc(1:11*mc_max) = 0.0_dp
21855 kad(1:7*md_max) = 0.0_dp
21856 kac(1:7*mc_max) = 0.0_dp
21857 p_index = 0
21858 DO md = 1, md_max
21859 DO mc = 1, mc_max
21860 DO mb = 1, 11
21861 ks_bd = 0.0_dp
21862 ks_bc = 0.0_dp
21863 p_bd = pbd((md - 1)*11 + mb)
21864 p_bc = pbc((mc - 1)*11 + mb)
21865 DO ma = 1, 7
21866 p_index = p_index + 1
21867 tmp = scale*prim(p_index)
21868 ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21869 ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21870 kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21871 kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21872 END DO
21873 kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
21874 kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
21875 END DO
21876 END DO
21877 END DO
21878 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 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 kbd(1:15*md_max) = 0.0_dp
21904 kbc(1:15*mc_max) = 0.0_dp
21905 kad(1:7*md_max) = 0.0_dp
21906 kac(1:7*mc_max) = 0.0_dp
21907 p_index = 0
21908 DO md = 1, md_max
21909 DO mc = 1, mc_max
21910 DO mb = 1, 15
21911 ks_bd = 0.0_dp
21912 ks_bc = 0.0_dp
21913 p_bd = pbd((md - 1)*15 + mb)
21914 p_bc = pbc((mc - 1)*15 + mb)
21915 DO ma = 1, 7
21916 p_index = p_index + 1
21917 tmp = scale*prim(p_index)
21918 ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma)
21919 ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma)
21920 kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc
21921 kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd
21922 END DO
21923 kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
21924 kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
21925 END DO
21926 END DO
21927 END DO
21928 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 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 kbd(1:1*1) = 0.0_dp
21951 kbc(1:1*1) = 0.0_dp
21952 kad(1:9*1) = 0.0_dp
21953 kac(1:9*1) = 0.0_dp
21954 p_index = 0
21955 DO md = 1, 1
21956 DO mc = 1, 1
21957 DO mb = 1, 1
21958 ks_bd = 0.0_dp
21959 ks_bc = 0.0_dp
21960 p_bd = pbd((md - 1)*1 + mb)
21961 p_bc = pbc((mc - 1)*1 + mb)
21962 DO ma = 1, 9
21963 p_index = p_index + 1
21964 tmp = scale*prim(p_index)
21965 ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
21966 ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
21967 kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
21968 kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
21969 END DO
21970 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
21971 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
21972 END DO
21973 END DO
21974 END DO
21975 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 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 kbd(1:1*2) = 0.0_dp
21998 kbc(1:1*1) = 0.0_dp
21999 kad(1:9*2) = 0.0_dp
22000 kac(1:9*1) = 0.0_dp
22001 p_index = 0
22002 DO md = 1, 2
22003 DO mc = 1, 1
22004 DO mb = 1, 1
22005 ks_bd = 0.0_dp
22006 ks_bc = 0.0_dp
22007 p_bd = pbd((md - 1)*1 + mb)
22008 p_bc = pbc((mc - 1)*1 + mb)
22009 DO ma = 1, 9
22010 p_index = p_index + 1
22011 tmp = scale*prim(p_index)
22012 ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22013 ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22014 kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22015 kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22016 END DO
22017 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
22018 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
22019 END DO
22020 END DO
22021 END DO
22022 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 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 kbd(1:1*md_max) = 0.0_dp
22046 kbc(1:1*1) = 0.0_dp
22047 kad(1:9*md_max) = 0.0_dp
22048 kac(1:9*1) = 0.0_dp
22049 p_index = 0
22050 DO md = 1, md_max
22051 DO mc = 1, 1
22052 DO mb = 1, 1
22053 ks_bd = 0.0_dp
22054 ks_bc = 0.0_dp
22055 p_bd = pbd((md - 1)*1 + mb)
22056 p_bc = pbc((mc - 1)*1 + mb)
22057 DO ma = 1, 9
22058 p_index = p_index + 1
22059 tmp = scale*prim(p_index)
22060 ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22061 ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22062 kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22063 kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22064 END DO
22065 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
22066 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
22067 END DO
22068 END DO
22069 END DO
22070 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 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 kbd(1:1*1) = 0.0_dp
22093 kbc(1:1*2) = 0.0_dp
22094 kad(1:9*1) = 0.0_dp
22095 kac(1:9*2) = 0.0_dp
22096 p_index = 0
22097 DO md = 1, 1
22098 DO mc = 1, 2
22099 DO mb = 1, 1
22100 ks_bd = 0.0_dp
22101 ks_bc = 0.0_dp
22102 p_bd = pbd((md - 1)*1 + mb)
22103 p_bc = pbc((mc - 1)*1 + mb)
22104 DO ma = 1, 9
22105 p_index = p_index + 1
22106 tmp = scale*prim(p_index)
22107 ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22108 ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22109 kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22110 kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22111 END DO
22112 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
22113 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
22114 END DO
22115 END DO
22116 END DO
22117 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 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 kbd(1:1*md_max) = 0.0_dp
22141 kbc(1:1*2) = 0.0_dp
22142 kad(1:9*md_max) = 0.0_dp
22143 kac(1:9*2) = 0.0_dp
22144 p_index = 0
22145 DO md = 1, md_max
22146 DO mc = 1, 2
22147 DO mb = 1, 1
22148 ks_bd = 0.0_dp
22149 ks_bc = 0.0_dp
22150 p_bd = pbd((md - 1)*1 + mb)
22151 p_bc = pbc((mc - 1)*1 + mb)
22152 DO ma = 1, 9
22153 p_index = p_index + 1
22154 tmp = scale*prim(p_index)
22155 ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22156 ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22157 kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22158 kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22159 END DO
22160 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
22161 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
22162 END DO
22163 END DO
22164 END DO
22165 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 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 kbd(1:1*md_max) = 0.0_dp
22190 kbc(1:1*mc_max) = 0.0_dp
22191 kad(1:9*md_max) = 0.0_dp
22192 kac(1:9*mc_max) = 0.0_dp
22193 p_index = 0
22194 DO md = 1, md_max
22195 DO mc = 1, mc_max
22196 DO mb = 1, 1
22197 ks_bd = 0.0_dp
22198 ks_bc = 0.0_dp
22199 p_bd = pbd((md - 1)*1 + mb)
22200 p_bc = pbc((mc - 1)*1 + mb)
22201 DO ma = 1, 9
22202 p_index = p_index + 1
22203 tmp = scale*prim(p_index)
22204 ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22205 ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22206 kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22207 kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22208 END DO
22209 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
22210 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
22211 END DO
22212 END DO
22213 END DO
22214 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 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 kbd(1:2*1) = 0.0_dp
22237 kbc(1:2*1) = 0.0_dp
22238 kad(1:9*1) = 0.0_dp
22239 kac(1:9*1) = 0.0_dp
22240 p_index = 0
22241 DO md = 1, 1
22242 DO mc = 1, 1
22243 DO mb = 1, 2
22244 ks_bd = 0.0_dp
22245 ks_bc = 0.0_dp
22246 p_bd = pbd((md - 1)*2 + mb)
22247 p_bc = pbc((mc - 1)*2 + mb)
22248 DO ma = 1, 9
22249 p_index = p_index + 1
22250 tmp = scale*prim(p_index)
22251 ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22252 ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22253 kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22254 kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22255 END DO
22256 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
22257 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
22258 END DO
22259 END DO
22260 END DO
22261 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 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 kbd(1:2*md_max) = 0.0_dp
22285 kbc(1:2*1) = 0.0_dp
22286 kad(1:9*md_max) = 0.0_dp
22287 kac(1:9*1) = 0.0_dp
22288 p_index = 0
22289 DO md = 1, md_max
22290 DO mc = 1, 1
22291 DO mb = 1, 2
22292 ks_bd = 0.0_dp
22293 ks_bc = 0.0_dp
22294 p_bd = pbd((md - 1)*2 + mb)
22295 p_bc = pbc((mc - 1)*2 + mb)
22296 DO ma = 1, 9
22297 p_index = p_index + 1
22298 tmp = scale*prim(p_index)
22299 ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22300 ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22301 kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22302 kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22303 END DO
22304 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
22305 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
22306 END DO
22307 END DO
22308 END DO
22309 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 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 kbd(1:2*md_max) = 0.0_dp
22334 kbc(1:2*mc_max) = 0.0_dp
22335 kad(1:9*md_max) = 0.0_dp
22336 kac(1:9*mc_max) = 0.0_dp
22337 p_index = 0
22338 DO md = 1, md_max
22339 DO mc = 1, mc_max
22340 DO mb = 1, 2
22341 ks_bd = 0.0_dp
22342 ks_bc = 0.0_dp
22343 p_bd = pbd((md - 1)*2 + mb)
22344 p_bc = pbc((mc - 1)*2 + mb)
22345 DO ma = 1, 9
22346 p_index = p_index + 1
22347 tmp = scale*prim(p_index)
22348 ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22349 ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22350 kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22351 kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22352 END DO
22353 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
22354 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
22355 END DO
22356 END DO
22357 END DO
22358 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 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 kbd(1:3*md_max) = 0.0_dp
22383 kbc(1:3*mc_max) = 0.0_dp
22384 kad(1:9*md_max) = 0.0_dp
22385 kac(1:9*mc_max) = 0.0_dp
22386 p_index = 0
22387 DO md = 1, md_max
22388 DO mc = 1, mc_max
22389 DO mb = 1, 3
22390 ks_bd = 0.0_dp
22391 ks_bc = 0.0_dp
22392 p_bd = pbd((md - 1)*3 + mb)
22393 p_bc = pbc((mc - 1)*3 + mb)
22394 DO ma = 1, 9
22395 p_index = p_index + 1
22396 tmp = scale*prim(p_index)
22397 ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22398 ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22399 kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22400 kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22401 END DO
22402 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
22403 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
22404 END DO
22405 END DO
22406 END DO
22407 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 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 kbd(1:4*md_max) = 0.0_dp
22432 kbc(1:4*mc_max) = 0.0_dp
22433 kad(1:9*md_max) = 0.0_dp
22434 kac(1:9*mc_max) = 0.0_dp
22435 p_index = 0
22436 DO md = 1, md_max
22437 DO mc = 1, mc_max
22438 DO mb = 1, 4
22439 ks_bd = 0.0_dp
22440 ks_bc = 0.0_dp
22441 p_bd = pbd((md - 1)*4 + mb)
22442 p_bc = pbc((mc - 1)*4 + mb)
22443 DO ma = 1, 9
22444 p_index = p_index + 1
22445 tmp = scale*prim(p_index)
22446 ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22447 ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22448 kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22449 kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22450 END DO
22451 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
22452 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
22453 END DO
22454 END DO
22455 END DO
22456 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 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 kbd(1:5*md_max) = 0.0_dp
22481 kbc(1:5*mc_max) = 0.0_dp
22482 kad(1:9*md_max) = 0.0_dp
22483 kac(1:9*mc_max) = 0.0_dp
22484 p_index = 0
22485 DO md = 1, md_max
22486 DO mc = 1, mc_max
22487 DO mb = 1, 5
22488 ks_bd = 0.0_dp
22489 ks_bc = 0.0_dp
22490 p_bd = pbd((md - 1)*5 + mb)
22491 p_bc = pbc((mc - 1)*5 + mb)
22492 DO ma = 1, 9
22493 p_index = p_index + 1
22494 tmp = scale*prim(p_index)
22495 ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22496 ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22497 kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22498 kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22499 END DO
22500 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
22501 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
22502 END DO
22503 END DO
22504 END DO
22505 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 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 kbd(1:6*md_max) = 0.0_dp
22530 kbc(1:6*mc_max) = 0.0_dp
22531 kad(1:9*md_max) = 0.0_dp
22532 kac(1:9*mc_max) = 0.0_dp
22533 p_index = 0
22534 DO md = 1, md_max
22535 DO mc = 1, mc_max
22536 DO mb = 1, 6
22537 ks_bd = 0.0_dp
22538 ks_bc = 0.0_dp
22539 p_bd = pbd((md - 1)*6 + mb)
22540 p_bc = pbc((mc - 1)*6 + mb)
22541 DO ma = 1, 9
22542 p_index = p_index + 1
22543 tmp = scale*prim(p_index)
22544 ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22545 ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22546 kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22547 kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22548 END DO
22549 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
22550 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
22551 END DO
22552 END DO
22553 END DO
22554 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 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 kbd(1:7*md_max) = 0.0_dp
22579 kbc(1:7*mc_max) = 0.0_dp
22580 kad(1:9*md_max) = 0.0_dp
22581 kac(1:9*mc_max) = 0.0_dp
22582 p_index = 0
22583 DO md = 1, md_max
22584 DO mc = 1, mc_max
22585 DO mb = 1, 7
22586 ks_bd = 0.0_dp
22587 ks_bc = 0.0_dp
22588 p_bd = pbd((md - 1)*7 + mb)
22589 p_bc = pbc((mc - 1)*7 + mb)
22590 DO ma = 1, 9
22591 p_index = p_index + 1
22592 tmp = scale*prim(p_index)
22593 ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22594 ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22595 kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22596 kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22597 END DO
22598 kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
22599 kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
22600 END DO
22601 END DO
22602 END DO
22603 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 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 kbd(1:9*md_max) = 0.0_dp
22628 kbc(1:9*mc_max) = 0.0_dp
22629 kad(1:9*md_max) = 0.0_dp
22630 kac(1:9*mc_max) = 0.0_dp
22631 p_index = 0
22632 DO md = 1, md_max
22633 DO mc = 1, mc_max
22634 DO mb = 1, 9
22635 ks_bd = 0.0_dp
22636 ks_bc = 0.0_dp
22637 p_bd = pbd((md - 1)*9 + mb)
22638 p_bc = pbc((mc - 1)*9 + mb)
22639 DO ma = 1, 9
22640 p_index = p_index + 1
22641 tmp = scale*prim(p_index)
22642 ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22643 ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22644 kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22645 kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22646 END DO
22647 kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
22648 kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
22649 END DO
22650 END DO
22651 END DO
22652 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 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 kbd(1:10*md_max) = 0.0_dp
22678 kbc(1:10*mc_max) = 0.0_dp
22679 kad(1:9*md_max) = 0.0_dp
22680 kac(1:9*mc_max) = 0.0_dp
22681 p_index = 0
22682 DO md = 1, md_max
22683 DO mc = 1, mc_max
22684 DO mb = 1, 10
22685 ks_bd = 0.0_dp
22686 ks_bc = 0.0_dp
22687 p_bd = pbd((md - 1)*10 + mb)
22688 p_bc = pbc((mc - 1)*10 + mb)
22689 DO ma = 1, 9
22690 p_index = p_index + 1
22691 tmp = scale*prim(p_index)
22692 ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22693 ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22694 kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22695 kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22696 END DO
22697 kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
22698 kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
22699 END DO
22700 END DO
22701 END DO
22702 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 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 kbd(1:11*md_max) = 0.0_dp
22728 kbc(1:11*mc_max) = 0.0_dp
22729 kad(1:9*md_max) = 0.0_dp
22730 kac(1:9*mc_max) = 0.0_dp
22731 p_index = 0
22732 DO md = 1, md_max
22733 DO mc = 1, mc_max
22734 DO mb = 1, 11
22735 ks_bd = 0.0_dp
22736 ks_bc = 0.0_dp
22737 p_bd = pbd((md - 1)*11 + mb)
22738 p_bc = pbc((mc - 1)*11 + mb)
22739 DO ma = 1, 9
22740 p_index = p_index + 1
22741 tmp = scale*prim(p_index)
22742 ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22743 ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22744 kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22745 kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22746 END DO
22747 kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
22748 kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
22749 END DO
22750 END DO
22751 END DO
22752 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 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 kbd(1:15*md_max) = 0.0_dp
22778 kbc(1:15*mc_max) = 0.0_dp
22779 kad(1:9*md_max) = 0.0_dp
22780 kac(1:9*mc_max) = 0.0_dp
22781 p_index = 0
22782 DO md = 1, md_max
22783 DO mc = 1, mc_max
22784 DO mb = 1, 15
22785 ks_bd = 0.0_dp
22786 ks_bc = 0.0_dp
22787 p_bd = pbd((md - 1)*15 + mb)
22788 p_bc = pbc((mc - 1)*15 + mb)
22789 DO ma = 1, 9
22790 p_index = p_index + 1
22791 tmp = scale*prim(p_index)
22792 ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma)
22793 ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma)
22794 kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc
22795 kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd
22796 END DO
22797 kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
22798 kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
22799 END DO
22800 END DO
22801 END DO
22802 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 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 kbd(1:1*1) = 0.0_dp
22826 kbc(1:1*1) = 0.0_dp
22827 kad(1:10*1) = 0.0_dp
22828 kac(1:10*1) = 0.0_dp
22829 p_index = 0
22830 DO md = 1, 1
22831 DO mc = 1, 1
22832 DO mb = 1, 1
22833 ks_bd = 0.0_dp
22834 ks_bc = 0.0_dp
22835 p_bd = pbd((md - 1)*1 + mb)
22836 p_bc = pbc((mc - 1)*1 + mb)
22837 DO ma = 1, 10
22838 p_index = p_index + 1
22839 tmp = scale*prim(p_index)
22840 ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
22841 ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
22842 kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
22843 kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
22844 END DO
22845 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
22846 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
22847 END DO
22848 END DO
22849 END DO
22850 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 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 kbd(1:1*md_max) = 0.0_dp
22874 kbc(1:1*1) = 0.0_dp
22875 kad(1:10*md_max) = 0.0_dp
22876 kac(1:10*1) = 0.0_dp
22877 p_index = 0
22878 DO md = 1, md_max
22879 DO mc = 1, 1
22880 DO mb = 1, 1
22881 ks_bd = 0.0_dp
22882 ks_bc = 0.0_dp
22883 p_bd = pbd((md - 1)*1 + mb)
22884 p_bc = pbc((mc - 1)*1 + mb)
22885 DO ma = 1, 10
22886 p_index = p_index + 1
22887 tmp = scale*prim(p_index)
22888 ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
22889 ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
22890 kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
22891 kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
22892 END DO
22893 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
22894 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
22895 END DO
22896 END DO
22897 END DO
22898 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 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 kbd(1:1*md_max) = 0.0_dp
22924 kbc(1:1*mc_max) = 0.0_dp
22925 kad(1:10*md_max) = 0.0_dp
22926 kac(1:10*mc_max) = 0.0_dp
22927 p_index = 0
22928 DO md = 1, md_max
22929 DO mc = 1, mc_max
22930 DO mb = 1, 1
22931 ks_bd = 0.0_dp
22932 ks_bc = 0.0_dp
22933 p_bd = pbd((md - 1)*1 + mb)
22934 p_bc = pbc((mc - 1)*1 + mb)
22935 DO ma = 1, 10
22936 p_index = p_index + 1
22937 tmp = scale*prim(p_index)
22938 ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
22939 ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
22940 kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
22941 kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
22942 END DO
22943 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
22944 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
22945 END DO
22946 END DO
22947 END DO
22948 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 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 kbd(1:2*md_max) = 0.0_dp
22974 kbc(1:2*mc_max) = 0.0_dp
22975 kad(1:10*md_max) = 0.0_dp
22976 kac(1:10*mc_max) = 0.0_dp
22977 p_index = 0
22978 DO md = 1, md_max
22979 DO mc = 1, mc_max
22980 DO mb = 1, 2
22981 ks_bd = 0.0_dp
22982 ks_bc = 0.0_dp
22983 p_bd = pbd((md - 1)*2 + mb)
22984 p_bc = pbc((mc - 1)*2 + mb)
22985 DO ma = 1, 10
22986 p_index = p_index + 1
22987 tmp = scale*prim(p_index)
22988 ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
22989 ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
22990 kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
22991 kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
22992 END DO
22993 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
22994 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
22995 END DO
22996 END DO
22997 END DO
22998 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 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 kbd(1:3*md_max) = 0.0_dp
23024 kbc(1:3*mc_max) = 0.0_dp
23025 kad(1:10*md_max) = 0.0_dp
23026 kac(1:10*mc_max) = 0.0_dp
23027 p_index = 0
23028 DO md = 1, md_max
23029 DO mc = 1, mc_max
23030 DO mb = 1, 3
23031 ks_bd = 0.0_dp
23032 ks_bc = 0.0_dp
23033 p_bd = pbd((md - 1)*3 + mb)
23034 p_bc = pbc((mc - 1)*3 + mb)
23035 DO ma = 1, 10
23036 p_index = p_index + 1
23037 tmp = scale*prim(p_index)
23038 ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
23039 ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
23040 kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
23041 kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
23042 END DO
23043 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
23044 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
23045 END DO
23046 END DO
23047 END DO
23048 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 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 kbd(1:4*md_max) = 0.0_dp
23074 kbc(1:4*mc_max) = 0.0_dp
23075 kad(1:10*md_max) = 0.0_dp
23076 kac(1:10*mc_max) = 0.0_dp
23077 p_index = 0
23078 DO md = 1, md_max
23079 DO mc = 1, mc_max
23080 DO mb = 1, 4
23081 ks_bd = 0.0_dp
23082 ks_bc = 0.0_dp
23083 p_bd = pbd((md - 1)*4 + mb)
23084 p_bc = pbc((mc - 1)*4 + mb)
23085 DO ma = 1, 10
23086 p_index = p_index + 1
23087 tmp = scale*prim(p_index)
23088 ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
23089 ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
23090 kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
23091 kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
23092 END DO
23093 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
23094 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
23095 END DO
23096 END DO
23097 END DO
23098 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 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 kbd(1:5*md_max) = 0.0_dp
23124 kbc(1:5*mc_max) = 0.0_dp
23125 kad(1:10*md_max) = 0.0_dp
23126 kac(1:10*mc_max) = 0.0_dp
23127 p_index = 0
23128 DO md = 1, md_max
23129 DO mc = 1, mc_max
23130 DO mb = 1, 5
23131 ks_bd = 0.0_dp
23132 ks_bc = 0.0_dp
23133 p_bd = pbd((md - 1)*5 + mb)
23134 p_bc = pbc((mc - 1)*5 + mb)
23135 DO ma = 1, 10
23136 p_index = p_index + 1
23137 tmp = scale*prim(p_index)
23138 ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
23139 ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
23140 kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
23141 kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
23142 END DO
23143 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
23144 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
23145 END DO
23146 END DO
23147 END DO
23148 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 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 kbd(1:6*md_max) = 0.0_dp
23174 kbc(1:6*mc_max) = 0.0_dp
23175 kad(1:10*md_max) = 0.0_dp
23176 kac(1:10*mc_max) = 0.0_dp
23177 p_index = 0
23178 DO md = 1, md_max
23179 DO mc = 1, mc_max
23180 DO mb = 1, 6
23181 ks_bd = 0.0_dp
23182 ks_bc = 0.0_dp
23183 p_bd = pbd((md - 1)*6 + mb)
23184 p_bc = pbc((mc - 1)*6 + mb)
23185 DO ma = 1, 10
23186 p_index = p_index + 1
23187 tmp = scale*prim(p_index)
23188 ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
23189 ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
23190 kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
23191 kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
23192 END DO
23193 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
23194 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
23195 END DO
23196 END DO
23197 END DO
23198 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 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 kbd(1:7*md_max) = 0.0_dp
23224 kbc(1:7*mc_max) = 0.0_dp
23225 kad(1:10*md_max) = 0.0_dp
23226 kac(1:10*mc_max) = 0.0_dp
23227 p_index = 0
23228 DO md = 1, md_max
23229 DO mc = 1, mc_max
23230 DO mb = 1, 7
23231 ks_bd = 0.0_dp
23232 ks_bc = 0.0_dp
23233 p_bd = pbd((md - 1)*7 + mb)
23234 p_bc = pbc((mc - 1)*7 + mb)
23235 DO ma = 1, 10
23236 p_index = p_index + 1
23237 tmp = scale*prim(p_index)
23238 ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
23239 ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
23240 kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
23241 kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
23242 END DO
23243 kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
23244 kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
23245 END DO
23246 END DO
23247 END DO
23248 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 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 kbd(1:9*md_max) = 0.0_dp
23274 kbc(1:9*mc_max) = 0.0_dp
23275 kad(1:10*md_max) = 0.0_dp
23276 kac(1:10*mc_max) = 0.0_dp
23277 p_index = 0
23278 DO md = 1, md_max
23279 DO mc = 1, mc_max
23280 DO mb = 1, 9
23281 ks_bd = 0.0_dp
23282 ks_bc = 0.0_dp
23283 p_bd = pbd((md - 1)*9 + mb)
23284 p_bc = pbc((mc - 1)*9 + mb)
23285 DO ma = 1, 10
23286 p_index = p_index + 1
23287 tmp = scale*prim(p_index)
23288 ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
23289 ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
23290 kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
23291 kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
23292 END DO
23293 kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
23294 kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
23295 END DO
23296 END DO
23297 END DO
23298 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 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 kbd(1:10*md_max) = 0.0_dp
23324 kbc(1:10*mc_max) = 0.0_dp
23325 kad(1:10*md_max) = 0.0_dp
23326 kac(1:10*mc_max) = 0.0_dp
23327 p_index = 0
23328 DO md = 1, md_max
23329 DO mc = 1, mc_max
23330 DO mb = 1, 10
23331 ks_bd = 0.0_dp
23332 ks_bc = 0.0_dp
23333 p_bd = pbd((md - 1)*10 + mb)
23334 p_bc = pbc((mc - 1)*10 + mb)
23335 DO ma = 1, 10
23336 p_index = p_index + 1
23337 tmp = scale*prim(p_index)
23338 ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
23339 ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
23340 kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
23341 kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
23342 END DO
23343 kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
23344 kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
23345 END DO
23346 END DO
23347 END DO
23348 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 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 kbd(1:11*md_max) = 0.0_dp
23374 kbc(1:11*mc_max) = 0.0_dp
23375 kad(1:10*md_max) = 0.0_dp
23376 kac(1:10*mc_max) = 0.0_dp
23377 p_index = 0
23378 DO md = 1, md_max
23379 DO mc = 1, mc_max
23380 DO mb = 1, 11
23381 ks_bd = 0.0_dp
23382 ks_bc = 0.0_dp
23383 p_bd = pbd((md - 1)*11 + mb)
23384 p_bc = pbc((mc - 1)*11 + mb)
23385 DO ma = 1, 10
23386 p_index = p_index + 1
23387 tmp = scale*prim(p_index)
23388 ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
23389 ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
23390 kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
23391 kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
23392 END DO
23393 kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
23394 kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
23395 END DO
23396 END DO
23397 END DO
23398 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 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 kbd(1:15*md_max) = 0.0_dp
23424 kbc(1:15*mc_max) = 0.0_dp
23425 kad(1:10*md_max) = 0.0_dp
23426 kac(1:10*mc_max) = 0.0_dp
23427 p_index = 0
23428 DO md = 1, md_max
23429 DO mc = 1, mc_max
23430 DO mb = 1, 15
23431 ks_bd = 0.0_dp
23432 ks_bc = 0.0_dp
23433 p_bd = pbd((md - 1)*15 + mb)
23434 p_bc = pbc((mc - 1)*15 + mb)
23435 DO ma = 1, 10
23436 p_index = p_index + 1
23437 tmp = scale*prim(p_index)
23438 ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma)
23439 ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma)
23440 kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc
23441 kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd
23442 END DO
23443 kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
23444 kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
23445 END DO
23446 END DO
23447 END DO
23448 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 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 kbd(1:1*1) = 0.0_dp
23472 kbc(1:1*1) = 0.0_dp
23473 kad(1:11*1) = 0.0_dp
23474 kac(1:11*1) = 0.0_dp
23475 p_index = 0
23476 DO md = 1, 1
23477 DO mc = 1, 1
23478 DO mb = 1, 1
23479 ks_bd = 0.0_dp
23480 ks_bc = 0.0_dp
23481 p_bd = pbd((md - 1)*1 + mb)
23482 p_bc = pbc((mc - 1)*1 + mb)
23483 DO ma = 1, 11
23484 p_index = p_index + 1
23485 tmp = scale*prim(p_index)
23486 ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23487 ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23488 kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23489 kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23490 END DO
23491 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
23492 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
23493 END DO
23494 END DO
23495 END DO
23496 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 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 kbd(1:1*md_max) = 0.0_dp
23520 kbc(1:1*1) = 0.0_dp
23521 kad(1:11*md_max) = 0.0_dp
23522 kac(1:11*1) = 0.0_dp
23523 p_index = 0
23524 DO md = 1, md_max
23525 DO mc = 1, 1
23526 DO mb = 1, 1
23527 ks_bd = 0.0_dp
23528 ks_bc = 0.0_dp
23529 p_bd = pbd((md - 1)*1 + mb)
23530 p_bc = pbc((mc - 1)*1 + mb)
23531 DO ma = 1, 11
23532 p_index = p_index + 1
23533 tmp = scale*prim(p_index)
23534 ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23535 ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23536 kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23537 kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23538 END DO
23539 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
23540 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
23541 END DO
23542 END DO
23543 END DO
23544 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 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 kbd(1:1*md_max) = 0.0_dp
23570 kbc(1:1*mc_max) = 0.0_dp
23571 kad(1:11*md_max) = 0.0_dp
23572 kac(1:11*mc_max) = 0.0_dp
23573 p_index = 0
23574 DO md = 1, md_max
23575 DO mc = 1, mc_max
23576 DO mb = 1, 1
23577 ks_bd = 0.0_dp
23578 ks_bc = 0.0_dp
23579 p_bd = pbd((md - 1)*1 + mb)
23580 p_bc = pbc((mc - 1)*1 + mb)
23581 DO ma = 1, 11
23582 p_index = p_index + 1
23583 tmp = scale*prim(p_index)
23584 ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23585 ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23586 kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23587 kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23588 END DO
23589 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
23590 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
23591 END DO
23592 END DO
23593 END DO
23594 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 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 kbd(1:2*md_max) = 0.0_dp
23620 kbc(1:2*mc_max) = 0.0_dp
23621 kad(1:11*md_max) = 0.0_dp
23622 kac(1:11*mc_max) = 0.0_dp
23623 p_index = 0
23624 DO md = 1, md_max
23625 DO mc = 1, mc_max
23626 DO mb = 1, 2
23627 ks_bd = 0.0_dp
23628 ks_bc = 0.0_dp
23629 p_bd = pbd((md - 1)*2 + mb)
23630 p_bc = pbc((mc - 1)*2 + mb)
23631 DO ma = 1, 11
23632 p_index = p_index + 1
23633 tmp = scale*prim(p_index)
23634 ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23635 ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23636 kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23637 kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23638 END DO
23639 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
23640 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
23641 END DO
23642 END DO
23643 END DO
23644 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 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 kbd(1:3*md_max) = 0.0_dp
23670 kbc(1:3*mc_max) = 0.0_dp
23671 kad(1:11*md_max) = 0.0_dp
23672 kac(1:11*mc_max) = 0.0_dp
23673 p_index = 0
23674 DO md = 1, md_max
23675 DO mc = 1, mc_max
23676 DO mb = 1, 3
23677 ks_bd = 0.0_dp
23678 ks_bc = 0.0_dp
23679 p_bd = pbd((md - 1)*3 + mb)
23680 p_bc = pbc((mc - 1)*3 + mb)
23681 DO ma = 1, 11
23682 p_index = p_index + 1
23683 tmp = scale*prim(p_index)
23684 ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23685 ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23686 kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23687 kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23688 END DO
23689 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
23690 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
23691 END DO
23692 END DO
23693 END DO
23694 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 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 kbd(1:4*md_max) = 0.0_dp
23720 kbc(1:4*mc_max) = 0.0_dp
23721 kad(1:11*md_max) = 0.0_dp
23722 kac(1:11*mc_max) = 0.0_dp
23723 p_index = 0
23724 DO md = 1, md_max
23725 DO mc = 1, mc_max
23726 DO mb = 1, 4
23727 ks_bd = 0.0_dp
23728 ks_bc = 0.0_dp
23729 p_bd = pbd((md - 1)*4 + mb)
23730 p_bc = pbc((mc - 1)*4 + mb)
23731 DO ma = 1, 11
23732 p_index = p_index + 1
23733 tmp = scale*prim(p_index)
23734 ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23735 ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23736 kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23737 kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23738 END DO
23739 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
23740 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
23741 END DO
23742 END DO
23743 END DO
23744 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 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 kbd(1:5*md_max) = 0.0_dp
23770 kbc(1:5*mc_max) = 0.0_dp
23771 kad(1:11*md_max) = 0.0_dp
23772 kac(1:11*mc_max) = 0.0_dp
23773 p_index = 0
23774 DO md = 1, md_max
23775 DO mc = 1, mc_max
23776 DO mb = 1, 5
23777 ks_bd = 0.0_dp
23778 ks_bc = 0.0_dp
23779 p_bd = pbd((md - 1)*5 + mb)
23780 p_bc = pbc((mc - 1)*5 + mb)
23781 DO ma = 1, 11
23782 p_index = p_index + 1
23783 tmp = scale*prim(p_index)
23784 ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23785 ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23786 kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23787 kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23788 END DO
23789 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
23790 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
23791 END DO
23792 END DO
23793 END DO
23794 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 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 kbd(1:6*md_max) = 0.0_dp
23820 kbc(1:6*mc_max) = 0.0_dp
23821 kad(1:11*md_max) = 0.0_dp
23822 kac(1:11*mc_max) = 0.0_dp
23823 p_index = 0
23824 DO md = 1, md_max
23825 DO mc = 1, mc_max
23826 DO mb = 1, 6
23827 ks_bd = 0.0_dp
23828 ks_bc = 0.0_dp
23829 p_bd = pbd((md - 1)*6 + mb)
23830 p_bc = pbc((mc - 1)*6 + mb)
23831 DO ma = 1, 11
23832 p_index = p_index + 1
23833 tmp = scale*prim(p_index)
23834 ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23835 ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23836 kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23837 kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23838 END DO
23839 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
23840 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
23841 END DO
23842 END DO
23843 END DO
23844 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 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 kbd(1:7*md_max) = 0.0_dp
23870 kbc(1:7*mc_max) = 0.0_dp
23871 kad(1:11*md_max) = 0.0_dp
23872 kac(1:11*mc_max) = 0.0_dp
23873 p_index = 0
23874 DO md = 1, md_max
23875 DO mc = 1, mc_max
23876 DO mb = 1, 7
23877 ks_bd = 0.0_dp
23878 ks_bc = 0.0_dp
23879 p_bd = pbd((md - 1)*7 + mb)
23880 p_bc = pbc((mc - 1)*7 + mb)
23881 DO ma = 1, 11
23882 p_index = p_index + 1
23883 tmp = scale*prim(p_index)
23884 ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23885 ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23886 kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23887 kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23888 END DO
23889 kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
23890 kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
23891 END DO
23892 END DO
23893 END DO
23894 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 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 kbd(1:9*md_max) = 0.0_dp
23920 kbc(1:9*mc_max) = 0.0_dp
23921 kad(1:11*md_max) = 0.0_dp
23922 kac(1:11*mc_max) = 0.0_dp
23923 p_index = 0
23924 DO md = 1, md_max
23925 DO mc = 1, mc_max
23926 DO mb = 1, 9
23927 ks_bd = 0.0_dp
23928 ks_bc = 0.0_dp
23929 p_bd = pbd((md - 1)*9 + mb)
23930 p_bc = pbc((mc - 1)*9 + mb)
23931 DO ma = 1, 11
23932 p_index = p_index + 1
23933 tmp = scale*prim(p_index)
23934 ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23935 ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23936 kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23937 kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23938 END DO
23939 kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
23940 kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
23941 END DO
23942 END DO
23943 END DO
23944 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 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 kbd(1:10*md_max) = 0.0_dp
23970 kbc(1:10*mc_max) = 0.0_dp
23971 kad(1:11*md_max) = 0.0_dp
23972 kac(1:11*mc_max) = 0.0_dp
23973 p_index = 0
23974 DO md = 1, md_max
23975 DO mc = 1, mc_max
23976 DO mb = 1, 10
23977 ks_bd = 0.0_dp
23978 ks_bc = 0.0_dp
23979 p_bd = pbd((md - 1)*10 + mb)
23980 p_bc = pbc((mc - 1)*10 + mb)
23981 DO ma = 1, 11
23982 p_index = p_index + 1
23983 tmp = scale*prim(p_index)
23984 ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
23985 ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
23986 kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
23987 kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
23988 END DO
23989 kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
23990 kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
23991 END DO
23992 END DO
23993 END DO
23994 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 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 kbd(1:11*md_max) = 0.0_dp
24020 kbc(1:11*mc_max) = 0.0_dp
24021 kad(1:11*md_max) = 0.0_dp
24022 kac(1:11*mc_max) = 0.0_dp
24023 p_index = 0
24024 DO md = 1, md_max
24025 DO mc = 1, mc_max
24026 DO mb = 1, 11
24027 ks_bd = 0.0_dp
24028 ks_bc = 0.0_dp
24029 p_bd = pbd((md - 1)*11 + mb)
24030 p_bc = pbc((mc - 1)*11 + mb)
24031 DO ma = 1, 11
24032 p_index = p_index + 1
24033 tmp = scale*prim(p_index)
24034 ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
24035 ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
24036 kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
24037 kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
24038 END DO
24039 kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
24040 kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
24041 END DO
24042 END DO
24043 END DO
24044 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 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 kbd(1:15*md_max) = 0.0_dp
24070 kbc(1:15*mc_max) = 0.0_dp
24071 kad(1:11*md_max) = 0.0_dp
24072 kac(1:11*mc_max) = 0.0_dp
24073 p_index = 0
24074 DO md = 1, md_max
24075 DO mc = 1, mc_max
24076 DO mb = 1, 15
24077 ks_bd = 0.0_dp
24078 ks_bc = 0.0_dp
24079 p_bd = pbd((md - 1)*15 + mb)
24080 p_bc = pbc((mc - 1)*15 + mb)
24081 DO ma = 1, 11
24082 p_index = p_index + 1
24083 tmp = scale*prim(p_index)
24084 ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma)
24085 ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma)
24086 kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc
24087 kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd
24088 END DO
24089 kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
24090 kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
24091 END DO
24092 END DO
24093 END DO
24094 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 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 kbd(1:1*1) = 0.0_dp
24118 kbc(1:1*1) = 0.0_dp
24119 kad(1:15*1) = 0.0_dp
24120 kac(1:15*1) = 0.0_dp
24121 p_index = 0
24122 DO md = 1, 1
24123 DO mc = 1, 1
24124 DO mb = 1, 1
24125 ks_bd = 0.0_dp
24126 ks_bc = 0.0_dp
24127 p_bd = pbd((md - 1)*1 + mb)
24128 p_bc = pbc((mc - 1)*1 + mb)
24129 DO ma = 1, 15
24130 p_index = p_index + 1
24131 tmp = scale*prim(p_index)
24132 ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24133 ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24134 kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24135 kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24136 END DO
24137 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
24138 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
24139 END DO
24140 END DO
24141 END DO
24142 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 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 kbd(1:1*md_max) = 0.0_dp
24166 kbc(1:1*1) = 0.0_dp
24167 kad(1:15*md_max) = 0.0_dp
24168 kac(1:15*1) = 0.0_dp
24169 p_index = 0
24170 DO md = 1, md_max
24171 DO mc = 1, 1
24172 DO mb = 1, 1
24173 ks_bd = 0.0_dp
24174 ks_bc = 0.0_dp
24175 p_bd = pbd((md - 1)*1 + mb)
24176 p_bc = pbc((mc - 1)*1 + mb)
24177 DO ma = 1, 15
24178 p_index = p_index + 1
24179 tmp = scale*prim(p_index)
24180 ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24181 ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24182 kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24183 kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24184 END DO
24185 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
24186 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
24187 END DO
24188 END DO
24189 END DO
24190 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 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 kbd(1:1*md_max) = 0.0_dp
24216 kbc(1:1*mc_max) = 0.0_dp
24217 kad(1:15*md_max) = 0.0_dp
24218 kac(1:15*mc_max) = 0.0_dp
24219 p_index = 0
24220 DO md = 1, md_max
24221 DO mc = 1, mc_max
24222 DO mb = 1, 1
24223 ks_bd = 0.0_dp
24224 ks_bc = 0.0_dp
24225 p_bd = pbd((md - 1)*1 + mb)
24226 p_bc = pbc((mc - 1)*1 + mb)
24227 DO ma = 1, 15
24228 p_index = p_index + 1
24229 tmp = scale*prim(p_index)
24230 ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24231 ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24232 kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24233 kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24234 END DO
24235 kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd
24236 kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc
24237 END DO
24238 END DO
24239 END DO
24240 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 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 kbd(1:2*md_max) = 0.0_dp
24266 kbc(1:2*mc_max) = 0.0_dp
24267 kad(1:15*md_max) = 0.0_dp
24268 kac(1:15*mc_max) = 0.0_dp
24269 p_index = 0
24270 DO md = 1, md_max
24271 DO mc = 1, mc_max
24272 DO mb = 1, 2
24273 ks_bd = 0.0_dp
24274 ks_bc = 0.0_dp
24275 p_bd = pbd((md - 1)*2 + mb)
24276 p_bc = pbc((mc - 1)*2 + mb)
24277 DO ma = 1, 15
24278 p_index = p_index + 1
24279 tmp = scale*prim(p_index)
24280 ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24281 ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24282 kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24283 kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24284 END DO
24285 kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd
24286 kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc
24287 END DO
24288 END DO
24289 END DO
24290 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 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 kbd(1:3*md_max) = 0.0_dp
24316 kbc(1:3*mc_max) = 0.0_dp
24317 kad(1:15*md_max) = 0.0_dp
24318 kac(1:15*mc_max) = 0.0_dp
24319 p_index = 0
24320 DO md = 1, md_max
24321 DO mc = 1, mc_max
24322 DO mb = 1, 3
24323 ks_bd = 0.0_dp
24324 ks_bc = 0.0_dp
24325 p_bd = pbd((md - 1)*3 + mb)
24326 p_bc = pbc((mc - 1)*3 + mb)
24327 DO ma = 1, 15
24328 p_index = p_index + 1
24329 tmp = scale*prim(p_index)
24330 ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24331 ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24332 kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24333 kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24334 END DO
24335 kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd
24336 kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc
24337 END DO
24338 END DO
24339 END DO
24340 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 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 kbd(1:4*md_max) = 0.0_dp
24366 kbc(1:4*mc_max) = 0.0_dp
24367 kad(1:15*md_max) = 0.0_dp
24368 kac(1:15*mc_max) = 0.0_dp
24369 p_index = 0
24370 DO md = 1, md_max
24371 DO mc = 1, mc_max
24372 DO mb = 1, 4
24373 ks_bd = 0.0_dp
24374 ks_bc = 0.0_dp
24375 p_bd = pbd((md - 1)*4 + mb)
24376 p_bc = pbc((mc - 1)*4 + mb)
24377 DO ma = 1, 15
24378 p_index = p_index + 1
24379 tmp = scale*prim(p_index)
24380 ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24381 ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24382 kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24383 kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24384 END DO
24385 kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd
24386 kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc
24387 END DO
24388 END DO
24389 END DO
24390 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 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 kbd(1:5*md_max) = 0.0_dp
24416 kbc(1:5*mc_max) = 0.0_dp
24417 kad(1:15*md_max) = 0.0_dp
24418 kac(1:15*mc_max) = 0.0_dp
24419 p_index = 0
24420 DO md = 1, md_max
24421 DO mc = 1, mc_max
24422 DO mb = 1, 5
24423 ks_bd = 0.0_dp
24424 ks_bc = 0.0_dp
24425 p_bd = pbd((md - 1)*5 + mb)
24426 p_bc = pbc((mc - 1)*5 + mb)
24427 DO ma = 1, 15
24428 p_index = p_index + 1
24429 tmp = scale*prim(p_index)
24430 ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24431 ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24432 kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24433 kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24434 END DO
24435 kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd
24436 kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc
24437 END DO
24438 END DO
24439 END DO
24440 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 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 kbd(1:6*md_max) = 0.0_dp
24466 kbc(1:6*mc_max) = 0.0_dp
24467 kad(1:15*md_max) = 0.0_dp
24468 kac(1:15*mc_max) = 0.0_dp
24469 p_index = 0
24470 DO md = 1, md_max
24471 DO mc = 1, mc_max
24472 DO mb = 1, 6
24473 ks_bd = 0.0_dp
24474 ks_bc = 0.0_dp
24475 p_bd = pbd((md - 1)*6 + mb)
24476 p_bc = pbc((mc - 1)*6 + mb)
24477 DO ma = 1, 15
24478 p_index = p_index + 1
24479 tmp = scale*prim(p_index)
24480 ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24481 ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24482 kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24483 kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24484 END DO
24485 kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd
24486 kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc
24487 END DO
24488 END DO
24489 END DO
24490 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 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 kbd(1:7*md_max) = 0.0_dp
24516 kbc(1:7*mc_max) = 0.0_dp
24517 kad(1:15*md_max) = 0.0_dp
24518 kac(1:15*mc_max) = 0.0_dp
24519 p_index = 0
24520 DO md = 1, md_max
24521 DO mc = 1, mc_max
24522 DO mb = 1, 7
24523 ks_bd = 0.0_dp
24524 ks_bc = 0.0_dp
24525 p_bd = pbd((md - 1)*7 + mb)
24526 p_bc = pbc((mc - 1)*7 + mb)
24527 DO ma = 1, 15
24528 p_index = p_index + 1
24529 tmp = scale*prim(p_index)
24530 ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24531 ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24532 kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24533 kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24534 END DO
24535 kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd
24536 kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc
24537 END DO
24538 END DO
24539 END DO
24540 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 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 kbd(1:9*md_max) = 0.0_dp
24566 kbc(1:9*mc_max) = 0.0_dp
24567 kad(1:15*md_max) = 0.0_dp
24568 kac(1:15*mc_max) = 0.0_dp
24569 p_index = 0
24570 DO md = 1, md_max
24571 DO mc = 1, mc_max
24572 DO mb = 1, 9
24573 ks_bd = 0.0_dp
24574 ks_bc = 0.0_dp
24575 p_bd = pbd((md - 1)*9 + mb)
24576 p_bc = pbc((mc - 1)*9 + mb)
24577 DO ma = 1, 15
24578 p_index = p_index + 1
24579 tmp = scale*prim(p_index)
24580 ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24581 ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24582 kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24583 kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24584 END DO
24585 kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd
24586 kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc
24587 END DO
24588 END DO
24589 END DO
24590 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 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 kbd(1:10*md_max) = 0.0_dp
24616 kbc(1:10*mc_max) = 0.0_dp
24617 kad(1:15*md_max) = 0.0_dp
24618 kac(1:15*mc_max) = 0.0_dp
24619 p_index = 0
24620 DO md = 1, md_max
24621 DO mc = 1, mc_max
24622 DO mb = 1, 10
24623 ks_bd = 0.0_dp
24624 ks_bc = 0.0_dp
24625 p_bd = pbd((md - 1)*10 + mb)
24626 p_bc = pbc((mc - 1)*10 + mb)
24627 DO ma = 1, 15
24628 p_index = p_index + 1
24629 tmp = scale*prim(p_index)
24630 ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24631 ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24632 kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24633 kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24634 END DO
24635 kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd
24636 kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc
24637 END DO
24638 END DO
24639 END DO
24640 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 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 kbd(1:11*md_max) = 0.0_dp
24666 kbc(1:11*mc_max) = 0.0_dp
24667 kad(1:15*md_max) = 0.0_dp
24668 kac(1:15*mc_max) = 0.0_dp
24669 p_index = 0
24670 DO md = 1, md_max
24671 DO mc = 1, mc_max
24672 DO mb = 1, 11
24673 ks_bd = 0.0_dp
24674 ks_bc = 0.0_dp
24675 p_bd = pbd((md - 1)*11 + mb)
24676 p_bc = pbc((mc - 1)*11 + mb)
24677 DO ma = 1, 15
24678 p_index = p_index + 1
24679 tmp = scale*prim(p_index)
24680 ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24681 ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24682 kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24683 kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24684 END DO
24685 kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd
24686 kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc
24687 END DO
24688 END DO
24689 END DO
24690 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 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 kbd(1:15*md_max) = 0.0_dp
24716 kbc(1:15*mc_max) = 0.0_dp
24717 kad(1:15*md_max) = 0.0_dp
24718 kac(1:15*mc_max) = 0.0_dp
24719 p_index = 0
24720 DO md = 1, md_max
24721 DO mc = 1, mc_max
24722 DO mb = 1, 15
24723 ks_bd = 0.0_dp
24724 ks_bc = 0.0_dp
24725 p_bd = pbd((md - 1)*15 + mb)
24726 p_bc = pbc((mc - 1)*15 + mb)
24727 DO ma = 1, 15
24728 p_index = p_index + 1
24729 tmp = scale*prim(p_index)
24730 ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma)
24731 ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma)
24732 kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc
24733 kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd
24734 END DO
24735 kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd
24736 kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc
24737 END DO
24738 END DO
24739 END DO
24740 END SUBROUTINE block_15_15
24741#endif
24742END MODULE hfx_contract_block
hfx_contract_block
routines to contract density matrix blocks with the for center integrals to yield the Kohn-Sham matri...
Definition hfx_contract_block.F:15
hfx_contract_block::contract_block
subroutine, public contract_block(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale)
...
Definition hfx_contract_block.F:42
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34