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