1 SUBROUTINE OFFSET_alpha_1_1_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 i1 ( p2 h1 )_tr 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 p2b 18 INTEGER h1b 19 length = 0 20 DO p2b = noab+1,noab+nvab 21 DO h1b = 1,noab 22 IF (int_mb(k_spin+p2b-1) .eq. int_mb(k_spin+h1b-1)) THEN 23 IF (ieor(int_mb(k_sym+p2b-1),int_mb(k_sym+h1b-1)) .eq. irrep_tr) T 24 &HEN 25 IF ((.not.restricted).or.(int_mb(k_spin+p2b-1)+int_mb(k_spin+h1b-1 26 &).ne.4)) THEN 27 length = length + 1 28 END IF 29 END IF 30 END IF 31 END DO 32 END DO 33 IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off 34 &set)) CALL ERRQUIT('alpha_1_1_1',0,MA_ERR) 35 int_mb(k_a_offset) = length 36 addr = 0 37 size = 0 38 DO p2b = noab+1,noab+nvab 39 DO h1b = 1,noab 40 IF (int_mb(k_spin+p2b-1) .eq. int_mb(k_spin+h1b-1)) THEN 41 IF (ieor(int_mb(k_sym+p2b-1),int_mb(k_sym+h1b-1)) .eq. irrep_tr) T 42 &HEN 43 IF ((.not.restricted).or.(int_mb(k_spin+p2b-1)+int_mb(k_spin+h1b-1 44 &).ne.4)) THEN 45 addr = addr + 1 46 int_mb(k_a_offset+addr) = h1b - 1 + noab * (p2b - noab - 1) 47 int_mb(k_a_offset+length+addr) = size 48 size = size + int_mb(k_range+p2b-1) * int_mb(k_range+h1b-1) 49 END IF 50 END IF 51 END IF 52 END DO 53 END DO 54 RETURN 55 END 56