1      SUBROUTINE ccsdt_t3a_1_5_1(d_a,k_a_offset,d_c,k_c_offset)
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     i2 ( h9 h11 h1 p8 )_v + = 1 * v ( h9 h11 h1 p8 )_v
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 d_a
13      INTEGER k_a_offset
14      INTEGER d_c
15      INTEGER k_c_offset
16      INTEGER NXTASK
17      INTEGER next
18      INTEGER nprocs
19      INTEGER count
20      INTEGER h9b
21      INTEGER h11b
22      INTEGER h1b
23      INTEGER p8b
24      INTEGER dimc
25      INTEGER h9b_1
26      INTEGER h11b_1
27      INTEGER h1b_1
28      INTEGER p8b_1
29      INTEGER dim_common
30      INTEGER dima_sort
31      INTEGER dima
32      INTEGER l_a_sort
33      INTEGER k_a_sort
34      INTEGER l_a
35      INTEGER k_a
36      INTEGER l_c
37      INTEGER k_c
38      LOGICAL ACOLO_1H
39      EXTERNAL NXTASK
40      nprocs = GA_NNODES()
41      count = 0
42      next = NXTASK(nprocs,1)
43      DO h9b = 1,noab
44      DO h11b = h9b,noab
45      DO h1b = 1,noab
46      DO p8b = noab+1,noab+nvab
47      IF (next.eq.count) THEN
48      IF(acolo_1h(h1b)) THEN
49      IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-
50     &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN
51      IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+
52     &h1b-1)+int_mb(k_spin+p8b-1)) THEN
53      IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb
54     &(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. irrep_v) THEN
55      dimc = int_mb(k_range+h9b-1) * int_mb(k_range+h11b-1) * int_mb(k_r
56     &ange+h1b-1) * int_mb(k_range+p8b-1)
57      CALL TCE_RESTRICTED_4(h9b,h11b,h1b,p8b,h9b_1,h11b_1,h1b_1,p8b_1)
58      dim_common = 1
59      dima_sort = int_mb(k_range+h9b-1) * int_mb(k_range+h11b-1) * int_m
60     &b(k_range+h1b-1) * int_mb(k_range+p8b-1)
61      dima = dim_common * dima_sort
62      IF (dima .gt. 0) THEN
63      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
64     & ERRQUIT('ccsdt_t3_1_5_1',0,MA_ERR)
65      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
66     &ccsdt_t3_1_5_1',1,MA_ERR)
67      IF ((h1b .le. p8b)) THEN
68      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p8b_1
69     & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (h11b_1 - 1 + (noa
70     &b+nvab) * (h9b_1 - 1)))))
71      CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h9b-1)
72     &,int_mb(k_range+h11b-1),int_mb(k_range+h1b-1),int_mb(k_range+p8b-1
73     &),4,3,2,1,1.0d0)
74      END IF
75      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('ccsdt_t3_1_5_1',2,MA_ERR
76     &)
77      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
78     &ccsdt_t3_1_5_1',3,MA_ERR)
79      CALL TCE_SORT_4(dbl_mb(k_a_sort),dbl_mb(k_c),int_mb(k_range+p8b-1)
80     &,int_mb(k_range+h1b-1),int_mb(k_range+h11b-1),int_mb(k_range+h9b-1
81     &),4,3,2,1,1.0d0)
82      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p8b -
83     & noab - 1 + nvab * (h1b - 1 + noab * (h11b - 1 + noab * (h9b - 1))
84     &)))
85      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsdt_t3_1_5_1',4,MA_ERR
86     &)
87      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('ccsdt_t3_1_5_1',5,M
88     &A_ERR)
89      END IF
90      END IF
91      END IF
92      END IF
93      END IF !active
94      next = NXTASK(nprocs,1)
95      END IF
96      count = count + 1
97      END DO
98      END DO
99      END DO
100      END DO
101      next = NXTASK(-nprocs,1)
102      call GA_SYNC()
103      RETURN
104      END
105