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