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