#define OMPCOLLAPSE 3
      SUBROUTINE ccsd_t_doubles_l(a_i0,
     &d_t2,d_v2,k_t2_offset,k_v2_offset,t
     &_h1b,t_h2b,t_h3b,t_p4b,t_p5b,t_p6b,toggle)
C     $Id: ccsd_t_doubles_l.F 25793 2014-06-11 21:38:37Z edo $
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 ( p4 p5 p6 h1 h2 h3 )_vt + = -1 * P( 9 ) * Sum ( h7 ) * t ( p4 p5 h1 h7 )_t * v ( h7 p6 h2 h3 )_v
C     i0 ( p4 p5 p6 h1 h2 h3 )_vt + = -1 * P( 9 ) * Sum ( p7 ) * t ( p4 p7 h1 h2 )_t * v ( p5 p6 h3 p7 )_v
      IMPLICIT NONE
#include "global.fh"
#include "mafdecls.fh"
#include "util.fh"
#include "errquit.fh"
#include "tce.fh"
#include "offl.fh"
#include "ccsd_t_ps.fh"
      INTEGER t_p4b
      INTEGER t_p5b
      INTEGER t_p6b
      INTEGER t_h1b
      INTEGER t_h2b
      INTEGER t_h3b
      INTEGER toggle
      INTEGER d_t2
      INTEGER k_t2_offset
      INTEGER d_v2
      INTEGER k_v2_offset
      integer l_v2sub
      integer k_v2sub
      integer l_t2sub
      integer k_t2sub
      integer l_scratch
      integer k_scratch
      DOUBLE PRECISION a_i0(*)
      
      DOUBLE PRECISION krnl_start
      logical offload_master
      external offload_master
      integer range_p4,range_h1,ii
      integer t2size,v2size
      
      krnl_start = util_wallsec()
      
c *** debug ***
c      write(6,*)'I am in ccsd_t_doubles',ga_nodeid()
c      call util_flush(6)
c *************
      call ccsd_t_v2t2lgth(t2size,v2size)
      if (otceps) call pstat_on(ps_cctdbl)
      IF (.not.MA_PUSH_GET(mt_dbl,t2size,'t2sub',
     L     l_t2sub,k_t2sub)) CALL
     & ERRQUIT('ccsd_t_doubles t2sub',101,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,max(t2size,v2size),'t2sub',
     L     l_scratch,k_scratch)) CALL
     & ERRQUIT('ccsd_t_doubles scratch',102,MA_ERR)
      IF (.not.MA_PUSH_GET(mt_dbl,v2size,'v2sub',
     L     l_v2sub,k_v2sub)) CALL
     & ERRQUIT('ccsd_t_doubles v2sub',103,MA_ERR)

      IF (toggle .eq. 2) then
      if(offload_master()) then
         CALL offl0_ccsd_t_doubles_l_12(d_t2,
     &        k_t2_offset,d_v2,k_v2_offset,
     A        a_i0,t_p4b,t_p5b,t_p6b,t_h1b,t_h2b,t_h3b,
     T        dbl_mb(k_v2sub),dbl_mb(k_t2sub),
     S        dbl_mb(k_scratch))
      else
         CALL ccsd_t_doubles_l_12(d_t2,
     &        k_t2_offset,d_v2,k_v2_offset,
     A        a_i0,t_p4b,t_p5b,t_p6b,t_h1b,t_h2b,t_h3b,
     T        dbl_mb(k_v2sub),dbl_mb(k_t2sub),
     S        dbl_mb(k_scratch))
         endif
      endif
      IF (.not.MA_chop_stack(l_t2sub)) CALL
     & ERRQUIT('ccsd_t_doubles_1',103,MA_ERR)
      if (otceps) call pstat_off(ps_cctdbl)
      
      RETURN
      END
      subroutine ccsd_t_v2t2lgth(t2size,v2size)
      implicit none
#include "mafdecls.fh"
#include "tce.fh"
c     compute v2sub and t2sub max length
      integer t2size,v2size ! [out]
c
      integer range_p4,range_h1,ii
c
      range_p4=0
      do ii = noab+1,noab+nvab
         range_p4 = max(range_p4,int_mb(k_range+ii-1))
      enddo
      range_h1=0
      do ii = 1,noab
         range_h1 = max(range_h1,int_mb(k_range+ii-1))
      enddo
      t2size=(range_p4**2)*(range_h1**2)
      v2size=max((range_p4)*(range_h1**3),
     M     (range_p4**3)*(range_h1))
      call util_align64(t2size)
      call util_align64(v2size)
      return
      end
      subroutine util_align64(in)
      implicit none
#include "mafdecls.fh"
      integer in,alignval
      alignval=64/MA_sizeof(MT_DBL,1,MT_BYTE)
      if(mod(in,alignval).ne.0) in=(1+in/alignval)*alignval
      return
      end
      subroutine ccsd_t_transpt2(t2sub,scratch,
     c     h1d,p5d,p4d,h7d)
      implicit none
      integer h1d,p5d,p4d,h7d
      double precision scratch(h7d,p4d,p5d,h1d)
      double precision t2sub(h1d,p5d,p4d,h7d)
c
      integer h1,p5,p4,h7
c     
      integer pp5,hh1
!DIR$ ASSUME_ALIGNED t2sub: 64
!DIR$ ASSUME_ALIGNED scratch: 64
c
      call dcopy(h1d*p5d*p4d*h7d,t2sub,1,scratch,1)
#define CHUNK 16
!$omp parallel do private(h7,p4,pp5,hh1,p5,h1) collapse(2)
      do h7=1,h7d
         do p4=1,p4d
            do pp5=1,p5d,CHUNK
               do hh1=1,h1d,CHUNK
                  do p5=pp5,min(pp5+CHUNK-1,p5d)
!DEC$ LOOP COUNT AVG=CHUNK
cc!deC$ SIMD
                     do h1=hh1,min(hh1+CHUNK-1,h1d)
                        t2sub(h1,p5,p4,h7)=scratch(h7,p4,p5,h1)
                     enddo
                  enddo
               enddo
            enddo
         enddo
      enddo
      return
      end
      subroutine ccsd_t_detranspt2(t2sub,scratch,
     c     h1d,p5d,p4d,h7d)
      implicit none
      integer h1d,p5d,p4d,h7d
      double precision t2sub(h7d,p4d,p5d,h1d)
      double precision scratch(h1d,p5d,p5d,h7d)
c
      integer h1,p5,p4,h7
c     
      integer pp5,hh1
c
      call dcopy(h1d*p5d*p4d*h7d,scratch,1,t2sub,1)
      return
      end
      subroutine ccsd_t_transpt2_7124(t2sub,scratch,
     c    p4d,h1d,h2d,p7d)
      implicit none
      integer p4d,h1d,h2d,p7d
      double precision scratch(p7d,p4d,h1d,h2d)
      double precision t2sub(p7d,h2d,h1d,p4d)
c
      integer p4,h1,h2,p7
c     
      integer hh2,pp7
!DIR$ ASSUME_ALIGNED t2sub: 64
!DIR$ ASSUME_ALIGNED scratch: 64
c
      call dcopy(p4d*h1d*h2d*p7d,t2sub,1,scratch,1)
#define CHUNK 16
!$omp parallel do private(p4,h1,hh2,pp7,h2,p7) collapse(2)
      do p4=1,p4d
         do h1=1,h1d
            do hh2=1,h2d,CHUNK
               do pp7=1,p7d,CHUNK
                  do h2=hh2,min(hh2+CHUNK-1,h2d)
!DEC$ LOOP COUNT AVG=CHUNK
cc!deC$ SIMD
                     do p7=pp7,min(pp7+CHUNK-1,p7d)
                        t2sub(p7,h2,h1,p4)=scratch(p7,p4,h1,h2)
                     enddo
                  enddo
               enddo
            enddo
         enddo
      enddo
      return
      end
      subroutine sd_t_d1_1(h3d,h2d,h1d,p6d,p5d,p4d,
     1               h7d,
     2               triplesx,t2sub,v2sub)
      IMPLICIT NONE
      integer h3d,h2d,h1d,p6d,p5d,p4d,h7d
      integer h3,h2,h1,p6,p5,p4,h7
      double precision triplesx(h3d,h2d,h1d,p6d,p5d,p4d)
      double precision t2sub(h7d,p4d,p5d,h1d)
      double precision v2sub(h3d,h2d,p6d,h7d)
#ifdef USE_OPENMP
!$omp parallel do private(p5,p6,p4,h1,h3,h2,h7) collapse(OMPCOLLAPSE)
#endif
      do p4=1,p4d
      do p5=1,p5d
      do p6=1,p6d
      do h1=1,h1d
      do h2=1,h2d
      do h3=1,h3d
      do h7=1,h7d
       triplesx(h3,h2,h1,p6,p5,p4)=triplesx(h3,h2,h1,p6,p5,p4)
     1   - t2sub(h7,p4,p5,h1)*v2sub(h3,h2,p6,h7)
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
#ifdef USE_OPENMP
!$omp end parallel do
#endif
      return
      end
c
      subroutine sd_t_d1_2(h3d,h2d,h1d,p6d,p5d,p4d,
     1               h7d,
     2               triplesx,t2sub,v2sub)
      IMPLICIT NONE
      integer h3d,h2d,h1d,p6d,p5d,p4d,h7d
      integer h3,h2,h1,p6,p5,p4,h7
      double precision triplesx(h3d,h1d,h2d,p6d,p5d,p4d)
      double precision t2sub(h7d,p4d,p5d,h1d)
      double precision v2sub(h3d,h2d,p6d,h7d)
#ifdef USE_OPENMP
!$omp parallel do private(p5,p6,p4,h1,h3,h2,h7) collapse(OMPCOLLAPSE)
#endif
      do p4=1,p4d
      do p5=1,p5d
      do p6=1,p6d
      do h2=1,h2d
      do h1=1,h1d
      do h3=1,h3d
      do h7=1,h7d
       triplesx(h3,h1,h2,p6,p5,p4)=triplesx(h3,h1,h2,p6,p5,p4)
     1   + t2sub(h7,p4,p5,h1)*v2sub(h3,h2,p6,h7)
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo  
      enddo
#ifdef USE_OPENMP
!$omp end parallel do
#endif
      return
      end
c
      subroutine sd_t_d1_3(h3d,h2d,h1d,p6d,p5d,p4d,
     1               h7d,
     2               triplesx,t2sub,v2sub)
      IMPLICIT NONE
      integer h3d,h2d,h1d,p6d,p5d,p4d,h7d
      integer h3,h2,h1,p6,p5,p4,h7
      double precision triplesx(h1d,h3d,h2d,p6d,p5d,p4d)
      double precision t2sub(h7d,p4d,p5d,h1d)
      double precision v2sub(h3d,h2d,p6d,h7d)
#ifdef USE_OPENMP
!$omp parallel do private(p5,p6,p4,h1,h3,h2,h7) collapse(OMPCOLLAPSE)
#endif
      do p4=1,p4d
      do p5=1,p5d
      do p6=1,p6d
      do h2=1,h2d
      do h3=1,h3d
      do h1=1,h1d
      do h7=1,h7d
       triplesx(h1,h3,h2,p6,p5,p4)=triplesx(h1,h3,h2,p6,p5,p4)
     1   - t2sub(h7,p4,p5,h1)*v2sub(h3,h2,p6,h7)
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
#ifdef USE_OPENMP
!$omp end parallel do
#endif
      return
      end
c
      subroutine sd_t_d1_4(h3d,h2d,h1d,p6d,p5d,p4d,
     1               h7d,
     2               triplesx,t2sub,v2sub)
      IMPLICIT NONE
      integer h3d,h2d,h1d,p6d,p5d,p4d,h7d
      integer h3,h2,h1,p6,p5,p4,h7
      double precision triplesx(h3d,h2d,h1d,p5d,p4d,p6d)
      double precision t2sub(h7d,p4d,p5d,h1d)
      double precision v2sub(h3d,h2d,p6d,h7d)
#ifdef USE_OPENMP
!$omp parallel do private(p5,p6,p4,h1,h3,h2,h7) collapse(OMPCOLLAPSE)
#endif
      do p6=1,p6d
      do p4=1,p4d
      do p5=1,p5d
      do h1=1,h1d
      do h2=1,h2d
      do h3=1,h3d
      do h7=1,h7d
       triplesx(h3,h2,h1,p5,p4,p6)=triplesx(h3,h2,h1,p5,p4,p6)
     1   - t2sub(h7,p4,p5,h1)*v2sub(h3,h2,p6,h7)
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
#ifdef USE_OPENMP
!$omp end parallel do
#endif
      return
      end
c
      subroutine sd_t_d1_5(h3d,h2d,h1d,p6d,p5d,p4d,
     1               h7d,
     2               triplesx,t2sub,v2sub)
      IMPLICIT NONE
      integer h3d,h2d,h1d,p6d,p5d,p4d,h7d
      integer h3,h2,h1,p6,p5,p4,h7
      double precision triplesx(h3d,h1d,h2d,p5d,p4d,p6d)
      double precision t2sub(h7d,p4d,p5d,h1d)
      double precision v2sub(h3d,h2d,p6d,h7d)
#ifdef USE_OPENMP
!$omp parallel do private(p5,p6,p4,h1,h3,h2,h7) collapse(OMPCOLLAPSE)
#endif
      do p6=1,p6d
      do p4=1,p4d
      do p5=1,p5d
      do h2=1,h2d
      do h1=1,h1d
      do h3=1,h3d
      do h7=1,h7d
       triplesx(h3,h1,h2,p5,p4,p6)=triplesx(h3,h1,h2,p5,p4,p6)
     1   + t2sub(h7,p4,p5,h1)*v2sub(h3,h2,p6,h7)
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
#ifdef USE_OPENMP
!$omp end parallel do
#endif
      return
      end
c
      subroutine sd_t_d1_6(h3d,h2d,h1d,p6d,p5d,p4d,
     1               h7d,
     2               triplesx,t2sub,v2sub)
      IMPLICIT NONE
      integer h3d,h2d,h1d,p6d,p5d,p4d,h7d
      integer h3,h2,h1,p6,p5,p4,h7
      double precision triplesx(h1d,h3d,h2d,p5d,p4d,p6d)
      double precision t2sub(h7d,p4d,p5d,h1d)
      double precision v2sub(h3d,h2d,p6d,h7d)
#ifdef USE_OPENMP
!$omp parallel do private(p5,p6,p4,h1,h3,h2,h7) collapse(OMPCOLLAPSE)
#endif
      do p6=1,p6d
      do p4=1,p4d
      do p5=1,p5d
      do h2=1,h2d
      do h3=1,h3d
      do h1=1,h1d
      do h7=1,h7d
       triplesx(h1,h3,h2,p5,p4,p6)=triplesx(h1,h3,h2,p5,p4,p6)
     1   - t2sub(h7,p4,p5,h1)*v2sub(h3,h2,p6,h7)
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
#ifdef USE_OPENMP
!$omp end parallel do
#endif
      return
      end
c
      subroutine sd_t_d1_7(h3d,h2d,h1d,p6d,p5d,p4d,
     1               h7d,
     2               triplesx,t2sub,v2sub)
      IMPLICIT NONE
      integer h3d,h2d,h1d,p6d,p5d,p4d,h7d
      integer h3,h2,h1,p6,p5,p4,h7
      double precision triplesx(h3d,h2d,h1d,p5d,p6d,p4d)
      double precision t2sub(h7d,p4d,p5d,h1d)
      double precision v2sub(h3d,h2d,p6d,h7d)
#ifdef USE_OPENMP
!$omp parallel do private(p5,p6,p4,h1,h3,h2,h7) collapse(OMPCOLLAPSE)
#endif
      do p4=1,p4d
      do p6=1,p6d
      do p5=1,p5d
      do h1=1,h1d
      do h2=1,h2d
      do h3=1,h3d
      do h7=1,h7d
       triplesx(h3,h2,h1,p5,p6,p4)=triplesx(h3,h2,h1,p5,p6,p4)
     1   + t2sub(h7,p4,p5,h1)*v2sub(h3,h2,p6,h7)
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
#ifdef USE_OPENMP
!$omp end parallel do
#endif
      return
      end
c
      subroutine sd_t_d1_8(h3d,h2d,h1d,p6d,p5d,p4d,
     1               h7d,
     2               triplesx,t2sub,v2sub)
      IMPLICIT NONE
      integer h3d,h2d,h1d,p6d,p5d,p4d,h7d
      integer h3,h2,h1,p6,p5,p4,h7
      double precision triplesx(h3d,h1d,h2d,p5d,p6d,p4d)
      double precision t2sub(h7d,p4d,p5d,h1d)
      double precision v2sub(h3d,h2d,p6d,h7d)
#ifdef USE_OPENMP
!$omp parallel do private(p5,p6,p4,h1,h3,h2,h7) collapse(OMPCOLLAPSE)
#endif
      do p4=1,p4d
      do p6=1,p6d
      do p5=1,p5d
      do h2=1,h2d
      do h1=1,h1d
      do h3=1,h3d
      do h7=1,h7d
       triplesx(h3,h1,h2,p5,p6,p4)=triplesx(h3,h1,h2,p5,p6,p4)
     1   - t2sub(h7,p4,p5,h1)*v2sub(h3,h2,p6,h7)
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
#ifdef USE_OPENMP
!$omp end parallel do
#endif
      return
      end
c
      subroutine sd_t_d1_9(h3d,h2d,h1d,p6d,p5d,p4d,
     1               h7d,
     2               triplesx,t2sub,v2sub)
      IMPLICIT NONE
      integer h3d,h2d,h1d,p6d,p5d,p4d,h7d
      integer h3,h2,h1,p6,p5,p4,h7
      double precision triplesx(h1d,h3d,h2d,p5d,p6d,p4d)
      double precision t2sub(h7d,p4d,p5d,h1d)
      double precision v2sub(h3d,h2d,p6d,h7d)
#ifdef USE_OPENMP
!$omp parallel do private(p5,p6,p4,h1,h3,h2,h7) collapse(OMPCOLLAPSE)
#endif
      do p4=1,p4d
      do p6=1,p6d
      do p5=1,p5d
      do h2=1,h2d
      do h3=1,h3d
      do h1=1,h1d
      do h7=1,h7d
       triplesx(h1,h3,h2,p5,p6,p4)=triplesx(h1,h3,h2,p5,p6,p4)
     1   + t2sub(h7,p4,p5,h1)*v2sub(h3,h2,p6,h7)
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
#ifdef USE_OPENMP
!$omp end parallel do
#endif
      return
      end
c
      subroutine sd_t_d2_1(h3d,h2d,h1d,p6d,p5d,p4d,
     1               p7d,
     2               triplesx,t2sub,v2sub)
      IMPLICIT NONE
      integer h3d,h2d,h1d,p6d,p5d,p4d,p7d
      integer h3,h2,h1,p6,p5,p4,p7
      double precision triplesx(h3d,h2d,h1d,p6d,p5d,p4d)
      double precision t2sub(p7d,p4d,h1d,h2d)
      double precision v2sub(p7d,h3d,p6d,p5d)
#ifdef USE_OPENMP
!$omp parallel do private(p5,p6,p4,h1,h3,h2,p7) collapse(OMPCOLLAPSE)
#endif
      do p4=1,p4d
      do p5=1,p5d
      do p6=1,p6d
      do h1=1,h1d
      do h2=1,h2d
      do h3=1,h3d
      do p7=1,p7d
       triplesx(h3,h2,h1,p6,p5,p4)=triplesx(h3,h2,h1,p6,p5,p4)
     1   - t2sub(p7,p4,h1,h2)*v2sub(p7,h3,p6,p5)
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
#ifdef USE_OPENMP
!$omp end parallel do
#endif
      return
      end
c
      subroutine sd_t_d2_2(h3d,h2d,h1d,p6d,p5d,p4d,
     1               p7d,
     2               triplesx,t2sub,v2sub)
      IMPLICIT NONE
      integer h3d,h2d,h1d,p6d,p5d,p4d,p7d
      integer h3,h2,h1,p6,p5,p4,p7
      double precision triplesx(h2d,h1d,h3d,p6d,p5d,p4d)
      double precision t2sub(p7d,p4d,h1d,h2d)
      double precision v2sub(p7d,h3d,p6d,p5d)
#ifdef USE_OPENMP
!$omp parallel do private(p5,p6,p4,h1,h3,h2,p7) collapse(OMPCOLLAPSE)
#endif
      do p4=1,p4d
      do p5=1,p5d
      do p6=1,p6d
      do h3=1,h3d
      do h1=1,h1d
      do h2=1,h2d
      do p7=1,p7d
       triplesx(h2,h1,h3,p6,p5,p4)=triplesx(h2,h1,h3,p6,p5,p4)
     1   - t2sub(p7,p4,h1,h2)*v2sub(p7,h3,p6,p5)
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
#ifdef USE_OPENMP
!$omp end parallel do
#endif
      return
      end
c
      subroutine sd_t_d2_3(h3d,h2d,h1d,p6d,p5d,p4d,
     1               p7d,
     2               triplesx,t2sub,v2sub)
      IMPLICIT NONE
      integer h3d,h2d,h1d,p6d,p5d,p4d,p7d
      integer h3,h2,h1,p6,p5,p4,p7
      double precision triplesx(h2d,h3d,h1d,p6d,p5d,p4d)
      double precision t2sub(p7d,p4d,h1d,h2d)
      double precision v2sub(p7d,h3d,p6d,p5d)
#ifdef USE_OPENMP
!$omp parallel do private(p5,p6,p4,h1,h3,h2,p7) collapse(OMPCOLLAPSE)
#endif
      do p4=1,p4d
      do p5=1,p5d
      do p6=1,p6d
      do h1=1,h1d
      do h3=1,h3d
      do h2=1,h2d
      do p7=1,p7d
       triplesx(h2,h3,h1,p6,p5,p4)=triplesx(h2,h3,h1,p6,p5,p4)
     1   + t2sub(p7,p4,h1,h2)*v2sub(p7,h3,p6,p5)
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
#ifdef USE_OPENMP
!$omp end parallel do
#endif
      return
      end
c
      subroutine sd_t_d2_4(h3d,h2d,h1d,p6d,p5d,p4d,
     1               p7d,
     2               triplesx,t2sub,v2sub)
      IMPLICIT NONE
      integer h3d,h2d,h1d,p6d,p5d,p4d,p7d
      integer h3,h2,h1,p6,p5,p4,p7
      double precision triplesx(h3d,h2d,h1d,p6d,p4d,p5d)
      double precision t2sub(p7d,p4d,h1d,h2d)
      double precision v2sub(p7d,h3d,p6d,p5d)
#ifdef USE_OPENMP
!$omp parallel do private(p5,p6,p4,h1,h3,h2,p7) collapse(OMPCOLLAPSE)
#endif
      do p5=1,p5d
      do p4=1,p4d
      do p6=1,p6d
      do h1=1,h1d
      do h2=1,h2d
      do h3=1,h3d
      do p7=1,p7d
       triplesx(h3,h2,h1,p6,p4,p5)=triplesx(h3,h2,h1,p6,p4,p5)
     1   + t2sub(p7,p4,h1,h2)*v2sub(p7,h3,p6,p5)
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
#ifdef USE_OPENMP
!$omp end parallel do
#endif
      return
      end
c
      subroutine sd_t_d2_5(h3d,h2d,h1d,p6d,p5d,p4d,
     1               p7d,
     2               triplesx,t2sub,v2sub)
      IMPLICIT NONE
      integer h3d,h2d,h1d,p6d,p5d,p4d,p7d
      integer h3,h2,h1,p6,p5,p4,p7
      double precision triplesx(h2d,h1d,h3d,p6d,p4d,p5d)
      double precision t2sub(p7d,p4d,h1d,h2d)
      double precision v2sub(p7d,h3d,p6d,p5d)
#ifdef USE_OPENMP
!$omp parallel do private(p5,p6,p4,h1,h3,h2,p7) collapse(OMPCOLLAPSE)
#endif
      do p5=1,p5d
      do p4=1,p4d
      do p6=1,p6d
      do h3=1,h3d
      do h1=1,h1d
      do h2=1,h2d
      do p7=1,p7d
       triplesx(h2,h1,h3,p6,p4,p5)=triplesx(h2,h1,h3,p6,p4,p5)
     1   + t2sub(p7,p4,h1,h2)*v2sub(p7,h3,p6,p5)
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
#ifdef USE_OPENMP
!$omp end parallel do
#endif
      return
      end
c
      subroutine sd_t_d2_6(h3d,h2d,h1d,p6d,p5d,p4d,
     1               p7d,
     2               triplesx,t2sub,v2sub)
      IMPLICIT NONE
      integer h3d,h2d,h1d,p6d,p5d,p4d,p7d
      integer h3,h2,h1,p6,p5,p4,p7
      double precision triplesx(h2d,h3d,h1d,p6d,p4d,p5d)
      double precision t2sub(p7d,p4d,h1d,h2d)
      double precision v2sub(p7d,h3d,p6d,p5d)
#ifdef USE_OPENMP
!$omp parallel do private(p5,p6,p4,h1,h3,h2,p7) collapse(OMPCOLLAPSE)
#endif
      do p5=1,p5d
      do p4=1,p4d
      do p6=1,p6d
      do h1=1,h1d
      do h3=1,h3d
      do h2=1,h2d
      do p7=1,p7d
       triplesx(h2,h3,h1,p6,p4,p5)=triplesx(h2,h3,h1,p6,p4,p5)
     1   - t2sub(p7,p4,h1,h2)*v2sub(p7,h3,p6,p5)
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
#ifdef USE_OPENMP
!$omp end parallel do
#endif
      return
      end
c
      subroutine sd_t_d2_7(h3d,h2d,h1d,p6d,p5d,p4d,
     1               p7d,
     2               triplesx,t2sub,v2sub)
      IMPLICIT NONE
      integer h3d,h2d,h1d,p6d,p5d,p4d,p7d
      integer h3,h2,h1,p6,p5,p4,p7
      double precision triplesx(h3d,h2d,h1d,p4d,p6d,p5d)
      double precision t2sub(p7d,p4d,h1d,h2d)
      double precision v2sub(p7d,h3d,p6d,p5d)
#ifdef USE_OPENMP
!$omp parallel do private(p5,p6,p4,h1,h3,h2,p7) collapse(OMPCOLLAPSE)
#endif
      do p5=1,p5d
      do p6=1,p6d
      do p4=1,p4d
      do h1=1,h1d
      do h2=1,h2d
      do h3=1,h3d
      do p7=1,p7d
       triplesx(h3,h2,h1,p4,p6,p5)=triplesx(h3,h2,h1,p4,p6,p5)
     1   - t2sub(p7,p4,h1,h2)*v2sub(p7,h3,p6,p5)
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
#ifdef USE_OPENMP
!$omp end parallel do
#endif
      return
      end
c
      subroutine sd_t_d2_8(h3d,h2d,h1d,p6d,p5d,p4d,
     1               p7d,
     2               triplesx,t2sub,v2sub)
      IMPLICIT NONE
      integer h3d,h2d,h1d,p6d,p5d,p4d,p7d
      integer h3,h2,h1,p6,p5,p4,p7
      double precision triplesx(h2d,h1d,h3d,p4d,p6d,p5d)
      double precision t2sub(p7d,p4d,h1d,h2d)
      double precision v2sub(p7d,h3d,p6d,p5d)
#ifdef USE_OPENMP
!$omp parallel do private(p5,p6,p4,h1,h3,h2,p7) collapse(OMPCOLLAPSE)
#endif
      do p5=1,p5d
      do p6=1,p6d
      do p4=1,p4d
      do h3=1,h3d
      do h1=1,h1d
      do h2=1,h2d
      do p7=1,p7d
       triplesx(h2,h1,h3,p4,p6,p5)=triplesx(h2,h1,h3,p4,p6,p5)
     1   - t2sub(p7,p4,h1,h2)*v2sub(p7,h3,p6,p5)
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
#ifdef USE_OPENMP
!$omp end parallel do
#endif
      return
      end
c
      subroutine sd_t_d2_9(h3d,h2d,h1d,p6d,p5d,p4d,
     1               p7d,
     2               triplesx,t2sub,v2sub)
      IMPLICIT NONE
      integer h3d,h2d,h1d,p6d,p5d,p4d,p7d
      integer h3,h2,h1,p6,p5,p4,p7
      double precision triplesx(h2d,h3d,h1d,p4d,p6d,p5d)
      double precision t2sub(p7d,p4d,h1d,h2d)
      double precision v2sub(p7d,h3d,p6d,p5d)
#ifdef USE_OPENMP
!$omp parallel do private(p5,p6,p4,h1,h3,h2,p7) collapse(OMPCOLLAPSE)
#endif
      do p5=1,p5d
      do p6=1,p6d
      do p4=1,p4d
      do h1=1,h1d
      do h3=1,h3d
      do h2=1,h2d
      do p7=1,p7d
       triplesx(h2,h3,h1,p4,p6,p5)=triplesx(h2,h3,h1,p4,p6,p5)
     1   + t2sub(p7,p4,h1,h2)*v2sub(p7,h3,p6,p5)
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
      enddo
#ifdef USE_OPENMP
!$omp end parallel do
#endif
      return
      end
