1      SUBROUTINE eomccsdtq_y2_25_5_1(d_a,k_a_offset,d_b,k_b_offset,d_c,k
2     &_c_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     i2 ( h3 h8 h9 h10 h14 p1 p5 p6 )_yt + = 1 * Sum ( p11 ) * t ( p11 h14 )_t * y ( h3 h8 h9 h10 p1 p5 p6 p11 )_y
7      IMPLICIT NONE
8#include "global.fh"
9#include "mafdecls.fh"
10#include "sym.fh"
11#include "errquit.fh"
12#include "tce.fh"
13      INTEGER d_a
14      INTEGER k_a_offset
15      INTEGER d_b
16      INTEGER k_b_offset
17      INTEGER d_c
18      INTEGER k_c_offset
19      INTEGER NXTASK
20      INTEGER next
21      INTEGER nprocs
22      INTEGER count
23      INTEGER h3b
24      INTEGER h8b
25      INTEGER h9b
26      INTEGER h10b
27      INTEGER p1b
28      INTEGER h14b
29      INTEGER p5b
30      INTEGER p6b
31      INTEGER dimc
32      INTEGER l_c_sort
33      INTEGER k_c_sort
34      INTEGER p11b
35      INTEGER p11b_1
36      INTEGER h14b_1
37      INTEGER h3b_2
38      INTEGER h8b_2
39      INTEGER h9b_2
40      INTEGER h10b_2
41      INTEGER p1b_2
42      INTEGER p5b_2
43      INTEGER p6b_2
44      INTEGER p11b_2
45      INTEGER dim_common
46      INTEGER dima_sort
47      INTEGER dima
48      INTEGER dimb_sort
49      INTEGER dimb
50      INTEGER l_a_sort
51      INTEGER k_a_sort
52      INTEGER l_a
53      INTEGER k_a
54      INTEGER l_b_sort
55      INTEGER k_b_sort
56      INTEGER l_b
57      INTEGER k_b
58      INTEGER l_c
59      INTEGER k_c
60      EXTERNAL NXTASK
61      nprocs = GA_NNODES()
62      count = 0
63      next = NXTASK(nprocs,1)
64      DO h3b = 1,noab
65      DO h8b = 1,noab
66      DO h9b = h8b,noab
67      DO h10b = h9b,noab
68      DO p1b = noab+1,noab+nvab
69      DO h14b = 1,noab
70      DO p5b = noab+1,noab+nvab
71      DO p6b = p5b,noab+nvab
72      IF (next.eq.count) THEN
73      IF ((.not.restricted).or.(int_mb(k_spin+h3b-1)+int_mb(k_spin+h8b-1
74     &)+int_mb(k_spin+h9b-1)+int_mb(k_spin+h10b-1)+int_mb(k_spin+p1b-1)+
75     &int_mb(k_spin+h14b-1)+int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1).ne
76     &.16)) THEN
77      IF (int_mb(k_spin+h3b-1)+int_mb(k_spin+h8b-1)+int_mb(k_spin+h9b-1)
78     &+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+p1b-1)+int_mb(k_spin+h14
79     &b-1)+int_mb(k_spin+p5b-1)+int_mb(k_spin+p6b-1)) THEN
80      IF (ieor(int_mb(k_sym+h3b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb(
81     &k_sym+h9b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+p1b-1),ie
82     &or(int_mb(k_sym+h14b-1),ieor(int_mb(k_sym+p5b-1),int_mb(k_sym+p6b-
83     &1)))))))) .eq. ieor(irrep_y,irrep_t)) THEN
84      dimc = int_mb(k_range+h3b-1) * int_mb(k_range+h8b-1) * int_mb(k_ra
85     &nge+h9b-1) * int_mb(k_range+h10b-1) * int_mb(k_range+p1b-1) * int_
86     &mb(k_range+h14b-1) * int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1)
87      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
88     & ERRQUIT('eomccsdtq_y2_25_5_1',0,MA_ERR)
89      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
90      DO p11b = noab+1,noab+nvab
91      IF (int_mb(k_spin+p11b-1) .eq. int_mb(k_spin+h14b-1)) THEN
92      IF (ieor(int_mb(k_sym+p11b-1),int_mb(k_sym+h14b-1)) .eq. irrep_t)
93     &THEN
94      CALL TCE_RESTRICTED_2(p11b,h14b,p11b_1,h14b_1)
95      CALL TCE_RESTRICTED_8(h3b,h8b,h9b,h10b,p1b,p5b,p6b,p11b,h3b_2,h8b_
96     &2,h9b_2,h10b_2,p1b_2,p5b_2,p6b_2,p11b_2)
97      dim_common = int_mb(k_range+p11b-1)
98      dima_sort = int_mb(k_range+h14b-1)
99      dima = dim_common * dima_sort
100      dimb_sort = int_mb(k_range+h3b-1) * int_mb(k_range+h8b-1) * int_mb
101     &(k_range+h9b-1) * int_mb(k_range+h10b-1) * int_mb(k_range+p1b-1) *
102     & int_mb(k_range+p5b-1) * int_mb(k_range+p6b-1)
103      dimb = dim_common * dimb_sort
104      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
105      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
106     & ERRQUIT('eomccsdtq_y2_25_5_1',1,MA_ERR)
107      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
108     &eomccsdtq_y2_25_5_1',2,MA_ERR)
109      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h14b_
110     &1 - 1 + noab * (p11b_1 - noab - 1)))
111      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p11b-1
112     &),int_mb(k_range+h14b-1),2,1,1.0d0)
113      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('eomccsdtq_y2_25_5_1',3,M
114     &A_ERR)
115      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
116     & ERRQUIT('eomccsdtq_y2_25_5_1',4,MA_ERR)
117      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
118     &eomccsdtq_y2_25_5_1',5,MA_ERR)
119      IF ((h10b .lt. h3b) .and. (p11b .lt. p5b) .and. (p6b .lt. p1b)) TH
120     &EN
121      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p1b_2
122     & - noab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p5b_2 - noab - 1
123     &+ nvab * (p11b_2 - noab - 1 + nvab * (h3b_2 - 1 + noab * (h10b_2 -
124     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
125      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
126     &,int_mb(k_range+h9b-1),int_mb(k_range+h10b-1),int_mb(k_range+h3b-1
127     &),int_mb(k_range+p11b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-
128     &1),int_mb(k_range+p1b-1),7,6,8,3,2,1,4,5,1.0d0)
129      END IF
130      IF ((h10b .lt. h3b) .and. (p5b .le. p11b) .and. (p11b .lt. p6b) .a
131     &nd. (p6b .lt. p1b)) THEN
132      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p1b_2
133     & - noab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p11b_2 - noab - 1
134     & + nvab * (p5b_2 - noab - 1 + nvab * (h3b_2 - 1 + noab * (h10b_2 -
135     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
136      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
137     &,int_mb(k_range+h9b-1),int_mb(k_range+h10b-1),int_mb(k_range+h3b-1
138     &),int_mb(k_range+p5b-1),int_mb(k_range+p11b-1),int_mb(k_range+p6b-
139     &1),int_mb(k_range+p1b-1),7,5,8,3,2,1,4,6,-1.0d0)
140      END IF
141      IF ((h10b .lt. h3b) .and. (p6b .le. p11b) .and. (p11b .lt. p1b)) T
142     &HEN
143      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p1b_2
144     & - noab - 1 + nvab * (p11b_2 - noab - 1 + nvab * (p6b_2 - noab - 1
145     & + nvab * (p5b_2 - noab - 1 + nvab * (h3b_2 - 1 + noab * (h10b_2 -
146     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
147      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
148     &,int_mb(k_range+h9b-1),int_mb(k_range+h10b-1),int_mb(k_range+h3b-1
149     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p11b-
150     &1),int_mb(k_range+p1b-1),6,5,8,3,2,1,4,7,1.0d0)
151      END IF
152      IF ((h10b .lt. h3b) .and. (p6b .lt. p1b) .and. (p1b .le. p11b)) TH
153     &EN
154      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p11b_
155     &2 - noab - 1 + nvab * (p1b_2 - noab - 1 + nvab * (p6b_2 - noab - 1
156     & + nvab * (p5b_2 - noab - 1 + nvab * (h3b_2 - 1 + noab * (h10b_2 -
157     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
158      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
159     &,int_mb(k_range+h9b-1),int_mb(k_range+h10b-1),int_mb(k_range+h3b-1
160     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p1b-1
161     &),int_mb(k_range+p11b-1),6,5,7,3,2,1,4,8,-1.0d0)
162      END IF
163      IF ((h10b .lt. h3b) .and. (p11b .lt. p5b) .and. (p5b .lt. p1b) .an
164     &d. (p1b .le. p6b)) THEN
165      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
166     & - noab - 1 + nvab * (p1b_2 - noab - 1 + nvab * (p5b_2 - noab - 1
167     &+ nvab * (p11b_2 - noab - 1 + nvab * (h3b_2 - 1 + noab * (h10b_2 -
168     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
169      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
170     &,int_mb(k_range+h9b-1),int_mb(k_range+h10b-1),int_mb(k_range+h3b-1
171     &),int_mb(k_range+p11b-1),int_mb(k_range+p5b-1),int_mb(k_range+p1b-
172     &1),int_mb(k_range+p6b-1),8,6,7,3,2,1,4,5,-1.0d0)
173      END IF
174      IF ((h10b .lt. h3b) .and. (p5b .le. p11b) .and. (p11b .lt. p1b) .a
175     &nd. (p1b .le. p6b)) THEN
176      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
177     & - noab - 1 + nvab * (p1b_2 - noab - 1 + nvab * (p11b_2 - noab - 1
178     & + nvab * (p5b_2 - noab - 1 + nvab * (h3b_2 - 1 + noab * (h10b_2 -
179     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
180      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
181     &,int_mb(k_range+h9b-1),int_mb(k_range+h10b-1),int_mb(k_range+h3b-1
182     &),int_mb(k_range+p5b-1),int_mb(k_range+p11b-1),int_mb(k_range+p1b-
183     &1),int_mb(k_range+p6b-1),8,5,7,3,2,1,4,6,1.0d0)
184      END IF
185      IF ((h10b .lt. h3b) .and. (p5b .lt. p1b) .and. (p1b .le. p11b) .an
186     &d. (p11b .lt. p6b)) THEN
187      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
188     & - noab - 1 + nvab * (p11b_2 - noab - 1 + nvab * (p1b_2 - noab - 1
189     & + nvab * (p5b_2 - noab - 1 + nvab * (h3b_2 - 1 + noab * (h10b_2 -
190     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
191      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
192     &,int_mb(k_range+h9b-1),int_mb(k_range+h10b-1),int_mb(k_range+h3b-1
193     &),int_mb(k_range+p5b-1),int_mb(k_range+p1b-1),int_mb(k_range+p11b-
194     &1),int_mb(k_range+p6b-1),8,5,6,3,2,1,4,7,-1.0d0)
195      END IF
196      IF ((h10b .lt. h3b) .and. (p5b .lt. p1b) .and. (p1b .le. p6b) .and
197     &. (p6b .le. p11b)) THEN
198      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p11b_
199     &2 - noab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p1b_2 - noab - 1
200     & + nvab * (p5b_2 - noab - 1 + nvab * (h3b_2 - 1 + noab * (h10b_2 -
201     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
202      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
203     &,int_mb(k_range+h9b-1),int_mb(k_range+h10b-1),int_mb(k_range+h3b-1
204     &),int_mb(k_range+p5b-1),int_mb(k_range+p1b-1),int_mb(k_range+p6b-1
205     &),int_mb(k_range+p11b-1),7,5,6,3,2,1,4,8,1.0d0)
206      END IF
207      IF ((h10b .lt. h3b) .and. (p11b .lt. p1b) .and. (p1b .le. p5b)) TH
208     &EN
209      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
210     & - noab - 1 + nvab * (p5b_2 - noab - 1 + nvab * (p1b_2 - noab - 1
211     &+ nvab * (p11b_2 - noab - 1 + nvab * (h3b_2 - 1 + noab * (h10b_2 -
212     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
213      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
214     &,int_mb(k_range+h9b-1),int_mb(k_range+h10b-1),int_mb(k_range+h3b-1
215     &),int_mb(k_range+p11b-1),int_mb(k_range+p1b-1),int_mb(k_range+p5b-
216     &1),int_mb(k_range+p6b-1),8,7,6,3,2,1,4,5,1.0d0)
217      END IF
218      IF ((h10b .lt. h3b) .and. (p1b .le. p11b) .and. (p11b .lt. p5b)) T
219     &HEN
220      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
221     & - noab - 1 + nvab * (p5b_2 - noab - 1 + nvab * (p11b_2 - noab - 1
222     & + nvab * (p1b_2 - noab - 1 + nvab * (h3b_2 - 1 + noab * (h10b_2 -
223     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
224      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
225     &,int_mb(k_range+h9b-1),int_mb(k_range+h10b-1),int_mb(k_range+h3b-1
226     &),int_mb(k_range+p1b-1),int_mb(k_range+p11b-1),int_mb(k_range+p5b-
227     &1),int_mb(k_range+p6b-1),8,7,5,3,2,1,4,6,-1.0d0)
228      END IF
229      IF ((h10b .lt. h3b) .and. (p1b .le. p5b) .and. (p5b .le. p11b) .an
230     &d. (p11b .lt. p6b)) THEN
231      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
232     & - noab - 1 + nvab * (p11b_2 - noab - 1 + nvab * (p5b_2 - noab - 1
233     & + nvab * (p1b_2 - noab - 1 + nvab * (h3b_2 - 1 + noab * (h10b_2 -
234     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
235      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
236     &,int_mb(k_range+h9b-1),int_mb(k_range+h10b-1),int_mb(k_range+h3b-1
237     &),int_mb(k_range+p1b-1),int_mb(k_range+p5b-1),int_mb(k_range+p11b-
238     &1),int_mb(k_range+p6b-1),8,6,5,3,2,1,4,7,1.0d0)
239      END IF
240      IF ((h10b .lt. h3b) .and. (p1b .le. p5b) .and. (p6b .le. p11b)) TH
241     &EN
242      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p11b_
243     &2 - noab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p5b_2 - noab - 1
244     & + nvab * (p1b_2 - noab - 1 + nvab * (h3b_2 - 1 + noab * (h10b_2 -
245     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
246      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
247     &,int_mb(k_range+h9b-1),int_mb(k_range+h10b-1),int_mb(k_range+h3b-1
248     &),int_mb(k_range+p1b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1
249     &),int_mb(k_range+p11b-1),7,6,5,3,2,1,4,8,-1.0d0)
250      END IF
251      IF ((h9b .lt. h3b) .and. (h3b .le. h10b) .and. (p11b .lt. p5b) .an
252     &d. (p6b .lt. p1b)) THEN
253      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p1b_2
254     & - noab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p5b_2 - noab - 1
255     &+ nvab * (p11b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h3b_2 -
256     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
257      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
258     &,int_mb(k_range+h9b-1),int_mb(k_range+h3b-1),int_mb(k_range+h10b-1
259     &),int_mb(k_range+p11b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-
260     &1),int_mb(k_range+p1b-1),7,6,8,4,2,1,3,5,-1.0d0)
261      END IF
262      IF ((h9b .lt. h3b) .and. (h3b .le. h10b) .and. (p5b .le. p11b) .an
263     &d. (p11b .lt. p6b) .and. (p6b .lt. p1b)) THEN
264      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p1b_2
265     & - noab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p11b_2 - noab - 1
266     & + nvab * (p5b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h3b_2 -
267     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
268      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
269     &,int_mb(k_range+h9b-1),int_mb(k_range+h3b-1),int_mb(k_range+h10b-1
270     &),int_mb(k_range+p5b-1),int_mb(k_range+p11b-1),int_mb(k_range+p6b-
271     &1),int_mb(k_range+p1b-1),7,5,8,4,2,1,3,6,1.0d0)
272      END IF
273      IF ((h9b .lt. h3b) .and. (h3b .le. h10b) .and. (p6b .le. p11b) .an
274     &d. (p11b .lt. p1b)) THEN
275      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p1b_2
276     & - noab - 1 + nvab * (p11b_2 - noab - 1 + nvab * (p6b_2 - noab - 1
277     & + nvab * (p5b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h3b_2 -
278     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
279      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
280     &,int_mb(k_range+h9b-1),int_mb(k_range+h3b-1),int_mb(k_range+h10b-1
281     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p11b-
282     &1),int_mb(k_range+p1b-1),6,5,8,4,2,1,3,7,-1.0d0)
283      END IF
284      IF ((h9b .lt. h3b) .and. (h3b .le. h10b) .and. (p6b .lt. p1b) .and
285     &. (p1b .le. p11b)) THEN
286      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p11b_
287     &2 - noab - 1 + nvab * (p1b_2 - noab - 1 + nvab * (p6b_2 - noab - 1
288     & + nvab * (p5b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h3b_2 -
289     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
290      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
291     &,int_mb(k_range+h9b-1),int_mb(k_range+h3b-1),int_mb(k_range+h10b-1
292     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p1b-1
293     &),int_mb(k_range+p11b-1),6,5,7,4,2,1,3,8,1.0d0)
294      END IF
295      IF ((h9b .lt. h3b) .and. (h3b .le. h10b) .and. (p11b .lt. p5b) .an
296     &d. (p5b .lt. p1b) .and. (p1b .le. p6b)) THEN
297      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
298     & - noab - 1 + nvab * (p1b_2 - noab - 1 + nvab * (p5b_2 - noab - 1
299     &+ nvab * (p11b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h3b_2 -
300     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
301      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
302     &,int_mb(k_range+h9b-1),int_mb(k_range+h3b-1),int_mb(k_range+h10b-1
303     &),int_mb(k_range+p11b-1),int_mb(k_range+p5b-1),int_mb(k_range+p1b-
304     &1),int_mb(k_range+p6b-1),8,6,7,4,2,1,3,5,1.0d0)
305      END IF
306      IF ((h9b .lt. h3b) .and. (h3b .le. h10b) .and. (p5b .le. p11b) .an
307     &d. (p11b .lt. p1b) .and. (p1b .le. p6b)) THEN
308      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
309     & - noab - 1 + nvab * (p1b_2 - noab - 1 + nvab * (p11b_2 - noab - 1
310     & + nvab * (p5b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h3b_2 -
311     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
312      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
313     &,int_mb(k_range+h9b-1),int_mb(k_range+h3b-1),int_mb(k_range+h10b-1
314     &),int_mb(k_range+p5b-1),int_mb(k_range+p11b-1),int_mb(k_range+p1b-
315     &1),int_mb(k_range+p6b-1),8,5,7,4,2,1,3,6,-1.0d0)
316      END IF
317      IF ((h9b .lt. h3b) .and. (h3b .le. h10b) .and. (p5b .lt. p1b) .and
318     &. (p1b .le. p11b) .and. (p11b .lt. p6b)) THEN
319      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
320     & - noab - 1 + nvab * (p11b_2 - noab - 1 + nvab * (p1b_2 - noab - 1
321     & + nvab * (p5b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h3b_2 -
322     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
323      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
324     &,int_mb(k_range+h9b-1),int_mb(k_range+h3b-1),int_mb(k_range+h10b-1
325     &),int_mb(k_range+p5b-1),int_mb(k_range+p1b-1),int_mb(k_range+p11b-
326     &1),int_mb(k_range+p6b-1),8,5,6,4,2,1,3,7,1.0d0)
327      END IF
328      IF ((h9b .lt. h3b) .and. (h3b .le. h10b) .and. (p5b .lt. p1b) .and
329     &. (p1b .le. p6b) .and. (p6b .le. p11b)) THEN
330      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p11b_
331     &2 - noab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p1b_2 - noab - 1
332     & + nvab * (p5b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h3b_2 -
333     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
334      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
335     &,int_mb(k_range+h9b-1),int_mb(k_range+h3b-1),int_mb(k_range+h10b-1
336     &),int_mb(k_range+p5b-1),int_mb(k_range+p1b-1),int_mb(k_range+p6b-1
337     &),int_mb(k_range+p11b-1),7,5,6,4,2,1,3,8,-1.0d0)
338      END IF
339      IF ((h9b .lt. h3b) .and. (h3b .le. h10b) .and. (p11b .lt. p1b) .an
340     &d. (p1b .le. p5b)) THEN
341      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
342     & - noab - 1 + nvab * (p5b_2 - noab - 1 + nvab * (p1b_2 - noab - 1
343     &+ nvab * (p11b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h3b_2 -
344     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
345      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
346     &,int_mb(k_range+h9b-1),int_mb(k_range+h3b-1),int_mb(k_range+h10b-1
347     &),int_mb(k_range+p11b-1),int_mb(k_range+p1b-1),int_mb(k_range+p5b-
348     &1),int_mb(k_range+p6b-1),8,7,6,4,2,1,3,5,-1.0d0)
349      END IF
350      IF ((h9b .lt. h3b) .and. (h3b .le. h10b) .and. (p1b .le. p11b) .an
351     &d. (p11b .lt. p5b)) THEN
352      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
353     & - noab - 1 + nvab * (p5b_2 - noab - 1 + nvab * (p11b_2 - noab - 1
354     & + nvab * (p1b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h3b_2 -
355     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
356      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
357     &,int_mb(k_range+h9b-1),int_mb(k_range+h3b-1),int_mb(k_range+h10b-1
358     &),int_mb(k_range+p1b-1),int_mb(k_range+p11b-1),int_mb(k_range+p5b-
359     &1),int_mb(k_range+p6b-1),8,7,5,4,2,1,3,6,1.0d0)
360      END IF
361      IF ((h9b .lt. h3b) .and. (h3b .le. h10b) .and. (p1b .le. p5b) .and
362     &. (p5b .le. p11b) .and. (p11b .lt. p6b)) THEN
363      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
364     & - noab - 1 + nvab * (p11b_2 - noab - 1 + nvab * (p5b_2 - noab - 1
365     & + nvab * (p1b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h3b_2 -
366     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
367      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
368     &,int_mb(k_range+h9b-1),int_mb(k_range+h3b-1),int_mb(k_range+h10b-1
369     &),int_mb(k_range+p1b-1),int_mb(k_range+p5b-1),int_mb(k_range+p11b-
370     &1),int_mb(k_range+p6b-1),8,6,5,4,2,1,3,7,-1.0d0)
371      END IF
372      IF ((h9b .lt. h3b) .and. (h3b .le. h10b) .and. (p1b .le. p5b) .and
373     &. (p6b .le. p11b)) THEN
374      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p11b_
375     &2 - noab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p5b_2 - noab - 1
376     & + nvab * (p1b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h3b_2 -
377     & 1 + noab * (h9b_2 - 1 + noab * (h8b_2 - 1)))))))))
378      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
379     &,int_mb(k_range+h9b-1),int_mb(k_range+h3b-1),int_mb(k_range+h10b-1
380     &),int_mb(k_range+p1b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1
381     &),int_mb(k_range+p11b-1),7,6,5,4,2,1,3,8,1.0d0)
382      END IF
383      IF ((h8b .lt. h3b) .and. (h3b .le. h9b) .and. (p11b .lt. p5b) .and
384     &. (p6b .lt. p1b)) THEN
385      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p1b_2
386     & - noab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p5b_2 - noab - 1
387     &+ nvab * (p11b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
388     & 1 + noab * (h3b_2 - 1 + noab * (h8b_2 - 1)))))))))
389      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
390     &,int_mb(k_range+h3b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
391     &),int_mb(k_range+p11b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-
392     &1),int_mb(k_range+p1b-1),7,6,8,4,3,1,2,5,1.0d0)
393      END IF
394      IF ((h8b .lt. h3b) .and. (h3b .le. h9b) .and. (p5b .le. p11b) .and
395     &. (p11b .lt. p6b) .and. (p6b .lt. p1b)) THEN
396      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p1b_2
397     & - noab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p11b_2 - noab - 1
398     & + nvab * (p5b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
399     & 1 + noab * (h3b_2 - 1 + noab * (h8b_2 - 1)))))))))
400      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
401     &,int_mb(k_range+h3b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
402     &),int_mb(k_range+p5b-1),int_mb(k_range+p11b-1),int_mb(k_range+p6b-
403     &1),int_mb(k_range+p1b-1),7,5,8,4,3,1,2,6,-1.0d0)
404      END IF
405      IF ((h8b .lt. h3b) .and. (h3b .le. h9b) .and. (p6b .le. p11b) .and
406     &. (p11b .lt. p1b)) THEN
407      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p1b_2
408     & - noab - 1 + nvab * (p11b_2 - noab - 1 + nvab * (p6b_2 - noab - 1
409     & + nvab * (p5b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
410     & 1 + noab * (h3b_2 - 1 + noab * (h8b_2 - 1)))))))))
411      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
412     &,int_mb(k_range+h3b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
413     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p11b-
414     &1),int_mb(k_range+p1b-1),6,5,8,4,3,1,2,7,1.0d0)
415      END IF
416      IF ((h8b .lt. h3b) .and. (h3b .le. h9b) .and. (p6b .lt. p1b) .and.
417     & (p1b .le. p11b)) THEN
418      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p11b_
419     &2 - noab - 1 + nvab * (p1b_2 - noab - 1 + nvab * (p6b_2 - noab - 1
420     & + nvab * (p5b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
421     & 1 + noab * (h3b_2 - 1 + noab * (h8b_2 - 1)))))))))
422      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
423     &,int_mb(k_range+h3b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
424     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p1b-1
425     &),int_mb(k_range+p11b-1),6,5,7,4,3,1,2,8,-1.0d0)
426      END IF
427      IF ((h8b .lt. h3b) .and. (h3b .le. h9b) .and. (p11b .lt. p5b) .and
428     &. (p5b .lt. p1b) .and. (p1b .le. p6b)) THEN
429      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
430     & - noab - 1 + nvab * (p1b_2 - noab - 1 + nvab * (p5b_2 - noab - 1
431     &+ nvab * (p11b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
432     & 1 + noab * (h3b_2 - 1 + noab * (h8b_2 - 1)))))))))
433      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
434     &,int_mb(k_range+h3b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
435     &),int_mb(k_range+p11b-1),int_mb(k_range+p5b-1),int_mb(k_range+p1b-
436     &1),int_mb(k_range+p6b-1),8,6,7,4,3,1,2,5,-1.0d0)
437      END IF
438      IF ((h8b .lt. h3b) .and. (h3b .le. h9b) .and. (p5b .le. p11b) .and
439     &. (p11b .lt. p1b) .and. (p1b .le. p6b)) THEN
440      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
441     & - noab - 1 + nvab * (p1b_2 - noab - 1 + nvab * (p11b_2 - noab - 1
442     & + nvab * (p5b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
443     & 1 + noab * (h3b_2 - 1 + noab * (h8b_2 - 1)))))))))
444      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
445     &,int_mb(k_range+h3b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
446     &),int_mb(k_range+p5b-1),int_mb(k_range+p11b-1),int_mb(k_range+p1b-
447     &1),int_mb(k_range+p6b-1),8,5,7,4,3,1,2,6,1.0d0)
448      END IF
449      IF ((h8b .lt. h3b) .and. (h3b .le. h9b) .and. (p5b .lt. p1b) .and.
450     & (p1b .le. p11b) .and. (p11b .lt. p6b)) THEN
451      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
452     & - noab - 1 + nvab * (p11b_2 - noab - 1 + nvab * (p1b_2 - noab - 1
453     & + nvab * (p5b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
454     & 1 + noab * (h3b_2 - 1 + noab * (h8b_2 - 1)))))))))
455      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
456     &,int_mb(k_range+h3b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
457     &),int_mb(k_range+p5b-1),int_mb(k_range+p1b-1),int_mb(k_range+p11b-
458     &1),int_mb(k_range+p6b-1),8,5,6,4,3,1,2,7,-1.0d0)
459      END IF
460      IF ((h8b .lt. h3b) .and. (h3b .le. h9b) .and. (p5b .lt. p1b) .and.
461     & (p1b .le. p6b) .and. (p6b .le. p11b)) THEN
462      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p11b_
463     &2 - noab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p1b_2 - noab - 1
464     & + nvab * (p5b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
465     & 1 + noab * (h3b_2 - 1 + noab * (h8b_2 - 1)))))))))
466      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
467     &,int_mb(k_range+h3b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
468     &),int_mb(k_range+p5b-1),int_mb(k_range+p1b-1),int_mb(k_range+p6b-1
469     &),int_mb(k_range+p11b-1),7,5,6,4,3,1,2,8,1.0d0)
470      END IF
471      IF ((h8b .lt. h3b) .and. (h3b .le. h9b) .and. (p11b .lt. p1b) .and
472     &. (p1b .le. p5b)) THEN
473      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
474     & - noab - 1 + nvab * (p5b_2 - noab - 1 + nvab * (p1b_2 - noab - 1
475     &+ nvab * (p11b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
476     & 1 + noab * (h3b_2 - 1 + noab * (h8b_2 - 1)))))))))
477      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
478     &,int_mb(k_range+h3b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
479     &),int_mb(k_range+p11b-1),int_mb(k_range+p1b-1),int_mb(k_range+p5b-
480     &1),int_mb(k_range+p6b-1),8,7,6,4,3,1,2,5,1.0d0)
481      END IF
482      IF ((h8b .lt. h3b) .and. (h3b .le. h9b) .and. (p1b .le. p11b) .and
483     &. (p11b .lt. p5b)) THEN
484      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
485     & - noab - 1 + nvab * (p5b_2 - noab - 1 + nvab * (p11b_2 - noab - 1
486     & + nvab * (p1b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
487     & 1 + noab * (h3b_2 - 1 + noab * (h8b_2 - 1)))))))))
488      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
489     &,int_mb(k_range+h3b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
490     &),int_mb(k_range+p1b-1),int_mb(k_range+p11b-1),int_mb(k_range+p5b-
491     &1),int_mb(k_range+p6b-1),8,7,5,4,3,1,2,6,-1.0d0)
492      END IF
493      IF ((h8b .lt. h3b) .and. (h3b .le. h9b) .and. (p1b .le. p5b) .and.
494     & (p5b .le. p11b) .and. (p11b .lt. p6b)) THEN
495      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
496     & - noab - 1 + nvab * (p11b_2 - noab - 1 + nvab * (p5b_2 - noab - 1
497     & + nvab * (p1b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
498     & 1 + noab * (h3b_2 - 1 + noab * (h8b_2 - 1)))))))))
499      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
500     &,int_mb(k_range+h3b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
501     &),int_mb(k_range+p1b-1),int_mb(k_range+p5b-1),int_mb(k_range+p11b-
502     &1),int_mb(k_range+p6b-1),8,6,5,4,3,1,2,7,1.0d0)
503      END IF
504      IF ((h8b .lt. h3b) .and. (h3b .le. h9b) .and. (p1b .le. p5b) .and.
505     & (p6b .le. p11b)) THEN
506      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p11b_
507     &2 - noab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p5b_2 - noab - 1
508     & + nvab * (p1b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
509     & 1 + noab * (h3b_2 - 1 + noab * (h8b_2 - 1)))))))))
510      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h8b-1)
511     &,int_mb(k_range+h3b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
512     &),int_mb(k_range+p1b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1
513     &),int_mb(k_range+p11b-1),7,6,5,4,3,1,2,8,-1.0d0)
514      END IF
515      IF ((h3b .le. h8b) .and. (p11b .lt. p5b) .and. (p6b .lt. p1b)) THE
516     &N
517      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p1b_2
518     & - noab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p5b_2 - noab - 1
519     &+ nvab * (p11b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
520     & 1 + noab * (h8b_2 - 1 + noab * (h3b_2 - 1)))))))))
521      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h3b-1)
522     &,int_mb(k_range+h8b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
523     &),int_mb(k_range+p11b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-
524     &1),int_mb(k_range+p1b-1),7,6,8,4,3,2,1,5,-1.0d0)
525      END IF
526      IF ((h3b .le. h8b) .and. (p5b .le. p11b) .and. (p11b .lt. p6b) .an
527     &d. (p6b .lt. p1b)) THEN
528      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p1b_2
529     & - noab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p11b_2 - noab - 1
530     & + nvab * (p5b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
531     & 1 + noab * (h8b_2 - 1 + noab * (h3b_2 - 1)))))))))
532      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h3b-1)
533     &,int_mb(k_range+h8b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
534     &),int_mb(k_range+p5b-1),int_mb(k_range+p11b-1),int_mb(k_range+p6b-
535     &1),int_mb(k_range+p1b-1),7,5,8,4,3,2,1,6,1.0d0)
536      END IF
537      IF ((h3b .le. h8b) .and. (p6b .le. p11b) .and. (p11b .lt. p1b)) TH
538     &EN
539      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p1b_2
540     & - noab - 1 + nvab * (p11b_2 - noab - 1 + nvab * (p6b_2 - noab - 1
541     & + nvab * (p5b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
542     & 1 + noab * (h8b_2 - 1 + noab * (h3b_2 - 1)))))))))
543      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h3b-1)
544     &,int_mb(k_range+h8b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
545     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p11b-
546     &1),int_mb(k_range+p1b-1),6,5,8,4,3,2,1,7,-1.0d0)
547      END IF
548      IF ((h3b .le. h8b) .and. (p6b .lt. p1b) .and. (p1b .le. p11b)) THE
549     &N
550      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p11b_
551     &2 - noab - 1 + nvab * (p1b_2 - noab - 1 + nvab * (p6b_2 - noab - 1
552     & + nvab * (p5b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
553     & 1 + noab * (h8b_2 - 1 + noab * (h3b_2 - 1)))))))))
554      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h3b-1)
555     &,int_mb(k_range+h8b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
556     &),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1),int_mb(k_range+p1b-1
557     &),int_mb(k_range+p11b-1),6,5,7,4,3,2,1,8,1.0d0)
558      END IF
559      IF ((h3b .le. h8b) .and. (p11b .lt. p5b) .and. (p5b .lt. p1b) .and
560     &. (p1b .le. p6b)) THEN
561      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
562     & - noab - 1 + nvab * (p1b_2 - noab - 1 + nvab * (p5b_2 - noab - 1
563     &+ nvab * (p11b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
564     & 1 + noab * (h8b_2 - 1 + noab * (h3b_2 - 1)))))))))
565      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h3b-1)
566     &,int_mb(k_range+h8b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
567     &),int_mb(k_range+p11b-1),int_mb(k_range+p5b-1),int_mb(k_range+p1b-
568     &1),int_mb(k_range+p6b-1),8,6,7,4,3,2,1,5,1.0d0)
569      END IF
570      IF ((h3b .le. h8b) .and. (p5b .le. p11b) .and. (p11b .lt. p1b) .an
571     &d. (p1b .le. p6b)) THEN
572      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
573     & - noab - 1 + nvab * (p1b_2 - noab - 1 + nvab * (p11b_2 - noab - 1
574     & + nvab * (p5b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
575     & 1 + noab * (h8b_2 - 1 + noab * (h3b_2 - 1)))))))))
576      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h3b-1)
577     &,int_mb(k_range+h8b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
578     &),int_mb(k_range+p5b-1),int_mb(k_range+p11b-1),int_mb(k_range+p1b-
579     &1),int_mb(k_range+p6b-1),8,5,7,4,3,2,1,6,-1.0d0)
580      END IF
581      IF ((h3b .le. h8b) .and. (p5b .lt. p1b) .and. (p1b .le. p11b) .and
582     &. (p11b .lt. p6b)) THEN
583      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
584     & - noab - 1 + nvab * (p11b_2 - noab - 1 + nvab * (p1b_2 - noab - 1
585     & + nvab * (p5b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
586     & 1 + noab * (h8b_2 - 1 + noab * (h3b_2 - 1)))))))))
587      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h3b-1)
588     &,int_mb(k_range+h8b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
589     &),int_mb(k_range+p5b-1),int_mb(k_range+p1b-1),int_mb(k_range+p11b-
590     &1),int_mb(k_range+p6b-1),8,5,6,4,3,2,1,7,1.0d0)
591      END IF
592      IF ((h3b .le. h8b) .and. (p5b .lt. p1b) .and. (p1b .le. p6b) .and.
593     & (p6b .le. p11b)) THEN
594      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p11b_
595     &2 - noab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p1b_2 - noab - 1
596     & + nvab * (p5b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
597     & 1 + noab * (h8b_2 - 1 + noab * (h3b_2 - 1)))))))))
598      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h3b-1)
599     &,int_mb(k_range+h8b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
600     &),int_mb(k_range+p5b-1),int_mb(k_range+p1b-1),int_mb(k_range+p6b-1
601     &),int_mb(k_range+p11b-1),7,5,6,4,3,2,1,8,-1.0d0)
602      END IF
603      IF ((h3b .le. h8b) .and. (p11b .lt. p1b) .and. (p1b .le. p5b)) THE
604     &N
605      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
606     & - noab - 1 + nvab * (p5b_2 - noab - 1 + nvab * (p1b_2 - noab - 1
607     &+ nvab * (p11b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
608     & 1 + noab * (h8b_2 - 1 + noab * (h3b_2 - 1)))))))))
609      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h3b-1)
610     &,int_mb(k_range+h8b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
611     &),int_mb(k_range+p11b-1),int_mb(k_range+p1b-1),int_mb(k_range+p5b-
612     &1),int_mb(k_range+p6b-1),8,7,6,4,3,2,1,5,-1.0d0)
613      END IF
614      IF ((h3b .le. h8b) .and. (p1b .le. p11b) .and. (p11b .lt. p5b)) TH
615     &EN
616      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
617     & - noab - 1 + nvab * (p5b_2 - noab - 1 + nvab * (p11b_2 - noab - 1
618     & + nvab * (p1b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
619     & 1 + noab * (h8b_2 - 1 + noab * (h3b_2 - 1)))))))))
620      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h3b-1)
621     &,int_mb(k_range+h8b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
622     &),int_mb(k_range+p1b-1),int_mb(k_range+p11b-1),int_mb(k_range+p5b-
623     &1),int_mb(k_range+p6b-1),8,7,5,4,3,2,1,6,1.0d0)
624      END IF
625      IF ((h3b .le. h8b) .and. (p1b .le. p5b) .and. (p5b .le. p11b) .and
626     &. (p11b .lt. p6b)) THEN
627      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p6b_2
628     & - noab - 1 + nvab * (p11b_2 - noab - 1 + nvab * (p5b_2 - noab - 1
629     & + nvab * (p1b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
630     & 1 + noab * (h8b_2 - 1 + noab * (h3b_2 - 1)))))))))
631      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h3b-1)
632     &,int_mb(k_range+h8b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
633     &),int_mb(k_range+p1b-1),int_mb(k_range+p5b-1),int_mb(k_range+p11b-
634     &1),int_mb(k_range+p6b-1),8,6,5,4,3,2,1,7,-1.0d0)
635      END IF
636      IF ((h3b .le. h8b) .and. (p1b .le. p5b) .and. (p6b .le. p11b)) THE
637     &N
638      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(p11b_
639     &2 - noab - 1 + nvab * (p6b_2 - noab - 1 + nvab * (p5b_2 - noab - 1
640     & + nvab * (p1b_2 - noab - 1 + nvab * (h10b_2 - 1 + noab * (h9b_2 -
641     & 1 + noab * (h8b_2 - 1 + noab * (h3b_2 - 1)))))))))
642      CALL TCE_SORT_8(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+h3b-1)
643     &,int_mb(k_range+h8b-1),int_mb(k_range+h9b-1),int_mb(k_range+h10b-1
644     &),int_mb(k_range+p1b-1),int_mb(k_range+p5b-1),int_mb(k_range+p6b-1
645     &),int_mb(k_range+p11b-1),7,6,5,4,3,2,1,8,1.0d0)
646      END IF
647      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('eomccsdtq_y2_25_5_1',6,M
648     &A_ERR)
649      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
650     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
651     &t),dima_sort)
652      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('eomccsdtq_y2_25_5_1
653     &',7,MA_ERR)
654      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('eomccsdtq_y2_25_5_1
655     &',8,MA_ERR)
656      END IF
657      END IF
658      END IF
659      END DO
660      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
661     &eomccsdtq_y2_25_5_1',9,MA_ERR)
662      CALL TCE_SORT_8(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+p6b-1)
663     &,int_mb(k_range+p5b-1),int_mb(k_range+p1b-1),int_mb(k_range+h10b-1
664     &),int_mb(k_range+h9b-1),int_mb(k_range+h8b-1),int_mb(k_range+h3b-1
665     &),int_mb(k_range+h14b-1),7,6,5,4,3,8,2,1,1.0d0)
666      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p6b -
667     & noab - 1 + nvab * (p5b - noab - 1 + nvab * (h14b - 1 + noab * (p1
668     &b - noab - 1 + nvab * (h10b - 1 + noab * (h9b - 1 + noab * (h8b -
669     &1 + noab * (h3b - 1)))))))))
670      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('eomccsdtq_y2_25_5_1',10,
671     &MA_ERR)
672      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('eomccsdtq_y2_25_5_1
673     &',11,MA_ERR)
674      END IF
675      END IF
676      END IF
677      next = NXTASK(nprocs,1)
678      END IF
679      count = count + 1
680      END DO
681      END DO
682      END DO
683      END DO
684      END DO
685      END DO
686      END DO
687      END DO
688      next = NXTASK(-nprocs,1)
689      call GA_SYNC()
690      RETURN
691      END
692