(git:34ef472)
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 ! **************************************************************************************************
15 MODULE hfx_contract_block
16  USE kinds, ONLY: dp
17 #include "../base/base_uses.f90"
18 
19  IMPLICIT NONE
20  PRIVATE
21  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'hfx_contract_block'
22  PUBLIC :: contract_block
23 CONTAINS
24 ! **************************************************************************************************
25 !> \brief ...
26 !> \param ma_max ...
27 !> \param mb_max ...
28 !> \param mc_max ...
29 !> \param md_max ...
30 !> \param kbd ...
31 !> \param kbc ...
32 !> \param kad ...
33 !> \param kac ...
34 !> \param pbd ...
35 !> \param pbc ...
36 !> \param pad ...
37 !> \param pac ...
38 !> \param prim ...
39 !> \param scale ...
40 ! **************************************************************************************************
41  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
24742 END MODULE hfx_contract_block
pbc
subroutine pbc(r, r_pbc, s, s_pbc, a, b, c, alpha, beta, gamma, debug, info, pbc0, h, hinv)
...
Definition: dumpdcd.F:1203
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