* [patch] Fix PR middle-end/68251
@ 2015-11-09 11:15 Eric Botcazou
2015-11-09 12:05 ` Richard Biener
2015-11-10 9:02 ` Eric Botcazou
0 siblings, 2 replies; 4+ messages in thread
From: Eric Botcazou @ 2015-11-09 11:15 UTC (permalink / raw)
To: gcc-patches
[-- Attachment #1: Type: text/plain, Size: 1295 bytes --]
Hi,
I don't understand how this didn't show up sooner given the amount of testing,
but there is a nasty overloading for the new REF_REVERSE_STORAGE_ORDER flag:
#define REF_REVERSE_STORAGE_ORDER(NODE) \
(TREE_CHECK2 (NODE, BIT_FIELD_REF, MEM_REF)->base.u.bits.saturating_flag)
saturating_flag is part of the 'bits' structure, which is itself part of the
'u' union, which also contains the dependence_info structure, and:
#define MR_DEPENDENCE_CLIQUE(NODE) \
(TREE_CHECK2 (NODE, MEM_REF, TARGET_MEM_REF)->base.u.dependence_info.clique)
#define MR_DEPENDENCE_BASE(NODE) \
(TREE_CHECK2 (NODE, MEM_REF, TARGET_MEM_REF)->base.u.dependence_info.base)
So there is a conflict on MEM_REF nodes. Therefore the attached patch changes
REF_REVERSE_STORAGE_ORDER to use the default_def_flag instead.
Tested on x86_64-suse-linux, OK for the mainline? I'll install the Fortran
testcase once it is reduced because it takes a while to compile ATM.
2015-11-09 Eric Botcazou <ebotcazou@adacore.com>
PR middle-end/68251
* tree-core.h (REF_REVERSE_STORAGE_ORDER): Move around.
* tree.h (REF_REVERSE_STORAGE_ORDER): Change to default_def_flag.
* tree-streamer-in.c (unpack_ts_base_value_fields): Adjust.
* tree-streamer-out.c (pack_ts_base_value_fields): Likewise.
--
Eric Botcazou
[-- Attachment #2: pr68251.diff --]
[-- Type: text/x-patch, Size: 2861 bytes --]
Index: tree-core.h
===================================================================
--- tree-core.h (revision 229993)
+++ tree-core.h (working copy)
@@ -1157,9 +1157,6 @@ struct GTY(()) tree_base {
TYPE_SATURATING in
other types
- REF_REVERSE_STORAGE_ORDER in
- BIT_FIELD_REF, MEM_REF
-
VAR_DECL_IS_VIRTUAL_OPERAND in
VAR_DECL
@@ -1174,6 +1171,9 @@ struct GTY(()) tree_base {
default_def_flag:
+ TYPE_FINAL_P in
+ RECORD_TYPE, UNION_TYPE and QUAL_UNION_TYPE
+
TYPE_VECTOR_OPAQUE in
VECTOR_TYPE
@@ -1183,8 +1183,8 @@ struct GTY(()) tree_base {
DECL_NONLOCAL_FRAME in
VAR_DECL
- TYPE_FINAL_P in
- RECORD_TYPE, UNION_TYPE and QUAL_UNION_TYPE
+ REF_REVERSE_STORAGE_ORDER in
+ BIT_FIELD_REF, MEM_REF
*/
struct GTY(()) tree_typed {
Index: tree.h
===================================================================
--- tree.h (revision 229993)
+++ tree.h (working copy)
@@ -927,7 +927,7 @@ extern void omp_clause_range_check_faile
But, of course, the storage order must be preserved when the accesses
themselves are rewritten or transformed. */
#define REF_REVERSE_STORAGE_ORDER(NODE) \
- (TREE_CHECK2 (NODE, BIT_FIELD_REF, MEM_REF)->base.u.bits.saturating_flag)
+ (TREE_CHECK2 (NODE, BIT_FIELD_REF, MEM_REF)->base.default_def_flag)
/* These flags are available for each language front end to use internally. */
#define TREE_LANG_FLAG_0(NODE) \
Index: tree-streamer-in.c
===================================================================
--- tree-streamer-in.c (revision 229993)
+++ tree-streamer-in.c (working copy)
@@ -143,7 +143,10 @@ unpack_ts_base_value_fields (struct bitp
TYPE_ADDR_SPACE (expr) = (unsigned) bp_unpack_value (bp, 8);
}
else if (TREE_CODE (expr) == BIT_FIELD_REF || TREE_CODE (expr) == MEM_REF)
- REF_REVERSE_STORAGE_ORDER (expr) = (unsigned) bp_unpack_value (bp, 1);
+ {
+ REF_REVERSE_STORAGE_ORDER (expr) = (unsigned) bp_unpack_value (bp, 1);
+ bp_unpack_value (bp, 8);
+ }
else if (TREE_CODE (expr) == SSA_NAME)
{
SSA_NAME_IS_DEFAULT_DEF (expr) = (unsigned) bp_unpack_value (bp, 1);
Index: tree-streamer-out.c
===================================================================
--- tree-streamer-out.c (revision 229993)
+++ tree-streamer-out.c (working copy)
@@ -117,7 +117,10 @@ pack_ts_base_value_fields (struct bitpac
bp_pack_value (bp, TYPE_ADDR_SPACE (expr), 8);
}
else if (TREE_CODE (expr) == BIT_FIELD_REF || TREE_CODE (expr) == MEM_REF)
- bp_pack_value (bp, REF_REVERSE_STORAGE_ORDER (expr), 1);
+ {
+ bp_pack_value (bp, REF_REVERSE_STORAGE_ORDER (expr), 1);
+ bp_pack_value (bp, 0, 8);
+ }
else if (TREE_CODE (expr) == SSA_NAME)
{
bp_pack_value (bp, SSA_NAME_IS_DEFAULT_DEF (expr), 1);
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [patch] Fix PR middle-end/68251
2015-11-09 11:15 [patch] Fix PR middle-end/68251 Eric Botcazou
@ 2015-11-09 12:05 ` Richard Biener
2015-11-09 12:11 ` Eric Botcazou
2015-11-10 9:02 ` Eric Botcazou
1 sibling, 1 reply; 4+ messages in thread
From: Richard Biener @ 2015-11-09 12:05 UTC (permalink / raw)
To: Eric Botcazou; +Cc: GCC Patches
On Mon, Nov 9, 2015 at 12:13 PM, Eric Botcazou <ebotcazou@adacore.com> wrote:
> Hi,
>
> I don't understand how this didn't show up sooner given the amount of testing,
> but there is a nasty overloading for the new REF_REVERSE_STORAGE_ORDER flag:
>
> #define REF_REVERSE_STORAGE_ORDER(NODE) \
> (TREE_CHECK2 (NODE, BIT_FIELD_REF, MEM_REF)->base.u.bits.saturating_flag)
>
> saturating_flag is part of the 'bits' structure, which is itself part of the
> 'u' union, which also contains the dependence_info structure, and:
>
> #define MR_DEPENDENCE_CLIQUE(NODE) \
> (TREE_CHECK2 (NODE, MEM_REF, TARGET_MEM_REF)->base.u.dependence_info.clique)
> #define MR_DEPENDENCE_BASE(NODE) \
> (TREE_CHECK2 (NODE, MEM_REF, TARGET_MEM_REF)->base.u.dependence_info.base)
>
> So there is a conflict on MEM_REF nodes. Therefore the attached patch changes
> REF_REVERSE_STORAGE_ORDER to use the default_def_flag instead.
>
> Tested on x86_64-suse-linux, OK for the mainline? I'll install the Fortran
> testcase once it is reduced because it takes a while to compile ATM.
Looks good to me. I wonder where you store the info on
TARGET_MEM_REFs though? Or
is IVOPTs prohibited from messing with such refs (pessmizing them)?
Thanks,
Richard.
>
> 2015-11-09 Eric Botcazou <ebotcazou@adacore.com>
>
> PR middle-end/68251
> * tree-core.h (REF_REVERSE_STORAGE_ORDER): Move around.
> * tree.h (REF_REVERSE_STORAGE_ORDER): Change to default_def_flag.
> * tree-streamer-in.c (unpack_ts_base_value_fields): Adjust.
> * tree-streamer-out.c (pack_ts_base_value_fields): Likewise.
>
> --
> Eric Botcazou
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [patch] Fix PR middle-end/68251
2015-11-09 12:05 ` Richard Biener
@ 2015-11-09 12:11 ` Eric Botcazou
0 siblings, 0 replies; 4+ messages in thread
From: Eric Botcazou @ 2015-11-09 12:11 UTC (permalink / raw)
To: Richard Biener; +Cc: gcc-patches
> Looks good to me.
Thanks.
> I wonder where you store the info on TARGET_MEM_REFs though? Or
> is IVOPTs prohibited from messing with such refs (pessmizing them)?
Yes, the latter:
* tree-ssa-loop-ivopts.c (may_be_nonaddressable_p) <MEM_REF>: New.
Return true if reverse storage order.
<BIT_FIELD_REF>: Likewise.
<COMPONENT_REF>: Likewise.
<ARRAY_REF>: Likewise.
<ARRAY_RANGE_REF>: Likewise.
(split_address_cost): Likewise. Bail out if reverse storage order
--
Eric Botcazou
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [patch] Fix PR middle-end/68251
2015-11-09 11:15 [patch] Fix PR middle-end/68251 Eric Botcazou
2015-11-09 12:05 ` Richard Biener
@ 2015-11-10 9:02 ` Eric Botcazou
1 sibling, 0 replies; 4+ messages in thread
From: Eric Botcazou @ 2015-11-10 9:02 UTC (permalink / raw)
To: gcc-patches
[-- Attachment #1: Type: text/plain, Size: 320 bytes --]
> Tested on x86_64-suse-linux, OK for the mainline? I'll install the Fortran
> testcase once it is reduced because it takes a while to compile ATM.
Here it is, as reduced by Joost, installed on the mainline.
2015-11-10 Eric Botcazou <ebotcazou@adacore.com>
* gfortran.dg/pr68251.f90: New test.
--
Eric Botcazou
[-- Attachment #2: pr68251.f90 --]
[-- Type: text/x-fortran, Size: 41128 bytes --]
! PR middle-end/68251
! Reduced testcase by Joost VandeVondele <Joost.VandeVondele@mat.ethz.ch>
! { dg-do compile }
! { dg-options "-O3" }
MODULE hfx_contract_block
INTEGER, PARAMETER :: dp=8
CONTAINS
SUBROUTINE contract_block(ma_max,mb_max,mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(mb_max*md_max), kbc(mb_max*mc_max), &
kad(ma_max*md_max), kac(ma_max*mc_max), pbd(mb_max*md_max), &
pbc(mb_max*mc_max), pad(ma_max*md_max), pac(ma_max*mc_max), &
prim(ma_max*mb_max*mc_max*md_max), scale
SELECT CASE(ma_max)
CASE(1)
SELECT CASE(mb_max)
CASE(1)
SELECT CASE(mc_max)
CASE(1)
SELECT CASE(md_max)
CASE(1)
CALL block_1_1_1_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_1_1_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_1_11(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
END SELECT
SELECT CASE(mc_max)
CASE(1)
SELECT CASE(md_max)
CASE(2)
CALL block_1_2_1_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_2_1_3(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_2_1_4(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_2_1_5(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_2_1_6(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_2_1_7(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_2_2_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_2_2_4(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_2_4_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_2_6_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
SELECT CASE(md_max)
CASE(1)
CALL block_1_2_7_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
END SELECT
SELECT CASE(mc_max)
CASE(1)
SELECT CASE(md_max)
CASE(1)
CALL block_1_3_1_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_3_1_3(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_3_1_4(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_3_1_5(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_3_1_6(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_3_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_3_2_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_3_2_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_3_2_3(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
SELECT CASE(md_max)
CASE(1)
CALL block_1_3_3_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_3_3_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
SELECT CASE(md_max)
CASE(1)
CALL block_1_3_5(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_3_5(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
END SELECT
SELECT CASE(mc_max)
CASE(1)
SELECT CASE(md_max)
CASE(1)
CALL block_1_4_1_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_4_1_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_4_1_3(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
SELECT CASE(md_max)
CASE(1)
CALL block_1_4_2_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_4_2_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_4_3_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_4_3(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_4_3(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_4_3(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_4_3(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_4_3(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_4_3(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_4_3(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_4_3(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_4_4_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_4_4(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
SELECT CASE(md_max)
CASE(1)
CALL block_1_5_1_3(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
SELECT CASE(md_max)
CASE(1)
CALL block_1_6_1_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_6_1_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_1_6_1_3(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
SELECT CASE(md_max)
CASE(1)
CALL block_1_6_2_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
END SELECT
SELECT CASE(mc_max)
CASE(1)
SELECT CASE(md_max)
END SELECT
END SELECT
END SELECT
SELECT CASE(mb_max)
CASE(1)
SELECT CASE(mc_max)
CASE(1)
SELECT CASE(md_max)
CASE(1)
CALL block_2_1_1_3(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_2_1_1_4(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_2_1_1_5(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_2_1_1_6(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_2_1_2_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_2_1_2_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_2_1_2_4(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
END SELECT
SELECT CASE(mc_max)
CASE(1)
SELECT CASE(md_max)
CASE(1)
CALL block_2_2_1_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_2_2_2_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_2_2_3_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
END SELECT
SELECT CASE(mc_max)
CASE(1)
SELECT CASE(md_max)
CASE(7)
CALL block_3_2_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_2_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_2_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_2_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_2_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
END SELECT
SELECT CASE(mc_max)
CASE(1)
SELECT CASE(md_max)
CASE(1)
CALL block_3_5_1_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
CALL block_3_6(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_6(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_6(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_6(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_6(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_6(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_6(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_6(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_6(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_3_6(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
CALL block_3_9(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
SELECT CASE(mb_max)
CASE(1)
SELECT CASE(mc_max)
CASE(1)
SELECT CASE(md_max)
CASE(1)
CALL block_4_1_1_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_1_1_3(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_1_1_4(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_1_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_1_4(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_1_4(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_1_4(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_1_4(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_1_4(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_1_4(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_1_4(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
END SELECT
SELECT CASE(mc_max)
CASE(1)
SELECT CASE(md_max)
CASE(1)
CALL block_4_2_1_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_2_2(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_2_2(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_2_2(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_2_2(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_2_2(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_2_2(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_2_2(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_2_2(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_2_2(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_2_2(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
SELECT CASE(md_max)
CASE(1)
CALL block_4_3_1_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
CALL block_4_3(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_3(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_3(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_3(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_3(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_3(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_3(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_3(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_3(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
CALL block_4_3(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
SELECT CASE(md_max)
CASE(1)
CALL block_4_4_1_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
END SELECT
SELECT CASE(mc_max)
CASE(1)
SELECT CASE(md_max)
END SELECT
END SELECT
END SELECT
SELECT CASE(mb_max)
CASE(1)
CALL block_15_15(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
END SELECT
END SELECT
END SUBROUTINE contract_block
SUBROUTINE block_1_1_1_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(1*1), kbc(1*1), kad(1*1), kac(1*1), pbd(1*1), &
pbc(1*1), pad(1*1), pac(1*1), prim(1*1*1*1), scale
DO md = 1,1
DO mc = 1,1
DO mb = 1,1
DO ma = 1,1
kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc
END DO
END DO
END DO
END DO
END SUBROUTINE block_1_1_1_1
SUBROUTINE block_1_1_1_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(1*2), kbc(1*1), kad(1*2), kac(1*1), pbd(1*2), &
pbc(1*1), pad(1*2), pac(1*1), prim(1*1*1*2), scale
DO md = 1,2
DO mc = 1,1
DO mb = 1,1
DO ma = 1,1
kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd
END DO
END DO
END DO
END DO
END SUBROUTINE block_1_1_1_2
SUBROUTINE block_1_1_11(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(1*md_max), kbc(1*11), kad(1*md_max), kac(1*11), &
pbd(1*md_max), pbc(1*11), pad(1*md_max), pac(1*11), &
prim(1*1*11*md_max), scale
DO md = 1,md_max
DO mc = 1,11
DO mb = 1,1
kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_1_11
SUBROUTINE block_1_2_1_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(2*2), kbc(2*1), kad(1*2), kac(1*1), pbd(2*2), &
pbc(2*1), pad(1*2), pac(1*1), prim(1*2*1*2), scale
DO md = 1,2
DO mc = 1,1
DO mb = 1,2
kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_2_1_2
SUBROUTINE block_1_2_1_3(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(2*3), kbc(2*1), kad(1*3), kac(1*1), pbd(2*3), &
pbc(2*1), pad(1*3), pac(1*1), prim(1*2*1*3), scale
DO md = 1,3
DO mc = 1,1
DO mb = 1,2
kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_2_1_3
SUBROUTINE block_1_2_1_4(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(2*4), kbc(2*1), kad(1*4), kac(1*1), pbd(2*4), &
pbc(2*1), pad(1*4), pac(1*1), prim(1*2*1*4), scale
DO md = 1,4
DO mc = 1,1
DO mb = 1,2
kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_2_1_4
SUBROUTINE block_1_2_1_5(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(2*5), kbc(2*1), kad(1*5), kac(1*1), pbd(2*5), &
pbc(2*1), pad(1*5), pac(1*1), prim(1*2*1*5), scale
DO md = 1,5
DO mc = 1,1
DO mb = 1,2
kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_2_1_5
SUBROUTINE block_1_2_1_6(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(2*6), kbc(2*1), kad(1*6), kac(1*1), pbd(2*6), &
pbc(2*1), pad(1*6), pac(1*1), prim(1*2*1*6), scale
DO md = 1,6
DO mc = 1,1
DO mb = 1,2
DO ma = 1,1
kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd
END DO
END DO
END DO
END DO
END SUBROUTINE block_1_2_1_6
SUBROUTINE block_1_2_1_7(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(2*7), kbc(2*1), kad(1*7), kac(1*1), pbd(2*7), &
pbc(2*1), pad(1*7), pac(1*1), prim(1*2*1*7), scale
DO md = 1,7
DO mc = 1,1
DO mb = 1,2
DO ma = 1,1
kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc
END DO
END DO
END DO
END DO
END SUBROUTINE block_1_2_1_7
SUBROUTINE block_1_2_2_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(2*2), kbc(2*2), kad(1*2), kac(1*2), pbd(2*2), &
pbc(2*2), pad(1*2), pac(1*2), prim(1*2*2*2), scale
DO md = 1,2
DO mc = 1,2
DO mb = 1,2
kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_2_2_2
SUBROUTINE block_1_2_2_4(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(2*4), kbc(2*2), kad(1*4), kac(1*2), pbd(2*4), &
pbc(2*2), pad(1*4), pac(1*2), prim(1*2*2*4), scale
DO md = 1,4
DO mc = 1,2
DO mb = 1,2
kbd((md-1)*2+mb) = kbd((md-1)*2+mb) - ks_bd
END DO
END DO
END DO
END SUBROUTINE block_1_2_2_4
SUBROUTINE block_1_2_4_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(2*1), kbc(2*4), kad(1*1), kac(1*4), pbd(2*1), &
pbc(2*4), pad(1*1), pac(1*4), prim(1*2*4*1), scale
DO md = 1,1
DO mc = 1,4
DO mb = 1,2
kbd((md-1)*2+mb) = kbd((md-1)*2+mb) - ks_bd
END DO
END DO
END DO
END SUBROUTINE block_1_2_4_1
SUBROUTINE block_1_2_6_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(2*1), kbc(2*6), kad(1*1), kac(1*6), pbd(2*1), &
pbc(2*6), pad(1*1), pac(1*6), prim(1*2*6*1), scale
DO md = 1,1
DO mc = 1,6
DO mb = 1,2
DO ma = 1,1
kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc
END DO
END DO
END DO
END DO
END SUBROUTINE block_1_2_6_1
SUBROUTINE block_1_2_7_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(2*1), kbc(2*7), kad(1*1), kac(1*7), pbd(2*1), &
pbc(2*7), pad(1*1), pac(1*7), prim(1*2*7*1), scale
DO md = 1,1
DO mc = 1,7
DO mb = 1,2
DO ma = 1,1
kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd
END DO
END DO
END DO
END DO
END SUBROUTINE block_1_2_7_1
SUBROUTINE block_1_3_1_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(3*1), kbc(3*1), kad(1*1), kac(1*1), pbd(3*1), &
pbc(3*1), pad(1*1), pac(1*1), prim(1*3*1*1), scale
DO md = 1,1
DO mc = 1,1
DO mb = 1,3
kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_3_1_1
SUBROUTINE block_1_3_1_3(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(3*3), kbc(3*1), kad(1*3), kac(1*1), pbd(3*3), &
pbc(3*1), pad(1*3), pac(1*1), prim(1*3*1*3), scale
DO md = 1,3
DO mc = 1,1
DO mb = 1,3
DO ma = 1,1
kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd
END DO
END DO
END DO
END DO
END SUBROUTINE block_1_3_1_3
SUBROUTINE block_1_3_1_4(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(3*4), kbc(3*1), kad(1*4), kac(1*1), pbd(3*4), &
pbc(3*1), pad(1*4), pac(1*1), prim(1*3*1*4), scale
DO md = 1,4
DO mc = 1,1
DO mb = 1,3
kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_3_1_4
SUBROUTINE block_1_3_1_5(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(3*5), kbc(3*1), kad(1*5), kac(1*1), pbd(3*5), &
pbc(3*1), pad(1*5), pac(1*1), prim(1*3*1*5), scale
DO md = 1,5
DO mc = 1,1
DO mb = 1,3
DO ma = 1,1
kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd
END DO
END DO
END DO
END DO
END SUBROUTINE block_1_3_1_5
SUBROUTINE block_1_3_1_6(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(3*6), kbc(3*1), kad(1*6), kac(1*1), pbd(3*6), &
pbc(3*1), pad(1*6), pac(1*1), prim(1*3*1*6), scale
DO md = 1,6
DO mc = 1,1
DO mb = 1,3
DO ma = 1,1
kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd
END DO
END DO
END DO
END DO
END SUBROUTINE block_1_3_1_6
SUBROUTINE block_1_3_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(3*md_max), kbc(3*1), kad(1*md_max), kac(1*1), &
pbd(3*md_max), pbc(3*1), pad(1*md_max), pac(1*1), prim(1*3*1*md_max), &
scale
DO md = 1,md_max
DO mc = 1,1
DO mb = 1,3
DO ma = 1,1
kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc
END DO
END DO
END DO
END DO
END SUBROUTINE block_1_3_1
SUBROUTINE block_1_3_2_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(3*1), kbc(3*2), kad(1*1), kac(1*2), pbd(3*1), &
pbc(3*2), pad(1*1), pac(1*2), prim(1*3*2*1), scale
DO md = 1,1
DO mc = 1,2
DO mb = 1,3
kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_3_2_1
SUBROUTINE block_1_3_2_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(3*2), kbc(3*2), kad(1*2), kac(1*2), pbd(3*2), &
pbc(3*2), pad(1*2), pac(1*2), prim(1*3*2*2), scale
DO md = 1,2
DO mc = 1,2
DO mb = 1,3
DO ma = 1,1
kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc
END DO
END DO
END DO
END DO
END SUBROUTINE block_1_3_2_2
SUBROUTINE block_1_3_2_3(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(3*3), kbc(3*2), kad(1*3), kac(1*2), pbd(3*3), &
pbc(3*2), pad(1*3), pac(1*2), prim(1*3*2*3), scale
kbc(1:3*2) = 0.0_dp
DO md = 1,3
DO mc = 1,2
DO mb = 1,3
kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_3_2_3
SUBROUTINE block_1_3_3_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(3*1), kbc(3*3), kad(1*1), kac(1*3), pbd(3*1), &
pbc(3*3), pad(1*1), pac(1*3), prim(1*3*3*1), scale
DO md = 1,1
DO mc = 1,3
DO mb = 1,3
kbd((md-1)*3+mb) = kbd((md-1)*3+mb) - ks_bd
END DO
END DO
END DO
END SUBROUTINE block_1_3_3_1
SUBROUTINE block_1_3_3_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(3*2), kbc(3*3), kad(1*2), kac(1*3), pbd(3*2), &
pbc(3*3), pad(1*2), pac(1*3), prim(1*3*3*2), scale
DO md = 1,2
DO mc = 1,3
DO mb = 1,3
kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_3_3_2
SUBROUTINE block_1_3_5(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(3*md_max), kbc(3*5), kad(1*md_max), kac(1*5), &
pbd(3*md_max), pbc(3*5), pad(1*md_max), pac(1*5), prim(1*3*5*md_max), &
scale
kbd(1:3*md_max) = 0.0_dp
DO md = 1,md_max
END DO
END SUBROUTINE block_1_3_5
SUBROUTINE block_1_3_6(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
DO md = 1,md_max
END DO
END SUBROUTINE block_1_3_6
SUBROUTINE block_1_4_1_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(4*1), kbc(4*1), kad(1*1), kac(1*1), pbd(4*1), &
pbc(4*1), pad(1*1), pac(1*1), prim(1*4*1*1), scale
DO md = 1,1
DO mc = 1,1
DO mb = 1,4
DO ma = 1,1
kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd
END DO
END DO
END DO
END DO
END SUBROUTINE block_1_4_1_1
SUBROUTINE block_1_4_1_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(4*2), kbc(4*1), kad(1*2), kac(1*1), pbd(4*2), &
pbc(4*1), pad(1*2), pac(1*1), prim(1*4*1*2), scale
DO md = 1,2
DO mc = 1,1
DO mb = 1,4
kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_4_1_2
SUBROUTINE block_1_4_1_3(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(4*3), kbc(4*1), kad(1*3), kac(1*1), pbd(4*3), &
pbc(4*1), pad(1*3), pac(1*1), prim(1*4*1*3), scale
DO md = 1,3
DO mc = 1,1
DO mb = 1,4
kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_4_1_3
SUBROUTINE block_1_4_2_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(4*1), kbc(4*2), kad(1*1), kac(1*2), pbd(4*1), &
pbc(4*2), pad(1*1), pac(1*2), prim(1*4*2*1), scale
DO md = 1,1
DO mc = 1,2
DO mb = 1,4
kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_4_2_1
SUBROUTINE block_1_4_2_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(4*2), kbc(4*2), kad(1*2), kac(1*2), pbd(4*2), &
pbc(4*2), pad(1*2), pac(1*2), prim(1*4*2*2), scale
DO md = 1,2
DO mc = 1,2
DO mb = 1,4
DO ma = 1,1
kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc
END DO
END DO
END DO
END DO
END SUBROUTINE block_1_4_2_2
SUBROUTINE block_1_4_3_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(4*1), kbc(4*3), kad(1*1), kac(1*3), pbd(4*1), &
pbc(4*3), pad(1*1), pac(1*3), prim(1*4*3*1), scale
DO md = 1,1
DO mc = 1,3
DO mb = 1,4
kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_4_3_1
SUBROUTINE block_1_4_3(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(4*md_max), kbc(4*3), kad(1*md_max), kac(1*3), &
pbd(4*md_max), pbc(4*3), pad(1*md_max), pac(1*3), prim(1*4*3*md_max), &
scale
DO md = 1,md_max
DO mc = 1,3
DO mb = 1,4
kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_4_3
SUBROUTINE block_1_4_4_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(4*1), kbc(4*4), kad(1*1), kac(1*4), pbd(4*1), &
pbc(4*4), pad(1*1), pac(1*4), prim(1*4*4*1), scale
DO md = 1,1
DO mc = 1,4
DO mb = 1,4
kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_4_4_1
SUBROUTINE block_1_4_4(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(4*md_max), kbc(4*4), kad(1*md_max), kac(1*4), &
pbd(4*md_max), pbc(4*4), pad(1*md_max), pac(1*4), prim(1*4*4*md_max), &
scale
DO md = 1,md_max
DO mc = 1,4
DO mb = 1,4
DO ma = 1,1
kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd
END DO
END DO
END DO
END DO
END SUBROUTINE block_1_4_4
SUBROUTINE block_1_5_1_3(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(5*3), kbc(5*1), kad(1*3), kac(1*1), pbd(5*3), &
pbc(5*1), pad(1*3), pac(1*1), prim(1*5*1*3), scale
DO md = 1,3
DO mc = 1,1
DO mb = 1,5
DO ma = 1,1
kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd
END DO
END DO
END DO
END DO
END SUBROUTINE block_1_5_1_3
SUBROUTINE block_1_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(5*md_max), kbc(5*1), kad(1*md_max), kac(1*1), &
pbd(5*md_max), pbc(5*1), pad(1*md_max), pac(1*1), prim(1*5*1*md_max), &
scale
DO md = 1,md_max
DO mc = 1,1
DO mb = 1,5
kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_5_1
SUBROUTINE block_1_6_1_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(6*1), kbc(6*1), kad(1*1), kac(1*1), pbd(6*1), &
pbc(6*1), pad(1*1), pac(1*1), prim(1*6*1*1), scale
DO md = 1,1
DO mc = 1,1
DO mb = 1,6
DO ma = 1,1
kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd
END DO
END DO
END DO
END DO
END SUBROUTINE block_1_6_1_1
SUBROUTINE block_1_6_1_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(6*2), kbc(6*1), kad(1*2), kac(1*1), pbd(6*2), &
pbc(6*1), pad(1*2), pac(1*1), prim(1*6*1*2), scale
DO md = 1,2
DO mc = 1,1
DO mb = 1,6
DO ma = 1,1
kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc
END DO
END DO
END DO
END DO
END SUBROUTINE block_1_6_1_2
SUBROUTINE block_1_6_1_3(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(6*3), kbc(6*1), kad(1*3), kac(1*1), pbd(6*3), &
pbc(6*1), pad(1*3), pac(1*1), prim(1*6*1*3), scale
DO md = 1,3
DO mc = 1,1
DO mb = 1,6
kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_6_1_3
SUBROUTINE block_1_6_2_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(6*1), kbc(6*2), kad(1*1), kac(1*2), pbd(6*1), &
pbc(6*2), pad(1*1), pac(1*2), prim(1*6*2*1), scale
DO md = 1,1
DO mc = 1,2
DO mb = 1,6
kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_1_6_2_1
SUBROUTINE block_2_1_1_3(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(1*3), kbc(1*1), kad(2*3), kac(2*1), pbd(1*3), &
pbc(1*1), pad(2*3), pac(2*1), prim(2*1*1*3), scale
DO md = 1,3
DO mc = 1,1
DO mb = 1,1
DO ma = 1,2
kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd
END DO
END DO
END DO
END DO
END SUBROUTINE block_2_1_1_3
SUBROUTINE block_2_1_1_4(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(1*4), kbc(1*1), kad(2*4), kac(2*1), pbd(1*4), &
pbc(1*1), pad(2*4), pac(2*1), prim(2*1*1*4), scale
DO md = 1,4
DO mc = 1,1
DO mb = 1,1
kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_2_1_1_4
SUBROUTINE block_2_1_1_5(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(1*5), kbc(1*1), kad(2*5), kac(2*1), pbd(1*5), &
pbc(1*1), pad(2*5), pac(2*1), prim(2*1*1*5), scale
DO md = 1,5
DO mc = 1,1
DO mb = 1,1
kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_2_1_1_5
SUBROUTINE block_2_1_1_6(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(1*6), kbc(1*1), kad(2*6), kac(2*1), pbd(1*6), &
pbc(1*1), pad(2*6), pac(2*1), prim(2*1*1*6), scale
DO md = 1,6
DO mc = 1,1
DO mb = 1,1
DO ma = 1,2
kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc
END DO
END DO
END DO
END DO
END SUBROUTINE block_2_1_1_6
SUBROUTINE block_2_1_2_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(1*1), kbc(1*2), kad(2*1), kac(2*2), pbd(1*1), &
pbc(1*2), pad(2*1), pac(2*2), prim(2*1*2*1), scale
DO md = 1,1
DO mc = 1,2
DO mb = 1,1
DO ma = 1,2
kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd
END DO
END DO
END DO
END DO
END SUBROUTINE block_2_1_2_1
SUBROUTINE block_2_1_2_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(1*2), kbc(1*2), kad(2*2), kac(2*2), pbd(1*2), &
pbc(1*2), pad(2*2), pac(2*2), prim(2*1*2*2), scale
DO md = 1,2
DO mc = 1,2
DO mb = 1,1
kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_2_1_2_2
SUBROUTINE block_2_1_2_4(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(1*4), kbc(1*2), kad(2*4), kac(2*2), pbd(1*4), &
pbc(1*2), pad(2*4), pac(2*2), prim(2*1*2*4), scale
DO md = 1,4
DO mc = 1,2
DO mb = 1,1
kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_2_1_2_4
SUBROUTINE block_2_2_1_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(2*1), kbc(2*1), kad(2*1), kac(2*1), pbd(2*1), &
pbc(2*1), pad(2*1), pac(2*1), prim(2*2*1*1), scale
DO md = 1,1
DO mc = 1,1
DO mb = 1,2
kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_2_2_1_1
SUBROUTINE block_2_2_2_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(2*1), kbc(2*2), kad(2*1), kac(2*2), pbd(2*1), &
pbc(2*2), pad(2*1), pac(2*2), prim(2*2*2*1), scale
DO md = 1,1
DO mc = 1,2
DO mb = 1,2
kbd((md-1)*2+mb) = kbd((md-1)*2+mb) - ks_bd
END DO
END DO
END DO
END SUBROUTINE block_2_2_2_1
SUBROUTINE block_2_2_3_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(2*1), kbc(2*3), kad(2*1), kac(2*3), pbd(2*1), &
pbc(2*3), pad(2*1), pac(2*3), prim(2*2*3*1), scale
DO md = 1,1
DO mc = 1,3
DO mb = 1,2
kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_2_2_3_1
SUBROUTINE block_3_2_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(2*md_max), kbc(2*1), kad(3*md_max), kac(3*1), &
pbd(2*md_max), pbc(2*1), pad(3*md_max), pac(3*1), prim(3*2*1*md_max), &
scale
DO md = 1,md_max
DO mc = 1,1
DO mb = 1,2
kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_3_2_1
SUBROUTINE block_3_5_1_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(5*1), kbc(5*1), kad(3*1), kac(3*1), pbd(5*1), &
pbc(5*1), pad(3*1), pac(3*1), prim(3*5*1*1), scale
DO md = 1,1
DO mc = 1,1
DO mb = 1,5
DO ma = 1,3
kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc
END DO
END DO
END DO
END DO
END SUBROUTINE block_3_5_1_1
SUBROUTINE block_3_5_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(5*md_max), kbc(5*1), kad(3*md_max), kac(3*1), &
pbd(5*md_max), pbc(5*1), pad(3*md_max), pac(3*1), prim(3*5*1*md_max), &
scale
DO md = 1,md_max
DO mc = 1,1
DO mb = 1,5
kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_3_5_1
SUBROUTINE block_3_6(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(6*md_max), kbc(6*mc_max), kad(3*md_max), &
kac(3*mc_max), pbd(6*md_max), pbc(6*mc_max), pad(3*md_max), &
pac(3*mc_max), prim(3*6*mc_max*md_max), scale
kbd(1:6*md_max) = 0.0_dp
END SUBROUTINE block_3_6
SUBROUTINE block_3_9(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(9*md_max), kbc(9*mc_max), kad(3*md_max), &
kac(3*mc_max), pbd(9*md_max), pbc(9*mc_max), pad(3*md_max), &
pac(3*mc_max), prim(3*9*mc_max*md_max), scale
DO md = 1,md_max
DO mc = 1,mc_max
DO mb = 1,9
DO ma = 1,3
kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd
END DO
END DO
END DO
END DO
END SUBROUTINE block_3_9
SUBROUTINE block_4_1_1_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(1*2), kbc(1*1), kad(4*2), kac(4*1), pbd(1*2), &
pbc(1*1), pad(4*2), pac(4*1), prim(4*1*1*2), scale
DO md = 1,2
DO mc = 1,1
DO mb = 1,1
DO ma = 1,4
kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd
END DO
END DO
END DO
END DO
END SUBROUTINE block_4_1_1_2
SUBROUTINE block_4_1_1_3(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(1*3), kbc(1*1), kad(4*3), kac(4*1), pbd(1*3), &
pbc(1*1), pad(4*3), pac(4*1), prim(4*1*1*3), scale
DO md = 1,3
DO mc = 1,1
DO mb = 1,1
kbd((md-1)*1+mb) = kbd((md-1)*1+mb) - ks_bd
END DO
END DO
END DO
END SUBROUTINE block_4_1_1_3
SUBROUTINE block_4_1_1_4(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(1*4), kbc(1*1), kad(4*4), kac(4*1), pbd(1*4), &
pbc(1*1), pad(4*4), pac(4*1), prim(4*1*1*4), scale
DO md = 1,4
DO mc = 1,1
DO mb = 1,1
kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_4_1_1_4
SUBROUTINE block_4_1_1(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(1*md_max), kbc(1*1), kad(4*md_max), kac(4*1), &
pbd(1*md_max), pbc(1*1), pad(4*md_max), pac(4*1), prim(4*1*1*md_max), &
scale
DO md = 1,md_max
DO mc = 1,1
DO mb = 1,1
kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_4_1_1
SUBROUTINE block_4_1_4(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(1*md_max), kbc(1*4), kad(4*md_max), kac(4*4), &
pbd(1*md_max), pbc(1*4), pad(4*md_max), pac(4*4), prim(4*1*4*md_max), &
scale
kbd(1:1*md_max) = 0.0_dp
END SUBROUTINE block_4_1_4
SUBROUTINE block_4_2_1_2(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(2*2), kbc(2*1), kad(4*2), kac(4*1), pbd(2*2), &
pbc(2*1), pad(4*2), pac(4*1), prim(4*2*1*2), scale
DO md = 1,2
DO mc = 1,1
DO mb = 1,2
DO ma = 1,4
kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd
END DO
END DO
END DO
END DO
END SUBROUTINE block_4_2_1_2
SUBROUTINE block_4_2_2(md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(2*md_max), kbc(2*2), kad(4*md_max), kac(4*2), &
pbd(2*md_max), pbc(2*2), pad(4*md_max), pac(4*2), prim(4*2*2*md_max), &
scale
DO md = 1,md_max
DO mc = 1,2
DO mb = 1,2
kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_4_2_2
SUBROUTINE block_4_3_1_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(3*1), kbc(3*1), kad(4*1), kac(4*1), pbd(3*1), &
pbc(3*1), pad(4*1), pac(4*1), prim(4*3*1*1), scale
DO md = 1,1
DO mc = 1,1
DO mb = 1,3
DO ma = 1,4
kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd
END DO
END DO
END DO
END DO
END SUBROUTINE block_4_3_1_1
SUBROUTINE block_4_3(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(3*md_max), kbc(3*mc_max), kad(4*md_max), &
kac(4*mc_max), pbd(3*md_max), pbc(3*mc_max), pad(4*md_max), &
pac(4*mc_max), prim(4*3*mc_max*md_max), scale
DO md = 1,md_max
DO mc = 1,mc_max
DO mb = 1,3
kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_4_3
SUBROUTINE block_4_4_1_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(4*1), kbc(4*1), kad(4*1), kac(4*1), pbd(4*1), &
pbc(4*1), pad(4*1), pac(4*1), prim(4*4*1*1), scale
DO md = 1,1
DO mc = 1,1
DO mb = 1,4
DO ma = 1,4
kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc
END DO
END DO
END DO
END DO
END SUBROUTINE block_4_4_1_1
SUBROUTINE block_15_15(mc_max,md_max,kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
REAL(KIND=dp) :: kbd(15*md_max), kbc(15*mc_max), kad(15*md_max), &
kac(15*mc_max), pbd(15*md_max), pbc(15*mc_max), pad(15*md_max), &
pac(15*mc_max), prim(15*15*mc_max*md_max), scale
DO md = 1,md_max
DO mc = 1,mc_max
DO mb = 1,15
kbc((mc-1)*15+mb) = kbc((mc-1)*15+mb) - ks_bc
END DO
END DO
END DO
END SUBROUTINE block_15_15
END MODULE hfx_contract_block
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2015-11-10 9:02 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2015-11-09 11:15 [patch] Fix PR middle-end/68251 Eric Botcazou
2015-11-09 12:05 ` Richard Biener
2015-11-09 12:11 ` Eric Botcazou
2015-11-10 9:02 ` Eric Botcazou
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).