From f502dccafede0c4e9da2f27c7df53ae73a42d41c Mon Sep 17 00:00:00 2001 From: edoapra Date: Fri, 2 Dec 2022 14:16:08 -0800 Subject: [PATCH 1/5] mp2_copyback by default for better scaling --- src/mp2_grad/mp2_back_transform.F | 20 +++----------------- 1 file changed, 3 insertions(+), 17 deletions(-) diff --git a/src/mp2_grad/mp2_back_transform.F b/src/mp2_grad/mp2_back_transform.F index 77d6cd2157..1d69db43a5 100644 --- a/src/mp2_grad/mp2_back_transform.F +++ b/src/mp2_grad/mp2_back_transform.F @@ -55,7 +55,8 @@ c integer l_c_t, k_c_t integer l_act, k_act, l_actsh, k_actsh integer twopdmunit - integer junk, ninseg, ierr, i, j, ish, ishlo, ishhi, shmax, tdim + integer junk(2), ninseg, ierr, i, j, ish, ishlo, ishhi, shmax, + t tdim integer nsh, natoms, nactive, nblock c integer k_scr, l_scr, k_lab, l_lab, k_eri, l_eri, leneri, lenscr @@ -475,7 +476,7 @@ c end do ! End of a call ga_sync() if (.not. rtdb_get(rtdb, 'mp2:copyback', mt_log, 1, mp2cpybck)) - $ mp2cpybck=.false. + $ mp2cpybck=.true. if(mp2cpybck) then call mp2_copyback(g_buf,g_buf_trans) @@ -1158,27 +1159,12 @@ c check for boundaries of buff() write(6,*) ga_nodeid(),' i_1.gt.ihi ',i_1,ihi call errquit(' mp2copybck: i boundary passed ',0,0) endif -#if 0 - call ga_get(g_a_trans,i_0,i_1, - A jlo,jhi,buff(i_0,jlo),i_ld) -#else call ga_get(g_a_trans,i_0,i_1, A jlo,jhi,buff,i_ld) call ga_put(g_a, i_0, i_1, jlo, jhi, buff, i_ld) -#endif enddo endif c everybody needs to have the buffer filled call ga_sync() -cold if(dowork) call ga_put(g_a, ilo, ihi, jlo, jhi, buff, ihi-ilo+1) - call ga_sync() -#if 0 - call ga_sync() - tr=ga_ddot(g_a,g_a) - tr_tr=ga_ddot(g_a_trans,g_a_trans) - if(abs(tr-tr_tr).gt.1d-6)then - if(ga_nodeid().eq.0)write(6,*) 'tr ',tr,' tr_tr ',tr_tr - endif -#endif return end From 37deeca9a0993d96511331baabfb479030827fc2 Mon Sep 17 00:00:00 2001 From: edoapra Date: Fri, 2 Dec 2022 14:16:51 -0800 Subject: [PATCH 2/5] more time profiling --- src/mp2_grad/mp2_energy.F | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/src/mp2_grad/mp2_energy.F b/src/mp2_grad/mp2_energy.F index 309b0cfdf7..1156530570 100644 --- a/src/mp2_grad/mp2_energy.F +++ b/src/mp2_grad/mp2_energy.F @@ -717,6 +717,10 @@ c endif endif call pstat_on(ps_laifock) + if (doprint) then + write(6,111) ' Start laifock', util_wallsec() + call util_flush(6) + end if call mp2_lai_fock_uhf_prepar( $ g_p_ab_a,g_p_ab_b,g_p_ij_a,g_p_ij_b, $ noa,nob,nva,nvb,g_tmpa, g_tmpb,nmo) @@ -725,6 +729,10 @@ c $ noa,nob,nva,nvb,g_lai_a,g_lai_b,rtdb,tol2e_fock) call mp2_lai_fock_uhf_tidy(g_tmpa, g_tmpb) call pstat_off(ps_laifock) + if (doprint) then + write(6,111) ' Done laifock', util_wallsec() + call util_flush(6) + end if c if (omatrix) then call ga_print(g_lai_a) @@ -782,11 +790,20 @@ c if(.not.ga_create(mt_dbl,nmo,nmo,'tot beta dens',nmo,0, $ g_p_tot_b))call errquit( $ 'mp2_energy: ga_create failed',0, GA_ERR) -c +c + if (doprint) then + write(6,111) ' Start make_tot_dens', util_wallsec() + call util_flush(6) + end if + call mp2_make_tot_dens(g_p_ij_a,g_p_ij_b,g_p_ab_a,g_p_ab_b, $ g_rhs,g_p_tot_a,g_p_tot_b,noa,nva,nob,nvb,nbf,nmo, $ int_mb(k_map_a), int_mb(k_map_b), $ g_vecs_a,g_vecs_b,basis,scftype) + if (doprint) then + write(6,111) ' Done make_tot_dens', util_wallsec() + call util_flush(6) + end if c if (otrace) then call mp2_print_trace_norm(g_p_tot_a,'g_p_tot_a',nmo) @@ -931,6 +948,7 @@ c endif c call ga_sync + 111 format(a,' at ', f10.1,'s') c end subroutine mp2_print_trace_norm(g, text, n) From 518b2b72b14fd73e46cb03964715b4d7125f3a46 Mon Sep 17 00:00:00 2001 From: edoapra Date: Fri, 2 Dec 2022 14:17:51 -0800 Subject: [PATCH 3/5] removed copy patch --- src/mp2_grad/mp2_make_tot_dens.F | 73 ++++++++++++++++++++++++++------ 1 file changed, 59 insertions(+), 14 deletions(-) diff --git a/src/mp2_grad/mp2_make_tot_dens.F b/src/mp2_grad/mp2_make_tot_dens.F index dcdff3e219..45fa16a229 100644 --- a/src/mp2_grad/mp2_make_tot_dens.F +++ b/src/mp2_grad/mp2_make_tot_dens.F @@ -26,6 +26,8 @@ character*256 p_a_ao character*256 p_b_ao integer base + integer l_buf,k_buf + integer ilo,ihi,jlo,jhi,dowork c call util_file_name('p_a_ao',.true.,.true.,p_a_ao) call util_file_name('p_b_ao',.true.,.true.,p_b_ao) @@ -48,22 +50,48 @@ c$$$ call ga_put(g_p_tot_a,i,i,a+noa,a+noa,temp,1) c$$$ end do c$$$ end do c + call ga_distribution(g_p_tot_a, ga_nodeid(), + T ilo, ihi, jlo, jhi) +c check if distrib by columns + if ((ilo.eq.0).and.(ihi.eq.-1)) then + dowork=0 + else + if(ilo.ne.1.and.ihi.ne.nmo) call + R errquit(' mp2maketotdens bug ',0,0) + dowork=1 + endif ioff = 0 - do i = 1+ga_nodeid(),noa,ga_nnodes() ! Loop thru SCF order + if(dowork.eq.1) then + do i = 1,noa + ii = map_a(i) + if(ii.ge.jlo.and.ii.le.jhi) then do a = 1,nva - ii = map_a(i) aa = map_a(a+noa)-noa ia = ioff+a+(i-1)*nva call ga_get(g_rhs,ia,ia,1,1,xx,1) call ga_put(g_p_tot_a,aa+noa,aa+noa,ii,ii,xx,1) call ga_put(g_p_tot_a,ii,ii,aa+noa,aa+noa,xx,1) end do + endif end do -c - call ga_copy_patch('n',g_p_ij_a,1,noa,1,noa,g_p_tot_a, - $ 1,noa,1,noa) - call ga_copy_patch('n',g_p_ab_a,1,nva,1,nva,g_p_tot_a, - $ noa+1,nmo,noa+1,nmo) + if (.not. ma_push_get(mt_dbl, nmo, 'mp2: maket', + $ l_buf, k_buf)) call errquit + $ ('mp2: insufficient memory : bug ', nmo, MA_ERR) + + do i=jlo,jhi + if(i.le.nob) then + call ga_get(g_p_ij_a,1,noa,i,i,dbl_mb(k_buf),noa) + call ga_put(g_p_tot_a,1,noa,i,i,dbl_mb(k_buf),noa) + else + call ga_get(g_p_ab_a,1,nva,i-noa,i-noa,dbl_mb(k_buf),nva) + call ga_put(g_p_tot_a,noa+1,nmo,i,i,dbl_mb(k_buf),nva) + endif + enddo + if (.not. ma_pop_stack(l_buf)) call errquit + $ ('mp2: pop_stack failed ', nmo, MA_ERR) + endif + call ga_mask_sync(.true.,.false.) + call ga_sync() c if (scftype .eq. 'UHF') then base = (nva*noa) @@ -71,15 +99,18 @@ c base = 0 ! Alpha is the same as beta end if ioff = base - do i = 1+ga_nodeid(),nob,ga_nnodes() ! Loop thru SCF order + if (dowork.eq.1) then + do i = 1,nob + ii = map_b(i) + if(ii.ge.jlo.and.ii.le.jhi) then do a = 1,nvb - ii = map_b(i) aa = map_b(a+nob)-nob ia = ioff+a+(i-1)*nvb call ga_get(g_rhs,ia,ia,1,1,xx,1) call ga_put(g_p_tot_b,aa+nob,aa+nob,ii,ii,xx,1) call ga_put(g_p_tot_b,ii,ii,aa+nob,aa+nob,xx,1) end do + endif end do c$$$ call ga_copy_patch('n',g_rhs,base+1,base+(nvb*nob), c$$$ $ 1,1,g_p_tot_b,nob+1,nmo,1,nob) @@ -90,11 +121,25 @@ c$$$ call ga_get(g_rhs,indx,indx,1,1,temp,1) c$$$ call ga_put(g_p_tot_b,i,i,a+nob,a+nob,temp,1) c$$$ end do c$$$ end do -c - call ga_copy_patch('n',g_p_ij_b,1,nob,1,nob,g_p_tot_b, - $ 1,nob,1,nob) - call ga_copy_patch('n',g_p_ab_b,1,nvb,1,nvb,g_p_tot_b, - $ nob+1,nmo,nob+1,nmo) +c + if (.not. ma_push_get(mt_dbl, nmo, 'mp2: maket', + $ l_buf, k_buf)) call errquit + $ ('mp2: insufficient memory : bug ', nmo, MA_ERR) + + do i=jlo,jhi + if(i.le.nob) then + call ga_get(g_p_ij_b,1,nob,i,i,dbl_mb(k_buf),nob) + call ga_put(g_p_tot_b,1,nob,i,i,dbl_mb(k_buf),nob) + else + call ga_get(g_p_ab_b,1,nvb,i-nob,i-nob,dbl_mb(k_buf),nvb) + call ga_put(g_p_tot_b,nob+1,nmo,i,i,dbl_mb(k_buf),nvb) + endif + enddo + if (.not. ma_pop_stack(l_buf)) call errquit + $ ('mp2: pop_stack failed ', nmo, MA_ERR) + + endif + call ga_sync() c *ga:1:0 if(.not.ga_create(mt_dbl,nmo,nbf,'scratch',0,0,g_scratch)) From bb38e7039426b95c334441809c4b5a1094d2b5b8 Mon Sep 17 00:00:00 2001 From: edoapra Date: Fri, 2 Dec 2022 14:18:32 -0800 Subject: [PATCH 4/5] replaced ga_transpose --- src/mp2_grad/mp2_make_tot_wdens.F | 45 +++++++++++++++++++++++++++++-- 1 file changed, 43 insertions(+), 2 deletions(-) diff --git a/src/mp2_grad/mp2_make_tot_wdens.F b/src/mp2_grad/mp2_make_tot_wdens.F index a59215b2e2..a7a4da599f 100644 --- a/src/mp2_grad/mp2_make_tot_wdens.F +++ b/src/mp2_grad/mp2_make_tot_wdens.F @@ -46,7 +46,7 @@ c call ga_copy_patch('n',g_w_ai_a,1,noa_hi,1,nva,g_w_tot_a, $ 1, noa_hi, noa_hi+1, nmo) c - call ga_transpose(g_w_ai_a,g_w_ai_a_tr) + call mp2_transpwai(g_w_ai_a,g_w_ai_a_tr) call ga_copy_patch('n',g_w_ai_a_tr,1,nva,1,noa_hi,g_w_tot_a, $ noa_hi+1,nmo,1,noa_hi) call ga_copy_patch('n',g_w_ij_a,1,noa_hi,1,noa_hi,g_w_tot_a, @@ -55,7 +55,7 @@ c $ noa_hi+1,nmo,noa_hi+1,nmo) call ga_copy_patch('n',g_w_ai_b,1,nob_hi,1,nvb,g_w_tot_b, $ 1, nob_hi, nob_hi+1,nmo) - call ga_transpose(g_w_ai_b,g_w_ai_b_tr) + call mp2_transpwai(g_w_ai_b,g_w_ai_b_tr) call ga_copy_patch('n',g_w_ai_b_tr,1,nvb,1,nob_hi,g_w_tot_b, $ nob_hi+1,nmo,1,nob_hi) call ga_copy_patch('n',g_w_ij_b,1,nob_hi,1,nob_hi,g_w_tot_b, @@ -148,3 +148,44 @@ c c end + subroutine mp2_transpwai(g,g_tr) + implicit none +#include "mafdecls.fh" +#include "global.fh" +#include "errquit.fh" + integer g,g_tr +c + integer ilo,ihi,jlo,jhi + integer i,j + integer k_buf,l_buf + integer n_row,n_col,gtype + integer dowork +c + call ga_inquire(g_tr, gtype, n_row, n_col) + call ga_distribution(g_tr, ga_nodeid(), + T ilo, ihi, jlo, jhi) + if ((ilo.eq.0).and.(ihi.eq.-1)) then + dowork=0 + else +c check if distrib by columns + if(ilo.ne.1.and.ihi.ne.n_row) call + R errquit(' mp2transpwai bug ',0,0) + dowork=1 + endif + if(dowork.eq.1) then + if (.not. ma_push_get(mt_dbl, n_row, 'mp2: wdens', + $ l_buf, k_buf)) call errquit + $ ('mp2: insufficient memory : bug ', n_row, MA_ERR) + do j=jlo,jhi + call ga_get(g,j,j,1,n_row,dbl_mb(k_buf),1) + if (.not.ma_verify_allocator_stuff()) stop ' ma ck 2b' + call ga_put(g_tr,1,n_row,j,j,dbl_mb(k_buf),n_row) + if (.not.ma_verify_allocator_stuff()) stop ' ma ck 2b' + enddo + if (.not. ma_pop_stack(l_buf)) call errquit + $ ('mp2transp pop_stack failed ', n_row, MA_ERR) + + endif + call ga_sync() + return + end From 4c68ffa0151c7341901b3f910ae395629b759315 Mon Sep 17 00:00:00 2001 From: edoapra Date: Fri, 2 Dec 2022 14:56:08 -0800 Subject: [PATCH 5/5] fix for xlf error 1515-010 --- src/NWints/sifs/build_sifs.sh | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/NWints/sifs/build_sifs.sh b/src/NWints/sifs/build_sifs.sh index e1c0123a52..b08cd970b5 100755 --- a/src/NWints/sifs/build_sifs.sh +++ b/src/NWints/sifs/build_sifs.sh @@ -24,3 +24,19 @@ cat > ibummr.patch < siftdy.patch <