1C     $Id$
2      SUBROUTINE offl_ccsd_t_singles_l(a_i0,d_t1,d_v2,
3     &k_t1_offset,k_v2_offset,t
4     &_h1b,t_h2b,t_h3b,t_p4b,t_p5b,t_p6b,toggle)
5C     $Id$
6C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
7C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
8C     i0 ( p4 p5 p6 h1 h2 h3 )_vt + = 1 * P( 9 ) * t ( p4 h1 )_t * v ( p5 p6 h2 h3 )_v
9      IMPLICIT NONE
10#include "global.fh"
11#include "mafdecls.fh"
12#include "util.fh"
13#include "errquit.fh"
14#include "tce.fh"
15#include "offl.fh"
16      INTEGER t_p4b
17      INTEGER t_p5b
18      INTEGER t_p6b
19      INTEGER t_h1b
20      INTEGER t_h2b
21      INTEGER t_h3b
22      INTEGER toggle
23      INTEGER d_t1
24      INTEGER k_t1_offset
25      INTEGER d_v2
26      INTEGER k_v2_offset
27      DOUBLE PRECISION a_i0(*)
28      logical offload_enabled
29      external offload_enabled
30      integer range_p4,range_h1,ii
31      integer t1size,v2size
32      integer l_t1sub,k_t1sub
33      integer l_v2sub,k_v2sub
34      integer l_scratch,k_scratch
35
36c
37
38      IF (toggle .eq. 2) then
39      call ccsd_t_v2t1lgth(t1size,v2size)
40      IF (.not.MA_PUSH_GET(mt_dbl,t1size,'t1sub',
41     L     l_t1sub,k_t1sub)) CALL
42     & ERRQUIT('ccsd_t_singles t1sub',101,MA_ERR)
43      IF (.not.MA_PUSH_GET(mt_dbl,v2size,'v2sub',
44     L     l_v2sub,k_v2sub)) CALL
45     & ERRQUIT('ccsd_t_singles v2sub',103,MA_ERR)
46      IF (.not.MA_PUSH_GET(mt_dbl,t1size,'t1scratch',
47     L     l_scratch,k_scratch)) CALL
48     & ERRQUIT('ccsd_t_singles v2sub',103,MA_ERR)
49#ifdef USE_OPENMP
50#ifdef OPENMP_OFFLOAD
51      if(offload_enabled()) then
52         CALL offl_gpu_ccsd_t_singles_l_1(
53     D        dbl_mb(d_t1),k_t1_offset,
54     &        d_v2,k_v2_offset,a_i0,
55     &        t_p4b,t_p5b,t_p6b,t_h1b,t_h2b,t_h3b,
56     T        dbl_mb(k_v2sub),dbl_mb(k_t1sub),dbl_mb(k_scratch))
57      else
58#endif
59#endif
60         CALL offl_cpu_ccsd_t_singles_l_1(
61     D        dbl_mb(d_t1),k_t1_offset,
62     &        d_v2,k_v2_offset,a_i0,
63     &        t_p4b,t_p5b,t_p6b,t_h1b,t_h2b,t_h3b,
64     T        dbl_mb(k_v2sub),dbl_mb(k_t1sub),dbl_mb(k_scratch))
65#ifdef USE_OPENMP
66#ifdef OPENMP_OFFLOAD
67      endif
68#endif
69#endif
70      IF (.not.MA_chop_stack(l_t1sub)) CALL
71     & ERRQUIT('ccsd_t_singles_l',103,MA_ERR)
72
73      endif
74      RETURN
75      END
76      subroutine ccsd_t_v2t1lgth(t1size,v2size)
77      implicit none
78#include "mafdecls.fh"
79#include "tce.fh"
80c     compute v2sub and t1sub max length
81      integer t1size,v2size ! [out]
82c
83      integer range_p4,range_h1,ii
84c
85      range_p4=0
86      do ii = noab+1,noab+nvab
87         range_p4 = max(range_p4,int_mb(k_range+ii-1))
88      enddo
89      range_h1=0
90      do ii = 1,noab
91         range_h1 = max(range_h1,int_mb(k_range+ii-1))
92      enddo
93      t1size=(range_p4)*(range_h1)
94      v2size=max((range_p4)*(range_h1**3),
95     M     (range_p4**3)*(range_h1))
96      call util_align64(t1size)
97      call util_align64(v2size)
98      return
99      end
100