1 SUBROUTINE OFFSET_eomccsdtq_y1_7_6_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 i3 ( h6 h8 h13 p4 )_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 h6b 18 INTEGER h8b 19 INTEGER h13b 20 INTEGER p4b 21 length = 0 22 DO h6b = 1,noab 23 DO h8b = h6b,noab 24 DO h13b = 1,noab 25 DO p4b = noab+1,noab+nvab 26 IF (int_mb(k_spin+h6b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h 27 &13b-1)+int_mb(k_spin+p4b-1)) THEN 28 IF (ieor(int_mb(k_sym+h6b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 29 &k_sym+h13b-1),int_mb(k_sym+p4b-1)))) .eq. irrep_v) THEN 30 IF ((.not.restricted).or.(int_mb(k_spin+h6b-1)+int_mb(k_spin+h8b-1 31 &)+int_mb(k_spin+h13b-1)+int_mb(k_spin+p4b-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('eomccsdtq_y1_7_6_2_1',0,MA_ERR) 42 int_mb(k_a_offset) = length 43 addr = 0 44 size = 0 45 DO h6b = 1,noab 46 DO h8b = h6b,noab 47 DO h13b = 1,noab 48 DO p4b = noab+1,noab+nvab 49 IF (int_mb(k_spin+h6b-1)+int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+h 50 &13b-1)+int_mb(k_spin+p4b-1)) THEN 51 IF (ieor(int_mb(k_sym+h6b-1),ieor(int_mb(k_sym+h8b-1),ieor(int_mb( 52 &k_sym+h13b-1),int_mb(k_sym+p4b-1)))) .eq. irrep_v) THEN 53 IF ((.not.restricted).or.(int_mb(k_spin+h6b-1)+int_mb(k_spin+h8b-1 54 &)+int_mb(k_spin+h13b-1)+int_mb(k_spin+p4b-1).ne.8)) THEN 55 addr = addr + 1 56 int_mb(k_a_offset+addr) = p4b - noab - 1 + nvab * (h13b - 1 + noab 57 & * (h8b - 1 + noab * (h6b - 1))) 58 int_mb(k_a_offset+length+addr) = size 59 size = size + int_mb(k_range+h6b-1) * int_mb(k_range+h8b-1) * int_ 60 &mb(k_range+h13b-1) * int_mb(k_range+p4b-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