1      SUBROUTINE OFFSET_ccsdt_lr_alpha_offdiag_7_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     i1 ( p2 p1 )_ya
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 p2b
19      INTEGER p1b
20      length = 0
21      DO p2b = noab+1,noab+nvab
22      DO p1b = noab+1,noab+nvab
23      IF (int_mb(k_spin+p2b-1) .eq. int_mb(k_spin+p1b-1)) THEN
24      IF (ieor(int_mb(k_sym+p2b-1),int_mb(k_sym+p1b-1)) .eq. ieor(irrep_
25     &y,irrep_a)) THEN
26      IF ((.not.restricted).or.(int_mb(k_spin+p2b-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('ccsdt_lr_alpha_offdiag_7_1',0,MA_ERR)
36      int_mb(k_a_offset) = length
37      addr = 0
38      size = 0
39      DO p2b = noab+1,noab+nvab
40      DO p1b = noab+1,noab+nvab
41      IF (int_mb(k_spin+p2b-1) .eq. int_mb(k_spin+p1b-1)) THEN
42      IF (ieor(int_mb(k_sym+p2b-1),int_mb(k_sym+p1b-1)) .eq. ieor(irrep_
43     &y,irrep_a)) THEN
44      IF ((.not.restricted).or.(int_mb(k_spin+p2b-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 * (p2b - noab - 1)
48      int_mb(k_a_offset+length+addr) = size
49      size = size + int_mb(k_range+p2b-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