From feeeae731a2fe98f3519fa73301a8105baf07ff5 Mon Sep 17 00:00:00 2001 From: edoapra Date: Tue, 14 Oct 2025 16:50:21 -0700 Subject: [PATCH 1/7] trying to improve parallelization --- src/ddscf/int_dip_ga.F | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/ddscf/int_dip_ga.F b/src/ddscf/int_dip_ga.F index 7f678d7d17..554b21e3b1 100644 --- a/src/ddscf/int_dip_ga.F +++ b/src/ddscf/int_dip_ga.F @@ -279,6 +279,7 @@ c end do double precision buf(jlo:jhi,6,ilo:ihi) integer i, j do i = ilo,ihi +#if 0 do j = jlo, jhi call ga_put(g_xx,i,i,j,j,buf(j,1,i),1) call ga_put(g_xy,i,i,j,j,buf(j,2,i),1) @@ -287,6 +288,14 @@ c end do call ga_put(g_yz,i,i,j,j,buf(j,5,i),1) call ga_put(g_zz,i,i,j,j,buf(j,6,i),1) end do +#else + call ga_put(g_xx,jlo,jhi,i,i,buf(jlo,1,i),1) + call ga_put(g_xy,jlo,jhi,i,i,buf(jlo,2,i),1) + call ga_put(g_xz,jlo,jhi,i,i,buf(jlo,3,i),1) + call ga_put(g_yy,jlo,jhi,i,i,buf(jlo,4,i),1) + call ga_put(g_yz,jlo,jhi,i,i,buf(jlo,5,i),1) + call ga_put(g_zz,jlo,jhi,i,i,buf(jlo,6,i),1) +#endif end do end From 78c4768a40646145b10c7604c26402af08057462 Mon Sep 17 00:00:00 2001 From: edoapra Date: Wed, 15 Oct 2025 11:32:26 -0700 Subject: [PATCH 2/7] intent changed from in to inout since ga_created modifies params --- src/nwdft/rt_tddft/init/rt_tddft_init_dip_quad_ints.F | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/nwdft/rt_tddft/init/rt_tddft_init_dip_quad_ints.F b/src/nwdft/rt_tddft/init/rt_tddft_init_dip_quad_ints.F index fa44cbae04..609387e833 100644 --- a/src/nwdft/rt_tddft/init/rt_tddft_init_dip_quad_ints.F +++ b/src/nwdft/rt_tddft/init/rt_tddft_init_dip_quad_ints.F @@ -16,7 +16,7 @@ C C == Inputs == - type(rt_params_t), intent(in) :: params + type(rt_params_t), intent(inout) :: params C == Parameters == @@ -122,7 +122,7 @@ C C == Inputs == - type(rt_params_t), intent(in) :: params + type(rt_params_t), intent(inout) :: params C == Parameters == From 2509fd813a10415be664f5a16adf4f5d237e1cae Mon Sep 17 00:00:00 2001 From: edoapra Date: Wed, 15 Oct 2025 13:27:26 -0700 Subject: [PATCH 3/7] fix for gfortran type mismatch warning sequence enabled in derived types --- src/nwdft/rt_tddft/headers/rt_tddft.fh | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/src/nwdft/rt_tddft/headers/rt_tddft.fh b/src/nwdft/rt_tddft/headers/rt_tddft.fh index d1368928c1..ecf0e89565 100644 --- a/src/nwdft/rt_tddft/headers/rt_tddft.fh +++ b/src/nwdft/rt_tddft/headers/rt_tddft.fh @@ -61,9 +61,7 @@ C C Vector for field, dipoles, etc. C type :: rt_vector_t -#ifdef XLFLINUX sequence -#endif double precision :: x, y, z end type rt_vector_t @@ -72,9 +70,7 @@ C C "half" of a 3x3 tensor (for quadrupole quantities) C type :: rt_quad_t -#ifdef XLFLINUX sequence -#endif double precision :: xx, xy, xz, yy, yz, zz end type rt_quad_t @@ -83,9 +79,7 @@ C C Handles for vector GA's C type :: rt_vector_handle_t -#ifdef XLFLINUX sequence -#endif integer :: x, y, z end type rt_vector_handle_t @@ -94,9 +88,7 @@ C C Handles for quadrupole GA's C type :: rt_quad_handle_t -#ifdef XLFLINUX sequence -#endif integer :: xx, xy, xz, yy, yz, zz end type rt_quad_handle_t @@ -105,9 +97,7 @@ C C Geometry fragments. C type :: rt_geom_t -#ifdef XLFLINUX sequence -#endif character*16 :: name integer :: ncent integer :: g_mask !dbl, nbf_ao x nbf_ao, allocd in rt_tddft_init_geoms @@ -124,9 +114,7 @@ C C Time-dependent system energies. C type :: rt_energies_t -#ifdef XLFLINUX sequence -#endif double precision :: core double precision :: coul double precision :: xc(2) @@ -139,9 +127,7 @@ C C Contains parameters for an external field (excitation) C type :: rt_field_t -#ifdef XLFLINUX sequence -#endif character(16) :: name !hardcoded to match geom name max character(256) :: filename character(20) :: type @@ -164,9 +150,7 @@ C C Rule for applying field C type :: rt_excite_t -#ifdef XLFLINUX sequence -#endif integer :: field_indx integer :: geom_indx integer :: ao_indx @@ -190,9 +174,7 @@ C using "super" matrices. C C type :: rt_params_t -#ifdef XLFLINUX sequence -#endif integer :: rtdb character(len=24):: tag From 6977108c276f4a6491764ef2f93c7cc6bd3b68aa Mon Sep 17 00:00:00 2001 From: edoapra Date: Wed, 15 Oct 2025 16:15:25 -0700 Subject: [PATCH 4/7] cleanup --- src/nwdft/rt_tddft/headers/rt_tddft.fh | 3 --- src/nwdft/rt_tddft/init/rt_tddft_init_coulcdfit.F | 5 +---- src/nwdft/rt_tddft/init/rt_tddft_init_rtdb.F | 2 +- 3 files changed, 2 insertions(+), 8 deletions(-) diff --git a/src/nwdft/rt_tddft/headers/rt_tddft.fh b/src/nwdft/rt_tddft/headers/rt_tddft.fh index ecf0e89565..c5f841ae6e 100644 --- a/src/nwdft/rt_tddft/headers/rt_tddft.fh +++ b/src/nwdft/rt_tddft/headers/rt_tddft.fh @@ -263,9 +263,6 @@ C (charge density fitting for Coulomb part of Fock matrix) integer :: n3c_int integer :: l_3cwhat, k_3cwhat !int integer :: n3c_dbl - integer :: iwhat_max - integer :: n_semi_bufs - integer :: fd C (matrix sizes) diff --git a/src/nwdft/rt_tddft/init/rt_tddft_init_coulcdfit.F b/src/nwdft/rt_tddft/init/rt_tddft_init_coulcdfit.F index 96690fc2a5..4b318df34a 100644 --- a/src/nwdft/rt_tddft/init/rt_tddft_init_coulcdfit.F +++ b/src/nwdft/rt_tddft/init/rt_tddft_init_coulcdfit.F @@ -19,7 +19,7 @@ C C == In/out == - type(rt_params_t) params !cdfit params stored in here + type(rt_params_t), intent(inout) :: params !cdfit params stored in here C == Parameters == @@ -163,9 +163,6 @@ C params%k_3cwhat = k_3cwhat params%l_3cwhat = l_3cwhat params%n3c_dbl = n3c_dbl - params%iwhat_max = iwhat_max - params%n_semi_bufs = n_semi_bufs - params%fd = fd end subroutine rt_tddft_init_coulcdfit diff --git a/src/nwdft/rt_tddft/init/rt_tddft_init_rtdb.F b/src/nwdft/rt_tddft/init/rt_tddft_init_rtdb.F index 240c99009c..8c4c191b35 100644 --- a/src/nwdft/rt_tddft/init/rt_tddft_init_rtdb.F +++ b/src/nwdft/rt_tddft/init/rt_tddft_init_rtdb.F @@ -13,7 +13,7 @@ C C == In/out == - type(rt_params_t) params + type(rt_params_t), intent(inout) :: params C == Parameters == character(*), parameter :: pname = "rt_tddft_init_rtdb: " From 4dfb37cc852bf0f3ebacdafd5aa1ce499fcbef2d Mon Sep 17 00:00:00 2001 From: edoapra Date: Wed, 15 Oct 2025 16:16:29 -0700 Subject: [PATCH 5/7] set variables to avoid being unitialized to avoid sporadic rtdb_cget errors because rtdb_cput was using garbage values --- src/nwdft/rt_tddft/input/rt_tddft_input_field.F | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/src/nwdft/rt_tddft/input/rt_tddft_input_field.F b/src/nwdft/rt_tddft/input/rt_tddft_input_field.F index 57d1c4e662..49fac536ae 100644 --- a/src/nwdft/rt_tddft/input/rt_tddft_input_field.F +++ b/src/nwdft/rt_tddft/input/rt_tddft_input_field.F @@ -389,6 +389,19 @@ C C C Load into rtdb C +c set variables to avoid being unitialized (and later trash rtdb) + this_field%filename = "fname" + this_field%polarization = "pol" + this_field%spin = "sp" + this_field%max = 0d0 + this_field%frequency = 0d0 + this_field%width = 0d0 + this_field%center = 0d0 + this_field%start = 0d0 + this_field%phase = 0d0 + this_field%theta = 0d0 + this_field%phi = 0d0 +c this_field%name = field_name this_field%type = type @@ -442,7 +455,6 @@ C else call errquit (pname//"invalid type: "//trim(type), 0, 0) endif - C XXX REFACTOR THIS if (type .ne. "file") then From ba4f82b0df6fe6d07f767eccbc64499d8580d57a Mon Sep 17 00:00:00 2001 From: edoapra Date: Thu, 16 Oct 2025 11:57:39 -0700 Subject: [PATCH 6/7] local ga_put for dipole and quadrupole could be replaced by ga_access --- src/ddscf/int_dip_ga.F | 186 +++++++++++++++++++++-------------------- 1 file changed, 97 insertions(+), 89 deletions(-) diff --git a/src/ddscf/int_dip_ga.F b/src/ddscf/int_dip_ga.F index 554b21e3b1..a63a851ae7 100644 --- a/src/ddscf/int_dip_ga.F +++ b/src/ddscf/int_dip_ga.F @@ -15,127 +15,95 @@ integer g_x, g_y, g_z integer nshell_i, nshell_j integer ishell, jshell, iproc, nproc, mscratch, max1e - integer ijshell, ilo, ihi, jlo, jhi + integer ilo, ihi, jlo, jhi integer l_buf, l_scr integer k_buf, k_scr logical do_mirr logical util_mirrmat external util_mirrmat - integer g_x_mirr,g_y_mirr,g_z_mirr - integer g_x_org,g_y_org,g_z_org + integer g(3) + integer i0,i1,j0,j1 + integer iptr0,iptr1,jptr0,jptr1 ! double precision center(3) ! call dfill(3, 0.0d0, center, 1) ! + g(1)=g_x + g(2)=g_y + g(3)=g_z call ga_sync() call ga_zero(g_x) call ga_zero(g_y) call ga_zero(g_z) - g_x_mirr=0 - g_y_mirr=0 - g_z_mirr=0 - do_mirr=util_mirrmat(1,g_x,g_x_mirr, - D .false., .true.) - do_mirr=do_mirr.and.util_mirrmat(1,g_y,g_y_mirr, - D .false., .true.) - do_mirr=do_mirr.and.util_mirrmat(1,g_z,g_z_mirr, - D .false., .true.) - if(do_mirr) then - g_x_org=g_x - g_x=g_x_mirr - g_y_org=g_y - g_y=g_y_mirr - g_z_org=g_z - g_z=g_z_mirr - - else - if(g_x_mirr.ne.0) then - if(.not.ga_destroy(g_x_mirr))call errquit( - $ 'could not destroy mirrx handle',1, GA_ERR) - endif - if(g_y_mirr.ne.0) then - if(.not.ga_destroy(g_y_mirr))call errquit( - $ 'could not destroy mirry handle',1, GA_ERR) - endif - endif if(oscfps) call pstat_on(ps_int_dip) ! ! grab basis set info type stuff ! - if(.not.bas_numcont(ibas,nshell_i))call errquit - $ ('int_dip_ga: bas_numcont failed for ibas',ibas, BASIS_ERR) - if(.not.bas_numcont(jbas,nshell_j))call errquit - $ ('int_dip_ga: bas_numcont failed for jbas',jbas, BASIS_ERR) + call ga_distribution(g_x,ga_nodeid(),i0,i1,j0,j1) + write(6,'(i5,a,5i5)') + I ga_nodeid(),'DDISTRIB',g_x,i0,i1,j0,j1 + if (i0.gt.0 .and. i0.le.i1) then + if(.not.bas_numcont(ibas,nshell_i))call errquit + $ ('int_dip_ga: bas_numcont failed for ibas',ibas,BASIS_ERR) + if(.not.bas_numcont(jbas,nshell_j))call errquit + $ ('int_dip_ga: bas_numcont failed for jbas',jbas,BASIS_ERR) ! ! allocate temp. arrays ! - call int_mem_dipole(max1e,mscratch,ibas,jbas,1) + call int_mem_dipole(max1e,mscratch,ibas,jbas,1) ! - if(.not.MA_push_get(MT_DBL,max1e,'int_dip_ga:buf',l_buf,k_buf)) - $ call errquit('int_dip_ga: ma failure',max1e, MA_ERR) - if(.not.MA_push_get(MT_DBL,mscratch,'int_dip_ga:scr', - $ l_scr,k_scr)) - $ call errquit('int_dip_ga: ma failure',mscratch, MA_ERR) + if(.not.MA_push_get(MT_DBL,max1e,'int_dip_ga:buf',l_buf,k_buf)) + $ call errquit('int_dip_ga: ma failure',max1e, MA_ERR) + if(.not.MA_push_get(MT_DBL,mscratch,'int_dip_ga:scr', + $ l_scr,k_scr)) + $ call errquit('int_dip_ga: ma failure',mscratch, MA_ERR) ! ! loop over shells ! - iproc = ga_nodeid() - nproc = ga_nnodes() - ijshell = 0 - call ga_sync() - do jshell = 1,nshell_j - do ishell = 1,nshell_i - if(mod(ijshell,nproc).eq.iproc)then + iproc = ga_nodeid() + do jshell = 1,nshell_j + do ishell = 1,nshell_i if(.not.bas_cn2bfr(ibas,ishell,ilo,ihi)) $ call errquit('int_dip_ga:bas_cn2bfr ?', ibas, - & BASIS_ERR) + & BASIS_ERR) if(.not.bas_cn2bfr(jbas,jshell,jlo,jhi)) $ call errquit('int_dip_ga:bas_cn2bfr ?', jbas, - & BASIS_ERR) - -! + & BASIS_ERR) + iptr0=max(i0,ilo) + iptr1=min(i1,ihi) + jptr0=max(j0,jlo) + jptr1=min(j1,jhi) + if(iptr1.ge.iptr0.and.jptr1.ge.jptr0) then ! get the integrals we want ! -! call int_mpole(ibas, ishell, jbas, jshell, - call int_mpole(jbas, jshell, ibas, ishell, - $ 1, - $ center, - $ mscratch, dbl_mb(k_scr), max1e, dbl_mb(k_buf)) -! + call int_mpole(jbas, jshell, ibas, ishell, + $ 1, + $ center, + $ mscratch, dbl_mb(k_scr), max1e, + D dbl_mb(k_buf)) +! ! bung integrals into global array ! - call int_dip_put_in_g(g_x, g_y, g_z, ilo,ihi,jlo,jhi, - $ dbl_mb(k_buf+(ihi-ilo+1)*(jhi-jlo+1))) - endif - ijshell=ijshell+1 + call int_mpole_put_in_g(g, 3, + L ilo,ihi,jlo,jhi, + P iptr0,iptr1,jptr0,jptr1, + $ dbl_mb(k_buf+(ihi-ilo+1)*(jhi-jlo+1))) + endif + enddo enddo - enddo ! - if(.not.MA_pop_stack(l_scr)) + if(.not.MA_pop_stack(l_scr)) + $ call errquit('int_dip_ga:pop failed',0, MA_ERR) + if(.not.MA_pop_stack(l_buf)) $ call errquit('int_dip_ga:pop failed',0, MA_ERR) - if(.not.MA_pop_stack(l_buf)) - $ call errquit('int_dip_ga:pop failed',0, MA_ERR) -! + + endif call ga_sync() - if (do_mirr) then - g_x=g_x_org - call util_mirrmerge(g_x_mirr,g_x) - if(.not.ga_destroy(g_x_mirr))call errquit( - $ 'could not destroy g_x_mirr handle',1, GA_ERR) - g_y=g_y_org - call util_mirrmerge(g_y_mirr,g_y) - if(.not.ga_destroy(g_y_mirr))call errquit( - $ 'could not destroy g_y_mirr handle',1, GA_ERR) - g_z=g_z_org - call util_mirrmerge(g_z_mirr,g_z) - if(.not.ga_destroy(g_z_mirr))call errquit( - $ 'could not destroy g_x_mirr handle',1, GA_ERR) - endif - call ga_sync() -! + +c if (.true.) then if (util_print('multipole', print_debug)) then call ga_print(g_x) call ga_print(g_y) @@ -162,6 +130,25 @@ c do i = ilo,ihi end do c end do end + subroutine int_mpole_put_in_g(g, + M mult_size, + L ilo,ihi,jlo,jhi, + 1 iptr0, iptr1, jptr0, jptr1, + B buf) + implicit none +#include "global.fh" + integer mult_size,mult + integer g(mult_size) + integer ilo,ihi,jlo,jhi + integer iptr0, iptr1, jptr0, jptr1 + double precision buf(ilo:ihi,mult_size,jlo:jhi) + integer i, j + do j = jptr0, jptr1 + do mult=1,mult_size + call ga_put(g(mult),iptr0,iptr1,j,j,buf(iptr0,mult,j),1) + end do + end do + end subroutine int_qdr_ga(ibas, jbas, g_xx, g_xy, g_xz, 1 g_yy, g_yz, g_zz) @@ -184,6 +171,10 @@ c end do integer ijshell, ilo, ihi, jlo, jhi integer l_buf, l_scr integer k_buf, k_scr + integer g(6) + integer i0,i1,j0,j1 + integer iptr0,iptr1,jptr0,jptr1 + ! double precision center(3) ! @@ -191,17 +182,27 @@ c end do ! call ga_sync() + g(1)=g_xx + g(2)=g_xy + g(3)=g_xz + g(4)=g_yy + g(5)=g_yz + g(6)=g_zz call ga_zero(g_xx) call ga_zero(g_xy) call ga_zero(g_xz) call ga_zero(g_yy) call ga_zero(g_yz) call ga_zero(g_zz) - + call ga_distribution(g_xx,ga_nodeid(),i0,i1,j0,j1) +c if(ga_nodeid().eq.0) write(6,'(a,4i5)') + write(6,'(i5,a,5i5)') + I ga_nodeid(),'QDISTRIB',g_xx,i0,i1,j0,j1 if(oscfps) call pstat_on(ps_int_dip) ! ! grab basis set info type stuff ! + if (i0.gt.0 .and. i0.le.i1) then if(.not.bas_numcont(ibas,nshell_i))call errquit $ ('int_qdr_ga: bas_numcont failed for ibas',ibas, BASIS_ERR) if(.not.bas_numcont(jbas,nshell_j))call errquit @@ -220,29 +221,34 @@ c end do ! loop over shells ! iproc = ga_nodeid() - nproc = ga_nnodes() ijshell = 0 do jshell = 1,nshell_j do ishell = 1,nshell_i - if(mod(ijshell,nproc).eq.iproc)then +! if(mod(ijshell,nproc).eq.iproc)then if(.not.bas_cn2bfr(ibas,ishell,ilo,ihi)) $ call errquit('int_qdr_ga:bas_cn2bfr ?', ibas, & BASIS_ERR) if(.not.bas_cn2bfr(jbas,jshell,jlo,jhi)) $ call errquit('int_qdr_ga:bas_cn2bfr ?', jbas, & BASIS_ERR) + iptr0=max(i0,ilo) + iptr1=min(i1,ihi) + jptr0=max(j0,jlo) + jptr1=min(j1,jhi) + if(iptr1.ge.iptr0.and.jptr1.ge.jptr0) then ! ! get the integrals we want ! - call int_mpole(ibas, ishell, jbas, jshell, + call int_mpole(jbas, ishell, ibas, jshell, $ 2, $ center, $ mscratch, dbl_mb(k_scr), max1e, dbl_mb(k_buf)) ! ! bung integrals into global array ! - call int_qdr_put_in_g(g_xx, g_xy, g_xz, - $ g_yy, g_yz, g_zz, ilo,ihi,jlo,jhi, + call int_mpole_put_in_g(g,6, + $ ilo,ihi,jlo,jhi, + P iptr0,iptr1,jptr0,jptr1, $ dbl_mb(k_buf+(ihi-ilo+1)*(jhi-jlo+1)*4)) endif ijshell=ijshell+1 @@ -252,11 +258,13 @@ c end do if(.not.MA_pop_stack(l_scr)) $ call errquit('int_qdr_ga:pop failed',0, MA_ERR) if(.not.MA_pop_stack(l_buf)) - $ call errquit('int_qdr_ga:pop failed',0, MA_ERR) + $ call errquit('int_qdr_ga:pop failed',0, MA_ERR) + endif ! call ga_sync() ! if (util_print('multipole', print_debug)) then +c if (.true.) then call ga_print(g_xx) call ga_print(g_xy) call ga_print(g_xz) From ad43c0dd742154f3b05a8f34560b2d086bfcfe6c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edoardo=20Apr=C3=A0?= Date: Fri, 17 Oct 2025 05:17:18 -0700 Subject: [PATCH 7/7] remove debug output for ga_distribution call Comment out debug write statements for distribution. --- src/ddscf/int_dip_ga.F | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/ddscf/int_dip_ga.F b/src/ddscf/int_dip_ga.F index a63a851ae7..b5e174df2a 100644 --- a/src/ddscf/int_dip_ga.F +++ b/src/ddscf/int_dip_ga.F @@ -42,8 +42,8 @@ ! grab basis set info type stuff ! call ga_distribution(g_x,ga_nodeid(),i0,i1,j0,j1) - write(6,'(i5,a,5i5)') - I ga_nodeid(),'DDISTRIB',g_x,i0,i1,j0,j1 +cdbg write(6,'(i5,a,5i5)') +cdbg I ga_nodeid(),'DDISTRIB',g_x,i0,i1,j0,j1 if (i0.gt.0 .and. i0.le.i1) then if(.not.bas_numcont(ibas,nshell_i))call errquit $ ('int_dip_ga: bas_numcont failed for ibas',ibas,BASIS_ERR) @@ -196,8 +196,8 @@ c end do call ga_zero(g_zz) call ga_distribution(g_xx,ga_nodeid(),i0,i1,j0,j1) c if(ga_nodeid().eq.0) write(6,'(a,4i5)') - write(6,'(i5,a,5i5)') - I ga_nodeid(),'QDISTRIB',g_xx,i0,i1,j0,j1 +cdbg write(6,'(i5,a,5i5)') +cdbg I ga_nodeid(),'QDISTRIB',g_xx,i0,i1,j0,j1 if(oscfps) call pstat_on(ps_int_dip) ! ! grab basis set info type stuff