From 222f9a0aad2d77432772424cdd2b675c50a778cf Mon Sep 17 00:00:00 2001 From: edoapra Date: Tue, 31 Jan 2023 17:46:42 -0800 Subject: [PATCH 1/8] disable mirroring with mp2:tuhfreplicated=f --- src/mp2_grad/mp2_grad_doit.F | 2 +- src/mp2_grad/mp2_make_tuhf.F | 54 ++++++++++++++++++++++-------------- 2 files changed, 34 insertions(+), 22 deletions(-) diff --git a/src/mp2_grad/mp2_grad_doit.F b/src/mp2_grad/mp2_grad_doit.F index 429592b83d..7e8d8242ca 100644 --- a/src/mp2_grad/mp2_grad_doit.F +++ b/src/mp2_grad/mp2_grad_doit.F @@ -333,7 +333,7 @@ c end if call pstat_on(ps_maket) - call mp2_make_tuhf(nbf,noa_lo,noa_hi,nva_lo,nva_hi, + call mp2_make_tuhf(rtdb,nbf,noa_lo,noa_hi,nva_lo,nva_hi, $ sym_lo_oa,sym_hi_oa,sym_lo_va,sym_hi_va,num_oa,num_va, $ nob_lo,nob_hi,nvb_lo,nvb_hi,sym_lo_ob,sym_hi_ob, $ sym_lo_vb,sym_hi_vb,num_ob,num_vb,oseg_lo,oseg_hi, diff --git a/src/mp2_grad/mp2_make_tuhf.F b/src/mp2_grad/mp2_make_tuhf.F index eac9057921..f27a4d8274 100644 --- a/src/mp2_grad/mp2_make_tuhf.F +++ b/src/mp2_grad/mp2_make_tuhf.F @@ -1,4 +1,4 @@ - subroutine mp2_make_tuhf(nbf,noa_lo,noa_hi,nva_lo,nva_hi, + subroutine mp2_make_tuhf(rtdb,nbf,noa_lo,noa_hi,nva_lo,nva_hi, $ sym_lo_oa,sym_hi_oa,sym_lo_va,sym_hi_va,num_oa,num_va, $ nob_lo,nob_hi,nvb_lo,nvb_hi, sym_lo_ob,sym_hi_ob, $ sym_lo_vb,sym_hi_vb,num_ob,num_vb, @@ -16,6 +16,7 @@ #include "rtdb.fh" #include "eaf.fh" #include "util.fh" + integer rtdb character*8 task integer nbf,i integer noa_lo,noa_hi,nva_lo,nva_hi @@ -51,7 +52,7 @@ c logical otdebug logical do_mirra,do_mirrb,do_mirr integer g_ta_mirr,g_tb_mirr,g_ta_org,g_tb_org - logical util_mirrmat + logical util_mirrmat,tuhfreplicated external util_mirrmat c integer l_ia_uv, k_ia_uv, l_tmp, k_tmp, l_ia_jb, k_ia_jb @@ -86,24 +87,35 @@ c *ga:1:0 if(.not.ga_create(mt_dbl,nob*nvb,nva,'T_b',(nob*nvb),0,g_t_b)) $ call errquit('could not alloc ga for T_b',1, GA_ERR) - do_mirra=util_mirrmat(1,g_t_a,g_ta_mirr, - D .false., .true.) - do_mirrb=util_mirrmat(1,g_t_b,g_tb_mirr, + if (.not.rtdb_get(rtdb, 'mp2:tuhfreplicated', mt_log, 1, + T tuhfreplicated)) tuhfreplicated=.true. + if(tuhfreplicated) then + do_mirra=util_mirrmat(1,g_t_a,g_ta_mirr, D .false., .true.) - if(do_mirra.and.do_mirrb) then - if(ga_nodeid().eq.0) - w write(6,*) 'mp2_make_tuhf mirroring' - do_mirr=.true. - g_ta_org=g_t_a - g_tb_org=g_t_b - g_t_a=g_ta_mirr - g_t_b=g_tb_mirr - else - if(do_mirra) then - if(.not.ga_destroy(g_ta_mirr))call errquit( - $ 'could not destroy mirrt_a handle',1, GA_ERR) - endif - endif + do_mirrb=util_mirrmat(1,g_t_b,g_tb_mirr, + D .false., .true.) + else + do_mirra=.false. + do_mirrb=.false. + endif + if(do_mirra.and.do_mirrb) then + if(ga_nodeid().eq.0) + w write(6,*) 'mp2_make_tuhf mirroring' + do_mirr=.true. + g_ta_org=g_t_a + g_tb_org=g_t_b + g_t_a=g_ta_mirr + g_t_b=g_tb_mirr + else + if(do_mirra) then + if(.not.ga_destroy(g_ta_mirr))call errquit( + $ 'could not destroy mirrt_a handle',1, GA_ERR) + write(6,10) ga_nodeid(),'destroyed g_ta_mirr',g_ta_mirr + 10 format(i5,a,i5) + endif + g_ta_org=0 + g_tb_org=0 + endif tunitptra=1 tunitptrb=1 do i=oseg_lo,oseg_hi @@ -295,9 +307,9 @@ c c if(do_mirr) then if(.not.ga_destroy(g_t_b))call errquit( - $ 'could not destroy t_b handle',1, GA_ERR) + $ 'could not destroy mirr t_b handle',1, GA_ERR) if(.not.ga_destroy(g_t_a))call errquit( - $ 'could not destroy t_a handle',1, GA_ERR) + $ 'could not destroy mirr t_a handle',1, GA_ERR) g_t_a=g_ta_org g_t_b=g_tb_org endif From b556e5f29524728cfb661c55fdee6ec412695f5d Mon Sep 17 00:00:00 2001 From: edoapra Date: Wed, 1 Feb 2023 12:55:52 -0800 Subject: [PATCH 2/8] check memory for mirroring --- src/mp2_grad/mp2_make_tuhf.F | 25 +++++++++++++++++------- src/util/util_mirror.F | 38 ++++++++++++++++++++++++++++++++++++ 2 files changed, 56 insertions(+), 7 deletions(-) diff --git a/src/mp2_grad/mp2_make_tuhf.F b/src/mp2_grad/mp2_make_tuhf.F index f27a4d8274..0d1729c4fa 100644 --- a/src/mp2_grad/mp2_make_tuhf.F +++ b/src/mp2_grad/mp2_make_tuhf.F @@ -54,6 +54,8 @@ c integer g_ta_mirr,g_tb_mirr,g_ta_org,g_tb_org logical util_mirrmat,tuhfreplicated external util_mirrmat + integer util_mirrmem,mem_mirr + external util_mirrmem c integer l_ia_uv, k_ia_uv, l_tmp, k_tmp, l_ia_jb, k_ia_jb double precision ddot @@ -89,14 +91,23 @@ c $ call errquit('could not alloc ga for T_b',1, GA_ERR) if (.not.rtdb_get(rtdb, 'mp2:tuhfreplicated', mt_log, 1, T tuhfreplicated)) tuhfreplicated=.true. + do_mirra=.false. + do_mirrb=.false. if(tuhfreplicated) then - do_mirra=util_mirrmat(1,g_t_a,g_ta_mirr, - D .false., .true.) - do_mirrb=util_mirrmat(1,g_t_b,g_tb_mirr, - D .false., .true.) - else - do_mirra=.false. - do_mirrb=.false. + mem_mirr= + M util_mirrmem(1,g_t_a)+ + M util_mirrmem(1,g_t_b) + if(ga_nodeid().eq.0) then + write(6,14) ' needed by mirroring: ', mem_mirr + write(6,14) ' ga_memory_avail() : ', ga_memory_avail() + endif + 14 format(a,i10,' bytes') + if(ga_memory_avail().gt. mem_mirr) then + do_mirra=util_mirrmat(1,g_t_a,g_ta_mirr, + D .false., .true.) + do_mirrb=util_mirrmat(1,g_t_b,g_tb_mirr, + D .false., .true.) + endif endif if(do_mirra.and.do_mirrb) then if(ga_nodeid().eq.0) diff --git a/src/util/util_mirror.F b/src/util/util_mirror.F index ab08217e61..5577c5eefc 100644 --- a/src/util/util_mirror.F +++ b/src/util/util_mirror.F @@ -136,3 +136,41 @@ c call util_mirrstop(g_densdis) return end + integer function util_mirrmem(nmat,g_a) + implicit none +#include "global.fh" +#include "mafdecls.fh" + integer g_a(*) + integer nmat +c + integer ppn + integer nbytes,i,imat + integer maxdim + parameter(maxdim=10) + integer type, dims(maxdim),ndim + util_mirrmem=0 + call util_getppn(ppn) + do imat=1,nmat + call nga_inquire(g_a(imat), type, ndim, dims) + if(ndim.gt.maxdim) call errquit( + Q ' mirrmem: increase maxdim to ',ndim,0) +#if 1 + if(ga_nodeid().eq.0) then + write(0,123) ga_nodeid(), ' ndim ',ndim,' dims ', + D (dims(i),i=1,ndim) + endif + 123 format(I2,A,I2,A,3I4) +#endif + nbytes=1 + do i=1,ndim + nbytes=nbytes*dims(i) + enddo + nbytes=ma_sizeof(mt_dbl,1,mt_byte)*nbytes + util_mirrmem=util_mirrmem+nbytes + enddo + if(ga_nnodes().ne.1) then +c divide by ppn & round it by 30% + util_mirrmem=(util_mirrmem*130)/(ppn*100) + endif + return + end From b164a38584fb06de59bc58d202f4f2617b586bdb Mon Sep 17 00:00:00 2001 From: edoapra Date: Thu, 2 Feb 2023 16:57:54 -0800 Subject: [PATCH 3/8] fix undefined --- src/mp2_grad/mp2_make_tuhf.F | 1 + 1 file changed, 1 insertion(+) diff --git a/src/mp2_grad/mp2_make_tuhf.F b/src/mp2_grad/mp2_make_tuhf.F index 0d1729c4fa..b16c559d7f 100644 --- a/src/mp2_grad/mp2_make_tuhf.F +++ b/src/mp2_grad/mp2_make_tuhf.F @@ -91,6 +91,7 @@ c $ call errquit('could not alloc ga for T_b',1, GA_ERR) if (.not.rtdb_get(rtdb, 'mp2:tuhfreplicated', mt_log, 1, T tuhfreplicated)) tuhfreplicated=.true. + do_mirr=.false. do_mirra=.false. do_mirrb=.false. if(tuhfreplicated) then From 98062a351a6839bab4aad5fb782a0f59faf41921 Mon Sep 17 00:00:00 2001 From: edoapra Date: Thu, 2 Feb 2023 18:35:46 -0800 Subject: [PATCH 4/8] debug ga_destroy failure --- src/mp2_grad/mp2_make_tuhf.F | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/mp2_grad/mp2_make_tuhf.F b/src/mp2_grad/mp2_make_tuhf.F index b16c559d7f..f1247158f3 100644 --- a/src/mp2_grad/mp2_make_tuhf.F +++ b/src/mp2_grad/mp2_make_tuhf.F @@ -326,8 +326,12 @@ c g_t_b=g_tb_org endif - if(.not.ga_destroy(g_t_b))call errquit( - $ 'could not destroy t_b handle',1, GA_ERR) + if(.not.ga_destroy(g_t_b))then + if(ga_nodeid().eq.0) call ga_summarize(1) + call ga_sync() + call errquit( + $ 'could not destroy t_b handle',1, GA_ERR) + endif if(.not.ga_destroy(g_t_a))call errquit( $ 'could not destroy t_a handle',1, GA_ERR) c From 3d77028c25bfda9662a37d6ef860525f0bd8cfdd Mon Sep 17 00:00:00 2001 From: edoapra Date: Thu, 2 Feb 2023 19:16:36 -0800 Subject: [PATCH 5/8] mirroring no longer default --- src/mp2_grad/mp2_make_tuhf.F | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/mp2_grad/mp2_make_tuhf.F b/src/mp2_grad/mp2_make_tuhf.F index f1247158f3..6c6413e4b7 100644 --- a/src/mp2_grad/mp2_make_tuhf.F +++ b/src/mp2_grad/mp2_make_tuhf.F @@ -90,7 +90,7 @@ c if(.not.ga_create(mt_dbl,nob*nvb,nva,'T_b',(nob*nvb),0,g_t_b)) $ call errquit('could not alloc ga for T_b',1, GA_ERR) if (.not.rtdb_get(rtdb, 'mp2:tuhfreplicated', mt_log, 1, - T tuhfreplicated)) tuhfreplicated=.true. + T tuhfreplicated)) tuhfreplicated=.false. do_mirr=.false. do_mirra=.false. do_mirrb=.false. @@ -108,6 +108,9 @@ c D .false., .true.) do_mirrb=util_mirrmat(1,g_t_b,g_tb_mirr, D .false., .true.) + else + if(ga_nodeid().eq.0) + W write(6,*) ' insuff. memory for mirroring ' endif endif if(do_mirra.and.do_mirrb) then From 060830826736e63efacc0bbbb595aabdd5664e74 Mon Sep 17 00:00:00 2001 From: edoapra Date: Thu, 2 Feb 2023 18:08:57 -0800 Subject: [PATCH 6/8] fix undefiened --- src/nwdft/lr_tddft/tddft_prod_v.F | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/nwdft/lr_tddft/tddft_prod_v.F b/src/nwdft/lr_tddft/tddft_prod_v.F index 124c3c3c17..bb6588f6bd 100644 --- a/src/nwdft/lr_tddft/tddft_prod_v.F +++ b/src/nwdft/lr_tddft/tddft_prod_v.F @@ -58,7 +58,6 @@ c character*4 targetsym ! Symmetry of target excited state double precision cwall ! Wall timings double precision ccpu ! CPU timings - double precision dcpu ! CPU timings integer algorithm ! =1 multiple fock build; =2: conventional integer mult ! Ground state spin multiplicity integer l_irs(2),k_irs(2)! Irreps @@ -116,6 +115,8 @@ c double precision, allocatable, dimension(:,:) :: eye integer iwhich c nodezero=(ga_nodeid().eq.0) + ccpu=0d0 + cwall=0d0 cjb c call ga_print(g_movecs(1)) c From a0911106648cffb61b3fe7ab5c8214a0005f2632 Mon Sep 17 00:00:00 2001 From: edoapra Date: Thu, 2 Feb 2023 18:06:44 -0800 Subject: [PATCH 7/8] redefined nstates if tddft_iguess has decreased nroots --- src/qmd/qmd_driver.F | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/src/qmd/qmd_driver.F b/src/qmd/qmd_driver.F index ba457b3c5d..f7ee698773 100644 --- a/src/qmd/qmd_driver.F +++ b/src/qmd/qmd_driver.F @@ -381,6 +381,17 @@ c $ nroots,ipol,nmo,nocc, $ dbl_mb(k_en),g_vecs) esys=dbl_mb(k_en+state-1) +c check nroots vs nstates (tddft might have changed nroots) +c get number of TDDFT roots calculated + if (.not.rtdb_get(rtdb,'tddft:nroots',mt_int,1,nroots)) + & call errquit(pname//'failed to get nroots ',0,RTDB_ERR) + if (nroots.lt.(nstates-1)) then +c call errquit(pname//'nroots<(nstates-1) ',0,RTDB_ERR) + if(ga_nodeid().eq.0) write(luout,124) nstates,nroots + 124 format(9x,'Number of states decreased from ',i8,' to ',i8) + nstates=nroots + endif + c calculate couplings call qmd_coup(rtdb,geom,geom_p,ipol,nstates,dt_nucl,nmo, $ nocc,g_vecs,g_vecs_p,dbl_mb(k_coup), From b80cc23ce642dc312c689646124ffe68bce85a3a Mon Sep 17 00:00:00 2001 From: edoapra Date: Thu, 2 Feb 2023 18:05:53 -0800 Subject: [PATCH 8/8] always print roots decrease --- src/nwdft/lr_tddft/tddft_iguess.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/nwdft/lr_tddft/tddft_iguess.F b/src/nwdft/lr_tddft/tddft_iguess.F index a820dbc6a0..2b0d85e745 100644 --- a/src/nwdft/lr_tddft/tddft_iguess.F +++ b/src/nwdft/lr_tddft/tddft_iguess.F @@ -371,7 +371,7 @@ c else if (lewin) then if (nroots.gt.newin) nroots = newin else if (nroots.gt.nov(1)+nov(2)) then - if (nodezero.and.util_print('initial guess',print_default)) + if (nodezero.and.util_print('initial guess',print_low)) 1 write(LuOut,9040) nroots,nov(1)+nov(2) nroots=nov(1)+nov(2) if (.not.rtdb_put(rtdb,'tddft:nroots',mt_int,1,nroots))