From cd0352af7e598c8601f79f99b033387660215e27 Mon Sep 17 00:00:00 2001 From: Jeff Hammond Date: Fri, 4 Oct 2024 16:04:02 +0300 Subject: [PATCH 1/2] remove both nonblocking and Blue Gene/P versions of trpdrv ccsd_trpdrv_nb has a bug in it. all of the nonblocking stuff is in the OpenMP (_omp) version. that should be used instead. ccsd_trpdrv_bgp is obsolete. for any Blue Gene like system, the OpenMP version will be fine. Signed-off-by: Jeff Hammond --- src/ccsd/aoccsd2.F | 58 ++-------------------------------------------- 1 file changed, 2 insertions(+), 56 deletions(-) diff --git a/src/ccsd/aoccsd2.F b/src/ccsd/aoccsd2.F index ec436e385d..f43af82818 100644 --- a/src/ccsd/aoccsd2.F +++ b/src/ccsd/aoccsd2.F @@ -17,8 +17,8 @@ c Double Precision RefEner, Convi, Tol2E Character*(*) CC_Theory Integer RTDB, geom - logical oconverged, occd, use_trpdrv_nb - logical use_trpdrv_omp, use_trpdrv_bgp2 + logical oconverged, occd + logical use_trpdrv_omp logical use_trpdrv_omp_mp logical use_trpdrv_openmp_imax logical use_trpdrv_openacc @@ -717,9 +717,6 @@ C ! ! Determine if OpenMP, etc. should be used in (T) code ! - if (.not. rtdb_get(rtdb, 'ccsd:use_trpdrv_nb', mt_log, 1, - 1 use_trpdrv_nb)) - 2 use_trpdrv_nb=.false. if (.not. rtdb_get(rtdb, 'ccsd:use_trpdrv_omp', mt_log, 1, 1 use_trpdrv_omp)) 2 use_trpdrv_omp=.false. @@ -735,9 +732,6 @@ C if (.not. rtdb_get(rtdb, 'ccsd:use_trpdrv_offload', mt_log, 1, 1 use_trpdrv_offload)) 2 use_trpdrv_offload=.false. - if (.not. rtdb_get(rtdb, 'ccsd:use_trpdrv_bgp2', mt_log, 1, - 1 use_trpdrv_bgp2)) - 2 use_trpdrv_bgp2=.false. ! mem_avail = ma_inquire_avail(MT_DBL) if(iam.eq.0.and.oprint)write(luout,*)'memory',mem_avail @@ -1057,29 +1051,6 @@ c #else call errquit('aoccsd: trpdrv_omp_mixprec disabled ',0,0) #endif -c - elseif (use_trpdrv_nb) then -c - if (iam.eq.0.and.oprint) then - write(luout,1847) nvpass - call util_flush(luout) - endif - 1847 format(' commencing triples evaluation - non-blocking',i8) - call ccsd_trpdrv_nb(dbl_mb(k_t1), -#ifdef USE_F90_ALLOCATABLE - $ f1n,f1t,f2n,f2t,f3n,f3t,f4n,f4t, -#else - $ dbl_mb(k_f1n),dbl_mb(k_f1t),dbl_mb(k_f2n),dbl_mb(k_f2t), - $ dbl_mb(k_f3n),dbl_mb(k_f3t),dbl_mb(k_f4n),dbl_mb(k_f4t), -#endif - $ eorb,g_objo,g_objv,g_coul,g_exch,ncor,nocc,nvir,iprt, - $ empt(1),empt(2),oseg_lo,oseg_hi,kchunk, - $ dbl_mb(k_trp_Tij), dbl_mb(k_trp_Tkj), dbl_mb(k_trp_Tia), - $ dbl_mb(k_trp_Tka), dbl_mb(k_trp_Xia), dbl_mb(k_trp_Xka), - $ dbl_mb(k_trp_Jia), dbl_mb(k_trp_Jka), dbl_mb(k_trp_Kia), - $ dbl_mb(k_trp_Kka), dbl_mb(k_trp_Jij), dbl_mb(k_trp_Jkj), - $ dbl_mb(k_trp_Kij), dbl_mb(k_trp_Kkj), dbl_mb(k_trp_Dja), - $ dbl_mb(k_trp_Djka), dbl_mb(k_trp_Djia)) c #ifdef USE_MIC_TRPDRV elseif (use_trpdrv_offload) then @@ -1105,31 +1076,6 @@ c $ dbl_mb(k_trp_Kij), dbl_mb(k_trp_Kkj), dbl_mb(k_trp_Dja), $ dbl_mb(k_trp_Djka), dbl_mb(k_trp_Djia)) c -#endif -#ifdef BGP - elseif (use_trpdrv_bgp2) then -c - if (iam.eq.0.and.oprint) then - write(luout,1849)nvpass - call util_flush(luout) - endif - 1849 format(' commencing triples evaluation - Blue Gene v2',i8) - call ccsd_trpdrv_bgp2(dbl_mb(k_t1), -#ifdef USE_F90_ALLOCATABLE - $ f1n,f1t,f2n,f2t,f3n,f3t,f4n,f4t, -#else - $ dbl_mb(k_f1n),dbl_mb(k_f1t),dbl_mb(k_f2n),dbl_mb(k_f2t), - $ dbl_mb(k_f3n),dbl_mb(k_f3t),dbl_mb(k_f4n),dbl_mb(k_f4t), -#endif - $ eorb,g_objo,g_objv,g_coul,g_exch,ncor,nocc,nvir,iprt, - $ empt(1),empt(2),oseg_lo,oseg_hi,kchunk, - $ dbl_mb(k_trp_Tij), dbl_mb(k_trp_Tkj), dbl_mb(k_trp_Tia), - $ dbl_mb(k_trp_Tka), dbl_mb(k_trp_Xia), dbl_mb(k_trp_Xka), - $ dbl_mb(k_trp_Jia), dbl_mb(k_trp_Jka), dbl_mb(k_trp_Kia), - $ dbl_mb(k_trp_Kka), dbl_mb(k_trp_Jij), dbl_mb(k_trp_Jkj), - $ dbl_mb(k_trp_Kij), dbl_mb(k_trp_Kkj), dbl_mb(k_trp_Dja), - $ dbl_mb(k_trp_Djka), dbl_mb(k_trp_Djia)) -c #endif else c From 4ef2c6115e285d05ace902e3c32fe7ec7e898479 Mon Sep 17 00:00:00 2001 From: Jeff Hammond Date: Fri, 4 Oct 2024 16:06:35 +0300 Subject: [PATCH 2/2] remove --- src/ccsd/GNUmakefile | 8 - src/ccsd/ccsd_tengy_bgp.F | 70 ---- src/ccsd/ccsd_tengy_bgp2.F | 200 ----------- src/ccsd/ccsd_trpdrv_bgp2.F | 478 -------------------------- src/ccsd/ccsd_trpdrv_nb.F | 649 ------------------------------------ 5 files changed, 1405 deletions(-) delete mode 100644 src/ccsd/ccsd_tengy_bgp.F delete mode 100644 src/ccsd/ccsd_tengy_bgp2.F delete mode 100644 src/ccsd/ccsd_trpdrv_bgp2.F delete mode 100644 src/ccsd/ccsd_trpdrv_nb.F diff --git a/src/ccsd/GNUmakefile b/src/ccsd/GNUmakefile index 03d0391351..fbf7377dcd 100644 --- a/src/ccsd/GNUmakefile +++ b/src/ccsd/GNUmakefile @@ -28,7 +28,6 @@ endif ccsd_idx34.o \ ccsd_tengy.o \ ccsd_trpdrv.o \ - ccsd_trpdrv_nb.o \ ccsd_trpdrv_omp.o \ ccsd_trpdrv_omp_mixprec.o \ moints_trp.o \ @@ -76,7 +75,6 @@ endif ccsd_pdiis.F \ ccsd_sortmo.F \ ccsd_trpdrv.F \ - ccsd_trpdrv_nb.F \ ccsd_trpdrv_omp.F \ ccsd_trpdrv_omp_mixprec.F \ moints_trp.F \ @@ -94,17 +92,11 @@ endif aoccsd2.F \ ccsd_fsig1.F \ ccsd_fsig2.F \ - ccsd_trpdrv_bgp2.F \ ccsd_trpdrv_offload.F \ ccsd_trpdrv_openacc.F \ ccsd_trpdrv_openmp_imax.F \ moints_trp.F -ifeq ($(TARGET),BGP) - OBJ_OPTIMIZE += ccsd_trpdrv_bgp2.o ccsd_tengy_bgp2.o ccsd_tengy_bgp.o - LIB_DEFINES += -DBGP -endif - ifdef USE_MIC_TRPDRV OBJ_OPTIMIZE += ccsd_trpdrv_offload.o LIB_DEFINES += -DUSE_MIC_TRPDRV diff --git a/src/ccsd/ccsd_tengy_bgp.F b/src/ccsd/ccsd_tengy_bgp.F deleted file mode 100644 index ea3dc22a2a..0000000000 --- a/src/ccsd/ccsd_tengy_bgp.F +++ /dev/null @@ -1,70 +0,0 @@ -! -! Argonne Leadership Computing Facility -! BlueGene/P version -! Written by Vitali Morozov -! Updated 20091022 -! -O5 -qipa=noinline -qsmp=omp -! -! modified from the original (use of einv) -! - subroutine ccsd_tengy_bgp(f1n,f1t,f2n,f2t,f3n,f3t,f4n,f4t, - 1 dintc,dintx,t1v,einv, - 2 emp4,emp5,nvir) - implicit none - integer nvir,b,c - double precision emp4,emp5,denom - double precision two,three,four - double precision f1n(nvir,nvir),f1t(nvir,nvir) - double precision f2n(nvir,nvir),f2t(nvir,nvir) - double precision f3n(nvir,nvir),f3t(nvir,nvir) - double precision f4n(nvir,nvir),f4t(nvir,nvir) - double precision dintc(nvir),dintx(nvir),t1v(nvir) - double precision einv(nvir,nvir) - double precision e1, e2, e3, e4 - double precision t0, t1, t2, t3, t4, t5, t6, t7, t8, t9 - double precision z0, z1, z3, z5, z9, s0 -c -!$omp parallel do -!$omp& private(b,c,e1,e2,e3,e4,z0,z1,z3,z5,z9,s0, -!$omp& t0,t1,t2,t3,t4,t5,t6,t7,t8,t9) -!$omp& shared(f1n,f2n,f3n,f4n,f1t,f2t,f3t,f4t,dintx,dintc,t1v,einv) -!$omp& reduction(+:emp5,emp4) schedule(static) - do b = 1, nvir - do c = 1, nvir - - s0 = einv(c,b) - - e1 = f1n(c,b) + f4n(c,b) - 2d0*( f2n(c,b) + f3n(c,b) ) - e2 = e1 + 3d0*f1n(c,b) - - e3 = f1t(c,b) -2d0 * f2t(c,b) - e4 = e3 + f2n(c,b) - 2d0*( f3t(c,b) + f4n(c,b) + f1n(c,b) - 1 - 2d0*( f3n(c,b) + f4t(c,b) ) ) - - emp5 = emp5 + ( t1v(c)*( e1*dintc(b) + e4*dintx(b) ) - 1 + t1v(b)*( e2*dintx(c) + e3*dintc(c) ) ) * s0 - - t1 = f1t(c,b) + f3n(c,b) - t2 = f1n(c,b) + f2t(c,b) + f4n(c,b) - t9 = f1t(c,b) + f4t(c,b) - t0 = f2t(c,b) + f3t(c,b) - t3 = t9 - 2d0*t0 - t4 = t1 + f2n(c,b) - t5 = 2d0*t9 - t0 - t6 = f3n(c,b) + 2d0*f4t(c,b) - t7 = f3n(c,b) * f4t(c,b) - t8 = t1*t3 - f1n(c,b)*t5 +3d0*( f1n(c,b)*f1n(c,b) + t7 ) - - z0 = f2t(b,c) + f3t(b,c) - z9 = f1t(b,c) + f4t(b,c) - z1 = f1t(b,c) + f3n(b,c) - z3 = z9 - 2d0*z0 - z5 = 2d0*z9 - z0 - - emp4 = emp4 + ( t8 + t2*z3 - t4*z5 - 1 + 3d0*( t6*f1n(b,c) + f2t(c,b)*f2n(b,c) ) ) * s0 - enddo - enddo -c - return - end diff --git a/src/ccsd/ccsd_tengy_bgp2.F b/src/ccsd/ccsd_tengy_bgp2.F deleted file mode 100644 index ff88335f28..0000000000 --- a/src/ccsd/ccsd_tengy_bgp2.F +++ /dev/null @@ -1,200 +0,0 @@ -c! -c! 1) eorb_m( 0 ) => eorb( ncor + nocc ), allos to have 1 pointer instead of 3 -c! 2) #include "ccsdps.fh" is unnecessary -c! 3) constants to variables is bad -c! 4) remove if (occsdps) for a moment -c! -c! Original 60794725 -c! Computed 42410408, intrinsics for d0-d9 - subroutine ccsd_tengy_bgp2(f1n,f1t,f2n,f2t,f3n,f3t,f4n,f4t, - 1 dintc,dintx,t1v,eorb_r,eaijk,emp4,emp5,nvir) - implicit none - integer ncor,nocc,nvir - integer b,c - double precision eaijk,emp4,emp5,denom - double precision f1n(nvir,nvir),f1t(nvir,nvir) - double precision f2n(nvir,nvir),f2t(nvir,nvir) - double precision f3n(nvir,nvir),f3t(nvir,nvir) - double precision f4n(nvir,nvir),f4t(nvir,nvir) - double precision dintc(nvir),dintx(nvir),t1v(nvir),eorb_r(*) - - complex(8), parameter :: two = (2d0,2d0), three = (3d0,3d0) - complex(8) af1t,af1n,af2t,af2n,af3t,af3n,af4t,af4n, - 1 adix,adiv,at1v,axmp,adic,b1,b2,b3,b4,b5,b6,b0,b9 - complex(8) c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,ca, - 1 bf1t,bf2t,bf3t,bf4t,bf1n,bf2n,bf3n - complex(8) d0,d1,d2,d3,d4,d5,d6,d7,d8,d9,da, - 1 cf1t,cf2t,cf3t,cf4t,cf1n,cf2n,cf3n,cf4n - complex(8) e0,e1,e3,e5,e9,ef1t,ef2t,ef3t,ef4t,ef1n,ef2n,ef3n, - 1 bxmp,bdiv - real(8) f0,f1 - - real(8) ediv(nvir,nvir) - -c! ediv is symmetric => ediv( b,c ) = ediv( c,b ) - do b = 1, nvir - do c = b, nvir - ediv( c,b ) = 1d0 / ( eaijk - eorb_r( b ) - eorb_r( c ) ) - ediv( b,c ) = ediv( c,b ) - enddo - enddo - - axmp = ( emp5,0d0 ) - - do b = 1, nvir - do c = 1, nvir, 2 - af1n = LOADFP( f1n( c,b ) ) - af1t = LOADFP( f1t( c,b ) ) - af2n = LOADFP( f2n( c,b ) ) - af2t = LOADFP( f2t( c,b ) ) - af3n = LOADFP( f3n( c,b ) ) - af3t = LOADFP( f3t( c,b ) ) - af4n = LOADFP( f4n( c,b ) ) - af4t = LOADFP( f4t( c,b ) ) - at1v = LOADFP( t1v( c ) ) - adic = LOADFP( dintc( c ) ) - adix = LOADFP( dintx( c ) ) - adiv = LOADFP( ediv( c,b ) ) - - b5 = FPADD( af1n, af4n ) - b5 = FPNMSUB( b5, two, af3n ) - b1 = FPNMSUB( b5, two, af2n ) - b2 = FPMADD( b1,three,af1n ) - b3 = FPNMSUB( af1t, two, af2t ) - b4 = FPADD( b3, af2n ) - b6 = FPNMSUB( b5, two, af4t ) - b4 = FPNMSUB( b4, two, af3t ) - b4 = FPNMSUB( b4, two, b6 ) - b4 = FXPMUL( b4, dintx(b) ) - b4 = FXCPMADD( b4, b1, dintc(b) ) - b4 = FPMUL( b4, at1v ) - b3 = FPMUL( b3, adic ) - b3 = FPMADD( b3, b2, adix ) - b3 = FXCPMADD( b4, b3, t1v(b) ) - axmp = FPMADD( axmp, b3, adiv ) - enddo - enddo - - emp5 = DBLE( axmp ) + IMAG( axmp ) - - bxmp = ( 0d0,0d0 ) - do b = 1, nvir, 2 - do c = 1, nvir, 2 - - af1t = LOADFP( f1t( c,b ) ) - af2t = LOADFP( f2t( c,b ) ) - af3t = LOADFP( f3t( c,b ) ) - af4t = LOADFP( f4t( c,b ) ) - af1n = LOADFP( f1n( c,b ) ) - af2n = LOADFP( f2n( c,b ) ) - af3n = LOADFP( f3n( c,b ) ) - af4n = LOADFP( f4n( c,b ) ) - adiv = LOADFP( ediv( c,b ) ) - - c1 = FPADD( af1t, af3n ) - c2 = FPADD( af1n, af2t ) - c2 = FPADD( c2, af4n ) - c9 = FPADD( af1t, af4t ) - c0 = FPADD( af2t, af3t ) - c3 = FPNMSUB( c9, two, c0 ) - c4 = FPADD( c1, af2n ) - c5 = FPMSUB( c0, two, c9 ) - c6 = FPMADD( af3n, two, af4t ) - c7 = FPMUL( af3n, af4t ) - c8 = FPMUL( c1, c3 ) - ca = FPMADD( c7, af1n, af1n ) - c8 = FPNMSUB( c8, c5, af1n ) - c8 = FPMADD( c8, three, ca ) - - bf1t = LOADFP( f1t( b,c ) ) - bf2t = LOADFP( f2t( b,c ) ) - bf3t = LOADFP( f3t( b,c ) ) - bf4t = LOADFP( f4t( b,c ) ) - bf1n = LOADFP( f1n( b,c ) ) - bf2n = LOADFP( f2n( b,c ) ) - bf3n = LOADFP( f3n( b,c ) ) - - b0 = FPADD( bf2t, bf3t ) - b9 = FPADD( bf1t, bf4t ) - b1 = FPADD( bf1t, bf3n ) - b3 = FPNMSUB( b9, two, b0 ) - b5 = FPMSUB( b0, two, b9 ) - - cf1t = LOADFP( f1t( c,b+1 ) ) - cf2t = LOADFP( f2t( c,b+1 ) ) - cf3t = LOADFP( f3t( c,b+1 ) ) - cf4t = LOADFP( f4t( c,b+1 ) ) - cf1n = LOADFP( f1n( c,b+1 ) ) - cf2n = LOADFP( f2n( c,b+1 ) ) - cf3n = LOADFP( f3n( c,b+1 ) ) - cf4n = LOADFP( f4n( c,b+1 ) ) - bdiv = LOADFP( ediv( c,b+1 ) ) - - d1 = FPADD( cf1t, cf3n ) - d2 = FPADD( cf1n, cf2t ) - d2 = FPADD( d2, cf4n ) - d9 = FPADD( cf1t, cf4t ) - d0 = FPADD( cf2t, cf3t ) - d3 = FPNMSUB( d9, two, d0 ) - d4 = FPADD( d1, cf2n ) - d5 = FPMSUB( d0, two, d9 ) - d6 = FPMADD( cf3n, two, cf4t ) - !d7 = FPMUL( cf3n, cf4t ) - !d8 = FPMUL( d1, d3 ) - !da = FPMADD( d7, cf1n, cf1n ) - !d8 = FPNMSUB( d8, d5, cf1n ) - !d8 = FPMADD( d8, three, da ) - d5 = FPNMSUB( d5, three, cf1n ) - d7 = FPMUL( d1, d3 ) - d8 = FPNMSUB( d7, d5, cf1n ) - - ef1t = LOADFP( f1t( b,c+1 ) ) - ef2t = LOADFP( f2t( b,c+1 ) ) - ef3t = LOADFP( f3t( b,c+1 ) ) - ef4t = LOADFP( f4t( b,c+1 ) ) - ef1n = LOADFP( f1n( b,c+1 ) ) - ef2n = LOADFP( f2n( b,c+1 ) ) - ef3n = LOADFP( f3n( b,c+1 ) ) - - e0 = FPADD( ef2t, ef3t ) - e9 = FPADD( ef1t, ef4t ) - e1 = FPADD( ef1t, ef3n ) - e3 = FPNMSUB( e9, two, e0 ) - e5 = FPMSUB( e0, two, e9 ) - - f0 = IMAG( b3 ) - b3 = ( DBLE(b3),DBLE(e3) ) - e3 = ( f0,IMAG(e3) ) - f0 = IMAG( b5 ) - b5 = ( DBLE(b5),DBLE(e5) ) - e5 = ( f0,IMAG(e5) ) - f0 = IMAG( bf1n ) - bf1n = ( DBLE(bf1n),DBLE(ef1n) ) - ef1n = ( f0,IMAG(ef1n) ) - f0 = IMAG( bf2n ) - bf2n = ( DBLE(bf2n),DBLE(ef2n) ) - ef2n = ( f0,IMAG(ef2n) ) - - c8 = FPMADD( c8, c2, b3 ) - c6 = FPMUL( c6, bf1n ) - c8 = FPNMSUB( c8, c4, b5 ) - c6 = FPMADD( c6, af2t, bf2n ) - c8 = FPMADD( c8, three, c6 ) - bxmp = FPMADD( bxmp, c8, adiv ) - - d8 = FPMADD( d8, d2, e3 ) - d6 = FPMUL( d6, ef1n ) - d8 = FPNMSUB( d8, d4, e5 ) - d6 = FPMADD( d6, cf2t, ef2n ) - d6 = FPMADD( d6, cf3n, cf4t ) - d8 = FPMADD( d8, three, d6 ) - bxmp = FPMADD( bxmp, d8, bdiv ) - enddo - enddo - - emp4 = emp4 + DBLE( bxmp ) + IMAG( bxmp ) - - return - end - -c $Id$ diff --git a/src/ccsd/ccsd_trpdrv_bgp2.F b/src/ccsd/ccsd_trpdrv_bgp2.F deleted file mode 100644 index b0397218eb..0000000000 --- a/src/ccsd/ccsd_trpdrv_bgp2.F +++ /dev/null @@ -1,478 +0,0 @@ - subroutine ccsd_trpdrv_bgp2(t1, - & f1n,f1t,f2n,f2t,f3n,f3t,f4n,f4t,eorb, - & g_objo,g_objv,g_coul,g_exch, - & ncor,nocc,nvir,iprt,emp4,emp5, - & oseg_lo,oseg_hi, - $ kchunk, Tij, Tkj, Tia, Tka, Xia, Xka, Jia, Jka, Kia, Kka, - $ Jij, Jkj, Kij, Kkj, Dja, Djka, Djia) -C $Id$ - implicit none -c -#include "global.fh" -#include "ccsd_len.fh" -#include "ccsdps.fh" -c - double precision t1(*), - & f1n(*),f1t(*),f2n(*), - & f2t(*),f3n(*),f3t(*),f4n(*),f4t(*),eorb(*), - & emp4,emp5 - double precision Tij(*), Tkj(*), Tia(*), Tka(*), Xia(*), Xka(*), - $ Jia(*), Jka(*), Kia(*), Kka(*), - $ Jij(*), Jkj(*), Kij(*), Kkj(*), Dja(*), Djka(*), Djia(*) - - integer g_objo,g_objv,ncor,nocc,nvir,iprt,g_coul, - & g_exch,oseg_lo,oseg_hi -c - double precision eaijk - integer a,b,c,i,j,k,akold,av,inode,len,next,nxtask - external nxtask -C - Integer Nodes, IAm -c - integer klo, khi, start, end - integer kchunk -c -#ifdef DEBUG_PRINT - integer tt - double precision tt0,tt1,trp_time(26) -#endif -c - double precision zip - data zip/0.0d00/ -c -c apr call ga_print(g_coul) -c apr call ga_print(g_exch) - Nodes = GA_NNodes() - IAm = GA_NodeID() -C - call ga_sync() - if (occsdps) then - call pstat_on(ps_trpdrv) - else - call qenter('trpdrv',0) - endif - inode=-1 - next=nxtask(nodes, 1) -c -#ifdef DEBUG_PRINT - do tt = 1, 26 - trp_time(tt) = 0.0d0 - enddo -#endif -c - do klo = 1, nocc, kchunk - akold=0 - khi = min(nocc, klo+kchunk-1) - do a=oseg_lo,oseg_hi - av=a-ncor-nocc - do j=1,nocc - inode=inode+1 - if (inode.eq.next)then -c -c Get Dja = Dci,ja for given j, a, all ci -c - start = 1 + (j-1)*lnov - len = lnov - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_get(g_objv,start,end,av,av,Dja,len) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(1) = trp_time(1) + (tt1-tt0) -#endif -c -c Get Tkj = T(b,c,k,j) for given j, klo<=k<=khi, all bc -c - start = (klo-1)*lnvv + 1 - len = (khi-klo+1)*lnvv - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_get(g_objo,start,end,j,j,Tkj,len) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(2) = trp_time(2) + (tt1-tt0) -#endif -c -c Get Jkj = J(c,l,k,j) for given j, klo<=k<=khi, all cl -c - start = lnovv + (klo-1)*lnov + 1 - len = (khi-klo+1)*lnov - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_get(g_objo,start,end,j,j,Jkj,len) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(3) = trp_time(3) + (tt1-tt0) -#endif -c -c Get Kkj = K(c,l,k,j) for given j, klo<=k<=khi, all cl -c - start = lnovv + lnoov + (klo-1)*lnov + 1 - len = (khi-klo+1)*lnov - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_get(g_objo,start,end,j,j,Kkj,len) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(4) = trp_time(4) + (tt1-tt0) -#endif -c - if (akold .ne. a) then - akold = a -c -c Get Jka = J(b,c,k,a) for given a, klo<=k<=khi, all bc -c - start = (a-oseg_lo)*nocc + klo - len = (khi-klo+1) - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_get(g_coul,1,lnvv,start,end,Jka,lnvv) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(5) = trp_time(5) + (tt1-tt0) -#endif -c -c Get Kka = K(b,c,k,a) for given a, klo<=k<=khi, all bc -c - start = (a-oseg_lo)*nocc + klo - len = (khi-klo+1) - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_get(g_exch,1,lnvv,start,end,Kka,lnvv) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(6) = trp_time(6) + (tt1-tt0) -#endif -c -c Get Tka = Tbl,ka for given a, klo<=k<=khi, all bl -c - start = 1 + lnoov + (klo-1)*lnov - len = (khi-klo+1)*lnov - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_get(g_objv,start,end,av,av,Tka,len) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(7) = trp_time(7) + (tt1-tt0) -#endif -c -c Get Xka = Tal,kb for given a, klo<=k<=khi, all bl -c - start = 1 + lnoov + lnoov + (klo-1)*lnov - len = (khi-klo+1)*lnov - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_get(g_objv,start,end,av,av,Xka,len) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(8) = trp_time(8) + (tt1-tt0) -#endif - endif -c -c Get Djka = Dcj,ka for given j, a, klo<=k<=khi, all c -c - do k = klo, khi - start = 1 + (j-1)*nvir + (k-1)*lnov - len = nvir - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_get(g_objv,start,end,av,av, - $ Djka(1+(k-klo)*nvir),len) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(9) = trp_time(9) + (tt1-tt0) -#endif - enddo -c - do i=1,nocc -c -c Get Tij = T(b,c,i,j) for given j, i, all bc -c - start = (i-1)*lnvv + 1 - len = lnvv - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_get(g_objo,start,end,j,j,Tij,len) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(10) = trp_time(10) + (tt1-tt0) -#endif -c -c Get Jij = J(c,l,i,j) for given j, i, all cl -c - start = lnovv + (i-1)*lnov + 1 - len = lnov - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_get(g_objo,start,end,j,j,Jij,len) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(11) = trp_time(11) + (tt1-tt0) -#endif -c -c Get Kij = K(c,l,i,j) for given j, i, all cl -c - start = lnovv + lnoov + (i-1)*lnov + 1 - len = lnov - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_get(g_objo,start,end,j,j,Kij,len) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(12) = trp_time(12) + (tt1-tt0) -#endif -c -c Get Jia = J(b,c,i,a) for given a, i, all bc -c - start = (a-oseg_lo)*nocc + i - len = 1 - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_get(g_coul,1,lnvv,start,end,Jia,lnvv) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(13) = trp_time(13) + (tt1-tt0) -#endif -c -c Get Kia = K(b,c,i,a) for given a, i, all bc -c - start = (a-oseg_lo)*nocc + i - len = 1 - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_get(g_exch,1,lnvv,start,end,Kia,lnvv) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(14) = trp_time(14) + (tt1-tt0) -#endif -c -c Get Dia = Dcj,ia for given j, i, a, all c -c - start = 1 + (j-1)*nvir + (i-1)*lnov - len = nvir - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_get(g_objv,start,end,av,av,Djia,len) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(15) = trp_time(15) + (tt1-tt0) -#endif -c -c Get Tia = Tbl,ia for given a, i, all bl -c - start = 1 + lnoov + (i-1)*lnov - len = lnov - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_get(g_objv,start,end,av,av,Tia,len) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(16) = trp_time(16) + (tt1-tt0) -#endif -c -c Get Xia = Tal,ib for given a, i, all bl -c - start = 1 + lnoov + lnoov + (i-1)*lnov - len = lnov - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_get(g_objv,start,end,av,av,Xia,len) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(17) = trp_time(17) + (tt1-tt0) -#endif -c - do k=klo,min(khi,i) - call dfill(lnvv,zip,f1n,1) - call dfill(lnvv,zip,f1t,1) - call dfill(lnvv,zip,f2n,1) - call dfill(lnvv,zip,f2t,1) - call dfill(lnvv,zip,f3n,1) - call dfill(lnvv,zip,f3t,1) - call dfill(lnvv,zip,f4n,1) - call dfill(lnvv,zip,f4t,1) -c -c sum(d) (Jia, Kia)bd * Tkj,cd -> Fbc -c -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ccsd_dovvv(Jia, Kia, - $ Tkj(1+(k-klo)*lnvv),f1n,f2n,f3n,f4n, - $ nocc,nvir) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(18) = trp_time(18) + (tt1-tt0) -#endif -c -c sum(d) (Jka, Kka)bd * Tij,cd -> Fbc -c -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ccsd_dovvv(Jka(1+(k-klo)*lnvv), - $ Kka(1+(k-klo)*lnvv), - $ Tij,f1t,f2t,f3t,f4t,nocc,nvir) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(19) = trp_time(19) + (tt1-tt0) -#endif -c -c sum(l) (Jij, Kij)cl * Tkl,ab -> Fbc -c -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ccsd_doooo(Jkj(1+(k-klo)*lnov), - $ Kkj(1+(k-klo)*lnov), - $ Tia,Xia, - $ f1n,f2n, - $ f3n,f4n,nocc,nvir) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(20) = trp_time(20) + (tt1-tt0) -#endif -c -c sum(l) (Jkj, Kkj)cl * Tli,ba -> Fbc -c -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ccsd_doooo(Jij, Kij, - $ Tka(1+(k-klo)*lnov),Xka(1+(k-klo)*lnov), - $ f1t,f2t, - $ f3t,f4t,nocc,nvir) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(21) = trp_time(21) + (tt1-tt0) -#endif -c -c if (iprt.gt.50)then -c call prtfmat(f1n,f1t,f2n,f2t,f3n,f3t,f4n, -c $ f4t, nvir) -c end if -c - eaijk=eorb(ncor+i)+eorb(ncor+j)+eorb(ncor+k) - $ -eorb(a) -c -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ccsd_tengy_bgp2(f1n,f1t,f2n,f2t, - $ f3n,f3t,f4n,f4t, - $ Dja(1+(i-1)*nvir), - $ Djia, - $ t1((k-1)*nvir+1), - $ eorb(nocc+ncor+1), - $ eaijk,emp4,emp5, - $ ncor,nocc,nvir) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(22) = trp_time(22) + (tt1-tt0) -#endif -c - if (i.ne.k)then -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ccsd_tengy_bgp2(f1t,f1n,f2t,f2n, - $ f3t,f3n,f4t,f4n, - $ Dja(1+(k-1)*nvir), - $ Djka(1+(k-klo)*nvir), - $ t1((i-1)*nvir+1), - $ eorb(nocc+ncor+1), - $ eaijk,emp4,emp5, - $ ncor,nocc,nvir) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(23) = trp_time(23) + (tt1-tt0) -#endif -c - end if - end do - end do - if (iprt.gt.50)then - write(6,1234)iam,a,j,emp4,emp5 - 1234 format(' iam aijk',3i5,2e15.5) - end if - next=nxtask(nodes, 1) - end if - end do - end do - end do -c -#ifdef DEBUG_PRINT -c - do tt = 1, 17 - !write(6,97) IAm,tt,trp_time(tt) - trp_time(24) = trp_time(24) + trp_time(tt) - enddo - call util_flush(6) - 97 format('node ',i5,': ga_get timer(',i2,') = ',1e15.5) -c - do tt = 18, 21 - !write(6,98) IAm,tt,trp_time(tt) - trp_time(25) = trp_time(25) + trp_time(tt) - enddo - call util_flush(6) - 98 format('node ',i5,': dgemm timer(',i2,') = ',1e15.5) -c - do tt = 22, 23 - !write(6,99) IAm,tt,trp_time(tt) - trp_time(26) = trp_time(26) + trp_time(tt) - enddo - call util_flush(6) - 99 format('node ',i5,': tengy timer(',i2,') = ',1e15.5) -c - call ga_sync() - if (IAm.eq.0) write(6,87) - 87 format(2x,'node',6x,'ga_get',9x,'dgemm',10x,'tengy') - call ga_sync() - write(6,88) IAm,trp_time(24),trp_time(25),trp_time(26) - 88 format(i7,3e15.5) -c -#endif -c - next=nxtask(-nodes, 1) - call ga_sync() - if (occsdps) then - call pstat_off(ps_trpdrv) - else - call qexit('trpdrv',0) - endif -c - end diff --git a/src/ccsd/ccsd_trpdrv_nb.F b/src/ccsd/ccsd_trpdrv_nb.F deleted file mode 100644 index 68e2845074..0000000000 --- a/src/ccsd/ccsd_trpdrv_nb.F +++ /dev/null @@ -1,649 +0,0 @@ - subroutine ccsd_trpdrv_nb(t1, - & f1n,f1t,f2n,f2t,f3n,f3t,f4n,f4t,eorb, - & g_objo,g_objv,g_coul,g_exch, - & ncor,nocc,nvir,iprt,emp4,emp5, - & oseg_lo,oseg_hi, - $ kchunk, Tij, Tkj, Tia, Tka, Xia, Xka, Jia, Jka, Kia, Kka, - $ Jij, Jkj, Kij, Kkj, Dja, Djka, Djia) -c -C $Id$ -c -c CCSD(T) non-blocking modifications written by -c Jeff Hammond, Argonne Leadership Computing Facility -c Fall 2009 -c - implicit none -c -#include "global.fh" -#include "ccsd_len.fh" -#include "ccsdps.fh" -c - double precision t1(*), - & f1n(*),f1t(*),f2n(*), - & f2t(*),f3n(*),f3t(*),f4n(*),f4t(*),eorb(*), - & emp4,emp5 - double precision Tij(*), Tkj(*), Tia(*), Tka(*), Xia(*), Xka(*), - $ Jia(*), Jka(*), Kia(*), Kka(*), - $ Jij(*), Jkj(*), Kij(*), Kkj(*), Dja(*), Djka(*), Djia(*) - - integer g_objo,g_objv,ncor,nocc,nvir,iprt,g_coul, - & g_exch,oseg_lo,oseg_hi -c - double precision eaijk - integer a,i,j,k,akold,av,inode,len,ad3,next - integer nxtask - external nxtask -c - Integer Nodes, IAm -c - integer klo, khi, start, end - integer kchunk -c -c================================================== -c -c NON-BLOCKING stuff -c -c================================================== -c -c Dependencies (global array, local array, handle): -c -c g_objv, Dja, nbh_objv1 -c g_objv, Tka, nbh_objv2 -c g_objv, Xka, nbh_objv3 -c g_objv, Djka(1+(k-klo)*nvir), nbh_objv4(k) -c g_objv, Djia, nbh_objv5 -c g_objv, Tia, nbh_objv6 -c g_objv, Xia, nbh_objv7 -c g_objo, Tkj, nbh_objo1 -c g_objo, Jkj, nbh_objo2 -c g_objo, Kkj, nbh_objo3 -c g_objo, Tij, nbh_objo4 -c g_objo, Jij, nbh_objo5 -c g_objo, Kij, nbh_objo6 -c g_exch, Kka, nbh_exch1 -c g_exch, Kia, nbh_exch2 -c g_coul, Jka, nbh_coul1 -c g_coul, Jia, nbh_coul2 -c -c non-blocking handles -c - integer nbh_objv1,nbh_objv2,nbh_objv3 - integer nbh_objv5,nbh_objv6,nbh_objv7 - integer nbh_objv4(nocc) -c - integer nbh_objo1,nbh_objo2,nbh_objo3 - integer nbh_objo4,nbh_objo5,nbh_objo6 -c - integer nbh_exch1,nbh_exch2,nbh_coul1,nbh_coul2 -c - logical need_ccsd_dovvv1 - logical need_ccsd_dovvv2 - logical need_ccsd_doooo1 - logical need_ccsd_doooo2 -c -#ifdef DEBUG_PRINT - integer tt - double precision tt0,tt1,trp_time(26) -#endif -c -c================================================== -c - double precision zip - data zip/0.0d00/ -c - Nodes = GA_NNodes() - IAm = GA_NodeID() -c - call ga_sync() -c - if (occsdps) then - call pstat_on(ps_trpdrv) - else - call qenter('trpdrv',0) - endif - inode=-1 - next=nxtask(nodes, 1) -c -#ifdef DEBUG_PRINT - do tt = 1, 26 - trp_time(tt) = 0.0d0 - enddo -#endif -c - do klo = 1, nocc, kchunk - akold=0 - khi = min(nocc, klo+kchunk-1) - do a=oseg_lo,oseg_hi - av=a-ncor-nocc - do j=1,nocc - inode=inode+1 - if (inode.eq.next)then -c -c Get Dja = Dci,ja for given j, a, all ci -c - start = 1 + (j-1)*lnov - len = lnov - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_nbget(g_objv,start,end,av,av,Dja,len, - 1 nbh_objv1) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(1) = trp_time(1) + (tt1-tt0) -#endif -c -c Get Tkj = T(b,c,k,j) for given j, klo<=k<=khi, all bc -c - start = (klo-1)*lnvv + 1 - len = (khi-klo+1)*lnvv - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_nbget(g_objo,start,end,j,j,Tkj,len, - 1 nbh_objo1) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(2) = trp_time(2) + (tt1-tt0) -#endif -c -c Get Jkj = J(c,l,k,j) for given j, klo<=k<=khi, all cl -c - start = lnovv + (klo-1)*lnov + 1 - len = (khi-klo+1)*lnov - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_nbget(g_objo,start,end,j,j,Jkj,len, - 1 nbh_objo2) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(3) = trp_time(3) + (tt1-tt0) -#endif -c -c Get Kkj = K(c,l,k,j) for given j, klo<=k<=khi, all cl -c - start = lnovv + lnoov + (klo-1)*lnov + 1 - len = (khi-klo+1)*lnov - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_nbget(g_objo,start,end,j,j,Kkj,len, - 1 nbh_objo3) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(4) = trp_time(4) + (tt1-tt0) -#endif -c - if (akold .ne. a) then - akold = a -c -c Get Jka = J(b,c,k,a) for given a, klo<=k<=khi, all bc -c - start = (a-oseg_lo)*nocc + klo - len = (khi-klo+1) - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_nbget(g_coul,1,lnvv,start,end,Jka,lnvv, - 1 nbh_coul1) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(5) = trp_time(5) + (tt1-tt0) -#endif -c -c Get Kka = K(b,c,k,a) for given a, klo<=k<=khi, all bc -c - start = (a-oseg_lo)*nocc + klo - len = (khi-klo+1) - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_nbget(g_exch,1,lnvv,start,end,Kka,lnvv, - 1 nbh_exch1) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(6) = trp_time(6) + (tt1-tt0) -#endif -c -c Get Tka = Tbl,ka for given a, klo<=k<=khi, all bl -c - start = 1 + lnoov + (klo-1)*lnov - len = (khi-klo+1)*lnov - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_nbget(g_objv,start,end,av,av,Tka,len, - 1 nbh_objv2) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(7) = trp_time(7) + (tt1-tt0) -#endif -c -c Get Xka = Tal,kb for given a, klo<=k<=khi, all bl -c - start = 1 + lnoov + lnoov + (klo-1)*lnov - len = (khi-klo+1)*lnov - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_nbget(g_objv,start,end,av,av,Xka,len, - 1 nbh_objv3) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(8) = trp_time(8) + (tt1-tt0) -#endif - endif -c -c Get Djka = Dcj,ka for given j, a, klo<=k<=khi, all c -c - do k = klo, khi - start = 1 + (j-1)*nvir + (k-1)*lnov - len = nvir - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_nbget(g_objv,start,end,av,av, - 1 Djka(1+(k-klo)*nvir),len,nbh_objv4(k)) ! k <= nocc -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(9) = trp_time(9) + (tt1-tt0) -#endif - enddo -c - do i=1,nocc -c -c Get Tij = T(b,c,i,j) for given j, i, all bc -c - start = (i-1)*lnvv + 1 - len = lnvv - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_nbget(g_objo,start,end,j,j,Tij,len, - 1 nbh_objo4) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(10) = trp_time(10) + (tt1-tt0) -#endif -c -c Get Jij = J(c,l,i,j) for given j, i, all cl -c - start = lnovv + (i-1)*lnov + 1 - len = lnov - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_nbget(g_objo,start,end,j,j,Jij,len, - 1 nbh_objo5) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(11) = trp_time(11) + (tt1-tt0) -#endif -c -c Get Kij = K(c,l,i,j) for given j, i, all cl -c - start = lnovv + lnoov + (i-1)*lnov + 1 - len = lnov - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_nbget(g_objo,start,end,j,j,Kij,len, - 1 nbh_objo6) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(12) = trp_time(12) + (tt1-tt0) -#endif -c -c Get Jia = J(b,c,i,a) for given a, i, all bc -c - start = (a-oseg_lo)*nocc + i - len = 1 - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_nbget(g_coul,1,lnvv,start,end,Jia,lnvv, - 1 nbh_coul2) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(13) = trp_time(13) + (tt1-tt0) -#endif -c -c Get Kia = K(b,c,i,a) for given a, i, all bc -c - start = (a-oseg_lo)*nocc + i - len = 1 - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_nbget(g_exch,1,lnvv,start,end,Kia,lnvv, - 1 nbh_exch2) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(14) = trp_time(14) + (tt1-tt0) -#endif -c -c Get Dia = Dcj,ia for given j, i, a, all c -c - start = 1 + (j-1)*nvir + (i-1)*lnov - len = nvir - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_nbget(g_objv,start,end,av,av,Djia,len, - 1 nbh_objv5) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(15) = trp_time(15) + (tt1-tt0) -#endif -c -c Get Tia = Tbl,ia for given a, i, all bl -c - start = 1 + lnoov + (i-1)*lnov - len = lnov - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_nbget(g_objv,start,end,av,av,Tia,len, - 1 nbh_objv6) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(16) = trp_time(16) + (tt1-tt0) -#endif -c -c Get Xia = Tal,ib for given a, i, all bl -c - start = 1 + lnoov + lnoov + (i-1)*lnov - len = lnov - end = start + len - 1 -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ga_nbget(g_objv,start,end,av,av,Xia,len, - 1 nbh_objv7) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(17) = trp_time(17) + (tt1-tt0) -#endif -c - do k=klo,min(khi,i) - call dfill(lnvv,zip,f1n,1) - call dfill(lnvv,zip,f1t,1) - call dfill(lnvv,zip,f2n,1) - call dfill(lnvv,zip,f2t,1) - call dfill(lnvv,zip,f3n,1) - call dfill(lnvv,zip,f3t,1) - call dfill(lnvv,zip,f4n,1) - call dfill(lnvv,zip,f4t,1) -c - need_ccsd_dovvv1 = .true. - need_ccsd_dovvv2 = .true. - need_ccsd_doooo1 = .true. - need_ccsd_doooo2 = .true. -c -#ifdef DEBUG_PRINT - !write(6,*) IAm,'before do-while loop' -#endif -c - do while ( need_ccsd_dovvv1 .or. need_ccsd_dovvv2 - 1 .or. need_ccsd_doooo1 .or. need_ccsd_doooo2 ) -c -c sum(d) (Jia, Kia)bd * Tkj,cd -> Fbc -c -c g_coul, Jia, nbh_coul2 -c g_exch, Kia, nbh_exch2 -c g_objo, Tkj, nbh_objo1 -c - if ( need_ccsd_dovvv1 ) then - if ( (0.eq.ga_nbtest(nbh_coul2)) .and. - 1 (0.eq.ga_nbtest(nbh_exch2)) .and. - 2 (0.eq.ga_nbtest(nbh_objo1)) ) then - -#ifdef DEBUG_PRINT - !write(6,55) IAm,'ccsd_dovvv1' -#endif - -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ccsd_dovvv(Jia, Kia, - $ Tkj(1+(k-klo)*lnvv), - $ f1n,f2n,f3n,f4n,nocc,nvir) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(18) = trp_time(18) + (tt1-tt0) -#endif -c - need_ccsd_dovvv1 = .false. -c - endif - endif -c -c sum(d) (Jka, Kka)bd * Tij,cd -> Fbc -c -c g_coul, Jka, nbh_coul1 -c g_exch, Kka, nbh_exch1 -c g_objo, Tij, nbh_objo4 -c - if ( need_ccsd_dovvv2 ) then - if ( (0.eq.ga_nbtest(nbh_coul1)) .and. - 1 (0.eq.ga_nbtest(nbh_exch1)) .and. - 2 (0.eq.ga_nbtest(nbh_objo4)) ) then - -#ifdef DEBUG_PRINT - !write(6,55) IAm,'ccsd_dovvv2' -#endif - -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ccsd_dovvv(Jka(1+(k-klo)*lnvv), - $ Kka(1+(k-klo)*lnvv),Tij, - $ f1t,f2t,f3t,f4t,nocc,nvir) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(19) = trp_time(19) + (tt1-tt0) -#endif -c - need_ccsd_dovvv2 = .false. -c - endif - endif -c -c sum(l) (Jij, Kij)cl * Tkl,ab -> Fbc -c -c g_objo, Jkj, nbh_objo2 -c g_objo, Kkj, nbh_objo3 -c g_objv, Tia, nbh_objv6 -c g_objv, Xia, nbh_objv7 -c - if ( need_ccsd_doooo1 ) then - if ( (0.eq.ga_nbtest(nbh_objo2)) .and. - 1 (0.eq.ga_nbtest(nbh_objo3)) .and. - 2 (0.eq.ga_nbtest(nbh_objv6)) .and. - 3 (0.eq.ga_nbtest(nbh_objv7)) ) then - -#ifdef DEBUG_PRINT - !write(6,55) IAm,'ccsd_doooo1' -#endif - -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ccsd_doooo(Jkj(1+(k-klo)*lnov), - $ Kkj(1+(k-klo)*lnov),Tia,Xia, - $ f1n,f2n,f3n,f4n,nocc,nvir) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(20) = trp_time(20) + (tt1-tt0) -#endif -c - need_ccsd_doooo1 = .false. -c - endif - endif -c -c sum(l) (Jkj, Kkj)cl * Tli,ba -> Fbc -c -c g_objo, Jij, nbh_objo5 -c g_objo, Kij, nbh_objo6 -c g_objv, Tka, nbh_objv2 -c g_objv, Xka, nbh_objv3 -c - if ( need_ccsd_doooo2 ) then - if ( (0.eq.ga_nbtest(nbh_objo5)) .and. - 1 (0.eq.ga_nbtest(nbh_objo6)) .and. - 2 (0.eq.ga_nbtest(nbh_objv2)) .and. - 3 (0.eq.ga_nbtest(nbh_objv3)) ) then - -#ifdef DEBUG_PRINT - !write(6,55) IAm,'ccsd_doooo2' -#endif - -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ccsd_doooo(Jij, Kij, - $ Tka(1+(k-klo)*lnov),Xka(1+(k-klo)*lnov), - $ f1t,f2t,f3t,f4t,nocc,nvir) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(21) = trp_time(21) + (tt1-tt0) -#endif -c - need_ccsd_doooo2 = .false. -c - endif - endif -c - enddo ! while need... - -#ifdef DEBUG_PRINT - !write(6,*) IAm,'after do-while loop and before ga_nbwaits' -#endif -c -c g_objv, Dja, nbh_objv1 -c g_objv, Djka(1+(k-klo)*nvir), nbh_objv4(k) -c g_objv, Djia, nbh_objv5 -c -c just do waits since it is unlikely that these get calls -c will not finish during the time that ccsd_do... is running -c - call ga_nbwait(nbh_objv1) - !do k = klo, khi - call ga_nbwait(nbh_objv4(k)) - !enddo - call ga_nbwait(nbh_objv5) -c -#ifdef DEBUG_PRINT - !write(6,*) IAm,'after ga_nbwaits' -#endif -c - eaijk=eorb(ncor+i)+eorb(ncor+j)+eorb(ncor+k)- - $ eorb(a) - -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ccsd_tengy(f1n,f1t,f2n,f2t, - $ f3n,f3t,f4n,f4t, - & Dja(1+(i-1)*nvir),Djia, - $ t1((k-1)*nvir+1), - $ eorb,eaijk,emp4,emp5, - $ ncor,nocc,nvir) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(22) = trp_time(22) + (tt1-tt0) -#endif -c - if (i.ne.k)then -#ifdef DEBUG_PRINT - tt0 = ga_wtime() -#endif - call ccsd_tengy(f1t,f1n,f2t,f2n, - $ f3t,f3n,f4t,f4n, - $ Dja(1+(k-1)*nvir), - $ Djka(1+(k-klo)*nvir), - $ t1((i-1)*nvir+1), - $ eorb,eaijk,emp4,emp5, - $ ncor,nocc,nvir) -#ifdef DEBUG_PRINT - tt1 = ga_wtime() - trp_time(23) = trp_time(23) + (tt1-tt0) -#endif -c - end if - - - end do - end do - if (iprt.gt.50)then - write(6,1234)iam,a,j,emp4,emp5 - 1234 format(' iam aijk',3i5,2e15.5) - end if - next=nxtask(nodes, 1) - end if - end do - end do - end do -c -#ifdef DEBUG_PRINT -c - do tt = 1, 17 - !write(6,97) IAm,tt,trp_time(tt) - trp_time(24) = trp_time(24) + trp_time(tt) - enddo - call util_flush(6) - 97 format('node ',i5,': ga_nbget timer(',i2,') = ',1e15.5) -c - do tt = 18, 21 - !write(6,98) IAm,tt,trp_time(tt) - trp_time(25) = trp_time(25) + trp_time(tt) - enddo - call util_flush(6) - 98 format('node ',i5,': dgemm timer(',i2,') = ',1e15.5) -c - do tt = 22, 23 - !write(6,99) IAm,tt,trp_time(tt) - trp_time(26) = trp_time(26) + trp_time(tt) - enddo - call util_flush(6) - 99 format('node ',i5,': tengy timer(',i2,') = ',1e15.5) -c - call ga_sync() - if (IAm.eq.0) write(6,87) - 87 format(2x,'node',6x,'ga_nbget',9x,'dgemm',10x,'tengy') - call ga_sync() - write(6,88) IAm,trp_time(24),trp_time(25),trp_time(26) - 88 format(i7,3e15.5) -c -#endif -c - next=nxtask(-nodes, 1) - call ga_sync - if (occsdps) then - call pstat_off(ps_trpdrv) - else - call qexit('trpdrv',0) - endif -c - 55 format('node ',i5,': ',a12) -c - end -