1 SUBROUTINE OFFSET_eomccsdt_x3_5_2_1(l_a_offset,k_a_offset,size) 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 i2 ( h11 h12 h1 p7 )_v 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 l_a_offset 13 INTEGER k_a_offset 14 INTEGER size 15 INTEGER length 16 INTEGER addr 17 INTEGER h11b 18 INTEGER h12b 19 INTEGER h1b 20 INTEGER p7b 21 length = 0 22 DO h11b = 1,noab 23 DO h12b = h11b,noab 24 DO h1b = 1,noab 25 DO p7b = noab+1,noab+nvab 26 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 27 &+h1b-1)+int_mb(k_spin+p7b-1)) THEN 28 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 29 &b(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 30 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 31 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 32 length = length + 1 33 END IF 34 END IF 35 END IF 36 END DO 37 END DO 38 END DO 39 END DO 40 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 41 &set)) CALL ERRQUIT('eomccsdt_x3_5_2_1',0,MA_ERR) 42 int_mb(k_a_offset) = length 43 addr = 0 44 size = 0 45 DO h11b = 1,noab 46 DO h12b = h11b,noab 47 DO h1b = 1,noab 48 DO p7b = noab+1,noab+nvab 49 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 50 &+h1b-1)+int_mb(k_spin+p7b-1)) THEN 51 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 52 &b(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 53 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 54 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 55 addr = addr + 1 56 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 57 &* (h12b - 1 + noab * (h11b - 1))) 58 int_mb(k_a_offset+length+addr) = size 59 size = size + int_mb(k_range+h11b-1) * int_mb(k_range+h12b-1) * in 60 &t_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 61 END IF 62 END IF 63 END IF 64 END DO 65 END DO 66 END DO 67 END DO 68 RETURN 69 END 70 SUBROUTINE OFFSET_eomccsdt_x3_6_1(l_a_offset,k_a_offset,size) 71C $Id$ 72C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 73C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 74C i1 ( h9 p4 h1 p10 )_v 75 IMPLICIT NONE 76#include "global.fh" 77#include "mafdecls.fh" 78#include "sym.fh" 79#include "errquit.fh" 80#include "tce.fh" 81 INTEGER l_a_offset 82 INTEGER k_a_offset 83 INTEGER size 84 INTEGER length 85 INTEGER addr 86 INTEGER p4b 87 INTEGER h9b 88 INTEGER h1b 89 INTEGER p10b 90 length = 0 91 DO p4b = noab+1,noab+nvab 92 DO h9b = 1,noab 93 DO h1b = 1,noab 94 DO p10b = noab+1,noab+nvab 95 IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h 96 &1b-1)+int_mb(k_spin+p10b-1)) THEN 97 IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb( 98 &k_sym+h1b-1),int_mb(k_sym+p10b-1)))) .eq. irrep_v) THEN 99 IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+p4b-1 100 &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p10b-1).ne.8)) THEN 101 length = length + 1 102 END IF 103 END IF 104 END IF 105 END DO 106 END DO 107 END DO 108 END DO 109 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 110 &set)) CALL ERRQUIT('eomccsdt_x3_6_1',0,MA_ERR) 111 int_mb(k_a_offset) = length 112 addr = 0 113 size = 0 114 DO p4b = noab+1,noab+nvab 115 DO h9b = 1,noab 116 DO h1b = 1,noab 117 DO p10b = noab+1,noab+nvab 118 IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h 119 &1b-1)+int_mb(k_spin+p10b-1)) THEN 120 IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb( 121 &k_sym+h1b-1),int_mb(k_sym+p10b-1)))) .eq. irrep_v) THEN 122 IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+p4b-1 123 &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p10b-1).ne.8)) THEN 124 addr = addr + 1 125 int_mb(k_a_offset+addr) = p10b - noab - 1 + nvab * (h1b - 1 + noab 126 & * (h9b - 1 + noab * (p4b - noab - 1))) 127 int_mb(k_a_offset+length+addr) = size 128 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h9b-1) * int_ 129 &mb(k_range+h1b-1) * int_mb(k_range+p10b-1) 130 END IF 131 END IF 132 END IF 133 END DO 134 END DO 135 END DO 136 END DO 137 RETURN 138 END 139 SUBROUTINE OFFSET_eomccsdt_x3_8_1_1(l_a_offset,k_a_offset,size) 140C $Id$ 141C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 142C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 143C i2 ( h11 p4 h1 p10 )_v 144 IMPLICIT NONE 145#include "global.fh" 146#include "mafdecls.fh" 147#include "sym.fh" 148#include "errquit.fh" 149#include "tce.fh" 150 INTEGER l_a_offset 151 INTEGER k_a_offset 152 INTEGER size 153 INTEGER length 154 INTEGER addr 155 INTEGER p4b 156 INTEGER h11b 157 INTEGER h1b 158 INTEGER p10b 159 length = 0 160 DO p4b = noab+1,noab+nvab 161 DO h11b = 1,noab 162 DO h1b = 1,noab 163 DO p10b = noab+1,noab+nvab 164 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 165 &h1b-1)+int_mb(k_spin+p10b-1)) THEN 166 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 167 &(k_sym+h1b-1),int_mb(k_sym+p10b-1)))) .eq. irrep_v) THEN 168 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 169 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p10b-1).ne.8)) THEN 170 length = length + 1 171 END IF 172 END IF 173 END IF 174 END DO 175 END DO 176 END DO 177 END DO 178 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 179 &set)) CALL ERRQUIT('eomccsdt_x3_8_1_1',0,MA_ERR) 180 int_mb(k_a_offset) = length 181 addr = 0 182 size = 0 183 DO p4b = noab+1,noab+nvab 184 DO h11b = 1,noab 185 DO h1b = 1,noab 186 DO p10b = noab+1,noab+nvab 187 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 188 &h1b-1)+int_mb(k_spin+p10b-1)) THEN 189 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 190 &(k_sym+h1b-1),int_mb(k_sym+p10b-1)))) .eq. irrep_v) THEN 191 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 192 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p10b-1).ne.8)) THEN 193 addr = addr + 1 194 int_mb(k_a_offset+addr) = p10b - noab - 1 + nvab * (h1b - 1 + noab 195 & * (h11b - 1 + noab * (p4b - noab - 1))) 196 int_mb(k_a_offset+length+addr) = size 197 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h11b-1) * int 198 &_mb(k_range+h1b-1) * int_mb(k_range+p10b-1) 199 END IF 200 END IF 201 END IF 202 END DO 203 END DO 204 END DO 205 END DO 206 RETURN 207 END 208 SUBROUTINE OFFSET_eomccsdt_x3_8_1_2_1(l_a_offset,k_a_offset,size) 209C $Id$ 210C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 211C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 212C i3 ( h8 h11 h1 p10 )_v 213 IMPLICIT NONE 214#include "global.fh" 215#include "mafdecls.fh" 216#include "sym.fh" 217#include "errquit.fh" 218#include "tce.fh" 219 INTEGER l_a_offset 220 INTEGER k_a_offset 221 INTEGER size 222 INTEGER length 223 INTEGER addr 224 INTEGER h8b 225 INTEGER h11b 226 INTEGER h1b 227 INTEGER p10b 228 length = 0 229 DO h8b = 1,noab 230 DO h11b = h8b,noab 231 DO h1b = 1,noab 232 DO p10b = noab+1,noab+nvab 233 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+ 234 &h1b-1)+int_mb(k_spin+p10b-1)) THEN 235 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 236 &(k_sym+h1b-1),int_mb(k_sym+p10b-1)))) .eq. irrep_v) THEN 237 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 238 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p10b-1).ne.8)) THEN 239 length = length + 1 240 END IF 241 END IF 242 END IF 243 END DO 244 END DO 245 END DO 246 END DO 247 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 248 &set)) CALL ERRQUIT('eomccsdt_x3_8_1_2_1',0,MA_ERR) 249 int_mb(k_a_offset) = length 250 addr = 0 251 size = 0 252 DO h8b = 1,noab 253 DO h11b = h8b,noab 254 DO h1b = 1,noab 255 DO p10b = noab+1,noab+nvab 256 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+ 257 &h1b-1)+int_mb(k_spin+p10b-1)) THEN 258 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 259 &(k_sym+h1b-1),int_mb(k_sym+p10b-1)))) .eq. irrep_v) THEN 260 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 261 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p10b-1).ne.8)) THEN 262 addr = addr + 1 263 int_mb(k_a_offset+addr) = p10b - noab - 1 + nvab * (h1b - 1 + noab 264 & * (h11b - 1 + noab * (h8b - 1))) 265 int_mb(k_a_offset+length+addr) = size 266 size = size + int_mb(k_range+h8b-1) * int_mb(k_range+h11b-1) * int 267 &_mb(k_range+h1b-1) * int_mb(k_range+p10b-1) 268 END IF 269 END IF 270 END IF 271 END DO 272 END DO 273 END DO 274 END DO 275 RETURN 276 END 277 SUBROUTINE OFFSET_eomccsdt_x3_8_1(l_a_offset,k_a_offset,size) 278C $Id$ 279C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 280C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 281C i1 ( h11 p4 p5 h1 h2 h3 )_vx 282 IMPLICIT NONE 283#include "global.fh" 284#include "mafdecls.fh" 285#include "sym.fh" 286#include "errquit.fh" 287#include "tce.fh" 288 INTEGER l_a_offset 289 INTEGER k_a_offset 290 INTEGER size 291 INTEGER length 292 INTEGER addr 293 INTEGER p4b 294 INTEGER p5b 295 INTEGER h11b 296 INTEGER h1b 297 INTEGER h2b 298 INTEGER h3b 299 length = 0 300 DO p4b = noab+1,noab+nvab 301 DO p5b = p4b,noab+nvab 302 DO h11b = 1,noab 303 DO h1b = 1,noab 304 DO h2b = h1b,noab 305 DO h3b = h2b,noab 306 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+p5b-1 307 &) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3b 308 &-1)) THEN 309 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 310 &(k_sym+p5b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),in 311 &t_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_v,irrep_x)) THEN 312 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 313 &1)+int_mb(k_spin+p5b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+ 314 &int_mb(k_spin+h3b-1).ne.12)) THEN 315 length = length + 1 316 END IF 317 END IF 318 END IF 319 END DO 320 END DO 321 END DO 322 END DO 323 END DO 324 END DO 325 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 326 &set)) CALL ERRQUIT('eomccsdt_x3_8_1',0,MA_ERR) 327 int_mb(k_a_offset) = length 328 addr = 0 329 size = 0 330 DO p4b = noab+1,noab+nvab 331 DO p5b = p4b,noab+nvab 332 DO h11b = 1,noab 333 DO h1b = 1,noab 334 DO h2b = h1b,noab 335 DO h3b = h2b,noab 336 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+p5b-1 337 &) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3b 338 &-1)) THEN 339 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 340 &(k_sym+p5b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),in 341 &t_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_v,irrep_x)) THEN 342 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 343 &1)+int_mb(k_spin+p5b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+ 344 &int_mb(k_spin+h3b-1).ne.12)) THEN 345 addr = addr + 1 346 int_mb(k_a_offset+addr) = h3b - 1 + noab * (h2b - 1 + noab * (h1b 347 &- 1 + noab * (h11b - 1 + noab * (p5b - noab - 1 + nvab * (p4b - no 348 &ab - 1))))) 349 int_mb(k_a_offset+length+addr) = size 350 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+p5b-1) * int_ 351 &mb(k_range+h11b-1) * int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) 352 & * int_mb(k_range+h3b-1) 353 END IF 354 END IF 355 END IF 356 END DO 357 END DO 358 END DO 359 END DO 360 END DO 361 END DO 362 RETURN 363 END 364 SUBROUTINE OFFSET_eomccsdt_x3_8_2_1(l_a_offset,k_a_offset,size) 365C $Id$ 366C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 367C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 368C i2 ( h11 p7 )_f 369 IMPLICIT NONE 370#include "global.fh" 371#include "mafdecls.fh" 372#include "sym.fh" 373#include "errquit.fh" 374#include "tce.fh" 375 INTEGER l_a_offset 376 INTEGER k_a_offset 377 INTEGER size 378 INTEGER length 379 INTEGER addr 380 INTEGER h11b 381 INTEGER p7b 382 length = 0 383 DO h11b = 1,noab 384 DO p7b = noab+1,noab+nvab 385 IF (int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+p7b-1)) THEN 386 IF (ieor(int_mb(k_sym+h11b-1),int_mb(k_sym+p7b-1)) .eq. irrep_f) T 387 &HEN 388 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p7b- 389 &1).ne.4)) THEN 390 length = length + 1 391 END IF 392 END IF 393 END IF 394 END DO 395 END DO 396 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 397 &set)) CALL ERRQUIT('eomccsdt_x3_8_2_1',0,MA_ERR) 398 int_mb(k_a_offset) = length 399 addr = 0 400 size = 0 401 DO h11b = 1,noab 402 DO p7b = noab+1,noab+nvab 403 IF (int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+p7b-1)) THEN 404 IF (ieor(int_mb(k_sym+h11b-1),int_mb(k_sym+p7b-1)) .eq. irrep_f) T 405 &HEN 406 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p7b- 407 &1).ne.4)) THEN 408 addr = addr + 1 409 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h11b - 1) 410 int_mb(k_a_offset+length+addr) = size 411 size = size + int_mb(k_range+h11b-1) * int_mb(k_range+p7b-1) 412 END IF 413 END IF 414 END IF 415 END DO 416 END DO 417 RETURN 418 END 419 SUBROUTINE OFFSET_eomccsdt_x3_8_3_1(l_a_offset,k_a_offset,size) 420C $Id$ 421C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 422C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 423C i2 ( h10 h11 h1 p7 )_v 424 IMPLICIT NONE 425#include "global.fh" 426#include "mafdecls.fh" 427#include "sym.fh" 428#include "errquit.fh" 429#include "tce.fh" 430 INTEGER l_a_offset 431 INTEGER k_a_offset 432 INTEGER size 433 INTEGER length 434 INTEGER addr 435 INTEGER h10b 436 INTEGER h11b 437 INTEGER h1b 438 INTEGER p7b 439 length = 0 440 DO h10b = 1,noab 441 DO h11b = h10b,noab 442 DO h1b = 1,noab 443 DO p7b = noab+1,noab+nvab 444 IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin 445 &+h1b-1)+int_mb(k_spin+p7b-1)) THEN 446 IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m 447 &b(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 448 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b 449 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 450 length = length + 1 451 END IF 452 END IF 453 END IF 454 END DO 455 END DO 456 END DO 457 END DO 458 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 459 &set)) CALL ERRQUIT('eomccsdt_x3_8_3_1',0,MA_ERR) 460 int_mb(k_a_offset) = length 461 addr = 0 462 size = 0 463 DO h10b = 1,noab 464 DO h11b = h10b,noab 465 DO h1b = 1,noab 466 DO p7b = noab+1,noab+nvab 467 IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin 468 &+h1b-1)+int_mb(k_spin+p7b-1)) THEN 469 IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m 470 &b(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 471 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b 472 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 473 addr = addr + 1 474 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 475 &* (h11b - 1 + noab * (h10b - 1))) 476 int_mb(k_a_offset+length+addr) = size 477 size = size + int_mb(k_range+h10b-1) * int_mb(k_range+h11b-1) * in 478 &t_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 479 END IF 480 END IF 481 END IF 482 END DO 483 END DO 484 END DO 485 END DO 486 RETURN 487 END 488 SUBROUTINE OFFSET_eomccsdt_x3_8_5_1(l_a_offset,k_a_offset,size) 489C $Id$ 490C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 491C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 492C i2 ( h8 h11 p4 h1 h2 h3 )_vx 493 IMPLICIT NONE 494#include "global.fh" 495#include "mafdecls.fh" 496#include "sym.fh" 497#include "errquit.fh" 498#include "tce.fh" 499 INTEGER l_a_offset 500 INTEGER k_a_offset 501 INTEGER size 502 INTEGER length 503 INTEGER addr 504 INTEGER p4b 505 INTEGER h8b 506 INTEGER h11b 507 INTEGER h1b 508 INTEGER h2b 509 INTEGER h3b 510 length = 0 511 DO p4b = noab+1,noab+nvab 512 DO h8b = 1,noab 513 DO h11b = h8b,noab 514 DO h1b = 1,noab 515 DO h2b = h1b,noab 516 DO h3b = h2b,noab 517 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1 518 &) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3b 519 &-1)) THEN 520 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 521 &(k_sym+p4b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),in 522 &t_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_v,irrep_x)) THEN 523 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 524 &1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+ 525 &int_mb(k_spin+h3b-1).ne.12)) THEN 526 length = length + 1 527 END IF 528 END IF 529 END IF 530 END DO 531 END DO 532 END DO 533 END DO 534 END DO 535 END DO 536 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 537 &set)) CALL ERRQUIT('eomccsdt_x3_8_5_1',0,MA_ERR) 538 int_mb(k_a_offset) = length 539 addr = 0 540 size = 0 541 DO p4b = noab+1,noab+nvab 542 DO h8b = 1,noab 543 DO h11b = h8b,noab 544 DO h1b = 1,noab 545 DO h2b = h1b,noab 546 DO h3b = h2b,noab 547 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1 548 &) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3b 549 &-1)) THEN 550 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 551 &(k_sym+p4b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),in 552 &t_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_v,irrep_x)) THEN 553 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 554 &1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+ 555 &int_mb(k_spin+h3b-1).ne.12)) THEN 556 addr = addr + 1 557 int_mb(k_a_offset+addr) = h3b - 1 + noab * (h2b - 1 + noab * (h1b 558 &- 1 + noab * (h11b - 1 + noab * (h8b - 1 + noab * (p4b - noab - 1) 559 &)))) 560 int_mb(k_a_offset+length+addr) = size 561 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h8b-1) * int_ 562 &mb(k_range+h11b-1) * int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) 563 & * int_mb(k_range+h3b-1) 564 END IF 565 END IF 566 END IF 567 END DO 568 END DO 569 END DO 570 END DO 571 END DO 572 END DO 573 RETURN 574 END 575 SUBROUTINE OFFSET_eomccsdt_x3_8_6_1(l_a_offset,k_a_offset,size) 576C $Id$ 577C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 578C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 579C i2 ( h11 p4 h1 p7 )_vx 580 IMPLICIT NONE 581#include "global.fh" 582#include "mafdecls.fh" 583#include "sym.fh" 584#include "errquit.fh" 585#include "tce.fh" 586 INTEGER l_a_offset 587 INTEGER k_a_offset 588 INTEGER size 589 INTEGER length 590 INTEGER addr 591 INTEGER p4b 592 INTEGER h11b 593 INTEGER h1b 594 INTEGER p7b 595 length = 0 596 DO p4b = noab+1,noab+nvab 597 DO h11b = 1,noab 598 DO h1b = 1,noab 599 DO p7b = noab+1,noab+nvab 600 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 601 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 602 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 603 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_x)) T 604 &HEN 605 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 606 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 607 length = length + 1 608 END IF 609 END IF 610 END IF 611 END DO 612 END DO 613 END DO 614 END DO 615 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 616 &set)) CALL ERRQUIT('eomccsdt_x3_8_6_1',0,MA_ERR) 617 int_mb(k_a_offset) = length 618 addr = 0 619 size = 0 620 DO p4b = noab+1,noab+nvab 621 DO h11b = 1,noab 622 DO h1b = 1,noab 623 DO p7b = noab+1,noab+nvab 624 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 625 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 626 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 627 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_x)) T 628 &HEN 629 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 630 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 631 addr = addr + 1 632 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 633 &* (h11b - 1 + noab * (p4b - noab - 1))) 634 int_mb(k_a_offset+length+addr) = size 635 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h11b-1) * int 636 &_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 637 END IF 638 END IF 639 END IF 640 END DO 641 END DO 642 END DO 643 END DO 644 RETURN 645 END 646 SUBROUTINE OFFSET_eomccsdt_x3_8_6_3_1(l_a_offset,k_a_offset,size) 647C $Id$ 648C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 649C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 650C i3 ( h10 h11 h1 p7 )_vt 651 IMPLICIT NONE 652#include "global.fh" 653#include "mafdecls.fh" 654#include "sym.fh" 655#include "errquit.fh" 656#include "tce.fh" 657 INTEGER l_a_offset 658 INTEGER k_a_offset 659 INTEGER size 660 INTEGER length 661 INTEGER addr 662 INTEGER h10b 663 INTEGER h11b 664 INTEGER h1b 665 INTEGER p7b 666 length = 0 667 DO h10b = 1,noab 668 DO h11b = h10b,noab 669 DO h1b = 1,noab 670 DO p7b = noab+1,noab+nvab 671 IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin 672 &+h1b-1)+int_mb(k_spin+p7b-1)) THEN 673 IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m 674 &b(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_t)) 675 &THEN 676 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b 677 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 678 length = length + 1 679 END IF 680 END IF 681 END IF 682 END DO 683 END DO 684 END DO 685 END DO 686 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 687 &set)) CALL ERRQUIT('eomccsdt_x3_8_6_3_1',0,MA_ERR) 688 int_mb(k_a_offset) = length 689 addr = 0 690 size = 0 691 DO h10b = 1,noab 692 DO h11b = h10b,noab 693 DO h1b = 1,noab 694 DO p7b = noab+1,noab+nvab 695 IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin 696 &+h1b-1)+int_mb(k_spin+p7b-1)) THEN 697 IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m 698 &b(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_t)) 699 &THEN 700 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b 701 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 702 addr = addr + 1 703 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 704 &* (h11b - 1 + noab * (h10b - 1))) 705 int_mb(k_a_offset+length+addr) = size 706 size = size + int_mb(k_range+h10b-1) * int_mb(k_range+h11b-1) * in 707 &t_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 708 END IF 709 END IF 710 END IF 711 END DO 712 END DO 713 END DO 714 END DO 715 RETURN 716 END 717 SUBROUTINE OFFSET_eomccsdt_x3_8_6_4_1(l_a_offset,k_a_offset,size) 718C $Id$ 719C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 720C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 721C i3 ( h8 h11 h1 p7 )_vx 722 IMPLICIT NONE 723#include "global.fh" 724#include "mafdecls.fh" 725#include "sym.fh" 726#include "errquit.fh" 727#include "tce.fh" 728 INTEGER l_a_offset 729 INTEGER k_a_offset 730 INTEGER size 731 INTEGER length 732 INTEGER addr 733 INTEGER h8b 734 INTEGER h11b 735 INTEGER h1b 736 INTEGER p7b 737 length = 0 738 DO h8b = 1,noab 739 DO h11b = h8b,noab 740 DO h1b = 1,noab 741 DO p7b = noab+1,noab+nvab 742 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+ 743 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 744 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 745 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_x)) T 746 &HEN 747 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 748 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 749 length = length + 1 750 END IF 751 END IF 752 END IF 753 END DO 754 END DO 755 END DO 756 END DO 757 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 758 &set)) CALL ERRQUIT('eomccsdt_x3_8_6_4_1',0,MA_ERR) 759 int_mb(k_a_offset) = length 760 addr = 0 761 size = 0 762 DO h8b = 1,noab 763 DO h11b = h8b,noab 764 DO h1b = 1,noab 765 DO p7b = noab+1,noab+nvab 766 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+ 767 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 768 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 769 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_x)) T 770 &HEN 771 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 772 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 773 addr = addr + 1 774 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 775 &* (h11b - 1 + noab * (h8b - 1))) 776 int_mb(k_a_offset+length+addr) = size 777 size = size + int_mb(k_range+h8b-1) * int_mb(k_range+h11b-1) * int 778 &_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 779 END IF 780 END IF 781 END IF 782 END DO 783 END DO 784 END DO 785 END DO 786 RETURN 787 END 788 SUBROUTINE OFFSET_eomccsdt_x3_8_7_1(l_a_offset,k_a_offset,size) 789C $Id$ 790C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 791C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 792C i2 ( h11 p7 )_vx 793 IMPLICIT NONE 794#include "global.fh" 795#include "mafdecls.fh" 796#include "sym.fh" 797#include "errquit.fh" 798#include "tce.fh" 799 INTEGER l_a_offset 800 INTEGER k_a_offset 801 INTEGER size 802 INTEGER length 803 INTEGER addr 804 INTEGER h11b 805 INTEGER p7b 806 length = 0 807 DO h11b = 1,noab 808 DO p7b = noab+1,noab+nvab 809 IF (int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+p7b-1)) THEN 810 IF (ieor(int_mb(k_sym+h11b-1),int_mb(k_sym+p7b-1)) .eq. ieor(irrep 811 &_v,irrep_x)) THEN 812 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p7b- 813 &1).ne.4)) THEN 814 length = length + 1 815 END IF 816 END IF 817 END IF 818 END DO 819 END DO 820 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 821 &set)) CALL ERRQUIT('eomccsdt_x3_8_7_1',0,MA_ERR) 822 int_mb(k_a_offset) = length 823 addr = 0 824 size = 0 825 DO h11b = 1,noab 826 DO p7b = noab+1,noab+nvab 827 IF (int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+p7b-1)) THEN 828 IF (ieor(int_mb(k_sym+h11b-1),int_mb(k_sym+p7b-1)) .eq. ieor(irrep 829 &_v,irrep_x)) THEN 830 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p7b- 831 &1).ne.4)) THEN 832 addr = addr + 1 833 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h11b - 1) 834 int_mb(k_a_offset+length+addr) = size 835 size = size + int_mb(k_range+h11b-1) * int_mb(k_range+p7b-1) 836 END IF 837 END IF 838 END IF 839 END DO 840 END DO 841 RETURN 842 END 843 SUBROUTINE OFFSET_eomccsdt_x3_8_8_1(l_a_offset,k_a_offset,size) 844C $Id$ 845C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 846C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 847C i2 ( h10 h11 p4 h1 h2 h3 )_vt 848 IMPLICIT NONE 849#include "global.fh" 850#include "mafdecls.fh" 851#include "sym.fh" 852#include "errquit.fh" 853#include "tce.fh" 854 INTEGER l_a_offset 855 INTEGER k_a_offset 856 INTEGER size 857 INTEGER length 858 INTEGER addr 859 INTEGER p4b 860 INTEGER h10b 861 INTEGER h11b 862 INTEGER h1b 863 INTEGER h2b 864 INTEGER h3b 865 length = 0 866 DO p4b = noab+1,noab+nvab 867 DO h10b = 1,noab 868 DO h11b = h10b,noab 869 DO h1b = 1,noab 870 DO h2b = h1b,noab 871 DO h3b = h2b,noab 872 IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 873 &1) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3 874 &b-1)) THEN 875 IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m 876 &b(k_sym+p4b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),i 877 &nt_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_v,irrep_t)) THEN 878 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b 879 &-1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1) 880 &+int_mb(k_spin+h3b-1).ne.12)) THEN 881 length = length + 1 882 END IF 883 END IF 884 END IF 885 END DO 886 END DO 887 END DO 888 END DO 889 END DO 890 END DO 891 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 892 &set)) CALL ERRQUIT('eomccsdt_x3_8_8_1',0,MA_ERR) 893 int_mb(k_a_offset) = length 894 addr = 0 895 size = 0 896 DO p4b = noab+1,noab+nvab 897 DO h10b = 1,noab 898 DO h11b = h10b,noab 899 DO h1b = 1,noab 900 DO h2b = h1b,noab 901 DO h3b = h2b,noab 902 IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 903 &1) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3 904 &b-1)) THEN 905 IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m 906 &b(k_sym+p4b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),i 907 &nt_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_v,irrep_t)) THEN 908 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b 909 &-1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1) 910 &+int_mb(k_spin+h3b-1).ne.12)) THEN 911 addr = addr + 1 912 int_mb(k_a_offset+addr) = h3b - 1 + noab * (h2b - 1 + noab * (h1b 913 &- 1 + noab * (h11b - 1 + noab * (h10b - 1 + noab * (p4b - noab - 1 914 &))))) 915 int_mb(k_a_offset+length+addr) = size 916 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h10b-1) * int 917 &_mb(k_range+h11b-1) * int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1 918 &) * int_mb(k_range+h3b-1) 919 END IF 920 END IF 921 END IF 922 END DO 923 END DO 924 END DO 925 END DO 926 END DO 927 END DO 928 RETURN 929 END 930 SUBROUTINE OFFSET_eomccsdt_x3_8_9_1(l_a_offset,k_a_offset,size) 931C $Id$ 932C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 933C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 934C i2 ( h8 h11 h1 p7 )_vx 935 IMPLICIT NONE 936#include "global.fh" 937#include "mafdecls.fh" 938#include "sym.fh" 939#include "errquit.fh" 940#include "tce.fh" 941 INTEGER l_a_offset 942 INTEGER k_a_offset 943 INTEGER size 944 INTEGER length 945 INTEGER addr 946 INTEGER h8b 947 INTEGER h11b 948 INTEGER h1b 949 INTEGER p7b 950 length = 0 951 DO h8b = 1,noab 952 DO h11b = h8b,noab 953 DO h1b = 1,noab 954 DO p7b = noab+1,noab+nvab 955 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+ 956 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 957 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 958 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_x)) T 959 &HEN 960 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 961 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 962 length = length + 1 963 END IF 964 END IF 965 END IF 966 END DO 967 END DO 968 END DO 969 END DO 970 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 971 &set)) CALL ERRQUIT('eomccsdt_x3_8_9_1',0,MA_ERR) 972 int_mb(k_a_offset) = length 973 addr = 0 974 size = 0 975 DO h8b = 1,noab 976 DO h11b = h8b,noab 977 DO h1b = 1,noab 978 DO p7b = noab+1,noab+nvab 979 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+ 980 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 981 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 982 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_x)) T 983 &HEN 984 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 985 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 986 addr = addr + 1 987 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 988 &* (h11b - 1 + noab * (h8b - 1))) 989 int_mb(k_a_offset+length+addr) = size 990 size = size + int_mb(k_range+h8b-1) * int_mb(k_range+h11b-1) * int 991 &_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 992 END IF 993 END IF 994 END IF 995 END DO 996 END DO 997 END DO 998 END DO 999 RETURN 1000 END 1001 SUBROUTINE OFFSET_eomccsdt_x3_9_10_1(l_a_offset,k_a_offset,size) 1002C $Id$ 1003C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 1004C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 1005C i2 ( h9 h12 h1 p8 )_vx 1006 IMPLICIT NONE 1007#include "global.fh" 1008#include "mafdecls.fh" 1009#include "sym.fh" 1010#include "errquit.fh" 1011#include "tce.fh" 1012 INTEGER l_a_offset 1013 INTEGER k_a_offset 1014 INTEGER size 1015 INTEGER length 1016 INTEGER addr 1017 INTEGER h9b 1018 INTEGER h12b 1019 INTEGER h1b 1020 INTEGER p8b 1021 length = 0 1022 DO h9b = 1,noab 1023 DO h12b = h9b,noab 1024 DO h1b = 1,noab 1025 DO p8b = noab+1,noab+nvab 1026 IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin+ 1027 &h1b-1)+int_mb(k_spin+p8b-1)) THEN 1028 IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_mb 1029 &(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_v,irrep_x)) T 1030 &HEN 1031 IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h12b- 1032 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 1033 length = length + 1 1034 END IF 1035 END IF 1036 END IF 1037 END DO 1038 END DO 1039 END DO 1040 END DO 1041 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 1042 &set)) CALL ERRQUIT('eomccsdt_x3_9_10_1',0,MA_ERR) 1043 int_mb(k_a_offset) = length 1044 addr = 0 1045 size = 0 1046 DO h9b = 1,noab 1047 DO h12b = h9b,noab 1048 DO h1b = 1,noab 1049 DO p8b = noab+1,noab+nvab 1050 IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin+ 1051 &h1b-1)+int_mb(k_spin+p8b-1)) THEN 1052 IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_mb 1053 &(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_v,irrep_x)) T 1054 &HEN 1055 IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h12b- 1056 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 1057 addr = addr + 1 1058 int_mb(k_a_offset+addr) = p8b - noab - 1 + nvab * (h1b - 1 + noab 1059 &* (h12b - 1 + noab * (h9b - 1))) 1060 int_mb(k_a_offset+length+addr) = size 1061 size = size + int_mb(k_range+h9b-1) * int_mb(k_range+h12b-1) * int 1062 &_mb(k_range+h1b-1) * int_mb(k_range+p8b-1) 1063 END IF 1064 END IF 1065 END IF 1066 END DO 1067 END DO 1068 END DO 1069 END DO 1070 RETURN 1071 END 1072 SUBROUTINE OFFSET_eomccsdt_x3_9_1_1(l_a_offset,k_a_offset,size) 1073C $Id$ 1074C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 1075C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 1076C i2 ( h12 h13 h1 h2 )_v 1077 IMPLICIT NONE 1078#include "global.fh" 1079#include "mafdecls.fh" 1080#include "sym.fh" 1081#include "errquit.fh" 1082#include "tce.fh" 1083 INTEGER l_a_offset 1084 INTEGER k_a_offset 1085 INTEGER size 1086 INTEGER length 1087 INTEGER addr 1088 INTEGER h12b 1089 INTEGER h13b 1090 INTEGER h1b 1091 INTEGER h2b 1092 length = 0 1093 DO h12b = 1,noab 1094 DO h13b = h12b,noab 1095 DO h1b = 1,noab 1096 DO h2b = h1b,noab 1097 IF (int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b-1) .eq. int_mb(k_spin 1098 &+h1b-1)+int_mb(k_spin+h2b-1)) THEN 1099 IF (ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+h13b-1),ieor(int_m 1100 &b(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN 1101 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b 1102 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 1103 length = length + 1 1104 END IF 1105 END IF 1106 END IF 1107 END DO 1108 END DO 1109 END DO 1110 END DO 1111 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 1112 &set)) CALL ERRQUIT('eomccsdt_x3_9_1_1',0,MA_ERR) 1113 int_mb(k_a_offset) = length 1114 addr = 0 1115 size = 0 1116 DO h12b = 1,noab 1117 DO h13b = h12b,noab 1118 DO h1b = 1,noab 1119 DO h2b = h1b,noab 1120 IF (int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b-1) .eq. int_mb(k_spin 1121 &+h1b-1)+int_mb(k_spin+h2b-1)) THEN 1122 IF (ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+h13b-1),ieor(int_m 1123 &b(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN 1124 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b 1125 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 1126 addr = addr + 1 1127 int_mb(k_a_offset+addr) = h2b - 1 + noab * (h1b - 1 + noab * (h13b 1128 & - 1 + noab * (h12b - 1))) 1129 int_mb(k_a_offset+length+addr) = size 1130 size = size + int_mb(k_range+h12b-1) * int_mb(k_range+h13b-1) * in 1131 &t_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) 1132 END IF 1133 END IF 1134 END IF 1135 END DO 1136 END DO 1137 END DO 1138 END DO 1139 RETURN 1140 END 1141 SUBROUTINE OFFSET_eomccsdt_x3_9_1_2_1(l_a_offset,k_a_offset,size) 1142C $Id$ 1143C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 1144C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 1145C i3 ( h12 h13 h1 p9 )_v 1146 IMPLICIT NONE 1147#include "global.fh" 1148#include "mafdecls.fh" 1149#include "sym.fh" 1150#include "errquit.fh" 1151#include "tce.fh" 1152 INTEGER l_a_offset 1153 INTEGER k_a_offset 1154 INTEGER size 1155 INTEGER length 1156 INTEGER addr 1157 INTEGER h12b 1158 INTEGER h13b 1159 INTEGER h1b 1160 INTEGER p9b 1161 length = 0 1162 DO h12b = 1,noab 1163 DO h13b = h12b,noab 1164 DO h1b = 1,noab 1165 DO p9b = noab+1,noab+nvab 1166 IF (int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b-1) .eq. int_mb(k_spin 1167 &+h1b-1)+int_mb(k_spin+p9b-1)) THEN 1168 IF (ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+h13b-1),ieor(int_m 1169 &b(k_sym+h1b-1),int_mb(k_sym+p9b-1)))) .eq. irrep_v) THEN 1170 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b 1171 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p9b-1).ne.8)) THEN 1172 length = length + 1 1173 END IF 1174 END IF 1175 END IF 1176 END DO 1177 END DO 1178 END DO 1179 END DO 1180 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 1181 &set)) CALL ERRQUIT('eomccsdt_x3_9_1_2_1',0,MA_ERR) 1182 int_mb(k_a_offset) = length 1183 addr = 0 1184 size = 0 1185 DO h12b = 1,noab 1186 DO h13b = h12b,noab 1187 DO h1b = 1,noab 1188 DO p9b = noab+1,noab+nvab 1189 IF (int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b-1) .eq. int_mb(k_spin 1190 &+h1b-1)+int_mb(k_spin+p9b-1)) THEN 1191 IF (ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+h13b-1),ieor(int_m 1192 &b(k_sym+h1b-1),int_mb(k_sym+p9b-1)))) .eq. irrep_v) THEN 1193 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b 1194 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p9b-1).ne.8)) THEN 1195 addr = addr + 1 1196 int_mb(k_a_offset+addr) = p9b - noab - 1 + nvab * (h1b - 1 + noab 1197 &* (h13b - 1 + noab * (h12b - 1))) 1198 int_mb(k_a_offset+length+addr) = size 1199 size = size + int_mb(k_range+h12b-1) * int_mb(k_range+h13b-1) * in 1200 &t_mb(k_range+h1b-1) * int_mb(k_range+p9b-1) 1201 END IF 1202 END IF 1203 END IF 1204 END DO 1205 END DO 1206 END DO 1207 END DO 1208 RETURN 1209 END 1210 SUBROUTINE OFFSET_eomccsdt_x3_9_1(l_a_offset,k_a_offset,size) 1211C $Id$ 1212C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 1213C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 1214C i1 ( h12 p4 h1 h2 )_vx 1215 IMPLICIT NONE 1216#include "global.fh" 1217#include "mafdecls.fh" 1218#include "sym.fh" 1219#include "errquit.fh" 1220#include "tce.fh" 1221 INTEGER l_a_offset 1222 INTEGER k_a_offset 1223 INTEGER size 1224 INTEGER length 1225 INTEGER addr 1226 INTEGER p4b 1227 INTEGER h12b 1228 INTEGER h1b 1229 INTEGER h2b 1230 length = 0 1231 DO p4b = noab+1,noab+nvab 1232 DO h12b = 1,noab 1233 DO h1b = 1,noab 1234 DO h2b = h1b,noab 1235 IF (int_mb(k_spin+h12b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 1236 &h1b-1)+int_mb(k_spin+h2b-1)) THEN 1237 IF (ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 1238 &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_x)) T 1239 &HEN 1240 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+p4b- 1241 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 1242 length = length + 1 1243 END IF 1244 END IF 1245 END IF 1246 END DO 1247 END DO 1248 END DO 1249 END DO 1250 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 1251 &set)) CALL ERRQUIT('eomccsdt_x3_9_1',0,MA_ERR) 1252 int_mb(k_a_offset) = length 1253 addr = 0 1254 size = 0 1255 DO p4b = noab+1,noab+nvab 1256 DO h12b = 1,noab 1257 DO h1b = 1,noab 1258 DO h2b = h1b,noab 1259 IF (int_mb(k_spin+h12b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 1260 &h1b-1)+int_mb(k_spin+h2b-1)) THEN 1261 IF (ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 1262 &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_x)) T 1263 &HEN 1264 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+p4b- 1265 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 1266 addr = addr + 1 1267 int_mb(k_a_offset+addr) = h2b - 1 + noab * (h1b - 1 + noab * (h12b 1268 & - 1 + noab * (p4b - noab - 1))) 1269 int_mb(k_a_offset+length+addr) = size 1270 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h12b-1) * int 1271 &_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) 1272 END IF 1273 END IF 1274 END IF 1275 END DO 1276 END DO 1277 END DO 1278 END DO 1279 RETURN 1280 END 1281 SUBROUTINE OFFSET_eomccsdt_x3_9_3_1(l_a_offset,k_a_offset,size) 1282C $Id$ 1283C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 1284C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 1285C i2 ( h12 p7 )_f 1286 IMPLICIT NONE 1287#include "global.fh" 1288#include "mafdecls.fh" 1289#include "sym.fh" 1290#include "errquit.fh" 1291#include "tce.fh" 1292 INTEGER l_a_offset 1293 INTEGER k_a_offset 1294 INTEGER size 1295 INTEGER length 1296 INTEGER addr 1297 INTEGER h12b 1298 INTEGER p7b 1299 length = 0 1300 DO h12b = 1,noab 1301 DO p7b = noab+1,noab+nvab 1302 IF (int_mb(k_spin+h12b-1) .eq. int_mb(k_spin+p7b-1)) THEN 1303 IF (ieor(int_mb(k_sym+h12b-1),int_mb(k_sym+p7b-1)) .eq. irrep_f) T 1304 &HEN 1305 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+p7b- 1306 &1).ne.4)) THEN 1307 length = length + 1 1308 END IF 1309 END IF 1310 END IF 1311 END DO 1312 END DO 1313 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 1314 &set)) CALL ERRQUIT('eomccsdt_x3_9_3_1',0,MA_ERR) 1315 int_mb(k_a_offset) = length 1316 addr = 0 1317 size = 0 1318 DO h12b = 1,noab 1319 DO p7b = noab+1,noab+nvab 1320 IF (int_mb(k_spin+h12b-1) .eq. int_mb(k_spin+p7b-1)) THEN 1321 IF (ieor(int_mb(k_sym+h12b-1),int_mb(k_sym+p7b-1)) .eq. irrep_f) T 1322 &HEN 1323 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+p7b- 1324 &1).ne.4)) THEN 1325 addr = addr + 1 1326 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h12b - 1) 1327 int_mb(k_a_offset+length+addr) = size 1328 size = size + int_mb(k_range+h12b-1) * int_mb(k_range+p7b-1) 1329 END IF 1330 END IF 1331 END IF 1332 END DO 1333 END DO 1334 RETURN 1335 END 1336 SUBROUTINE OFFSET_eomccsdt_x3_9_4_1(l_a_offset,k_a_offset,size) 1337C $Id$ 1338C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 1339C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 1340C i2 ( h10 h12 h1 p7 )_v 1341 IMPLICIT NONE 1342#include "global.fh" 1343#include "mafdecls.fh" 1344#include "sym.fh" 1345#include "errquit.fh" 1346#include "tce.fh" 1347 INTEGER l_a_offset 1348 INTEGER k_a_offset 1349 INTEGER size 1350 INTEGER length 1351 INTEGER addr 1352 INTEGER h10b 1353 INTEGER h12b 1354 INTEGER h1b 1355 INTEGER p7b 1356 length = 0 1357 DO h10b = 1,noab 1358 DO h12b = h10b,noab 1359 DO h1b = 1,noab 1360 DO p7b = noab+1,noab+nvab 1361 IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 1362 &+h1b-1)+int_mb(k_spin+p7b-1)) THEN 1363 IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 1364 &b(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 1365 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h12b 1366 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 1367 length = length + 1 1368 END IF 1369 END IF 1370 END IF 1371 END DO 1372 END DO 1373 END DO 1374 END DO 1375 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 1376 &set)) CALL ERRQUIT('eomccsdt_x3_9_4_1',0,MA_ERR) 1377 int_mb(k_a_offset) = length 1378 addr = 0 1379 size = 0 1380 DO h10b = 1,noab 1381 DO h12b = h10b,noab 1382 DO h1b = 1,noab 1383 DO p7b = noab+1,noab+nvab 1384 IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 1385 &+h1b-1)+int_mb(k_spin+p7b-1)) THEN 1386 IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 1387 &b(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 1388 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h12b 1389 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 1390 addr = addr + 1 1391 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 1392 &* (h12b - 1 + noab * (h10b - 1))) 1393 int_mb(k_a_offset+length+addr) = size 1394 size = size + int_mb(k_range+h10b-1) * int_mb(k_range+h12b-1) * in 1395 &t_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 1396 END IF 1397 END IF 1398 END IF 1399 END DO 1400 END DO 1401 END DO 1402 END DO 1403 RETURN 1404 END 1405 SUBROUTINE OFFSET_eomccsdt_x3_9_7_1(l_a_offset,k_a_offset,size) 1406C $Id$ 1407C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 1408C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 1409C i2 ( h11 h12 h1 h2 )_vx 1410 IMPLICIT NONE 1411#include "global.fh" 1412#include "mafdecls.fh" 1413#include "sym.fh" 1414#include "errquit.fh" 1415#include "tce.fh" 1416 INTEGER l_a_offset 1417 INTEGER k_a_offset 1418 INTEGER size 1419 INTEGER length 1420 INTEGER addr 1421 INTEGER h11b 1422 INTEGER h12b 1423 INTEGER h1b 1424 INTEGER h2b 1425 length = 0 1426 DO h11b = 1,noab 1427 DO h12b = h11b,noab 1428 DO h1b = 1,noab 1429 DO h2b = h1b,noab 1430 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 1431 &+h1b-1)+int_mb(k_spin+h2b-1)) THEN 1432 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 1433 &b(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_x)) 1434 &THEN 1435 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 1436 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 1437 length = length + 1 1438 END IF 1439 END IF 1440 END IF 1441 END DO 1442 END DO 1443 END DO 1444 END DO 1445 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 1446 &set)) CALL ERRQUIT('eomccsdt_x3_9_7_1',0,MA_ERR) 1447 int_mb(k_a_offset) = length 1448 addr = 0 1449 size = 0 1450 DO h11b = 1,noab 1451 DO h12b = h11b,noab 1452 DO h1b = 1,noab 1453 DO h2b = h1b,noab 1454 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 1455 &+h1b-1)+int_mb(k_spin+h2b-1)) THEN 1456 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 1457 &b(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_x)) 1458 &THEN 1459 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 1460 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 1461 addr = addr + 1 1462 int_mb(k_a_offset+addr) = h2b - 1 + noab * (h1b - 1 + noab * (h12b 1463 & - 1 + noab * (h11b - 1))) 1464 int_mb(k_a_offset+length+addr) = size 1465 size = size + int_mb(k_range+h11b-1) * int_mb(k_range+h12b-1) * in 1466 &t_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) 1467 END IF 1468 END IF 1469 END IF 1470 END DO 1471 END DO 1472 END DO 1473 END DO 1474 RETURN 1475 END 1476 SUBROUTINE OFFSET_eomccsdt_x3_9_7_3_1(l_a_offset,k_a_offset,size) 1477C $Id$ 1478C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 1479C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 1480C i3 ( h11 h12 h1 p8 )_vx 1481 IMPLICIT NONE 1482#include "global.fh" 1483#include "mafdecls.fh" 1484#include "sym.fh" 1485#include "errquit.fh" 1486#include "tce.fh" 1487 INTEGER l_a_offset 1488 INTEGER k_a_offset 1489 INTEGER size 1490 INTEGER length 1491 INTEGER addr 1492 INTEGER h11b 1493 INTEGER h12b 1494 INTEGER h1b 1495 INTEGER p8b 1496 length = 0 1497 DO h11b = 1,noab 1498 DO h12b = h11b,noab 1499 DO h1b = 1,noab 1500 DO p8b = noab+1,noab+nvab 1501 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 1502 &+h1b-1)+int_mb(k_spin+p8b-1)) THEN 1503 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 1504 &b(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_v,irrep_x)) 1505 &THEN 1506 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 1507 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 1508 length = length + 1 1509 END IF 1510 END IF 1511 END IF 1512 END DO 1513 END DO 1514 END DO 1515 END DO 1516 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 1517 &set)) CALL ERRQUIT('eomccsdt_x3_9_7_3_1',0,MA_ERR) 1518 int_mb(k_a_offset) = length 1519 addr = 0 1520 size = 0 1521 DO h11b = 1,noab 1522 DO h12b = h11b,noab 1523 DO h1b = 1,noab 1524 DO p8b = noab+1,noab+nvab 1525 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 1526 &+h1b-1)+int_mb(k_spin+p8b-1)) THEN 1527 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 1528 &b(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_v,irrep_x)) 1529 &THEN 1530 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 1531 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 1532 addr = addr + 1 1533 int_mb(k_a_offset+addr) = p8b - noab - 1 + nvab * (h1b - 1 + noab 1534 &* (h12b - 1 + noab * (h11b - 1))) 1535 int_mb(k_a_offset+length+addr) = size 1536 size = size + int_mb(k_range+h11b-1) * int_mb(k_range+h12b-1) * in 1537 &t_mb(k_range+h1b-1) * int_mb(k_range+p8b-1) 1538 END IF 1539 END IF 1540 END IF 1541 END DO 1542 END DO 1543 END DO 1544 END DO 1545 RETURN 1546 END 1547 SUBROUTINE OFFSET_eomccsdt_x3_9_8_1(l_a_offset,k_a_offset,size) 1548C $Id$ 1549C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 1550C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 1551C i2 ( h12 p4 h1 p8 )_vx 1552 IMPLICIT NONE 1553#include "global.fh" 1554#include "mafdecls.fh" 1555#include "sym.fh" 1556#include "errquit.fh" 1557#include "tce.fh" 1558 INTEGER l_a_offset 1559 INTEGER k_a_offset 1560 INTEGER size 1561 INTEGER length 1562 INTEGER addr 1563 INTEGER p4b 1564 INTEGER h12b 1565 INTEGER h1b 1566 INTEGER p8b 1567 length = 0 1568 DO p4b = noab+1,noab+nvab 1569 DO h12b = 1,noab 1570 DO h1b = 1,noab 1571 DO p8b = noab+1,noab+nvab 1572 IF (int_mb(k_spin+h12b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 1573 &h1b-1)+int_mb(k_spin+p8b-1)) THEN 1574 IF (ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 1575 &(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_v,irrep_x)) T 1576 &HEN 1577 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+p4b- 1578 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 1579 length = length + 1 1580 END IF 1581 END IF 1582 END IF 1583 END DO 1584 END DO 1585 END DO 1586 END DO 1587 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 1588 &set)) CALL ERRQUIT('eomccsdt_x3_9_8_1',0,MA_ERR) 1589 int_mb(k_a_offset) = length 1590 addr = 0 1591 size = 0 1592 DO p4b = noab+1,noab+nvab 1593 DO h12b = 1,noab 1594 DO h1b = 1,noab 1595 DO p8b = noab+1,noab+nvab 1596 IF (int_mb(k_spin+h12b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 1597 &h1b-1)+int_mb(k_spin+p8b-1)) THEN 1598 IF (ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 1599 &(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_v,irrep_x)) T 1600 &HEN 1601 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+p4b- 1602 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 1603 addr = addr + 1 1604 int_mb(k_a_offset+addr) = p8b - noab - 1 + nvab * (h1b - 1 + noab 1605 &* (h12b - 1 + noab * (p4b - noab - 1))) 1606 int_mb(k_a_offset+length+addr) = size 1607 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h12b-1) * int 1608 &_mb(k_range+h1b-1) * int_mb(k_range+p8b-1) 1609 END IF 1610 END IF 1611 END IF 1612 END DO 1613 END DO 1614 END DO 1615 END DO 1616 RETURN 1617 END 1618 SUBROUTINE OFFSET_eomccsdt_x3_9_9_1(l_a_offset,k_a_offset,size) 1619C $Id$ 1620C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 1621C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 1622C i2 ( h12 p8 )_vx 1623 IMPLICIT NONE 1624#include "global.fh" 1625#include "mafdecls.fh" 1626#include "sym.fh" 1627#include "errquit.fh" 1628#include "tce.fh" 1629 INTEGER l_a_offset 1630 INTEGER k_a_offset 1631 INTEGER size 1632 INTEGER length 1633 INTEGER addr 1634 INTEGER h12b 1635 INTEGER p8b 1636 length = 0 1637 DO h12b = 1,noab 1638 DO p8b = noab+1,noab+nvab 1639 IF (int_mb(k_spin+h12b-1) .eq. int_mb(k_spin+p8b-1)) THEN 1640 IF (ieor(int_mb(k_sym+h12b-1),int_mb(k_sym+p8b-1)) .eq. ieor(irrep 1641 &_v,irrep_x)) THEN 1642 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+p8b- 1643 &1).ne.4)) THEN 1644 length = length + 1 1645 END IF 1646 END IF 1647 END IF 1648 END DO 1649 END DO 1650 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 1651 &set)) CALL ERRQUIT('eomccsdt_x3_9_9_1',0,MA_ERR) 1652 int_mb(k_a_offset) = length 1653 addr = 0 1654 size = 0 1655 DO h12b = 1,noab 1656 DO p8b = noab+1,noab+nvab 1657 IF (int_mb(k_spin+h12b-1) .eq. int_mb(k_spin+p8b-1)) THEN 1658 IF (ieor(int_mb(k_sym+h12b-1),int_mb(k_sym+p8b-1)) .eq. ieor(irrep 1659 &_v,irrep_x)) THEN 1660 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+p8b- 1661 &1).ne.4)) THEN 1662 addr = addr + 1 1663 int_mb(k_a_offset+addr) = p8b - noab - 1 + nvab * (h12b - 1) 1664 int_mb(k_a_offset+length+addr) = size 1665 size = size + int_mb(k_range+h12b-1) * int_mb(k_range+p8b-1) 1666 END IF 1667 END IF 1668 END IF 1669 END DO 1670 END DO 1671 RETURN 1672 END 1673 SUBROUTINE OFFSET_eomccsdt_x3a_10_1_1(l_a_offset,k_a_offset,size) 1674C $Id$ 1675C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 1676C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 1677C i2 ( h11 p4 h1 p7 )_v 1678 IMPLICIT NONE 1679#include "global.fh" 1680#include "mafdecls.fh" 1681#include "sym.fh" 1682#include "errquit.fh" 1683#include "tce.fh" 1684 INTEGER l_a_offset 1685 INTEGER k_a_offset 1686 INTEGER size 1687 INTEGER length 1688 INTEGER addr 1689 INTEGER p4b 1690 INTEGER h11b 1691 INTEGER h1b 1692 INTEGER p7b 1693 LOGICAL ACOLO_1P,ACOLO_1H 1694 length = 0 1695 DO p4b = noab+1,noab+nvab 1696 DO h11b = 1,noab 1697 DO h1b = 1,noab 1698 DO p7b = noab+1,noab+nvab 1699 IF(acolo_1p(p4b).AND.acolo_1h(h1b)) THEN 1700 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 1701 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 1702 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 1703 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 1704 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 1705 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 1706 length = length + 1 1707 END IF 1708 END IF 1709 END IF 1710 END IF !active 1711 END DO 1712 END DO 1713 END DO 1714 END DO 1715 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 1716 &set)) CALL ERRQUIT('eomccsdt_x3_10_1_1',0,MA_ERR) 1717 int_mb(k_a_offset) = length 1718 addr = 0 1719 size = 0 1720 DO p4b = noab+1,noab+nvab 1721 DO h11b = 1,noab 1722 DO h1b = 1,noab 1723 DO p7b = noab+1,noab+nvab 1724 IF(acolo_1p(p4b).AND.acolo_1h(h1b)) THEN 1725 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 1726 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 1727 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 1728 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 1729 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 1730 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 1731 addr = addr + 1 1732 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 1733 &* (h11b - 1 + noab * (p4b - noab - 1))) 1734 int_mb(k_a_offset+length+addr) = size 1735 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h11b-1) * int 1736 &_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 1737 END IF 1738 END IF 1739 END IF 1740 END IF !active 1741 END DO 1742 END DO 1743 END DO 1744 END DO 1745 RETURN 1746 END 1747 SUBROUTINE OFFSET_eomccsdt_x3a_10_1(l_a_offset,k_a_offset,size) 1748C $Id$ 1749C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 1750C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 1751C i1 ( h11 p4 p5 h1 h2 h3 )_vt 1752 IMPLICIT NONE 1753#include "global.fh" 1754#include "mafdecls.fh" 1755#include "sym.fh" 1756#include "errquit.fh" 1757#include "tce.fh" 1758 INTEGER l_a_offset 1759 INTEGER k_a_offset 1760 INTEGER size 1761 INTEGER length 1762 INTEGER addr 1763 INTEGER p4b 1764 INTEGER p5b 1765 INTEGER h11b 1766 INTEGER h1b 1767 INTEGER h2b 1768 INTEGER h3b 1769 LOGICAL ACOLO_O_2P 1770 length = 0 1771 DO p4b = noab+1,noab+nvab 1772 DO p5b = p4b,noab+nvab 1773 DO h11b = 1,noab 1774 DO h1b = 1,noab 1775 DO h2b = h1b,noab 1776 DO h3b = h2b,noab 1777 IF(acolo_o_2p(p4b,p5b,h1b,h2b,h3b)) THEN 1778 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+p5b-1 1779 &) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3b 1780 &-1)) THEN 1781 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 1782 &(k_sym+p5b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),in 1783 &t_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_v,irrep_t)) THEN 1784 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 1785 &1)+int_mb(k_spin+p5b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+ 1786 &int_mb(k_spin+h3b-1).ne.12)) THEN 1787 length = length + 1 1788 END IF 1789 END IF 1790 END IF 1791 END IF !active 1792 END DO 1793 END DO 1794 END DO 1795 END DO 1796 END DO 1797 END DO 1798 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 1799 &set)) CALL ERRQUIT('eomccsdt_x3_10_1',0,MA_ERR) 1800 int_mb(k_a_offset) = length 1801 addr = 0 1802 size = 0 1803 DO p4b = noab+1,noab+nvab 1804 DO p5b = p4b,noab+nvab 1805 DO h11b = 1,noab 1806 DO h1b = 1,noab 1807 DO h2b = h1b,noab 1808 DO h3b = h2b,noab 1809 IF(acolo_o_2p(p4b,p5b,h1b,h2b,h3b)) THEN 1810 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+p5b-1 1811 &) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3b 1812 &-1)) THEN 1813 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 1814 &(k_sym+p5b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),in 1815 &t_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_v,irrep_t)) THEN 1816 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 1817 &1)+int_mb(k_spin+p5b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+ 1818 &int_mb(k_spin+h3b-1).ne.12)) THEN 1819 addr = addr + 1 1820 int_mb(k_a_offset+addr) = h3b - 1 + noab * (h2b - 1 + noab * (h1b 1821 &- 1 + noab * (h11b - 1 + noab * (p5b - noab - 1 + nvab * (p4b - no 1822 &ab - 1))))) 1823 int_mb(k_a_offset+length+addr) = size 1824 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+p5b-1) * int_ 1825 &mb(k_range+h11b-1) * int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) 1826 & * int_mb(k_range+h3b-1) 1827 END IF 1828 END IF 1829 END IF 1830 END IF !active 1831 END DO 1832 END DO 1833 END DO 1834 END DO 1835 END DO 1836 END DO 1837 RETURN 1838 END 1839 SUBROUTINE OFFSET_eomccsdt_x3a_10_2_1(l_a_offset,k_a_offset,size) 1840C $Id$ 1841C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 1842C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 1843C i2 ( h11 p10 )_f 1844 IMPLICIT NONE 1845#include "global.fh" 1846#include "mafdecls.fh" 1847#include "sym.fh" 1848#include "errquit.fh" 1849#include "tce.fh" 1850 INTEGER l_a_offset 1851 INTEGER k_a_offset 1852 INTEGER size 1853 INTEGER length 1854 INTEGER addr 1855 INTEGER h11b 1856 INTEGER p10b 1857 LOGICAL ACOLO_1P 1858 length = 0 1859 DO h11b = 1,noab 1860 DO p10b = noab+1,noab+nvab 1861 IF(acolo_1p(p10b)) THEN 1862 IF (int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+p10b-1)) THEN 1863 IF (ieor(int_mb(k_sym+h11b-1),int_mb(k_sym+p10b-1)) .eq. irrep_f) 1864 &THEN 1865 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p10b 1866 &-1).ne.4)) THEN 1867 length = length + 1 1868 END IF 1869 END IF 1870 END IF 1871 END IF !active 1872 END DO 1873 END DO 1874 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 1875 &set)) CALL ERRQUIT('eomccsdt_x3_10_2_1',0,MA_ERR) 1876 int_mb(k_a_offset) = length 1877 addr = 0 1878 size = 0 1879 DO h11b = 1,noab 1880 DO p10b = noab+1,noab+nvab 1881 IF(acolo_1p(p10b)) THEN 1882 IF (int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+p10b-1)) THEN 1883 IF (ieor(int_mb(k_sym+h11b-1),int_mb(k_sym+p10b-1)) .eq. irrep_f) 1884 &THEN 1885 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p10b 1886 &-1).ne.4)) THEN 1887 addr = addr + 1 1888 int_mb(k_a_offset+addr) = p10b - noab - 1 + nvab * (h11b - 1) 1889 int_mb(k_a_offset+length+addr) = size 1890 size = size + int_mb(k_range+h11b-1) * int_mb(k_range+p10b-1) 1891 END IF 1892 END IF 1893 END IF 1894 END IF !active 1895 END DO 1896 END DO 1897 RETURN 1898 END 1899 SUBROUTINE OFFSET_eomccsdt_x3a_10_3_1(l_a_offset,k_a_offset,size) 1900C $Id$ 1901C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 1902C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 1903C i2 ( h8 h11 h1 p7 )_v 1904 IMPLICIT NONE 1905#include "global.fh" 1906#include "mafdecls.fh" 1907#include "sym.fh" 1908#include "errquit.fh" 1909#include "tce.fh" 1910 INTEGER l_a_offset 1911 INTEGER k_a_offset 1912 INTEGER size 1913 INTEGER length 1914 INTEGER addr 1915 INTEGER h8b 1916 INTEGER h11b 1917 INTEGER h1b 1918 INTEGER p7b 1919 LOGICAL ACOLO_1A_2H,ACOLO_1P,ACOLO_1H 1920 length = 0 1921 DO h8b = 1,noab 1922 DO h11b = h8b,noab 1923 DO h1b = 1,noab 1924 DO p7b = noab+1,noab+nvab 1925 IF(acolo_1a_2h(h8b,h11b).AND.acolo_1p(p7b).AND.acolo_1h(h1b)) THEN 1926 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+ 1927 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 1928 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 1929 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 1930 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 1931 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 1932 length = length + 1 1933 END IF 1934 END IF 1935 END IF 1936 END IF !active 1937 END DO 1938 END DO 1939 END DO 1940 END DO 1941 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 1942 &set)) CALL ERRQUIT('eomccsdt_x3_10_3_1',0,MA_ERR) 1943 int_mb(k_a_offset) = length 1944 addr = 0 1945 size = 0 1946 DO h8b = 1,noab 1947 DO h11b = h8b,noab 1948 DO h1b = 1,noab 1949 DO p7b = noab+1,noab+nvab 1950 IF(acolo_1a_2h(h8b,h11b).AND.acolo_1p(p7b).AND.acolo_1h(h1b)) THEN 1951 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+ 1952 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 1953 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 1954 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 1955 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 1956 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 1957 addr = addr + 1 1958 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 1959 &* (h11b - 1 + noab * (h8b - 1))) 1960 int_mb(k_a_offset+length+addr) = size 1961 size = size + int_mb(k_range+h8b-1) * int_mb(k_range+h11b-1) * int 1962 &_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 1963 END IF 1964 END IF 1965 END IF 1966 END IF !active 1967 END DO 1968 END DO 1969 END DO 1970 END DO 1971 RETURN 1972 END 1973 SUBROUTINE OFFSET_eomccsdt_x3a_11_1(l_a_offset,k_a_offset,size) 1974C $Id$ 1975C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 1976C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 1977C i1 ( p4 p5 h1 p7 )_vx 1978 IMPLICIT NONE 1979#include "global.fh" 1980#include "mafdecls.fh" 1981#include "sym.fh" 1982#include "errquit.fh" 1983#include "tce.fh" 1984 INTEGER l_a_offset 1985 INTEGER k_a_offset 1986 INTEGER size 1987 INTEGER length 1988 INTEGER addr 1989 INTEGER p4b 1990 INTEGER p5b 1991 INTEGER h1b 1992 INTEGER p7b 1993 LOGICAL ACOLO_2P_1H 1994 length = 0 1995 DO p4b = noab+1,noab+nvab 1996 DO p5b = p4b,noab+nvab 1997 DO h1b = 1,noab 1998 DO p7b = noab+1,noab+nvab 1999 IF(acolo_2p_1h(p4b,p5b,h1b)) THEN 2000 IF (int_mb(k_spin+p4b-1)+int_mb(k_spin+p5b-1) .eq. int_mb(k_spin+h 2001 &1b-1)+int_mb(k_spin+p7b-1)) THEN 2002 IF (ieor(int_mb(k_sym+p4b-1),ieor(int_mb(k_sym+p5b-1),ieor(int_mb( 2003 &k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_x)) TH 2004 &EN 2005 IF ((.not.restricted).or.(int_mb(k_spin+p4b-1)+int_mb(k_spin+p5b-1 2006 &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 2007 length = length + 1 2008 END IF 2009 END IF 2010 END IF 2011 END IF !active 2012 END DO 2013 END DO 2014 END DO 2015 END DO 2016 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 2017 &set)) CALL ERRQUIT('eomccsdt_x3_11_1',0,MA_ERR) 2018 int_mb(k_a_offset) = length 2019 addr = 0 2020 size = 0 2021 DO p4b = noab+1,noab+nvab 2022 DO p5b = p4b,noab+nvab 2023 DO h1b = 1,noab 2024 DO p7b = noab+1,noab+nvab 2025 IF(acolo_2p_1h(p4b,p5b,h1b)) THEN 2026 IF (int_mb(k_spin+p4b-1)+int_mb(k_spin+p5b-1) .eq. int_mb(k_spin+h 2027 &1b-1)+int_mb(k_spin+p7b-1)) THEN 2028 IF (ieor(int_mb(k_sym+p4b-1),ieor(int_mb(k_sym+p5b-1),ieor(int_mb( 2029 &k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_x)) TH 2030 &EN 2031 IF ((.not.restricted).or.(int_mb(k_spin+p4b-1)+int_mb(k_spin+p5b-1 2032 &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 2033 addr = addr + 1 2034 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 2035 &* (p5b - noab - 1 + nvab * (p4b - noab - 1))) 2036 int_mb(k_a_offset+length+addr) = size 2037 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+p5b-1) * int_ 2038 &mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 2039 END IF 2040 END IF 2041 END IF 2042 END IF !active 2043 END DO 2044 END DO 2045 END DO 2046 END DO 2047 RETURN 2048 END 2049 SUBROUTINE OFFSET_eomccsdt_x3a_11_2_1(l_a_offset,k_a_offset,size) 2050C $Id$ 2051C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 2052C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 2053C i2 ( h11 h12 h1 p7 )_v 2054 IMPLICIT NONE 2055#include "global.fh" 2056#include "mafdecls.fh" 2057#include "sym.fh" 2058#include "errquit.fh" 2059#include "tce.fh" 2060 INTEGER l_a_offset 2061 INTEGER k_a_offset 2062 INTEGER size 2063 INTEGER length 2064 INTEGER addr 2065 INTEGER h11b 2066 INTEGER h12b 2067 INTEGER h1b 2068 INTEGER p7b 2069 LOGICAL ACOLO_1H 2070 length = 0 2071 DO h11b = 1,noab 2072 DO h12b = h11b,noab 2073 DO h1b = 1,noab 2074 DO p7b = noab+1,noab+nvab 2075 IF(acolo_1h(h1b)) THEN 2076 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 2077 &+h1b-1)+int_mb(k_spin+p7b-1)) THEN 2078 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 2079 &b(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 2080 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 2081 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 2082 length = length + 1 2083 END IF 2084 END IF 2085 END IF 2086 END IF !active 2087 END DO 2088 END DO 2089 END DO 2090 END DO 2091 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 2092 &set)) CALL ERRQUIT('eomccsdt_x3_11_2_1',0,MA_ERR) 2093 int_mb(k_a_offset) = length 2094 addr = 0 2095 size = 0 2096 DO h11b = 1,noab 2097 DO h12b = h11b,noab 2098 DO h1b = 1,noab 2099 DO p7b = noab+1,noab+nvab 2100 IF(acolo_1h(h1b)) THEN 2101 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 2102 &+h1b-1)+int_mb(k_spin+p7b-1)) THEN 2103 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 2104 &b(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 2105 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 2106 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 2107 addr = addr + 1 2108 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 2109 &* (h12b - 1 + noab * (h11b - 1))) 2110 int_mb(k_a_offset+length+addr) = size 2111 size = size + int_mb(k_range+h11b-1) * int_mb(k_range+h12b-1) * in 2112 &t_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 2113 END IF 2114 END IF 2115 END IF 2116 END IF !active 2117 END DO 2118 END DO 2119 END DO 2120 END DO 2121 RETURN 2122 END 2123 SUBROUTINE OFFSET_eomccsdt_x3a_11_5_1(l_a_offset,k_a_offset,size) 2124C $Id$ 2125C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 2126C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 2127C i2 ( h8 h9 h1 p7 )_vx 2128 IMPLICIT NONE 2129#include "global.fh" 2130#include "mafdecls.fh" 2131#include "sym.fh" 2132#include "errquit.fh" 2133#include "tce.fh" 2134 INTEGER l_a_offset 2135 INTEGER k_a_offset 2136 INTEGER size 2137 INTEGER length 2138 INTEGER addr 2139 INTEGER h8b 2140 INTEGER h9b 2141 INTEGER h1b 2142 INTEGER p7b 2143 LOGICAL ACOLO_1H 2144 length = 0 2145 DO h8b = 1,noab 2146 DO h9b = h8b,noab 2147 DO h1b = 1,noab 2148 DO p7b = noab+1,noab+nvab 2149 IF(acolo_1h(h1b)) THEN 2150 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+h 2151 &1b-1)+int_mb(k_spin+p7b-1)) THEN 2152 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h9b-1),ieor(int_mb( 2153 &k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_x)) TH 2154 &EN 2155 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h9b-1 2156 &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 2157 length = length + 1 2158 END IF 2159 END IF 2160 END IF 2161 END IF !active 2162 END DO 2163 END DO 2164 END DO 2165 END DO 2166 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 2167 &set)) CALL ERRQUIT('eomccsdt_x3_11_5_1',0,MA_ERR) 2168 int_mb(k_a_offset) = length 2169 addr = 0 2170 size = 0 2171 DO h8b = 1,noab 2172 DO h9b = h8b,noab 2173 DO h1b = 1,noab 2174 DO p7b = noab+1,noab+nvab 2175 IF(acolo_1h(h1b)) THEN 2176 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+h 2177 &1b-1)+int_mb(k_spin+p7b-1)) THEN 2178 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h9b-1),ieor(int_mb( 2179 &k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_x)) TH 2180 &EN 2181 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h9b-1 2182 &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 2183 addr = addr + 1 2184 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 2185 &* (h9b - 1 + noab * (h8b - 1))) 2186 int_mb(k_a_offset+length+addr) = size 2187 size = size + int_mb(k_range+h8b-1) * int_mb(k_range+h9b-1) * int_ 2188 &mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 2189 END IF 2190 END IF 2191 END IF 2192 END IF !active 2193 END DO 2194 END DO 2195 END DO 2196 END DO 2197 RETURN 2198 END 2199 SUBROUTINE OFFSET_eomccsdt_x3a_1_1(l_a_offset,k_a_offset,size) 2200C $Id$ 2201C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 2202C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 2203C i1 ( h11 p4 h1 h2 )_v 2204 IMPLICIT NONE 2205#include "global.fh" 2206#include "mafdecls.fh" 2207#include "sym.fh" 2208#include "errquit.fh" 2209#include "tce.fh" 2210 INTEGER l_a_offset 2211 INTEGER k_a_offset 2212 INTEGER size 2213 INTEGER length 2214 INTEGER addr 2215 INTEGER p4b 2216 INTEGER h11b 2217 INTEGER h1b 2218 INTEGER h2b 2219 LOGICAL ACOLO_1P_2H 2220 length = 0 2221 DO p4b = noab+1,noab+nvab 2222 DO h11b = 1,noab 2223 DO h1b = 1,noab 2224 DO h2b = h1b,noab 2225 IF(acolo_1p_2h(p4b,h1b,h2b)) THEN 2226 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 2227 &h1b-1)+int_mb(k_spin+h2b-1)) THEN 2228 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 2229 &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN 2230 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 2231 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 2232 length = length + 1 2233 END IF 2234 END IF 2235 END IF 2236 END IF !active 2237 END DO 2238 END DO 2239 END DO 2240 END DO 2241 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 2242 &set)) CALL ERRQUIT('eomccsdt_x3_1_1',0,MA_ERR) 2243 int_mb(k_a_offset) = length 2244 addr = 0 2245 size = 0 2246 DO p4b = noab+1,noab+nvab 2247 DO h11b = 1,noab 2248 DO h1b = 1,noab 2249 DO h2b = h1b,noab 2250 IF(acolo_1p_2h(p4b,h1b,h2b)) THEN 2251 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 2252 &h1b-1)+int_mb(k_spin+h2b-1)) THEN 2253 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 2254 &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN 2255 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 2256 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 2257 addr = addr + 1 2258 int_mb(k_a_offset+addr) = h2b - 1 + noab * (h1b - 1 + noab * (h11b 2259 & - 1 + noab * (p4b - noab - 1))) 2260 int_mb(k_a_offset+length+addr) = size 2261 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h11b-1) * int 2262 &_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) 2263 END IF 2264 END IF 2265 END IF 2266 END IF !active 2267 END DO 2268 END DO 2269 END DO 2270 END DO 2271 RETURN 2272 END 2273 SUBROUTINE OFFSET_eomccsdt_x3a_1_2_1(l_a_offset,k_a_offset,size) 2274C $Id$ 2275C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 2276C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 2277C i2 ( h11 h12 h1 h2 )_v 2278 IMPLICIT NONE 2279#include "global.fh" 2280#include "mafdecls.fh" 2281#include "sym.fh" 2282#include "errquit.fh" 2283#include "tce.fh" 2284 INTEGER l_a_offset 2285 INTEGER k_a_offset 2286 INTEGER size 2287 INTEGER length 2288 INTEGER addr 2289 INTEGER h11b 2290 INTEGER h12b 2291 INTEGER h1b 2292 INTEGER h2b 2293 LOGICAL ACOLO_2H 2294 length = 0 2295 DO h11b = 1,noab 2296 DO h12b = h11b,noab 2297 DO h1b = 1,noab 2298 DO h2b = h1b,noab 2299 IF(acolo_2h(h1b,h2b)) THEN 2300 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 2301 &+h1b-1)+int_mb(k_spin+h2b-1)) THEN 2302 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 2303 &b(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN 2304 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 2305 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 2306 length = length + 1 2307 END IF 2308 END IF 2309 END IF 2310 END IF !active 2311 END DO 2312 END DO 2313 END DO 2314 END DO 2315 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 2316 &set)) CALL ERRQUIT('eomccsdt_x3_1_2_1',0,MA_ERR) 2317 int_mb(k_a_offset) = length 2318 addr = 0 2319 size = 0 2320 DO h11b = 1,noab 2321 DO h12b = h11b,noab 2322 DO h1b = 1,noab 2323 DO h2b = h1b,noab 2324 IF(acolo_2h(h1b,h2b)) THEN 2325 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 2326 &+h1b-1)+int_mb(k_spin+h2b-1)) THEN 2327 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 2328 &b(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN 2329 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 2330 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 2331 addr = addr + 1 2332 int_mb(k_a_offset+addr) = h2b - 1 + noab * (h1b - 1 + noab * (h12b 2333 & - 1 + noab * (h11b - 1))) 2334 int_mb(k_a_offset+length+addr) = size 2335 size = size + int_mb(k_range+h11b-1) * int_mb(k_range+h12b-1) * in 2336 &t_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) 2337 END IF 2338 END IF 2339 END IF 2340 END IF !active 2341 END DO 2342 END DO 2343 END DO 2344 END DO 2345 RETURN 2346 END 2347 SUBROUTINE OFFSET_eomccsdt_x3a_12_1(l_a_offset,k_a_offset,size) 2348C $Id$ 2349C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 2350C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 2351C i1 ( h7 h8 p4 h1 h2 h3 )_vx 2352 IMPLICIT NONE 2353#include "global.fh" 2354#include "mafdecls.fh" 2355#include "sym.fh" 2356#include "errquit.fh" 2357#include "tce.fh" 2358 INTEGER l_a_offset 2359 INTEGER k_a_offset 2360 INTEGER size 2361 INTEGER length 2362 INTEGER addr 2363 INTEGER p4b 2364 INTEGER h7b 2365 INTEGER h8b 2366 INTEGER h1b 2367 INTEGER h2b 2368 INTEGER h3b 2369 LOGICAL ACOLO_O_1P 2370 length = 0 2371 DO p4b = noab+1,noab+nvab 2372 DO h7b = 1,noab 2373 DO h8b = h7b,noab 2374 DO h1b = 1,noab 2375 DO h2b = h1b,noab 2376 DO h3b = h2b,noab 2377 IF(acolo_o_1p(p4b,h1b,h2b,h3b)) THEN 2378 IF (int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1)+int_mb(k_spin+p4b-1) 2379 & .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3b- 2380 &1)) THEN 2381 IF (ieor(int_mb(k_sym+h7b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 2382 &k_sym+p4b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),int 2383 &_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_v,irrep_x)) THEN 2384 IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1 2385 &)+int_mb(k_spin+p4b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+i 2386 &nt_mb(k_spin+h3b-1).ne.12)) THEN 2387 length = length + 1 2388 END IF 2389 END IF 2390 END IF 2391 END IF !active 2392 END DO 2393 END DO 2394 END DO 2395 END DO 2396 END DO 2397 END DO 2398 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 2399 &set)) CALL ERRQUIT('eomccsdt_x3_12_1',0,MA_ERR) 2400 int_mb(k_a_offset) = length 2401 addr = 0 2402 size = 0 2403 DO p4b = noab+1,noab+nvab 2404 DO h7b = 1,noab 2405 DO h8b = h7b,noab 2406 DO h1b = 1,noab 2407 DO h2b = h1b,noab 2408 DO h3b = h2b,noab 2409 IF(acolo_o_1p(p4b,h1b,h2b,h3b)) THEN 2410 IF (int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1)+int_mb(k_spin+p4b-1) 2411 & .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3b- 2412 &1)) THEN 2413 IF (ieor(int_mb(k_sym+h7b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 2414 &k_sym+p4b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),int 2415 &_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_v,irrep_x)) THEN 2416 IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1 2417 &)+int_mb(k_spin+p4b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+i 2418 &nt_mb(k_spin+h3b-1).ne.12)) THEN 2419 addr = addr + 1 2420 int_mb(k_a_offset+addr) = h3b - 1 + noab * (h2b - 1 + noab * (h1b 2421 &- 1 + noab * (h8b - 1 + noab * (h7b - 1 + noab * (p4b - noab - 1)) 2422 &))) 2423 int_mb(k_a_offset+length+addr) = size 2424 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h7b-1) * int_ 2425 &mb(k_range+h8b-1) * int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) 2426 &* int_mb(k_range+h3b-1) 2427 END IF 2428 END IF 2429 END IF 2430 END IF !active 2431 END DO 2432 END DO 2433 END DO 2434 END DO 2435 END DO 2436 END DO 2437 RETURN 2438 END 2439 SUBROUTINE OFFSET_eomccsdt_x3a_1_2_2_1(l_a_offset,k_a_offset,size) 2440C $Id$ 2441C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 2442C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 2443C i3 ( h11 h12 h1 p8 )_v 2444 IMPLICIT NONE 2445#include "global.fh" 2446#include "mafdecls.fh" 2447#include "sym.fh" 2448#include "errquit.fh" 2449#include "tce.fh" 2450 INTEGER l_a_offset 2451 INTEGER k_a_offset 2452 INTEGER size 2453 INTEGER length 2454 INTEGER addr 2455 INTEGER h11b 2456 INTEGER h12b 2457 INTEGER h1b 2458 INTEGER p8b 2459 LOGICAL ACOLO_1H 2460 length = 0 2461 DO h11b = 1,noab 2462 DO h12b = h11b,noab 2463 DO h1b = 1,noab 2464 DO p8b = noab+1,noab+nvab 2465 IF(acolo_1h(h1b)) THEN 2466 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 2467 &+h1b-1)+int_mb(k_spin+p8b-1)) THEN 2468 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 2469 &b(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. irrep_v) THEN 2470 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 2471 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 2472 length = length + 1 2473 END IF 2474 END IF 2475 END IF 2476 END IF !active 2477 END DO 2478 END DO 2479 END DO 2480 END DO 2481 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 2482 &set)) CALL ERRQUIT('eomccsdt_x3_1_2_2_1',0,MA_ERR) 2483 int_mb(k_a_offset) = length 2484 addr = 0 2485 size = 0 2486 DO h11b = 1,noab 2487 DO h12b = h11b,noab 2488 DO h1b = 1,noab 2489 DO p8b = noab+1,noab+nvab 2490 IF(acolo_1h(h1b)) THEN 2491 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 2492 &+h1b-1)+int_mb(k_spin+p8b-1)) THEN 2493 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 2494 &b(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. irrep_v) THEN 2495 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 2496 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 2497 addr = addr + 1 2498 int_mb(k_a_offset+addr) = p8b - noab - 1 + nvab * (h1b - 1 + noab 2499 &* (h12b - 1 + noab * (h11b - 1))) 2500 int_mb(k_a_offset+length+addr) = size 2501 size = size + int_mb(k_range+h11b-1) * int_mb(k_range+h12b-1) * in 2502 &t_mb(k_range+h1b-1) * int_mb(k_range+p8b-1) 2503 END IF 2504 END IF 2505 END IF 2506 END IF !active 2507 END DO 2508 END DO 2509 END DO 2510 END DO 2511 RETURN 2512 END 2513 SUBROUTINE OFFSET_eomccsdt_x3a_13_1_1(l_a_offset,k_a_offset,size) 2514C $Id$ 2515C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 2516C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 2517C i2 ( h7 p11 )_f 2518 IMPLICIT NONE 2519#include "global.fh" 2520#include "mafdecls.fh" 2521#include "sym.fh" 2522#include "errquit.fh" 2523#include "tce.fh" 2524 INTEGER l_a_offset 2525 INTEGER k_a_offset 2526 INTEGER size 2527 INTEGER length 2528 INTEGER addr 2529 INTEGER h7b 2530 INTEGER p11b 2531 LOGICAL ACOLO_1H 2532 length = 0 2533 DO h7b = 1,noab 2534 DO p11b = noab+1,noab+nvab 2535 IF(acolo_1h(h7b)) THEN 2536 IF (int_mb(k_spin+h7b-1) .eq. int_mb(k_spin+p11b-1)) THEN 2537 IF (ieor(int_mb(k_sym+h7b-1),int_mb(k_sym+p11b-1)) .eq. irrep_f) T 2538 &HEN 2539 IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+p11b- 2540 &1).ne.4)) THEN 2541 length = length + 1 2542 END IF 2543 END IF 2544 END IF 2545 END IF !active 2546 END DO 2547 END DO 2548 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 2549 &set)) CALL ERRQUIT('eomccsdt_x3_13_1_1',0,MA_ERR) 2550 int_mb(k_a_offset) = length 2551 addr = 0 2552 size = 0 2553 DO h7b = 1,noab 2554 DO p11b = noab+1,noab+nvab 2555 IF(acolo_1h(h7b)) THEN 2556 IF (int_mb(k_spin+h7b-1) .eq. int_mb(k_spin+p11b-1)) THEN 2557 IF (ieor(int_mb(k_sym+h7b-1),int_mb(k_sym+p11b-1)) .eq. irrep_f) T 2558 &HEN 2559 IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+p11b- 2560 &1).ne.4)) THEN 2561 addr = addr + 1 2562 int_mb(k_a_offset+addr) = p11b - noab - 1 + nvab * (h7b - 1) 2563 int_mb(k_a_offset+length+addr) = size 2564 size = size + int_mb(k_range+h7b-1) * int_mb(k_range+p11b-1) 2565 END IF 2566 END IF 2567 END IF 2568 END IF !active 2569 END DO 2570 END DO 2571 RETURN 2572 END 2573 SUBROUTINE OFFSET_eomccsdt_x3a_1_3_1(l_a_offset,k_a_offset,size) 2574C $Id$ 2575C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 2576C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 2577C i2 ( h11 p4 h1 p7 )_v 2578 IMPLICIT NONE 2579#include "global.fh" 2580#include "mafdecls.fh" 2581#include "sym.fh" 2582#include "errquit.fh" 2583#include "tce.fh" 2584 INTEGER l_a_offset 2585 INTEGER k_a_offset 2586 INTEGER size 2587 INTEGER length 2588 INTEGER addr 2589 INTEGER p4b 2590 INTEGER h11b 2591 INTEGER h1b 2592 INTEGER p7b 2593 LOGICAL ACOLO_1P_1H 2594 length = 0 2595 DO p4b = noab+1,noab+nvab 2596 DO h11b = 1,noab 2597 DO h1b = 1,noab 2598 DO p7b = noab+1,noab+nvab 2599 IF(acolo_1p_1h(p4b,h1b)) THEN 2600 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 2601 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 2602 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 2603 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 2604 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 2605 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 2606 length = length + 1 2607 END IF 2608 END IF 2609 END IF 2610 END IF !active 2611 END DO 2612 END DO 2613 END DO 2614 END DO 2615 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 2616 &set)) CALL ERRQUIT('eomccsdt_x3_1_3_1',0,MA_ERR) 2617 int_mb(k_a_offset) = length 2618 addr = 0 2619 size = 0 2620 DO p4b = noab+1,noab+nvab 2621 DO h11b = 1,noab 2622 DO h1b = 1,noab 2623 DO p7b = noab+1,noab+nvab 2624 IF(acolo_1p_1h(p4b,h1b)) THEN 2625 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 2626 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 2627 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 2628 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 2629 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 2630 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 2631 addr = addr + 1 2632 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 2633 &* (h11b - 1 + noab * (p4b - noab - 1))) 2634 int_mb(k_a_offset+length+addr) = size 2635 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h11b-1) * int 2636 &_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 2637 END IF 2638 END IF 2639 END IF 2640 END IF !active 2641 END DO 2642 END DO 2643 END DO 2644 END DO 2645 RETURN 2646 END 2647 SUBROUTINE OFFSET_eomccsdt_x3a_13_1(l_a_offset,k_a_offset,size) 2648C $Id$ 2649C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 2650C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 2651C i1 ( h7 h1 )_fx 2652 IMPLICIT NONE 2653#include "global.fh" 2654#include "mafdecls.fh" 2655#include "sym.fh" 2656#include "errquit.fh" 2657#include "tce.fh" 2658 INTEGER l_a_offset 2659 INTEGER k_a_offset 2660 INTEGER size 2661 INTEGER length 2662 INTEGER addr 2663 INTEGER h7b 2664 INTEGER h1b 2665 LOGICAL ACOLO_1H 2666 length = 0 2667 DO h7b = 1,noab 2668 DO h1b = 1,noab 2669 IF(acolo_1h(h7b).AND.acolo_1h(h1b)) THEN 2670 IF (int_mb(k_spin+h7b-1) .eq. int_mb(k_spin+h1b-1)) THEN 2671 IF (ieor(int_mb(k_sym+h7b-1),int_mb(k_sym+h1b-1)) .eq. ieor(irrep_ 2672 &f,irrep_x)) THEN 2673 IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+h1b-1 2674 &).ne.4)) THEN 2675 length = length + 1 2676 END IF 2677 END IF 2678 END IF 2679 END IF !active 2680 END DO 2681 END DO 2682 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 2683 &set)) CALL ERRQUIT('eomccsdt_x3_13_1',0,MA_ERR) 2684 int_mb(k_a_offset) = length 2685 addr = 0 2686 size = 0 2687 DO h7b = 1,noab 2688 DO h1b = 1,noab 2689 IF(acolo_1h(h7b).AND.acolo_1h(h1b)) THEN 2690 IF (int_mb(k_spin+h7b-1) .eq. int_mb(k_spin+h1b-1)) THEN 2691 IF (ieor(int_mb(k_sym+h7b-1),int_mb(k_sym+h1b-1)) .eq. ieor(irrep_ 2692 &f,irrep_x)) THEN 2693 IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+h1b-1 2694 &).ne.4)) THEN 2695 addr = addr + 1 2696 int_mb(k_a_offset+addr) = h1b - 1 + noab * (h7b - 1) 2697 int_mb(k_a_offset+length+addr) = size 2698 size = size + int_mb(k_range+h7b-1) * int_mb(k_range+h1b-1) 2699 END IF 2700 END IF 2701 END IF 2702 END IF !active 2703 END DO 2704 END DO 2705 RETURN 2706 END 2707 SUBROUTINE OFFSET_eomccsdt_x3a_13_4_1(l_a_offset,k_a_offset,size) 2708C $Id$ 2709C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 2710C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 2711C i2 ( h7 p8 )_vx 2712 IMPLICIT NONE 2713#include "global.fh" 2714#include "mafdecls.fh" 2715#include "sym.fh" 2716#include "errquit.fh" 2717#include "tce.fh" 2718 INTEGER l_a_offset 2719 INTEGER k_a_offset 2720 INTEGER size 2721 INTEGER length 2722 INTEGER addr 2723 INTEGER h7b 2724 INTEGER p8b 2725 LOGICAL ACOLO_1H 2726 length = 0 2727 DO h7b = 1,noab 2728 DO p8b = noab+1,noab+nvab 2729 IF(acolo_1h(h7b)) THEN 2730 IF (int_mb(k_spin+h7b-1) .eq. int_mb(k_spin+p8b-1)) THEN 2731 IF (ieor(int_mb(k_sym+h7b-1),int_mb(k_sym+p8b-1)) .eq. ieor(irrep_ 2732 &v,irrep_x)) THEN 2733 IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+p8b-1 2734 &).ne.4)) THEN 2735 length = length + 1 2736 END IF 2737 END IF 2738 END IF 2739 END IF !active 2740 END DO 2741 END DO 2742 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 2743 &set)) CALL ERRQUIT('eomccsdt_x3_13_4_1',0,MA_ERR) 2744 int_mb(k_a_offset) = length 2745 addr = 0 2746 size = 0 2747 DO h7b = 1,noab 2748 DO p8b = noab+1,noab+nvab 2749 IF(acolo_1h(h7b)) THEN 2750 IF (int_mb(k_spin+h7b-1) .eq. int_mb(k_spin+p8b-1)) THEN 2751 IF (ieor(int_mb(k_sym+h7b-1),int_mb(k_sym+p8b-1)) .eq. ieor(irrep_ 2752 &v,irrep_x)) THEN 2753 IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+p8b-1 2754 &).ne.4)) THEN 2755 addr = addr + 1 2756 int_mb(k_a_offset+addr) = p8b - noab - 1 + nvab * (h7b - 1) 2757 int_mb(k_a_offset+length+addr) = size 2758 size = size + int_mb(k_range+h7b-1) * int_mb(k_range+p8b-1) 2759 END IF 2760 END IF 2761 END IF 2762 END IF !active 2763 END DO 2764 END DO 2765 RETURN 2766 END 2767 SUBROUTINE OFFSET_eomccsdt_x3a_1_4_1(l_a_offset,k_a_offset,size) 2768C $Id$ 2769C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 2770C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 2771C i2 ( h11 p10 )_f 2772 IMPLICIT NONE 2773#include "global.fh" 2774#include "mafdecls.fh" 2775#include "sym.fh" 2776#include "errquit.fh" 2777#include "tce.fh" 2778 INTEGER l_a_offset 2779 INTEGER k_a_offset 2780 INTEGER size 2781 INTEGER length 2782 INTEGER addr 2783 INTEGER h11b 2784 INTEGER p10b 2785 length = 0 2786 DO h11b = 1,noab 2787 DO p10b = noab+1,noab+nvab 2788 IF (int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+p10b-1)) THEN 2789 IF (ieor(int_mb(k_sym+h11b-1),int_mb(k_sym+p10b-1)) .eq. irrep_f) 2790 &THEN 2791 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p10b 2792 &-1).ne.4)) THEN 2793 length = length + 1 2794 END IF 2795 END IF 2796 END IF 2797 END DO 2798 END DO 2799 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 2800 &set)) CALL ERRQUIT('eomccsdt_x3_1_4_1',0,MA_ERR) 2801 int_mb(k_a_offset) = length 2802 addr = 0 2803 size = 0 2804 DO h11b = 1,noab 2805 DO p10b = noab+1,noab+nvab 2806 IF (int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+p10b-1)) THEN 2807 IF (ieor(int_mb(k_sym+h11b-1),int_mb(k_sym+p10b-1)) .eq. irrep_f) 2808 &THEN 2809 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p10b 2810 &-1).ne.4)) THEN 2811 addr = addr + 1 2812 int_mb(k_a_offset+addr) = p10b - noab - 1 + nvab * (h11b - 1) 2813 int_mb(k_a_offset+length+addr) = size 2814 size = size + int_mb(k_range+h11b-1) * int_mb(k_range+p10b-1) 2815 END IF 2816 END IF 2817 END IF 2818 END DO 2819 END DO 2820 RETURN 2821 END 2822 SUBROUTINE OFFSET_eomccsdt_x3a_14_1(l_a_offset,k_a_offset,size) 2823C $Id$ 2824C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 2825C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 2826C i1 ( h7 h8 h1 h2 )_vx 2827 IMPLICIT NONE 2828#include "global.fh" 2829#include "mafdecls.fh" 2830#include "sym.fh" 2831#include "errquit.fh" 2832#include "tce.fh" 2833 INTEGER l_a_offset 2834 INTEGER k_a_offset 2835 INTEGER size 2836 INTEGER length 2837 INTEGER addr 2838 INTEGER h7b 2839 INTEGER h8b 2840 INTEGER h1b 2841 INTEGER h2b 2842 LOGICAL ACOLO_2H 2843 length = 0 2844 DO h7b = 1,noab 2845 DO h8b = h7b,noab 2846 DO h1b = 1,noab 2847 DO h2b = h1b,noab 2848 IF(acolo_2h(h7b,h8b).AND.acolo_2h(h1b,h2b)) THEN 2849 IF (int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h 2850 &1b-1)+int_mb(k_spin+h2b-1)) THEN 2851 IF (ieor(int_mb(k_sym+h7b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 2852 &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_x)) TH 2853 &EN 2854 IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1 2855 &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 2856 length = length + 1 2857 END IF 2858 END IF 2859 END IF 2860 END IF !active 2861 END DO 2862 END DO 2863 END DO 2864 END DO 2865 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 2866 &set)) CALL ERRQUIT('eomccsdt_x3_14_1',0,MA_ERR) 2867 int_mb(k_a_offset) = length 2868 addr = 0 2869 size = 0 2870 DO h7b = 1,noab 2871 DO h8b = h7b,noab 2872 DO h1b = 1,noab 2873 DO h2b = h1b,noab 2874 IF(acolo_2h(h7b,h8b).AND.acolo_2h(h1b,h2b)) THEN 2875 IF (int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h 2876 &1b-1)+int_mb(k_spin+h2b-1)) THEN 2877 IF (ieor(int_mb(k_sym+h7b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 2878 &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_x)) TH 2879 &EN 2880 IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1 2881 &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 2882 addr = addr + 1 2883 int_mb(k_a_offset+addr) = h2b - 1 + noab * (h1b - 1 + noab * (h8b 2884 &- 1 + noab * (h7b - 1))) 2885 int_mb(k_a_offset+length+addr) = size 2886 size = size + int_mb(k_range+h7b-1) * int_mb(k_range+h8b-1) * int_ 2887 &mb(k_range+h1b-1) * int_mb(k_range+h2b-1) 2888 END IF 2889 END IF 2890 END IF 2891 END IF !active 2892 END DO 2893 END DO 2894 END DO 2895 END DO 2896 RETURN 2897 END 2898 SUBROUTINE OFFSET_eomccsdt_x3a_14_3_1(l_a_offset,k_a_offset,size) 2899C $Id$ 2900C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 2901C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 2902C i2 ( h7 h8 h1 p9 )_vx 2903 IMPLICIT NONE 2904#include "global.fh" 2905#include "mafdecls.fh" 2906#include "sym.fh" 2907#include "errquit.fh" 2908#include "tce.fh" 2909 INTEGER l_a_offset 2910 INTEGER k_a_offset 2911 INTEGER size 2912 INTEGER length 2913 INTEGER addr 2914 INTEGER h7b 2915 INTEGER h8b 2916 INTEGER h1b 2917 INTEGER p9b 2918 LOGICAL ACOLO_2H,ACOLO_1H 2919 length = 0 2920 DO h7b = 1,noab 2921 DO h8b = h7b,noab 2922 DO h1b = 1,noab 2923 DO p9b = noab+1,noab+nvab 2924 IF(acolo_2h(h7b,h8b).AND.acolo_1h(h1b)) THEN 2925 IF (int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h 2926 &1b-1)+int_mb(k_spin+p9b-1)) THEN 2927 IF (ieor(int_mb(k_sym+h7b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 2928 &k_sym+h1b-1),int_mb(k_sym+p9b-1)))) .eq. ieor(irrep_v,irrep_x)) TH 2929 &EN 2930 IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1 2931 &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p9b-1).ne.8)) THEN 2932 length = length + 1 2933 END IF 2934 END IF 2935 END IF 2936 END IF !active 2937 END DO 2938 END DO 2939 END DO 2940 END DO 2941 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 2942 &set)) CALL ERRQUIT('eomccsdt_x3_14_3_1',0,MA_ERR) 2943 int_mb(k_a_offset) = length 2944 addr = 0 2945 size = 0 2946 DO h7b = 1,noab 2947 DO h8b = h7b,noab 2948 DO h1b = 1,noab 2949 DO p9b = noab+1,noab+nvab 2950 IF(acolo_2h(h7b,h8b).AND.acolo_1h(h1b)) THEN 2951 IF (int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h 2952 &1b-1)+int_mb(k_spin+p9b-1)) THEN 2953 IF (ieor(int_mb(k_sym+h7b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 2954 &k_sym+h1b-1),int_mb(k_sym+p9b-1)))) .eq. ieor(irrep_v,irrep_x)) TH 2955 &EN 2956 IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1 2957 &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p9b-1).ne.8)) THEN 2958 addr = addr + 1 2959 int_mb(k_a_offset+addr) = p9b - noab - 1 + nvab * (h1b - 1 + noab 2960 &* (h8b - 1 + noab * (h7b - 1))) 2961 int_mb(k_a_offset+length+addr) = size 2962 size = size + int_mb(k_range+h7b-1) * int_mb(k_range+h8b-1) * int_ 2963 &mb(k_range+h1b-1) * int_mb(k_range+p9b-1) 2964 END IF 2965 END IF 2966 END IF 2967 END IF !active 2968 END DO 2969 END DO 2970 END DO 2971 END DO 2972 RETURN 2973 END 2974 SUBROUTINE OFFSET_eomccsdt_x3a_1_5_1(l_a_offset,k_a_offset,size) 2975C $Id$ 2976C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 2977C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 2978C i2 ( h8 h11 h1 p7 )_v 2979 IMPLICIT NONE 2980#include "global.fh" 2981#include "mafdecls.fh" 2982#include "sym.fh" 2983#include "errquit.fh" 2984#include "tce.fh" 2985 INTEGER l_a_offset 2986 INTEGER k_a_offset 2987 INTEGER size 2988 INTEGER length 2989 INTEGER addr 2990 INTEGER h8b 2991 INTEGER h11b 2992 INTEGER h1b 2993 INTEGER p7b 2994 LOGICAL ACOLO_1H 2995 length = 0 2996 DO h8b = 1,noab 2997 DO h11b = h8b,noab 2998 DO h1b = 1,noab 2999 DO p7b = noab+1,noab+nvab 3000 IF(acolo_1h(h1b)) THEN 3001 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+ 3002 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 3003 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 3004 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 3005 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 3006 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 3007 length = length + 1 3008 END IF 3009 END IF 3010 END IF 3011 END IF !active 3012 END DO 3013 END DO 3014 END DO 3015 END DO 3016 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 3017 &set)) CALL ERRQUIT('eomccsdt_x3_1_5_1',0,MA_ERR) 3018 int_mb(k_a_offset) = length 3019 addr = 0 3020 size = 0 3021 DO h8b = 1,noab 3022 DO h11b = h8b,noab 3023 DO h1b = 1,noab 3024 DO p7b = noab+1,noab+nvab 3025 IF(acolo_1h(h1b)) THEN 3026 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+ 3027 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 3028 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 3029 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 3030 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 3031 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 3032 addr = addr + 1 3033 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 3034 &* (h11b - 1 + noab * (h8b - 1))) 3035 int_mb(k_a_offset+length+addr) = size 3036 size = size + int_mb(k_range+h8b-1) * int_mb(k_range+h11b-1) * int 3037 &_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 3038 END IF 3039 END IF 3040 END IF 3041 END IF !active 3042 END DO 3043 END DO 3044 END DO 3045 END DO 3046 RETURN 3047 END 3048 SUBROUTINE OFFSET_eomccsdt_x3a_15_1(l_a_offset,k_a_offset,size) 3049C $Id$ 3050C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 3051C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 3052C i1 ( p4 p7 )_vx 3053 IMPLICIT NONE 3054#include "global.fh" 3055#include "mafdecls.fh" 3056#include "sym.fh" 3057#include "errquit.fh" 3058#include "tce.fh" 3059 INTEGER l_a_offset 3060 INTEGER k_a_offset 3061 INTEGER size 3062 INTEGER length 3063 INTEGER addr 3064 INTEGER p4b 3065 INTEGER p7b 3066 LOGICAL ACOLO_1P 3067 length = 0 3068 DO p4b = noab+1,noab+nvab 3069 DO p7b = noab+1,noab+nvab 3070 IF(acolo_1p(p4b).AND.acolo_1p(p7b)) THEN 3071 IF (int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+p7b-1)) THEN 3072 IF (ieor(int_mb(k_sym+p4b-1),int_mb(k_sym+p7b-1)) .eq. ieor(irrep_ 3073 &v,irrep_x)) THEN 3074 IF ((.not.restricted).or.(int_mb(k_spin+p4b-1)+int_mb(k_spin+p7b-1 3075 &).ne.4)) THEN 3076 length = length + 1 3077 END IF 3078 END IF 3079 END IF 3080 END IF !active 3081 END DO 3082 END DO 3083 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 3084 &set)) CALL ERRQUIT('eomccsdt_x3_15_1',0,MA_ERR) 3085 int_mb(k_a_offset) = length 3086 addr = 0 3087 size = 0 3088 DO p4b = noab+1,noab+nvab 3089 DO p7b = noab+1,noab+nvab 3090 IF(acolo_1p(p4b).AND.acolo_1p(p7b)) THEN 3091 IF (int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+p7b-1)) THEN 3092 IF (ieor(int_mb(k_sym+p4b-1),int_mb(k_sym+p7b-1)) .eq. ieor(irrep_ 3093 &v,irrep_x)) THEN 3094 IF ((.not.restricted).or.(int_mb(k_spin+p4b-1)+int_mb(k_spin+p7b-1 3095 &).ne.4)) THEN 3096 addr = addr + 1 3097 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (p4b - noab - 1) 3098 int_mb(k_a_offset+length+addr) = size 3099 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+p7b-1) 3100 END IF 3101 END IF 3102 END IF 3103 END IF !active 3104 END DO 3105 END DO 3106 RETURN 3107 END 3108 SUBROUTINE OFFSET_eomccsdt_x3a_16_1(l_a_offset,k_a_offset,size) 3109C $Id$ 3110C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 3111C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 3112C i1 ( h8 p4 h1 p7 )_vx 3113 IMPLICIT NONE 3114#include "global.fh" 3115#include "mafdecls.fh" 3116#include "sym.fh" 3117#include "errquit.fh" 3118#include "tce.fh" 3119 INTEGER l_a_offset 3120 INTEGER k_a_offset 3121 INTEGER size 3122 INTEGER length 3123 INTEGER addr 3124 INTEGER p4b 3125 INTEGER h8b 3126 INTEGER h1b 3127 INTEGER p7b 3128 LOGICAL ACOLO_1P_1H 3129 length = 0 3130 DO p4b = noab+1,noab+nvab 3131 DO h8b = 1,noab 3132 DO h1b = 1,noab 3133 DO p7b = noab+1,noab+nvab 3134 IF(acolo_1p_1h(p7b,h8b).AND.acolo_1p_1h(p4b,h1b)) THEN 3135 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h 3136 &1b-1)+int_mb(k_spin+p7b-1)) THEN 3137 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb( 3138 &k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_x)) TH 3139 &EN 3140 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+p4b-1 3141 &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 3142 length = length + 1 3143 END IF 3144 END IF 3145 END IF 3146 END IF !active 3147 END DO 3148 END DO 3149 END DO 3150 END DO 3151 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 3152 &set)) CALL ERRQUIT('eomccsdt_x3_16_1',0,MA_ERR) 3153 int_mb(k_a_offset) = length 3154 addr = 0 3155 size = 0 3156 DO p4b = noab+1,noab+nvab 3157 DO h8b = 1,noab 3158 DO h1b = 1,noab 3159 DO p7b = noab+1,noab+nvab 3160 IF(acolo_1p_1h(p7b,h8b).AND.acolo_1p_1h(p4b,h1b)) THEN 3161 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h 3162 &1b-1)+int_mb(k_spin+p7b-1)) THEN 3163 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb( 3164 &k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_x)) TH 3165 &EN 3166 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+p4b-1 3167 &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 3168 addr = addr + 1 3169 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 3170 &* (h8b - 1 + noab * (p4b - noab - 1))) 3171 int_mb(k_a_offset+length+addr) = size 3172 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h8b-1) * int_ 3173 &mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 3174 END IF 3175 END IF 3176 END IF 3177 END IF !active 3178 END DO 3179 END DO 3180 END DO 3181 END DO 3182 RETURN 3183 END 3184 SUBROUTINE OFFSET_eomccsdt_x3a_17_1(l_a_offset,k_a_offset,size) 3185C $Id$ 3186C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 3187C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 3188C i1 ( h9 h10 p4 h1 h2 h3 )_vt 3189 IMPLICIT NONE 3190#include "global.fh" 3191#include "mafdecls.fh" 3192#include "sym.fh" 3193#include "errquit.fh" 3194#include "tce.fh" 3195 INTEGER l_a_offset 3196 INTEGER k_a_offset 3197 INTEGER size 3198 INTEGER length 3199 INTEGER addr 3200 INTEGER p4b 3201 INTEGER h9b 3202 INTEGER h10b 3203 INTEGER h1b 3204 INTEGER h2b 3205 INTEGER h3b 3206 LOGICAL ACOLO_O_1P 3207 length = 0 3208 DO p4b = noab+1,noab+nvab 3209 DO h9b = 1,noab 3210 DO h10b = h9b,noab 3211 DO h1b = 1,noab 3212 DO h2b = h1b,noab 3213 DO h3b = h2b,noab 3214 IF(acolo_o_1p(p4b,h1b,h2b,h3b)) THEN 3215 IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+h10b-1)+int_mb(k_spin+p4b-1 3216 &) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3b 3217 &-1)) THEN 3218 IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb 3219 &(k_sym+p4b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),in 3220 &t_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_v,irrep_t)) THEN 3221 IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h10b- 3222 &1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+ 3223 &int_mb(k_spin+h3b-1).ne.12)) THEN 3224 length = length + 1 3225 END IF 3226 END IF 3227 END IF 3228 END IF !active 3229 END DO 3230 END DO 3231 END DO 3232 END DO 3233 END DO 3234 END DO 3235 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 3236 &set)) CALL ERRQUIT('eomccsdt_x3_17_1',0,MA_ERR) 3237 int_mb(k_a_offset) = length 3238 addr = 0 3239 size = 0 3240 DO p4b = noab+1,noab+nvab 3241 DO h9b = 1,noab 3242 DO h10b = h9b,noab 3243 DO h1b = 1,noab 3244 DO h2b = h1b,noab 3245 DO h3b = h2b,noab 3246 IF(acolo_o_1p(p4b,h1b,h2b,h3b)) THEN 3247 IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+h10b-1)+int_mb(k_spin+p4b-1 3248 &) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3b 3249 &-1)) THEN 3250 IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb 3251 &(k_sym+p4b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),in 3252 &t_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_v,irrep_t)) THEN 3253 IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h10b- 3254 &1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+ 3255 &int_mb(k_spin+h3b-1).ne.12)) THEN 3256 addr = addr + 1 3257 int_mb(k_a_offset+addr) = h3b - 1 + noab * (h2b - 1 + noab * (h1b 3258 &- 1 + noab * (h10b - 1 + noab * (h9b - 1 + noab * (p4b - noab - 1) 3259 &)))) 3260 int_mb(k_a_offset+length+addr) = size 3261 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h9b-1) * int_ 3262 &mb(k_range+h10b-1) * int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) 3263 & * int_mb(k_range+h3b-1) 3264 END IF 3265 END IF 3266 END IF 3267 END IF !active 3268 END DO 3269 END DO 3270 END DO 3271 END DO 3272 END DO 3273 END DO 3274 RETURN 3275 END 3276 SUBROUTINE OFFSET_eomccsdt_x3a_2_1(l_a_offset,k_a_offset,size) 3277C $Id$ 3278C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 3279C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 3280C i1 ( p4 p5 h1 p12 )_v 3281 IMPLICIT NONE 3282#include "global.fh" 3283#include "mafdecls.fh" 3284#include "sym.fh" 3285#include "errquit.fh" 3286#include "tce.fh" 3287 INTEGER l_a_offset 3288 INTEGER k_a_offset 3289 INTEGER size 3290 INTEGER length 3291 INTEGER addr 3292 INTEGER p4b 3293 INTEGER p5b 3294 INTEGER h1b 3295 INTEGER p12b 3296 LOGICAL ACOLO_2P_1H 3297 length = 0 3298 DO p4b = noab+1,noab+nvab 3299 DO p5b = p4b,noab+nvab 3300 DO h1b = 1,noab 3301 DO p12b = noab+1,noab+nvab 3302 IF(acolo_2p_1h(p4b,p5b,h1b)) THEN 3303 IF (int_mb(k_spin+p4b-1)+int_mb(k_spin+p5b-1) .eq. int_mb(k_spin+h 3304 &1b-1)+int_mb(k_spin+p12b-1)) THEN 3305 IF (ieor(int_mb(k_sym+p4b-1),ieor(int_mb(k_sym+p5b-1),ieor(int_mb( 3306 &k_sym+h1b-1),int_mb(k_sym+p12b-1)))) .eq. irrep_v) THEN 3307 IF ((.not.restricted).or.(int_mb(k_spin+p4b-1)+int_mb(k_spin+p5b-1 3308 &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p12b-1).ne.8)) THEN 3309 length = length + 1 3310 END IF 3311 END IF 3312 END IF 3313 END IF !active 3314 END DO 3315 END DO 3316 END DO 3317 END DO 3318 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 3319 &set)) CALL ERRQUIT('eomccsdt_x3_2_1',0,MA_ERR) 3320 int_mb(k_a_offset) = length 3321 addr = 0 3322 size = 0 3323 DO p4b = noab+1,noab+nvab 3324 DO p5b = p4b,noab+nvab 3325 DO h1b = 1,noab 3326 DO p12b = noab+1,noab+nvab 3327 IF(acolo_2p_1h(p4b,p5b,h1b)) THEN 3328 IF (int_mb(k_spin+p4b-1)+int_mb(k_spin+p5b-1) .eq. int_mb(k_spin+h 3329 &1b-1)+int_mb(k_spin+p12b-1)) THEN 3330 IF (ieor(int_mb(k_sym+p4b-1),ieor(int_mb(k_sym+p5b-1),ieor(int_mb( 3331 &k_sym+h1b-1),int_mb(k_sym+p12b-1)))) .eq. irrep_v) THEN 3332 IF ((.not.restricted).or.(int_mb(k_spin+p4b-1)+int_mb(k_spin+p5b-1 3333 &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p12b-1).ne.8)) THEN 3334 addr = addr + 1 3335 int_mb(k_a_offset+addr) = p12b - noab - 1 + nvab * (h1b - 1 + noab 3336 & * (p5b - noab - 1 + nvab * (p4b - noab - 1))) 3337 int_mb(k_a_offset+length+addr) = size 3338 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+p5b-1) * int_ 3339 &mb(k_range+h1b-1) * int_mb(k_range+p12b-1) 3340 END IF 3341 END IF 3342 END IF 3343 END IF !active 3344 END DO 3345 END DO 3346 END DO 3347 END DO 3348 RETURN 3349 END 3350 SUBROUTINE OFFSET_eomccsdt_x3a_2_3_1(l_a_offset,k_a_offset,size) 3351C $Id$ 3352C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 3353C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 3354C i2 ( h7 h8 h1 p12 )_v 3355 IMPLICIT NONE 3356#include "global.fh" 3357#include "mafdecls.fh" 3358#include "sym.fh" 3359#include "errquit.fh" 3360#include "tce.fh" 3361 INTEGER l_a_offset 3362 INTEGER k_a_offset 3363 INTEGER size 3364 INTEGER length 3365 INTEGER addr 3366 INTEGER h7b 3367 INTEGER h8b 3368 INTEGER h1b 3369 INTEGER p12b 3370 LOGICAL ACOLO_1H 3371 length = 0 3372 DO h7b = 1,noab 3373 DO h8b = h7b,noab 3374 DO h1b = 1,noab 3375 DO p12b = noab+1,noab+nvab 3376 IF(acolo_1h(h1b)) THEN 3377 IF (int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h 3378 &1b-1)+int_mb(k_spin+p12b-1)) THEN 3379 IF (ieor(int_mb(k_sym+h7b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 3380 &k_sym+h1b-1),int_mb(k_sym+p12b-1)))) .eq. irrep_v) THEN 3381 IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1 3382 &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p12b-1).ne.8)) THEN 3383 length = length + 1 3384 END IF 3385 END IF 3386 END IF 3387 END IF !active 3388 END DO 3389 END DO 3390 END DO 3391 END DO 3392 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 3393 &set)) CALL ERRQUIT('eomccsdt_x3_2_3_1',0,MA_ERR) 3394 int_mb(k_a_offset) = length 3395 addr = 0 3396 size = 0 3397 DO h7b = 1,noab 3398 DO h8b = h7b,noab 3399 DO h1b = 1,noab 3400 DO p12b = noab+1,noab+nvab 3401 IF(acolo_1h(h1b)) THEN 3402 IF (int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h 3403 &1b-1)+int_mb(k_spin+p12b-1)) THEN 3404 IF (ieor(int_mb(k_sym+h7b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 3405 &k_sym+h1b-1),int_mb(k_sym+p12b-1)))) .eq. irrep_v) THEN 3406 IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1 3407 &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p12b-1).ne.8)) THEN 3408 addr = addr + 1 3409 int_mb(k_a_offset+addr) = p12b - noab - 1 + nvab * (h1b - 1 + noab 3410 & * (h8b - 1 + noab * (h7b - 1))) 3411 int_mb(k_a_offset+length+addr) = size 3412 size = size + int_mb(k_range+h7b-1) * int_mb(k_range+h8b-1) * int_ 3413 &mb(k_range+h1b-1) * int_mb(k_range+p12b-1) 3414 END IF 3415 END IF 3416 END IF 3417 END IF !active 3418 END DO 3419 END DO 3420 END DO 3421 END DO 3422 RETURN 3423 END 3424 SUBROUTINE OFFSET_eomccsdt_x3a_3_1(l_a_offset,k_a_offset,size) 3425C $Id$ 3426C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 3427C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 3428C i1 ( h10 h1 )_f 3429 IMPLICIT NONE 3430#include "global.fh" 3431#include "mafdecls.fh" 3432#include "sym.fh" 3433#include "errquit.fh" 3434#include "tce.fh" 3435 INTEGER l_a_offset 3436 INTEGER k_a_offset 3437 INTEGER size 3438 INTEGER length 3439 INTEGER addr 3440 INTEGER h10b 3441 INTEGER h1b 3442 LOGICAL ACOLO_1H 3443 length = 0 3444 DO h10b = 1,noab 3445 DO h1b = 1,noab 3446 IF(acolo_1h(h1b).AND.acolo_1h(h10b)) THEN 3447 IF (int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+h1b-1)) THEN 3448 IF (ieor(int_mb(k_sym+h10b-1),int_mb(k_sym+h1b-1)) .eq. irrep_f) T 3449 &HEN 3450 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h1b- 3451 &1).ne.4)) THEN 3452 length = length + 1 3453 END IF 3454 END IF 3455 END IF 3456 END IF !active 3457 END DO 3458 END DO 3459 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 3460 &set)) CALL ERRQUIT('eomccsdt_x3_3_1',0,MA_ERR) 3461 int_mb(k_a_offset) = length 3462 addr = 0 3463 size = 0 3464 DO h10b = 1,noab 3465 DO h1b = 1,noab 3466 IF(acolo_1h(h1b).AND.acolo_1h(h10b)) THEN 3467 IF (int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+h1b-1)) THEN 3468 IF (ieor(int_mb(k_sym+h10b-1),int_mb(k_sym+h1b-1)) .eq. irrep_f) T 3469 &HEN 3470 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h1b- 3471 &1).ne.4)) THEN 3472 addr = addr + 1 3473 int_mb(k_a_offset+addr) = h1b - 1 + noab * (h10b - 1) 3474 int_mb(k_a_offset+length+addr) = size 3475 size = size + int_mb(k_range+h10b-1) * int_mb(k_range+h1b-1) 3476 END IF 3477 END IF 3478 END IF 3479 END IF !active 3480 END DO 3481 END DO 3482 RETURN 3483 END 3484 SUBROUTINE OFFSET_eomccsdt_x3a_3_2_1(l_a_offset,k_a_offset,size) 3485C $Id$ 3486C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 3487C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 3488C i2 ( h10 p11 )_f 3489 IMPLICIT NONE 3490#include "global.fh" 3491#include "mafdecls.fh" 3492#include "sym.fh" 3493#include "errquit.fh" 3494#include "tce.fh" 3495 INTEGER l_a_offset 3496 INTEGER k_a_offset 3497 INTEGER size 3498 INTEGER length 3499 INTEGER addr 3500 INTEGER h10b 3501 INTEGER p11b 3502 LOGICAL ACOLO_1H 3503 length = 0 3504 DO h10b = 1,noab 3505 DO p11b = noab+1,noab+nvab 3506 IF(acolo_1h(h10b)) THEN 3507 IF (int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+p11b-1)) THEN 3508 IF (ieor(int_mb(k_sym+h10b-1),int_mb(k_sym+p11b-1)) .eq. irrep_f) 3509 &THEN 3510 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+p11b 3511 &-1).ne.4)) THEN 3512 length = length + 1 3513 END IF 3514 END IF 3515 END IF 3516 END IF !active 3517 END DO 3518 END DO 3519 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 3520 &set)) CALL ERRQUIT('eomccsdt_x3_3_2_1',0,MA_ERR) 3521 int_mb(k_a_offset) = length 3522 addr = 0 3523 size = 0 3524 DO h10b = 1,noab 3525 DO p11b = noab+1,noab+nvab 3526 IF(acolo_1h(h10b)) THEN 3527 IF (int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+p11b-1)) THEN 3528 IF (ieor(int_mb(k_sym+h10b-1),int_mb(k_sym+p11b-1)) .eq. irrep_f) 3529 &THEN 3530 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+p11b 3531 &-1).ne.4)) THEN 3532 addr = addr + 1 3533 int_mb(k_a_offset+addr) = p11b - noab - 1 + nvab * (h10b - 1) 3534 int_mb(k_a_offset+length+addr) = size 3535 size = size + int_mb(k_range+h10b-1) * int_mb(k_range+p11b-1) 3536 END IF 3537 END IF 3538 END IF 3539 END IF !active 3540 END DO 3541 END DO 3542 RETURN 3543 END 3544 SUBROUTINE OFFSET_eomccsdt_x3a_4_1(l_a_offset,k_a_offset,size) 3545C $Id$ 3546C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 3547C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 3548C i1 ( p4 p10 )_f 3549 IMPLICIT NONE 3550#include "global.fh" 3551#include "mafdecls.fh" 3552#include "sym.fh" 3553#include "errquit.fh" 3554#include "tce.fh" 3555 INTEGER l_a_offset 3556 INTEGER k_a_offset 3557 INTEGER size 3558 INTEGER length 3559 INTEGER addr 3560 INTEGER p4b 3561 INTEGER p10b 3562 LOGICAL ACOLO_1P 3563 length = 0 3564 DO p4b = noab+1,noab+nvab 3565 DO p10b = noab+1,noab+nvab 3566 IF(acolo_1p(p4b).AND.acolo_1p(p10b)) THEN 3567 IF (int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+p10b-1)) THEN 3568 IF (ieor(int_mb(k_sym+p4b-1),int_mb(k_sym+p10b-1)) .eq. irrep_f) T 3569 &HEN 3570 IF ((.not.restricted).or.(int_mb(k_spin+p4b-1)+int_mb(k_spin+p10b- 3571 &1).ne.4)) THEN 3572 length = length + 1 3573 END IF 3574 END IF 3575 END IF 3576 END IF !active 3577 END DO 3578 END DO 3579 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 3580 &set)) CALL ERRQUIT('eomccsdt_x3_4_1',0,MA_ERR) 3581 int_mb(k_a_offset) = length 3582 addr = 0 3583 size = 0 3584 DO p4b = noab+1,noab+nvab 3585 DO p10b = noab+1,noab+nvab 3586 IF(acolo_1p(p4b).AND.acolo_1p(p10b)) THEN 3587 IF (int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+p10b-1)) THEN 3588 IF (ieor(int_mb(k_sym+p4b-1),int_mb(k_sym+p10b-1)) .eq. irrep_f) T 3589 &HEN 3590 IF ((.not.restricted).or.(int_mb(k_spin+p4b-1)+int_mb(k_spin+p10b- 3591 &1).ne.4)) THEN 3592 addr = addr + 1 3593 int_mb(k_a_offset+addr) = p10b - noab - 1 + nvab * (p4b - noab - 1 3594 &) 3595 int_mb(k_a_offset+length+addr) = size 3596 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+p10b-1) 3597 END IF 3598 END IF 3599 END IF 3600 END IF !active 3601 END DO 3602 END DO 3603 RETURN 3604 END 3605 SUBROUTINE OFFSET_eomccsdt_x3a_5_1(l_a_offset,k_a_offset,size) 3606C $Id$ 3607C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 3608C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 3609C i1 ( h11 h12 h1 h2 )_v 3610 IMPLICIT NONE 3611#include "global.fh" 3612#include "mafdecls.fh" 3613#include "sym.fh" 3614#include "errquit.fh" 3615#include "tce.fh" 3616 INTEGER l_a_offset 3617 INTEGER k_a_offset 3618 INTEGER size 3619 INTEGER length 3620 INTEGER addr 3621 INTEGER h11b 3622 INTEGER h12b 3623 INTEGER h1b 3624 INTEGER h2b 3625 LOGICAL ACOLO_2H 3626 length = 0 3627 DO h11b = 1,noab 3628 DO h12b = h11b,noab 3629 DO h1b = 1,noab 3630 DO h2b = h1b,noab 3631 if(acolo_2h(h1b,h2b).AND.acolo_2h(h11b,h12b)) THEN 3632 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 3633 &+h1b-1)+int_mb(k_spin+h2b-1)) THEN 3634 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 3635 &b(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN 3636 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 3637 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 3638 length = length + 1 3639 END IF 3640 END IF 3641 END IF 3642 END IF !active 3643 END DO 3644 END DO 3645 END DO 3646 END DO 3647 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 3648 &set)) CALL ERRQUIT('eomccsdt_x3_5_1',0,MA_ERR) 3649 int_mb(k_a_offset) = length 3650 addr = 0 3651 size = 0 3652 DO h11b = 1,noab 3653 DO h12b = h11b,noab 3654 DO h1b = 1,noab 3655 DO h2b = h1b,noab 3656 if(acolo_2h(h1b,h2b).AND.acolo_2h(h11b,h12b)) THEN 3657 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 3658 &+h1b-1)+int_mb(k_spin+h2b-1)) THEN 3659 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 3660 &b(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN 3661 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 3662 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 3663 addr = addr + 1 3664 int_mb(k_a_offset+addr) = h2b - 1 + noab * (h1b - 1 + noab * (h12b 3665 & - 1 + noab * (h11b - 1))) 3666 int_mb(k_a_offset+length+addr) = size 3667 size = size + int_mb(k_range+h11b-1) * int_mb(k_range+h12b-1) * in 3668 &t_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) 3669 END IF 3670 END IF 3671 END IF 3672 END IF !active 3673 END DO 3674 END DO 3675 END DO 3676 END DO 3677 RETURN 3678 END 3679 SUBROUTINE OFFSET_eomccsdt_x3a_5_2_1(l_a_offset,k_a_offset,size) 3680C $Id$ 3681C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 3682C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 3683C i2 ( h11 h12 h1 p7 )_v 3684 IMPLICIT NONE 3685#include "global.fh" 3686#include "mafdecls.fh" 3687#include "sym.fh" 3688#include "errquit.fh" 3689#include "tce.fh" 3690 INTEGER l_a_offset 3691 INTEGER k_a_offset 3692 INTEGER size 3693 INTEGER length 3694 INTEGER addr 3695 INTEGER h11b 3696 INTEGER h12b 3697 INTEGER h1b 3698 INTEGER p7b 3699 LOGICAL ACOLO_2H,ACOLO_1H 3700 length = 0 3701 DO h11b = 1,noab 3702 DO h12b = h11b,noab 3703 DO h1b = 1,noab 3704 DO p7b = noab+1,noab+nvab 3705 IF(acolo_2h(h11b,h12b).AND.acolo_1h(h1b)) THEN 3706 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 3707 &+h1b-1)+int_mb(k_spin+p7b-1)) THEN 3708 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 3709 &b(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 3710 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 3711 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 3712 length = length + 1 3713 END IF 3714 END IF 3715 END IF 3716 END IF !active 3717 END DO 3718 END DO 3719 END DO 3720 END DO 3721 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 3722 &set)) CALL ERRQUIT('eomccsdt_x3_5_2_1',0,MA_ERR) 3723 int_mb(k_a_offset) = length 3724 addr = 0 3725 size = 0 3726 DO h11b = 1,noab 3727 DO h12b = h11b,noab 3728 DO h1b = 1,noab 3729 DO p7b = noab+1,noab+nvab 3730 IF(acolo_2h(h11b,h12b).AND.acolo_1h(h1b)) THEN 3731 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 3732 &+h1b-1)+int_mb(k_spin+p7b-1)) THEN 3733 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 3734 &b(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 3735 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 3736 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 3737 addr = addr + 1 3738 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 3739 &* (h12b - 1 + noab * (h11b - 1))) 3740 int_mb(k_a_offset+length+addr) = size 3741 size = size + int_mb(k_range+h11b-1) * int_mb(k_range+h12b-1) * in 3742 &t_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 3743 END IF 3744 END IF 3745 END IF 3746 END IF !active 3747 END DO 3748 END DO 3749 END DO 3750 END DO 3751 RETURN 3752 END 3753 SUBROUTINE OFFSET_eomccsdt_x3a_6_1(l_a_offset,k_a_offset,size) 3754C $Id$ 3755C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 3756C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 3757C i1 ( h9 p4 h1 p10 )_v 3758 IMPLICIT NONE 3759#include "global.fh" 3760#include "mafdecls.fh" 3761#include "sym.fh" 3762#include "errquit.fh" 3763#include "tce.fh" 3764 INTEGER l_a_offset 3765 INTEGER k_a_offset 3766 INTEGER size 3767 INTEGER length 3768 INTEGER addr 3769 INTEGER p4b 3770 INTEGER h9b 3771 INTEGER h1b 3772 INTEGER p10b 3773 LOGICAL ACOLO_1H,ACOLO_1P 3774 length = 0 3775 DO p4b = noab+1,noab+nvab 3776 DO h9b = 1,noab 3777 DO h1b = 1,noab 3778 DO p10b = noab+1,noab+nvab 3779 IF(acolo_1p(p10b).AND.acolo_1p(p4b).AND.acolo_1h(h1b).AND. 3780 & acolo_1h(h9b)) THEN 3781 IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h 3782 &1b-1)+int_mb(k_spin+p10b-1)) THEN 3783 IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb( 3784 &k_sym+h1b-1),int_mb(k_sym+p10b-1)))) .eq. irrep_v) THEN 3785 IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+p4b-1 3786 &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p10b-1).ne.8)) THEN 3787 length = length + 1 3788 END IF 3789 END IF 3790 END IF 3791 END IF !active 3792 END DO 3793 END DO 3794 END DO 3795 END DO 3796 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 3797 &set)) CALL ERRQUIT('eomccsdt_x3_6_1',0,MA_ERR) 3798 int_mb(k_a_offset) = length 3799 addr = 0 3800 size = 0 3801 DO p4b = noab+1,noab+nvab 3802 DO h9b = 1,noab 3803 DO h1b = 1,noab 3804 DO p10b = noab+1,noab+nvab 3805 IF(acolo_1p(p10b).AND.acolo_1p(p4b).AND.acolo_1h(h1b).AND. 3806 & acolo_1h(h9b)) THEN 3807 IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h 3808 &1b-1)+int_mb(k_spin+p10b-1)) THEN 3809 IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb( 3810 &k_sym+h1b-1),int_mb(k_sym+p10b-1)))) .eq. irrep_v) THEN 3811 IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+p4b-1 3812 &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p10b-1).ne.8)) THEN 3813 addr = addr + 1 3814 int_mb(k_a_offset+addr) = p10b - noab - 1 + nvab * (h1b - 1 + noab 3815 & * (h9b - 1 + noab * (p4b - noab - 1))) 3816 int_mb(k_a_offset+length+addr) = size 3817 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h9b-1) * int_ 3818 &mb(k_range+h1b-1) * int_mb(k_range+p10b-1) 3819 END IF 3820 END IF 3821 END IF 3822 END IF !active 3823 END DO 3824 END DO 3825 END DO 3826 END DO 3827 RETURN 3828 END 3829 SUBROUTINE OFFSET_eomccsdt_x3a_8_1_1(l_a_offset,k_a_offset,size) 3830C $Id$ 3831C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 3832C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 3833C i2 ( h11 p4 h1 p10 )_v 3834 IMPLICIT NONE 3835#include "global.fh" 3836#include "mafdecls.fh" 3837#include "sym.fh" 3838#include "errquit.fh" 3839#include "tce.fh" 3840 INTEGER l_a_offset 3841 INTEGER k_a_offset 3842 INTEGER size 3843 INTEGER length 3844 INTEGER addr 3845 INTEGER p4b 3846 INTEGER h11b 3847 INTEGER h1b 3848 INTEGER p10b 3849 LOGICAL ACOLO_1H,ACOLO_1P 3850 length = 0 3851 DO p4b = noab+1,noab+nvab 3852 DO h11b = 1,noab 3853 DO h1b = 1,noab 3854 DO p10b = noab+1,noab+nvab 3855 IF(acolo_1p(p4b).AND.acolo_1h(h1b)) THEN 3856 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 3857 &h1b-1)+int_mb(k_spin+p10b-1)) THEN 3858 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 3859 &(k_sym+h1b-1),int_mb(k_sym+p10b-1)))) .eq. irrep_v) THEN 3860 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 3861 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p10b-1).ne.8)) THEN 3862 length = length + 1 3863 END IF 3864 END IF 3865 END IF 3866 END IF !active 3867 END DO 3868 END DO 3869 END DO 3870 END DO 3871 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 3872 &set)) CALL ERRQUIT('eomccsdt_x3_8_1_1',0,MA_ERR) 3873 int_mb(k_a_offset) = length 3874 addr = 0 3875 size = 0 3876 DO p4b = noab+1,noab+nvab 3877 DO h11b = 1,noab 3878 DO h1b = 1,noab 3879 DO p10b = noab+1,noab+nvab 3880 IF(acolo_1p(p4b).AND.acolo_1h(h1b)) THEN 3881 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 3882 &h1b-1)+int_mb(k_spin+p10b-1)) THEN 3883 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 3884 &(k_sym+h1b-1),int_mb(k_sym+p10b-1)))) .eq. irrep_v) THEN 3885 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 3886 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p10b-1).ne.8)) THEN 3887 addr = addr + 1 3888 int_mb(k_a_offset+addr) = p10b - noab - 1 + nvab * (h1b - 1 + noab 3889 & * (h11b - 1 + noab * (p4b - noab - 1))) 3890 int_mb(k_a_offset+length+addr) = size 3891 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h11b-1) * int 3892 &_mb(k_range+h1b-1) * int_mb(k_range+p10b-1) 3893 END IF 3894 END IF 3895 END IF 3896 END IF !active 3897 END DO 3898 END DO 3899 END DO 3900 END DO 3901 RETURN 3902 END 3903 SUBROUTINE OFFSET_eomccsdt_x3a_8_1_2_1(l_a_offset,k_a_offset,size) 3904C $Id$ 3905C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 3906C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 3907C i3 ( h8 h11 h1 p10 )_v 3908 IMPLICIT NONE 3909#include "global.fh" 3910#include "mafdecls.fh" 3911#include "sym.fh" 3912#include "errquit.fh" 3913#include "tce.fh" 3914 INTEGER l_a_offset 3915 INTEGER k_a_offset 3916 INTEGER size 3917 INTEGER length 3918 INTEGER addr 3919 INTEGER h8b 3920 INTEGER h11b 3921 INTEGER h1b 3922 INTEGER p10b 3923 LOGICAL ACOLO_1H 3924 length = 0 3925 DO h8b = 1,noab 3926 DO h11b = h8b,noab 3927 DO h1b = 1,noab 3928 DO p10b = noab+1,noab+nvab 3929 IF(acolo_1h(h1b)) THEN 3930 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+ 3931 &h1b-1)+int_mb(k_spin+p10b-1)) THEN 3932 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 3933 &(k_sym+h1b-1),int_mb(k_sym+p10b-1)))) .eq. irrep_v) THEN 3934 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 3935 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p10b-1).ne.8)) THEN 3936 length = length + 1 3937 END IF 3938 END IF 3939 END IF 3940 END IF !active 3941 END DO 3942 END DO 3943 END DO 3944 END DO 3945 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 3946 &set)) CALL ERRQUIT('eomccsdt_x3_8_1_2_1',0,MA_ERR) 3947 int_mb(k_a_offset) = length 3948 addr = 0 3949 size = 0 3950 DO h8b = 1,noab 3951 DO h11b = h8b,noab 3952 DO h1b = 1,noab 3953 DO p10b = noab+1,noab+nvab 3954 IF(acolo_1h(h1b)) THEN 3955 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+ 3956 &h1b-1)+int_mb(k_spin+p10b-1)) THEN 3957 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 3958 &(k_sym+h1b-1),int_mb(k_sym+p10b-1)))) .eq. irrep_v) THEN 3959 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 3960 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p10b-1).ne.8)) THEN 3961 addr = addr + 1 3962 int_mb(k_a_offset+addr) = p10b - noab - 1 + nvab * (h1b - 1 + noab 3963 & * (h11b - 1 + noab * (h8b - 1))) 3964 int_mb(k_a_offset+length+addr) = size 3965 size = size + int_mb(k_range+h8b-1) * int_mb(k_range+h11b-1) * int 3966 &_mb(k_range+h1b-1) * int_mb(k_range+p10b-1) 3967 END IF 3968 END IF 3969 END IF 3970 END IF !active 3971 END DO 3972 END DO 3973 END DO 3974 END DO 3975 RETURN 3976 END 3977 SUBROUTINE OFFSET_eomccsdt_x3a_8_1(l_a_offset,k_a_offset,size) 3978C $Id$ 3979C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 3980C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 3981C i1 ( h11 p4 p5 h1 h2 h3 )_vx 3982 IMPLICIT NONE 3983#include "global.fh" 3984#include "mafdecls.fh" 3985#include "sym.fh" 3986#include "errquit.fh" 3987#include "tce.fh" 3988 INTEGER l_a_offset 3989 INTEGER k_a_offset 3990 INTEGER size 3991 INTEGER length 3992 INTEGER addr 3993 INTEGER p4b 3994 INTEGER p5b 3995 INTEGER h11b 3996 INTEGER h1b 3997 INTEGER h2b 3998 INTEGER h3b 3999 LOGICAL ACOLO_O_2P 4000 length = 0 4001 DO p4b = noab+1,noab+nvab 4002 DO p5b = p4b,noab+nvab 4003 DO h11b = 1,noab 4004 DO h1b = 1,noab 4005 DO h2b = h1b,noab 4006 DO h3b = h2b,noab 4007 IF(acolo_o_2p(p4b,p5b,h1b,h2b,h3b)) THEN 4008 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+p5b-1 4009 &) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3b 4010 &-1)) THEN 4011 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 4012 &(k_sym+p5b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),in 4013 &t_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_v,irrep_x)) THEN 4014 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 4015 &1)+int_mb(k_spin+p5b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+ 4016 &int_mb(k_spin+h3b-1).ne.12)) THEN 4017 length = length + 1 4018 END IF 4019 END IF 4020 END IF 4021 END IF !active 4022 END DO 4023 END DO 4024 END DO 4025 END DO 4026 END DO 4027 END DO 4028 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 4029 &set)) CALL ERRQUIT('eomccsdt_x3_8_1',0,MA_ERR) 4030 int_mb(k_a_offset) = length 4031 addr = 0 4032 size = 0 4033 DO p4b = noab+1,noab+nvab 4034 DO p5b = p4b,noab+nvab 4035 DO h11b = 1,noab 4036 DO h1b = 1,noab 4037 DO h2b = h1b,noab 4038 DO h3b = h2b,noab 4039 IF(acolo_o_2p(p4b,p5b,h1b,h2b,h3b)) THEN 4040 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+p5b-1 4041 &) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3b 4042 &-1)) THEN 4043 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 4044 &(k_sym+p5b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),in 4045 &t_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_v,irrep_x)) THEN 4046 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 4047 &1)+int_mb(k_spin+p5b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+ 4048 &int_mb(k_spin+h3b-1).ne.12)) THEN 4049 addr = addr + 1 4050 int_mb(k_a_offset+addr) = h3b - 1 + noab * (h2b - 1 + noab * (h1b 4051 &- 1 + noab * (h11b - 1 + noab * (p5b - noab - 1 + nvab * (p4b - no 4052 &ab - 1))))) 4053 int_mb(k_a_offset+length+addr) = size 4054 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+p5b-1) * int_ 4055 &mb(k_range+h11b-1) * int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) 4056 & * int_mb(k_range+h3b-1) 4057 END IF 4058 END IF 4059 END IF 4060 END IF !active 4061 END DO 4062 END DO 4063 END DO 4064 END DO 4065 END DO 4066 END DO 4067 RETURN 4068 END 4069 SUBROUTINE OFFSET_eomccsdt_x3a_8_2_1(l_a_offset,k_a_offset,size) 4070C $Id$ 4071C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 4072C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 4073C i2 ( h11 p7 )_f 4074 IMPLICIT NONE 4075#include "global.fh" 4076#include "mafdecls.fh" 4077#include "sym.fh" 4078#include "errquit.fh" 4079#include "tce.fh" 4080 INTEGER l_a_offset 4081 INTEGER k_a_offset 4082 INTEGER size 4083 INTEGER length 4084 INTEGER addr 4085 INTEGER h11b 4086 INTEGER p7b 4087 LOGICAL ACOLO_1P 4088 length = 0 4089 DO h11b = 1,noab 4090 DO p7b = noab+1,noab+nvab 4091 IF(acolo_1p(p7b)) THEN 4092 IF (int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+p7b-1)) THEN 4093 IF (ieor(int_mb(k_sym+h11b-1),int_mb(k_sym+p7b-1)) .eq. irrep_f) T 4094 &HEN 4095 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p7b- 4096 &1).ne.4)) THEN 4097 length = length + 1 4098 END IF 4099 END IF 4100 END IF 4101 END IF !active 4102 END DO 4103 END DO 4104 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 4105 &set)) CALL ERRQUIT('eomccsdt_x3_8_2_1',0,MA_ERR) 4106 int_mb(k_a_offset) = length 4107 addr = 0 4108 size = 0 4109 DO h11b = 1,noab 4110 DO p7b = noab+1,noab+nvab 4111 IF(acolo_1p(p7b)) THEN 4112 IF (int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+p7b-1)) THEN 4113 IF (ieor(int_mb(k_sym+h11b-1),int_mb(k_sym+p7b-1)) .eq. irrep_f) T 4114 &HEN 4115 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p7b- 4116 &1).ne.4)) THEN 4117 addr = addr + 1 4118 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h11b - 1) 4119 int_mb(k_a_offset+length+addr) = size 4120 size = size + int_mb(k_range+h11b-1) * int_mb(k_range+p7b-1) 4121 END IF 4122 END IF 4123 END IF 4124 END IF !active 4125 END DO 4126 END DO 4127 RETURN 4128 END 4129 SUBROUTINE OFFSET_eomccsdt_x3a_8_3_1(l_a_offset,k_a_offset,size) 4130C $Id$ 4131C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 4132C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 4133C i2 ( h10 h11 h1 p7 )_v 4134 IMPLICIT NONE 4135#include "global.fh" 4136#include "mafdecls.fh" 4137#include "sym.fh" 4138#include "errquit.fh" 4139#include "tce.fh" 4140 INTEGER l_a_offset 4141 INTEGER k_a_offset 4142 INTEGER size 4143 INTEGER length 4144 INTEGER addr 4145 INTEGER h10b 4146 INTEGER h11b 4147 INTEGER h1b 4148 INTEGER p7b 4149 LOGICAL ACOLO_1P,ACOLO_1H,ACOLO_1A_2H 4150 length = 0 4151 DO h10b = 1,noab 4152 DO h11b = h10b,noab 4153 DO h1b = 1,noab 4154 DO p7b = noab+1,noab+nvab 4155 IF(acolo_1p(p7b).AND.acolo_1h(h1b).AND.acolo_1a_2h(h10b,h11b)) 4156 & THEN 4157 IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin 4158 &+h1b-1)+int_mb(k_spin+p7b-1)) THEN 4159 IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m 4160 &b(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 4161 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b 4162 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 4163 length = length + 1 4164 END IF 4165 END IF 4166 END IF 4167 END IF !active 4168 END DO 4169 END DO 4170 END DO 4171 END DO 4172 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 4173 &set)) CALL ERRQUIT('eomccsdt_x3_8_3_1',0,MA_ERR) 4174 int_mb(k_a_offset) = length 4175 addr = 0 4176 size = 0 4177 DO h10b = 1,noab 4178 DO h11b = h10b,noab 4179 DO h1b = 1,noab 4180 DO p7b = noab+1,noab+nvab 4181 IF(acolo_1p(p7b).AND.acolo_1h(h1b).AND.acolo_1a_2h(h10b,h11b)) 4182 & THEN 4183 IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin 4184 &+h1b-1)+int_mb(k_spin+p7b-1)) THEN 4185 IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m 4186 &b(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 4187 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b 4188 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 4189 addr = addr + 1 4190 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 4191 &* (h11b - 1 + noab * (h10b - 1))) 4192 int_mb(k_a_offset+length+addr) = size 4193 size = size + int_mb(k_range+h10b-1) * int_mb(k_range+h11b-1) * in 4194 &t_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 4195 END IF 4196 END IF 4197 END IF 4198 END IF !active 4199 END DO 4200 END DO 4201 END DO 4202 END DO 4203 RETURN 4204 END 4205 SUBROUTINE OFFSET_eomccsdt_x3a_8_5_1(l_a_offset,k_a_offset,size) 4206C $Id$ 4207C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 4208C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 4209C i2 ( h8 h11 p4 h1 h2 h3 )_vx 4210 IMPLICIT NONE 4211#include "global.fh" 4212#include "mafdecls.fh" 4213#include "sym.fh" 4214#include "errquit.fh" 4215#include "tce.fh" 4216 INTEGER l_a_offset 4217 INTEGER k_a_offset 4218 INTEGER size 4219 INTEGER length 4220 INTEGER addr 4221 INTEGER p4b 4222 INTEGER h8b 4223 INTEGER h11b 4224 INTEGER h1b 4225 INTEGER h2b 4226 INTEGER h3b 4227 LOGICAL ACOLO_O_1P 4228 length = 0 4229 DO p4b = noab+1,noab+nvab 4230 DO h8b = 1,noab 4231 DO h11b = h8b,noab 4232 DO h1b = 1,noab 4233 DO h2b = h1b,noab 4234 DO h3b = h2b,noab 4235 IF(acolo_o_1p(p4b,h1b,h2b,h3b)) THEN 4236 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1 4237 &) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3b 4238 &-1)) THEN 4239 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 4240 &(k_sym+p4b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),in 4241 &t_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_v,irrep_x)) THEN 4242 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 4243 &1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+ 4244 &int_mb(k_spin+h3b-1).ne.12)) THEN 4245 length = length + 1 4246 END IF 4247 END IF 4248 END IF 4249 END IF !active 4250 END DO 4251 END DO 4252 END DO 4253 END DO 4254 END DO 4255 END DO 4256 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 4257 &set)) CALL ERRQUIT('eomccsdt_x3_8_5_1',0,MA_ERR) 4258 int_mb(k_a_offset) = length 4259 addr = 0 4260 size = 0 4261 DO p4b = noab+1,noab+nvab 4262 DO h8b = 1,noab 4263 DO h11b = h8b,noab 4264 DO h1b = 1,noab 4265 DO h2b = h1b,noab 4266 DO h3b = h2b,noab 4267 IF(acolo_o_1p(p4b,h1b,h2b,h3b)) THEN 4268 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1 4269 &) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3b 4270 &-1)) THEN 4271 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 4272 &(k_sym+p4b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),in 4273 &t_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_v,irrep_x)) THEN 4274 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 4275 &1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+ 4276 &int_mb(k_spin+h3b-1).ne.12)) THEN 4277 addr = addr + 1 4278 int_mb(k_a_offset+addr) = h3b - 1 + noab * (h2b - 1 + noab * (h1b 4279 &- 1 + noab * (h11b - 1 + noab * (h8b - 1 + noab * (p4b - noab - 1) 4280 &)))) 4281 int_mb(k_a_offset+length+addr) = size 4282 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h8b-1) * int_ 4283 &mb(k_range+h11b-1) * int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) 4284 & * int_mb(k_range+h3b-1) 4285 END IF 4286 END IF 4287 END IF 4288 END IF !active 4289 END DO 4290 END DO 4291 END DO 4292 END DO 4293 END DO 4294 END DO 4295 RETURN 4296 END 4297 SUBROUTINE OFFSET_eomccsdt_x3a_8_6_1(l_a_offset,k_a_offset,size) 4298C $Id$ 4299C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 4300C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 4301C i2 ( h11 p4 h1 p7 )_vx 4302 IMPLICIT NONE 4303#include "global.fh" 4304#include "mafdecls.fh" 4305#include "sym.fh" 4306#include "errquit.fh" 4307#include "tce.fh" 4308 INTEGER l_a_offset 4309 INTEGER k_a_offset 4310 INTEGER size 4311 INTEGER length 4312 INTEGER addr 4313 INTEGER p4b 4314 INTEGER h11b 4315 INTEGER h1b 4316 INTEGER p7b 4317 LOGICAL ACOLO_1P,ACOLO_1H 4318 length = 0 4319 DO p4b = noab+1,noab+nvab 4320 DO h11b = 1,noab 4321 DO h1b = 1,noab 4322 DO p7b = noab+1,noab+nvab 4323 IF(acolo_1p(p4b).AND.acolo_1h(h1b)) THEN 4324 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 4325 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 4326 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 4327 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_x)) T 4328 &HEN 4329 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 4330 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 4331 length = length + 1 4332 END IF 4333 END IF 4334 END IF 4335 END IF !active 4336 END DO 4337 END DO 4338 END DO 4339 END DO 4340 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 4341 &set)) CALL ERRQUIT('eomccsdt_x3_8_6_1',0,MA_ERR) 4342 int_mb(k_a_offset) = length 4343 addr = 0 4344 size = 0 4345 DO p4b = noab+1,noab+nvab 4346 DO h11b = 1,noab 4347 DO h1b = 1,noab 4348 DO p7b = noab+1,noab+nvab 4349 IF(acolo_1p(p4b).AND.acolo_1h(h1b)) THEN 4350 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 4351 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 4352 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 4353 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_x)) T 4354 &HEN 4355 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 4356 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 4357 addr = addr + 1 4358 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 4359 &* (h11b - 1 + noab * (p4b - noab - 1))) 4360 int_mb(k_a_offset+length+addr) = size 4361 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h11b-1) * int 4362 &_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 4363 END IF 4364 END IF 4365 END IF 4366 END IF !active 4367 END DO 4368 END DO 4369 END DO 4370 END DO 4371 RETURN 4372 END 4373 SUBROUTINE OFFSET_eomccsdt_x3a_8_6_3_1(l_a_offset,k_a_offset,size) 4374C $Id$ 4375C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 4376C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 4377C i3 ( h10 h11 h1 p7 )_vt 4378 IMPLICIT NONE 4379#include "global.fh" 4380#include "mafdecls.fh" 4381#include "sym.fh" 4382#include "errquit.fh" 4383#include "tce.fh" 4384 INTEGER l_a_offset 4385 INTEGER k_a_offset 4386 INTEGER size 4387 INTEGER length 4388 INTEGER addr 4389 INTEGER h10b 4390 INTEGER h11b 4391 INTEGER h1b 4392 INTEGER p7b 4393 LOGICAL ACOLO_1H 4394 length = 0 4395 DO h10b = 1,noab 4396 DO h11b = h10b,noab 4397 DO h1b = 1,noab 4398 DO p7b = noab+1,noab+nvab 4399 IF(acolo_1h(h1b)) THEN 4400 IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin 4401 &+h1b-1)+int_mb(k_spin+p7b-1)) THEN 4402 IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m 4403 &b(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_t)) 4404 &THEN 4405 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b 4406 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 4407 length = length + 1 4408 END IF 4409 END IF 4410 END IF 4411 END IF !active 4412 END DO 4413 END DO 4414 END DO 4415 END DO 4416 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 4417 &set)) CALL ERRQUIT('eomccsdt_x3_8_6_3_1',0,MA_ERR) 4418 int_mb(k_a_offset) = length 4419 addr = 0 4420 size = 0 4421 DO h10b = 1,noab 4422 DO h11b = h10b,noab 4423 DO h1b = 1,noab 4424 DO p7b = noab+1,noab+nvab 4425 IF(acolo_1h(h1b)) THEN 4426 IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin 4427 &+h1b-1)+int_mb(k_spin+p7b-1)) THEN 4428 IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m 4429 &b(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_t)) 4430 &THEN 4431 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b 4432 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 4433 addr = addr + 1 4434 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 4435 &* (h11b - 1 + noab * (h10b - 1))) 4436 int_mb(k_a_offset+length+addr) = size 4437 size = size + int_mb(k_range+h10b-1) * int_mb(k_range+h11b-1) * in 4438 &t_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 4439 END IF 4440 END IF 4441 END IF 4442 END IF !active 4443 END DO 4444 END DO 4445 END DO 4446 END DO 4447 RETURN 4448 END 4449 SUBROUTINE OFFSET_eomccsdt_x3a_8_6_4_1(l_a_offset,k_a_offset,size) 4450C $Id$ 4451C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 4452C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 4453C i3 ( h8 h11 h1 p7 )_vx 4454 IMPLICIT NONE 4455#include "global.fh" 4456#include "mafdecls.fh" 4457#include "sym.fh" 4458#include "errquit.fh" 4459#include "tce.fh" 4460 INTEGER l_a_offset 4461 INTEGER k_a_offset 4462 INTEGER size 4463 INTEGER length 4464 INTEGER addr 4465 INTEGER h8b 4466 INTEGER h11b 4467 INTEGER h1b 4468 INTEGER p7b 4469 LOGICAL ACOLO_1H 4470 length = 0 4471 DO h8b = 1,noab 4472 DO h11b = h8b,noab 4473 DO h1b = 1,noab 4474 DO p7b = noab+1,noab+nvab 4475 IF(acolo_1h(h1b)) THEN 4476 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+ 4477 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 4478 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 4479 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_x)) T 4480 &HEN 4481 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 4482 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 4483 length = length + 1 4484 END IF 4485 END IF 4486 END IF 4487 END IF !active 4488 END DO 4489 END DO 4490 END DO 4491 END DO 4492 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 4493 &set)) CALL ERRQUIT('eomccsdt_x3_8_6_4_1',0,MA_ERR) 4494 int_mb(k_a_offset) = length 4495 addr = 0 4496 size = 0 4497 DO h8b = 1,noab 4498 DO h11b = h8b,noab 4499 DO h1b = 1,noab 4500 DO p7b = noab+1,noab+nvab 4501 IF(acolo_1h(h1b)) THEN 4502 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+ 4503 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 4504 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 4505 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_x)) T 4506 &HEN 4507 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 4508 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 4509 addr = addr + 1 4510 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 4511 &* (h11b - 1 + noab * (h8b - 1))) 4512 int_mb(k_a_offset+length+addr) = size 4513 size = size + int_mb(k_range+h8b-1) * int_mb(k_range+h11b-1) * int 4514 &_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 4515 END IF 4516 END IF 4517 END IF 4518 END IF !active 4519 END DO 4520 END DO 4521 END DO 4522 END DO 4523 RETURN 4524 END 4525 SUBROUTINE OFFSET_eomccsdt_x3a_8_7_1(l_a_offset,k_a_offset,size) 4526C $Id$ 4527C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 4528C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 4529C i2 ( h11 p7 )_vx 4530 IMPLICIT NONE 4531#include "global.fh" 4532#include "mafdecls.fh" 4533#include "sym.fh" 4534#include "errquit.fh" 4535#include "tce.fh" 4536 INTEGER l_a_offset 4537 INTEGER k_a_offset 4538 INTEGER size 4539 INTEGER length 4540 INTEGER addr 4541 INTEGER h11b 4542 INTEGER p7b 4543 LOGICAL ACOLO_1P 4544 length = 0 4545 DO h11b = 1,noab 4546 DO p7b = noab+1,noab+nvab 4547 IF(acolo_1p(p7b)) THEN 4548 IF (int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+p7b-1)) THEN 4549 IF (ieor(int_mb(k_sym+h11b-1),int_mb(k_sym+p7b-1)) .eq. ieor(irrep 4550 &_v,irrep_x)) THEN 4551 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p7b- 4552 &1).ne.4)) THEN 4553 length = length + 1 4554 END IF 4555 END IF 4556 END IF 4557 END IF !active 4558 END DO 4559 END DO 4560 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 4561 &set)) CALL ERRQUIT('eomccsdt_x3_8_7_1',0,MA_ERR) 4562 int_mb(k_a_offset) = length 4563 addr = 0 4564 size = 0 4565 DO h11b = 1,noab 4566 DO p7b = noab+1,noab+nvab 4567 IF(acolo_1p(p7b)) THEN 4568 IF (int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+p7b-1)) THEN 4569 IF (ieor(int_mb(k_sym+h11b-1),int_mb(k_sym+p7b-1)) .eq. ieor(irrep 4570 &_v,irrep_x)) THEN 4571 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+p7b- 4572 &1).ne.4)) THEN 4573 addr = addr + 1 4574 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h11b - 1) 4575 int_mb(k_a_offset+length+addr) = size 4576 size = size + int_mb(k_range+h11b-1) * int_mb(k_range+p7b-1) 4577 END IF 4578 END IF 4579 END IF 4580 END IF !active 4581 END DO 4582 END DO 4583 RETURN 4584 END 4585 SUBROUTINE OFFSET_eomccsdt_x3a_8_8_1(l_a_offset,k_a_offset,size) 4586C $Id$ 4587C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 4588C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 4589C i2 ( h10 h11 p4 h1 h2 h3 )_vt 4590 IMPLICIT NONE 4591#include "global.fh" 4592#include "mafdecls.fh" 4593#include "sym.fh" 4594#include "errquit.fh" 4595#include "tce.fh" 4596 INTEGER l_a_offset 4597 INTEGER k_a_offset 4598 INTEGER size 4599 INTEGER length 4600 INTEGER addr 4601 INTEGER p4b 4602 INTEGER h10b 4603 INTEGER h11b 4604 INTEGER h1b 4605 INTEGER h2b 4606 INTEGER h3b 4607 LOGICAL ACOLO_O_1P 4608 length = 0 4609 DO p4b = noab+1,noab+nvab 4610 DO h10b = 1,noab 4611 DO h11b = h10b,noab 4612 DO h1b = 1,noab 4613 DO h2b = h1b,noab 4614 DO h3b = h2b,noab 4615 IF(acolo_o_1p(p4b,h1b,h2b,h3b)) THEN 4616 IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 4617 &1) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3 4618 &b-1)) THEN 4619 IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m 4620 &b(k_sym+p4b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),i 4621 &nt_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_v,irrep_t)) THEN 4622 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b 4623 &-1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1) 4624 &+int_mb(k_spin+h3b-1).ne.12)) THEN 4625 length = length + 1 4626 END IF 4627 END IF 4628 END IF 4629 END IF !active 4630 END DO 4631 END DO 4632 END DO 4633 END DO 4634 END DO 4635 END DO 4636 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 4637 &set)) CALL ERRQUIT('eomccsdt_x3_8_8_1',0,MA_ERR) 4638 int_mb(k_a_offset) = length 4639 addr = 0 4640 size = 0 4641 DO p4b = noab+1,noab+nvab 4642 DO h10b = 1,noab 4643 DO h11b = h10b,noab 4644 DO h1b = 1,noab 4645 DO h2b = h1b,noab 4646 DO h3b = h2b,noab 4647 IF(acolo_o_1p(p4b,h1b,h2b,h3b)) THEN 4648 IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b-1)+int_mb(k_spin+p4b- 4649 &1) .eq. int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1)+int_mb(k_spin+h3 4650 &b-1)) THEN 4651 IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_m 4652 &b(k_sym+p4b-1),ieor(int_mb(k_sym+h1b-1),ieor(int_mb(k_sym+h2b-1),i 4653 &nt_mb(k_sym+h3b-1)))))) .eq. ieor(irrep_v,irrep_t)) THEN 4654 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h11b 4655 &-1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1) 4656 &+int_mb(k_spin+h3b-1).ne.12)) THEN 4657 addr = addr + 1 4658 int_mb(k_a_offset+addr) = h3b - 1 + noab * (h2b - 1 + noab * (h1b 4659 &- 1 + noab * (h11b - 1 + noab * (h10b - 1 + noab * (p4b - noab - 1 4660 &))))) 4661 int_mb(k_a_offset+length+addr) = size 4662 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h10b-1) * int 4663 &_mb(k_range+h11b-1) * int_mb(k_range+h1b-1) * int_mb(k_range+h2b-1 4664 &) * int_mb(k_range+h3b-1) 4665 END IF 4666 END IF 4667 END IF 4668 END IF !active 4669 END DO 4670 END DO 4671 END DO 4672 END DO 4673 END DO 4674 END DO 4675 RETURN 4676 END 4677 SUBROUTINE OFFSET_eomccsdt_x3a_8_9_1(l_a_offset,k_a_offset,size) 4678C $Id$ 4679C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 4680C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 4681C i2 ( h8 h11 h1 p7 )_vx 4682 IMPLICIT NONE 4683#include "global.fh" 4684#include "mafdecls.fh" 4685#include "sym.fh" 4686#include "errquit.fh" 4687#include "tce.fh" 4688 INTEGER l_a_offset 4689 INTEGER k_a_offset 4690 INTEGER size 4691 INTEGER length 4692 INTEGER addr 4693 INTEGER h8b 4694 INTEGER h11b 4695 INTEGER h1b 4696 INTEGER p7b 4697 LOGICAL ACOLO_1P,ACOLO_1H,ACOLO_1A_2H 4698 length = 0 4699 DO h8b = 1,noab 4700 DO h11b = h8b,noab 4701 DO h1b = 1,noab 4702 DO p7b = noab+1,noab+nvab 4703 IF(acolo_1p(p7b).AND.acolo_1h(h1b).AND.acolo_1a_2h(h8b,h11b)) THEN 4704 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+ 4705 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 4706 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 4707 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_x)) T 4708 &HEN 4709 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 4710 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 4711 length = length + 1 4712 END IF 4713 END IF 4714 END IF 4715 END IF !active 4716 END DO 4717 END DO 4718 END DO 4719 END DO 4720 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 4721 &set)) CALL ERRQUIT('eomccsdt_x3_8_9_1',0,MA_ERR) 4722 int_mb(k_a_offset) = length 4723 addr = 0 4724 size = 0 4725 DO h8b = 1,noab 4726 DO h11b = h8b,noab 4727 DO h1b = 1,noab 4728 DO p7b = noab+1,noab+nvab 4729 IF(acolo_1p(p7b).AND.acolo_1h(h1b).AND.acolo_1a_2h(h8b,h11b)) THEN 4730 IF (int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+ 4731 &h1b-1)+int_mb(k_spin+p7b-1)) THEN 4732 IF (ieor(int_mb(k_sym+h8b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 4733 &(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_v,irrep_x)) T 4734 &HEN 4735 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h11b- 4736 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 4737 addr = addr + 1 4738 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 4739 &* (h11b - 1 + noab * (h8b - 1))) 4740 int_mb(k_a_offset+length+addr) = size 4741 size = size + int_mb(k_range+h8b-1) * int_mb(k_range+h11b-1) * int 4742 &_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 4743 END IF 4744 END IF 4745 END IF 4746 END IF !active 4747 END DO 4748 END DO 4749 END DO 4750 END DO 4751 RETURN 4752 END 4753 SUBROUTINE OFFSET_eomccsdt_x3a_9_10_1(l_a_offset,k_a_offset,size) 4754C $Id$ 4755C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 4756C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 4757C i2 ( h9 h12 h1 p8 )_vx 4758 IMPLICIT NONE 4759#include "global.fh" 4760#include "mafdecls.fh" 4761#include "sym.fh" 4762#include "errquit.fh" 4763#include "tce.fh" 4764 INTEGER l_a_offset 4765 INTEGER k_a_offset 4766 INTEGER size 4767 INTEGER length 4768 INTEGER addr 4769 INTEGER h9b 4770 INTEGER h12b 4771 INTEGER h1b 4772 INTEGER p8b 4773 LOGICAL ACOLO_1H 4774 length = 0 4775 DO h9b = 1,noab 4776 DO h12b = h9b,noab 4777 DO h1b = 1,noab 4778 DO p8b = noab+1,noab+nvab 4779 IF(acolo_1h(h1b)) THEN 4780 IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin+ 4781 &h1b-1)+int_mb(k_spin+p8b-1)) THEN 4782 IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_mb 4783 &(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_v,irrep_x)) T 4784 &HEN 4785 IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h12b- 4786 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 4787 length = length + 1 4788 END IF 4789 END IF 4790 END IF 4791 END IF !active 4792 END DO 4793 END DO 4794 END DO 4795 END DO 4796 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 4797 &set)) CALL ERRQUIT('eomccsdt_x3_9_10_1',0,MA_ERR) 4798 int_mb(k_a_offset) = length 4799 addr = 0 4800 size = 0 4801 DO h9b = 1,noab 4802 DO h12b = h9b,noab 4803 DO h1b = 1,noab 4804 DO p8b = noab+1,noab+nvab 4805 IF(acolo_1h(h1b)) THEN 4806 IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin+ 4807 &h1b-1)+int_mb(k_spin+p8b-1)) THEN 4808 IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_mb 4809 &(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_v,irrep_x)) T 4810 &HEN 4811 IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h12b- 4812 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 4813 addr = addr + 1 4814 int_mb(k_a_offset+addr) = p8b - noab - 1 + nvab * (h1b - 1 + noab 4815 &* (h12b - 1 + noab * (h9b - 1))) 4816 int_mb(k_a_offset+length+addr) = size 4817 size = size + int_mb(k_range+h9b-1) * int_mb(k_range+h12b-1) * int 4818 &_mb(k_range+h1b-1) * int_mb(k_range+p8b-1) 4819 END IF 4820 END IF 4821 END IF 4822 END IF !active 4823 END DO 4824 END DO 4825 END DO 4826 END DO 4827 RETURN 4828 END 4829 SUBROUTINE OFFSET_eomccsdt_x3a_9_1_1(l_a_offset,k_a_offset,size) 4830C $Id$ 4831C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 4832C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 4833C i2 ( h12 h13 h1 h2 )_v 4834 IMPLICIT NONE 4835#include "global.fh" 4836#include "mafdecls.fh" 4837#include "sym.fh" 4838#include "errquit.fh" 4839#include "tce.fh" 4840 INTEGER l_a_offset 4841 INTEGER k_a_offset 4842 INTEGER size 4843 INTEGER length 4844 INTEGER addr 4845 INTEGER h12b 4846 INTEGER h13b 4847 INTEGER h1b 4848 INTEGER h2b 4849 LOGICAL ACOLO_2H 4850 length = 0 4851 DO h12b = 1,noab 4852 DO h13b = h12b,noab 4853 DO h1b = 1,noab 4854 DO h2b = h1b,noab 4855 IF(acolo_2h(h1b,h2b)) THEN 4856 IF (int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b-1) .eq. int_mb(k_spin 4857 &+h1b-1)+int_mb(k_spin+h2b-1)) THEN 4858 IF (ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+h13b-1),ieor(int_m 4859 &b(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN 4860 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b 4861 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 4862 length = length + 1 4863 END IF 4864 END IF 4865 END IF 4866 END IF !active 4867 END DO 4868 END DO 4869 END DO 4870 END DO 4871 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 4872 &set)) CALL ERRQUIT('eomccsdt_x3_9_1_1',0,MA_ERR) 4873 int_mb(k_a_offset) = length 4874 addr = 0 4875 size = 0 4876 DO h12b = 1,noab 4877 DO h13b = h12b,noab 4878 DO h1b = 1,noab 4879 DO h2b = h1b,noab 4880 IF(acolo_2h(h1b,h2b)) THEN 4881 IF (int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b-1) .eq. int_mb(k_spin 4882 &+h1b-1)+int_mb(k_spin+h2b-1)) THEN 4883 IF (ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+h13b-1),ieor(int_m 4884 &b(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. irrep_v) THEN 4885 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b 4886 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 4887 addr = addr + 1 4888 int_mb(k_a_offset+addr) = h2b - 1 + noab * (h1b - 1 + noab * (h13b 4889 & - 1 + noab * (h12b - 1))) 4890 int_mb(k_a_offset+length+addr) = size 4891 size = size + int_mb(k_range+h12b-1) * int_mb(k_range+h13b-1) * in 4892 &t_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) 4893 END IF 4894 END IF 4895 END IF 4896 END IF !active 4897 END DO 4898 END DO 4899 END DO 4900 END DO 4901 RETURN 4902 END 4903 SUBROUTINE OFFSET_eomccsdt_x3a_9_1_2_1(l_a_offset,k_a_offset,size) 4904C $Id$ 4905C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 4906C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 4907C i3 ( h12 h13 h1 p9 )_v 4908 IMPLICIT NONE 4909#include "global.fh" 4910#include "mafdecls.fh" 4911#include "sym.fh" 4912#include "errquit.fh" 4913#include "tce.fh" 4914 INTEGER l_a_offset 4915 INTEGER k_a_offset 4916 INTEGER size 4917 INTEGER length 4918 INTEGER addr 4919 INTEGER h12b 4920 INTEGER h13b 4921 INTEGER h1b 4922 INTEGER p9b 4923 LOGICAL ACOLO_1H 4924 length = 0 4925 DO h12b = 1,noab 4926 DO h13b = h12b,noab 4927 DO h1b = 1,noab 4928 DO p9b = noab+1,noab+nvab 4929 IF(acolo_1h(h1b)) THEN 4930 IF (int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b-1) .eq. int_mb(k_spin 4931 &+h1b-1)+int_mb(k_spin+p9b-1)) THEN 4932 IF (ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+h13b-1),ieor(int_m 4933 &b(k_sym+h1b-1),int_mb(k_sym+p9b-1)))) .eq. irrep_v) THEN 4934 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b 4935 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p9b-1).ne.8)) THEN 4936 length = length + 1 4937 END IF 4938 END IF 4939 END IF 4940 END IF !active 4941 END DO 4942 END DO 4943 END DO 4944 END DO 4945 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 4946 &set)) CALL ERRQUIT('eomccsdt_x3_9_1_2_1',0,MA_ERR) 4947 int_mb(k_a_offset) = length 4948 addr = 0 4949 size = 0 4950 DO h12b = 1,noab 4951 DO h13b = h12b,noab 4952 DO h1b = 1,noab 4953 DO p9b = noab+1,noab+nvab 4954 IF(acolo_1h(h1b)) THEN 4955 IF (int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b-1) .eq. int_mb(k_spin 4956 &+h1b-1)+int_mb(k_spin+p9b-1)) THEN 4957 IF (ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+h13b-1),ieor(int_m 4958 &b(k_sym+h1b-1),int_mb(k_sym+p9b-1)))) .eq. irrep_v) THEN 4959 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b 4960 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p9b-1).ne.8)) THEN 4961 addr = addr + 1 4962 int_mb(k_a_offset+addr) = p9b - noab - 1 + nvab * (h1b - 1 + noab 4963 &* (h13b - 1 + noab * (h12b - 1))) 4964 int_mb(k_a_offset+length+addr) = size 4965 size = size + int_mb(k_range+h12b-1) * int_mb(k_range+h13b-1) * in 4966 &t_mb(k_range+h1b-1) * int_mb(k_range+p9b-1) 4967 END IF 4968 END IF 4969 END IF 4970 END IF !active 4971 END DO 4972 END DO 4973 END DO 4974 END DO 4975 RETURN 4976 END 4977 SUBROUTINE OFFSET_eomccsdt_x3a_9_1(l_a_offset,k_a_offset,size) 4978C $Id$ 4979C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 4980C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 4981C i1 ( h12 p4 h1 h2 )_vx 4982 IMPLICIT NONE 4983#include "global.fh" 4984#include "mafdecls.fh" 4985#include "sym.fh" 4986#include "errquit.fh" 4987#include "tce.fh" 4988 INTEGER l_a_offset 4989 INTEGER k_a_offset 4990 INTEGER size 4991 INTEGER length 4992 INTEGER addr 4993 INTEGER p4b 4994 INTEGER h12b 4995 INTEGER h1b 4996 INTEGER h2b 4997 LOGICAL ACOLO_1P_2H 4998 length = 0 4999 DO p4b = noab+1,noab+nvab 5000 DO h12b = 1,noab 5001 DO h1b = 1,noab 5002 DO h2b = h1b,noab 5003 IF(acolo_1p_2h(p4b,h1b,h2b)) THEN 5004 IF (int_mb(k_spin+h12b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 5005 &h1b-1)+int_mb(k_spin+h2b-1)) THEN 5006 IF (ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 5007 &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_x)) T 5008 &HEN 5009 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+p4b- 5010 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 5011 length = length + 1 5012 END IF 5013 END IF 5014 END IF 5015 END IF !active 5016 END DO 5017 END DO 5018 END DO 5019 END DO 5020 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 5021 &set)) CALL ERRQUIT('eomccsdt_x3_9_1',0,MA_ERR) 5022 int_mb(k_a_offset) = length 5023 addr = 0 5024 size = 0 5025 DO p4b = noab+1,noab+nvab 5026 DO h12b = 1,noab 5027 DO h1b = 1,noab 5028 DO h2b = h1b,noab 5029 IF(acolo_1p_2h(p4b,h1b,h2b)) THEN 5030 IF (int_mb(k_spin+h12b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 5031 &h1b-1)+int_mb(k_spin+h2b-1)) THEN 5032 IF (ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 5033 &(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_x)) T 5034 &HEN 5035 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+p4b- 5036 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 5037 addr = addr + 1 5038 int_mb(k_a_offset+addr) = h2b - 1 + noab * (h1b - 1 + noab * (h12b 5039 & - 1 + noab * (p4b - noab - 1))) 5040 int_mb(k_a_offset+length+addr) = size 5041 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h12b-1) * int 5042 &_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) 5043 END IF 5044 END IF 5045 END IF 5046 END IF !active 5047 END DO 5048 END DO 5049 END DO 5050 END DO 5051 RETURN 5052 END 5053 SUBROUTINE OFFSET_eomccsdt_x3a_9_3_1(l_a_offset,k_a_offset,size) 5054C $Id$ 5055C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 5056C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 5057C i2 ( h12 p7 )_f 5058 IMPLICIT NONE 5059#include "global.fh" 5060#include "mafdecls.fh" 5061#include "sym.fh" 5062#include "errquit.fh" 5063#include "tce.fh" 5064 INTEGER l_a_offset 5065 INTEGER k_a_offset 5066 INTEGER size 5067 INTEGER length 5068 INTEGER addr 5069 INTEGER h12b 5070 INTEGER p7b 5071 length = 0 5072 DO h12b = 1,noab 5073 DO p7b = noab+1,noab+nvab 5074 IF (int_mb(k_spin+h12b-1) .eq. int_mb(k_spin+p7b-1)) THEN 5075 IF (ieor(int_mb(k_sym+h12b-1),int_mb(k_sym+p7b-1)) .eq. irrep_f) T 5076 &HEN 5077 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+p7b- 5078 &1).ne.4)) THEN 5079 length = length + 1 5080 END IF 5081 END IF 5082 END IF 5083 END DO 5084 END DO 5085 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 5086 &set)) CALL ERRQUIT('eomccsdt_x3_9_3_1',0,MA_ERR) 5087 int_mb(k_a_offset) = length 5088 addr = 0 5089 size = 0 5090 DO h12b = 1,noab 5091 DO p7b = noab+1,noab+nvab 5092 IF (int_mb(k_spin+h12b-1) .eq. int_mb(k_spin+p7b-1)) THEN 5093 IF (ieor(int_mb(k_sym+h12b-1),int_mb(k_sym+p7b-1)) .eq. irrep_f) T 5094 &HEN 5095 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+p7b- 5096 &1).ne.4)) THEN 5097 addr = addr + 1 5098 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h12b - 1) 5099 int_mb(k_a_offset+length+addr) = size 5100 size = size + int_mb(k_range+h12b-1) * int_mb(k_range+p7b-1) 5101 END IF 5102 END IF 5103 END IF 5104 END DO 5105 END DO 5106 RETURN 5107 END 5108 SUBROUTINE OFFSET_eomccsdt_x3a_9_4_1(l_a_offset,k_a_offset,size) 5109C $Id$ 5110C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 5111C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 5112C i2 ( h10 h12 h1 p7 )_v 5113 IMPLICIT NONE 5114#include "global.fh" 5115#include "mafdecls.fh" 5116#include "sym.fh" 5117#include "errquit.fh" 5118#include "tce.fh" 5119 INTEGER l_a_offset 5120 INTEGER k_a_offset 5121 INTEGER size 5122 INTEGER length 5123 INTEGER addr 5124 INTEGER h10b 5125 INTEGER h12b 5126 INTEGER h1b 5127 INTEGER p7b 5128 LOGICAL ACOLO_1H 5129 length = 0 5130 DO h10b = 1,noab 5131 DO h12b = h10b,noab 5132 DO h1b = 1,noab 5133 DO p7b = noab+1,noab+nvab 5134 IF(acolo_1h(h1b)) THEN 5135 IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 5136 &+h1b-1)+int_mb(k_spin+p7b-1)) THEN 5137 IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 5138 &b(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 5139 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h12b 5140 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 5141 length = length + 1 5142 END IF 5143 END IF 5144 END IF 5145 END IF !active 5146 END DO 5147 END DO 5148 END DO 5149 END DO 5150 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 5151 &set)) CALL ERRQUIT('eomccsdt_x3_9_4_1',0,MA_ERR) 5152 int_mb(k_a_offset) = length 5153 addr = 0 5154 size = 0 5155 DO h10b = 1,noab 5156 DO h12b = h10b,noab 5157 DO h1b = 1,noab 5158 DO p7b = noab+1,noab+nvab 5159 IF(acolo_1h(h1b)) THEN 5160 IF (int_mb(k_spin+h10b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 5161 &+h1b-1)+int_mb(k_spin+p7b-1)) THEN 5162 IF (ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 5163 &b(k_sym+h1b-1),int_mb(k_sym+p7b-1)))) .eq. irrep_v) THEN 5164 IF ((.not.restricted).or.(int_mb(k_spin+h10b-1)+int_mb(k_spin+h12b 5165 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 5166 addr = addr + 1 5167 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h1b - 1 + noab 5168 &* (h12b - 1 + noab * (h10b - 1))) 5169 int_mb(k_a_offset+length+addr) = size 5170 size = size + int_mb(k_range+h10b-1) * int_mb(k_range+h12b-1) * in 5171 &t_mb(k_range+h1b-1) * int_mb(k_range+p7b-1) 5172 END IF 5173 END IF 5174 END IF 5175 END IF !active 5176 END DO 5177 END DO 5178 END DO 5179 END DO 5180 RETURN 5181 END 5182 SUBROUTINE OFFSET_eomccsdt_x3a_9_7_1(l_a_offset,k_a_offset,size) 5183C $Id$ 5184C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 5185C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 5186C i2 ( h11 h12 h1 h2 )_vx 5187 IMPLICIT NONE 5188#include "global.fh" 5189#include "mafdecls.fh" 5190#include "sym.fh" 5191#include "errquit.fh" 5192#include "tce.fh" 5193 INTEGER l_a_offset 5194 INTEGER k_a_offset 5195 INTEGER size 5196 INTEGER length 5197 INTEGER addr 5198 INTEGER h11b 5199 INTEGER h12b 5200 INTEGER h1b 5201 INTEGER h2b 5202 LOGICAL ACOLO_2H 5203 length = 0 5204 DO h11b = 1,noab 5205 DO h12b = h11b,noab 5206 DO h1b = 1,noab 5207 DO h2b = h1b,noab 5208 IF(acolo_2h(h1b,h2b)) THEN 5209 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 5210 &+h1b-1)+int_mb(k_spin+h2b-1)) THEN 5211 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 5212 &b(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_x)) 5213 &THEN 5214 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 5215 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 5216 length = length + 1 5217 END IF 5218 END IF 5219 END IF 5220 END IF !active 5221 END DO 5222 END DO 5223 END DO 5224 END DO 5225 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 5226 &set)) CALL ERRQUIT('eomccsdt_x3_9_7_1',0,MA_ERR) 5227 int_mb(k_a_offset) = length 5228 addr = 0 5229 size = 0 5230 DO h11b = 1,noab 5231 DO h12b = h11b,noab 5232 DO h1b = 1,noab 5233 DO h2b = h1b,noab 5234 IF(acolo_2h(h1b,h2b)) THEN 5235 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 5236 &+h1b-1)+int_mb(k_spin+h2b-1)) THEN 5237 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 5238 &b(k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_v,irrep_x)) 5239 &THEN 5240 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 5241 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN 5242 addr = addr + 1 5243 int_mb(k_a_offset+addr) = h2b - 1 + noab * (h1b - 1 + noab * (h12b 5244 & - 1 + noab * (h11b - 1))) 5245 int_mb(k_a_offset+length+addr) = size 5246 size = size + int_mb(k_range+h11b-1) * int_mb(k_range+h12b-1) * in 5247 &t_mb(k_range+h1b-1) * int_mb(k_range+h2b-1) 5248 END IF 5249 END IF 5250 END IF 5251 END IF !active 5252 END DO 5253 END DO 5254 END DO 5255 END DO 5256 RETURN 5257 END 5258 SUBROUTINE OFFSET_eomccsdt_x3a_9_7_3_1(l_a_offset,k_a_offset,size) 5259C $Id$ 5260C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 5261C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 5262C i3 ( h11 h12 h1 p8 )_vx 5263 IMPLICIT NONE 5264#include "global.fh" 5265#include "mafdecls.fh" 5266#include "sym.fh" 5267#include "errquit.fh" 5268#include "tce.fh" 5269 INTEGER l_a_offset 5270 INTEGER k_a_offset 5271 INTEGER size 5272 INTEGER length 5273 INTEGER addr 5274 INTEGER h11b 5275 INTEGER h12b 5276 INTEGER h1b 5277 INTEGER p8b 5278 LOGICAL ACOLO_1H 5279 length = 0 5280 DO h11b = 1,noab 5281 DO h12b = h11b,noab 5282 DO h1b = 1,noab 5283 DO p8b = noab+1,noab+nvab 5284 IF(acolo_1h(h1b)) THEN 5285 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 5286 &+h1b-1)+int_mb(k_spin+p8b-1)) THEN 5287 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 5288 &b(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_v,irrep_x)) 5289 &THEN 5290 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 5291 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 5292 length = length + 1 5293 END IF 5294 END IF 5295 END IF 5296 END IF !active 5297 END DO 5298 END DO 5299 END DO 5300 END DO 5301 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 5302 &set)) CALL ERRQUIT('eomccsdt_x3_9_7_3_1',0,MA_ERR) 5303 int_mb(k_a_offset) = length 5304 addr = 0 5305 size = 0 5306 DO h11b = 1,noab 5307 DO h12b = h11b,noab 5308 DO h1b = 1,noab 5309 DO p8b = noab+1,noab+nvab 5310 IF(acolo_1h(h1b)) THEN 5311 IF (int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b-1) .eq. int_mb(k_spin 5312 &+h1b-1)+int_mb(k_spin+p8b-1)) THEN 5313 IF (ieor(int_mb(k_sym+h11b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_m 5314 &b(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_v,irrep_x)) 5315 &THEN 5316 IF ((.not.restricted).or.(int_mb(k_spin+h11b-1)+int_mb(k_spin+h12b 5317 &-1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 5318 addr = addr + 1 5319 int_mb(k_a_offset+addr) = p8b - noab - 1 + nvab * (h1b - 1 + noab 5320 &* (h12b - 1 + noab * (h11b - 1))) 5321 int_mb(k_a_offset+length+addr) = size 5322 size = size + int_mb(k_range+h11b-1) * int_mb(k_range+h12b-1) * in 5323 &t_mb(k_range+h1b-1) * int_mb(k_range+p8b-1) 5324 END IF 5325 END IF 5326 END IF 5327 END IF !active 5328 END DO 5329 END DO 5330 END DO 5331 END DO 5332 RETURN 5333 END 5334 SUBROUTINE OFFSET_eomccsdt_x3a_9_8_1(l_a_offset,k_a_offset,size) 5335C $Id$ 5336C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 5337C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 5338C i2 ( h12 p4 h1 p8 )_vx 5339 IMPLICIT NONE 5340#include "global.fh" 5341#include "mafdecls.fh" 5342#include "sym.fh" 5343#include "errquit.fh" 5344#include "tce.fh" 5345 INTEGER l_a_offset 5346 INTEGER k_a_offset 5347 INTEGER size 5348 INTEGER length 5349 INTEGER addr 5350 INTEGER p4b 5351 INTEGER h12b 5352 INTEGER h1b 5353 INTEGER p8b 5354 LOGICAL ACOLO_1P_1H 5355 length = 0 5356 DO p4b = noab+1,noab+nvab 5357 DO h12b = 1,noab 5358 DO h1b = 1,noab 5359 DO p8b = noab+1,noab+nvab 5360 IF(acolo_1p_1h(p4b,h1b)) THEN 5361 IF (int_mb(k_spin+h12b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 5362 &h1b-1)+int_mb(k_spin+p8b-1)) THEN 5363 IF (ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 5364 &(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_v,irrep_x)) T 5365 &HEN 5366 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+p4b- 5367 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 5368 length = length + 1 5369 END IF 5370 END IF 5371 END IF 5372 END IF !active 5373 END DO 5374 END DO 5375 END DO 5376 END DO 5377 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 5378 &set)) CALL ERRQUIT('eomccsdt_x3_9_8_1',0,MA_ERR) 5379 int_mb(k_a_offset) = length 5380 addr = 0 5381 size = 0 5382 DO p4b = noab+1,noab+nvab 5383 DO h12b = 1,noab 5384 DO h1b = 1,noab 5385 DO p8b = noab+1,noab+nvab 5386 IF(acolo_1p_1h(p4b,h1b)) THEN 5387 IF (int_mb(k_spin+h12b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+ 5388 &h1b-1)+int_mb(k_spin+p8b-1)) THEN 5389 IF (ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb 5390 &(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_v,irrep_x)) T 5391 &HEN 5392 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+p4b- 5393 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 5394 addr = addr + 1 5395 int_mb(k_a_offset+addr) = p8b - noab - 1 + nvab * (h1b - 1 + noab 5396 &* (h12b - 1 + noab * (p4b - noab - 1))) 5397 int_mb(k_a_offset+length+addr) = size 5398 size = size + int_mb(k_range+p4b-1) * int_mb(k_range+h12b-1) * int 5399 &_mb(k_range+h1b-1) * int_mb(k_range+p8b-1) 5400 END IF 5401 END IF 5402 END IF 5403 END IF !active 5404 END DO 5405 END DO 5406 END DO 5407 END DO 5408 RETURN 5409 END 5410 SUBROUTINE OFFSET_eomccsdt_x3a_9_9_1(l_a_offset,k_a_offset,size) 5411C $Id$ 5412C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 5413C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 5414C i2 ( h12 p8 )_vx 5415 IMPLICIT NONE 5416#include "global.fh" 5417#include "mafdecls.fh" 5418#include "sym.fh" 5419#include "errquit.fh" 5420#include "tce.fh" 5421 INTEGER l_a_offset 5422 INTEGER k_a_offset 5423 INTEGER size 5424 INTEGER length 5425 INTEGER addr 5426 INTEGER h12b 5427 INTEGER p8b 5428 length = 0 5429 DO h12b = 1,noab 5430 DO p8b = noab+1,noab+nvab 5431 IF (int_mb(k_spin+h12b-1) .eq. int_mb(k_spin+p8b-1)) THEN 5432 IF (ieor(int_mb(k_sym+h12b-1),int_mb(k_sym+p8b-1)) .eq. ieor(irrep 5433 &_v,irrep_x)) THEN 5434 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+p8b- 5435 &1).ne.4)) THEN 5436 length = length + 1 5437 END IF 5438 END IF 5439 END IF 5440 END DO 5441 END DO 5442 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 5443 &set)) CALL ERRQUIT('eomccsdt_x3_9_9_1',0,MA_ERR) 5444 int_mb(k_a_offset) = length 5445 addr = 0 5446 size = 0 5447 DO h12b = 1,noab 5448 DO p8b = noab+1,noab+nvab 5449 IF (int_mb(k_spin+h12b-1) .eq. int_mb(k_spin+p8b-1)) THEN 5450 IF (ieor(int_mb(k_sym+h12b-1),int_mb(k_sym+p8b-1)) .eq. ieor(irrep 5451 &_v,irrep_x)) THEN 5452 IF ((.not.restricted).or.(int_mb(k_spin+h12b-1)+int_mb(k_spin+p8b- 5453 &1).ne.4)) THEN 5454 addr = addr + 1 5455 int_mb(k_a_offset+addr) = p8b - noab - 1 + nvab * (h12b - 1) 5456 int_mb(k_a_offset+length+addr) = size 5457 size = size + int_mb(k_range+h12b-1) * int_mb(k_range+p8b-1) 5458 END IF 5459 END IF 5460 END IF 5461 END DO 5462 END DO 5463 RETURN 5464 END 5465 SUBROUTINE OFFSET_eomccsdt_y1_10_1(l_a_offset,k_a_offset,size) 5466C $Id$ 5467C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 5468C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 5469C i1 ( p9 p10 )_yt 5470 IMPLICIT NONE 5471#include "global.fh" 5472#include "mafdecls.fh" 5473#include "sym.fh" 5474#include "errquit.fh" 5475#include "tce.fh" 5476 INTEGER l_a_offset 5477 INTEGER k_a_offset 5478 INTEGER size 5479 INTEGER length 5480 INTEGER addr 5481 INTEGER p9b 5482 INTEGER p10b 5483 length = 0 5484 DO p9b = noab+1,noab+nvab 5485 DO p10b = noab+1,noab+nvab 5486 IF (int_mb(k_spin+p9b-1) .eq. int_mb(k_spin+p10b-1)) THEN 5487 IF (ieor(int_mb(k_sym+p9b-1),int_mb(k_sym+p10b-1)) .eq. ieor(irrep 5488 &_y,irrep_t)) THEN 5489 IF ((.not.restricted).or.(int_mb(k_spin+p9b-1)+int_mb(k_spin+p10b- 5490 &1).ne.4)) THEN 5491 length = length + 1 5492 END IF 5493 END IF 5494 END IF 5495 END DO 5496 END DO 5497 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 5498 &set)) CALL ERRQUIT('eomccsdt_y1_10_1',0,MA_ERR) 5499 int_mb(k_a_offset) = length 5500 addr = 0 5501 size = 0 5502 DO p9b = noab+1,noab+nvab 5503 DO p10b = noab+1,noab+nvab 5504 IF (int_mb(k_spin+p9b-1) .eq. int_mb(k_spin+p10b-1)) THEN 5505 IF (ieor(int_mb(k_sym+p9b-1),int_mb(k_sym+p10b-1)) .eq. ieor(irrep 5506 &_y,irrep_t)) THEN 5507 IF ((.not.restricted).or.(int_mb(k_spin+p9b-1)+int_mb(k_spin+p10b- 5508 &1).ne.4)) THEN 5509 addr = addr + 1 5510 int_mb(k_a_offset+addr) = p10b - noab - 1 + nvab * (p9b - noab - 1 5511 &) 5512 int_mb(k_a_offset+length+addr) = size 5513 size = size + int_mb(k_range+p9b-1) * int_mb(k_range+p10b-1) 5514 END IF 5515 END IF 5516 END IF 5517 END DO 5518 END DO 5519 RETURN 5520 END 5521 SUBROUTINE OFFSET_eomccsdt_y1_11_1(l_a_offset,k_a_offset,size) 5522C $Id$ 5523C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 5524C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 5525C i1 ( h2 h7 h9 p10 )_yt 5526 IMPLICIT NONE 5527#include "global.fh" 5528#include "mafdecls.fh" 5529#include "sym.fh" 5530#include "errquit.fh" 5531#include "tce.fh" 5532 INTEGER l_a_offset 5533 INTEGER k_a_offset 5534 INTEGER size 5535 INTEGER length 5536 INTEGER addr 5537 INTEGER h2b 5538 INTEGER h7b 5539 INTEGER h9b 5540 INTEGER p10b 5541 length = 0 5542 DO h2b = 1,noab 5543 DO h7b = 1,noab 5544 DO h9b = 1,noab 5545 DO p10b = noab+1,noab+nvab 5546 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h7b-1) .eq. int_mb(k_spin+h 5547 &9b-1)+int_mb(k_spin+p10b-1)) THEN 5548 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h7b-1),ieor(int_mb( 5549 &k_sym+h9b-1),int_mb(k_sym+p10b-1)))) .eq. ieor(irrep_y,irrep_t)) T 5550 &HEN 5551 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h7b-1 5552 &)+int_mb(k_spin+h9b-1)+int_mb(k_spin+p10b-1).ne.8)) THEN 5553 length = length + 1 5554 END IF 5555 END IF 5556 END IF 5557 END DO 5558 END DO 5559 END DO 5560 END DO 5561 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 5562 &set)) CALL ERRQUIT('eomccsdt_y1_11_1',0,MA_ERR) 5563 int_mb(k_a_offset) = length 5564 addr = 0 5565 size = 0 5566 DO h2b = 1,noab 5567 DO h7b = 1,noab 5568 DO h9b = 1,noab 5569 DO p10b = noab+1,noab+nvab 5570 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h7b-1) .eq. int_mb(k_spin+h 5571 &9b-1)+int_mb(k_spin+p10b-1)) THEN 5572 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h7b-1),ieor(int_mb( 5573 &k_sym+h9b-1),int_mb(k_sym+p10b-1)))) .eq. ieor(irrep_y,irrep_t)) T 5574 &HEN 5575 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h7b-1 5576 &)+int_mb(k_spin+h9b-1)+int_mb(k_spin+p10b-1).ne.8)) THEN 5577 addr = addr + 1 5578 int_mb(k_a_offset+addr) = p10b - noab - 1 + nvab * (h9b - 1 + noab 5579 & * (h7b - 1 + noab * (h2b - 1))) 5580 int_mb(k_a_offset+length+addr) = size 5581 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h7b-1) * int_ 5582 &mb(k_range+h9b-1) * int_mb(k_range+p10b-1) 5583 END IF 5584 END IF 5585 END IF 5586 END DO 5587 END DO 5588 END DO 5589 END DO 5590 RETURN 5591 END 5592 SUBROUTINE OFFSET_eomccsdt_y1_1_1(l_a_offset,k_a_offset,size) 5593C $Id$ 5594C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 5595C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 5596C i1 ( h2 h7 )_f 5597 IMPLICIT NONE 5598#include "global.fh" 5599#include "mafdecls.fh" 5600#include "sym.fh" 5601#include "errquit.fh" 5602#include "tce.fh" 5603 INTEGER l_a_offset 5604 INTEGER k_a_offset 5605 INTEGER size 5606 INTEGER length 5607 INTEGER addr 5608 INTEGER h2b 5609 INTEGER h7b 5610 length = 0 5611 DO h2b = 1,noab 5612 DO h7b = 1,noab 5613 IF (int_mb(k_spin+h2b-1) .eq. int_mb(k_spin+h7b-1)) THEN 5614 IF (ieor(int_mb(k_sym+h2b-1),int_mb(k_sym+h7b-1)) .eq. irrep_f) TH 5615 &EN 5616 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h7b-1 5617 &).ne.4)) THEN 5618 length = length + 1 5619 END IF 5620 END IF 5621 END IF 5622 END DO 5623 END DO 5624 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 5625 &set)) CALL ERRQUIT('eomccsdt_y1_1_1',0,MA_ERR) 5626 int_mb(k_a_offset) = length 5627 addr = 0 5628 size = 0 5629 DO h2b = 1,noab 5630 DO h7b = 1,noab 5631 IF (int_mb(k_spin+h2b-1) .eq. int_mb(k_spin+h7b-1)) THEN 5632 IF (ieor(int_mb(k_sym+h2b-1),int_mb(k_sym+h7b-1)) .eq. irrep_f) TH 5633 &EN 5634 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h7b-1 5635 &).ne.4)) THEN 5636 addr = addr + 1 5637 int_mb(k_a_offset+addr) = h7b - 1 + noab * (h2b - 1) 5638 int_mb(k_a_offset+length+addr) = size 5639 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h7b-1) 5640 END IF 5641 END IF 5642 END IF 5643 END DO 5644 END DO 5645 RETURN 5646 END 5647 SUBROUTINE OFFSET_eomccsdt_y1_1_2_1(l_a_offset,k_a_offset,size) 5648C $Id$ 5649C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 5650C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 5651C i2 ( h2 p3 )_f 5652 IMPLICIT NONE 5653#include "global.fh" 5654#include "mafdecls.fh" 5655#include "sym.fh" 5656#include "errquit.fh" 5657#include "tce.fh" 5658 INTEGER l_a_offset 5659 INTEGER k_a_offset 5660 INTEGER size 5661 INTEGER length 5662 INTEGER addr 5663 INTEGER h2b 5664 INTEGER p3b 5665 length = 0 5666 DO h2b = 1,noab 5667 DO p3b = noab+1,noab+nvab 5668 IF (int_mb(k_spin+h2b-1) .eq. int_mb(k_spin+p3b-1)) THEN 5669 IF (ieor(int_mb(k_sym+h2b-1),int_mb(k_sym+p3b-1)) .eq. irrep_f) TH 5670 &EN 5671 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+p3b-1 5672 &).ne.4)) THEN 5673 length = length + 1 5674 END IF 5675 END IF 5676 END IF 5677 END DO 5678 END DO 5679 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 5680 &set)) CALL ERRQUIT('eomccsdt_y1_1_2_1',0,MA_ERR) 5681 int_mb(k_a_offset) = length 5682 addr = 0 5683 size = 0 5684 DO h2b = 1,noab 5685 DO p3b = noab+1,noab+nvab 5686 IF (int_mb(k_spin+h2b-1) .eq. int_mb(k_spin+p3b-1)) THEN 5687 IF (ieor(int_mb(k_sym+h2b-1),int_mb(k_sym+p3b-1)) .eq. irrep_f) TH 5688 &EN 5689 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+p3b-1 5690 &).ne.4)) THEN 5691 addr = addr + 1 5692 int_mb(k_a_offset+addr) = p3b - noab - 1 + nvab * (h2b - 1) 5693 int_mb(k_a_offset+length+addr) = size 5694 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+p3b-1) 5695 END IF 5696 END IF 5697 END IF 5698 END DO 5699 END DO 5700 RETURN 5701 END 5702 SUBROUTINE OFFSET_eomccsdt_y1_12_1(l_a_offset,k_a_offset,size) 5703C $Id$ 5704C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 5705C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 5706C i1 ( p13 h12 )_yt 5707 IMPLICIT NONE 5708#include "global.fh" 5709#include "mafdecls.fh" 5710#include "sym.fh" 5711#include "errquit.fh" 5712#include "tce.fh" 5713 INTEGER l_a_offset 5714 INTEGER k_a_offset 5715 INTEGER size 5716 INTEGER length 5717 INTEGER addr 5718 INTEGER p13b 5719 INTEGER h12b 5720 length = 0 5721 DO p13b = noab+1,noab+nvab 5722 DO h12b = 1,noab 5723 IF (int_mb(k_spin+p13b-1) .eq. int_mb(k_spin+h12b-1)) THEN 5724 IF (ieor(int_mb(k_sym+p13b-1),int_mb(k_sym+h12b-1)) .eq. ieor(irre 5725 &p_y,irrep_t)) THEN 5726 IF ((.not.restricted).or.(int_mb(k_spin+p13b-1)+int_mb(k_spin+h12b 5727 &-1).ne.4)) THEN 5728 length = length + 1 5729 END IF 5730 END IF 5731 END IF 5732 END DO 5733 END DO 5734 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 5735 &set)) CALL ERRQUIT('eomccsdt_y1_12_1',0,MA_ERR) 5736 int_mb(k_a_offset) = length 5737 addr = 0 5738 size = 0 5739 DO p13b = noab+1,noab+nvab 5740 DO h12b = 1,noab 5741 IF (int_mb(k_spin+p13b-1) .eq. int_mb(k_spin+h12b-1)) THEN 5742 IF (ieor(int_mb(k_sym+p13b-1),int_mb(k_sym+h12b-1)) .eq. ieor(irre 5743 &p_y,irrep_t)) THEN 5744 IF ((.not.restricted).or.(int_mb(k_spin+p13b-1)+int_mb(k_spin+h12b 5745 &-1).ne.4)) THEN 5746 addr = addr + 1 5747 int_mb(k_a_offset+addr) = h12b - 1 + noab * (p13b - noab - 1) 5748 int_mb(k_a_offset+length+addr) = size 5749 size = size + int_mb(k_range+p13b-1) * int_mb(k_range+h12b-1) 5750 END IF 5751 END IF 5752 END IF 5753 END DO 5754 END DO 5755 RETURN 5756 END 5757 SUBROUTINE OFFSET_eomccsdt_y1_12_3_1(l_a_offset,k_a_offset,size) 5758C $Id$ 5759C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 5760C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 5761C i2 ( h8 h12 )_yt 5762 IMPLICIT NONE 5763#include "global.fh" 5764#include "mafdecls.fh" 5765#include "sym.fh" 5766#include "errquit.fh" 5767#include "tce.fh" 5768 INTEGER l_a_offset 5769 INTEGER k_a_offset 5770 INTEGER size 5771 INTEGER length 5772 INTEGER addr 5773 INTEGER h8b 5774 INTEGER h12b 5775 length = 0 5776 DO h8b = 1,noab 5777 DO h12b = 1,noab 5778 IF (int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h12b-1)) THEN 5779 IF (ieor(int_mb(k_sym+h8b-1),int_mb(k_sym+h12b-1)) .eq. ieor(irrep 5780 &_y,irrep_t)) THEN 5781 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h12b- 5782 &1).ne.4)) THEN 5783 length = length + 1 5784 END IF 5785 END IF 5786 END IF 5787 END DO 5788 END DO 5789 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 5790 &set)) CALL ERRQUIT('eomccsdt_y1_12_3_1',0,MA_ERR) 5791 int_mb(k_a_offset) = length 5792 addr = 0 5793 size = 0 5794 DO h8b = 1,noab 5795 DO h12b = 1,noab 5796 IF (int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h12b-1)) THEN 5797 IF (ieor(int_mb(k_sym+h8b-1),int_mb(k_sym+h12b-1)) .eq. ieor(irrep 5798 &_y,irrep_t)) THEN 5799 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+h12b- 5800 &1).ne.4)) THEN 5801 addr = addr + 1 5802 int_mb(k_a_offset+addr) = h12b - 1 + noab * (h8b - 1) 5803 int_mb(k_a_offset+length+addr) = size 5804 size = size + int_mb(k_range+h8b-1) * int_mb(k_range+h12b-1) 5805 END IF 5806 END IF 5807 END IF 5808 END DO 5809 END DO 5810 RETURN 5811 END 5812 SUBROUTINE OFFSET_eomccsdt_y1_12_4_1(l_a_offset,k_a_offset,size) 5813C $Id$ 5814C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 5815C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 5816C i2 ( h5 h6 h12 p3 )_yt 5817 IMPLICIT NONE 5818#include "global.fh" 5819#include "mafdecls.fh" 5820#include "sym.fh" 5821#include "errquit.fh" 5822#include "tce.fh" 5823 INTEGER l_a_offset 5824 INTEGER k_a_offset 5825 INTEGER size 5826 INTEGER length 5827 INTEGER addr 5828 INTEGER h5b 5829 INTEGER h6b 5830 INTEGER h12b 5831 INTEGER p3b 5832 length = 0 5833 DO h5b = 1,noab 5834 DO h6b = h5b,noab 5835 DO h12b = 1,noab 5836 DO p3b = noab+1,noab+nvab 5837 IF (int_mb(k_spin+h5b-1)+int_mb(k_spin+h6b-1) .eq. int_mb(k_spin+h 5838 &12b-1)+int_mb(k_spin+p3b-1)) THEN 5839 IF (ieor(int_mb(k_sym+h5b-1),ieor(int_mb(k_sym+h6b-1),ieor(int_mb( 5840 &k_sym+h12b-1),int_mb(k_sym+p3b-1)))) .eq. ieor(irrep_y,irrep_t)) T 5841 &HEN 5842 IF ((.not.restricted).or.(int_mb(k_spin+h5b-1)+int_mb(k_spin+h6b-1 5843 &)+int_mb(k_spin+h12b-1)+int_mb(k_spin+p3b-1).ne.8)) THEN 5844 length = length + 1 5845 END IF 5846 END IF 5847 END IF 5848 END DO 5849 END DO 5850 END DO 5851 END DO 5852 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 5853 &set)) CALL ERRQUIT('eomccsdt_y1_12_4_1',0,MA_ERR) 5854 int_mb(k_a_offset) = length 5855 addr = 0 5856 size = 0 5857 DO h5b = 1,noab 5858 DO h6b = h5b,noab 5859 DO h12b = 1,noab 5860 DO p3b = noab+1,noab+nvab 5861 IF (int_mb(k_spin+h5b-1)+int_mb(k_spin+h6b-1) .eq. int_mb(k_spin+h 5862 &12b-1)+int_mb(k_spin+p3b-1)) THEN 5863 IF (ieor(int_mb(k_sym+h5b-1),ieor(int_mb(k_sym+h6b-1),ieor(int_mb( 5864 &k_sym+h12b-1),int_mb(k_sym+p3b-1)))) .eq. ieor(irrep_y,irrep_t)) T 5865 &HEN 5866 IF ((.not.restricted).or.(int_mb(k_spin+h5b-1)+int_mb(k_spin+h6b-1 5867 &)+int_mb(k_spin+h12b-1)+int_mb(k_spin+p3b-1).ne.8)) THEN 5868 addr = addr + 1 5869 int_mb(k_a_offset+addr) = p3b - noab - 1 + nvab * (h12b - 1 + noab 5870 & * (h6b - 1 + noab * (h5b - 1))) 5871 int_mb(k_a_offset+length+addr) = size 5872 size = size + int_mb(k_range+h5b-1) * int_mb(k_range+h6b-1) * int_ 5873 &mb(k_range+h12b-1) * int_mb(k_range+p3b-1) 5874 END IF 5875 END IF 5876 END IF 5877 END DO 5878 END DO 5879 END DO 5880 END DO 5881 RETURN 5882 END 5883 SUBROUTINE OFFSET_eomccsdt_y1_12_4_2_1(l_a_offset,k_a_offset,size) 5884C $Id$ 5885C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 5886C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 5887C i3 ( h5 h6 h9 p3 p7 p8 )_y 5888 IMPLICIT NONE 5889#include "global.fh" 5890#include "mafdecls.fh" 5891#include "sym.fh" 5892#include "errquit.fh" 5893#include "tce.fh" 5894 INTEGER l_a_offset 5895 INTEGER k_a_offset 5896 INTEGER size 5897 INTEGER length 5898 INTEGER addr 5899 INTEGER h5b 5900 INTEGER h6b 5901 INTEGER h9b 5902 INTEGER p3b 5903 INTEGER p7b 5904 INTEGER p8b 5905 length = 0 5906 DO h5b = 1,noab 5907 DO h6b = h5b,noab 5908 DO h9b = h6b,noab 5909 DO p3b = noab+1,noab+nvab 5910 DO p7b = p3b,noab+nvab 5911 DO p8b = p7b,noab+nvab 5912 IF (int_mb(k_spin+h5b-1)+int_mb(k_spin+h6b-1)+int_mb(k_spin+h9b-1) 5913 & .eq. int_mb(k_spin+p3b-1)+int_mb(k_spin+p7b-1)+int_mb(k_spin+p8b- 5914 &1)) THEN 5915 IF (ieor(int_mb(k_sym+h5b-1),ieor(int_mb(k_sym+h6b-1),ieor(int_mb( 5916 &k_sym+h9b-1),ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p7b-1),int 5917 &_mb(k_sym+p8b-1)))))) .eq. irrep_y) THEN 5918 IF ((.not.restricted).or.(int_mb(k_spin+h5b-1)+int_mb(k_spin+h6b-1 5919 &)+int_mb(k_spin+h9b-1)+int_mb(k_spin+p3b-1)+int_mb(k_spin+p7b-1)+i 5920 &nt_mb(k_spin+p8b-1).ne.12)) THEN 5921 length = length + 1 5922 END IF 5923 END IF 5924 END IF 5925 END DO 5926 END DO 5927 END DO 5928 END DO 5929 END DO 5930 END DO 5931 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 5932 &set)) CALL ERRQUIT('eomccsdt_y1_12_4_2_1',0,MA_ERR) 5933 int_mb(k_a_offset) = length 5934 addr = 0 5935 size = 0 5936 DO h5b = 1,noab 5937 DO h6b = h5b,noab 5938 DO h9b = h6b,noab 5939 DO p3b = noab+1,noab+nvab 5940 DO p7b = p3b,noab+nvab 5941 DO p8b = p7b,noab+nvab 5942 IF (int_mb(k_spin+h5b-1)+int_mb(k_spin+h6b-1)+int_mb(k_spin+h9b-1) 5943 & .eq. int_mb(k_spin+p3b-1)+int_mb(k_spin+p7b-1)+int_mb(k_spin+p8b- 5944 &1)) THEN 5945 IF (ieor(int_mb(k_sym+h5b-1),ieor(int_mb(k_sym+h6b-1),ieor(int_mb( 5946 &k_sym+h9b-1),ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p7b-1),int 5947 &_mb(k_sym+p8b-1)))))) .eq. irrep_y) THEN 5948 IF ((.not.restricted).or.(int_mb(k_spin+h5b-1)+int_mb(k_spin+h6b-1 5949 &)+int_mb(k_spin+h9b-1)+int_mb(k_spin+p3b-1)+int_mb(k_spin+p7b-1)+i 5950 &nt_mb(k_spin+p8b-1).ne.12)) THEN 5951 addr = addr + 1 5952 int_mb(k_a_offset+addr) = p8b - noab - 1 + nvab * (p7b - noab - 1 5953 &+ nvab * (p3b - noab - 1 + nvab * (h9b - 1 + noab * (h6b - 1 + noa 5954 &b * (h5b - 1))))) 5955 int_mb(k_a_offset+length+addr) = size 5956 size = size + int_mb(k_range+h5b-1) * int_mb(k_range+h6b-1) * int_ 5957 &mb(k_range+h9b-1) * int_mb(k_range+p3b-1) * int_mb(k_range+p7b-1) 5958 &* int_mb(k_range+p8b-1) 5959 END IF 5960 END IF 5961 END IF 5962 END DO 5963 END DO 5964 END DO 5965 END DO 5966 END DO 5967 END DO 5968 RETURN 5969 END 5970 SUBROUTINE OFFSET_eomccsdt_y1_12_5_1(l_a_offset,k_a_offset,size) 5971C $Id$ 5972C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 5973C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 5974C i2 ( h6 h7 h8 h12 p3 p4 )_yt 5975 IMPLICIT NONE 5976#include "global.fh" 5977#include "mafdecls.fh" 5978#include "sym.fh" 5979#include "errquit.fh" 5980#include "tce.fh" 5981 INTEGER l_a_offset 5982 INTEGER k_a_offset 5983 INTEGER size 5984 INTEGER length 5985 INTEGER addr 5986 INTEGER h6b 5987 INTEGER h7b 5988 INTEGER h8b 5989 INTEGER h12b 5990 INTEGER p3b 5991 INTEGER p4b 5992 length = 0 5993 DO h6b = 1,noab 5994 DO h7b = h6b,noab 5995 DO h8b = h7b,noab 5996 DO h12b = 1,noab 5997 DO p3b = noab+1,noab+nvab 5998 DO p4b = p3b,noab+nvab 5999 IF (int_mb(k_spin+h6b-1)+int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1) 6000 & .eq. int_mb(k_spin+h12b-1)+int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b 6001 &-1)) THEN 6002 IF (ieor(int_mb(k_sym+h6b-1),ieor(int_mb(k_sym+h7b-1),ieor(int_mb( 6003 &k_sym+h8b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+p3b-1),in 6004 &t_mb(k_sym+p4b-1)))))) .eq. ieor(irrep_y,irrep_t)) THEN 6005 IF ((.not.restricted).or.(int_mb(k_spin+h6b-1)+int_mb(k_spin+h7b-1 6006 &)+int_mb(k_spin+h8b-1)+int_mb(k_spin+h12b-1)+int_mb(k_spin+p3b-1)+ 6007 &int_mb(k_spin+p4b-1).ne.12)) THEN 6008 length = length + 1 6009 END IF 6010 END IF 6011 END IF 6012 END DO 6013 END DO 6014 END DO 6015 END DO 6016 END DO 6017 END DO 6018 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 6019 &set)) CALL ERRQUIT('eomccsdt_y1_12_5_1',0,MA_ERR) 6020 int_mb(k_a_offset) = length 6021 addr = 0 6022 size = 0 6023 DO h6b = 1,noab 6024 DO h7b = h6b,noab 6025 DO h8b = h7b,noab 6026 DO h12b = 1,noab 6027 DO p3b = noab+1,noab+nvab 6028 DO p4b = p3b,noab+nvab 6029 IF (int_mb(k_spin+h6b-1)+int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1) 6030 & .eq. int_mb(k_spin+h12b-1)+int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b 6031 &-1)) THEN 6032 IF (ieor(int_mb(k_sym+h6b-1),ieor(int_mb(k_sym+h7b-1),ieor(int_mb( 6033 &k_sym+h8b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+p3b-1),in 6034 &t_mb(k_sym+p4b-1)))))) .eq. ieor(irrep_y,irrep_t)) THEN 6035 IF ((.not.restricted).or.(int_mb(k_spin+h6b-1)+int_mb(k_spin+h7b-1 6036 &)+int_mb(k_spin+h8b-1)+int_mb(k_spin+h12b-1)+int_mb(k_spin+p3b-1)+ 6037 &int_mb(k_spin+p4b-1).ne.12)) THEN 6038 addr = addr + 1 6039 int_mb(k_a_offset+addr) = p4b - noab - 1 + nvab * (p3b - noab - 1 6040 &+ nvab * (h12b - 1 + noab * (h8b - 1 + noab * (h7b - 1 + noab * (h 6041 &6b - 1))))) 6042 int_mb(k_a_offset+length+addr) = size 6043 size = size + int_mb(k_range+h6b-1) * int_mb(k_range+h7b-1) * int_ 6044 &mb(k_range+h8b-1) * int_mb(k_range+h12b-1) * int_mb(k_range+p3b-1) 6045 & * int_mb(k_range+p4b-1) 6046 END IF 6047 END IF 6048 END IF 6049 END DO 6050 END DO 6051 END DO 6052 END DO 6053 END DO 6054 END DO 6055 RETURN 6056 END 6057 SUBROUTINE OFFSET_eomccsdt_y1_13_1(l_a_offset,k_a_offset,size) 6058C $Id$ 6059C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 6060C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 6061C i1 ( h2 p11 h12 h13 )_yt 6062 IMPLICIT NONE 6063#include "global.fh" 6064#include "mafdecls.fh" 6065#include "sym.fh" 6066#include "errquit.fh" 6067#include "tce.fh" 6068 INTEGER l_a_offset 6069 INTEGER k_a_offset 6070 INTEGER size 6071 INTEGER length 6072 INTEGER addr 6073 INTEGER h2b 6074 INTEGER p11b 6075 INTEGER h12b 6076 INTEGER h13b 6077 length = 0 6078 DO h2b = 1,noab 6079 DO p11b = noab+1,noab+nvab 6080 DO h12b = 1,noab 6081 DO h13b = h12b,noab 6082 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+p11b-1) .eq. int_mb(k_spin+ 6083 &h12b-1)+int_mb(k_spin+h13b-1)) THEN 6084 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+p11b-1),ieor(int_mb 6085 &(k_sym+h12b-1),int_mb(k_sym+h13b-1)))) .eq. ieor(irrep_y,irrep_t)) 6086 & THEN 6087 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+p11b- 6088 &1)+int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b-1).ne.8)) THEN 6089 length = length + 1 6090 END IF 6091 END IF 6092 END IF 6093 END DO 6094 END DO 6095 END DO 6096 END DO 6097 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 6098 &set)) CALL ERRQUIT('eomccsdt_y1_13_1',0,MA_ERR) 6099 int_mb(k_a_offset) = length 6100 addr = 0 6101 size = 0 6102 DO h2b = 1,noab 6103 DO p11b = noab+1,noab+nvab 6104 DO h12b = 1,noab 6105 DO h13b = h12b,noab 6106 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+p11b-1) .eq. int_mb(k_spin+ 6107 &h12b-1)+int_mb(k_spin+h13b-1)) THEN 6108 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+p11b-1),ieor(int_mb 6109 &(k_sym+h12b-1),int_mb(k_sym+h13b-1)))) .eq. ieor(irrep_y,irrep_t)) 6110 & THEN 6111 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+p11b- 6112 &1)+int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b-1).ne.8)) THEN 6113 addr = addr + 1 6114 int_mb(k_a_offset+addr) = h13b - 1 + noab * (h12b - 1 + noab * (p1 6115 &1b - noab - 1 + nvab * (h2b - 1))) 6116 int_mb(k_a_offset+length+addr) = size 6117 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+p11b-1) * int 6118 &_mb(k_range+h12b-1) * int_mb(k_range+h13b-1) 6119 END IF 6120 END IF 6121 END IF 6122 END DO 6123 END DO 6124 END DO 6125 END DO 6126 RETURN 6127 END 6128 SUBROUTINE OFFSET_eomccsdt_y1_13_3_1(l_a_offset,k_a_offset,size) 6129C $Id$ 6130C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 6131C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 6132C i2 ( h2 h10 h12 h13 )_yt 6133 IMPLICIT NONE 6134#include "global.fh" 6135#include "mafdecls.fh" 6136#include "sym.fh" 6137#include "errquit.fh" 6138#include "tce.fh" 6139 INTEGER l_a_offset 6140 INTEGER k_a_offset 6141 INTEGER size 6142 INTEGER length 6143 INTEGER addr 6144 INTEGER h2b 6145 INTEGER h10b 6146 INTEGER h12b 6147 INTEGER h13b 6148 length = 0 6149 DO h2b = 1,noab 6150 DO h10b = 1,noab 6151 DO h12b = 1,noab 6152 DO h13b = h12b,noab 6153 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+ 6154 &h12b-1)+int_mb(k_spin+h13b-1)) THEN 6155 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb 6156 &(k_sym+h12b-1),int_mb(k_sym+h13b-1)))) .eq. ieor(irrep_y,irrep_t)) 6157 & THEN 6158 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h10b- 6159 &1)+int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b-1).ne.8)) THEN 6160 length = length + 1 6161 END IF 6162 END IF 6163 END IF 6164 END DO 6165 END DO 6166 END DO 6167 END DO 6168 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 6169 &set)) CALL ERRQUIT('eomccsdt_y1_13_3_1',0,MA_ERR) 6170 int_mb(k_a_offset) = length 6171 addr = 0 6172 size = 0 6173 DO h2b = 1,noab 6174 DO h10b = 1,noab 6175 DO h12b = 1,noab 6176 DO h13b = h12b,noab 6177 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+ 6178 &h12b-1)+int_mb(k_spin+h13b-1)) THEN 6179 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb 6180 &(k_sym+h12b-1),int_mb(k_sym+h13b-1)))) .eq. ieor(irrep_y,irrep_t)) 6181 & THEN 6182 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h10b- 6183 &1)+int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b-1).ne.8)) THEN 6184 addr = addr + 1 6185 int_mb(k_a_offset+addr) = h13b - 1 + noab * (h12b - 1 + noab * (h1 6186 &0b - 1 + noab * (h2b - 1))) 6187 int_mb(k_a_offset+length+addr) = size 6188 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h10b-1) * int 6189 &_mb(k_range+h12b-1) * int_mb(k_range+h13b-1) 6190 END IF 6191 END IF 6192 END IF 6193 END DO 6194 END DO 6195 END DO 6196 END DO 6197 RETURN 6198 END 6199 SUBROUTINE OFFSET_eomccsdt_y1_13_3_3_1(l_a_offset,k_a_offset,size) 6200C $Id$ 6201C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 6202C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 6203C i3 ( h2 h10 h13 p5 )_yt 6204 IMPLICIT NONE 6205#include "global.fh" 6206#include "mafdecls.fh" 6207#include "sym.fh" 6208#include "errquit.fh" 6209#include "tce.fh" 6210 INTEGER l_a_offset 6211 INTEGER k_a_offset 6212 INTEGER size 6213 INTEGER length 6214 INTEGER addr 6215 INTEGER h2b 6216 INTEGER h10b 6217 INTEGER h13b 6218 INTEGER p5b 6219 length = 0 6220 DO h2b = 1,noab 6221 DO h10b = 1,noab 6222 DO h13b = 1,noab 6223 DO p5b = noab+1,noab+nvab 6224 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+ 6225 &h13b-1)+int_mb(k_spin+p5b-1)) THEN 6226 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb 6227 &(k_sym+h13b-1),int_mb(k_sym+p5b-1)))) .eq. ieor(irrep_y,irrep_t)) 6228 &THEN 6229 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h10b- 6230 &1)+int_mb(k_spin+h13b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN 6231 length = length + 1 6232 END IF 6233 END IF 6234 END IF 6235 END DO 6236 END DO 6237 END DO 6238 END DO 6239 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 6240 &set)) CALL ERRQUIT('eomccsdt_y1_13_3_3_1',0,MA_ERR) 6241 int_mb(k_a_offset) = length 6242 addr = 0 6243 size = 0 6244 DO h2b = 1,noab 6245 DO h10b = 1,noab 6246 DO h13b = 1,noab 6247 DO p5b = noab+1,noab+nvab 6248 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+ 6249 &h13b-1)+int_mb(k_spin+p5b-1)) THEN 6250 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb 6251 &(k_sym+h13b-1),int_mb(k_sym+p5b-1)))) .eq. ieor(irrep_y,irrep_t)) 6252 &THEN 6253 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h10b- 6254 &1)+int_mb(k_spin+h13b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN 6255 addr = addr + 1 6256 int_mb(k_a_offset+addr) = p5b - noab - 1 + nvab * (h13b - 1 + noab 6257 & * (h10b - 1 + noab * (h2b - 1))) 6258 int_mb(k_a_offset+length+addr) = size 6259 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h10b-1) * int 6260 &_mb(k_range+h13b-1) * int_mb(k_range+p5b-1) 6261 END IF 6262 END IF 6263 END IF 6264 END DO 6265 END DO 6266 END DO 6267 END DO 6268 RETURN 6269 END 6270 SUBROUTINE OFFSET_eomccsdt_y1_13_4_1(l_a_offset,k_a_offset,size) 6271C $Id$ 6272C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 6273C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 6274C i2 ( h2 h5 h13 p3 )_yt 6275 IMPLICIT NONE 6276#include "global.fh" 6277#include "mafdecls.fh" 6278#include "sym.fh" 6279#include "errquit.fh" 6280#include "tce.fh" 6281 INTEGER l_a_offset 6282 INTEGER k_a_offset 6283 INTEGER size 6284 INTEGER length 6285 INTEGER addr 6286 INTEGER h2b 6287 INTEGER h5b 6288 INTEGER h13b 6289 INTEGER p3b 6290 length = 0 6291 DO h2b = 1,noab 6292 DO h5b = 1,noab 6293 DO h13b = 1,noab 6294 DO p3b = noab+1,noab+nvab 6295 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h5b-1) .eq. int_mb(k_spin+h 6296 &13b-1)+int_mb(k_spin+p3b-1)) THEN 6297 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h5b-1),ieor(int_mb( 6298 &k_sym+h13b-1),int_mb(k_sym+p3b-1)))) .eq. ieor(irrep_y,irrep_t)) T 6299 &HEN 6300 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h5b-1 6301 &)+int_mb(k_spin+h13b-1)+int_mb(k_spin+p3b-1).ne.8)) THEN 6302 length = length + 1 6303 END IF 6304 END IF 6305 END IF 6306 END DO 6307 END DO 6308 END DO 6309 END DO 6310 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 6311 &set)) CALL ERRQUIT('eomccsdt_y1_13_4_1',0,MA_ERR) 6312 int_mb(k_a_offset) = length 6313 addr = 0 6314 size = 0 6315 DO h2b = 1,noab 6316 DO h5b = 1,noab 6317 DO h13b = 1,noab 6318 DO p3b = noab+1,noab+nvab 6319 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h5b-1) .eq. int_mb(k_spin+h 6320 &13b-1)+int_mb(k_spin+p3b-1)) THEN 6321 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h5b-1),ieor(int_mb( 6322 &k_sym+h13b-1),int_mb(k_sym+p3b-1)))) .eq. ieor(irrep_y,irrep_t)) T 6323 &HEN 6324 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h5b-1 6325 &)+int_mb(k_spin+h13b-1)+int_mb(k_spin+p3b-1).ne.8)) THEN 6326 addr = addr + 1 6327 int_mb(k_a_offset+addr) = p3b - noab - 1 + nvab * (h13b - 1 + noab 6328 & * (h5b - 1 + noab * (h2b - 1))) 6329 int_mb(k_a_offset+length+addr) = size 6330 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h5b-1) * int_ 6331 &mb(k_range+h13b-1) * int_mb(k_range+p3b-1) 6332 END IF 6333 END IF 6334 END IF 6335 END DO 6336 END DO 6337 END DO 6338 END DO 6339 RETURN 6340 END 6341 SUBROUTINE OFFSET_eomccsdt_y1_13_5_1(l_a_offset,k_a_offset,size) 6342C $Id$ 6343C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 6344C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 6345C i2 ( h2 h12 )_yt 6346 IMPLICIT NONE 6347#include "global.fh" 6348#include "mafdecls.fh" 6349#include "sym.fh" 6350#include "errquit.fh" 6351#include "tce.fh" 6352 INTEGER l_a_offset 6353 INTEGER k_a_offset 6354 INTEGER size 6355 INTEGER length 6356 INTEGER addr 6357 INTEGER h2b 6358 INTEGER h12b 6359 length = 0 6360 DO h2b = 1,noab 6361 DO h12b = 1,noab 6362 IF (int_mb(k_spin+h2b-1) .eq. int_mb(k_spin+h12b-1)) THEN 6363 IF (ieor(int_mb(k_sym+h2b-1),int_mb(k_sym+h12b-1)) .eq. ieor(irrep 6364 &_y,irrep_t)) THEN 6365 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h12b- 6366 &1).ne.4)) THEN 6367 length = length + 1 6368 END IF 6369 END IF 6370 END IF 6371 END DO 6372 END DO 6373 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 6374 &set)) CALL ERRQUIT('eomccsdt_y1_13_5_1',0,MA_ERR) 6375 int_mb(k_a_offset) = length 6376 addr = 0 6377 size = 0 6378 DO h2b = 1,noab 6379 DO h12b = 1,noab 6380 IF (int_mb(k_spin+h2b-1) .eq. int_mb(k_spin+h12b-1)) THEN 6381 IF (ieor(int_mb(k_sym+h2b-1),int_mb(k_sym+h12b-1)) .eq. ieor(irrep 6382 &_y,irrep_t)) THEN 6383 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h12b- 6384 &1).ne.4)) THEN 6385 addr = addr + 1 6386 int_mb(k_a_offset+addr) = h12b - 1 + noab * (h2b - 1) 6387 int_mb(k_a_offset+length+addr) = size 6388 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h12b-1) 6389 END IF 6390 END IF 6391 END IF 6392 END DO 6393 END DO 6394 RETURN 6395 END 6396 SUBROUTINE OFFSET_eomccsdt_y1_13_6_1(l_a_offset,k_a_offset,size) 6397C $Id$ 6398C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 6399C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 6400C i2 ( h2 h6 h7 h13 p3 p4 )_yt 6401 IMPLICIT NONE 6402#include "global.fh" 6403#include "mafdecls.fh" 6404#include "sym.fh" 6405#include "errquit.fh" 6406#include "tce.fh" 6407 INTEGER l_a_offset 6408 INTEGER k_a_offset 6409 INTEGER size 6410 INTEGER length 6411 INTEGER addr 6412 INTEGER h2b 6413 INTEGER h6b 6414 INTEGER h7b 6415 INTEGER h13b 6416 INTEGER p3b 6417 INTEGER p4b 6418 length = 0 6419 DO h2b = 1,noab 6420 DO h6b = 1,noab 6421 DO h7b = h6b,noab 6422 DO h13b = 1,noab 6423 DO p3b = noab+1,noab+nvab 6424 DO p4b = p3b,noab+nvab 6425 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h6b-1)+int_mb(k_spin+h7b-1) 6426 & .eq. int_mb(k_spin+h13b-1)+int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b 6427 &-1)) THEN 6428 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h6b-1),ieor(int_mb( 6429 &k_sym+h7b-1),ieor(int_mb(k_sym+h13b-1),ieor(int_mb(k_sym+p3b-1),in 6430 &t_mb(k_sym+p4b-1)))))) .eq. ieor(irrep_y,irrep_t)) THEN 6431 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h6b-1 6432 &)+int_mb(k_spin+h7b-1)+int_mb(k_spin+h13b-1)+int_mb(k_spin+p3b-1)+ 6433 &int_mb(k_spin+p4b-1).ne.12)) THEN 6434 length = length + 1 6435 END IF 6436 END IF 6437 END IF 6438 END DO 6439 END DO 6440 END DO 6441 END DO 6442 END DO 6443 END DO 6444 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 6445 &set)) CALL ERRQUIT('eomccsdt_y1_13_6_1',0,MA_ERR) 6446 int_mb(k_a_offset) = length 6447 addr = 0 6448 size = 0 6449 DO h2b = 1,noab 6450 DO h6b = 1,noab 6451 DO h7b = h6b,noab 6452 DO h13b = 1,noab 6453 DO p3b = noab+1,noab+nvab 6454 DO p4b = p3b,noab+nvab 6455 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h6b-1)+int_mb(k_spin+h7b-1) 6456 & .eq. int_mb(k_spin+h13b-1)+int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b 6457 &-1)) THEN 6458 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h6b-1),ieor(int_mb( 6459 &k_sym+h7b-1),ieor(int_mb(k_sym+h13b-1),ieor(int_mb(k_sym+p3b-1),in 6460 &t_mb(k_sym+p4b-1)))))) .eq. ieor(irrep_y,irrep_t)) THEN 6461 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h6b-1 6462 &)+int_mb(k_spin+h7b-1)+int_mb(k_spin+h13b-1)+int_mb(k_spin+p3b-1)+ 6463 &int_mb(k_spin+p4b-1).ne.12)) THEN 6464 addr = addr + 1 6465 int_mb(k_a_offset+addr) = p4b - noab - 1 + nvab * (p3b - noab - 1 6466 &+ nvab * (h13b - 1 + noab * (h7b - 1 + noab * (h6b - 1 + noab * (h 6467 &2b - 1))))) 6468 int_mb(k_a_offset+length+addr) = size 6469 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h6b-1) * int_ 6470 &mb(k_range+h7b-1) * int_mb(k_range+h13b-1) * int_mb(k_range+p3b-1) 6471 & * int_mb(k_range+p4b-1) 6472 END IF 6473 END IF 6474 END IF 6475 END DO 6476 END DO 6477 END DO 6478 END DO 6479 END DO 6480 END DO 6481 RETURN 6482 END 6483 SUBROUTINE OFFSET_eomccsdt_y1_13_7_1(l_a_offset,k_a_offset,size) 6484C $Id$ 6485C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 6486C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 6487C i2 ( h2 p11 p7 p8 )_yt 6488 IMPLICIT NONE 6489#include "global.fh" 6490#include "mafdecls.fh" 6491#include "sym.fh" 6492#include "errquit.fh" 6493#include "tce.fh" 6494 INTEGER l_a_offset 6495 INTEGER k_a_offset 6496 INTEGER size 6497 INTEGER length 6498 INTEGER addr 6499 INTEGER h2b 6500 INTEGER p11b 6501 INTEGER p7b 6502 INTEGER p8b 6503 length = 0 6504 DO h2b = 1,noab 6505 DO p11b = noab+1,noab+nvab 6506 DO p7b = noab+1,noab+nvab 6507 DO p8b = p7b,noab+nvab 6508 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+p11b-1) .eq. int_mb(k_spin+ 6509 &p7b-1)+int_mb(k_spin+p8b-1)) THEN 6510 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+p11b-1),ieor(int_mb 6511 &(k_sym+p7b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_y,irrep_t)) T 6512 &HEN 6513 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+p11b- 6514 &1)+int_mb(k_spin+p7b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 6515 length = length + 1 6516 END IF 6517 END IF 6518 END IF 6519 END DO 6520 END DO 6521 END DO 6522 END DO 6523 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 6524 &set)) CALL ERRQUIT('eomccsdt_y1_13_7_1',0,MA_ERR) 6525 int_mb(k_a_offset) = length 6526 addr = 0 6527 size = 0 6528 DO h2b = 1,noab 6529 DO p11b = noab+1,noab+nvab 6530 DO p7b = noab+1,noab+nvab 6531 DO p8b = p7b,noab+nvab 6532 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+p11b-1) .eq. int_mb(k_spin+ 6533 &p7b-1)+int_mb(k_spin+p8b-1)) THEN 6534 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+p11b-1),ieor(int_mb 6535 &(k_sym+p7b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_y,irrep_t)) T 6536 &HEN 6537 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+p11b- 6538 &1)+int_mb(k_spin+p7b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 6539 addr = addr + 1 6540 int_mb(k_a_offset+addr) = p8b - noab - 1 + nvab * (p7b - noab - 1 6541 &+ nvab * (p11b - noab - 1 + nvab * (h2b - 1))) 6542 int_mb(k_a_offset+length+addr) = size 6543 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+p11b-1) * int 6544 &_mb(k_range+p7b-1) * int_mb(k_range+p8b-1) 6545 END IF 6546 END IF 6547 END IF 6548 END DO 6549 END DO 6550 END DO 6551 END DO 6552 RETURN 6553 END 6554 SUBROUTINE OFFSET_eomccsdt_y1_13_8_1_1(l_a_offset,k_a_offset,size) 6555C $Id$ 6556C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 6557C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 6558C i3 ( h2 h5 h9 p3 p4 p7 )_y 6559 IMPLICIT NONE 6560#include "global.fh" 6561#include "mafdecls.fh" 6562#include "sym.fh" 6563#include "errquit.fh" 6564#include "tce.fh" 6565 INTEGER l_a_offset 6566 INTEGER k_a_offset 6567 INTEGER size 6568 INTEGER length 6569 INTEGER addr 6570 INTEGER h2b 6571 INTEGER h5b 6572 INTEGER h9b 6573 INTEGER p3b 6574 INTEGER p4b 6575 INTEGER p7b 6576 length = 0 6577 DO h2b = 1,noab 6578 DO h5b = 1,noab 6579 DO h9b = h5b,noab 6580 DO p3b = noab+1,noab+nvab 6581 DO p4b = p3b,noab+nvab 6582 DO p7b = p4b,noab+nvab 6583 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h5b-1)+int_mb(k_spin+h9b-1) 6584 & .eq. int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+p7b- 6585 &1)) THEN 6586 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h5b-1),ieor(int_mb( 6587 &k_sym+h9b-1),ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),int 6588 &_mb(k_sym+p7b-1)))))) .eq. irrep_y) THEN 6589 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h5b-1 6590 &)+int_mb(k_spin+h9b-1)+int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1)+i 6591 &nt_mb(k_spin+p7b-1).ne.12)) THEN 6592 length = length + 1 6593 END IF 6594 END IF 6595 END IF 6596 END DO 6597 END DO 6598 END DO 6599 END DO 6600 END DO 6601 END DO 6602 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 6603 &set)) CALL ERRQUIT('eomccsdt_y1_13_8_1_1',0,MA_ERR) 6604 int_mb(k_a_offset) = length 6605 addr = 0 6606 size = 0 6607 DO h2b = 1,noab 6608 DO h5b = 1,noab 6609 DO h9b = h5b,noab 6610 DO p3b = noab+1,noab+nvab 6611 DO p4b = p3b,noab+nvab 6612 DO p7b = p4b,noab+nvab 6613 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h5b-1)+int_mb(k_spin+h9b-1) 6614 & .eq. int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+p7b- 6615 &1)) THEN 6616 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h5b-1),ieor(int_mb( 6617 &k_sym+h9b-1),ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),int 6618 &_mb(k_sym+p7b-1)))))) .eq. irrep_y) THEN 6619 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h5b-1 6620 &)+int_mb(k_spin+h9b-1)+int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1)+i 6621 &nt_mb(k_spin+p7b-1).ne.12)) THEN 6622 addr = addr + 1 6623 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (p4b - noab - 1 6624 &+ nvab * (p3b - noab - 1 + nvab * (h9b - 1 + noab * (h5b - 1 + noa 6625 &b * (h2b - 1))))) 6626 int_mb(k_a_offset+length+addr) = size 6627 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h5b-1) * int_ 6628 &mb(k_range+h9b-1) * int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) 6629 &* int_mb(k_range+p7b-1) 6630 END IF 6631 END IF 6632 END IF 6633 END DO 6634 END DO 6635 END DO 6636 END DO 6637 END DO 6638 END DO 6639 RETURN 6640 END 6641 SUBROUTINE OFFSET_eomccsdt_y1_13_8_1(l_a_offset,k_a_offset,size) 6642C $Id$ 6643C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 6644C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 6645C i2 ( h2 h9 h12 p7 )_yt 6646 IMPLICIT NONE 6647#include "global.fh" 6648#include "mafdecls.fh" 6649#include "sym.fh" 6650#include "errquit.fh" 6651#include "tce.fh" 6652 INTEGER l_a_offset 6653 INTEGER k_a_offset 6654 INTEGER size 6655 INTEGER length 6656 INTEGER addr 6657 INTEGER h2b 6658 INTEGER h9b 6659 INTEGER h12b 6660 INTEGER p7b 6661 length = 0 6662 DO h2b = 1,noab 6663 DO h9b = 1,noab 6664 DO h12b = 1,noab 6665 DO p7b = noab+1,noab+nvab 6666 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+h 6667 &12b-1)+int_mb(k_spin+p7b-1)) THEN 6668 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h9b-1),ieor(int_mb( 6669 &k_sym+h12b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_y,irrep_t)) T 6670 &HEN 6671 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h9b-1 6672 &)+int_mb(k_spin+h12b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 6673 length = length + 1 6674 END IF 6675 END IF 6676 END IF 6677 END DO 6678 END DO 6679 END DO 6680 END DO 6681 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 6682 &set)) CALL ERRQUIT('eomccsdt_y1_13_8_1',0,MA_ERR) 6683 int_mb(k_a_offset) = length 6684 addr = 0 6685 size = 0 6686 DO h2b = 1,noab 6687 DO h9b = 1,noab 6688 DO h12b = 1,noab 6689 DO p7b = noab+1,noab+nvab 6690 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h9b-1) .eq. int_mb(k_spin+h 6691 &12b-1)+int_mb(k_spin+p7b-1)) THEN 6692 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h9b-1),ieor(int_mb( 6693 &k_sym+h12b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_y,irrep_t)) T 6694 &HEN 6695 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h9b-1 6696 &)+int_mb(k_spin+h12b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 6697 addr = addr + 1 6698 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h12b - 1 + noab 6699 & * (h9b - 1 + noab * (h2b - 1))) 6700 int_mb(k_a_offset+length+addr) = size 6701 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h9b-1) * int_ 6702 &mb(k_range+h12b-1) * int_mb(k_range+p7b-1) 6703 END IF 6704 END IF 6705 END IF 6706 END DO 6707 END DO 6708 END DO 6709 END DO 6710 RETURN 6711 END 6712 SUBROUTINE OFFSET_eomccsdt_y1_13_9_1_1(l_a_offset,k_a_offset,size) 6713C $Id$ 6714C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 6715C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 6716C i3 ( h2 h9 h10 h13 p3 p7 )_yt 6717 IMPLICIT NONE 6718#include "global.fh" 6719#include "mafdecls.fh" 6720#include "sym.fh" 6721#include "errquit.fh" 6722#include "tce.fh" 6723 INTEGER l_a_offset 6724 INTEGER k_a_offset 6725 INTEGER size 6726 INTEGER length 6727 INTEGER addr 6728 INTEGER h2b 6729 INTEGER h9b 6730 INTEGER h10b 6731 INTEGER h13b 6732 INTEGER p3b 6733 INTEGER p7b 6734 length = 0 6735 DO h2b = 1,noab 6736 DO h9b = 1,noab 6737 DO h10b = h9b,noab 6738 DO h13b = 1,noab 6739 DO p3b = noab+1,noab+nvab 6740 DO p7b = p3b,noab+nvab 6741 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h9b-1)+int_mb(k_spin+h10b-1 6742 &) .eq. int_mb(k_spin+h13b-1)+int_mb(k_spin+p3b-1)+int_mb(k_spin+p7 6743 &b-1)) THEN 6744 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h9b-1),ieor(int_mb( 6745 &k_sym+h10b-1),ieor(int_mb(k_sym+h13b-1),ieor(int_mb(k_sym+p3b-1),i 6746 &nt_mb(k_sym+p7b-1)))))) .eq. ieor(irrep_y,irrep_t)) THEN 6747 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h9b-1 6748 &)+int_mb(k_spin+h10b-1)+int_mb(k_spin+h13b-1)+int_mb(k_spin+p3b-1) 6749 &+int_mb(k_spin+p7b-1).ne.12)) THEN 6750 length = length + 1 6751 END IF 6752 END IF 6753 END IF 6754 END DO 6755 END DO 6756 END DO 6757 END DO 6758 END DO 6759 END DO 6760 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 6761 &set)) CALL ERRQUIT('eomccsdt_y1_13_9_1_1',0,MA_ERR) 6762 int_mb(k_a_offset) = length 6763 addr = 0 6764 size = 0 6765 DO h2b = 1,noab 6766 DO h9b = 1,noab 6767 DO h10b = h9b,noab 6768 DO h13b = 1,noab 6769 DO p3b = noab+1,noab+nvab 6770 DO p7b = p3b,noab+nvab 6771 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h9b-1)+int_mb(k_spin+h10b-1 6772 &) .eq. int_mb(k_spin+h13b-1)+int_mb(k_spin+p3b-1)+int_mb(k_spin+p7 6773 &b-1)) THEN 6774 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h9b-1),ieor(int_mb( 6775 &k_sym+h10b-1),ieor(int_mb(k_sym+h13b-1),ieor(int_mb(k_sym+p3b-1),i 6776 &nt_mb(k_sym+p7b-1)))))) .eq. ieor(irrep_y,irrep_t)) THEN 6777 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h9b-1 6778 &)+int_mb(k_spin+h10b-1)+int_mb(k_spin+h13b-1)+int_mb(k_spin+p3b-1) 6779 &+int_mb(k_spin+p7b-1).ne.12)) THEN 6780 addr = addr + 1 6781 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (p3b - noab - 1 6782 &+ nvab * (h13b - 1 + noab * (h10b - 1 + noab * (h9b - 1 + noab * ( 6783 &h2b - 1))))) 6784 int_mb(k_a_offset+length+addr) = size 6785 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h9b-1) * int_ 6786 &mb(k_range+h10b-1) * int_mb(k_range+h13b-1) * int_mb(k_range+p3b-1 6787 &) * int_mb(k_range+p7b-1) 6788 END IF 6789 END IF 6790 END IF 6791 END DO 6792 END DO 6793 END DO 6794 END DO 6795 END DO 6796 END DO 6797 RETURN 6798 END 6799 SUBROUTINE OFFSET_eomccsdt_y1_13_9_1(l_a_offset,k_a_offset,size) 6800C $Id$ 6801C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 6802C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 6803C i2 ( h2 p11 h13 p3 )_ytt 6804 IMPLICIT NONE 6805#include "global.fh" 6806#include "mafdecls.fh" 6807#include "sym.fh" 6808#include "errquit.fh" 6809#include "tce.fh" 6810 INTEGER l_a_offset 6811 INTEGER k_a_offset 6812 INTEGER size 6813 INTEGER length 6814 INTEGER addr 6815 INTEGER h2b 6816 INTEGER p11b 6817 INTEGER h13b 6818 INTEGER p3b 6819 length = 0 6820 DO h2b = 1,noab 6821 DO p11b = noab+1,noab+nvab 6822 DO h13b = 1,noab 6823 DO p3b = noab+1,noab+nvab 6824 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+p11b-1) .eq. int_mb(k_spin+ 6825 &h13b-1)+int_mb(k_spin+p3b-1)) THEN 6826 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+p11b-1),ieor(int_mb 6827 &(k_sym+h13b-1),int_mb(k_sym+p3b-1)))) .eq. ieor(irrep_y,ieor(irrep 6828 &_t,irrep_t))) THEN 6829 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+p11b- 6830 &1)+int_mb(k_spin+h13b-1)+int_mb(k_spin+p3b-1).ne.8)) THEN 6831 length = length + 1 6832 END IF 6833 END IF 6834 END IF 6835 END DO 6836 END DO 6837 END DO 6838 END DO 6839 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 6840 &set)) CALL ERRQUIT('eomccsdt_y1_13_9_1',0,MA_ERR) 6841 int_mb(k_a_offset) = length 6842 addr = 0 6843 size = 0 6844 DO h2b = 1,noab 6845 DO p11b = noab+1,noab+nvab 6846 DO h13b = 1,noab 6847 DO p3b = noab+1,noab+nvab 6848 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+p11b-1) .eq. int_mb(k_spin+ 6849 &h13b-1)+int_mb(k_spin+p3b-1)) THEN 6850 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+p11b-1),ieor(int_mb 6851 &(k_sym+h13b-1),int_mb(k_sym+p3b-1)))) .eq. ieor(irrep_y,ieor(irrep 6852 &_t,irrep_t))) THEN 6853 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+p11b- 6854 &1)+int_mb(k_spin+h13b-1)+int_mb(k_spin+p3b-1).ne.8)) THEN 6855 addr = addr + 1 6856 int_mb(k_a_offset+addr) = p3b - noab - 1 + nvab * (h13b - 1 + noab 6857 & * (p11b - noab - 1 + nvab * (h2b - 1))) 6858 int_mb(k_a_offset+length+addr) = size 6859 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+p11b-1) * int 6860 &_mb(k_range+h13b-1) * int_mb(k_range+p3b-1) 6861 END IF 6862 END IF 6863 END IF 6864 END DO 6865 END DO 6866 END DO 6867 END DO 6868 RETURN 6869 END 6870 SUBROUTINE OFFSET_eomccsdt_y1_14_1(l_a_offset,k_a_offset,size) 6871C $Id$ 6872C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 6873C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 6874C i1 ( h2 h8 h12 h13 )_yt 6875 IMPLICIT NONE 6876#include "global.fh" 6877#include "mafdecls.fh" 6878#include "sym.fh" 6879#include "errquit.fh" 6880#include "tce.fh" 6881 INTEGER l_a_offset 6882 INTEGER k_a_offset 6883 INTEGER size 6884 INTEGER length 6885 INTEGER addr 6886 INTEGER h2b 6887 INTEGER h8b 6888 INTEGER h12b 6889 INTEGER h13b 6890 length = 0 6891 DO h2b = 1,noab 6892 DO h8b = 1,noab 6893 DO h12b = 1,noab 6894 DO h13b = h12b,noab 6895 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h 6896 &12b-1)+int_mb(k_spin+h13b-1)) THEN 6897 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 6898 &k_sym+h12b-1),int_mb(k_sym+h13b-1)))) .eq. ieor(irrep_y,irrep_t)) 6899 &THEN 6900 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h8b-1 6901 &)+int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b-1).ne.8)) THEN 6902 length = length + 1 6903 END IF 6904 END IF 6905 END IF 6906 END DO 6907 END DO 6908 END DO 6909 END DO 6910 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 6911 &set)) CALL ERRQUIT('eomccsdt_y1_14_1',0,MA_ERR) 6912 int_mb(k_a_offset) = length 6913 addr = 0 6914 size = 0 6915 DO h2b = 1,noab 6916 DO h8b = 1,noab 6917 DO h12b = 1,noab 6918 DO h13b = h12b,noab 6919 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h 6920 &12b-1)+int_mb(k_spin+h13b-1)) THEN 6921 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 6922 &k_sym+h12b-1),int_mb(k_sym+h13b-1)))) .eq. ieor(irrep_y,irrep_t)) 6923 &THEN 6924 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h8b-1 6925 &)+int_mb(k_spin+h12b-1)+int_mb(k_spin+h13b-1).ne.8)) THEN 6926 addr = addr + 1 6927 int_mb(k_a_offset+addr) = h13b - 1 + noab * (h12b - 1 + noab * (h8 6928 &b - 1 + noab * (h2b - 1))) 6929 int_mb(k_a_offset+length+addr) = size 6930 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h8b-1) * int_ 6931 &mb(k_range+h12b-1) * int_mb(k_range+h13b-1) 6932 END IF 6933 END IF 6934 END IF 6935 END DO 6936 END DO 6937 END DO 6938 END DO 6939 RETURN 6940 END 6941 SUBROUTINE OFFSET_eomccsdt_y1_14_3_1(l_a_offset,k_a_offset,size) 6942C $Id$ 6943C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 6944C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 6945C i2 ( h2 h8 h13 p3 )_yt 6946 IMPLICIT NONE 6947#include "global.fh" 6948#include "mafdecls.fh" 6949#include "sym.fh" 6950#include "errquit.fh" 6951#include "tce.fh" 6952 INTEGER l_a_offset 6953 INTEGER k_a_offset 6954 INTEGER size 6955 INTEGER length 6956 INTEGER addr 6957 INTEGER h2b 6958 INTEGER h8b 6959 INTEGER h13b 6960 INTEGER p3b 6961 length = 0 6962 DO h2b = 1,noab 6963 DO h8b = 1,noab 6964 DO h13b = 1,noab 6965 DO p3b = noab+1,noab+nvab 6966 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h 6967 &13b-1)+int_mb(k_spin+p3b-1)) THEN 6968 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 6969 &k_sym+h13b-1),int_mb(k_sym+p3b-1)))) .eq. ieor(irrep_y,irrep_t)) T 6970 &HEN 6971 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h8b-1 6972 &)+int_mb(k_spin+h13b-1)+int_mb(k_spin+p3b-1).ne.8)) THEN 6973 length = length + 1 6974 END IF 6975 END IF 6976 END IF 6977 END DO 6978 END DO 6979 END DO 6980 END DO 6981 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 6982 &set)) CALL ERRQUIT('eomccsdt_y1_14_3_1',0,MA_ERR) 6983 int_mb(k_a_offset) = length 6984 addr = 0 6985 size = 0 6986 DO h2b = 1,noab 6987 DO h8b = 1,noab 6988 DO h13b = 1,noab 6989 DO p3b = noab+1,noab+nvab 6990 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h 6991 &13b-1)+int_mb(k_spin+p3b-1)) THEN 6992 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 6993 &k_sym+h13b-1),int_mb(k_sym+p3b-1)))) .eq. ieor(irrep_y,irrep_t)) T 6994 &HEN 6995 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h8b-1 6996 &)+int_mb(k_spin+h13b-1)+int_mb(k_spin+p3b-1).ne.8)) THEN 6997 addr = addr + 1 6998 int_mb(k_a_offset+addr) = p3b - noab - 1 + nvab * (h13b - 1 + noab 6999 & * (h8b - 1 + noab * (h2b - 1))) 7000 int_mb(k_a_offset+length+addr) = size 7001 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h8b-1) * int_ 7002 &mb(k_range+h13b-1) * int_mb(k_range+p3b-1) 7003 END IF 7004 END IF 7005 END IF 7006 END DO 7007 END DO 7008 END DO 7009 END DO 7010 RETURN 7011 END 7012 SUBROUTINE OFFSET_eomccsdt_y1_14_4_1(l_a_offset,k_a_offset,size) 7013C $Id$ 7014C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 7015C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 7016C i2 ( h2 h8 h12 p7 )_yt 7017 IMPLICIT NONE 7018#include "global.fh" 7019#include "mafdecls.fh" 7020#include "sym.fh" 7021#include "errquit.fh" 7022#include "tce.fh" 7023 INTEGER l_a_offset 7024 INTEGER k_a_offset 7025 INTEGER size 7026 INTEGER length 7027 INTEGER addr 7028 INTEGER h2b 7029 INTEGER h8b 7030 INTEGER h12b 7031 INTEGER p7b 7032 length = 0 7033 DO h2b = 1,noab 7034 DO h8b = 1,noab 7035 DO h12b = 1,noab 7036 DO p7b = noab+1,noab+nvab 7037 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h 7038 &12b-1)+int_mb(k_spin+p7b-1)) THEN 7039 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 7040 &k_sym+h12b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_y,irrep_t)) T 7041 &HEN 7042 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h8b-1 7043 &)+int_mb(k_spin+h12b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 7044 length = length + 1 7045 END IF 7046 END IF 7047 END IF 7048 END DO 7049 END DO 7050 END DO 7051 END DO 7052 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 7053 &set)) CALL ERRQUIT('eomccsdt_y1_14_4_1',0,MA_ERR) 7054 int_mb(k_a_offset) = length 7055 addr = 0 7056 size = 0 7057 DO h2b = 1,noab 7058 DO h8b = 1,noab 7059 DO h12b = 1,noab 7060 DO p7b = noab+1,noab+nvab 7061 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h 7062 &12b-1)+int_mb(k_spin+p7b-1)) THEN 7063 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 7064 &k_sym+h12b-1),int_mb(k_sym+p7b-1)))) .eq. ieor(irrep_y,irrep_t)) T 7065 &HEN 7066 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h8b-1 7067 &)+int_mb(k_spin+h12b-1)+int_mb(k_spin+p7b-1).ne.8)) THEN 7068 addr = addr + 1 7069 int_mb(k_a_offset+addr) = p7b - noab - 1 + nvab * (h12b - 1 + noab 7070 & * (h8b - 1 + noab * (h2b - 1))) 7071 int_mb(k_a_offset+length+addr) = size 7072 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h8b-1) * int_ 7073 &mb(k_range+h12b-1) * int_mb(k_range+p7b-1) 7074 END IF 7075 END IF 7076 END IF 7077 END DO 7078 END DO 7079 END DO 7080 END DO 7081 RETURN 7082 END 7083 SUBROUTINE OFFSET_eomccsdt_y1_15_1(l_a_offset,k_a_offset,size) 7084C $Id$ 7085C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 7086C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 7087C i1 ( h2 p11 h10 p12 )_yt 7088 IMPLICIT NONE 7089#include "global.fh" 7090#include "mafdecls.fh" 7091#include "sym.fh" 7092#include "errquit.fh" 7093#include "tce.fh" 7094 INTEGER l_a_offset 7095 INTEGER k_a_offset 7096 INTEGER size 7097 INTEGER length 7098 INTEGER addr 7099 INTEGER h2b 7100 INTEGER p11b 7101 INTEGER h10b 7102 INTEGER p12b 7103 length = 0 7104 DO h2b = 1,noab 7105 DO p11b = noab+1,noab+nvab 7106 DO h10b = 1,noab 7107 DO p12b = noab+1,noab+nvab 7108 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+p11b-1) .eq. int_mb(k_spin+ 7109 &h10b-1)+int_mb(k_spin+p12b-1)) THEN 7110 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+p11b-1),ieor(int_mb 7111 &(k_sym+h10b-1),int_mb(k_sym+p12b-1)))) .eq. ieor(irrep_y,irrep_t)) 7112 & THEN 7113 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+p11b- 7114 &1)+int_mb(k_spin+h10b-1)+int_mb(k_spin+p12b-1).ne.8)) THEN 7115 length = length + 1 7116 END IF 7117 END IF 7118 END IF 7119 END DO 7120 END DO 7121 END DO 7122 END DO 7123 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 7124 &set)) CALL ERRQUIT('eomccsdt_y1_15_1',0,MA_ERR) 7125 int_mb(k_a_offset) = length 7126 addr = 0 7127 size = 0 7128 DO h2b = 1,noab 7129 DO p11b = noab+1,noab+nvab 7130 DO h10b = 1,noab 7131 DO p12b = noab+1,noab+nvab 7132 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+p11b-1) .eq. int_mb(k_spin+ 7133 &h10b-1)+int_mb(k_spin+p12b-1)) THEN 7134 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+p11b-1),ieor(int_mb 7135 &(k_sym+h10b-1),int_mb(k_sym+p12b-1)))) .eq. ieor(irrep_y,irrep_t)) 7136 & THEN 7137 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+p11b- 7138 &1)+int_mb(k_spin+h10b-1)+int_mb(k_spin+p12b-1).ne.8)) THEN 7139 addr = addr + 1 7140 int_mb(k_a_offset+addr) = p12b - noab - 1 + nvab * (h10b - 1 + noa 7141 &b * (p11b - noab - 1 + nvab * (h2b - 1))) 7142 int_mb(k_a_offset+length+addr) = size 7143 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+p11b-1) * int 7144 &_mb(k_range+h10b-1) * int_mb(k_range+p12b-1) 7145 END IF 7146 END IF 7147 END IF 7148 END DO 7149 END DO 7150 END DO 7151 END DO 7152 RETURN 7153 END 7154 SUBROUTINE OFFSET_eomccsdt_y1_15_3_1(l_a_offset,k_a_offset,size) 7155C $Id$ 7156C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 7157C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 7158C i2 ( h2 h6 h10 p12 )_yt 7159 IMPLICIT NONE 7160#include "global.fh" 7161#include "mafdecls.fh" 7162#include "sym.fh" 7163#include "errquit.fh" 7164#include "tce.fh" 7165 INTEGER l_a_offset 7166 INTEGER k_a_offset 7167 INTEGER size 7168 INTEGER length 7169 INTEGER addr 7170 INTEGER h2b 7171 INTEGER h6b 7172 INTEGER h10b 7173 INTEGER p12b 7174 length = 0 7175 DO h2b = 1,noab 7176 DO h6b = 1,noab 7177 DO h10b = 1,noab 7178 DO p12b = noab+1,noab+nvab 7179 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h6b-1) .eq. int_mb(k_spin+h 7180 &10b-1)+int_mb(k_spin+p12b-1)) THEN 7181 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h6b-1),ieor(int_mb( 7182 &k_sym+h10b-1),int_mb(k_sym+p12b-1)))) .eq. ieor(irrep_y,irrep_t)) 7183 &THEN 7184 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h6b-1 7185 &)+int_mb(k_spin+h10b-1)+int_mb(k_spin+p12b-1).ne.8)) THEN 7186 length = length + 1 7187 END IF 7188 END IF 7189 END IF 7190 END DO 7191 END DO 7192 END DO 7193 END DO 7194 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 7195 &set)) CALL ERRQUIT('eomccsdt_y1_15_3_1',0,MA_ERR) 7196 int_mb(k_a_offset) = length 7197 addr = 0 7198 size = 0 7199 DO h2b = 1,noab 7200 DO h6b = 1,noab 7201 DO h10b = 1,noab 7202 DO p12b = noab+1,noab+nvab 7203 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h6b-1) .eq. int_mb(k_spin+h 7204 &10b-1)+int_mb(k_spin+p12b-1)) THEN 7205 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h6b-1),ieor(int_mb( 7206 &k_sym+h10b-1),int_mb(k_sym+p12b-1)))) .eq. ieor(irrep_y,irrep_t)) 7207 &THEN 7208 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h6b-1 7209 &)+int_mb(k_spin+h10b-1)+int_mb(k_spin+p12b-1).ne.8)) THEN 7210 addr = addr + 1 7211 int_mb(k_a_offset+addr) = p12b - noab - 1 + nvab * (h10b - 1 + noa 7212 &b * (h6b - 1 + noab * (h2b - 1))) 7213 int_mb(k_a_offset+length+addr) = size 7214 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h6b-1) * int_ 7215 &mb(k_range+h10b-1) * int_mb(k_range+p12b-1) 7216 END IF 7217 END IF 7218 END IF 7219 END DO 7220 END DO 7221 END DO 7222 END DO 7223 RETURN 7224 END 7225 SUBROUTINE OFFSET_eomccsdt_y1_15_4_1(l_a_offset,k_a_offset,size) 7226C $Id$ 7227C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 7228C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 7229C i2 ( h2 h5 h6 h10 p3 p12 )_yt 7230 IMPLICIT NONE 7231#include "global.fh" 7232#include "mafdecls.fh" 7233#include "sym.fh" 7234#include "errquit.fh" 7235#include "tce.fh" 7236 INTEGER l_a_offset 7237 INTEGER k_a_offset 7238 INTEGER size 7239 INTEGER length 7240 INTEGER addr 7241 INTEGER h2b 7242 INTEGER h5b 7243 INTEGER h6b 7244 INTEGER h10b 7245 INTEGER p3b 7246 INTEGER p12b 7247 length = 0 7248 DO h2b = 1,noab 7249 DO h5b = 1,noab 7250 DO h6b = h5b,noab 7251 DO h10b = 1,noab 7252 DO p3b = noab+1,noab+nvab 7253 DO p12b = p3b,noab+nvab 7254 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h5b-1)+int_mb(k_spin+h6b-1) 7255 & .eq. int_mb(k_spin+h10b-1)+int_mb(k_spin+p3b-1)+int_mb(k_spin+p12 7256 &b-1)) THEN 7257 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h5b-1),ieor(int_mb( 7258 &k_sym+h6b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+p3b-1),in 7259 &t_mb(k_sym+p12b-1)))))) .eq. ieor(irrep_y,irrep_t)) THEN 7260 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h5b-1 7261 &)+int_mb(k_spin+h6b-1)+int_mb(k_spin+h10b-1)+int_mb(k_spin+p3b-1)+ 7262 &int_mb(k_spin+p12b-1).ne.12)) THEN 7263 length = length + 1 7264 END IF 7265 END IF 7266 END IF 7267 END DO 7268 END DO 7269 END DO 7270 END DO 7271 END DO 7272 END DO 7273 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 7274 &set)) CALL ERRQUIT('eomccsdt_y1_15_4_1',0,MA_ERR) 7275 int_mb(k_a_offset) = length 7276 addr = 0 7277 size = 0 7278 DO h2b = 1,noab 7279 DO h5b = 1,noab 7280 DO h6b = h5b,noab 7281 DO h10b = 1,noab 7282 DO p3b = noab+1,noab+nvab 7283 DO p12b = p3b,noab+nvab 7284 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h5b-1)+int_mb(k_spin+h6b-1) 7285 & .eq. int_mb(k_spin+h10b-1)+int_mb(k_spin+p3b-1)+int_mb(k_spin+p12 7286 &b-1)) THEN 7287 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h5b-1),ieor(int_mb( 7288 &k_sym+h6b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb(k_sym+p3b-1),in 7289 &t_mb(k_sym+p12b-1)))))) .eq. ieor(irrep_y,irrep_t)) THEN 7290 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h5b-1 7291 &)+int_mb(k_spin+h6b-1)+int_mb(k_spin+h10b-1)+int_mb(k_spin+p3b-1)+ 7292 &int_mb(k_spin+p12b-1).ne.12)) THEN 7293 addr = addr + 1 7294 int_mb(k_a_offset+addr) = p12b - noab - 1 + nvab * (p3b - noab - 1 7295 & + nvab * (h10b - 1 + noab * (h6b - 1 + noab * (h5b - 1 + noab * ( 7296 &h2b - 1))))) 7297 int_mb(k_a_offset+length+addr) = size 7298 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h5b-1) * int_ 7299 &mb(k_range+h6b-1) * int_mb(k_range+h10b-1) * int_mb(k_range+p3b-1) 7300 & * int_mb(k_range+p12b-1) 7301 END IF 7302 END IF 7303 END IF 7304 END DO 7305 END DO 7306 END DO 7307 END DO 7308 END DO 7309 END DO 7310 RETURN 7311 END 7312 SUBROUTINE OFFSET_eomccsdt_y1_16_1(l_a_offset,k_a_offset,size) 7313C $Id$ 7314C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 7315C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 7316C i1 ( h7 h8 h6 p1 )_yt 7317 IMPLICIT NONE 7318#include "global.fh" 7319#include "mafdecls.fh" 7320#include "sym.fh" 7321#include "errquit.fh" 7322#include "tce.fh" 7323 INTEGER l_a_offset 7324 INTEGER k_a_offset 7325 INTEGER size 7326 INTEGER length 7327 INTEGER addr 7328 INTEGER h7b 7329 INTEGER h8b 7330 INTEGER p1b 7331 INTEGER h6b 7332 length = 0 7333 DO h7b = 1,noab 7334 DO h8b = h7b,noab 7335 DO p1b = noab+1,noab+nvab 7336 DO h6b = 1,noab 7337 IF (int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h 7338 &6b-1)+int_mb(k_spin+p1b-1)) THEN 7339 IF (ieor(int_mb(k_sym+h7b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 7340 &k_sym+h6b-1),int_mb(k_sym+p1b-1)))) .eq. ieor(irrep_y,irrep_t)) TH 7341 &EN 7342 IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1 7343 &)+int_mb(k_spin+h6b-1)+int_mb(k_spin+p1b-1).ne.8)) THEN 7344 length = length + 1 7345 END IF 7346 END IF 7347 END IF 7348 END DO 7349 END DO 7350 END DO 7351 END DO 7352 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 7353 &set)) CALL ERRQUIT('eomccsdt_y1_16_1',0,MA_ERR) 7354 int_mb(k_a_offset) = length 7355 addr = 0 7356 size = 0 7357 DO h7b = 1,noab 7358 DO h8b = h7b,noab 7359 DO p1b = noab+1,noab+nvab 7360 DO h6b = 1,noab 7361 IF (int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h 7362 &6b-1)+int_mb(k_spin+p1b-1)) THEN 7363 IF (ieor(int_mb(k_sym+h7b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 7364 &k_sym+h6b-1),int_mb(k_sym+p1b-1)))) .eq. ieor(irrep_y,irrep_t)) TH 7365 &EN 7366 IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+h8b-1 7367 &)+int_mb(k_spin+h6b-1)+int_mb(k_spin+p1b-1).ne.8)) THEN 7368 addr = addr + 1 7369 int_mb(k_a_offset+addr) = h6b - 1 + noab * (p1b - noab - 1 + nvab 7370 &* (h8b - 1 + noab * (h7b - 1))) 7371 int_mb(k_a_offset+length+addr) = size 7372 size = size + int_mb(k_range+h7b-1) * int_mb(k_range+h8b-1) * int_ 7373 &mb(k_range+p1b-1) * int_mb(k_range+h6b-1) 7374 END IF 7375 END IF 7376 END IF 7377 END DO 7378 END DO 7379 END DO 7380 END DO 7381 RETURN 7382 END 7383 SUBROUTINE OFFSET_eomccsdt_y1_17_1_1(l_a_offset,k_a_offset,size) 7384C $Id$ 7385C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 7386C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 7387C i2 ( h2 p15 h16 p4 )_v 7388 IMPLICIT NONE 7389#include "global.fh" 7390#include "mafdecls.fh" 7391#include "sym.fh" 7392#include "errquit.fh" 7393#include "tce.fh" 7394 INTEGER l_a_offset 7395 INTEGER k_a_offset 7396 INTEGER size 7397 INTEGER length 7398 INTEGER addr 7399 INTEGER h2b 7400 INTEGER p15b 7401 INTEGER h16b 7402 INTEGER p4b 7403 length = 0 7404 DO h2b = 1,noab 7405 DO p15b = noab+1,noab+nvab 7406 DO h16b = 1,noab 7407 DO p4b = noab+1,noab+nvab 7408 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+p15b-1) .eq. int_mb(k_spin+ 7409 &h16b-1)+int_mb(k_spin+p4b-1)) THEN 7410 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+p15b-1),ieor(int_mb 7411 &(k_sym+h16b-1),int_mb(k_sym+p4b-1)))) .eq. irrep_v) THEN 7412 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+p15b- 7413 &1)+int_mb(k_spin+h16b-1)+int_mb(k_spin+p4b-1).ne.8)) THEN 7414 length = length + 1 7415 END IF 7416 END IF 7417 END IF 7418 END DO 7419 END DO 7420 END DO 7421 END DO 7422 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 7423 &set)) CALL ERRQUIT('eomccsdt_y1_17_1_1',0,MA_ERR) 7424 int_mb(k_a_offset) = length 7425 addr = 0 7426 size = 0 7427 DO h2b = 1,noab 7428 DO p15b = noab+1,noab+nvab 7429 DO h16b = 1,noab 7430 DO p4b = noab+1,noab+nvab 7431 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+p15b-1) .eq. int_mb(k_spin+ 7432 &h16b-1)+int_mb(k_spin+p4b-1)) THEN 7433 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+p15b-1),ieor(int_mb 7434 &(k_sym+h16b-1),int_mb(k_sym+p4b-1)))) .eq. irrep_v) THEN 7435 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+p15b- 7436 &1)+int_mb(k_spin+h16b-1)+int_mb(k_spin+p4b-1).ne.8)) THEN 7437 addr = addr + 1 7438 int_mb(k_a_offset+addr) = p4b - noab - 1 + nvab * (h16b - 1 + noab 7439 & * (p15b - noab - 1 + nvab * (h2b - 1))) 7440 int_mb(k_a_offset+length+addr) = size 7441 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+p15b-1) * int 7442 &_mb(k_range+h16b-1) * int_mb(k_range+p4b-1) 7443 END IF 7444 END IF 7445 END IF 7446 END DO 7447 END DO 7448 END DO 7449 END DO 7450 RETURN 7451 END 7452 SUBROUTINE OFFSET_eomccsdt_y1_17_1_4_1(l_a_offset,k_a_offset,size) 7453C $Id$ 7454C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 7455C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 7456C i3 ( h2 h10 p4 p8 )_v 7457 IMPLICIT NONE 7458#include "global.fh" 7459#include "mafdecls.fh" 7460#include "sym.fh" 7461#include "errquit.fh" 7462#include "tce.fh" 7463 INTEGER l_a_offset 7464 INTEGER k_a_offset 7465 INTEGER size 7466 INTEGER length 7467 INTEGER addr 7468 INTEGER h2b 7469 INTEGER h10b 7470 INTEGER p4b 7471 INTEGER p8b 7472 length = 0 7473 DO h2b = 1,noab 7474 DO h10b = 1,noab 7475 DO p4b = noab+1,noab+nvab 7476 DO p8b = p4b,noab+nvab 7477 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+ 7478 &p4b-1)+int_mb(k_spin+p8b-1)) THEN 7479 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb 7480 &(k_sym+p4b-1),int_mb(k_sym+p8b-1)))) .eq. irrep_v) THEN 7481 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h10b- 7482 &1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 7483 length = length + 1 7484 END IF 7485 END IF 7486 END IF 7487 END DO 7488 END DO 7489 END DO 7490 END DO 7491 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 7492 &set)) CALL ERRQUIT('eomccsdt_y1_17_1_4_1',0,MA_ERR) 7493 int_mb(k_a_offset) = length 7494 addr = 0 7495 size = 0 7496 DO h2b = 1,noab 7497 DO h10b = 1,noab 7498 DO p4b = noab+1,noab+nvab 7499 DO p8b = p4b,noab+nvab 7500 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h10b-1) .eq. int_mb(k_spin+ 7501 &p4b-1)+int_mb(k_spin+p8b-1)) THEN 7502 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb 7503 &(k_sym+p4b-1),int_mb(k_sym+p8b-1)))) .eq. irrep_v) THEN 7504 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h10b- 7505 &1)+int_mb(k_spin+p4b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 7506 addr = addr + 1 7507 int_mb(k_a_offset+addr) = p8b - noab - 1 + nvab * (p4b - noab - 1 7508 &+ nvab * (h10b - 1 + noab * (h2b - 1))) 7509 int_mb(k_a_offset+length+addr) = size 7510 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h10b-1) * int 7511 &_mb(k_range+p4b-1) * int_mb(k_range+p8b-1) 7512 END IF 7513 END IF 7514 END IF 7515 END DO 7516 END DO 7517 END DO 7518 END DO 7519 RETURN 7520 END 7521 SUBROUTINE OFFSET_eomccsdt_y1_17_1(l_a_offset,k_a_offset,size) 7522C $Id$ 7523C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 7524C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 7525C i1 ( h2 p13 p15 h12 h14 h16 )_vt 7526 IMPLICIT NONE 7527#include "global.fh" 7528#include "mafdecls.fh" 7529#include "sym.fh" 7530#include "errquit.fh" 7531#include "tce.fh" 7532 INTEGER l_a_offset 7533 INTEGER k_a_offset 7534 INTEGER size 7535 INTEGER length 7536 INTEGER addr 7537 INTEGER h2b 7538 INTEGER p13b 7539 INTEGER p15b 7540 INTEGER h12b 7541 INTEGER h14b 7542 INTEGER h16b 7543 length = 0 7544 DO h2b = 1,noab 7545 DO p13b = noab+1,noab+nvab 7546 DO p15b = p13b,noab+nvab 7547 DO h12b = 1,noab 7548 DO h14b = h12b,noab 7549 DO h16b = h14b,noab 7550 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+p13b-1)+int_mb(k_spin+p15b- 7551 &1) .eq. int_mb(k_spin+h12b-1)+int_mb(k_spin+h14b-1)+int_mb(k_spin+ 7552 &h16b-1)) THEN 7553 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+p13b-1),ieor(int_mb 7554 &(k_sym+p15b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+h14b-1) 7555 &,int_mb(k_sym+h16b-1)))))) .eq. ieor(irrep_v,irrep_t)) THEN 7556 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+p13b- 7557 &1)+int_mb(k_spin+p15b-1)+int_mb(k_spin+h12b-1)+int_mb(k_spin+h14b- 7558 &1)+int_mb(k_spin+h16b-1).ne.12)) THEN 7559 length = length + 1 7560 END IF 7561 END IF 7562 END IF 7563 END DO 7564 END DO 7565 END DO 7566 END DO 7567 END DO 7568 END DO 7569 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 7570 &set)) CALL ERRQUIT('eomccsdt_y1_17_1',0,MA_ERR) 7571 int_mb(k_a_offset) = length 7572 addr = 0 7573 size = 0 7574 DO h2b = 1,noab 7575 DO p13b = noab+1,noab+nvab 7576 DO p15b = p13b,noab+nvab 7577 DO h12b = 1,noab 7578 DO h14b = h12b,noab 7579 DO h16b = h14b,noab 7580 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+p13b-1)+int_mb(k_spin+p15b- 7581 &1) .eq. int_mb(k_spin+h12b-1)+int_mb(k_spin+h14b-1)+int_mb(k_spin+ 7582 &h16b-1)) THEN 7583 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+p13b-1),ieor(int_mb 7584 &(k_sym+p15b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+h14b-1) 7585 &,int_mb(k_sym+h16b-1)))))) .eq. ieor(irrep_v,irrep_t)) THEN 7586 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+p13b- 7587 &1)+int_mb(k_spin+p15b-1)+int_mb(k_spin+h12b-1)+int_mb(k_spin+h14b- 7588 &1)+int_mb(k_spin+h16b-1).ne.12)) THEN 7589 addr = addr + 1 7590 int_mb(k_a_offset+addr) = h16b - 1 + noab * (h14b - 1 + noab * (h1 7591 &2b - 1 + noab * (p15b - noab - 1 + nvab * (p13b - noab - 1 + nvab 7592 &* (h2b - 1))))) 7593 int_mb(k_a_offset+length+addr) = size 7594 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+p13b-1) * int 7595 &_mb(k_range+p15b-1) * int_mb(k_range+h12b-1) * int_mb(k_range+h14b 7596 &-1) * int_mb(k_range+h16b-1) 7597 END IF 7598 END IF 7599 END IF 7600 END DO 7601 END DO 7602 END DO 7603 END DO 7604 END DO 7605 END DO 7606 RETURN 7607 END 7608 SUBROUTINE OFFSET_eomccsdt_y1_17_2_1(l_a_offset,k_a_offset,size) 7609C $Id$ 7610C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 7611C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 7612C i2 ( h2 p4 )_f 7613 IMPLICIT NONE 7614#include "global.fh" 7615#include "mafdecls.fh" 7616#include "sym.fh" 7617#include "errquit.fh" 7618#include "tce.fh" 7619 INTEGER l_a_offset 7620 INTEGER k_a_offset 7621 INTEGER size 7622 INTEGER length 7623 INTEGER addr 7624 INTEGER h2b 7625 INTEGER p4b 7626 length = 0 7627 DO h2b = 1,noab 7628 DO p4b = noab+1,noab+nvab 7629 IF (int_mb(k_spin+h2b-1) .eq. int_mb(k_spin+p4b-1)) THEN 7630 IF (ieor(int_mb(k_sym+h2b-1),int_mb(k_sym+p4b-1)) .eq. irrep_f) TH 7631 &EN 7632 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+p4b-1 7633 &).ne.4)) THEN 7634 length = length + 1 7635 END IF 7636 END IF 7637 END IF 7638 END DO 7639 END DO 7640 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 7641 &set)) CALL ERRQUIT('eomccsdt_y1_17_2_1',0,MA_ERR) 7642 int_mb(k_a_offset) = length 7643 addr = 0 7644 size = 0 7645 DO h2b = 1,noab 7646 DO p4b = noab+1,noab+nvab 7647 IF (int_mb(k_spin+h2b-1) .eq. int_mb(k_spin+p4b-1)) THEN 7648 IF (ieor(int_mb(k_sym+h2b-1),int_mb(k_sym+p4b-1)) .eq. irrep_f) TH 7649 &EN 7650 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+p4b-1 7651 &).ne.4)) THEN 7652 addr = addr + 1 7653 int_mb(k_a_offset+addr) = p4b - noab - 1 + nvab * (h2b - 1) 7654 int_mb(k_a_offset+length+addr) = size 7655 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+p4b-1) 7656 END IF 7657 END IF 7658 END IF 7659 END DO 7660 END DO 7661 RETURN 7662 END 7663 SUBROUTINE OFFSET_eomccsdt_y1_17_3_1(l_a_offset,k_a_offset,size) 7664C $Id$ 7665C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 7666C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 7667C i2 ( h2 h8 h16 p5 )_v 7668 IMPLICIT NONE 7669#include "global.fh" 7670#include "mafdecls.fh" 7671#include "sym.fh" 7672#include "errquit.fh" 7673#include "tce.fh" 7674 INTEGER l_a_offset 7675 INTEGER k_a_offset 7676 INTEGER size 7677 INTEGER length 7678 INTEGER addr 7679 INTEGER h2b 7680 INTEGER h8b 7681 INTEGER h16b 7682 INTEGER p5b 7683 length = 0 7684 DO h2b = 1,noab 7685 DO h8b = 1,noab 7686 DO h16b = 1,noab 7687 DO p5b = noab+1,noab+nvab 7688 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h 7689 &16b-1)+int_mb(k_spin+p5b-1)) THEN 7690 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 7691 &k_sym+h16b-1),int_mb(k_sym+p5b-1)))) .eq. irrep_v) THEN 7692 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h8b-1 7693 &)+int_mb(k_spin+h16b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN 7694 length = length + 1 7695 END IF 7696 END IF 7697 END IF 7698 END DO 7699 END DO 7700 END DO 7701 END DO 7702 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 7703 &set)) CALL ERRQUIT('eomccsdt_y1_17_3_1',0,MA_ERR) 7704 int_mb(k_a_offset) = length 7705 addr = 0 7706 size = 0 7707 DO h2b = 1,noab 7708 DO h8b = 1,noab 7709 DO h16b = 1,noab 7710 DO p5b = noab+1,noab+nvab 7711 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h 7712 &16b-1)+int_mb(k_spin+p5b-1)) THEN 7713 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 7714 &k_sym+h16b-1),int_mb(k_sym+p5b-1)))) .eq. irrep_v) THEN 7715 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h8b-1 7716 &)+int_mb(k_spin+h16b-1)+int_mb(k_spin+p5b-1).ne.8)) THEN 7717 addr = addr + 1 7718 int_mb(k_a_offset+addr) = p5b - noab - 1 + nvab * (h16b - 1 + noab 7719 & * (h8b - 1 + noab * (h2b - 1))) 7720 int_mb(k_a_offset+length+addr) = size 7721 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h8b-1) * int_ 7722 &mb(k_range+h16b-1) * int_mb(k_range+p5b-1) 7723 END IF 7724 END IF 7725 END IF 7726 END DO 7727 END DO 7728 END DO 7729 END DO 7730 RETURN 7731 END 7732 SUBROUTINE OFFSET_eomccsdt_y1_17_5_1(l_a_offset,k_a_offset,size) 7733C $Id$ 7734C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 7735C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 7736C i2 ( h2 h10 p13 h12 h14 h16 )_vt 7737 IMPLICIT NONE 7738#include "global.fh" 7739#include "mafdecls.fh" 7740#include "sym.fh" 7741#include "errquit.fh" 7742#include "tce.fh" 7743 INTEGER l_a_offset 7744 INTEGER k_a_offset 7745 INTEGER size 7746 INTEGER length 7747 INTEGER addr 7748 INTEGER h2b 7749 INTEGER h10b 7750 INTEGER p13b 7751 INTEGER h12b 7752 INTEGER h14b 7753 INTEGER h16b 7754 length = 0 7755 DO h2b = 1,noab 7756 DO h10b = 1,noab 7757 DO p13b = noab+1,noab+nvab 7758 DO h12b = 1,noab 7759 DO h14b = h12b,noab 7760 DO h16b = h14b,noab 7761 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h10b-1)+int_mb(k_spin+p13b- 7762 &1) .eq. int_mb(k_spin+h12b-1)+int_mb(k_spin+h14b-1)+int_mb(k_spin+ 7763 &h16b-1)) THEN 7764 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb 7765 &(k_sym+p13b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+h14b-1) 7766 &,int_mb(k_sym+h16b-1)))))) .eq. ieor(irrep_v,irrep_t)) THEN 7767 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h10b- 7768 &1)+int_mb(k_spin+p13b-1)+int_mb(k_spin+h12b-1)+int_mb(k_spin+h14b- 7769 &1)+int_mb(k_spin+h16b-1).ne.12)) THEN 7770 length = length + 1 7771 END IF 7772 END IF 7773 END IF 7774 END DO 7775 END DO 7776 END DO 7777 END DO 7778 END DO 7779 END DO 7780 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 7781 &set)) CALL ERRQUIT('eomccsdt_y1_17_5_1',0,MA_ERR) 7782 int_mb(k_a_offset) = length 7783 addr = 0 7784 size = 0 7785 DO h2b = 1,noab 7786 DO h10b = 1,noab 7787 DO p13b = noab+1,noab+nvab 7788 DO h12b = 1,noab 7789 DO h14b = h12b,noab 7790 DO h16b = h14b,noab 7791 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h10b-1)+int_mb(k_spin+p13b- 7792 &1) .eq. int_mb(k_spin+h12b-1)+int_mb(k_spin+h14b-1)+int_mb(k_spin+ 7793 &h16b-1)) THEN 7794 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h10b-1),ieor(int_mb 7795 &(k_sym+p13b-1),ieor(int_mb(k_sym+h12b-1),ieor(int_mb(k_sym+h14b-1) 7796 &,int_mb(k_sym+h16b-1)))))) .eq. ieor(irrep_v,irrep_t)) THEN 7797 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h10b- 7798 &1)+int_mb(k_spin+p13b-1)+int_mb(k_spin+h12b-1)+int_mb(k_spin+h14b- 7799 &1)+int_mb(k_spin+h16b-1).ne.12)) THEN 7800 addr = addr + 1 7801 int_mb(k_a_offset+addr) = h16b - 1 + noab * (h14b - 1 + noab * (h1 7802 &2b - 1 + noab * (p13b - noab - 1 + nvab * (h10b - 1 + noab * (h2b 7803 &- 1))))) 7804 int_mb(k_a_offset+length+addr) = size 7805 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h10b-1) * int 7806 &_mb(k_range+p13b-1) * int_mb(k_range+h12b-1) * int_mb(k_range+h14b 7807 &-1) * int_mb(k_range+h16b-1) 7808 END IF 7809 END IF 7810 END IF 7811 END DO 7812 END DO 7813 END DO 7814 END DO 7815 END DO 7816 END DO 7817 RETURN 7818 END 7819 SUBROUTINE OFFSET_eomccsdt_y1_17_6_1_1(l_a_offset,k_a_offset,size) 7820C $Id$ 7821C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 7822C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 7823C i3 ( h2 h6 h12 p8 )_vt 7824 IMPLICIT NONE 7825#include "global.fh" 7826#include "mafdecls.fh" 7827#include "sym.fh" 7828#include "errquit.fh" 7829#include "tce.fh" 7830 INTEGER l_a_offset 7831 INTEGER k_a_offset 7832 INTEGER size 7833 INTEGER length 7834 INTEGER addr 7835 INTEGER h2b 7836 INTEGER h6b 7837 INTEGER h12b 7838 INTEGER p8b 7839 length = 0 7840 DO h2b = 1,noab 7841 DO h6b = 1,noab 7842 DO h12b = 1,noab 7843 DO p8b = noab+1,noab+nvab 7844 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h6b-1) .eq. int_mb(k_spin+h 7845 &12b-1)+int_mb(k_spin+p8b-1)) THEN 7846 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h6b-1),ieor(int_mb( 7847 &k_sym+h12b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_v,irrep_t)) T 7848 &HEN 7849 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h6b-1 7850 &)+int_mb(k_spin+h12b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 7851 length = length + 1 7852 END IF 7853 END IF 7854 END IF 7855 END DO 7856 END DO 7857 END DO 7858 END DO 7859 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 7860 &set)) CALL ERRQUIT('eomccsdt_y1_17_6_1_1',0,MA_ERR) 7861 int_mb(k_a_offset) = length 7862 addr = 0 7863 size = 0 7864 DO h2b = 1,noab 7865 DO h6b = 1,noab 7866 DO h12b = 1,noab 7867 DO p8b = noab+1,noab+nvab 7868 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+h6b-1) .eq. int_mb(k_spin+h 7869 &12b-1)+int_mb(k_spin+p8b-1)) THEN 7870 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+h6b-1),ieor(int_mb( 7871 &k_sym+h12b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_v,irrep_t)) T 7872 &HEN 7873 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+h6b-1 7874 &)+int_mb(k_spin+h12b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 7875 addr = addr + 1 7876 int_mb(k_a_offset+addr) = p8b - noab - 1 + nvab * (h12b - 1 + noab 7877 & * (h6b - 1 + noab * (h2b - 1))) 7878 int_mb(k_a_offset+length+addr) = size 7879 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+h6b-1) * int_ 7880 &mb(k_range+h12b-1) * int_mb(k_range+p8b-1) 7881 END IF 7882 END IF 7883 END IF 7884 END DO 7885 END DO 7886 END DO 7887 END DO 7888 RETURN 7889 END 7890 SUBROUTINE OFFSET_eomccsdt_y1_17_6_1(l_a_offset,k_a_offset,size) 7891C $Id$ 7892C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 7893C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 7894C i2 ( h2 p13 h12 p8 )_vtt 7895 IMPLICIT NONE 7896#include "global.fh" 7897#include "mafdecls.fh" 7898#include "sym.fh" 7899#include "errquit.fh" 7900#include "tce.fh" 7901 INTEGER l_a_offset 7902 INTEGER k_a_offset 7903 INTEGER size 7904 INTEGER length 7905 INTEGER addr 7906 INTEGER h2b 7907 INTEGER p13b 7908 INTEGER h12b 7909 INTEGER p8b 7910 length = 0 7911 DO h2b = 1,noab 7912 DO p13b = noab+1,noab+nvab 7913 DO h12b = 1,noab 7914 DO p8b = noab+1,noab+nvab 7915 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+p13b-1) .eq. int_mb(k_spin+ 7916 &h12b-1)+int_mb(k_spin+p8b-1)) THEN 7917 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+p13b-1),ieor(int_mb 7918 &(k_sym+h12b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_v,ieor(irrep 7919 &_t,irrep_t))) THEN 7920 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+p13b- 7921 &1)+int_mb(k_spin+h12b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 7922 length = length + 1 7923 END IF 7924 END IF 7925 END IF 7926 END DO 7927 END DO 7928 END DO 7929 END DO 7930 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 7931 &set)) CALL ERRQUIT('eomccsdt_y1_17_6_1',0,MA_ERR) 7932 int_mb(k_a_offset) = length 7933 addr = 0 7934 size = 0 7935 DO h2b = 1,noab 7936 DO p13b = noab+1,noab+nvab 7937 DO h12b = 1,noab 7938 DO p8b = noab+1,noab+nvab 7939 IF (int_mb(k_spin+h2b-1)+int_mb(k_spin+p13b-1) .eq. int_mb(k_spin+ 7940 &h12b-1)+int_mb(k_spin+p8b-1)) THEN 7941 IF (ieor(int_mb(k_sym+h2b-1),ieor(int_mb(k_sym+p13b-1),ieor(int_mb 7942 &(k_sym+h12b-1),int_mb(k_sym+p8b-1)))) .eq. ieor(irrep_v,ieor(irrep 7943 &_t,irrep_t))) THEN 7944 IF ((.not.restricted).or.(int_mb(k_spin+h2b-1)+int_mb(k_spin+p13b- 7945 &1)+int_mb(k_spin+h12b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 7946 addr = addr + 1 7947 int_mb(k_a_offset+addr) = p8b - noab - 1 + nvab * (h12b - 1 + noab 7948 & * (p13b - noab - 1 + nvab * (h2b - 1))) 7949 int_mb(k_a_offset+length+addr) = size 7950 size = size + int_mb(k_range+h2b-1) * int_mb(k_range+p13b-1) * int 7951 &_mb(k_range+h12b-1) * int_mb(k_range+p8b-1) 7952 END IF 7953 END IF 7954 END IF 7955 END DO 7956 END DO 7957 END DO 7958 END DO 7959 RETURN 7960 END 7961