1 SUBROUTINE OFFSET_ccsdtq_lr_alpha_12_16_1_1(l_a_offset,k_a_offset, 2 &size) 3C $Id$ 4C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 5C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 6C i3 ( h8 p1 )_vtrb 7 IMPLICIT NONE 8#include "global.fh" 9#include "mafdecls.fh" 10#include "sym.fh" 11#include "errquit.fh" 12#include "tce.fh" 13 INTEGER l_a_offset 14 INTEGER k_a_offset 15 INTEGER size 16 INTEGER length 17 INTEGER addr 18 INTEGER h8b 19 INTEGER p1b 20 length = 0 21 DO h8b = 1,noab 22 DO p1b = noab+1,noab+nvab 23 IF (int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+p1b-1)) THEN 24 IF (ieor(int_mb(k_sym+h8b-1),int_mb(k_sym+p1b-1)) .eq. ieor(irrep_ 25 &v,irrep_trb)) THEN 26 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+p1b-1 27 &).ne.4)) THEN 28 length = length + 1 29 END IF 30 END IF 31 END IF 32 END DO 33 END DO 34 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 35 &set)) CALL ERRQUIT('ccsdtq_lr_alpha_12_16_1_1',0,MA_ERR) 36 int_mb(k_a_offset) = length 37 addr = 0 38 size = 0 39 DO h8b = 1,noab 40 DO p1b = noab+1,noab+nvab 41 IF (int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+p1b-1)) THEN 42 IF (ieor(int_mb(k_sym+h8b-1),int_mb(k_sym+p1b-1)) .eq. ieor(irrep_ 43 &v,irrep_trb)) THEN 44 IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+p1b-1 45 &).ne.4)) THEN 46 addr = addr + 1 47 int_mb(k_a_offset+addr) = p1b - noab - 1 + nvab * (h8b - 1) 48 int_mb(k_a_offset+length+addr) = size 49 size = size + int_mb(k_range+h8b-1) * int_mb(k_range+p1b-1) 50 END IF 51 END IF 52 END IF 53 END DO 54 END DO 55 RETURN 56 END 57