1      SUBROUTINE ccsdtq_o4(d_i0,d_o1,d_t1,d_t2,d_t3,d_t4,k_i0_offset,k_o
2     &1_offset,k_t1_offset,k_t2_offset,k_t3_offset,k_t4_offset)
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 )_to + = 1 * P( 4 ) * Sum ( h9 ) * o ( h9 h1 )_o * t ( p5 p6 p7 p8 h2 h3 h4 h9 )_t
7C     i0 ( p5 p6 p7 p8 h1 h2 h3 h4 )_to + = -1 * P( 4 ) * Sum ( p9 ) * o ( p5 p9 )_o * t ( p6 p7 p8 p9 h1 h2 h3 h4 )_t
8C     i0 ( p5 p6 p7 p8 h1 h2 h3 h4 )_ott + = -1 * P( 4 ) * Sum ( h9 ) * t ( p5 p6 p7 p8 h1 h2 h3 h9 )_t * i1 ( h9 h4 )_ot
9C         i1 ( h9 h1 )_ot + = 1 * Sum ( p10 ) * o ( h9 p10 )_o * t ( p10 h1 )_t
10C     i0 ( p5 p6 p7 p8 h1 h2 h3 h4 )_ott + = -1 * P( 4 ) * Sum ( h9 ) * t ( p5 h9 )_t * i1 ( h9 p6 p7 p8 h1 h2 h3 h4 )_ot
11C         i1 ( h9 p5 p6 p7 h1 h2 h3 h4 )_ot + = -1 * Sum ( p10 ) * o ( h9 p10 )_o * t ( p5 p6 p7 p10 h1 h2 h3 h4 )_t
12C     i0 ( p5 p6 p7 p8 h1 h2 h3 h4 )_ott + = -1 * P( 24 ) * Sum ( h9 ) * t ( p5 p6 p7 h1 h2 h9 )_t * i1 ( h9 p8 h3 h4 )_ot
13C         i1 ( h9 p5 h1 h2 )_ot + = -1 * Sum ( p10 ) * o ( h9 p10 )_o * t ( p5 p10 h1 h2 )_t
14C     i0 ( p5 p6 p7 p8 h1 h2 h3 h4 )_ott + = -1 * P( 24 ) * Sum ( h9 ) * t ( p5 p6 h1 h9 )_t * i1 ( h9 p7 p8 h2 h3 h4 )_ot
15C         i1 ( h9 p5 p6 h1 h2 h3 )_ot + = 1 * Sum ( p10 ) * o ( h9 p10 )_o * t ( p5 p6 p10 h1 h2 h3 )_t
16      IMPLICIT NONE
17#include "global.fh"
18#include "mafdecls.fh"
19#include "util.fh"
20#include "errquit.fh"
21#include "tce.fh"
22      INTEGER d_i0
23      INTEGER k_i0_offset
24      INTEGER d_o1
25      INTEGER k_o1_offset
26      INTEGER d_t4
27      INTEGER k_t4_offset
28      INTEGER d_i1
29      INTEGER k_i1_offset
30      INTEGER d_t1
31      INTEGER k_t1_offset
32      INTEGER d_t3
33      INTEGER k_t3_offset
34      INTEGER d_t2
35      INTEGER k_t2_offset
36      INTEGER l_i1_offset
37      INTEGER size_i1
38      CHARACTER*255 filename
39      CALL ccsdtq_o4_1(d_o1,k_o1_offset,d_t4,k_t4_offset,d_i0,k_i0_offse
40     &t)
41      CALL ccsdtq_o4_2(d_o1,k_o1_offset,d_t4,k_t4_offset,d_i0,k_i0_offse
42     &t)
43      CALL OFFSET_ccsdtq_o4_3_1(l_i1_offset,k_i1_offset,size_i1)
44      CALL TCE_FILENAME('ccsdtq_o4_3_1_i1',filename)
45      CALL CREATEFILE(filename,d_i1,size_i1)
46      CALL ccsdtq_o4_3_1(d_o1,k_o1_offset,d_t1,k_t1_offset,d_i1,k_i1_off
47     &set)
48      CALL RECONCILEFILE(d_i1,size_i1)
49      CALL ccsdtq_o4_3(d_t4,k_t4_offset,d_i1,k_i1_offset,d_i0,k_i0_offse
50     &t)
51      CALL DELETEFILE(d_i1)
52      IF (.not.MA_POP_STACK(l_i1_offset)) CALL ERRQUIT('ccsdtq_o4',-1,MA
53     &_ERR)
54      CALL OFFSET_ccsdtq_o4_4_1(l_i1_offset,k_i1_offset,size_i1)
55      CALL TCE_FILENAME('ccsdtq_o4_4_1_i1',filename)
56      CALL CREATEFILE(filename,d_i1,size_i1)
57      CALL ccsdtq_o4_4_1(d_o1,k_o1_offset,d_t4,k_t4_offset,d_i1,k_i1_off
58     &set)
59      CALL RECONCILEFILE(d_i1,size_i1)
60      CALL ccsdtq_o4_4(d_t1,k_t1_offset,d_i1,k_i1_offset,d_i0,k_i0_offse
61     &t)
62      CALL DELETEFILE(d_i1)
63      IF (.not.MA_POP_STACK(l_i1_offset)) CALL ERRQUIT('ccsdtq_o4',-1,MA
64     &_ERR)
65      CALL OFFSET_ccsdtq_o4_5_1(l_i1_offset,k_i1_offset,size_i1)
66      CALL TCE_FILENAME('ccsdtq_o4_5_1_i1',filename)
67      CALL CREATEFILE(filename,d_i1,size_i1)
68      CALL ccsdtq_o4_5_1(d_o1,k_o1_offset,d_t2,k_t2_offset,d_i1,k_i1_off
69     &set)
70      CALL RECONCILEFILE(d_i1,size_i1)
71      CALL ccsdtq_o4_5(d_t3,k_t3_offset,d_i1,k_i1_offset,d_i0,k_i0_offse
72     &t)
73      CALL DELETEFILE(d_i1)
74      IF (.not.MA_POP_STACK(l_i1_offset)) CALL ERRQUIT('ccsdtq_o4',-1,MA
75     &_ERR)
76      CALL OFFSET_ccsdtq_o4_6_1(l_i1_offset,k_i1_offset,size_i1)
77      CALL TCE_FILENAME('ccsdtq_o4_6_1_i1',filename)
78      CALL CREATEFILE(filename,d_i1,size_i1)
79      CALL ccsdtq_o4_6_1(d_o1,k_o1_offset,d_t3,k_t3_offset,d_i1,k_i1_off
80     &set)
81      CALL RECONCILEFILE(d_i1,size_i1)
82      CALL ccsdtq_o4_6(d_t2,k_t2_offset,d_i1,k_i1_offset,d_i0,k_i0_offse
83     &t)
84      CALL DELETEFILE(d_i1)
85      IF (.not.MA_POP_STACK(l_i1_offset)) CALL ERRQUIT('ccsdtq_o4',-1,MA
86     &_ERR)
87      RETURN
88      END
89      SUBROUTINE ccsdtq_o4_1(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
90     &t)
91C     $Id$
92C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
93C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
94C     i0 ( p5 p6 p7 p8 h1 h2 h3 h4 )_to + = 1 * P( 4 ) * Sum ( h9 ) * o ( h9 h1 )_o * t ( p5 p6 p7 p8 h2 h3 h4 h9 )_t
95      IMPLICIT NONE
96#include "global.fh"
97#include "mafdecls.fh"
98#include "sym.fh"
99#include "errquit.fh"
100#include "tce.fh"
101      INTEGER d_a
102      INTEGER k_a_offset
103      INTEGER d_b
104      INTEGER k_b_offset
105      INTEGER d_c
106      INTEGER k_c_offset
107      INTEGER NXTASK
108      INTEGER next
109      INTEGER nprocs
110      INTEGER count
111      INTEGER p5b
112      INTEGER p6b
113      INTEGER p7b
114      INTEGER p8b
115      INTEGER h1b
116      INTEGER h2b
117      INTEGER h3b
118      INTEGER h4b
119      INTEGER dimc
120      INTEGER l_c_sort
121      INTEGER k_c_sort
122      INTEGER h9b
123      INTEGER h9b_1
124      INTEGER h1b_1
125      INTEGER p5b_2
126      INTEGER p6b_2
127      INTEGER p7b_2
128      INTEGER p8b_2
129      INTEGER h2b_2
130      INTEGER h3b_2
131      INTEGER h4b_2
132      INTEGER h9b_2
133      INTEGER dim_common
134      INTEGER dima_sort
135      INTEGER dima
136      INTEGER dimb_sort
137      INTEGER dimb
138      INTEGER l_a_sort
139      INTEGER k_a_sort
140      INTEGER l_a
141      INTEGER k_a
142      INTEGER l_b_sort
143      INTEGER k_b_sort
144      INTEGER l_b
145      INTEGER k_b
146      INTEGER l_c
147      INTEGER k_c
148      EXTERNAL NXTASK
149      nprocs = GA_NNODES()
150      count = 0
151      next = NXTASK(nprocs,1)
152      DO p5b = noab+1,noab+nvab
153      DO p6b = p5b,noab+nvab
154      DO p7b = p6b,noab+nvab
155      DO p8b = p7b,noab+nvab
156      DO h1b = 1,noab
157      DO h2b = 1,noab
158      DO h3b = h2b,noab
159      DO h4b = h3b,noab
160      IF (next.eq.count) THEN
161      IF ((.not.restricted).or.(int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1
162     &)+int_mb(k_spin+p7b-1)+int_mb(k_spin+p8b-1)+int_mb(k_spin+h1b-1)+i
163     &nt_mb(k_spin+h2b-1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1).ne.1
164     &6)) THEN
165      IF (int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1)+int_mb(k_spin+p7b-1)
166     &+int_mb(k_spin+p8b-1) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-
167     &1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1)) THEN
168      IF (ieor(int_mb(k_sym+p5b-1),ieor(int_mb(k_sym+p6b-1),ieor(int_mb(
169     &k_sym+p7b-1),ieor(int_mb(k_sym+p8b-1),ieor(int_mb(k_sym+h1b-1),ieo
170     &r(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h3b-1),int_mb(k_sym+h4b-1)
171     &))))))) .eq. ieor(irrep_t,irrep_o)) THEN
172      dimc = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_mb(k_ra
173     &nge+p7b-1) * int_mb(k_range+p8b-1) * int_mb(k_range+h1b-1) * int_m
174     &b(k_range+h2b-1) * int_mb(k_range+h3b-1) * int_mb(k_range+h4b-1)
175      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
176     & ERRQUIT('ccsdtq_o4_1',0,MA_ERR)
177      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
178      DO h9b = 1,noab
179      IF (int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+h1b-1)) THEN
180      IF (ieor(int_mb(k_sym+h9b-1),int_mb(k_sym+h1b-1)) .eq. irrep_o) TH
181     &EN
182      CALL TCE_RESTRICTED_2(h9b,h1b,h9b_1,h1b_1)
183      CALL TCE_RESTRICTED_8(p5b,p6b,p7b,p8b,h2b,h3b,h4b,h9b,p5b_2,p6b_2,
184     &p7b_2,p8b_2,h2b_2,h3b_2,h4b_2,h9b_2)
185      dim_common = int_mb(k_range+h9b-1)
186      dima_sort = int_mb(k_range+h1b-1)
187      dima = dim_common * dima_sort
188      dimb_sort = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_mb
189     &(k_range+p7b-1) * int_mb(k_range+p8b-1) * int_mb(k_range+h2b-1) *
190     &int_mb(k_range+h3b-1) * int_mb(k_range+h4b-1)
191      dimb = dim_common * dimb_sort
192      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
193      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
194     & ERRQUIT('ccsdtq_o4_1',1,MA_ERR)
195      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
196     &ccsdtq_o4_1',2,MA_ERR)
197      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h1b_1
198     & - 1 + (noab+nvab) * (h9b_1 - 1)))
199      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h9b-1)
200     &,int_mb(k_range+h1b-1),2,1,1.0d0)
201      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('ccsdtq_o4_1',3,MA_ERR)
202      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
203     & ERRQUIT('ccsdtq_o4_1',4,MA_ERR)
204      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
205     &ccsdtq_o4_1',5,MA_ERR)
206      IF ((h9b .lt. h2b)) THEN
207      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h4b_2
208     & - 1 + noab * (h3b_2 - 1 + noab * (h2b_2 - 1 + noab * (h9b_2 - 1 +
209     & noab * (p8b_2 - noab - 1 + nvab * (p7b_2 - noab - 1 + nvab * (p6b
210     &_2 - noab - 1 + nvab * (p5b_2 - noab - 1)))))))))
211      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p5b-1)
212     &,int_mb(k_range+p6b-1),int_mb(k_range+p7b-1),int_mb(k_range+p8b-1)
213     &,int_mb(k_range+h9b-1),int_mb(k_range+h2b-1),int_mb(k_range+h3b-1)
214     &,int_mb(k_range+h4b-1),8,7,6,4,3,2,1,5,-1.0d0)
215      END IF
216      IF ((h2b .le. h9b) .and. (h9b .lt. h3b)) THEN
217      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h4b_2
218     & - 1 + noab * (h3b_2 - 1 + noab * (h9b_2 - 1 + noab * (h2b_2 - 1 +
219     & noab * (p8b_2 - noab - 1 + nvab * (p7b_2 - noab - 1 + nvab * (p6b
220     &_2 - noab - 1 + nvab * (p5b_2 - noab - 1)))))))))
221      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p5b-1)
222     &,int_mb(k_range+p6b-1),int_mb(k_range+p7b-1),int_mb(k_range+p8b-1)
223     &,int_mb(k_range+h2b-1),int_mb(k_range+h9b-1),int_mb(k_range+h3b-1)
224     &,int_mb(k_range+h4b-1),8,7,5,4,3,2,1,6,1.0d0)
225      END IF
226      IF ((h3b .le. h9b) .and. (h9b .lt. h4b)) THEN
227      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h4b_2
228     & - 1 + noab * (h9b_2 - 1 + noab * (h3b_2 - 1 + noab * (h2b_2 - 1 +
229     & noab * (p8b_2 - noab - 1 + nvab * (p7b_2 - noab - 1 + nvab * (p6b
230     &_2 - noab - 1 + nvab * (p5b_2 - noab - 1)))))))))
231      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p5b-1)
232     &,int_mb(k_range+p6b-1),int_mb(k_range+p7b-1),int_mb(k_range+p8b-1)
233     &,int_mb(k_range+h2b-1),int_mb(k_range+h3b-1),int_mb(k_range+h9b-1)
234     &,int_mb(k_range+h4b-1),8,6,5,4,3,2,1,7,-1.0d0)
235      END IF
236      IF ((h4b .le. h9b)) THEN
237      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h9b_2
238     & - 1 + noab * (h4b_2 - 1 + noab * (h3b_2 - 1 + noab * (h2b_2 - 1 +
239     & noab * (p8b_2 - noab - 1 + nvab * (p7b_2 - noab - 1 + nvab * (p6b
240     &_2 - noab - 1 + nvab * (p5b_2 - noab - 1)))))))))
241      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p5b-1)
242     &,int_mb(k_range+p6b-1),int_mb(k_range+p7b-1),int_mb(k_range+p8b-1)
243     &,int_mb(k_range+h2b-1),int_mb(k_range+h3b-1),int_mb(k_range+h4b-1)
244     &,int_mb(k_range+h9b-1),7,6,5,4,3,2,1,8,1.0d0)
245      END IF
246      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('ccsdtq_o4_1',6,MA_ERR)
247      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
248     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
249     &t),dima_sort)
250      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('ccsdtq_o4_1',7,MA_E
251     &RR)
252      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('ccsdtq_o4_1',8,MA_E
253     &RR)
254      END IF
255      END IF
256      END IF
257      END DO
258      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
259     &ccsdtq_o4_1',9,MA_ERR)
260      IF ((h1b .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+h2b-1),int_mb(k_range+p8b-1)
263     &,int_mb(k_range+p7b-1),int_mb(k_range+p6b-1),int_mb(k_range+p5b-1)
264     &,int_mb(k_range+h1b-1),7,6,5,4,8,3,2,1,1.0d0)
265      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
266     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
267     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
268     &+ nvab * (p5b - noab - 1)))))))))
269      END IF
270      IF ((h2b .le. h1b) .and. (h1b .le. h3b)) 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+h2b-1),int_mb(k_range+p8b-1)
273     &,int_mb(k_range+p7b-1),int_mb(k_range+p6b-1),int_mb(k_range+p5b-1)
274     &,int_mb(k_range+h1b-1),7,6,5,4,3,8,2,1,-1.0d0)
275      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
276     & 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab * (h2b - 1 + noab *
277     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
278     &+ nvab * (p5b - noab - 1)))))))))
279      END IF
280      IF ((h3b .le. h1b) .and. (h1b .le. h4b)) 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+h2b-1),int_mb(k_range+p8b-1)
283     &,int_mb(k_range+p7b-1),int_mb(k_range+p6b-1),int_mb(k_range+p5b-1)
284     &,int_mb(k_range+h1b-1),7,6,5,4,3,2,8,1,1.0d0)
285      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
286     & 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab *
287     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
288     &+ nvab * (p5b - noab - 1)))))))))
289      END IF
290      IF ((h4b .le. h1b)) 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+h2b-1),int_mb(k_range+p8b-1)
293     &,int_mb(k_range+p7b-1),int_mb(k_range+p6b-1),int_mb(k_range+p5b-1)
294     &,int_mb(k_range+h1b-1),7,6,5,4,3,2,1,8,-1.0d0)
295      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
296     & 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab *
297     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
298     &+ nvab * (p5b - noab - 1)))))))))
299      END IF
300      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsdtq_o4_1',10,MA_ERR)
301      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('ccsdtq_o4_1',11,MA_
302     &ERR)
303      END IF
304      END IF
305      END IF
306      next = NXTASK(nprocs,1)
307      END IF
308      count = count + 1
309      END DO
310      END DO
311      END DO
312      END DO
313      END DO
314      END DO
315      END DO
316      END DO
317      next = NXTASK(-nprocs,1)
318      call GA_SYNC()
319      RETURN
320      END
321      SUBROUTINE ccsdtq_o4_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
322     &t)
323C     $Id$
324C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
325C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
326C     i0 ( p5 p6 p7 p8 h1 h2 h3 h4 )_to + = -1 * P( 4 ) * Sum ( p9 ) * o ( p5 p9 )_o * t ( p6 p7 p8 p9 h1 h2 h3 h4 )_t
327      IMPLICIT NONE
328#include "global.fh"
329#include "mafdecls.fh"
330#include "sym.fh"
331#include "errquit.fh"
332#include "tce.fh"
333      INTEGER d_a
334      INTEGER k_a_offset
335      INTEGER d_b
336      INTEGER k_b_offset
337      INTEGER d_c
338      INTEGER k_c_offset
339      INTEGER NXTASK
340      INTEGER next
341      INTEGER nprocs
342      INTEGER count
343      INTEGER p5b
344      INTEGER p6b
345      INTEGER p7b
346      INTEGER p8b
347      INTEGER h1b
348      INTEGER h2b
349      INTEGER h3b
350      INTEGER h4b
351      INTEGER dimc
352      INTEGER l_c_sort
353      INTEGER k_c_sort
354      INTEGER p9b
355      INTEGER p5b_1
356      INTEGER p9b_1
357      INTEGER p6b_2
358      INTEGER p7b_2
359      INTEGER p8b_2
360      INTEGER p9b_2
361      INTEGER h1b_2
362      INTEGER h2b_2
363      INTEGER h3b_2
364      INTEGER h4b_2
365      INTEGER dim_common
366      INTEGER dima_sort
367      INTEGER dima
368      INTEGER dimb_sort
369      INTEGER dimb
370      INTEGER l_a_sort
371      INTEGER k_a_sort
372      INTEGER l_a
373      INTEGER k_a
374      INTEGER l_b_sort
375      INTEGER k_b_sort
376      INTEGER l_b
377      INTEGER k_b
378      INTEGER l_c
379      INTEGER k_c
380      EXTERNAL NXTASK
381      nprocs = GA_NNODES()
382      count = 0
383      next = NXTASK(nprocs,1)
384      DO p5b = noab+1,noab+nvab
385      DO p6b = noab+1,noab+nvab
386      DO p7b = p6b,noab+nvab
387      DO p8b = p7b,noab+nvab
388      DO h1b = 1,noab
389      DO h2b = h1b,noab
390      DO h3b = h2b,noab
391      DO h4b = h3b,noab
392      IF (next.eq.count) THEN
393      IF ((.not.restricted).or.(int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1
394     &)+int_mb(k_spin+p7b-1)+int_mb(k_spin+p8b-1)+int_mb(k_spin+h1b-1)+i
395     &nt_mb(k_spin+h2b-1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1).ne.1
396     &6)) THEN
397      IF (int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1)+int_mb(k_spin+p7b-1)
398     &+int_mb(k_spin+p8b-1) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-
399     &1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1)) THEN
400      IF (ieor(int_mb(k_sym+p5b-1),ieor(int_mb(k_sym+p6b-1),ieor(int_mb(
401     &k_sym+p7b-1),ieor(int_mb(k_sym+p8b-1),ieor(int_mb(k_sym+h1b-1),ieo
402     &r(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h3b-1),int_mb(k_sym+h4b-1)
403     &))))))) .eq. ieor(irrep_t,irrep_o)) THEN
404      dimc = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_mb(k_ra
405     &nge+p7b-1) * int_mb(k_range+p8b-1) * int_mb(k_range+h1b-1) * int_m
406     &b(k_range+h2b-1) * int_mb(k_range+h3b-1) * int_mb(k_range+h4b-1)
407      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
408     & ERRQUIT('ccsdtq_o4_2',0,MA_ERR)
409      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
410      DO p9b = noab+1,noab+nvab
411      IF (int_mb(k_spin+p5b-1) .eq. int_mb(k_spin+p9b-1)) THEN
412      IF (ieor(int_mb(k_sym+p5b-1),int_mb(k_sym+p9b-1)) .eq. irrep_o) TH
413     &EN
414      CALL TCE_RESTRICTED_2(p5b,p9b,p5b_1,p9b_1)
415      CALL TCE_RESTRICTED_8(p6b,p7b,p8b,p9b,h1b,h2b,h3b,h4b,p6b_2,p7b_2,
416     &p8b_2,p9b_2,h1b_2,h2b_2,h3b_2,h4b_2)
417      dim_common = int_mb(k_range+p9b-1)
418      dima_sort = int_mb(k_range+p5b-1)
419      dima = dim_common * dima_sort
420      dimb_sort = int_mb(k_range+p6b-1) * int_mb(k_range+p7b-1) * int_mb
421     &(k_range+p8b-1) * int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) *
422     &int_mb(k_range+h3b-1) * int_mb(k_range+h4b-1)
423      dimb = dim_common * dimb_sort
424      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
425      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
426     & ERRQUIT('ccsdtq_o4_2',1,MA_ERR)
427      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
428     &ccsdtq_o4_2',2,MA_ERR)
429      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
430     & - 1 + (noab+nvab) * (p5b_1 - 1)))
431      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
432     &,int_mb(k_range+p9b-1),1,2,1.0d0)
433      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('ccsdtq_o4_2',3,MA_ERR)
434      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
435     & ERRQUIT('ccsdtq_o4_2',4,MA_ERR)
436      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
437     &ccsdtq_o4_2',5,MA_ERR)
438      IF ((p9b .lt. p6b)) THEN
439      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h4b_2
440     & - 1 + noab * (h3b_2 - 1 + noab * (h2b_2 - 1 + noab * (h1b_2 - 1 +
441     & noab * (p8b_2 - noab - 1 + nvab * (p7b_2 - noab - 1 + nvab * (p6b
442     &_2 - noab - 1 + nvab * (p9b_2 - noab - 1)))))))))
443      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p9b-1)
444     &,int_mb(k_range+p6b-1),int_mb(k_range+p7b-1),int_mb(k_range+p8b-1)
445     &,int_mb(k_range+h1b-1),int_mb(k_range+h2b-1),int_mb(k_range+h3b-1)
446     &,int_mb(k_range+h4b-1),8,7,6,5,4,3,2,1,-1.0d0)
447      END IF
448      IF ((p6b .le. p9b) .and. (p9b .lt. p7b)) THEN
449      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h4b_2
450     & - 1 + noab * (h3b_2 - 1 + noab * (h2b_2 - 1 + noab * (h1b_2 - 1 +
451     & noab * (p8b_2 - noab - 1 + nvab * (p7b_2 - noab - 1 + nvab * (p9b
452     &_2 - noab - 1 + nvab * (p6b_2 - noab - 1)))))))))
453      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p6b-1)
454     &,int_mb(k_range+p9b-1),int_mb(k_range+p7b-1),int_mb(k_range+p8b-1)
455     &,int_mb(k_range+h1b-1),int_mb(k_range+h2b-1),int_mb(k_range+h3b-1)
456     &,int_mb(k_range+h4b-1),8,7,6,5,4,3,1,2,1.0d0)
457      END IF
458      IF ((p7b .le. p9b) .and. (p9b .lt. p8b)) THEN
459      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h4b_2
460     & - 1 + noab * (h3b_2 - 1 + noab * (h2b_2 - 1 + noab * (h1b_2 - 1 +
461     & noab * (p8b_2 - noab - 1 + nvab * (p9b_2 - noab - 1 + nvab * (p7b
462     &_2 - noab - 1 + nvab * (p6b_2 - noab - 1)))))))))
463      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p6b-1)
464     &,int_mb(k_range+p7b-1),int_mb(k_range+p9b-1),int_mb(k_range+p8b-1)
465     &,int_mb(k_range+h1b-1),int_mb(k_range+h2b-1),int_mb(k_range+h3b-1)
466     &,int_mb(k_range+h4b-1),8,7,6,5,4,2,1,3,-1.0d0)
467      END IF
468      IF ((p8b .le. p9b)) THEN
469      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h4b_2
470     & - 1 + noab * (h3b_2 - 1 + noab * (h2b_2 - 1 + noab * (h1b_2 - 1 +
471     & noab * (p9b_2 - noab - 1 + nvab * (p8b_2 - noab - 1 + nvab * (p7b
472     &_2 - noab - 1 + nvab * (p6b_2 - noab - 1)))))))))
473      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p6b-1)
474     &,int_mb(k_range+p7b-1),int_mb(k_range+p8b-1),int_mb(k_range+p9b-1)
475     &,int_mb(k_range+h1b-1),int_mb(k_range+h2b-1),int_mb(k_range+h3b-1)
476     &,int_mb(k_range+h4b-1),8,7,6,5,3,2,1,4,1.0d0)
477      END IF
478      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('ccsdtq_o4_2',6,MA_ERR)
479      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
480     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
481     &t),dima_sort)
482      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('ccsdtq_o4_2',7,MA_E
483     &RR)
484      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('ccsdtq_o4_2',8,MA_E
485     &RR)
486      END IF
487      END IF
488      END IF
489      END DO
490      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
491     &ccsdtq_o4_2',9,MA_ERR)
492      IF ((p5b .le. p6b)) THEN
493      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
494     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+h1b-1)
495     &,int_mb(k_range+p8b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
496     &,int_mb(k_range+p5b-1),8,7,6,5,4,3,2,1,-1.0d0)
497      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
498     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
499     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
500     &+ nvab * (p5b - noab - 1)))))))))
501      END IF
502      IF ((p6b .le. p5b) .and. (p5b .le. p7b)) THEN
503      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
504     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+h1b-1)
505     &,int_mb(k_range+p8b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
506     &,int_mb(k_range+p5b-1),7,8,6,5,4,3,2,1,1.0d0)
507      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
508     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
509     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p5b - noab - 1
510     &+ nvab * (p6b - noab - 1)))))))))
511      END IF
512      IF ((p7b .le. p5b) .and. (p5b .le. p8b)) THEN
513      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
514     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+h1b-1)
515     &,int_mb(k_range+p8b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
516     &,int_mb(k_range+p5b-1),7,6,8,5,4,3,2,1,-1.0d0)
517      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
518     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
519     &(p8b - noab - 1 + nvab * (p5b - noab - 1 + nvab * (p7b - noab - 1
520     &+ nvab * (p6b - noab - 1)))))))))
521      END IF
522      IF ((p8b .le. p5b)) THEN
523      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
524     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+h1b-1)
525     &,int_mb(k_range+p8b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
526     &,int_mb(k_range+p5b-1),7,6,5,8,4,3,2,1,1.0d0)
527      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
528     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
529     &(p5b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p7b - noab - 1
530     &+ nvab * (p6b - noab - 1)))))))))
531      END IF
532      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsdtq_o4_2',10,MA_ERR)
533      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('ccsdtq_o4_2',11,MA_
534     &ERR)
535      END IF
536      END IF
537      END IF
538      next = NXTASK(nprocs,1)
539      END IF
540      count = count + 1
541      END DO
542      END DO
543      END DO
544      END DO
545      END DO
546      END DO
547      END DO
548      END DO
549      next = NXTASK(-nprocs,1)
550      call GA_SYNC()
551      RETURN
552      END
553      SUBROUTINE ccsdtq_o4_3(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
554     &t)
555C     $Id$
556C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
557C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
558C     i0 ( p5 p6 p7 p8 h1 h2 h3 h4 )_ott + = -1 * P( 4 ) * Sum ( h9 ) * t ( p5 p6 p7 p8 h1 h2 h3 h9 )_t * i1 ( h9 h4 )_ot
559      IMPLICIT NONE
560#include "global.fh"
561#include "mafdecls.fh"
562#include "sym.fh"
563#include "errquit.fh"
564#include "tce.fh"
565      INTEGER d_a
566      INTEGER k_a_offset
567      INTEGER d_b
568      INTEGER k_b_offset
569      INTEGER d_c
570      INTEGER k_c_offset
571      INTEGER NXTASK
572      INTEGER next
573      INTEGER nprocs
574      INTEGER count
575      INTEGER p5b
576      INTEGER p6b
577      INTEGER p7b
578      INTEGER p8b
579      INTEGER h1b
580      INTEGER h2b
581      INTEGER h3b
582      INTEGER h4b
583      INTEGER dimc
584      INTEGER l_c_sort
585      INTEGER k_c_sort
586      INTEGER h9b
587      INTEGER p5b_1
588      INTEGER p6b_1
589      INTEGER p7b_1
590      INTEGER p8b_1
591      INTEGER h1b_1
592      INTEGER h2b_1
593      INTEGER h3b_1
594      INTEGER h9b_1
595      INTEGER h9b_2
596      INTEGER h4b_2
597      INTEGER dim_common
598      INTEGER dima_sort
599      INTEGER dima
600      INTEGER dimb_sort
601      INTEGER dimb
602      INTEGER l_a_sort
603      INTEGER k_a_sort
604      INTEGER l_a
605      INTEGER k_a
606      INTEGER l_b_sort
607      INTEGER k_b_sort
608      INTEGER l_b
609      INTEGER k_b
610      INTEGER l_c
611      INTEGER k_c
612      EXTERNAL NXTASK
613      nprocs = GA_NNODES()
614      count = 0
615      next = NXTASK(nprocs,1)
616      DO p5b = noab+1,noab+nvab
617      DO p6b = p5b,noab+nvab
618      DO p7b = p6b,noab+nvab
619      DO p8b = p7b,noab+nvab
620      DO h1b = 1,noab
621      DO h2b = h1b,noab
622      DO h3b = h2b,noab
623      DO h4b = 1,noab
624      IF (next.eq.count) THEN
625      IF ((.not.restricted).or.(int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1
626     &)+int_mb(k_spin+p7b-1)+int_mb(k_spin+p8b-1)+int_mb(k_spin+h1b-1)+i
627     &nt_mb(k_spin+h2b-1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1).ne.1
628     &6)) THEN
629      IF (int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1)+int_mb(k_spin+p7b-1)
630     &+int_mb(k_spin+p8b-1) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-
631     &1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1)) THEN
632      IF (ieor(int_mb(k_sym+p5b-1),ieor(int_mb(k_sym+p6b-1),ieor(int_mb(
633     &k_sym+p7b-1),ieor(int_mb(k_sym+p8b-1),ieor(int_mb(k_sym+h1b-1),ieo
634     &r(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h3b-1),int_mb(k_sym+h4b-1)
635     &))))))) .eq. ieor(irrep_o,ieor(irrep_t,irrep_t))) THEN
636      dimc = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_mb(k_ra
637     &nge+p7b-1) * int_mb(k_range+p8b-1) * int_mb(k_range+h1b-1) * int_m
638     &b(k_range+h2b-1) * int_mb(k_range+h3b-1) * int_mb(k_range+h4b-1)
639      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
640     & ERRQUIT('ccsdtq_o4_3',0,MA_ERR)
641      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
642      DO h9b = 1,noab
643      IF (int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1)+int_mb(k_spin+p7b-1)
644     &+int_mb(k_spin+p8b-1) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-
645     &1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h9b-1)) THEN
646      IF (ieor(int_mb(k_sym+p5b-1),ieor(int_mb(k_sym+p6b-1),ieor(int_mb(
647     &k_sym+p7b-1),ieor(int_mb(k_sym+p8b-1),ieor(int_mb(k_sym+h1b-1),ieo
648     &r(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h3b-1),int_mb(k_sym+h9b-1)
649     &))))))) .eq. irrep_t) THEN
650      CALL TCE_RESTRICTED_8(p5b,p6b,p7b,p8b,h1b,h2b,h3b,h9b,p5b_1,p6b_1,
651     &p7b_1,p8b_1,h1b_1,h2b_1,h3b_1,h9b_1)
652      CALL TCE_RESTRICTED_2(h9b,h4b,h9b_2,h4b_2)
653      dim_common = int_mb(k_range+h9b-1)
654      dima_sort = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_mb
655     &(k_range+p7b-1) * int_mb(k_range+p8b-1) * int_mb(k_range+h1b-1) *
656     &int_mb(k_range+h2b-1) * int_mb(k_range+h3b-1)
657      dima = dim_common * dima_sort
658      dimb_sort = int_mb(k_range+h4b-1)
659      dimb = dim_common * dimb_sort
660      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
661      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
662     & ERRQUIT('ccsdtq_o4_3',1,MA_ERR)
663      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
664     &ccsdtq_o4_3',2,MA_ERR)
665      IF ((h9b .lt. h1b)) THEN
666      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h3b_1
667     & - 1 + noab * (h2b_1 - 1 + noab * (h1b_1 - 1 + noab * (h9b_1 - 1 +
668     & noab * (p8b_1 - noab - 1 + nvab * (p7b_1 - noab - 1 + nvab * (p6b
669     &_1 - noab - 1 + nvab * (p5b_1 - noab - 1)))))))))
670      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
671     &,int_mb(k_range+p6b-1),int_mb(k_range+p7b-1),int_mb(k_range+p8b-1)
672     &,int_mb(k_range+h9b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1)
673     &,int_mb(k_range+h3b-1),8,7,6,4,3,2,1,5,-1.0d0)
674      END IF
675      IF ((h1b .le. h9b) .and. (h9b .lt. h2b)) THEN
676      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h3b_1
677     & - 1 + noab * (h2b_1 - 1 + noab * (h9b_1 - 1 + noab * (h1b_1 - 1 +
678     & noab * (p8b_1 - noab - 1 + nvab * (p7b_1 - noab - 1 + nvab * (p6b
679     &_1 - noab - 1 + nvab * (p5b_1 - noab - 1)))))))))
680      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
681     &,int_mb(k_range+p6b-1),int_mb(k_range+p7b-1),int_mb(k_range+p8b-1)
682     &,int_mb(k_range+h1b-1),int_mb(k_range+h9b-1),int_mb(k_range+h2b-1)
683     &,int_mb(k_range+h3b-1),8,7,5,4,3,2,1,6,1.0d0)
684      END IF
685      IF ((h2b .le. h9b) .and. (h9b .lt. h3b)) THEN
686      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h3b_1
687     & - 1 + noab * (h9b_1 - 1 + noab * (h2b_1 - 1 + noab * (h1b_1 - 1 +
688     & noab * (p8b_1 - noab - 1 + nvab * (p7b_1 - noab - 1 + nvab * (p6b
689     &_1 - noab - 1 + nvab * (p5b_1 - noab - 1)))))))))
690      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
691     &,int_mb(k_range+p6b-1),int_mb(k_range+p7b-1),int_mb(k_range+p8b-1)
692     &,int_mb(k_range+h1b-1),int_mb(k_range+h2b-1),int_mb(k_range+h9b-1)
693     &,int_mb(k_range+h3b-1),8,6,5,4,3,2,1,7,-1.0d0)
694      END IF
695      IF ((h3b .le. h9b)) THEN
696      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h9b_1
697     & - 1 + noab * (h3b_1 - 1 + noab * (h2b_1 - 1 + noab * (h1b_1 - 1 +
698     & noab * (p8b_1 - noab - 1 + nvab * (p7b_1 - noab - 1 + nvab * (p6b
699     &_1 - noab - 1 + nvab * (p5b_1 - noab - 1)))))))))
700      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
701     &,int_mb(k_range+p6b-1),int_mb(k_range+p7b-1),int_mb(k_range+p8b-1)
702     &,int_mb(k_range+h1b-1),int_mb(k_range+h2b-1),int_mb(k_range+h3b-1)
703     &,int_mb(k_range+h9b-1),7,6,5,4,3,2,1,8,1.0d0)
704      END IF
705      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('ccsdtq_o4_3',3,MA_ERR)
706      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
707     & ERRQUIT('ccsdtq_o4_3',4,MA_ERR)
708      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
709     &ccsdtq_o4_3',5,MA_ERR)
710      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h4b_2
711     & - 1 + noab * (h9b_2 - 1)))
712      CALL TCE_SORT_2(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h9b-1)
713     &,int_mb(k_range+h4b-1),2,1,1.0d0)
714      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('ccsdtq_o4_3',6,MA_ERR)
715      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
716     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
717     &t),dima_sort)
718      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('ccsdtq_o4_3',7,MA_E
719     &RR)
720      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('ccsdtq_o4_3',8,MA_E
721     &RR)
722      END IF
723      END IF
724      END IF
725      END DO
726      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
727     &ccsdtq_o4_3',9,MA_ERR)
728      IF ((h3b .le. h4b)) THEN
729      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
730     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+h1b-1)
731     &,int_mb(k_range+p8b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
732     &,int_mb(k_range+p5b-1),8,7,6,5,4,3,2,1,-1.0d0)
733      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
734     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
735     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
736     &+ nvab * (p5b - noab - 1)))))))))
737      END IF
738      IF ((h4b .le. h1b)) THEN
739      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
740     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+h1b-1)
741     &,int_mb(k_range+p8b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
742     &,int_mb(k_range+p5b-1),8,7,6,5,1,4,3,2,1.0d0)
743      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h3b -
744     & 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab * (h4b - 1 + noab *
745     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
746     &+ nvab * (p5b - noab - 1)))))))))
747      END IF
748      IF ((h1b .le. h4b) .and. (h4b .le. h2b)) THEN
749      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
750     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+h1b-1)
751     &,int_mb(k_range+p8b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
752     &,int_mb(k_range+p5b-1),8,7,6,5,4,1,3,2,-1.0d0)
753      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h3b -
754     & 1 + noab * (h2b - 1 + noab * (h4b - 1 + noab * (h1b - 1 + noab *
755     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
756     &+ nvab * (p5b - noab - 1)))))))))
757      END IF
758      IF ((h2b .le. h4b) .and. (h4b .le. h3b)) THEN
759      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
760     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+h1b-1)
761     &,int_mb(k_range+p8b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
762     &,int_mb(k_range+p5b-1),8,7,6,5,4,3,1,2,1.0d0)
763      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h3b -
764     & 1 + noab * (h4b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
765     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
766     &+ nvab * (p5b - noab - 1)))))))))
767      END IF
768      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsdtq_o4_3',10,MA_ERR)
769      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('ccsdtq_o4_3',11,MA_
770     &ERR)
771      END IF
772      END IF
773      END IF
774      next = NXTASK(nprocs,1)
775      END IF
776      count = count + 1
777      END DO
778      END DO
779      END DO
780      END DO
781      END DO
782      END DO
783      END DO
784      END DO
785      next = NXTASK(-nprocs,1)
786      call GA_SYNC()
787      RETURN
788      END
789      SUBROUTINE ccsdtq_o4_3_1(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_off
790     &set)
791C     $Id$
792C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
793C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
794C     i1 ( h9 h1 )_ot + = 1 * Sum ( p10 ) * o ( h9 p10 )_o * t ( p10 h1 )_t
795      IMPLICIT NONE
796#include "global.fh"
797#include "mafdecls.fh"
798#include "sym.fh"
799#include "errquit.fh"
800#include "tce.fh"
801      INTEGER d_a
802      INTEGER k_a_offset
803      INTEGER d_b
804      INTEGER k_b_offset
805      INTEGER d_c
806      INTEGER k_c_offset
807      INTEGER NXTASK
808      INTEGER next
809      INTEGER nprocs
810      INTEGER count
811      INTEGER h9b
812      INTEGER h1b
813      INTEGER dimc
814      INTEGER l_c_sort
815      INTEGER k_c_sort
816      INTEGER p10b
817      INTEGER h9b_1
818      INTEGER p10b_1
819      INTEGER p10b_2
820      INTEGER h1b_2
821      INTEGER dim_common
822      INTEGER dima_sort
823      INTEGER dima
824      INTEGER dimb_sort
825      INTEGER dimb
826      INTEGER l_a_sort
827      INTEGER k_a_sort
828      INTEGER l_a
829      INTEGER k_a
830      INTEGER l_b_sort
831      INTEGER k_b_sort
832      INTEGER l_b
833      INTEGER k_b
834      INTEGER l_c
835      INTEGER k_c
836      EXTERNAL NXTASK
837      nprocs = GA_NNODES()
838      count = 0
839      next = NXTASK(nprocs,1)
840      DO h9b = 1,noab
841      DO h1b = 1,noab
842      IF (next.eq.count) THEN
843      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h1b-1
844     &).ne.4)) THEN
845      IF (int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+h1b-1)) THEN
846      IF (ieor(int_mb(k_sym+h9b-1),int_mb(k_sym+h1b-1)) .eq. ieor(irrep_
847     &o,irrep_t)) THEN
848      dimc = int_mb(k_range+h9b-1) * int_mb(k_range+h1b-1)
849      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
850     & ERRQUIT('ccsdtq_o4_3_1',0,MA_ERR)
851      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
852      DO p10b = noab+1,noab+nvab
853      IF (int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+p10b-1)) THEN
854      IF (ieor(int_mb(k_sym+h9b-1),int_mb(k_sym+p10b-1)) .eq. irrep_o) T
855     &HEN
856      CALL TCE_RESTRICTED_2(h9b,p10b,h9b_1,p10b_1)
857      CALL TCE_RESTRICTED_2(p10b,h1b,p10b_2,h1b_2)
858      dim_common = int_mb(k_range+p10b-1)
859      dima_sort = int_mb(k_range+h9b-1)
860      dima = dim_common * dima_sort
861      dimb_sort = int_mb(k_range+h1b-1)
862      dimb = dim_common * dimb_sort
863      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
864      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
865     & ERRQUIT('ccsdtq_o4_3_1',1,MA_ERR)
866      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
867     &ccsdtq_o4_3_1',2,MA_ERR)
868      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p10b_
869     &1 - 1 + (noab+nvab) * (h9b_1 - 1)))
870      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h9b-1)
871     &,int_mb(k_range+p10b-1),1,2,1.0d0)
872      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('ccsdtq_o4_3_1',3,MA_ERR)
873      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
874     & ERRQUIT('ccsdtq_o4_3_1',4,MA_ERR)
875      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
876     &ccsdtq_o4_3_1',5,MA_ERR)
877      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h1b_2
878     & - 1 + noab * (p10b_2 - noab - 1)))
879      CALL TCE_SORT_2(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p10b-1
880     &),int_mb(k_range+h1b-1),2,1,1.0d0)
881      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('ccsdtq_o4_3_1',6,MA_ERR)
882      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
883     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
884     &t),dima_sort)
885      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('ccsdtq_o4_3_1',7,MA
886     &_ERR)
887      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('ccsdtq_o4_3_1',8,MA
888     &_ERR)
889      END IF
890      END IF
891      END IF
892      END DO
893      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
894     &ccsdtq_o4_3_1',9,MA_ERR)
895      CALL TCE_SORT_2(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h1b-1)
896     &,int_mb(k_range+h9b-1),2,1,1.0d0)
897      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
898     & 1 + noab * (h9b - 1)))
899      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsdtq_o4_3_1',10,MA_ERR
900     &)
901      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('ccsdtq_o4_3_1',11,M
902     &A_ERR)
903      END IF
904      END IF
905      END IF
906      next = NXTASK(nprocs,1)
907      END IF
908      count = count + 1
909      END DO
910      END DO
911      next = NXTASK(-nprocs,1)
912      call GA_SYNC()
913      RETURN
914      END
915      SUBROUTINE OFFSET_ccsdtq_o4_3_1(l_a_offset,k_a_offset,size)
916C     $Id$
917C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
918C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
919C     i1 ( h9 h1 )_ot
920      IMPLICIT NONE
921#include "global.fh"
922#include "mafdecls.fh"
923#include "sym.fh"
924#include "errquit.fh"
925#include "tce.fh"
926      INTEGER l_a_offset
927      INTEGER k_a_offset
928      INTEGER size
929      INTEGER length
930      INTEGER addr
931      INTEGER h9b
932      INTEGER h1b
933      length = 0
934      DO h9b = 1,noab
935      DO h1b = 1,noab
936      IF (int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+h1b-1)) THEN
937      IF (ieor(int_mb(k_sym+h9b-1),int_mb(k_sym+h1b-1)) .eq. ieor(irrep_
938     &o,irrep_t)) THEN
939      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h1b-1
940     &).ne.4)) THEN
941      length = length + 1
942      END IF
943      END IF
944      END IF
945      END DO
946      END DO
947      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
948     &set)) CALL ERRQUIT('ccsdtq_o4_3_1',0,MA_ERR)
949      int_mb(k_a_offset) = length
950      addr = 0
951      size = 0
952      DO h9b = 1,noab
953      DO h1b = 1,noab
954      IF (int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+h1b-1)) THEN
955      IF (ieor(int_mb(k_sym+h9b-1),int_mb(k_sym+h1b-1)) .eq. ieor(irrep_
956     &o,irrep_t)) THEN
957      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h1b-1
958     &).ne.4)) THEN
959      addr = addr + 1
960      int_mb(k_a_offset+addr) = h1b - 1 + noab * (h9b - 1)
961      int_mb(k_a_offset+length+addr) = size
962      size = size + int_mb(k_range+h9b-1) * int_mb(k_range+h1b-1)
963      END IF
964      END IF
965      END IF
966      END DO
967      END DO
968      RETURN
969      END
970      SUBROUTINE ccsdtq_o4_4(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
971     &t)
972C     $Id$
973C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
974C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
975C     i0 ( p5 p6 p7 p8 h1 h2 h3 h4 )_ott + = -1 * P( 4 ) * Sum ( h9 ) * t ( p5 h9 )_t * i1 ( h9 p6 p7 p8 h1 h2 h3 h4 )_ot
976      IMPLICIT NONE
977#include "global.fh"
978#include "mafdecls.fh"
979#include "sym.fh"
980#include "errquit.fh"
981#include "tce.fh"
982      INTEGER d_a
983      INTEGER k_a_offset
984      INTEGER d_b
985      INTEGER k_b_offset
986      INTEGER d_c
987      INTEGER k_c_offset
988      INTEGER NXTASK
989      INTEGER next
990      INTEGER nprocs
991      INTEGER count
992      INTEGER p5b
993      INTEGER p6b
994      INTEGER p7b
995      INTEGER p8b
996      INTEGER h1b
997      INTEGER h2b
998      INTEGER h3b
999      INTEGER h4b
1000      INTEGER dimc
1001      INTEGER l_c_sort
1002      INTEGER k_c_sort
1003      INTEGER h9b
1004      INTEGER p5b_1
1005      INTEGER h9b_1
1006      INTEGER p6b_2
1007      INTEGER p7b_2
1008      INTEGER p8b_2
1009      INTEGER h9b_2
1010      INTEGER h1b_2
1011      INTEGER h2b_2
1012      INTEGER h3b_2
1013      INTEGER h4b_2
1014      INTEGER dim_common
1015      INTEGER dima_sort
1016      INTEGER dima
1017      INTEGER dimb_sort
1018      INTEGER dimb
1019      INTEGER l_a_sort
1020      INTEGER k_a_sort
1021      INTEGER l_a
1022      INTEGER k_a
1023      INTEGER l_b_sort
1024      INTEGER k_b_sort
1025      INTEGER l_b
1026      INTEGER k_b
1027      INTEGER l_c
1028      INTEGER k_c
1029      EXTERNAL NXTASK
1030      nprocs = GA_NNODES()
1031      count = 0
1032      next = NXTASK(nprocs,1)
1033      DO p5b = noab+1,noab+nvab
1034      DO p6b = noab+1,noab+nvab
1035      DO p7b = p6b,noab+nvab
1036      DO p8b = p7b,noab+nvab
1037      DO h1b = 1,noab
1038      DO h2b = h1b,noab
1039      DO h3b = h2b,noab
1040      DO h4b = h3b,noab
1041      IF (next.eq.count) THEN
1042      IF ((.not.restricted).or.(int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1
1043     &)+int_mb(k_spin+p7b-1)+int_mb(k_spin+p8b-1)+int_mb(k_spin+h1b-1)+i
1044     &nt_mb(k_spin+h2b-1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1).ne.1
1045     &6)) THEN
1046      IF (int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1)+int_mb(k_spin+p7b-1)
1047     &+int_mb(k_spin+p8b-1) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-
1048     &1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1)) THEN
1049      IF (ieor(int_mb(k_sym+p5b-1),ieor(int_mb(k_sym+p6b-1),ieor(int_mb(
1050     &k_sym+p7b-1),ieor(int_mb(k_sym+p8b-1),ieor(int_mb(k_sym+h1b-1),ieo
1051     &r(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h3b-1),int_mb(k_sym+h4b-1)
1052     &))))))) .eq. ieor(irrep_o,ieor(irrep_t,irrep_t))) THEN
1053      dimc = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_mb(k_ra
1054     &nge+p7b-1) * int_mb(k_range+p8b-1) * int_mb(k_range+h1b-1) * int_m
1055     &b(k_range+h2b-1) * int_mb(k_range+h3b-1) * int_mb(k_range+h4b-1)
1056      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
1057     & ERRQUIT('ccsdtq_o4_4',0,MA_ERR)
1058      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
1059      DO h9b = 1,noab
1060      IF (int_mb(k_spin+p5b-1) .eq. int_mb(k_spin+h9b-1)) THEN
1061      IF (ieor(int_mb(k_sym+p5b-1),int_mb(k_sym+h9b-1)) .eq. irrep_t) TH
1062     &EN
1063      CALL TCE_RESTRICTED_2(p5b,h9b,p5b_1,h9b_1)
1064      CALL TCE_RESTRICTED_8(p6b,p7b,p8b,h9b,h1b,h2b,h3b,h4b,p6b_2,p7b_2,
1065     &p8b_2,h9b_2,h1b_2,h2b_2,h3b_2,h4b_2)
1066      dim_common = int_mb(k_range+h9b-1)
1067      dima_sort = int_mb(k_range+p5b-1)
1068      dima = dim_common * dima_sort
1069      dimb_sort = int_mb(k_range+p6b-1) * int_mb(k_range+p7b-1) * int_mb
1070     &(k_range+p8b-1) * int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) *
1071     &int_mb(k_range+h3b-1) * int_mb(k_range+h4b-1)
1072      dimb = dim_common * dimb_sort
1073      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
1074      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
1075     & ERRQUIT('ccsdtq_o4_4',1,MA_ERR)
1076      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
1077     &ccsdtq_o4_4',2,MA_ERR)
1078      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h9b_1
1079     & - 1 + noab * (p5b_1 - noab - 1)))
1080      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
1081     &,int_mb(k_range+h9b-1),1,2,1.0d0)
1082      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('ccsdtq_o4_4',3,MA_ERR)
1083      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
1084     & ERRQUIT('ccsdtq_o4_4',4,MA_ERR)
1085      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
1086     &ccsdtq_o4_4',5,MA_ERR)
1087      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h4b_2
1088     & - 1 + noab * (h3b_2 - 1 + noab * (h2b_2 - 1 + noab * (h1b_2 - 1 +
1089     & noab * (h9b_2 - 1 + noab * (p8b_2 - noab - 1 + nvab * (p7b_2 - no
1090     &ab - 1 + nvab * (p6b_2 - noab - 1)))))))))
1091      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p6b-1)
1092     &,int_mb(k_range+p7b-1),int_mb(k_range+p8b-1),int_mb(k_range+h9b-1)
1093     &,int_mb(k_range+h1b-1),int_mb(k_range+h2b-1),int_mb(k_range+h3b-1)
1094     &,int_mb(k_range+h4b-1),8,7,6,5,3,2,1,4,1.0d0)
1095      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('ccsdtq_o4_4',6,MA_ERR)
1096      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
1097     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
1098     &t),dima_sort)
1099      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('ccsdtq_o4_4',7,MA_E
1100     &RR)
1101      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('ccsdtq_o4_4',8,MA_E
1102     &RR)
1103      END IF
1104      END IF
1105      END IF
1106      END DO
1107      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
1108     &ccsdtq_o4_4',9,MA_ERR)
1109      IF ((p5b .le. p6b)) THEN
1110      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1111     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+h1b-1)
1112     &,int_mb(k_range+p8b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1113     &,int_mb(k_range+p5b-1),8,7,6,5,4,3,2,1,-1.0d0)
1114      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
1115     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
1116     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
1117     &+ nvab * (p5b - noab - 1)))))))))
1118      END IF
1119      IF ((p6b .le. p5b) .and. (p5b .le. p7b)) THEN
1120      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1121     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+h1b-1)
1122     &,int_mb(k_range+p8b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1123     &,int_mb(k_range+p5b-1),7,8,6,5,4,3,2,1,1.0d0)
1124      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
1125     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
1126     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p5b - noab - 1
1127     &+ nvab * (p6b - noab - 1)))))))))
1128      END IF
1129      IF ((p7b .le. p5b) .and. (p5b .le. p8b)) THEN
1130      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1131     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+h1b-1)
1132     &,int_mb(k_range+p8b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1133     &,int_mb(k_range+p5b-1),7,6,8,5,4,3,2,1,-1.0d0)
1134      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
1135     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
1136     &(p8b - noab - 1 + nvab * (p5b - noab - 1 + nvab * (p7b - noab - 1
1137     &+ nvab * (p6b - noab - 1)))))))))
1138      END IF
1139      IF ((p8b .le. p5b)) THEN
1140      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1141     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+h1b-1)
1142     &,int_mb(k_range+p8b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1143     &,int_mb(k_range+p5b-1),7,6,5,8,4,3,2,1,1.0d0)
1144      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
1145     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
1146     &(p5b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p7b - noab - 1
1147     &+ nvab * (p6b - noab - 1)))))))))
1148      END IF
1149      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsdtq_o4_4',10,MA_ERR)
1150      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('ccsdtq_o4_4',11,MA_
1151     &ERR)
1152      END IF
1153      END IF
1154      END IF
1155      next = NXTASK(nprocs,1)
1156      END IF
1157      count = count + 1
1158      END DO
1159      END DO
1160      END DO
1161      END DO
1162      END DO
1163      END DO
1164      END DO
1165      END DO
1166      next = NXTASK(-nprocs,1)
1167      call GA_SYNC()
1168      RETURN
1169      END
1170      SUBROUTINE ccsdtq_o4_4_1(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_off
1171     &set)
1172C     $Id$
1173C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
1174C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
1175C     i1 ( h9 p5 p6 p7 h1 h2 h3 h4 )_ot + = -1 * Sum ( p10 ) * o ( h9 p10 )_o * t ( p5 p6 p7 p10 h1 h2 h3 h4 )_t
1176      IMPLICIT NONE
1177#include "global.fh"
1178#include "mafdecls.fh"
1179#include "sym.fh"
1180#include "errquit.fh"
1181#include "tce.fh"
1182      INTEGER d_a
1183      INTEGER k_a_offset
1184      INTEGER d_b
1185      INTEGER k_b_offset
1186      INTEGER d_c
1187      INTEGER k_c_offset
1188      INTEGER NXTASK
1189      INTEGER next
1190      INTEGER nprocs
1191      INTEGER count
1192      INTEGER p5b
1193      INTEGER p6b
1194      INTEGER p7b
1195      INTEGER h9b
1196      INTEGER h1b
1197      INTEGER h2b
1198      INTEGER h3b
1199      INTEGER h4b
1200      INTEGER dimc
1201      INTEGER l_c_sort
1202      INTEGER k_c_sort
1203      INTEGER p10b
1204      INTEGER h9b_1
1205      INTEGER p10b_1
1206      INTEGER p5b_2
1207      INTEGER p6b_2
1208      INTEGER p7b_2
1209      INTEGER p10b_2
1210      INTEGER h1b_2
1211      INTEGER h2b_2
1212      INTEGER h3b_2
1213      INTEGER h4b_2
1214      INTEGER dim_common
1215      INTEGER dima_sort
1216      INTEGER dima
1217      INTEGER dimb_sort
1218      INTEGER dimb
1219      INTEGER l_a_sort
1220      INTEGER k_a_sort
1221      INTEGER l_a
1222      INTEGER k_a
1223      INTEGER l_b_sort
1224      INTEGER k_b_sort
1225      INTEGER l_b
1226      INTEGER k_b
1227      INTEGER l_c
1228      INTEGER k_c
1229      EXTERNAL NXTASK
1230      nprocs = GA_NNODES()
1231      count = 0
1232      next = NXTASK(nprocs,1)
1233      DO p5b = noab+1,noab+nvab
1234      DO p6b = p5b,noab+nvab
1235      DO p7b = p6b,noab+nvab
1236      DO h9b = 1,noab
1237      DO h1b = 1,noab
1238      DO h2b = h1b,noab
1239      DO h3b = h2b,noab
1240      DO h4b = h3b,noab
1241      IF (next.eq.count) THEN
1242      IF ((.not.restricted).or.(int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1
1243     &)+int_mb(k_spin+p7b-1)+int_mb(k_spin+h9b-1)+int_mb(k_spin+h1b-1)+i
1244     &nt_mb(k_spin+h2b-1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1).ne.1
1245     &6)) THEN
1246      IF (int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1)+int_mb(k_spin+p7b-1)
1247     &+int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-
1248     &1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1)) THEN
1249      IF (ieor(int_mb(k_sym+p5b-1),ieor(int_mb(k_sym+p6b-1),ieor(int_mb(
1250     &k_sym+p7b-1),ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+h1b-1),ieo
1251     &r(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h3b-1),int_mb(k_sym+h4b-1)
1252     &))))))) .eq. ieor(irrep_o,irrep_t)) THEN
1253      dimc = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_mb(k_ra
1254     &nge+p7b-1) * int_mb(k_range+h9b-1) * int_mb(k_range+h1b-1) * int_m
1255     &b(k_range+h2b-1) * int_mb(k_range+h3b-1) * int_mb(k_range+h4b-1)
1256      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
1257     & ERRQUIT('ccsdtq_o4_4_1',0,MA_ERR)
1258      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
1259      DO p10b = noab+1,noab+nvab
1260      IF (int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+p10b-1)) THEN
1261      IF (ieor(int_mb(k_sym+h9b-1),int_mb(k_sym+p10b-1)) .eq. irrep_o) T
1262     &HEN
1263      CALL TCE_RESTRICTED_2(h9b,p10b,h9b_1,p10b_1)
1264      CALL TCE_RESTRICTED_8(p5b,p6b,p7b,p10b,h1b,h2b,h3b,h4b,p5b_2,p6b_2
1265     &,p7b_2,p10b_2,h1b_2,h2b_2,h3b_2,h4b_2)
1266      dim_common = int_mb(k_range+p10b-1)
1267      dima_sort = int_mb(k_range+h9b-1)
1268      dima = dim_common * dima_sort
1269      dimb_sort = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_mb
1270     &(k_range+p7b-1) * int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) *
1271     &int_mb(k_range+h3b-1) * int_mb(k_range+h4b-1)
1272      dimb = dim_common * dimb_sort
1273      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
1274      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
1275     & ERRQUIT('ccsdtq_o4_4_1',1,MA_ERR)
1276      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
1277     &ccsdtq_o4_4_1',2,MA_ERR)
1278      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p10b_
1279     &1 - 1 + (noab+nvab) * (h9b_1 - 1)))
1280      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h9b-1)
1281     &,int_mb(k_range+p10b-1),1,2,1.0d0)
1282      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('ccsdtq_o4_4_1',3,MA_ERR)
1283      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
1284     & ERRQUIT('ccsdtq_o4_4_1',4,MA_ERR)
1285      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
1286     &ccsdtq_o4_4_1',5,MA_ERR)
1287      IF ((p10b .lt. p5b)) THEN
1288      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h4b_2
1289     & - 1 + noab * (h3b_2 - 1 + noab * (h2b_2 - 1 + noab * (h1b_2 - 1 +
1290     & noab * (p7b_2 - noab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p5b
1291     &_2 - noab - 1 + nvab * (p10b_2 - noab - 1)))))))))
1292      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p10b-1
1293     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p7b-1
1294     &),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1),int_mb(k_range+h3b-1
1295     &),int_mb(k_range+h4b-1),8,7,6,5,4,3,2,1,-1.0d0)
1296      END IF
1297      IF ((p5b .le. p10b) .and. (p10b .lt. p6b)) THEN
1298      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h4b_2
1299     & - 1 + noab * (h3b_2 - 1 + noab * (h2b_2 - 1 + noab * (h1b_2 - 1 +
1300     & noab * (p7b_2 - noab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p10
1301     &b_2 - noab - 1 + nvab * (p5b_2 - noab - 1)))))))))
1302      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p5b-1)
1303     &,int_mb(k_range+p10b-1),int_mb(k_range+p6b-1),int_mb(k_range+p7b-1
1304     &),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1),int_mb(k_range+h3b-1
1305     &),int_mb(k_range+h4b-1),8,7,6,5,4,3,1,2,1.0d0)
1306      END IF
1307      IF ((p6b .le. p10b) .and. (p10b .lt. p7b)) THEN
1308      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h4b_2
1309     & - 1 + noab * (h3b_2 - 1 + noab * (h2b_2 - 1 + noab * (h1b_2 - 1 +
1310     & noab * (p7b_2 - noab - 1 + nvab * (p10b_2 - noab - 1 + nvab * (p6
1311     &b_2 - noab - 1 + nvab * (p5b_2 - noab - 1)))))))))
1312      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p5b-1)
1313     &,int_mb(k_range+p6b-1),int_mb(k_range+p10b-1),int_mb(k_range+p7b-1
1314     &),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1),int_mb(k_range+h3b-1
1315     &),int_mb(k_range+h4b-1),8,7,6,5,4,2,1,3,-1.0d0)
1316      END IF
1317      IF ((p7b .le. p10b)) THEN
1318      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h4b_2
1319     & - 1 + noab * (h3b_2 - 1 + noab * (h2b_2 - 1 + noab * (h1b_2 - 1 +
1320     & noab * (p10b_2 - noab - 1 + nvab * (p7b_2 - noab - 1 + nvab * (p6
1321     &b_2 - noab - 1 + nvab * (p5b_2 - noab - 1)))))))))
1322      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p5b-1)
1323     &,int_mb(k_range+p6b-1),int_mb(k_range+p7b-1),int_mb(k_range+p10b-1
1324     &),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1),int_mb(k_range+h3b-1
1325     &),int_mb(k_range+h4b-1),8,7,6,5,3,2,1,4,1.0d0)
1326      END IF
1327      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('ccsdtq_o4_4_1',6,MA_ERR)
1328      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
1329     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
1330     &t),dima_sort)
1331      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('ccsdtq_o4_4_1',7,MA
1332     &_ERR)
1333      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('ccsdtq_o4_4_1',8,MA
1334     &_ERR)
1335      END IF
1336      END IF
1337      END IF
1338      END DO
1339      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
1340     &ccsdtq_o4_4_1',9,MA_ERR)
1341      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1342     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+h1b-1)
1343     &,int_mb(k_range+p7b-1),int_mb(k_range+p6b-1),int_mb(k_range+p5b-1)
1344     &,int_mb(k_range+h9b-1),7,6,5,8,4,3,2,1,-1.0d0)
1345      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
1346     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
1347     &(h9b - 1 + noab * (p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab
1348     &* (p5b - noab - 1)))))))))
1349      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsdtq_o4_4_1',10,MA_ERR
1350     &)
1351      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('ccsdtq_o4_4_1',11,M
1352     &A_ERR)
1353      END IF
1354      END IF
1355      END IF
1356      next = NXTASK(nprocs,1)
1357      END IF
1358      count = count + 1
1359      END DO
1360      END DO
1361      END DO
1362      END DO
1363      END DO
1364      END DO
1365      END DO
1366      END DO
1367      next = NXTASK(-nprocs,1)
1368      call GA_SYNC()
1369      RETURN
1370      END
1371      SUBROUTINE OFFSET_ccsdtq_o4_4_1(l_a_offset,k_a_offset,size)
1372C     $Id$
1373C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
1374C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
1375C     i1 ( h9 p5 p6 p7 h1 h2 h3 h4 )_ot
1376      IMPLICIT NONE
1377#include "global.fh"
1378#include "mafdecls.fh"
1379#include "sym.fh"
1380#include "errquit.fh"
1381#include "tce.fh"
1382      INTEGER l_a_offset
1383      INTEGER k_a_offset
1384      INTEGER size
1385      INTEGER length
1386      INTEGER addr
1387      INTEGER p5b
1388      INTEGER p6b
1389      INTEGER p7b
1390      INTEGER h9b
1391      INTEGER h1b
1392      INTEGER h2b
1393      INTEGER h3b
1394      INTEGER h4b
1395      length = 0
1396      DO p5b = noab+1,noab+nvab
1397      DO p6b = p5b,noab+nvab
1398      DO p7b = p6b,noab+nvab
1399      DO h9b = 1,noab
1400      DO h1b = 1,noab
1401      DO h2b = h1b,noab
1402      DO h3b = h2b,noab
1403      DO h4b = h3b,noab
1404      IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1)
1405     &+int_mb(k_spin+p7b-1) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-
1406     &1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1)) THEN
1407      IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+p5b-1),ieor(int_mb(
1408     &k_sym+p6b-1),ieor(int_mb(k_sym+p7b-1),ieor(int_mb(k_sym+h1b-1),ieo
1409     &r(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h3b-1),int_mb(k_sym+h4b-1)
1410     &))))))) .eq. ieor(irrep_o,irrep_t)) THEN
1411      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+p5b-1
1412     &)+int_mb(k_spin+p6b-1)+int_mb(k_spin+p7b-1)+int_mb(k_spin+h1b-1)+i
1413     &nt_mb(k_spin+h2b-1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1).ne.1
1414     &6)) THEN
1415      length = length + 1
1416      END IF
1417      END IF
1418      END IF
1419      END DO
1420      END DO
1421      END DO
1422      END DO
1423      END DO
1424      END DO
1425      END DO
1426      END DO
1427      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
1428     &set)) CALL ERRQUIT('ccsdtq_o4_4_1',0,MA_ERR)
1429      int_mb(k_a_offset) = length
1430      addr = 0
1431      size = 0
1432      DO p5b = noab+1,noab+nvab
1433      DO p6b = p5b,noab+nvab
1434      DO p7b = p6b,noab+nvab
1435      DO h9b = 1,noab
1436      DO h1b = 1,noab
1437      DO h2b = h1b,noab
1438      DO h3b = h2b,noab
1439      DO h4b = h3b,noab
1440      IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1)
1441     &+int_mb(k_spin+p7b-1) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-
1442     &1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1)) THEN
1443      IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+p5b-1),ieor(int_mb(
1444     &k_sym+p6b-1),ieor(int_mb(k_sym+p7b-1),ieor(int_mb(k_sym+h1b-1),ieo
1445     &r(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h3b-1),int_mb(k_sym+h4b-1)
1446     &))))))) .eq. ieor(irrep_o,irrep_t)) THEN
1447      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+p5b-1
1448     &)+int_mb(k_spin+p6b-1)+int_mb(k_spin+p7b-1)+int_mb(k_spin+h1b-1)+i
1449     &nt_mb(k_spin+h2b-1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1).ne.1
1450     &6)) THEN
1451      addr = addr + 1
1452      int_mb(k_a_offset+addr) = h4b - 1 + noab * (h3b - 1 + noab * (h2b
1453     &- 1 + noab * (h1b - 1 + noab * (h9b - 1 + noab * (p7b - noab - 1 +
1454     & nvab * (p6b - noab - 1 + nvab * (p5b - noab - 1)))))))
1455      int_mb(k_a_offset+length+addr) = size
1456      size = size + int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_
1457     &mb(k_range+p7b-1) * int_mb(k_range+h9b-1) * int_mb(k_range+h1b-1)
1458     &* int_mb(k_range+h2b-1) * int_mb(k_range+h3b-1) * int_mb(k_range+h
1459     &4b-1)
1460      END IF
1461      END IF
1462      END IF
1463      END DO
1464      END DO
1465      END DO
1466      END DO
1467      END DO
1468      END DO
1469      END DO
1470      END DO
1471      RETURN
1472      END
1473      SUBROUTINE ccsdtq_o4_5(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
1474     &t)
1475C     $Id$
1476C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
1477C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
1478C     i0 ( p5 p6 p7 p8 h1 h2 h3 h4 )_ott + = -1 * P( 24 ) * Sum ( h9 ) * t ( p5 p6 p7 h1 h2 h9 )_t * i1 ( h9 p8 h3 h4 )_ot
1479      IMPLICIT NONE
1480#include "global.fh"
1481#include "mafdecls.fh"
1482#include "sym.fh"
1483#include "errquit.fh"
1484#include "tce.fh"
1485      INTEGER d_a
1486      INTEGER k_a_offset
1487      INTEGER d_b
1488      INTEGER k_b_offset
1489      INTEGER d_c
1490      INTEGER k_c_offset
1491      INTEGER NXTASK
1492      INTEGER next
1493      INTEGER nprocs
1494      INTEGER count
1495      INTEGER p5b
1496      INTEGER p6b
1497      INTEGER p7b
1498      INTEGER p8b
1499      INTEGER h1b
1500      INTEGER h2b
1501      INTEGER h3b
1502      INTEGER h4b
1503      INTEGER dimc
1504      INTEGER l_c_sort
1505      INTEGER k_c_sort
1506      INTEGER h9b
1507      INTEGER p5b_1
1508      INTEGER p6b_1
1509      INTEGER p7b_1
1510      INTEGER h1b_1
1511      INTEGER h2b_1
1512      INTEGER h9b_1
1513      INTEGER p8b_2
1514      INTEGER h9b_2
1515      INTEGER h3b_2
1516      INTEGER h4b_2
1517      INTEGER dim_common
1518      INTEGER dima_sort
1519      INTEGER dima
1520      INTEGER dimb_sort
1521      INTEGER dimb
1522      INTEGER l_a_sort
1523      INTEGER k_a_sort
1524      INTEGER l_a
1525      INTEGER k_a
1526      INTEGER l_b_sort
1527      INTEGER k_b_sort
1528      INTEGER l_b
1529      INTEGER k_b
1530      INTEGER l_c
1531      INTEGER k_c
1532      EXTERNAL NXTASK
1533      nprocs = GA_NNODES()
1534      count = 0
1535      next = NXTASK(nprocs,1)
1536      DO p5b = noab+1,noab+nvab
1537      DO p6b = p5b,noab+nvab
1538      DO p7b = p6b,noab+nvab
1539      DO p8b = noab+1,noab+nvab
1540      DO h1b = 1,noab
1541      DO h2b = h1b,noab
1542      DO h3b = 1,noab
1543      DO h4b = h3b,noab
1544      IF (next.eq.count) THEN
1545      IF ((.not.restricted).or.(int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1
1546     &)+int_mb(k_spin+p7b-1)+int_mb(k_spin+p8b-1)+int_mb(k_spin+h1b-1)+i
1547     &nt_mb(k_spin+h2b-1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1).ne.1
1548     &6)) THEN
1549      IF (int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1)+int_mb(k_spin+p7b-1)
1550     &+int_mb(k_spin+p8b-1) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-
1551     &1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1)) THEN
1552      IF (ieor(int_mb(k_sym+p5b-1),ieor(int_mb(k_sym+p6b-1),ieor(int_mb(
1553     &k_sym+p7b-1),ieor(int_mb(k_sym+p8b-1),ieor(int_mb(k_sym+h1b-1),ieo
1554     &r(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h3b-1),int_mb(k_sym+h4b-1)
1555     &))))))) .eq. ieor(irrep_o,ieor(irrep_t,irrep_t))) THEN
1556      dimc = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_mb(k_ra
1557     &nge+p7b-1) * int_mb(k_range+p8b-1) * int_mb(k_range+h1b-1) * int_m
1558     &b(k_range+h2b-1) * int_mb(k_range+h3b-1) * int_mb(k_range+h4b-1)
1559      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
1560     & ERRQUIT('ccsdtq_o4_5',0,MA_ERR)
1561      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
1562      DO h9b = 1,noab
1563      IF (int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1)+int_mb(k_spin+p7b-1)
1564     & .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h9b-
1565     &1)) THEN
1566      IF (ieor(int_mb(k_sym+p5b-1),ieor(int_mb(k_sym+p6b-1),ieor(int_mb(
1567     &k_sym+p7b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),int
1568     &_mb(k_sym+h9b-1)))))) .eq. irrep_t) THEN
1569      CALL TCE_RESTRICTED_6(p5b,p6b,p7b,h1b,h2b,h9b,p5b_1,p6b_1,p7b_1,h1
1570     &b_1,h2b_1,h9b_1)
1571      CALL TCE_RESTRICTED_4(p8b,h9b,h3b,h4b,p8b_2,h9b_2,h3b_2,h4b_2)
1572      dim_common = int_mb(k_range+h9b-1)
1573      dima_sort = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_mb
1574     &(k_range+p7b-1) * int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1)
1575      dima = dim_common * dima_sort
1576      dimb_sort = int_mb(k_range+p8b-1) * int_mb(k_range+h3b-1) * int_mb
1577     &(k_range+h4b-1)
1578      dimb = dim_common * dimb_sort
1579      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
1580      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
1581     & ERRQUIT('ccsdtq_o4_5',1,MA_ERR)
1582      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
1583     &ccsdtq_o4_5',2,MA_ERR)
1584      IF ((h9b .lt. h1b)) THEN
1585      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h2b_1
1586     & - 1 + noab * (h1b_1 - 1 + noab * (h9b_1 - 1 + noab * (p7b_1 - noa
1587     &b - 1 + nvab * (p6b_1 - noab - 1 + nvab * (p5b_1 - noab - 1)))))))
1588      CALL TCE_SORT_6(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
1589     &,int_mb(k_range+p6b-1),int_mb(k_range+p7b-1),int_mb(k_range+h9b-1)
1590     &,int_mb(k_range+h1b-1),int_mb(k_range+h2b-1),6,5,3,2,1,4,1.0d0)
1591      END IF
1592      IF ((h1b .le. h9b) .and. (h9b .lt. h2b)) THEN
1593      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h2b_1
1594     & - 1 + noab * (h9b_1 - 1 + noab * (h1b_1 - 1 + noab * (p7b_1 - noa
1595     &b - 1 + nvab * (p6b_1 - noab - 1 + nvab * (p5b_1 - noab - 1)))))))
1596      CALL TCE_SORT_6(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
1597     &,int_mb(k_range+p6b-1),int_mb(k_range+p7b-1),int_mb(k_range+h1b-1)
1598     &,int_mb(k_range+h9b-1),int_mb(k_range+h2b-1),6,4,3,2,1,5,-1.0d0)
1599      END IF
1600      IF ((h2b .le. h9b)) THEN
1601      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h9b_1
1602     & - 1 + noab * (h2b_1 - 1 + noab * (h1b_1 - 1 + noab * (p7b_1 - noa
1603     &b - 1 + nvab * (p6b_1 - noab - 1 + nvab * (p5b_1 - noab - 1)))))))
1604      CALL TCE_SORT_6(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
1605     &,int_mb(k_range+p6b-1),int_mb(k_range+p7b-1),int_mb(k_range+h1b-1)
1606     &,int_mb(k_range+h2b-1),int_mb(k_range+h9b-1),5,4,3,2,1,6,1.0d0)
1607      END IF
1608      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('ccsdtq_o4_5',3,MA_ERR)
1609      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
1610     & ERRQUIT('ccsdtq_o4_5',4,MA_ERR)
1611      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
1612     &ccsdtq_o4_5',5,MA_ERR)
1613      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h4b_2
1614     & - 1 + noab * (h3b_2 - 1 + noab * (h9b_2 - 1 + noab * (p8b_2 - noa
1615     &b - 1)))))
1616      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p8b-1)
1617     &,int_mb(k_range+h9b-1),int_mb(k_range+h3b-1),int_mb(k_range+h4b-1)
1618     &,4,3,1,2,1.0d0)
1619      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('ccsdtq_o4_5',6,MA_ERR)
1620      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
1621     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
1622     &t),dima_sort)
1623      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('ccsdtq_o4_5',7,MA_E
1624     &RR)
1625      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('ccsdtq_o4_5',8,MA_E
1626     &RR)
1627      END IF
1628      END IF
1629      END IF
1630      END DO
1631      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
1632     &ccsdtq_o4_5',9,MA_ERR)
1633      IF ((p7b .le. p8b) .and. (h2b .le. h3b)) THEN
1634      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1635     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1636     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1637     &,int_mb(k_range+p5b-1),8,7,6,3,5,4,2,1,-1.0d0)
1638      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
1639     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
1640     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
1641     &+ nvab * (p5b - noab - 1)))))))))
1642      END IF
1643      IF ((p7b .le. p8b) .and. (h3b .le. h1b) .and. (h2b .le. h4b)) THEN
1644      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1645     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1646     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1647     &,int_mb(k_range+p5b-1),8,7,6,3,2,5,4,1,-1.0d0)
1648      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
1649     & 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab *
1650     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
1651     &+ nvab * (p5b - noab - 1)))))))))
1652      END IF
1653      IF ((p7b .le. p8b) .and. (h1b .le. h3b) .and. (h3b .le. h2b) .and.
1654     & (h2b .le. h4b)) THEN
1655      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1656     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1657     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1658     &,int_mb(k_range+p5b-1),8,7,6,3,5,2,4,1,1.0d0)
1659      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
1660     & 1 + noab * (h2b - 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab *
1661     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
1662     &+ nvab * (p5b - noab - 1)))))))))
1663      END IF
1664      IF ((p7b .le. p8b) .and. (h3b .le. h1b) .and. (h1b .le. h4b) .and.
1665     & (h4b .le. h2b)) THEN
1666      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1667     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1668     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1669     &,int_mb(k_range+p5b-1),8,7,6,3,2,5,1,4,1.0d0)
1670      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
1671     & 1 + noab * (h4b - 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab *
1672     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
1673     &+ nvab * (p5b - noab - 1)))))))))
1674      END IF
1675      IF ((p7b .le. p8b) .and. (h1b .le. h3b) .and. (h4b .le. h2b)) THEN
1676      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1677     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1678     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1679     &,int_mb(k_range+p5b-1),8,7,6,3,5,2,1,4,-1.0d0)
1680      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
1681     & 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab *
1682     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
1683     &+ nvab * (p5b - noab - 1)))))))))
1684      END IF
1685      IF ((p7b .le. p8b) .and. (h4b .le. h1b)) THEN
1686      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1687     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1688     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1689     &,int_mb(k_range+p5b-1),8,7,6,3,2,1,5,4,-1.0d0)
1690      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
1691     & 1 + noab * (h1b - 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab *
1692     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
1693     &+ nvab * (p5b - noab - 1)))))))))
1694      END IF
1695      IF ((p8b .le. p5b) .and. (h2b .le. h3b)) THEN
1696      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1697     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1698     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1699     &,int_mb(k_range+p5b-1),3,8,7,6,5,4,2,1,1.0d0)
1700      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
1701     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
1702     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p5b - noab - 1
1703     &+ nvab * (p8b - noab - 1)))))))))
1704      END IF
1705      IF ((p8b .le. p5b) .and. (h3b .le. h1b) .and. (h2b .le. h4b)) THEN
1706      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1707     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1708     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1709     &,int_mb(k_range+p5b-1),3,8,7,6,2,5,4,1,1.0d0)
1710      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
1711     & 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab *
1712     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p5b - noab - 1
1713     &+ nvab * (p8b - noab - 1)))))))))
1714      END IF
1715      IF ((p8b .le. p5b) .and. (h1b .le. h3b) .and. (h3b .le. h2b) .and.
1716     & (h2b .le. h4b)) THEN
1717      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1718     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1719     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1720     &,int_mb(k_range+p5b-1),3,8,7,6,5,2,4,1,-1.0d0)
1721      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
1722     & 1 + noab * (h2b - 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab *
1723     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p5b - noab - 1
1724     &+ nvab * (p8b - noab - 1)))))))))
1725      END IF
1726      IF ((p8b .le. p5b) .and. (h3b .le. h1b) .and. (h1b .le. h4b) .and.
1727     & (h4b .le. h2b)) THEN
1728      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1729     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1730     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1731     &,int_mb(k_range+p5b-1),3,8,7,6,2,5,1,4,-1.0d0)
1732      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
1733     & 1 + noab * (h4b - 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab *
1734     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p5b - noab - 1
1735     &+ nvab * (p8b - noab - 1)))))))))
1736      END IF
1737      IF ((p8b .le. p5b) .and. (h1b .le. h3b) .and. (h4b .le. h2b)) THEN
1738      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1739     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1740     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1741     &,int_mb(k_range+p5b-1),3,8,7,6,5,2,1,4,1.0d0)
1742      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
1743     & 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab *
1744     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p5b - noab - 1
1745     &+ nvab * (p8b - noab - 1)))))))))
1746      END IF
1747      IF ((p8b .le. p5b) .and. (h4b .le. h1b)) THEN
1748      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1749     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1750     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1751     &,int_mb(k_range+p5b-1),3,8,7,6,2,1,5,4,1.0d0)
1752      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
1753     & 1 + noab * (h1b - 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab *
1754     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p5b - noab - 1
1755     &+ nvab * (p8b - noab - 1)))))))))
1756      END IF
1757      IF ((p5b .le. p8b) .and. (p8b .le. p6b) .and. (h2b .le. h3b)) THEN
1758      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1759     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1760     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1761     &,int_mb(k_range+p5b-1),8,3,7,6,5,4,2,1,-1.0d0)
1762      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
1763     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
1764     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p8b - noab - 1
1765     &+ nvab * (p5b - noab - 1)))))))))
1766      END IF
1767      IF ((p5b .le. p8b) .and. (p8b .le. p6b) .and. (h3b .le. h1b) .and.
1768     & (h2b .le. h4b)) THEN
1769      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1770     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1771     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1772     &,int_mb(k_range+p5b-1),8,3,7,6,2,5,4,1,-1.0d0)
1773      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
1774     & 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab *
1775     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p8b - noab - 1
1776     &+ nvab * (p5b - noab - 1)))))))))
1777      END IF
1778      IF ((p5b .le. p8b) .and. (p8b .le. p6b) .and. (h1b .le. h3b) .and.
1779     & (h3b .le. h2b) .and. (h2b .le. h4b)) THEN
1780      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1781     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1782     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1783     &,int_mb(k_range+p5b-1),8,3,7,6,5,2,4,1,1.0d0)
1784      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
1785     & 1 + noab * (h2b - 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab *
1786     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p8b - noab - 1
1787     &+ nvab * (p5b - noab - 1)))))))))
1788      END IF
1789      IF ((p5b .le. p8b) .and. (p8b .le. p6b) .and. (h3b .le. h1b) .and.
1790     & (h1b .le. h4b) .and. (h4b .le. h2b)) THEN
1791      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1792     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1793     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1794     &,int_mb(k_range+p5b-1),8,3,7,6,2,5,1,4,1.0d0)
1795      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
1796     & 1 + noab * (h4b - 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab *
1797     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p8b - noab - 1
1798     &+ nvab * (p5b - noab - 1)))))))))
1799      END IF
1800      IF ((p5b .le. p8b) .and. (p8b .le. p6b) .and. (h1b .le. h3b) .and.
1801     & (h4b .le. h2b)) THEN
1802      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1803     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1804     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1805     &,int_mb(k_range+p5b-1),8,3,7,6,5,2,1,4,-1.0d0)
1806      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
1807     & 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab *
1808     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p8b - noab - 1
1809     &+ nvab * (p5b - noab - 1)))))))))
1810      END IF
1811      IF ((p5b .le. p8b) .and. (p8b .le. p6b) .and. (h4b .le. h1b)) THEN
1812      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1813     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1814     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1815     &,int_mb(k_range+p5b-1),8,3,7,6,2,1,5,4,-1.0d0)
1816      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
1817     & 1 + noab * (h1b - 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab *
1818     &(p7b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p8b - noab - 1
1819     &+ nvab * (p5b - noab - 1)))))))))
1820      END IF
1821      IF ((p6b .le. p8b) .and. (p8b .le. p7b) .and. (h2b .le. h3b)) THEN
1822      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1823     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1824     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1825     &,int_mb(k_range+p5b-1),8,7,3,6,5,4,2,1,1.0d0)
1826      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
1827     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
1828     &(p7b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p6b - noab - 1
1829     &+ nvab * (p5b - noab - 1)))))))))
1830      END IF
1831      IF ((p6b .le. p8b) .and. (p8b .le. p7b) .and. (h3b .le. h1b) .and.
1832     & (h2b .le. h4b)) THEN
1833      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1834     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1835     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1836     &,int_mb(k_range+p5b-1),8,7,3,6,2,5,4,1,1.0d0)
1837      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
1838     & 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab *
1839     &(p7b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p6b - noab - 1
1840     &+ nvab * (p5b - noab - 1)))))))))
1841      END IF
1842      IF ((p6b .le. p8b) .and. (p8b .le. p7b) .and. (h1b .le. h3b) .and.
1843     & (h3b .le. h2b) .and. (h2b .le. h4b)) THEN
1844      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1845     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1846     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1847     &,int_mb(k_range+p5b-1),8,7,3,6,5,2,4,1,-1.0d0)
1848      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
1849     & 1 + noab * (h2b - 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab *
1850     &(p7b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p6b - noab - 1
1851     &+ nvab * (p5b - noab - 1)))))))))
1852      END IF
1853      IF ((p6b .le. p8b) .and. (p8b .le. p7b) .and. (h3b .le. h1b) .and.
1854     & (h1b .le. h4b) .and. (h4b .le. h2b)) THEN
1855      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1856     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1857     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1858     &,int_mb(k_range+p5b-1),8,7,3,6,2,5,1,4,-1.0d0)
1859      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
1860     & 1 + noab * (h4b - 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab *
1861     &(p7b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p6b - noab - 1
1862     &+ nvab * (p5b - noab - 1)))))))))
1863      END IF
1864      IF ((p6b .le. p8b) .and. (p8b .le. p7b) .and. (h1b .le. h3b) .and.
1865     & (h4b .le. h2b)) THEN
1866      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1867     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1868     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1869     &,int_mb(k_range+p5b-1),8,7,3,6,5,2,1,4,1.0d0)
1870      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
1871     & 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab *
1872     &(p7b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p6b - noab - 1
1873     &+ nvab * (p5b - noab - 1)))))))))
1874      END IF
1875      IF ((p6b .le. p8b) .and. (p8b .le. p7b) .and. (h4b .le. h1b)) THEN
1876      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
1877     &,int_mb(k_range+h3b-1),int_mb(k_range+p8b-1),int_mb(k_range+h2b-1)
1878     &,int_mb(k_range+h1b-1),int_mb(k_range+p7b-1),int_mb(k_range+p6b-1)
1879     &,int_mb(k_range+p5b-1),8,7,3,6,2,1,5,4,1.0d0)
1880      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
1881     & 1 + noab * (h1b - 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab *
1882     &(p7b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p6b - noab - 1
1883     &+ nvab * (p5b - noab - 1)))))))))
1884      END IF
1885      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsdtq_o4_5',10,MA_ERR)
1886      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('ccsdtq_o4_5',11,MA_
1887     &ERR)
1888      END IF
1889      END IF
1890      END IF
1891      next = NXTASK(nprocs,1)
1892      END IF
1893      count = count + 1
1894      END DO
1895      END DO
1896      END DO
1897      END DO
1898      END DO
1899      END DO
1900      END DO
1901      END DO
1902      next = NXTASK(-nprocs,1)
1903      call GA_SYNC()
1904      RETURN
1905      END
1906      SUBROUTINE ccsdtq_o4_5_1(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_off
1907     &set)
1908C     $Id$
1909C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
1910C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
1911C     i1 ( h9 p5 h1 h2 )_ot + = -1 * Sum ( p10 ) * o ( h9 p10 )_o * t ( p5 p10 h1 h2 )_t
1912      IMPLICIT NONE
1913#include "global.fh"
1914#include "mafdecls.fh"
1915#include "sym.fh"
1916#include "errquit.fh"
1917#include "tce.fh"
1918      INTEGER d_a
1919      INTEGER k_a_offset
1920      INTEGER d_b
1921      INTEGER k_b_offset
1922      INTEGER d_c
1923      INTEGER k_c_offset
1924      INTEGER NXTASK
1925      INTEGER next
1926      INTEGER nprocs
1927      INTEGER count
1928      INTEGER p5b
1929      INTEGER h9b
1930      INTEGER h1b
1931      INTEGER h2b
1932      INTEGER dimc
1933      INTEGER l_c_sort
1934      INTEGER k_c_sort
1935      INTEGER p10b
1936      INTEGER h9b_1
1937      INTEGER p10b_1
1938      INTEGER p5b_2
1939      INTEGER p10b_2
1940      INTEGER h1b_2
1941      INTEGER h2b_2
1942      INTEGER dim_common
1943      INTEGER dima_sort
1944      INTEGER dima
1945      INTEGER dimb_sort
1946      INTEGER dimb
1947      INTEGER l_a_sort
1948      INTEGER k_a_sort
1949      INTEGER l_a
1950      INTEGER k_a
1951      INTEGER l_b_sort
1952      INTEGER k_b_sort
1953      INTEGER l_b
1954      INTEGER k_b
1955      INTEGER l_c
1956      INTEGER k_c
1957      EXTERNAL NXTASK
1958      nprocs = GA_NNODES()
1959      count = 0
1960      next = NXTASK(nprocs,1)
1961      DO p5b = noab+1,noab+nvab
1962      DO h9b = 1,noab
1963      DO h1b = 1,noab
1964      DO h2b = h1b,noab
1965      IF (next.eq.count) THEN
1966      IF ((.not.restricted).or.(int_mb(k_spin+p5b-1)+int_mb(k_spin+h9b-1
1967     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
1968      IF (int_mb(k_spin+p5b-1)+int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+h
1969     &1b-1)+int_mb(k_spin+h2b-1)) THEN
1970      IF (ieor(int_mb(k_sym+p5b-1),ieor(int_mb(k_sym+h9b-1),ieor(int_mb(
1971     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_o,irrep_t)) TH
1972     &EN
1973      dimc = int_mb(k_range+p5b-1) * int_mb(k_range+h9b-1) * int_mb(k_ra
1974     &nge+h1b-1) * int_mb(k_range+h2b-1)
1975      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
1976     & ERRQUIT('ccsdtq_o4_5_1',0,MA_ERR)
1977      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
1978      DO p10b = noab+1,noab+nvab
1979      IF (int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+p10b-1)) THEN
1980      IF (ieor(int_mb(k_sym+h9b-1),int_mb(k_sym+p10b-1)) .eq. irrep_o) T
1981     &HEN
1982      CALL TCE_RESTRICTED_2(h9b,p10b,h9b_1,p10b_1)
1983      CALL TCE_RESTRICTED_4(p5b,p10b,h1b,h2b,p5b_2,p10b_2,h1b_2,h2b_2)
1984      dim_common = int_mb(k_range+p10b-1)
1985      dima_sort = int_mb(k_range+h9b-1)
1986      dima = dim_common * dima_sort
1987      dimb_sort = int_mb(k_range+p5b-1) * int_mb(k_range+h1b-1) * int_mb
1988     &(k_range+h2b-1)
1989      dimb = dim_common * dimb_sort
1990      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
1991      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
1992     & ERRQUIT('ccsdtq_o4_5_1',1,MA_ERR)
1993      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
1994     &ccsdtq_o4_5_1',2,MA_ERR)
1995      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p10b_
1996     &1 - 1 + (noab+nvab) * (h9b_1 - 1)))
1997      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h9b-1)
1998     &,int_mb(k_range+p10b-1),1,2,1.0d0)
1999      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('ccsdtq_o4_5_1',3,MA_ERR)
2000      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
2001     & ERRQUIT('ccsdtq_o4_5_1',4,MA_ERR)
2002      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
2003     &ccsdtq_o4_5_1',5,MA_ERR)
2004      IF ((p10b .lt. p5b)) THEN
2005      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h2b_2
2006     & - 1 + noab * (h1b_2 - 1 + noab * (p5b_2 - noab - 1 + nvab * (p10b
2007     &_2 - noab - 1)))))
2008      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p10b-1
2009     &),int_mb(k_range+p5b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1
2010     &),4,3,2,1,-1.0d0)
2011      END IF
2012      IF ((p5b .le. p10b)) THEN
2013      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h2b_2
2014     & - 1 + noab * (h1b_2 - 1 + noab * (p10b_2 - noab - 1 + nvab * (p5b
2015     &_2 - noab - 1)))))
2016      CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p5b-1)
2017     &,int_mb(k_range+p10b-1),int_mb(k_range+h1b-1),int_mb(k_range+h2b-1
2018     &),4,3,1,2,1.0d0)
2019      END IF
2020      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('ccsdtq_o4_5_1',6,MA_ERR)
2021      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
2022     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
2023     &t),dima_sort)
2024      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('ccsdtq_o4_5_1',7,MA
2025     &_ERR)
2026      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('ccsdtq_o4_5_1',8,MA
2027     &_ERR)
2028      END IF
2029      END IF
2030      END IF
2031      END DO
2032      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
2033     &ccsdtq_o4_5_1',9,MA_ERR)
2034      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
2035     &,int_mb(k_range+h1b-1),int_mb(k_range+p5b-1),int_mb(k_range+h9b-1)
2036     &,3,4,2,1,-1.0d0)
2037      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
2038     & 1 + noab * (h1b - 1 + noab * (h9b - 1 + noab * (p5b - noab - 1)))
2039     &))
2040      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsdtq_o4_5_1',10,MA_ERR
2041     &)
2042      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('ccsdtq_o4_5_1',11,M
2043     &A_ERR)
2044      END IF
2045      END IF
2046      END IF
2047      next = NXTASK(nprocs,1)
2048      END IF
2049      count = count + 1
2050      END DO
2051      END DO
2052      END DO
2053      END DO
2054      next = NXTASK(-nprocs,1)
2055      call GA_SYNC()
2056      RETURN
2057      END
2058      SUBROUTINE OFFSET_ccsdtq_o4_5_1(l_a_offset,k_a_offset,size)
2059C     $Id$
2060C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
2061C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
2062C     i1 ( h9 p5 h1 h2 )_ot
2063      IMPLICIT NONE
2064#include "global.fh"
2065#include "mafdecls.fh"
2066#include "sym.fh"
2067#include "errquit.fh"
2068#include "tce.fh"
2069      INTEGER l_a_offset
2070      INTEGER k_a_offset
2071      INTEGER size
2072      INTEGER length
2073      INTEGER addr
2074      INTEGER p5b
2075      INTEGER h9b
2076      INTEGER h1b
2077      INTEGER h2b
2078      length = 0
2079      DO p5b = noab+1,noab+nvab
2080      DO h9b = 1,noab
2081      DO h1b = 1,noab
2082      DO h2b = h1b,noab
2083      IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+p5b-1) .eq. int_mb(k_spin+h
2084     &1b-1)+int_mb(k_spin+h2b-1)) THEN
2085      IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+p5b-1),ieor(int_mb(
2086     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_o,irrep_t)) TH
2087     &EN
2088      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+p5b-1
2089     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
2090      length = length + 1
2091      END IF
2092      END IF
2093      END IF
2094      END DO
2095      END DO
2096      END DO
2097      END DO
2098      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
2099     &set)) CALL ERRQUIT('ccsdtq_o4_5_1',0,MA_ERR)
2100      int_mb(k_a_offset) = length
2101      addr = 0
2102      size = 0
2103      DO p5b = noab+1,noab+nvab
2104      DO h9b = 1,noab
2105      DO h1b = 1,noab
2106      DO h2b = h1b,noab
2107      IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+p5b-1) .eq. int_mb(k_spin+h
2108     &1b-1)+int_mb(k_spin+h2b-1)) THEN
2109      IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+p5b-1),ieor(int_mb(
2110     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_o,irrep_t)) TH
2111     &EN
2112      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+p5b-1
2113     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
2114      addr = addr + 1
2115      int_mb(k_a_offset+addr) = h2b - 1 + noab * (h1b - 1 + noab * (h9b
2116     &- 1 + noab * (p5b - noab - 1)))
2117      int_mb(k_a_offset+length+addr) = size
2118      size = size + int_mb(k_range+p5b-1) * int_mb(k_range+h9b-1) * int_
2119     &mb(k_range+h1b-1) * int_mb(k_range+h2b-1)
2120      END IF
2121      END IF
2122      END IF
2123      END DO
2124      END DO
2125      END DO
2126      END DO
2127      RETURN
2128      END
2129      SUBROUTINE ccsdtq_o4_6(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
2130     &t)
2131C     $Id$
2132C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
2133C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
2134C     i0 ( p5 p6 p7 p8 h1 h2 h3 h4 )_ott + = -1 * P( 24 ) * Sum ( h9 ) * t ( p5 p6 h1 h9 )_t * i1 ( h9 p7 p8 h2 h3 h4 )_ot
2135      IMPLICIT NONE
2136#include "global.fh"
2137#include "mafdecls.fh"
2138#include "sym.fh"
2139#include "errquit.fh"
2140#include "tce.fh"
2141      INTEGER d_a
2142      INTEGER k_a_offset
2143      INTEGER d_b
2144      INTEGER k_b_offset
2145      INTEGER d_c
2146      INTEGER k_c_offset
2147      INTEGER NXTASK
2148      INTEGER next
2149      INTEGER nprocs
2150      INTEGER count
2151      INTEGER p5b
2152      INTEGER p6b
2153      INTEGER p7b
2154      INTEGER p8b
2155      INTEGER h1b
2156      INTEGER h2b
2157      INTEGER h3b
2158      INTEGER h4b
2159      INTEGER dimc
2160      INTEGER l_c_sort
2161      INTEGER k_c_sort
2162      INTEGER h9b
2163      INTEGER p5b_1
2164      INTEGER p6b_1
2165      INTEGER h1b_1
2166      INTEGER h9b_1
2167      INTEGER p7b_2
2168      INTEGER p8b_2
2169      INTEGER h9b_2
2170      INTEGER h2b_2
2171      INTEGER h3b_2
2172      INTEGER h4b_2
2173      INTEGER dim_common
2174      INTEGER dima_sort
2175      INTEGER dima
2176      INTEGER dimb_sort
2177      INTEGER dimb
2178      INTEGER l_a_sort
2179      INTEGER k_a_sort
2180      INTEGER l_a
2181      INTEGER k_a
2182      INTEGER l_b_sort
2183      INTEGER k_b_sort
2184      INTEGER l_b
2185      INTEGER k_b
2186      INTEGER l_c
2187      INTEGER k_c
2188      EXTERNAL NXTASK
2189      nprocs = GA_NNODES()
2190      count = 0
2191      next = NXTASK(nprocs,1)
2192      DO p5b = noab+1,noab+nvab
2193      DO p6b = p5b,noab+nvab
2194      DO p7b = noab+1,noab+nvab
2195      DO p8b = p7b,noab+nvab
2196      DO h1b = 1,noab
2197      DO h2b = 1,noab
2198      DO h3b = h2b,noab
2199      DO h4b = h3b,noab
2200      IF (next.eq.count) THEN
2201      IF ((.not.restricted).or.(int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1
2202     &)+int_mb(k_spin+p7b-1)+int_mb(k_spin+p8b-1)+int_mb(k_spin+h1b-1)+i
2203     &nt_mb(k_spin+h2b-1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1).ne.1
2204     &6)) THEN
2205      IF (int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1)+int_mb(k_spin+p7b-1)
2206     &+int_mb(k_spin+p8b-1) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-
2207     &1)+int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1)) THEN
2208      IF (ieor(int_mb(k_sym+p5b-1),ieor(int_mb(k_sym+p6b-1),ieor(int_mb(
2209     &k_sym+p7b-1),ieor(int_mb(k_sym+p8b-1),ieor(int_mb(k_sym+h1b-1),ieo
2210     &r(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h3b-1),int_mb(k_sym+h4b-1)
2211     &))))))) .eq. ieor(irrep_o,ieor(irrep_t,irrep_t))) THEN
2212      dimc = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_mb(k_ra
2213     &nge+p7b-1) * int_mb(k_range+p8b-1) * int_mb(k_range+h1b-1) * int_m
2214     &b(k_range+h2b-1) * int_mb(k_range+h3b-1) * int_mb(k_range+h4b-1)
2215      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
2216     & ERRQUIT('ccsdtq_o4_6',0,MA_ERR)
2217      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
2218      DO h9b = 1,noab
2219      IF (int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1) .eq. int_mb(k_spin+h
2220     &1b-1)+int_mb(k_spin+h9b-1)) THEN
2221      IF (ieor(int_mb(k_sym+p5b-1),ieor(int_mb(k_sym+p6b-1),ieor(int_mb(
2222     &k_sym+h1b-1),int_mb(k_sym+h9b-1)))) .eq. irrep_t) THEN
2223      CALL TCE_RESTRICTED_4(p5b,p6b,h1b,h9b,p5b_1,p6b_1,h1b_1,h9b_1)
2224      CALL TCE_RESTRICTED_6(p7b,p8b,h9b,h2b,h3b,h4b,p7b_2,p8b_2,h9b_2,h2
2225     &b_2,h3b_2,h4b_2)
2226      dim_common = int_mb(k_range+h9b-1)
2227      dima_sort = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_mb
2228     &(k_range+h1b-1)
2229      dima = dim_common * dima_sort
2230      dimb_sort = int_mb(k_range+p7b-1) * int_mb(k_range+p8b-1) * int_mb
2231     &(k_range+h2b-1) * int_mb(k_range+h3b-1) * int_mb(k_range+h4b-1)
2232      dimb = dim_common * dimb_sort
2233      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
2234      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
2235     & ERRQUIT('ccsdtq_o4_6',1,MA_ERR)
2236      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
2237     &ccsdtq_o4_6',2,MA_ERR)
2238      IF ((h9b .lt. h1b)) THEN
2239      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h1b_1
2240     & - 1 + noab * (h9b_1 - 1 + noab * (p6b_1 - noab - 1 + nvab * (p5b_
2241     &1 - noab - 1)))))
2242      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
2243     &,int_mb(k_range+p6b-1),int_mb(k_range+h9b-1),int_mb(k_range+h1b-1)
2244     &,4,2,1,3,-1.0d0)
2245      END IF
2246      IF ((h1b .le. h9b)) THEN
2247      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h9b_1
2248     & - 1 + noab * (h1b_1 - 1 + noab * (p6b_1 - noab - 1 + nvab * (p5b_
2249     &1 - noab - 1)))))
2250      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p5b-1)
2251     &,int_mb(k_range+p6b-1),int_mb(k_range+h1b-1),int_mb(k_range+h9b-1)
2252     &,3,2,1,4,1.0d0)
2253      END IF
2254      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('ccsdtq_o4_6',3,MA_ERR)
2255      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
2256     & ERRQUIT('ccsdtq_o4_6',4,MA_ERR)
2257      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
2258     &ccsdtq_o4_6',5,MA_ERR)
2259      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h4b_2
2260     & - 1 + noab * (h3b_2 - 1 + noab * (h2b_2 - 1 + noab * (h9b_2 - 1 +
2261     & noab * (p8b_2 - noab - 1 + nvab * (p7b_2 - noab - 1)))))))
2262      CALL TCE_SORT_6(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p7b-1)
2263     &,int_mb(k_range+p8b-1),int_mb(k_range+h9b-1),int_mb(k_range+h2b-1)
2264     &,int_mb(k_range+h3b-1),int_mb(k_range+h4b-1),6,5,4,2,1,3,1.0d0)
2265      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('ccsdtq_o4_6',6,MA_ERR)
2266      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
2267     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
2268     &t),dima_sort)
2269      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('ccsdtq_o4_6',7,MA_E
2270     &RR)
2271      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('ccsdtq_o4_6',8,MA_E
2272     &RR)
2273      END IF
2274      END IF
2275      END IF
2276      END DO
2277      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
2278     &ccsdtq_o4_6',9,MA_ERR)
2279      IF ((p6b .le. p7b) .and. (h1b .le. h2b)) THEN
2280      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2281     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2282     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2283     &,int_mb(k_range+p5b-1),8,7,5,4,6,3,2,1,-1.0d0)
2284      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
2285     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
2286     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
2287     &+ nvab * (p5b - noab - 1)))))))))
2288      END IF
2289      IF ((p6b .le. p7b) .and. (h2b .le. h1b) .and. (h1b .le. h3b)) THEN
2290      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2291     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2292     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2293     &,int_mb(k_range+p5b-1),8,7,5,4,3,6,2,1,1.0d0)
2294      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
2295     & 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab * (h2b - 1 + noab *
2296     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
2297     &+ nvab * (p5b - noab - 1)))))))))
2298      END IF
2299      IF ((p6b .le. p7b) .and. (h3b .le. h1b) .and. (h1b .le. h4b)) THEN
2300      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2301     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2302     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2303     &,int_mb(k_range+p5b-1),8,7,5,4,3,2,6,1,-1.0d0)
2304      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
2305     & 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab *
2306     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
2307     &+ nvab * (p5b - noab - 1)))))))))
2308      END IF
2309      IF ((p6b .le. p7b) .and. (h4b .le. h1b)) THEN
2310      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2311     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2312     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2313     &,int_mb(k_range+p5b-1),8,7,5,4,3,2,1,6,1.0d0)
2314      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
2315     & 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab *
2316     &(p8b - noab - 1 + nvab * (p7b - noab - 1 + nvab * (p6b - noab - 1
2317     &+ nvab * (p5b - noab - 1)))))))))
2318      END IF
2319      IF ((p7b .le. p5b) .and. (p6b .le. p8b) .and. (h1b .le. h2b)) THEN
2320      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2321     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2322     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2323     &,int_mb(k_range+p5b-1),5,8,7,4,6,3,2,1,-1.0d0)
2324      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
2325     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
2326     &(p8b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p5b - noab - 1
2327     &+ nvab * (p7b - noab - 1)))))))))
2328      END IF
2329      IF ((p7b .le. p5b) .and. (p6b .le. p8b) .and. (h2b .le. h1b) .and.
2330     & (h1b .le. h3b)) THEN
2331      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2332     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2333     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2334     &,int_mb(k_range+p5b-1),5,8,7,4,3,6,2,1,1.0d0)
2335      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
2336     & 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab * (h2b - 1 + noab *
2337     &(p8b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p5b - noab - 1
2338     &+ nvab * (p7b - noab - 1)))))))))
2339      END IF
2340      IF ((p7b .le. p5b) .and. (p6b .le. p8b) .and. (h3b .le. h1b) .and.
2341     & (h1b .le. h4b)) THEN
2342      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2343     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2344     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2345     &,int_mb(k_range+p5b-1),5,8,7,4,3,2,6,1,-1.0d0)
2346      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
2347     & 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab *
2348     &(p8b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p5b - noab - 1
2349     &+ nvab * (p7b - noab - 1)))))))))
2350      END IF
2351      IF ((p7b .le. p5b) .and. (p6b .le. p8b) .and. (h4b .le. h1b)) THEN
2352      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2353     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2354     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2355     &,int_mb(k_range+p5b-1),5,8,7,4,3,2,1,6,1.0d0)
2356      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
2357     & 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab *
2358     &(p8b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p5b - noab - 1
2359     &+ nvab * (p7b - noab - 1)))))))))
2360      END IF
2361      IF ((p5b .le. p7b) .and. (p7b .le. p6b) .and. (p6b .le. p8b) .and.
2362     & (h1b .le. h2b)) THEN
2363      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2364     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2365     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2366     &,int_mb(k_range+p5b-1),8,5,7,4,6,3,2,1,1.0d0)
2367      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
2368     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
2369     &(p8b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p7b - noab - 1
2370     &+ nvab * (p5b - noab - 1)))))))))
2371      END IF
2372      IF ((p5b .le. p7b) .and. (p7b .le. p6b) .and. (p6b .le. p8b) .and.
2373     & (h2b .le. h1b) .and. (h1b .le. h3b)) THEN
2374      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2375     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2376     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2377     &,int_mb(k_range+p5b-1),8,5,7,4,3,6,2,1,-1.0d0)
2378      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
2379     & 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab * (h2b - 1 + noab *
2380     &(p8b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p7b - noab - 1
2381     &+ nvab * (p5b - noab - 1)))))))))
2382      END IF
2383      IF ((p5b .le. p7b) .and. (p7b .le. p6b) .and. (p6b .le. p8b) .and.
2384     & (h3b .le. h1b) .and. (h1b .le. h4b)) THEN
2385      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2386     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2387     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2388     &,int_mb(k_range+p5b-1),8,5,7,4,3,2,6,1,1.0d0)
2389      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
2390     & 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab *
2391     &(p8b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p7b - noab - 1
2392     &+ nvab * (p5b - noab - 1)))))))))
2393      END IF
2394      IF ((p5b .le. p7b) .and. (p7b .le. p6b) .and. (p6b .le. p8b) .and.
2395     & (h4b .le. h1b)) THEN
2396      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2397     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2398     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2399     &,int_mb(k_range+p5b-1),8,5,7,4,3,2,1,6,-1.0d0)
2400      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
2401     & 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab *
2402     &(p8b - noab - 1 + nvab * (p6b - noab - 1 + nvab * (p7b - noab - 1
2403     &+ nvab * (p5b - noab - 1)))))))))
2404      END IF
2405      IF ((p7b .le. p5b) .and. (p5b .le. p8b) .and. (p8b .le. p6b) .and.
2406     & (h1b .le. h2b)) THEN
2407      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2408     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2409     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2410     &,int_mb(k_range+p5b-1),5,8,4,7,6,3,2,1,1.0d0)
2411      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
2412     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
2413     &(p6b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p5b - noab - 1
2414     &+ nvab * (p7b - noab - 1)))))))))
2415      END IF
2416      IF ((p7b .le. p5b) .and. (p5b .le. p8b) .and. (p8b .le. p6b) .and.
2417     & (h2b .le. h1b) .and. (h1b .le. h3b)) THEN
2418      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2419     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2420     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2421     &,int_mb(k_range+p5b-1),5,8,4,7,3,6,2,1,-1.0d0)
2422      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
2423     & 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab * (h2b - 1 + noab *
2424     &(p6b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p5b - noab - 1
2425     &+ nvab * (p7b - noab - 1)))))))))
2426      END IF
2427      IF ((p7b .le. p5b) .and. (p5b .le. p8b) .and. (p8b .le. p6b) .and.
2428     & (h3b .le. h1b) .and. (h1b .le. h4b)) THEN
2429      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2430     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2431     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2432     &,int_mb(k_range+p5b-1),5,8,4,7,3,2,6,1,1.0d0)
2433      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
2434     & 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab *
2435     &(p6b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p5b - noab - 1
2436     &+ nvab * (p7b - noab - 1)))))))))
2437      END IF
2438      IF ((p7b .le. p5b) .and. (p5b .le. p8b) .and. (p8b .le. p6b) .and.
2439     & (h4b .le. h1b)) THEN
2440      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2441     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2442     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2443     &,int_mb(k_range+p5b-1),5,8,4,7,3,2,1,6,-1.0d0)
2444      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
2445     & 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab *
2446     &(p6b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p5b - noab - 1
2447     &+ nvab * (p7b - noab - 1)))))))))
2448      END IF
2449      IF ((p5b .le. p7b) .and. (p8b .le. p6b) .and. (h1b .le. h2b)) THEN
2450      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2451     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2452     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2453     &,int_mb(k_range+p5b-1),8,5,4,7,6,3,2,1,-1.0d0)
2454      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
2455     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
2456     &(p6b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p7b - noab - 1
2457     &+ nvab * (p5b - noab - 1)))))))))
2458      END IF
2459      IF ((p5b .le. p7b) .and. (p8b .le. p6b) .and. (h2b .le. h1b) .and.
2460     & (h1b .le. h3b)) THEN
2461      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2462     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2463     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2464     &,int_mb(k_range+p5b-1),8,5,4,7,3,6,2,1,1.0d0)
2465      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
2466     & 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab * (h2b - 1 + noab *
2467     &(p6b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p7b - noab - 1
2468     &+ nvab * (p5b - noab - 1)))))))))
2469      END IF
2470      IF ((p5b .le. p7b) .and. (p8b .le. p6b) .and. (h3b .le. h1b) .and.
2471     & (h1b .le. h4b)) THEN
2472      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2473     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2474     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2475     &,int_mb(k_range+p5b-1),8,5,4,7,3,2,6,1,-1.0d0)
2476      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
2477     & 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab *
2478     &(p6b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p7b - noab - 1
2479     &+ nvab * (p5b - noab - 1)))))))))
2480      END IF
2481      IF ((p5b .le. p7b) .and. (p8b .le. p6b) .and. (h4b .le. h1b)) THEN
2482      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2483     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2484     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2485     &,int_mb(k_range+p5b-1),8,5,4,7,3,2,1,6,1.0d0)
2486      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
2487     & 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab *
2488     &(p6b - noab - 1 + nvab * (p8b - noab - 1 + nvab * (p7b - noab - 1
2489     &+ nvab * (p5b - noab - 1)))))))))
2490      END IF
2491      IF ((p8b .le. p5b) .and. (h1b .le. h2b)) THEN
2492      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2493     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2494     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2495     &,int_mb(k_range+p5b-1),5,4,8,7,6,3,2,1,-1.0d0)
2496      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
2497     & 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab *
2498     &(p6b - noab - 1 + nvab * (p5b - noab - 1 + nvab * (p8b - noab - 1
2499     &+ nvab * (p7b - noab - 1)))))))))
2500      END IF
2501      IF ((p8b .le. p5b) .and. (h2b .le. h1b) .and. (h1b .le. h3b)) THEN
2502      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2503     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2504     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2505     &,int_mb(k_range+p5b-1),5,4,8,7,3,6,2,1,1.0d0)
2506      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
2507     & 1 + noab * (h3b - 1 + noab * (h1b - 1 + noab * (h2b - 1 + noab *
2508     &(p6b - noab - 1 + nvab * (p5b - noab - 1 + nvab * (p8b - noab - 1
2509     &+ nvab * (p7b - noab - 1)))))))))
2510      END IF
2511      IF ((p8b .le. p5b) .and. (h3b .le. h1b) .and. (h1b .le. h4b)) THEN
2512      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2513     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2514     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2515     &,int_mb(k_range+p5b-1),5,4,8,7,3,2,6,1,-1.0d0)
2516      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h4b -
2517     & 1 + noab * (h1b - 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab *
2518     &(p6b - noab - 1 + nvab * (p5b - noab - 1 + nvab * (p8b - noab - 1
2519     &+ nvab * (p7b - noab - 1)))))))))
2520      END IF
2521      IF ((p8b .le. p5b) .and. (h4b .le. h1b)) THEN
2522      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h4b-1)
2523     &,int_mb(k_range+h3b-1),int_mb(k_range+h2b-1),int_mb(k_range+p8b-1)
2524     &,int_mb(k_range+p7b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2525     &,int_mb(k_range+p5b-1),5,4,8,7,3,2,1,6,1.0d0)
2526      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
2527     & 1 + noab * (h4b - 1 + noab * (h3b - 1 + noab * (h2b - 1 + noab *
2528     &(p6b - noab - 1 + nvab * (p5b - noab - 1 + nvab * (p8b - noab - 1
2529     &+ nvab * (p7b - noab - 1)))))))))
2530      END IF
2531      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsdtq_o4_6',10,MA_ERR)
2532      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('ccsdtq_o4_6',11,MA_
2533     &ERR)
2534      END IF
2535      END IF
2536      END IF
2537      next = NXTASK(nprocs,1)
2538      END IF
2539      count = count + 1
2540      END DO
2541      END DO
2542      END DO
2543      END DO
2544      END DO
2545      END DO
2546      END DO
2547      END DO
2548      next = NXTASK(-nprocs,1)
2549      call GA_SYNC()
2550      RETURN
2551      END
2552      SUBROUTINE ccsdtq_o4_6_1(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_off
2553     &set)
2554C     $Id$
2555C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
2556C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
2557C     i1 ( h9 p5 p6 h1 h2 h3 )_ot + = 1 * Sum ( p10 ) * o ( h9 p10 )_o * t ( p5 p6 p10 h1 h2 h3 )_t
2558      IMPLICIT NONE
2559#include "global.fh"
2560#include "mafdecls.fh"
2561#include "sym.fh"
2562#include "errquit.fh"
2563#include "tce.fh"
2564      INTEGER d_a
2565      INTEGER k_a_offset
2566      INTEGER d_b
2567      INTEGER k_b_offset
2568      INTEGER d_c
2569      INTEGER k_c_offset
2570      INTEGER NXTASK
2571      INTEGER next
2572      INTEGER nprocs
2573      INTEGER count
2574      INTEGER p5b
2575      INTEGER p6b
2576      INTEGER h9b
2577      INTEGER h1b
2578      INTEGER h2b
2579      INTEGER h3b
2580      INTEGER dimc
2581      INTEGER l_c_sort
2582      INTEGER k_c_sort
2583      INTEGER p10b
2584      INTEGER h9b_1
2585      INTEGER p10b_1
2586      INTEGER p5b_2
2587      INTEGER p6b_2
2588      INTEGER p10b_2
2589      INTEGER h1b_2
2590      INTEGER h2b_2
2591      INTEGER h3b_2
2592      INTEGER dim_common
2593      INTEGER dima_sort
2594      INTEGER dima
2595      INTEGER dimb_sort
2596      INTEGER dimb
2597      INTEGER l_a_sort
2598      INTEGER k_a_sort
2599      INTEGER l_a
2600      INTEGER k_a
2601      INTEGER l_b_sort
2602      INTEGER k_b_sort
2603      INTEGER l_b
2604      INTEGER k_b
2605      INTEGER l_c
2606      INTEGER k_c
2607      EXTERNAL NXTASK
2608      nprocs = GA_NNODES()
2609      count = 0
2610      next = NXTASK(nprocs,1)
2611      DO p5b = noab+1,noab+nvab
2612      DO p6b = p5b,noab+nvab
2613      DO h9b = 1,noab
2614      DO h1b = 1,noab
2615      DO h2b = h1b,noab
2616      DO h3b = h2b,noab
2617      IF (next.eq.count) THEN
2618      IF ((.not.restricted).or.(int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1
2619     &)+int_mb(k_spin+h9b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+i
2620     &nt_mb(k_spin+h3b-1).ne.12)) THEN
2621      IF (int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1)+int_mb(k_spin+h9b-1)
2622     & .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3b-
2623     &1)) THEN
2624      IF (ieor(int_mb(k_sym+p5b-1),ieor(int_mb(k_sym+p6b-1),ieor(int_mb(
2625     &k_sym+h9b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),int
2626     &_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_o,irrep_t)) THEN
2627      dimc = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_mb(k_ra
2628     &nge+h9b-1) * int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) * int_m
2629     &b(k_range+h3b-1)
2630      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
2631     & ERRQUIT('ccsdtq_o4_6_1',0,MA_ERR)
2632      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
2633      DO p10b = noab+1,noab+nvab
2634      IF (int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+p10b-1)) THEN
2635      IF (ieor(int_mb(k_sym+h9b-1),int_mb(k_sym+p10b-1)) .eq. irrep_o) T
2636     &HEN
2637      CALL TCE_RESTRICTED_2(h9b,p10b,h9b_1,p10b_1)
2638      CALL TCE_RESTRICTED_6(p5b,p6b,p10b,h1b,h2b,h3b,p5b_2,p6b_2,p10b_2,
2639     &h1b_2,h2b_2,h3b_2)
2640      dim_common = int_mb(k_range+p10b-1)
2641      dima_sort = int_mb(k_range+h9b-1)
2642      dima = dim_common * dima_sort
2643      dimb_sort = int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_mb
2644     &(k_range+h1b-1) * int_mb(k_range+h2b-1) * int_mb(k_range+h3b-1)
2645      dimb = dim_common * dimb_sort
2646      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
2647      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
2648     & ERRQUIT('ccsdtq_o4_6_1',1,MA_ERR)
2649      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
2650     &ccsdtq_o4_6_1',2,MA_ERR)
2651      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p10b_
2652     &1 - 1 + (noab+nvab) * (h9b_1 - 1)))
2653      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h9b-1)
2654     &,int_mb(k_range+p10b-1),1,2,1.0d0)
2655      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('ccsdtq_o4_6_1',3,MA_ERR)
2656      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
2657     & ERRQUIT('ccsdtq_o4_6_1',4,MA_ERR)
2658      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
2659     &ccsdtq_o4_6_1',5,MA_ERR)
2660      IF ((p10b .lt. p5b)) THEN
2661      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h3b_2
2662     & - 1 + noab * (h2b_2 - 1 + noab * (h1b_2 - 1 + noab * (p6b_2 - noa
2663     &b - 1 + nvab * (p5b_2 - noab - 1 + nvab * (p10b_2 - noab - 1))))))
2664     &)
2665      CALL TCE_SORT_6(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p10b-1
2666     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+h1b-1
2667     &),int_mb(k_range+h2b-1),int_mb(k_range+h3b-1),6,5,4,3,2,1,1.0d0)
2668      END IF
2669      IF ((p5b .le. p10b) .and. (p10b .lt. p6b)) THEN
2670      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h3b_2
2671     & - 1 + noab * (h2b_2 - 1 + noab * (h1b_2 - 1 + noab * (p6b_2 - noa
2672     &b - 1 + nvab * (p10b_2 - noab - 1 + nvab * (p5b_2 - noab - 1))))))
2673     &)
2674      CALL TCE_SORT_6(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p5b-1)
2675     &,int_mb(k_range+p10b-1),int_mb(k_range+p6b-1),int_mb(k_range+h1b-1
2676     &),int_mb(k_range+h2b-1),int_mb(k_range+h3b-1),6,5,4,3,1,2,-1.0d0)
2677      END IF
2678      IF ((p6b .le. p10b)) THEN
2679      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h3b_2
2680     & - 1 + noab * (h2b_2 - 1 + noab * (h1b_2 - 1 + noab * (p10b_2 - no
2681     &ab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p5b_2 - noab - 1))))))
2682     &)
2683      CALL TCE_SORT_6(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p5b-1)
2684     &,int_mb(k_range+p6b-1),int_mb(k_range+p10b-1),int_mb(k_range+h1b-1
2685     &),int_mb(k_range+h2b-1),int_mb(k_range+h3b-1),6,5,4,2,1,3,1.0d0)
2686      END IF
2687      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('ccsdtq_o4_6_1',6,MA_ERR)
2688      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
2689     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
2690     &t),dima_sort)
2691      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('ccsdtq_o4_6_1',7,MA
2692     &_ERR)
2693      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('ccsdtq_o4_6_1',8,MA
2694     &_ERR)
2695      END IF
2696      END IF
2697      END IF
2698      END DO
2699      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
2700     &ccsdtq_o4_6_1',9,MA_ERR)
2701      CALL TCE_SORT_6(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h3b-1)
2702     &,int_mb(k_range+h2b-1),int_mb(k_range+h1b-1),int_mb(k_range+p6b-1)
2703     &,int_mb(k_range+p5b-1),int_mb(k_range+h9b-1),5,4,6,3,2,1,1.0d0)
2704      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h3b -
2705     & 1 + noab * (h2b - 1 + noab * (h1b - 1 + noab * (h9b - 1 + noab *
2706     &(p6b - noab - 1 + nvab * (p5b - noab - 1)))))))
2707      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsdtq_o4_6_1',10,MA_ERR
2708     &)
2709      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('ccsdtq_o4_6_1',11,M
2710     &A_ERR)
2711      END IF
2712      END IF
2713      END IF
2714      next = NXTASK(nprocs,1)
2715      END IF
2716      count = count + 1
2717      END DO
2718      END DO
2719      END DO
2720      END DO
2721      END DO
2722      END DO
2723      next = NXTASK(-nprocs,1)
2724      call GA_SYNC()
2725      RETURN
2726      END
2727      SUBROUTINE OFFSET_ccsdtq_o4_6_1(l_a_offset,k_a_offset,size)
2728C     $Id$
2729C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
2730C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
2731C     i1 ( h9 p5 p6 h1 h2 h3 )_ot
2732      IMPLICIT NONE
2733#include "global.fh"
2734#include "mafdecls.fh"
2735#include "sym.fh"
2736#include "errquit.fh"
2737#include "tce.fh"
2738      INTEGER l_a_offset
2739      INTEGER k_a_offset
2740      INTEGER size
2741      INTEGER length
2742      INTEGER addr
2743      INTEGER p5b
2744      INTEGER p6b
2745      INTEGER h9b
2746      INTEGER h1b
2747      INTEGER h2b
2748      INTEGER h3b
2749      length = 0
2750      DO p5b = noab+1,noab+nvab
2751      DO p6b = p5b,noab+nvab
2752      DO h9b = 1,noab
2753      DO h1b = 1,noab
2754      DO h2b = h1b,noab
2755      DO h3b = h2b,noab
2756      IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1)
2757     & .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3b-
2758     &1)) THEN
2759      IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+p5b-1),ieor(int_mb(
2760     &k_sym+p6b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),int
2761     &_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_o,irrep_t)) THEN
2762      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+p5b-1
2763     &)+int_mb(k_spin+p6b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+i
2764     &nt_mb(k_spin+h3b-1).ne.12)) THEN
2765      length = length + 1
2766      END IF
2767      END IF
2768      END IF
2769      END DO
2770      END DO
2771      END DO
2772      END DO
2773      END DO
2774      END DO
2775      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
2776     &set)) CALL ERRQUIT('ccsdtq_o4_6_1',0,MA_ERR)
2777      int_mb(k_a_offset) = length
2778      addr = 0
2779      size = 0
2780      DO p5b = noab+1,noab+nvab
2781      DO p6b = p5b,noab+nvab
2782      DO h9b = 1,noab
2783      DO h1b = 1,noab
2784      DO h2b = h1b,noab
2785      DO h3b = h2b,noab
2786      IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1)
2787     & .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3b-
2788     &1)) THEN
2789      IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+p5b-1),ieor(int_mb(
2790     &k_sym+p6b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),int
2791     &_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_o,irrep_t)) THEN
2792      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+p5b-1
2793     &)+int_mb(k_spin+p6b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+i
2794     &nt_mb(k_spin+h3b-1).ne.12)) THEN
2795      addr = addr + 1
2796      int_mb(k_a_offset+addr) = h3b - 1 + noab * (h2b - 1 + noab * (h1b
2797     &- 1 + noab * (h9b - 1 + noab * (p6b - noab - 1 + nvab * (p5b - noa
2798     &b - 1)))))
2799      int_mb(k_a_offset+length+addr) = size
2800      size = size + int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_
2801     &mb(k_range+h9b-1) * int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1)
2802     &* int_mb(k_range+h3b-1)
2803      END IF
2804      END IF
2805      END IF
2806      END DO
2807      END DO
2808      END DO
2809      END DO
2810      END DO
2811      END DO
2812      RETURN
2813      END
2814