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