      SUBROUTINE ccsd_e(d_f1,d_i0,d_t1,d_t2,d_v2,k_f1_offset,k_i0_offset
     &,k_t1_offset,k_t2_offset,k_v2_offset)
C     $Id: ccsd_e.F 19699 2010-10-29 17:07:13Z d3y133 $
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
C     i0 ( )_tf + = 1 * Sum ( p5 h6 ) * t ( p5 h6 )_t * i1 ( h6 p5 )_f                     DONE
C         i1 ( h6 p5 )_f + = 1 * f ( h6 p5 )_f                                             DONE
C         i1 ( h6 p5 )_vt + = 1/2 * Sum ( h4 p3 ) * t ( p3 h4 )_t * v ( h4 h6 p3 p5 )_v    DONE
C     i0 ( )_vt + = 1/4 * Sum ( h3 h4 p1 p2 ) * t ( p1 p2 h3 h4 )_t * v ( h3 h4 p1 p2 )_v  DONE
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "util.fh"
#include "errquit.fh"
#include "tce.fh"
c when local copies of  T1/X1 tensors are used,  d_t1 refers to k_t1_local (kk)
      INTEGER d_i0,k_i0_offset
      INTEGER d_t1,k_t1_offset
      INTEGER d_i1,k_i1_offset,l_i1_offset
      INTEGER d_t2,k_t2_offset
      INTEGER d_v2,k_v2_offset
      INTEGER d_f1,k_f1_offset
      INTEGER size_i1
      CHARACTER*255 filename
      CALL OFFSET_ccsd_e_1_1(l_i1_offset,k_i1_offset,size_i1)
      CALL TCE_FILENAME('ccsd_e_1_1_i1',filename)
      CALL CREATEFILE(filename,d_i1,size_i1)
      CALL ccsd_e_copy_fock_to_t(d_f1,k_f1_offset,d_i1,k_i1_offset)
      CALL ccsd_e_1_2(d_t1,k_t1_offset,d_v2,k_v2_offset,
     1                d_i1,k_i1_offset)
      CALL RECONCILEFILE(d_i1,size_i1)
      CALL ccsd_e_1(d_t1,k_t1_offset,d_i1,k_i1_offset,d_i0,k_i0_offset)
      CALL DELETEFILE(d_i1)
      IF (.not.MA_POP_STACK(l_i1_offset)) 
     1     CALL ERRQUIT('ccsd_e',-1,MA_ERR)
      CALL ccsd_e_2(d_t2,k_t2_offset,d_v2,k_v2_offset,d_i0,k_i0_offset)
      RETURN
      END




      SUBROUTINE ccsd_e_1(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offset)
C     $Id: ccsd_e.F 19699 2010-10-29 17:07:13Z d3y133 $
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
C     i0 ( )_tf + = 1 * Sum ( p5 h6 ) * t ( p5 h6 )_t * i1 ( h6 p5 )_f
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a,d_b,d_c
      INTEGER k_a_offset,k_b_offset,k_c_offset
      INTEGER NXTASK,next,nprocs,count
      INTEGER p5b,h6b,p5b_1,h6b_1,h6b_2,p5b_2
      INTEGER dim_p,dim_h,dim_ph,p,h
      INTEGER k_a,k_b,l_b,k_c,l_c
#ifdef LOCAL_COPY
      INTEGER l_a
#else
      INTEGER offset_a
#endif
      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
      next = NXTASK(nprocs, 1)
      IF (next.eq.count) THEN
       IF (0 .eq. ieor(irrep_t,irrep_f)) THEN
c
c     create output array
c
      IF (.not.MA_PUSH_GET(mt_dbl,1,'noname',l_c,k_c))
     1     CALL ERRQUIT('ccsd_e_1',0,MA_ERR)
      dbl_mb(k_c) = 0.0d0
c
      DO p5b = noab+1,noab+nvab
       DO h6b = 1,noab
        IF (int_mb(k_spin+p5b-1) .eq. int_mb(k_spin+h6b-1)) THEN
         IF (ieor(int_mb(k_sym+p5b-1),int_mb(k_sym+h6b-1))
     1       .eq.irrep_t) THEN
          CALL TCE_RESTRICTED_2(p5b,h6b,p5b_1,h6b_1)
          CALL TCE_RESTRICTED_2(h6b,p5b,h6b_2,p5b_2)
          dim_p = int_mb(k_range+p5b-1)
          dim_h = int_mb(k_range+h6b-1)
          dim_ph = dim_p * dim_h
          IF (dim_ph .gt. 0) THEN
c
c          a = t1
c
#ifdef LOCAL_COPY
           IF (.not.MA_PUSH_GET(mt_dbl,dim_ph,'a',l_a,k_a))
     1          CALL ERRQUIT('ccsd_e_1',2,MA_ERR)
           CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dim_ph,
     1          int_mb(k_a_offset),
     2          (h6b_1 - 1 + noab * (p5b_1 - noab - 1)))
#else
           call tce_hash(int_mb(k_a_offset),
     1                   (h6b_1 - 1 + noab * (p5b_1 - noab - 1)),
     2                   offset_a)
           k_a = d_a + offset_a
#endif
c
c          b = i1 = f1 + v2 * t1
c
           IF (.not.MA_PUSH_GET(mt_dbl,dim_ph,'b',l_b,k_b))
     1          CALL ERRQUIT('ccsd_e_1',5,MA_ERR)
           CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dim_ph,
     1          int_mb(k_b_offset),
     2          (p5b_2 - noab - 1 + nvab * (h6b_2 - 1)))
c
c          do the contraction as 2D dot product
c          c += Sum(p,h) a(p,h) * b(h,p)
c
           do p = 0,dim_p-1
            do h = 0,dim_h-1
             dbl_mb(k_c) = dbl_mb(k_c)
     1                   + dbl_mb(k_a + (dim_h * p) + h )
     2                   * dbl_mb(k_b + (dim_p * h) + p )
            enddo
           enddo
c
c          free arrays
c
           IF (.not.MA_POP_STACK(l_b)) 
     1          CALL ERRQUIT('ccsd_e_1',6,MA_ERR)
#ifdef LOCAL_COPY
           IF (.not.MA_POP_STACK(l_a)) 
     1          CALL ERRQUIT('ccsd_e_1',3,MA_ERR)
#endif
          END IF
         END IF
        END IF
       END DO
      END DO
c
c     sort output array and post to GA
c
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),1,int_mb(k_c_offset),0)
      IF (.not.MA_POP_STACK(l_c))
     1     CALL ERRQUIT('ccsd_e_1',10,MA_ERR)
c
       END IF
       next = NXTASK(nprocs, 1)
      END IF
      count = count + 1
      next = NXTASK(-nprocs, 1)
      call GA_SYNC()
      RETURN
      END




      SUBROUTINE ccsd_e_copy_fock_to_t(d_a,k_a_offset,d_c,k_c_offset)
C     $Id: ccsd_e.F 19699 2010-10-29 17:07:13Z d3y133 $
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
C     i1 ( h6 p5 )_f + = 1 * f ( h6 p5 )_f
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a,d_c
      INTEGER k_a_offset,k_c_offset
      INTEGER NXTASK,next,nprocs,count
      INTEGER h6b,p5b
      INTEGER h6b_1,p5b_1
      INTEGER dim_ph
      INTEGER k_a,l_a
      INTEGER k_c,l_c
      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
      next = NXTASK(nprocs, 1)
      DO h6b = 1,noab
       DO p5b = noab+1,noab+nvab
        IF (next.eq.count) THEN
         IF ((.not.restricted).or.(int_mb(k_spin+h6b-1)
     1                            +int_mb(k_spin+p5b-1).ne.4)) THEN
          IF (int_mb(k_spin+h6b-1) .eq. int_mb(k_spin+p5b-1)) THEN
           IF (ieor(int_mb(k_sym+h6b-1),int_mb(k_sym+p5b-1))
     1         .eq. irrep_f) THEN
            CALL TCE_RESTRICTED_2(h6b,p5b,h6b_1,p5b_1)
            dim_ph = int_mb(k_range+h6b-1) * int_mb(k_range+p5b-1)
            IF (dim_ph .gt. 0) THEN
             IF (.not.MA_PUSH_GET(mt_dbl,dim_ph,'a',l_a,k_a))
     1            CALL ERRQUIT('copy_fock_to_t',1,MA_ERR)
             CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dim_ph,
     1                           int_mb(k_a_offset),
     1                           (p5b_1-1 + (noab+nvab) * (h6b_1-1)))
             CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_a),dim_ph,
     1                           int_mb(k_c_offset),
     2                           (p5b-noab-1 + nvab * (h6b-1)))
             IF (.not.MA_POP_STACK(l_a))
     1            CALL ERRQUIT('copy_fock_to_t',2,MA_ERR)
            END IF
           END IF
          END IF
         END IF
         next = NXTASK(nprocs, 1)
        END IF
        count = count + 1
       END DO
      END DO
      next = NXTASK(-nprocs, 1)
      call GA_SYNC()
      RETURN
      END




      SUBROUTINE ccsd_e_1_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offset
     &)
C     $Id: ccsd_e.F 19699 2010-10-29 17:07:13Z d3y133 $
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
C     i1 ( h6 p5 )_vt + = 1/2 * Sum ( h4 p3 ) * t ( p3 h4 )_t * v ( h4 h6 p3 p5 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a,d_b,d_c
      INTEGER k_a_offset,k_b_offset,k_c_offset
      INTEGER NXTASK,next,nprocs,count
      INTEGER h6b,p5b,p3b,h4b,p3b_1,h4b_1,h6b_2,h4b_2,p5b_2,p3b_2
      INTEGER dim_common,dima_sort,dimb_sort,dima,dimb,dimc
      INTEGER k_as,l_as,k_bs,l_bs,k_c_sort,l_c_sort
      INTEGER k_a,k_b,l_b,k_c,l_c
#ifdef LOCAL_COPY
      INTEGER l_a
#else
      INTEGER offset_a
#endif
      EXTERNAL NXTASK
      nprocs = GA_NNODES()
      count = 0
      next = NXTASK(nprocs, 1)
      DO h6b = 1,noab
       DO p5b = noab+1,noab+nvab
        IF (next.eq.count) THEN
         IF ((.not.restricted).or.(int_mb(k_spin+h6b-1)
     1                            +int_mb(k_spin+p5b-1).ne.4)) THEN
          IF (int_mb(k_spin+h6b-1) .eq. int_mb(k_spin+p5b-1)) THEN
           IF (ieor(int_mb(k_sym+h6b-1),int_mb(k_sym+p5b-1)) 
     1     .eq.ieor(irrep_v,irrep_t)) THEN
            dimc = int_mb(k_range+h6b-1) * int_mb(k_range+p5b-1)
            IF (.not.MA_PUSH_GET(mt_dbl,dimc,'cs',l_c_sort,k_c_sort))
     1           CALL ERRQUIT('ccsd_e_1_2',0,MA_ERR)
            CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
            DO p3b = noab+1,noab+nvab
             DO h4b = 1,noab
              IF (int_mb(k_spin+p3b-1) .eq. int_mb(k_spin+h4b-1)) THEN
               IF (ieor(int_mb(k_sym+p3b-1),int_mb(k_sym+h4b-1)) 
     1             .eq. irrep_t) THEN
                CALL TCE_RESTRICTED_2(p3b,h4b,p3b_1,h4b_1)
                CALL TCE_RESTRICTED_4(h6b,h4b,p5b,p3b,
     1                                h6b_2,h4b_2,p5b_2,p3b_2)
                dim_common = int_mb(k_range+p3b-1) 
     1                     * int_mb(k_range+h4b-1)
                dima_sort = 1
                dima = dim_common * dima_sort
                dimb_sort = int_mb(k_range+h6b-1) 
     1                    * int_mb(k_range+p5b-1)
                dimb = dim_common * dimb_sort
                IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
                 IF (.not.MA_PUSH_GET(mt_dbl,dima,'as',l_as,k_as))
     1                CALL ERRQUIT('ccsd_e_1_2',1,MA_ERR)
#ifdef LOCAL_COPY
                 IF (.not.MA_PUSH_GET(mt_dbl,dima,'a',l_a,k_a))
     1                CALL ERRQUIT('ccsd_e_1_2',2,MA_ERR)
                 CALL GET_HASH_BLOCK_MA(dbl_mb(d_a),dbl_mb(k_a),dima,
     1                int_mb(k_a_offset),
     2                (h4b_1 - 1 + noab * (p3b_1 - noab - 1)))
#else
                 call tce_hash(int_mb(k_a_offset),
     1                         (h4b_1 - 1 + noab * (p3b_1 - noab - 1)),
     2                         offset_a)
                 k_a = d_a + offset_a
#endif
                 CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_as),
     1                int_mb(k_range+p3b-1),
     2                int_mb(k_range+h4b-1),2,1,1.0d0)
#ifdef LOCAL_COPY
                 IF (.not.MA_POP_STACK(l_a))
     1                CALL ERRQUIT('ccsd_e_1_2',3,MA_ERR)
#endif
                 IF (.not.MA_PUSH_GET(mt_dbl,dimb,'bs',l_bs,k_bs))
     1                CALL ERRQUIT('ccsd_e_1_2',4,MA_ERR)
                 IF (.not.MA_PUSH_GET(mt_dbl,dimb,'b',l_b,k_b))
     1                CALL ERRQUIT('ccsd_e_1_2',5,MA_ERR)
                 IF ((h4b .le. h6b) .and. (p3b .le. p5b)) THEN
                  if(.not.intorb) then
                   CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,
     1                  int_mb(k_b_offset),
     2                  (p5b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + 
     3                  (noab+nvab) * (h6b_2 - 1 + (noab+nvab) * 
     4                  (h4b_2 - 1)))))
                  else
                   CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,
     1                  int_mb(k_b_offset),
     2                  (p5b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + 
     3                  (noab+nvab) * (h6b_2 - 1 + (noab+nvab) * 
     4                  (h4b_2 - 1)))),p5b_2,p3b_2,h6b_2,h4b_2)
                  end if
                  CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_bs),
     1                 int_mb(k_range+h4b-1),int_mb(k_range+h6b-1),
     2                 int_mb(k_range+p3b-1),int_mb(k_range+p5b-1),
     3                 4,2,1,3,1.0d0)
                 END IF
                 IF ((h4b .le. h6b) .and. (p5b .lt. p3b)) THEN
                  if(.not.intorb) then
                   CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,
     1                  int_mb(k_b_offset),
     2                  (p3b_2 - 1 + (noab+nvab) * (p5b_2 - 1 + 
     3                  (noab+nvab) * (h6b_2 - 1 + (noab+nvab) * 
     4                  (h4b_2 - 1)))))
                  else 
                   CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,
     1                  int_mb(k_b_offset),
     2                  (p3b_2 - 1 + (noab+nvab) * (p5b_2 - 1 + 
     3                  (noab+nvab) * (h6b_2 - 1 + (noab+nvab) * 
     4                  (h4b_2 - 1)))),p3b_2,p5b_2,h6b_2,h4b_2)
                  end if
                  CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_bs),
     1                  int_mb(k_range+h4b-1),int_mb(k_range+h6b-1),
     2                  int_mb(k_range+p5b-1),int_mb(k_range+p3b-1),
     3                  3,2,1,4,-1.0d0)
                 END IF
                 IF ((h6b .lt. h4b) .and. (p3b .le. p5b)) THEN
                  if(.not.intorb) THEN
                   CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,
     1                  int_mb(k_b_offset),
     2                  (p5b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + 
     3                  (noab+nvab) * (h4b_2 - 1 + (noab+nvab) * 
     4                  (h6b_2 - 1)))))
                  else
                   CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,
     1                  int_mb(k_b_offset),
     2                  (p5b_2 - 1 + (noab+nvab) * (p3b_2 - 1 + 
     3                  (noab+nvab) * (h4b_2 - 1 + (noab+nvab) * 
     4                  (h6b_2 - 1)))),p5b_2,p3b_2,h4b_2,h6b_2)
                  end if
                  CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_bs),
     1                 int_mb(k_range+h6b-1),int_mb(k_range+h4b-1),
     2                 int_mb(k_range+p3b-1),int_mb(k_range+p5b-1),
     3                 4,1,2,3,-1.0d0)
                 END IF
                 IF ((h6b .lt. h4b) .and. (p5b .lt. p3b)) THEN
                  if(.not.intorb) then
                   CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,
     1                  int_mb(k_b_offset),
     2                  (p3b_2 - 1 + (noab+nvab) * (p5b_2 - 1 + 
     3                  (noab+nvab) * (h4b_2 - 1 + (noab+nvab) * 
     4                  (h6b_2 - 1)))))
                  else
                   CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dimb,
     1                  int_mb(k_b_offset),
     2                  (p3b_2 - 1 + (noab+nvab) * (p5b_2 - 1 + 
     3                  (noab+nvab) * (h4b_2 - 1 + (noab+nvab) * 
     4                  (h6b_2 - 1)))),p3b_2,p5b_2,h4b_2,h6b_2)
                  end if
                  CALL TCE_SORT_4(dbl_mb(k_b),dbl_mb(k_bs),
     1                 int_mb(k_range+h6b-1),int_mb(k_range+h4b-1),
     2                 int_mb(k_range+p5b-1),int_mb(k_range+p3b-1),
     3                 3,1,2,4,1.0d0)
                 END IF
                 IF (.not.MA_POP_STACK(l_b))
     1                CALL ERRQUIT('ccsd_e_1_2',6,MA_ERR)
                 CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,
     1                1.0d0,dbl_mb(k_as),dim_common,dbl_mb(k_bs),
     2                dim_common,1.0d0,dbl_mb(k_c_sort),dima_sort)
                 IF (.not.MA_POP_STACK(l_bs))
     1                CALL ERRQUIT('ccsd_e_1_2',7,MA_ERR)
                 IF (.not.MA_POP_STACK(l_as))
     1                CALL ERRQUIT('ccsd_e_1_2',8,MA_ERR)
                END IF
               END IF
              END IF
             END DO
            END DO
            IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c))
     1           CALL ERRQUIT('ccsd_e_1_2',9,MA_ERR)
            CALL TCE_SORT_2(dbl_mb(k_c_sort),dbl_mb(k_c),
     1           int_mb(k_range+p5b-1),int_mb(k_range+h6b-1),
     2           2,1,1.0d0/2.0d0)
            CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,
     1           int_mb(k_c_offset),(p5b - noab - 1 + nvab * (h6b - 1)))
            IF (.not.MA_POP_STACK(l_c))
     1           CALL ERRQUIT('ccsd_e_1_2',10,MA_ERR)
            IF (.not.MA_POP_STACK(l_c_sort))
     1           CALL ERRQUIT('ccsd_e_1_2',11,MA_ERR)
           END IF
          END IF
         END IF
         next = NXTASK(nprocs, 1)
        END IF
        count = count + 1
       END DO
      END DO
      next = NXTASK(-nprocs, 1)
      call GA_SYNC()
      RETURN
      END




      SUBROUTINE ccsd_e_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offset)
C     $Id: ccsd_e.F 19699 2010-10-29 17:07:13Z d3y133 $
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
C     i0 ( )_vt + = 1/4 * Sum ( h3 h4 p1 p2 ) * t ( p1 p2 h3 h4 )_t * v ( h3 h4 p1 p2 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER d_a,d_b,d_c
      INTEGER k_a_offset,k_b_offset,k_c_offset
      INTEGER NXTASK,next,nprocs,count
      INTEGER p1,p2,h3,h4
      INTEGER p1b,p2b,h3b,h4b
      INTEGER p1b_1,p2b_1,h3b_1,h4b_1
      INTEGER h3b_2,h4b_2,p1b_2,p2b_2
      INTEGER dim_p1,dim_p2,dim_h3,dim_h4,dim_pphh
      INTEGER k_a,l_a,k_b,l_b,k_c,l_c
      INTEGER k_as,l_as
      INTEGER k_bs,l_bs
      INTEGER nsuperp,nsubh
      DOUBLE PRECISION alpha
      DOUBLE PRECISION FACTORIAL
      EXTERNAL NXTASK
      EXTERNAL FACTORIAL
      nprocs = GA_NNODES()
      count = 0
      next = NXTASK(nprocs, 1)
      IF (next.eq.count) THEN
       IF (0 .eq. ieor(irrep_v,irrep_t)) THEN
c
c     create output array
c
      IF (.not.MA_PUSH_GET(mt_dbl,1,'noname',l_c,k_c)) 
     1     CALL ERRQUIT('ccsd_e_2',9,MA_ERR)
      dbl_mb(k_c) = 0.0d0
c
      DO p1b = noab+1,noab+nvab
       DO p2b = p1b,noab+nvab
        DO h3b = 1,noab
         DO h4b = h3b,noab
          IF (int_mb(k_spin+p1b-1)+int_mb(k_spin+p2b-1) .eq. 
     1        int_mb(k_spin+h3b-1)+int_mb(k_spin+h4b-1)) THEN
           IF (ieor(int_mb(k_sym+p1b-1),ieor(int_mb(k_sym+p2b-1),
     1         ieor(int_mb(k_sym+h3b-1),int_mb(k_sym+h4b-1))))
     2         .eq. irrep_t) THEN
            CALL TCE_RESTRICTED_4(p1b,p2b,h3b,h4b,
     1                            p1b_1,p2b_1,h3b_1,h4b_1)
            CALL TCE_RESTRICTED_4(h3b,h4b,p1b,p2b,
     1                            h3b_2,h4b_2,p1b_2,p2b_2)
            dim_p1 = int_mb(k_range+p1b-1) 
            dim_p2 = int_mb(k_range+p2b-1) 
            dim_h3 = int_mb(k_range+h3b-1) 
            dim_h4 = int_mb(k_range+h4b-1) 
            dim_pphh = dim_p1*dim_p2*dim_h3*dim_h4
            IF (dim_pphh .gt. 0) THEN
c
c            a = t2
c
             IF (.not.MA_PUSH_GET(mt_dbl,dim_pphh,'as',l_as,k_as)) 
     1            CALL ERRQUIT('ccsd_e_2',1,MA_ERR)
             IF (.not.MA_PUSH_GET(mt_dbl,dim_pphh,'a',l_a,k_a))
     1            CALL ERRQUIT('ccsd_e_2',2,MA_ERR)
             CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dim_pphh,
     1            int_mb(k_a_offset),
     2            (h4b_1 - 1 + noab * (h3b_1 - 1 + noab * 
     3            (p2b_1 - noab - 1 + nvab * (p1b_1 - noab - 1)))))
             CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_as),
     1            dim_p1,dim_p2,dim_h3,dim_h4,
     2            3,4,1,2,1.0d0)
             IF (.not.MA_POP_STACK(l_a))
     1            CALL ERRQUIT('ccsd_e_2',3,MA_ERR)
c
c            b = v2
c
             IF (.not.MA_PUSH_GET(mt_dbl,dim_pphh,'b',l_b,k_b))
     1            CALL ERRQUIT('ccsd_e_2',5,MA_ERR)
             if(.not.intorb) then
               CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dim_pphh,
     1           int_mb(k_b_offset),
     2           (p2b_2 - 1 + (noab+nvab) * (p1b_2 - 1 + (noab+nvab) *
     3           (h4b_2 - 1 + (noab+nvab) * (h3b_2 - 1)))))
             else
               CALL GET_HASH_BLOCK_I(d_b,dbl_mb(k_b),dim_pphh,
     1           int_mb(k_b_offset),
     2           (p2b_2 - 1 + (noab+nvab) * (p1b_2 - 1 + (noab+nvab) *
     3           (h4b_2 - 1 + (noab+nvab) * (h3b_2 - 1)))),
     4           p2b_2,p1b_2,h4b_2,h3b_2)
             end if
c
c            symmetry renormalization
c
             alpha = 1.0d0
             IF (p1b .eq. p2b) THEN
               alpha = 0.5d0*alpha
             END IF
             IF (h3b .eq. h4b) THEN
               alpha = 0.5d0*alpha
             END IF
c
c            do the contraction
c
             CALL DGEMM('T','N',1,1,dim_pphh,alpha,
     1            dbl_mb(k_as),dim_pphh,dbl_mb(k_b),
     2            dim_pphh,1.0d0,dbl_mb(k_c),1)
c
c            delete arrays
c
             IF (.not.MA_POP_STACK(l_b))
     1            CALL ERRQUIT('ccsd_e_2',7,MA_ERR)
             IF (.not.MA_POP_STACK(l_as))
     1            CALL ERRQUIT('ccsd_e_2',8,MA_ERR)
            END IF
           END IF
          END IF
         END DO
        END DO
       END DO
      END DO
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),1,int_mb(k_c_offset),0)
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsd_e_2',10,MA_ERR)
      END IF
      next = NXTASK(nprocs, 1)
      END IF
      count = count + 1
      next = NXTASK(-nprocs, 1)
      call GA_SYNC()
      RETURN
      END




      SUBROUTINE OFFSET_ccsd_e_1_1(l_a_offset,k_a_offset,size)
C     $Id: ccsd_e.F 19699 2010-10-29 17:07:13Z d3y133 $
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
C     i1 ( h6 p5 )_f
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "sym.fh"
#include "errquit.fh"
#include "tce.fh"
      INTEGER l_a_offset
      INTEGER k_a_offset
      INTEGER size
      INTEGER length
      INTEGER addr
      INTEGER h6b
      INTEGER p5b
      length = 0
      DO h6b = 1,noab
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+h6b-1) .eq. int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+h6b-1),int_mb(k_sym+p5b-1)) .eq. irrep_f) TH
     &EN
      IF ((.not.restricted).or.(int_mb(k_spin+h6b-1)+int_mb(k_spin+p5b-1
     &).ne.4)) THEN
      length = length + 1
      END IF
      END IF
      END IF
      END DO
      END DO
      IF (.not.MA_PUSH_GET(mt_int,2*length+1,'noname',l_a_offset,k_a_off
     &set)) CALL ERRQUIT('ccsd_e_1_1',0,MA_ERR)
      int_mb(k_a_offset) = length
      addr = 0
      size = 0
      DO h6b = 1,noab
      DO p5b = noab+1,noab+nvab
      IF (int_mb(k_spin+h6b-1) .eq. int_mb(k_spin+p5b-1)) THEN
      IF (ieor(int_mb(k_sym+h6b-1),int_mb(k_sym+p5b-1)) .eq. irrep_f) TH
     &EN
      IF ((.not.restricted).or.(int_mb(k_spin+h6b-1)+int_mb(k_spin+p5b-1
     &).ne.4)) THEN
      addr = addr + 1
      int_mb(k_a_offset+addr) = p5b - noab - 1 + nvab * (h6b - 1)
      int_mb(k_a_offset+length+addr) = size
      size = size + int_mb(k_range+h6b-1) * int_mb(k_range+p5b-1)
      END IF
      END IF
      END IF
      END DO
      END DO
      RETURN
      END
