1      SUBROUTINE ccsd2_q_left(a_i0,d_v2,d_y2,k_v2_offset,k_y2_offset,t_h
2     &5b,t_h6b,t_h7b,t_h8b,t_p1b,t_p2b,t_p3b,t_p4b,toggle)
3C     $Id$
4C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
5C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
6C     i0 ( h5 h6 h7 h8 p1 p2 p3 p4 )_yv + = 1 * P( 36 ) * y ( h7 h8 p1 p2 )_y * v ( h5 h6 p3 p4 )_v
7      IMPLICIT NONE
8#include "global.fh"
9#include "mafdecls.fh"
10#include "util.fh"
11#include "errquit.fh"
12#include "tce.fh"
13      INTEGER t_h5b
14      INTEGER t_h6b
15      INTEGER t_h7b
16      INTEGER t_h8b
17      INTEGER t_p1b
18      INTEGER t_p2b
19      INTEGER t_p3b
20      INTEGER t_p4b
21      INTEGER toggle
22      INTEGER d_y2
23      INTEGER k_y2_offset
24      INTEGER d_v2
25      INTEGER k_v2_offset
26      DOUBLE PRECISION a_i0(*)
27      IF (toggle .eq. 2) CALL ccsd2_q_left_1(d_y2,k_y2_offset,d_v2,k_v2_
28     &offset,a_i0,t_h5b,t_h6b,t_h7b,t_h8b,t_p1b,t_p2b,t_p3b,t_p4b)
29      RETURN
30      END
31      SUBROUTINE ccsd2_q_left_1(d_a,k_a_offset,d_b,k_b_offset,a_c,t_h5b,
32     &t_h6b,t_h7b,t_h8b,t_p1b,t_p2b,t_p3b,t_p4b)
33C     $Id$
34C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
35C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
36C     i0 ( h5 h6 h7 h8 p1 p2 p3 p4 )_yv + = 1 * P( 36 ) * y ( h7 h8 p1 p2 )_y * v ( h5 h6 p3 p4 )_v
37      IMPLICIT NONE
38#include "global.fh"
39#include "mafdecls.fh"
40#include "sym.fh"
41#include "errquit.fh"
42#include "tce.fh"
43      INTEGER d_a
44      INTEGER k_a_offset
45      INTEGER d_b
46      INTEGER k_b_offset
47      INTEGER t_h5b
48      INTEGER t_h6b
49      INTEGER t_h7b
50      INTEGER t_h8b
51      INTEGER t_p1b
52      INTEGER t_p2b
53      INTEGER t_p3b
54      INTEGER t_p4b
55      INTEGER h7b
56      INTEGER h8b
57      INTEGER h5b
58      INTEGER h6b
59      INTEGER p1b
60      INTEGER p2b
61      INTEGER p3b
62      INTEGER p4b
63      INTEGER dimc
64      INTEGER l_c_sort
65      INTEGER k_c_sort
66      INTEGER h7b_1
67      INTEGER h8b_1
68      INTEGER p1b_1
69      INTEGER p2b_1
70      INTEGER h5b_2
71      INTEGER h6b_2
72      INTEGER p3b_2
73      INTEGER p4b_2
74      INTEGER dim_common
75      INTEGER dima_sort
76      INTEGER dima
77      INTEGER dimb_sort
78      INTEGER dimb
79      INTEGER l_a_sort
80      INTEGER k_a_sort
81      INTEGER l_a
82      INTEGER k_a
83      INTEGER l_b_sort
84      INTEGER k_b_sort
85      INTEGER l_b
86      INTEGER k_b
87      DOUBLE PRECISION a_c(*)
88      LOGICAL skipped
89      DO h7b = 1,noab
90      DO h8b = h7b,noab
91      DO h5b = 1,noab
92      DO h6b = h5b,noab
93      DO p1b = noab+1,noab+nvab
94      DO p2b = p1b,noab+nvab
95      DO p3b = noab+1,noab+nvab
96      DO p4b = p3b,noab+nvab
97      skipped = .true.
98      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h6b) .and. (t_h7b .eq. h7b)
99     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
100     &2b) .and. (t_p3b .eq. p3b) .and. (t_p4b .eq. p4b)) skipped = .fals
101     &e.
102      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h6b) .and. (t_h7b .eq. h7b)
103     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
104     &1b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) skipped = .fals
105     &e.
106      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h6b) .and. (t_h7b .eq. h7b)
107     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
108     &1b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) skipped = .fals
109     &e.
110      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h6b) .and. (t_h7b .eq. h7b)
111     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
112     &3b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) skipped = .fals
113     &e.
114      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h6b) .and. (t_h7b .eq. h7b)
115     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
116     &3b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) skipped = .fals
117     &e.
118      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h6b) .and. (t_h7b .eq. h7b)
119     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
120     &4b) .and. (t_p3b .eq. p1b) .and. (t_p4b .eq. p2b)) skipped = .fals
121     &e.
122      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h6b)
123     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
124     &2b) .and. (t_p3b .eq. p3b) .and. (t_p4b .eq. p4b)) skipped = .fals
125     &e.
126      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h6b)
127     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
128     &1b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) skipped = .fals
129     &e.
130      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h6b)
131     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
132     &1b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) skipped = .fals
133     &e.
134      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h6b)
135     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
136     &3b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) skipped = .fals
137     &e.
138      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h6b)
139     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
140     &3b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) skipped = .fals
141     &e.
142      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h6b)
143     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
144     &4b) .and. (t_p3b .eq. p1b) .and. (t_p4b .eq. p2b)) skipped = .fals
145     &e.
146      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h6b)
147     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
148     &2b) .and. (t_p3b .eq. p3b) .and. (t_p4b .eq. p4b)) skipped = .fals
149     &e.
150      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h6b)
151     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
152     &1b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) skipped = .fals
153     &e.
154      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h6b)
155     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
156     &1b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) skipped = .fals
157     &e.
158      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h6b)
159     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
160     &3b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) skipped = .fals
161     &e.
162      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h6b)
163     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
164     &3b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) skipped = .fals
165     &e.
166      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h6b)
167     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
168     &4b) .and. (t_p3b .eq. p1b) .and. (t_p4b .eq. p2b)) skipped = .fals
169     &e.
170      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h8b)
171     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
172     &2b) .and. (t_p3b .eq. p3b) .and. (t_p4b .eq. p4b)) skipped = .fals
173     &e.
174      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h8b)
175     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
176     &1b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) skipped = .fals
177     &e.
178      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h8b)
179     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
180     &1b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) skipped = .fals
181     &e.
182      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h8b)
183     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
184     &3b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) skipped = .fals
185     &e.
186      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h8b)
187     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
188     &3b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) skipped = .fals
189     &e.
190      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h8b)
191     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
192     &4b) .and. (t_p3b .eq. p1b) .and. (t_p4b .eq. p2b)) skipped = .fals
193     &e.
194      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h8b)
195     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
196     &2b) .and. (t_p3b .eq. p3b) .and. (t_p4b .eq. p4b)) skipped = .fals
197     &e.
198      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h8b)
199     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
200     &1b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) skipped = .fals
201     &e.
202      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h8b)
203     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
204     &1b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) skipped = .fals
205     &e.
206      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h8b)
207     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
208     &3b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) skipped = .fals
209     &e.
210      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h8b)
211     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
212     &3b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) skipped = .fals
213     &e.
214      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h8b)
215     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
216     &4b) .and. (t_p3b .eq. p1b) .and. (t_p4b .eq. p2b)) skipped = .fals
217     &e.
218      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h8b) .and. (t_h7b .eq. h5b)
219     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
220     &2b) .and. (t_p3b .eq. p3b) .and. (t_p4b .eq. p4b)) skipped = .fals
221     &e.
222      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h8b) .and. (t_h7b .eq. h5b)
223     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
224     &1b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) skipped = .fals
225     &e.
226      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h8b) .and. (t_h7b .eq. h5b)
227     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
228     &1b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) skipped = .fals
229     &e.
230      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h8b) .and. (t_h7b .eq. h5b)
231     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
232     &3b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) skipped = .fals
233     &e.
234      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h8b) .and. (t_h7b .eq. h5b)
235     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
236     &3b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) skipped = .fals
237     &e.
238      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h8b) .and. (t_h7b .eq. h5b)
239     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
240     &4b) .and. (t_p3b .eq. p1b) .and. (t_p4b .eq. p2b)) skipped = .fals
241     &e.
242      IF (.not.skipped) THEN
243      IF ((.not.restricted).or.(int_mb(k_spin+h5b-1)+int_mb(k_spin+h6b-1
244     &)+int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1)+int_mb(k_spin+p1b-1)+i
245     &nt_mb(k_spin+p2b-1)+int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1).ne.1
246     &6)) THEN
247      IF (int_mb(k_spin+h5b-1)+int_mb(k_spin+h6b-1)+int_mb(k_spin+h7b-1)
248     &+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+p1b-1)+int_mb(k_spin+p2b-
249     &1)+int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1)) THEN
250      IF (ieor(int_mb(k_sym+h5b-1),ieor(int_mb(k_sym+h6b-1),ieor(int_mb(
251     &k_sym+h7b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+p1b-1),ieo
252     &r(int_mb(k_sym+p2b-1),ieor(int_mb(k_sym+p3b-1),int_mb(k_sym+p4b-1)
253     &))))))) .eq. ieor(irrep_y,irrep_v)) THEN
254      dimc = int_mb(k_range+h5b-1) * int_mb(k_range+h6b-1) * int_mb(k_ra
255     &nge+h7b-1) * int_mb(k_range+h8b-1) * int_mb(k_range+p1b-1) * int_m
256     &b(k_range+p2b-1) * int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1)
257      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
258     & ERRQUIT('ccsd2_q_left_1',0,MA_ERR)
259      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
260      IF (int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+p
261     &1b-1)+int_mb(k_spin+p2b-1)) THEN
262      IF (ieor(int_mb(k_sym+h7b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb(
263     &k_sym+p1b-1),int_mb(k_sym+p2b-1)))) .eq. irrep_y) THEN
264      CALL TCE_RESTRICTED_4(h7b,h8b,p1b,p2b,h7b_1,h8b_1,p1b_1,p2b_1)
265      CALL TCE_RESTRICTED_4(h5b,h6b,p3b,p4b,h5b_2,h6b_2,p3b_2,p4b_2)
266      dim_common = 1
267      dima_sort = int_mb(k_range+h7b-1) * int_mb(k_range+h8b-1) * int_mb
268     &(k_range+p1b-1) * int_mb(k_range+p2b-1)
269      dima = dim_common * dima_sort
270      dimb_sort = int_mb(k_range+h5b-1) * int_mb(k_range+h6b-1) * int_mb
271     &(k_range+p3b-1) * int_mb(k_range+p4b-1)
272      dimb = dim_common * dimb_sort
273      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
274      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
275     & ERRQUIT('ccsd2_q_left_1',1,MA_ERR)
276      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
277     &ccsd2_q_left_1',2,MA_ERR)
278      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p2b_1
279     & - noab - 1 + nvab * (p1b_1 - noab - 1 + nvab * (h8b_1 - 1 + noab
280     &* (h7b_1 - 1)))))
281      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h7b-1)
282     &,int_mb(k_range+h8b-1),int_mb(k_range+p1b-1),int_mb(k_range+p2b-1)
283     &,4,3,2,1,1.0d0)
284      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('ccsd2_q_left_1',3,MA_ERR
285     &)
286      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
287     & ERRQUIT('ccsd2_q_left_1',4,MA_ERR)
288      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
289     &ccsd2_q_left_1',5,MA_ERR)
290      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p4b_2
291     & - 1 + (noab+nvab) * (p3b_2 - 1 + (noab+nvab) * (h6b_2 - 1 + (noab
292     &+nvab) * (h5b_2 - 1)))))
293      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h5b-1)
294     &,int_mb(k_range+h6b-1),int_mb(k_range+p3b-1),int_mb(k_range+p4b-1)
295     &,4,3,2,1,1.0d0)
296      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('ccsd2_q_left_1',6,MA_ERR
297     &)
298      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
299     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
300     &t),dima_sort)
301      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('ccsd2_q_left_1',7,M
302     &A_ERR)
303      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('ccsd2_q_left_1',8,M
304     &A_ERR)
305      END IF
306      END IF
307      END IF
308      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h6b) .and. (t_h7b .eq. h7b)
309     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
310     &2b) .and. (t_p3b .eq. p3b) .and. (t_p4b .eq. p4b)) THEN
311      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
312     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
313     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
314     &mb(k_range+h7b-1),4,3,8,7,6,5,2,1,1.0d0)
315      END IF
316      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h6b) .and. (t_h7b .eq. h7b)
317     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
318     &1b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) THEN
319      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
320     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
321     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
322     &mb(k_range+h7b-1),4,3,8,7,2,6,5,1,1.0d0)
323      END IF
324      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h6b) .and. (t_h7b .eq. h7b)
325     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
326     &1b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) THEN
327      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
328     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
329     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
330     &mb(k_range+h7b-1),4,3,8,7,2,6,1,5,-1.0d0)
331      END IF
332      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h6b) .and. (t_h7b .eq. h7b)
333     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
334     &3b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) THEN
335      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
336     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
337     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
338     &mb(k_range+h7b-1),4,3,8,7,6,2,5,1,-1.0d0)
339      END IF
340      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h6b) .and. (t_h7b .eq. h7b)
341     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
342     &3b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) THEN
343      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
344     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
345     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
346     &mb(k_range+h7b-1),4,3,8,7,6,2,1,5,1.0d0)
347      END IF
348      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h6b) .and. (t_h7b .eq. h7b)
349     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
350     &4b) .and. (t_p3b .eq. p1b) .and. (t_p4b .eq. p2b)) THEN
351      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
352     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
353     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
354     &mb(k_range+h7b-1),4,3,8,7,2,1,6,5,1.0d0)
355      END IF
356      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h6b)
357     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
358     &2b) .and. (t_p3b .eq. p3b) .and. (t_p4b .eq. p4b)) THEN
359      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
360     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
361     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
362     &mb(k_range+h7b-1),8,4,3,7,6,5,2,1,1.0d0)
363      END IF
364      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h6b)
365     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
366     &1b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) THEN
367      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
368     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
369     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
370     &mb(k_range+h7b-1),8,4,3,7,2,6,5,1,1.0d0)
371      END IF
372      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h6b)
373     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
374     &1b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) THEN
375      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
376     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
377     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
378     &mb(k_range+h7b-1),8,4,3,7,2,6,1,5,-1.0d0)
379      END IF
380      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h6b)
381     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
382     &3b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) THEN
383      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
384     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
385     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
386     &mb(k_range+h7b-1),8,4,3,7,6,2,5,1,-1.0d0)
387      END IF
388      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h6b)
389     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
390     &3b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) THEN
391      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
392     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
393     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
394     &mb(k_range+h7b-1),8,4,3,7,6,2,1,5,1.0d0)
395      END IF
396      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h6b)
397     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
398     &4b) .and. (t_p3b .eq. p1b) .and. (t_p4b .eq. p2b)) THEN
399      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
400     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
401     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
402     &mb(k_range+h7b-1),8,4,3,7,2,1,6,5,1.0d0)
403      END IF
404      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h6b)
405     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
406     &2b) .and. (t_p3b .eq. p3b) .and. (t_p4b .eq. p4b)) THEN
407      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
408     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
409     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
410     &mb(k_range+h7b-1),4,8,3,7,6,5,2,1,-1.0d0)
411      END IF
412      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h6b)
413     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
414     &1b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) THEN
415      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
416     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
417     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
418     &mb(k_range+h7b-1),4,8,3,7,2,6,5,1,-1.0d0)
419      END IF
420      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h6b)
421     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
422     &1b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) THEN
423      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
424     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
425     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
426     &mb(k_range+h7b-1),4,8,3,7,2,6,1,5,1.0d0)
427      END IF
428      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h6b)
429     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
430     &3b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) THEN
431      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
432     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
433     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
434     &mb(k_range+h7b-1),4,8,3,7,6,2,5,1,1.0d0)
435      END IF
436      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h6b)
437     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
438     &3b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) THEN
439      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
440     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
441     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
442     &mb(k_range+h7b-1),4,8,3,7,6,2,1,5,-1.0d0)
443      END IF
444      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h6b)
445     & .and. (t_h8b .eq. h8b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
446     &4b) .and. (t_p3b .eq. p1b) .and. (t_p4b .eq. p2b)) THEN
447      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
448     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
449     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
450     &mb(k_range+h7b-1),4,8,3,7,2,1,6,5,-1.0d0)
451      END IF
452      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h8b)
453     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
454     &2b) .and. (t_p3b .eq. p3b) .and. (t_p4b .eq. p4b)) THEN
455      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
456     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
457     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
458     &mb(k_range+h7b-1),8,4,7,3,6,5,2,1,-1.0d0)
459      END IF
460      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h8b)
461     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
462     &1b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) THEN
463      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
464     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
465     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
466     &mb(k_range+h7b-1),8,4,7,3,2,6,5,1,-1.0d0)
467      END IF
468      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h8b)
469     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
470     &1b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) THEN
471      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
472     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
473     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
474     &mb(k_range+h7b-1),8,4,7,3,2,6,1,5,1.0d0)
475      END IF
476      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h8b)
477     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
478     &3b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) THEN
479      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
480     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
481     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
482     &mb(k_range+h7b-1),8,4,7,3,6,2,5,1,1.0d0)
483      END IF
484      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h8b)
485     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
486     &3b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) THEN
487      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
488     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
489     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
490     &mb(k_range+h7b-1),8,4,7,3,6,2,1,5,-1.0d0)
491      END IF
492      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h5b) .and. (t_h7b .eq. h8b)
493     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
494     &4b) .and. (t_p3b .eq. p1b) .and. (t_p4b .eq. p2b)) THEN
495      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
496     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
497     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
498     &mb(k_range+h7b-1),8,4,7,3,2,1,6,5,-1.0d0)
499      END IF
500      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h8b)
501     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
502     &2b) .and. (t_p3b .eq. p3b) .and. (t_p4b .eq. p4b)) THEN
503      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
504     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
505     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
506     &mb(k_range+h7b-1),4,8,7,3,6,5,2,1,1.0d0)
507      END IF
508      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h8b)
509     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
510     &1b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) THEN
511      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
512     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
513     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
514     &mb(k_range+h7b-1),4,8,7,3,2,6,5,1,1.0d0)
515      END IF
516      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h8b)
517     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
518     &1b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) THEN
519      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
520     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
521     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
522     &mb(k_range+h7b-1),4,8,7,3,2,6,1,5,-1.0d0)
523      END IF
524      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h8b)
525     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
526     &3b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) THEN
527      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
528     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
529     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
530     &mb(k_range+h7b-1),4,8,7,3,6,2,5,1,-1.0d0)
531      END IF
532      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h8b)
533     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
534     &3b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) THEN
535      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
536     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
537     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
538     &mb(k_range+h7b-1),4,8,7,3,6,2,1,5,1.0d0)
539      END IF
540      IF ((t_h5b .eq. h5b) .and. (t_h6b .eq. h7b) .and. (t_h7b .eq. h8b)
541     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
542     &4b) .and. (t_p3b .eq. p1b) .and. (t_p4b .eq. p2b)) THEN
543      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
544     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
545     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
546     &mb(k_range+h7b-1),4,8,7,3,2,1,6,5,1.0d0)
547      END IF
548      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h8b) .and. (t_h7b .eq. h5b)
549     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
550     &2b) .and. (t_p3b .eq. p3b) .and. (t_p4b .eq. p4b)) THEN
551      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
552     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
553     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
554     &mb(k_range+h7b-1),8,7,4,3,6,5,2,1,1.0d0)
555      END IF
556      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h8b) .and. (t_h7b .eq. h5b)
557     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
558     &1b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) THEN
559      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
560     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
561     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
562     &mb(k_range+h7b-1),8,7,4,3,2,6,5,1,1.0d0)
563      END IF
564      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h8b) .and. (t_h7b .eq. h5b)
565     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
566     &1b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) THEN
567      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
568     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
569     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
570     &mb(k_range+h7b-1),8,7,4,3,2,6,1,5,-1.0d0)
571      END IF
572      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h8b) .and. (t_h7b .eq. h5b)
573     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
574     &3b) .and. (t_p3b .eq. p2b) .and. (t_p4b .eq. p4b)) THEN
575      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
576     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
577     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
578     &mb(k_range+h7b-1),8,7,4,3,6,2,5,1,-1.0d0)
579      END IF
580      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h8b) .and. (t_h7b .eq. h5b)
581     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p1b) .and. (t_p2b .eq. p
582     &3b) .and. (t_p3b .eq. p4b) .and. (t_p4b .eq. p2b)) THEN
583      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
584     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
585     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
586     &mb(k_range+h7b-1),8,7,4,3,6,2,1,5,1.0d0)
587      END IF
588      IF ((t_h5b .eq. h7b) .and. (t_h6b .eq. h8b) .and. (t_h7b .eq. h5b)
589     & .and. (t_h8b .eq. h6b) .and. (t_p1b .eq. p3b) .and. (t_p2b .eq. p
590     &4b) .and. (t_p3b .eq. p1b) .and. (t_p4b .eq. p2b)) THEN
591      CALL TCE_SORTACC_8(dbl_mb(k_c_sort),a_c,int_mb(k_range+p4b-1),int_
592     &mb(k_range+p3b-1),int_mb(k_range+h6b-1),int_mb(k_range+h5b-1),int_
593     &mb(k_range+p2b-1),int_mb(k_range+p1b-1),int_mb(k_range+h8b-1),int_
594     &mb(k_range+h7b-1),8,7,4,3,2,1,6,5,1.0d0)
595      END IF
596      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('ccsd2_q_left_1',9,M
597     &A_ERR)
598      END IF
599      END IF
600      END IF
601      END IF
602      END DO
603      END DO
604      END DO
605      END DO
606      END DO
607      END DO
608      END DO
609      END DO
610      RETURN
611      END
612