1      SUBROUTINE eomccsdtq_x4_13(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_o
2     &ffset)
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 ( p5 p6 p7 p8 h1 h2 h3 h4 )_vxt + = -1 * P( 24 ) * Sum ( h14 ) * t ( p5 p6 p7 h1 h2 h14 )_t * i1 ( h14 p8 h3 h4 )_vx
7      IMPLICIT NONE
8#include "global.fh"
9#include "mafdecls.fh"
10#include "sym.fh"
11#include "errquit.fh"
12#include "tce.fh"
13      INTEGER d_a
14      INTEGER k_a_offset
15      INTEGER d_b
16      INTEGER k_b_offset
17      INTEGER d_c
18      INTEGER k_c_offset
19      INTEGER NXTASK
20      INTEGER next
21      INTEGER nprocs
22      INTEGER count
23      INTEGER p5b
24      INTEGER p6b
25      INTEGER p7b
26      INTEGER p8b
27      INTEGER h1b
28      INTEGER h2b
29      INTEGER h3b
30      INTEGER h4b
31      INTEGER dimc
32      INTEGER l_c_sort
33      INTEGER k_c_sort
34      INTEGER h14b
35      INTEGER p5b_1
36      INTEGER p6b_1
37      INTEGER p7b_1
38      INTEGER h1b_1
39      INTEGER h2b_1
40      INTEGER h14b_1
41      INTEGER p8b_2
42      INTEGER h14b_2
43      INTEGER h3b_2
44      INTEGER h4b_2
45      INTEGER dim_common
46      INTEGER dima_sort
47      INTEGER dima
48      INTEGER dimb_sort
49      INTEGER dimb
50      INTEGER l_a_sort
51      INTEGER k_a_sort
52      INTEGER l_a
53      INTEGER k_a
54      INTEGER l_b_sort
55      INTEGER k_b_sort
56      INTEGER l_b
57      INTEGER k_b
58      INTEGER l_c
59      INTEGER k_c
60      EXTERNAL NXTASK
61      nprocs = GA_NNODES()
62      count = 0
63      next = NXTASK(nprocs,1)
64      DO p5b = noab+1,noab+nvab
65      DO p6b = p5b,noab+nvab
66      DO p7b = p6b,noab+nvab
67      DO p8b = noab+1,noab+nvab
68      DO h1b = 1,noab
69      DO h2b = h1b,noab
70      DO h3b = 1,noab
71      DO h4b = h3b,noab
72      IF (next.eq.count) THEN
73      IF ((.not.restricted).or.(int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1
74     &)+int_mb(k_spin+p7b-1)+int_mb(k_spin+p8b-1)+int_mb(k_spin+h1b-1)+i
75     &nt_mb(k_spin+h2b-1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1).ne.1
76     &6)) THEN
77      IF (int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1)+int_mb(k_spin+p7b-1)
78     &+int_mb(k_spin+p8b-1) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-
79     &1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1)) THEN
80      IF (ieor(int_mb(k_sym+p5b-1),ieor(int_mb(k_sym+p6b-1),ieor(int_mb(
81     &k_sym+p7b-1),ieor(int_mb(k_sym+p8b-1),ieor(int_mb(k_sym+h1b-1),ieo
82     &r(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h3b-1),int_mb(k_sym+h4b-1)
83     &))))))) .eq. ieor(irrep_v,ieor(irrep_x,irrep_t))) THEN
84      dimc = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_mb(k_ra
85     &nge+p7b-1) * int_mb(k_range+p8b-1) * int_mb(k_range+h1b-1) * int_m
86     &b(k_range+h2b-1) * int_mb(k_range+h3b-1) * int_mb(k_range+h4b-1)
87      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
88     & ERRQUIT('eomccsdtq_x4_13',0,MA_ERR)
89      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
90      DO h14b = 1,noab
91      IF (int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1)+int_mb(k_spin+p7b-1)
92     & .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h14b
93     &-1)) THEN
94      IF (ieor(int_mb(k_sym+p5b-1),ieor(int_mb(k_sym+p6b-1),ieor(int_mb(
95     &k_sym+p7b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),int
96     &_mb(k_sym+h14b-1)))))) .eq. irrep_t) THEN
97      CALL TCE_RESTRICTED_6(p5b,p6b,p7b,h1b,h2b,h14b,p5b_1,p6b_1,p7b_1,h
98     &1b_1,h2b_1,h14b_1)
99      CALL TCE_RESTRICTED_4(p8b,h14b,h3b,h4b,p8b_2,h14b_2,h3b_2,h4b_2)
100      dim_common = int_mb(k_range+h14b-1)
101      dima_sort = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_mb
102     &(k_range+p7b-1) * int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1)
103      dima = dim_common * dima_sort
104      dimb_sort = int_mb(k_range+p8b-1) * int_mb(k_range+h3b-1) * int_mb
105     &(k_range+h4b-1)
106      dimb = dim_common * dimb_sort
107      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
108      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
109     & ERRQUIT('eomccsdtq_x4_13',1,MA_ERR)
110      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
111     &eomccsdtq_x4_13',2,MA_ERR)
112      IF ((h14b .lt. h1b)) THEN
113      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h2b_1
114     & - 1 + noab * (h1b_1 - 1 + noab * (h14b_1 - 1 + noab * (p7b_1 - no
115     &ab - 1 + nvab * (p6b_1 - noab - 1 + nvab * (p5b_1 - noab - 1))))))
116     &)
117      CALL TCE_SORT_6(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
118     &,int_mb(k_range+p6b-1),int_mb(k_range+p7b-1),int_mb(k_range+h14b-1
119     &),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1),6,5,3,2,1,4,1.0d0)
120      END IF
121      IF ((h1b .le. h14b) .and. (h14b .lt. h2b)) THEN
122      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h2b_1
123     & - 1 + noab * (h14b_1 - 1 + noab * (h1b_1 - 1 + noab * (p7b_1 - no
124     &ab - 1 + nvab * (p6b_1 - noab - 1 + nvab * (p5b_1 - noab - 1))))))
125     &)
126      CALL TCE_SORT_6(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
127     &,int_mb(k_range+p6b-1),int_mb(k_range+p7b-1),int_mb(k_range+h1b-1)
128     &,int_mb(k_range+h14b-1),int_mb(k_range+h2b-1),6,4,3,2,1,5,-1.0d0)
129      END IF
130      IF ((h2b .le. h14b)) THEN
131      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h14b_
132     &1 - 1 + noab * (h2b_1 - 1 + noab * (h1b_1 - 1 + noab * (p7b_1 - no
133     &ab - 1 + nvab * (p6b_1 - noab - 1 + nvab * (p5b_1 - noab - 1))))))
134     &)
135      CALL TCE_SORT_6(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
136     &,int_mb(k_range+p6b-1),int_mb(k_range+p7b-1),int_mb(k_range+h1b-1)
137     &,int_mb(k_range+h2b-1),int_mb(k_range+h14b-1),5,4,3,2,1,6,1.0d0)
138      END IF
139      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('eomccsdtq_x4_13',3,MA_ER
140     &R)
141      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
142     & ERRQUIT('eomccsdtq_x4_13',4,MA_ERR)
143      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
144     &eomccsdtq_x4_13',5,MA_ERR)
145      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h4b_2
146     & - 1 + noab * (h3b_2 - 1 + noab * (h14b_2 - 1 + noab * (p8b_2 - no
147     &ab - 1)))))
148      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p8b-1)
149     &,int_mb(k_range+h14b-1),int_mb(k_range+h3b-1),int_mb(k_range+h4b-1
150     &),4,3,1,2,1.0d0)
151      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('eomccsdtq_x4_13',6,MA_ER
152     &R)
153      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
154     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
155     &t),dima_sort)
156      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('eomccsdtq_x4_13',7,
157     &MA_ERR)
158      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('eomccsdtq_x4_13',8,
159     &MA_ERR)
160      END IF
161      END IF
162      END IF
163      END DO
164      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
165     &eomccsdtq_x4_13',9,MA_ERR)
166      IF ((p7b .le. p8b) .and. (h2b .le. h3b)) THEN
167      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
168     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
169     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
170     &,int_mb(k_range+p5b-1),8,7,6,3,5,4,2,1,-1.0d0)
171      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
172     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
173     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
174     &+ nvab * (p5b - noab - 1)))))))))
175      END IF
176      IF ((p7b .le. p8b) .and. (h3b .le. h1b) .and. (h2b .le. h4b)) THEN
177      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
178     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
179     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
180     &,int_mb(k_range+p5b-1),8,7,6,3,2,5,4,1,-1.0d0)
181      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
182     & 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab *
183     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
184     &+ nvab * (p5b - noab - 1)))))))))
185      END IF
186      IF ((p7b .le. p8b) .and. (h1b .le. h3b) .and. (h3b .le. h2b) .and.
187     & (h2b .le. h4b)) THEN
188      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
189     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
190     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
191     &,int_mb(k_range+p5b-1),8,7,6,3,5,2,4,1,1.0d0)
192      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
193     & 1 + noab * (h2b - 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab *
194     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
195     &+ nvab * (p5b - noab - 1)))))))))
196      END IF
197      IF ((p7b .le. p8b) .and. (h3b .le. h1b) .and. (h1b .le. h4b) .and.
198     & (h4b .le. h2b)) THEN
199      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
200     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
201     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
202     &,int_mb(k_range+p5b-1),8,7,6,3,2,5,1,4,1.0d0)
203      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
204     & 1 + noab * (h4b - 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab *
205     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
206     &+ nvab * (p5b - noab - 1)))))))))
207      END IF
208      IF ((p7b .le. p8b) .and. (h1b .le. h3b) .and. (h4b .le. h2b)) THEN
209      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
210     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
211     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
212     &,int_mb(k_range+p5b-1),8,7,6,3,5,2,1,4,-1.0d0)
213      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
214     & 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab *
215     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
216     &+ nvab * (p5b - noab - 1)))))))))
217      END IF
218      IF ((p7b .le. p8b) .and. (h4b .le. h1b)) THEN
219      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
220     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
221     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
222     &,int_mb(k_range+p5b-1),8,7,6,3,2,1,5,4,-1.0d0)
223      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
224     & 1 + noab * (h1b - 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab *
225     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
226     &+ nvab * (p5b - noab - 1)))))))))
227      END IF
228      IF ((p8b .le. p5b) .and. (h2b .le. h3b)) THEN
229      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
230     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
231     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
232     &,int_mb(k_range+p5b-1),3,8,7,6,5,4,2,1,1.0d0)
233      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
234     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
235     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p5b - noab - 1
236     &+ nvab * (p8b - noab - 1)))))))))
237      END IF
238      IF ((p8b .le. p5b) .and. (h3b .le. h1b) .and. (h2b .le. h4b)) THEN
239      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
240     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
241     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
242     &,int_mb(k_range+p5b-1),3,8,7,6,2,5,4,1,1.0d0)
243      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
244     & 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab *
245     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p5b - noab - 1
246     &+ nvab * (p8b - noab - 1)))))))))
247      END IF
248      IF ((p8b .le. p5b) .and. (h1b .le. h3b) .and. (h3b .le. h2b) .and.
249     & (h2b .le. h4b)) THEN
250      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
251     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
252     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
253     &,int_mb(k_range+p5b-1),3,8,7,6,5,2,4,1,-1.0d0)
254      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
255     & 1 + noab * (h2b - 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab *
256     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p5b - noab - 1
257     &+ nvab * (p8b - noab - 1)))))))))
258      END IF
259      IF ((p8b .le. p5b) .and. (h3b .le. h1b) .and. (h1b .le. h4b) .and.
260     & (h4b .le. h2b)) THEN
261      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
262     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
263     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
264     &,int_mb(k_range+p5b-1),3,8,7,6,2,5,1,4,-1.0d0)
265      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
266     & 1 + noab * (h4b - 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab *
267     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p5b - noab - 1
268     &+ nvab * (p8b - noab - 1)))))))))
269      END IF
270      IF ((p8b .le. p5b) .and. (h1b .le. h3b) .and. (h4b .le. h2b)) THEN
271      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
272     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
273     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
274     &,int_mb(k_range+p5b-1),3,8,7,6,5,2,1,4,1.0d0)
275      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
276     & 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab *
277     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p5b - noab - 1
278     &+ nvab * (p8b - noab - 1)))))))))
279      END IF
280      IF ((p8b .le. p5b) .and. (h4b .le. h1b)) THEN
281      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
282     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
283     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
284     &,int_mb(k_range+p5b-1),3,8,7,6,2,1,5,4,1.0d0)
285      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
286     & 1 + noab * (h1b - 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab *
287     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p5b - noab - 1
288     &+ nvab * (p8b - noab - 1)))))))))
289      END IF
290      IF ((p5b .le. p8b) .and. (p8b .le. p6b) .and. (h2b .le. h3b)) THEN
291      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
292     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
293     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
294     &,int_mb(k_range+p5b-1),8,3,7,6,5,4,2,1,-1.0d0)
295      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
296     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
297     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p8b - noab - 1
298     &+ nvab * (p5b - noab - 1)))))))))
299      END IF
300      IF ((p5b .le. p8b) .and. (p8b .le. p6b) .and. (h3b .le. h1b) .and.
301     & (h2b .le. h4b)) THEN
302      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
303     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
304     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
305     &,int_mb(k_range+p5b-1),8,3,7,6,2,5,4,1,-1.0d0)
306      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
307     & 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab *
308     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p8b - noab - 1
309     &+ nvab * (p5b - noab - 1)))))))))
310      END IF
311      IF ((p5b .le. p8b) .and. (p8b .le. p6b) .and. (h1b .le. h3b) .and.
312     & (h3b .le. h2b) .and. (h2b .le. h4b)) THEN
313      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
314     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
315     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
316     &,int_mb(k_range+p5b-1),8,3,7,6,5,2,4,1,1.0d0)
317      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
318     & 1 + noab * (h2b - 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab *
319     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p8b - noab - 1
320     &+ nvab * (p5b - noab - 1)))))))))
321      END IF
322      IF ((p5b .le. p8b) .and. (p8b .le. p6b) .and. (h3b .le. h1b) .and.
323     & (h1b .le. h4b) .and. (h4b .le. h2b)) THEN
324      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
325     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
326     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
327     &,int_mb(k_range+p5b-1),8,3,7,6,2,5,1,4,1.0d0)
328      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
329     & 1 + noab * (h4b - 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab *
330     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p8b - noab - 1
331     &+ nvab * (p5b - noab - 1)))))))))
332      END IF
333      IF ((p5b .le. p8b) .and. (p8b .le. p6b) .and. (h1b .le. h3b) .and.
334     & (h4b .le. h2b)) THEN
335      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
336     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
337     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
338     &,int_mb(k_range+p5b-1),8,3,7,6,5,2,1,4,-1.0d0)
339      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
340     & 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab *
341     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p8b - noab - 1
342     &+ nvab * (p5b - noab - 1)))))))))
343      END IF
344      IF ((p5b .le. p8b) .and. (p8b .le. p6b) .and. (h4b .le. h1b)) THEN
345      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
346     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
347     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
348     &,int_mb(k_range+p5b-1),8,3,7,6,2,1,5,4,-1.0d0)
349      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
350     & 1 + noab * (h1b - 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab *
351     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p8b - noab - 1
352     &+ nvab * (p5b - noab - 1)))))))))
353      END IF
354      IF ((p6b .le. p8b) .and. (p8b .le. p7b) .and. (h2b .le. h3b)) THEN
355      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
356     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
357     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
358     &,int_mb(k_range+p5b-1),8,7,3,6,5,4,2,1,1.0d0)
359      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
360     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
361     &(p7b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p6b - noab - 1
362     &+ nvab * (p5b - noab - 1)))))))))
363      END IF
364      IF ((p6b .le. p8b) .and. (p8b .le. p7b) .and. (h3b .le. h1b) .and.
365     & (h2b .le. h4b)) THEN
366      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
367     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
368     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
369     &,int_mb(k_range+p5b-1),8,7,3,6,2,5,4,1,1.0d0)
370      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
371     & 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab *
372     &(p7b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p6b - noab - 1
373     &+ nvab * (p5b - noab - 1)))))))))
374      END IF
375      IF ((p6b .le. p8b) .and. (p8b .le. p7b) .and. (h1b .le. h3b) .and.
376     & (h3b .le. h2b) .and. (h2b .le. h4b)) THEN
377      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
378     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
379     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
380     &,int_mb(k_range+p5b-1),8,7,3,6,5,2,4,1,-1.0d0)
381      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
382     & 1 + noab * (h2b - 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab *
383     &(p7b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p6b - noab - 1
384     &+ nvab * (p5b - noab - 1)))))))))
385      END IF
386      IF ((p6b .le. p8b) .and. (p8b .le. p7b) .and. (h3b .le. h1b) .and.
387     & (h1b .le. h4b) .and. (h4b .le. h2b)) THEN
388      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
389     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
390     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
391     &,int_mb(k_range+p5b-1),8,7,3,6,2,5,1,4,-1.0d0)
392      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
393     & 1 + noab * (h4b - 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab *
394     &(p7b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p6b - noab - 1
395     &+ nvab * (p5b - noab - 1)))))))))
396      END IF
397      IF ((p6b .le. p8b) .and. (p8b .le. p7b) .and. (h1b .le. h3b) .and.
398     & (h4b .le. h2b)) THEN
399      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
400     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
401     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
402     &,int_mb(k_range+p5b-1),8,7,3,6,5,2,1,4,1.0d0)
403      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
404     & 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab *
405     &(p7b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p6b - noab - 1
406     &+ nvab * (p5b - noab - 1)))))))))
407      END IF
408      IF ((p6b .le. p8b) .and. (p8b .le. p7b) .and. (h4b .le. h1b)) THEN
409      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
410     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
411     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
412     &,int_mb(k_range+p5b-1),8,7,3,6,2,1,5,4,1.0d0)
413      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
414     & 1 + noab * (h1b - 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab *
415     &(p7b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p6b - noab - 1
416     &+ nvab * (p5b - noab - 1)))))))))
417      END IF
418      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('eomccsdtq_x4_13',10,MA_E
419     &RR)
420      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('eomccsdtq_x4_13',11
421     &,MA_ERR)
422      END IF
423      END IF
424      END IF
425      next = NXTASK(nprocs,1)
426      END IF
427      count = count + 1
428      END DO
429      END DO
430      END DO
431      END DO
432      END DO
433      END DO
434      END DO
435      END DO
436      next = NXTASK(-nprocs,1)
437      call GA_SYNC()
438      RETURN
439      END
440