1      SUBROUTINE ccsdtq_lambda2_30_2_1_1(d_a,k_a_offset,d_c,k_c_offset)
2C     $Id$
3C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
4C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
5C     i3 ( h3 h4 h7 h11 p1 p5 p6 p9 )_y + = 1 * y ( h3 h4 h7 h11 p1 p5 p6 p9 )_y
6      IMPLICIT NONE
7#include "global.fh"
8#include "mafdecls.fh"
9#include "sym.fh"
10#include "errquit.fh"
11#include "tce.fh"
12      INTEGER d_a
13      INTEGER k_a_offset
14      INTEGER d_c
15      INTEGER k_c_offset
16      INTEGER NXTASK
17      INTEGER next
18      INTEGER nprocs
19      INTEGER count
20      INTEGER h3b
21      INTEGER h4b
22      INTEGER h7b
23      INTEGER h11b
24      INTEGER p1b
25      INTEGER p5b
26      INTEGER p6b
27      INTEGER p9b
28      INTEGER dimc
29      INTEGER h3b_1
30      INTEGER h4b_1
31      INTEGER h7b_1
32      INTEGER h11b_1
33      INTEGER p1b_1
34      INTEGER p5b_1
35      INTEGER p6b_1
36      INTEGER p9b_1
37      INTEGER dim_common
38      INTEGER dima_sort
39      INTEGER dima
40      INTEGER l_a_sort
41      INTEGER k_a_sort
42      INTEGER l_a
43      INTEGER k_a
44      INTEGER l_c
45      INTEGER k_c
46      EXTERNAL NXTASK
47      nprocs = GA_NNODES()
48      count = 0
49      next = NXTASK(nprocs,1)
50      DO h3b = 1,noab
51      DO h4b = h3b,noab
52      DO h7b = 1,noab
53      DO h11b = h7b,noab
54      DO p1b = noab+1,noab+nvab
55      DO p5b = noab+1,noab+nvab
56      DO p6b = p5b,noab+nvab
57      DO p9b = p6b,noab+nvab
58      IF (next.eq.count) THEN
59      IF ((.not.restricted).or.(int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1
60     &)+int_mb(k_spin+h7b-1)+int_mb(k_spin+h11b-1)+int_mb(k_spin+p1b-1)+
61     &int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1)+int_mb(k_spin+p9b-1).ne.
62     &16)) THEN
63      IF (int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1)+int_mb(k_spin+h7b-1)
64     &+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+p1b-1)+int_mb(k_spin+p5b
65     &-1)+int_mb(k_spin+p6b-1)+int_mb(k_spin+p9b-1)) THEN
66      IF (ieor(int_mb(k_sym+h3b-1),ieor(int_mb(k_sym+h4b-1),ieor(int_mb(
67     &k_sym+h7b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p1b-1),ie
68     &or(int_mb(k_sym+p5b-1),ieor(int_mb(k_sym+p6b-1),int_mb(k_sym+p9b-1
69     &)))))))) .eq. irrep_y) THEN
70      dimc = int_mb(k_range+h3b-1) * int_mb(k_range+h4b-1) * int_mb(k_ra
71     &nge+h7b-1) * int_mb(k_range+h11b-1) * int_mb(k_range+p1b-1) * int_
72     &mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_mb(k_range+p9b-1)
73      CALL TCE_RESTRICTED_8(h3b,h4b,h7b,h11b,p1b,p5b,p6b,p9b,h3b_1,h4b_1
74     &,h7b_1,h11b_1,p1b_1,p5b_1,p6b_1,p9b_1)
75      dim_common = 1
76      dima_sort = int_mb(k_range+h3b-1) * int_mb(k_range+h4b-1) * int_mb
77     &(k_range+h7b-1) * int_mb(k_range+h11b-1) * int_mb(k_range+p1b-1) *
78     & int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1) * int_mb(k_range+p9
79     &b-1)
80      dima = dim_common * dima_sort
81      IF (dima .gt. 0) THEN
82      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
83     & ERRQUIT('ccsdtq_lambda2_30_2_1_1',0,MA_ERR)
84      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
85     &ccsdtq_lambda2_30_2_1_1',1,MA_ERR)
86      IF ((h11b .lt. h3b) .and. (p9b .lt. p1b)) THEN
87      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p1b_1
88     & - noab - 1 + nvab * (p9b_1 - noab - 1 + nvab * (p6b_1 - noab - 1
89     &+ nvab * (p5b_1 - noab - 1 + nvab * (h4b_1 - 1 + noab * (h3b_1 - 1
90     & + noab * (h11b_1 - 1 + noab * (h7b_1 - 1)))))))))
91      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h7b-1)
92     &,int_mb(k_range+h11b-1),int_mb(k_range+h3b-1),int_mb(k_range+h4b-1
93     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p9b-1
94     &),int_mb(k_range+p1b-1),7,6,5,8,2,1,4,3,-1.0d0)
95      END IF
96      IF ((h11b .lt. h3b) .and. (p6b .lt. p1b) .and. (p1b .le. p9b)) THE
97     &N
98      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
99     & - noab - 1 + nvab * (p1b_1 - noab - 1 + nvab * (p6b_1 - noab - 1
100     &+ nvab * (p5b_1 - noab - 1 + nvab * (h4b_1 - 1 + noab * (h3b_1 - 1
101     & + noab * (h11b_1 - 1 + noab * (h7b_1 - 1)))))))))
102      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h7b-1)
103     &,int_mb(k_range+h11b-1),int_mb(k_range+h3b-1),int_mb(k_range+h4b-1
104     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p1b-1
105     &),int_mb(k_range+p9b-1),8,6,5,7,2,1,4,3,1.0d0)
106      END IF
107      IF ((h11b .lt. h3b) .and. (p5b .lt. p1b) .and. (p1b .le. p6b)) THE
108     &N
109      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
110     & - noab - 1 + nvab * (p6b_1 - noab - 1 + nvab * (p1b_1 - noab - 1
111     &+ nvab * (p5b_1 - noab - 1 + nvab * (h4b_1 - 1 + noab * (h3b_1 - 1
112     & + noab * (h11b_1 - 1 + noab * (h7b_1 - 1)))))))))
113      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h7b-1)
114     &,int_mb(k_range+h11b-1),int_mb(k_range+h3b-1),int_mb(k_range+h4b-1
115     &),int_mb(k_range+p5b-1),int_mb(k_range+p1b-1),int_mb(k_range+p6b-1
116     &),int_mb(k_range+p9b-1),8,7,5,6,2,1,4,3,-1.0d0)
117      END IF
118      IF ((h11b .lt. h3b) .and. (p1b .le. p5b)) THEN
119      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
120     & - noab - 1 + nvab * (p6b_1 - noab - 1 + nvab * (p5b_1 - noab - 1
121     &+ nvab * (p1b_1 - noab - 1 + nvab * (h4b_1 - 1 + noab * (h3b_1 - 1
122     & + noab * (h11b_1 - 1 + noab * (h7b_1 - 1)))))))))
123      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h7b-1)
124     &,int_mb(k_range+h11b-1),int_mb(k_range+h3b-1),int_mb(k_range+h4b-1
125     &),int_mb(k_range+p1b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1
126     &),int_mb(k_range+p9b-1),8,7,6,5,2,1,4,3,1.0d0)
127      END IF
128      IF ((h7b .lt. h3b) .and. (h3b .le. h11b) .and. (h11b .lt. h4b) .an
129     &d. (p9b .lt. p1b)) THEN
130      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p1b_1
131     & - noab - 1 + nvab * (p9b_1 - noab - 1 + nvab * (p6b_1 - noab - 1
132     &+ nvab * (p5b_1 - noab - 1 + nvab * (h4b_1 - 1 + noab * (h11b_1 -
133     &1 + noab * (h3b_1 - 1 + noab * (h7b_1 - 1)))))))))
134      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h7b-1)
135     &,int_mb(k_range+h3b-1),int_mb(k_range+h11b-1),int_mb(k_range+h4b-1
136     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p9b-1
137     &),int_mb(k_range+p1b-1),7,6,5,8,3,1,4,2,1.0d0)
138      END IF
139      IF ((h7b .lt. h3b) .and. (h3b .le. h11b) .and. (h11b .lt. h4b) .an
140     &d. (p6b .lt. p1b) .and. (p1b .le. p9b)) THEN
141      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
142     & - noab - 1 + nvab * (p1b_1 - noab - 1 + nvab * (p6b_1 - noab - 1
143     &+ nvab * (p5b_1 - noab - 1 + nvab * (h4b_1 - 1 + noab * (h11b_1 -
144     &1 + noab * (h3b_1 - 1 + noab * (h7b_1 - 1)))))))))
145      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h7b-1)
146     &,int_mb(k_range+h3b-1),int_mb(k_range+h11b-1),int_mb(k_range+h4b-1
147     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p1b-1
148     &),int_mb(k_range+p9b-1),8,6,5,7,3,1,4,2,-1.0d0)
149      END IF
150      IF ((h7b .lt. h3b) .and. (h3b .le. h11b) .and. (h11b .lt. h4b) .an
151     &d. (p5b .lt. p1b) .and. (p1b .le. p6b)) THEN
152      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
153     & - noab - 1 + nvab * (p6b_1 - noab - 1 + nvab * (p1b_1 - noab - 1
154     &+ nvab * (p5b_1 - noab - 1 + nvab * (h4b_1 - 1 + noab * (h11b_1 -
155     &1 + noab * (h3b_1 - 1 + noab * (h7b_1 - 1)))))))))
156      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h7b-1)
157     &,int_mb(k_range+h3b-1),int_mb(k_range+h11b-1),int_mb(k_range+h4b-1
158     &),int_mb(k_range+p5b-1),int_mb(k_range+p1b-1),int_mb(k_range+p6b-1
159     &),int_mb(k_range+p9b-1),8,7,5,6,3,1,4,2,1.0d0)
160      END IF
161      IF ((h7b .lt. h3b) .and. (h3b .le. h11b) .and. (h11b .lt. h4b) .an
162     &d. (p1b .le. p5b)) THEN
163      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
164     & - noab - 1 + nvab * (p6b_1 - noab - 1 + nvab * (p5b_1 - noab - 1
165     &+ nvab * (p1b_1 - noab - 1 + nvab * (h4b_1 - 1 + noab * (h11b_1 -
166     &1 + noab * (h3b_1 - 1 + noab * (h7b_1 - 1)))))))))
167      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h7b-1)
168     &,int_mb(k_range+h3b-1),int_mb(k_range+h11b-1),int_mb(k_range+h4b-1
169     &),int_mb(k_range+p1b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1
170     &),int_mb(k_range+p9b-1),8,7,6,5,3,1,4,2,-1.0d0)
171      END IF
172      IF ((h7b .lt. h3b) .and. (h4b .le. h11b) .and. (p9b .lt. p1b)) THE
173     &N
174      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p1b_1
175     & - noab - 1 + nvab * (p9b_1 - noab - 1 + nvab * (p6b_1 - noab - 1
176     &+ nvab * (p5b_1 - noab - 1 + nvab * (h11b_1 - 1 + noab * (h4b_1 -
177     &1 + noab * (h3b_1 - 1 + noab * (h7b_1 - 1)))))))))
178      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h7b-1)
179     &,int_mb(k_range+h3b-1),int_mb(k_range+h4b-1),int_mb(k_range+h11b-1
180     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p9b-1
181     &),int_mb(k_range+p1b-1),7,6,5,8,4,1,3,2,-1.0d0)
182      END IF
183      IF ((h7b .lt. h3b) .and. (h4b .le. h11b) .and. (p6b .lt. p1b) .and
184     &. (p1b .le. p9b)) THEN
185      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
186     & - noab - 1 + nvab * (p1b_1 - noab - 1 + nvab * (p6b_1 - noab - 1
187     &+ nvab * (p5b_1 - noab - 1 + nvab * (h11b_1 - 1 + noab * (h4b_1 -
188     &1 + noab * (h3b_1 - 1 + noab * (h7b_1 - 1)))))))))
189      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h7b-1)
190     &,int_mb(k_range+h3b-1),int_mb(k_range+h4b-1),int_mb(k_range+h11b-1
191     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p1b-1
192     &),int_mb(k_range+p9b-1),8,6,5,7,4,1,3,2,1.0d0)
193      END IF
194      IF ((h7b .lt. h3b) .and. (h4b .le. h11b) .and. (p5b .lt. p1b) .and
195     &. (p1b .le. p6b)) THEN
196      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
197     & - noab - 1 + nvab * (p6b_1 - noab - 1 + nvab * (p1b_1 - noab - 1
198     &+ nvab * (p5b_1 - noab - 1 + nvab * (h11b_1 - 1 + noab * (h4b_1 -
199     &1 + noab * (h3b_1 - 1 + noab * (h7b_1 - 1)))))))))
200      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h7b-1)
201     &,int_mb(k_range+h3b-1),int_mb(k_range+h4b-1),int_mb(k_range+h11b-1
202     &),int_mb(k_range+p5b-1),int_mb(k_range+p1b-1),int_mb(k_range+p6b-1
203     &),int_mb(k_range+p9b-1),8,7,5,6,4,1,3,2,-1.0d0)
204      END IF
205      IF ((h7b .lt. h3b) .and. (h4b .le. h11b) .and. (p1b .le. p5b)) THE
206     &N
207      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
208     & - noab - 1 + nvab * (p6b_1 - noab - 1 + nvab * (p5b_1 - noab - 1
209     &+ nvab * (p1b_1 - noab - 1 + nvab * (h11b_1 - 1 + noab * (h4b_1 -
210     &1 + noab * (h3b_1 - 1 + noab * (h7b_1 - 1)))))))))
211      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h7b-1)
212     &,int_mb(k_range+h3b-1),int_mb(k_range+h4b-1),int_mb(k_range+h11b-1
213     &),int_mb(k_range+p1b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1
214     &),int_mb(k_range+p9b-1),8,7,6,5,4,1,3,2,1.0d0)
215      END IF
216      IF ((h3b .le. h7b) .and. (h11b .lt. h4b) .and. (p9b .lt. p1b)) THE
217     &N
218      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p1b_1
219     & - noab - 1 + nvab * (p9b_1 - noab - 1 + nvab * (p6b_1 - noab - 1
220     &+ nvab * (p5b_1 - noab - 1 + nvab * (h4b_1 - 1 + noab * (h11b_1 -
221     &1 + noab * (h7b_1 - 1 + noab * (h3b_1 - 1)))))))))
222      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h3b-1)
223     &,int_mb(k_range+h7b-1),int_mb(k_range+h11b-1),int_mb(k_range+h4b-1
224     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p9b-1
225     &),int_mb(k_range+p1b-1),7,6,5,8,3,2,4,1,-1.0d0)
226      END IF
227      IF ((h3b .le. h7b) .and. (h11b .lt. h4b) .and. (p6b .lt. p1b) .and
228     &. (p1b .le. p9b)) THEN
229      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
230     & - noab - 1 + nvab * (p1b_1 - noab - 1 + nvab * (p6b_1 - noab - 1
231     &+ nvab * (p5b_1 - noab - 1 + nvab * (h4b_1 - 1 + noab * (h11b_1 -
232     &1 + noab * (h7b_1 - 1 + noab * (h3b_1 - 1)))))))))
233      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h3b-1)
234     &,int_mb(k_range+h7b-1),int_mb(k_range+h11b-1),int_mb(k_range+h4b-1
235     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p1b-1
236     &),int_mb(k_range+p9b-1),8,6,5,7,3,2,4,1,1.0d0)
237      END IF
238      IF ((h3b .le. h7b) .and. (h11b .lt. h4b) .and. (p5b .lt. p1b) .and
239     &. (p1b .le. p6b)) THEN
240      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
241     & - noab - 1 + nvab * (p6b_1 - noab - 1 + nvab * (p1b_1 - noab - 1
242     &+ nvab * (p5b_1 - noab - 1 + nvab * (h4b_1 - 1 + noab * (h11b_1 -
243     &1 + noab * (h7b_1 - 1 + noab * (h3b_1 - 1)))))))))
244      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h3b-1)
245     &,int_mb(k_range+h7b-1),int_mb(k_range+h11b-1),int_mb(k_range+h4b-1
246     &),int_mb(k_range+p5b-1),int_mb(k_range+p1b-1),int_mb(k_range+p6b-1
247     &),int_mb(k_range+p9b-1),8,7,5,6,3,2,4,1,-1.0d0)
248      END IF
249      IF ((h3b .le. h7b) .and. (h11b .lt. h4b) .and. (p1b .le. p5b)) THE
250     &N
251      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
252     & - noab - 1 + nvab * (p6b_1 - noab - 1 + nvab * (p5b_1 - noab - 1
253     &+ nvab * (p1b_1 - noab - 1 + nvab * (h4b_1 - 1 + noab * (h11b_1 -
254     &1 + noab * (h7b_1 - 1 + noab * (h3b_1 - 1)))))))))
255      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h3b-1)
256     &,int_mb(k_range+h7b-1),int_mb(k_range+h11b-1),int_mb(k_range+h4b-1
257     &),int_mb(k_range+p1b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1
258     &),int_mb(k_range+p9b-1),8,7,6,5,3,2,4,1,1.0d0)
259      END IF
260      IF ((h3b .le. h7b) .and. (h7b .lt. h4b) .and. (h4b .le. h11b) .and
261     &. (p9b .lt. p1b)) THEN
262      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p1b_1
263     & - noab - 1 + nvab * (p9b_1 - noab - 1 + nvab * (p6b_1 - noab - 1
264     &+ nvab * (p5b_1 - noab - 1 + nvab * (h11b_1 - 1 + noab * (h4b_1 -
265     &1 + noab * (h7b_1 - 1 + noab * (h3b_1 - 1)))))))))
266      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h3b-1)
267     &,int_mb(k_range+h7b-1),int_mb(k_range+h4b-1),int_mb(k_range+h11b-1
268     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p9b-1
269     &),int_mb(k_range+p1b-1),7,6,5,8,4,2,3,1,1.0d0)
270      END IF
271      IF ((h3b .le. h7b) .and. (h7b .lt. h4b) .and. (h4b .le. h11b) .and
272     &. (p6b .lt. p1b) .and. (p1b .le. p9b)) THEN
273      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
274     & - noab - 1 + nvab * (p1b_1 - noab - 1 + nvab * (p6b_1 - noab - 1
275     &+ nvab * (p5b_1 - noab - 1 + nvab * (h11b_1 - 1 + noab * (h4b_1 -
276     &1 + noab * (h7b_1 - 1 + noab * (h3b_1 - 1)))))))))
277      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h3b-1)
278     &,int_mb(k_range+h7b-1),int_mb(k_range+h4b-1),int_mb(k_range+h11b-1
279     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p1b-1
280     &),int_mb(k_range+p9b-1),8,6,5,7,4,2,3,1,-1.0d0)
281      END IF
282      IF ((h3b .le. h7b) .and. (h7b .lt. h4b) .and. (h4b .le. h11b) .and
283     &. (p5b .lt. p1b) .and. (p1b .le. p6b)) THEN
284      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
285     & - noab - 1 + nvab * (p6b_1 - noab - 1 + nvab * (p1b_1 - noab - 1
286     &+ nvab * (p5b_1 - noab - 1 + nvab * (h11b_1 - 1 + noab * (h4b_1 -
287     &1 + noab * (h7b_1 - 1 + noab * (h3b_1 - 1)))))))))
288      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h3b-1)
289     &,int_mb(k_range+h7b-1),int_mb(k_range+h4b-1),int_mb(k_range+h11b-1
290     &),int_mb(k_range+p5b-1),int_mb(k_range+p1b-1),int_mb(k_range+p6b-1
291     &),int_mb(k_range+p9b-1),8,7,5,6,4,2,3,1,1.0d0)
292      END IF
293      IF ((h3b .le. h7b) .and. (h7b .lt. h4b) .and. (h4b .le. h11b) .and
294     &. (p1b .le. p5b)) THEN
295      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
296     & - noab - 1 + nvab * (p6b_1 - noab - 1 + nvab * (p5b_1 - noab - 1
297     &+ nvab * (p1b_1 - noab - 1 + nvab * (h11b_1 - 1 + noab * (h4b_1 -
298     &1 + noab * (h7b_1 - 1 + noab * (h3b_1 - 1)))))))))
299      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h3b-1)
300     &,int_mb(k_range+h7b-1),int_mb(k_range+h4b-1),int_mb(k_range+h11b-1
301     &),int_mb(k_range+p1b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1
302     &),int_mb(k_range+p9b-1),8,7,6,5,4,2,3,1,-1.0d0)
303      END IF
304      IF ((h4b .le. h7b) .and. (p9b .lt. p1b)) THEN
305      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p1b_1
306     & - noab - 1 + nvab * (p9b_1 - noab - 1 + nvab * (p6b_1 - noab - 1
307     &+ nvab * (p5b_1 - noab - 1 + nvab * (h11b_1 - 1 + noab * (h7b_1 -
308     &1 + noab * (h4b_1 - 1 + noab * (h3b_1 - 1)))))))))
309      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h3b-1)
310     &,int_mb(k_range+h4b-1),int_mb(k_range+h7b-1),int_mb(k_range+h11b-1
311     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p9b-1
312     &),int_mb(k_range+p1b-1),7,6,5,8,4,3,2,1,-1.0d0)
313      END IF
314      IF ((h4b .le. h7b) .and. (p6b .lt. p1b) .and. (p1b .le. p9b)) THEN
315      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
316     & - noab - 1 + nvab * (p1b_1 - noab - 1 + nvab * (p6b_1 - noab - 1
317     &+ nvab * (p5b_1 - noab - 1 + nvab * (h11b_1 - 1 + noab * (h7b_1 -
318     &1 + noab * (h4b_1 - 1 + noab * (h3b_1 - 1)))))))))
319      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h3b-1)
320     &,int_mb(k_range+h4b-1),int_mb(k_range+h7b-1),int_mb(k_range+h11b-1
321     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p1b-1
322     &),int_mb(k_range+p9b-1),8,6,5,7,4,3,2,1,1.0d0)
323      END IF
324      IF ((h4b .le. h7b) .and. (p5b .lt. p1b) .and. (p1b .le. p6b)) THEN
325      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
326     & - noab - 1 + nvab * (p6b_1 - noab - 1 + nvab * (p1b_1 - noab - 1
327     &+ nvab * (p5b_1 - noab - 1 + nvab * (h11b_1 - 1 + noab * (h7b_1 -
328     &1 + noab * (h4b_1 - 1 + noab * (h3b_1 - 1)))))))))
329      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h3b-1)
330     &,int_mb(k_range+h4b-1),int_mb(k_range+h7b-1),int_mb(k_range+h11b-1
331     &),int_mb(k_range+p5b-1),int_mb(k_range+p1b-1),int_mb(k_range+p6b-1
332     &),int_mb(k_range+p9b-1),8,7,5,6,4,3,2,1,-1.0d0)
333      END IF
334      IF ((h4b .le. h7b) .and. (p1b .le. p5b)) THEN
335      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p9b_1
336     & - noab - 1 + nvab * (p6b_1 - noab - 1 + nvab * (p5b_1 - noab - 1
337     &+ nvab * (p1b_1 - noab - 1 + nvab * (h11b_1 - 1 + noab * (h7b_1 -
338     &1 + noab * (h4b_1 - 1 + noab * (h3b_1 - 1)))))))))
339      CALL TCE_SORT_8(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h3b-1)
340     &,int_mb(k_range+h4b-1),int_mb(k_range+h7b-1),int_mb(k_range+h11b-1
341     &),int_mb(k_range+p1b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1
342     &),int_mb(k_range+p9b-1),8,7,6,5,4,3,2,1,1.0d0)
343      END IF
344      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('ccsdtq_lambda2_30_2_1_1'
345     &,2,MA_ERR)
346      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
347     &ccsdtq_lambda2_30_2_1_1',3,MA_ERR)
348      CALL TCE_SORT_8(dbl_mb(k_a_sort),dbl_mb(k_c),int_mb(k_range+p9b-1)
349     &,int_mb(k_range+p6b-1),int_mb(k_range+p5b-1),int_mb(k_range+p1b-1)
350     &,int_mb(k_range+h11b-1),int_mb(k_range+h7b-1),int_mb(k_range+h4b-1
351     &),int_mb(k_range+h3b-1),8,7,6,5,4,3,2,1,1.0d0)
352      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p9b -
353     & noab - 1 + nvab * (p6b - noab - 1 + nvab * (p5b - noab - 1 + nvab
354     & * (p1b - noab - 1 + nvab * (h11b - 1 + noab * (h7b - 1 + noab * (
355     &h4b - 1 + noab * (h3b - 1)))))))))
356      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsdtq_lambda2_30_2_1_1'
357     &,4,MA_ERR)
358      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('ccsdtq_lambda2_30_2
359     &_1_1',5,MA_ERR)
360      END IF
361      END IF
362      END IF
363      END IF
364      next = NXTASK(nprocs,1)
365      END IF
366      count = count + 1
367      END DO
368      END DO
369      END DO
370      END DO
371      END DO
372      END DO
373      END DO
374      END DO
375      next = NXTASK(-nprocs,1)
376      call GA_SYNC()
377      RETURN
378      END
379