From f467c74a53e5e17bfa72a6e15b3327938b4fa532 Mon Sep 17 00:00:00 2001 From: Thomas Rose <39367840+Thomas3R@users.noreply.github.com> Date: Thu, 14 Mar 2024 15:13:19 +0100 Subject: [PATCH] Reduce memory usage in egbond_hb --- src/gfnff/gfnff_eg.f90 | 13 ++++++++----- src/gfnff/gfnff_ini.f90 | 24 +++++++++++++++++++++++- src/gfnff/gfnff_ini2.f90 | 6 +++++- src/gfnff/topology.f90 | 4 ++++ src/restart.f90 | 8 ++++++++ 5 files changed, 48 insertions(+), 7 deletions(-) diff --git a/src/gfnff/gfnff_eg.f90 b/src/gfnff/gfnff_eg.f90 index f9909e059..d7210e9c3 100644 --- a/src/gfnff/gfnff_eg.f90 +++ b/src/gfnff/gfnff_eg.f90 @@ -555,7 +555,7 @@ subroutine gfnff_eg(env,mol,pr,n,ichrg,at,xyz,sigma,g,etot,res_gff, & endif deallocate(dcn, dcndr) allocate(dEdcn(n),source=0.0_wp) - allocate(considered_ABH(n,n,n), source=.false.) + allocate(considered_ABH(topo%hb_mapNAB,topo%hb_mapNAB,topo%hb_mapNH), source=.false.) !$omp parallel do default(none) reduction(+:g, ebond, sigma, dEdcn) & !$omp shared(grab0, topo, neigh, param, rab0, rabdcn, xyz, at, hb_cn, hb_dcn, n, dhbcndL, considered_ABH) & @@ -1038,7 +1038,7 @@ subroutine egbond_hb(i,iat,jat,iTr,rab,rij,drij,drijdcn,hb_cn,hb_dcn,n,at,xyz,e, real*8,intent(in) :: hb_cn(n) real*8,intent(in) :: hb_dcn(3,n,n) real(wp), intent(in) :: dhbcndL(3,3,n) - logical, intent(inout) :: considered_ABH(n,n,n) ! only consider ABH triplets once; indep of iTr + logical, intent(inout) :: considered_ABH(topo%hb_mapNAB,topo%hb_mapNAB,topo%hb_mapNH)! only consider ABH triplets once; indep of iTr real*8,intent(inout) :: e real*8,intent(inout) :: g(3,n) real*8,intent(inout) :: sigma(3,3) @@ -1048,12 +1048,12 @@ subroutine egbond_hb(i,iat,jat,iTr,rab,rij,drij,drijdcn,hb_cn,hb_dcn,n,at,xyz,e, integer j,k integer jA,jH,iTrA,iTrH,iTrB integer hbH,hbB,hbA + integer mapA,mapB,mapH real*8 dr,dum real*8 dx,dy,dz,vrab(3),dg(3) real*8 yy,zz real*8 t1,t4,t5,t6,t8 - if (at(iat).eq.1) then hbH=iat hbA=jat @@ -1128,8 +1128,11 @@ subroutine egbond_hb(i,iat,jat,iTr,rab,rij,drij,drijdcn,hb_cn,hb_dcn,n,at,xyz,e, hbB = topo%bond_hb_B(1,k,j) iTrB= topo%bond_hb_B(2,k,j) ! only add gradient one time per ABH triple (independent of iTrB) - if(.not.considered_ABH(hbA,hbB,hbH)) then - considered_ABH(hbA,hbB,hbH)=.true. + mapA=topo%hb_mapABH(hbA) + mapB=topo%hb_mapABH(hbB) + mapH=topo%hb_mapABH(hbH) + if(.not.considered_ABH(mapA,mapB,mapH)) then + considered_ABH(mapA,mapB,mapH)=.true. dg=hb_dcn(:,hbB,hbH)*zz g(:,hbB)=g(:,hbB)-dg endif diff --git a/src/gfnff/gfnff_ini.f90 b/src/gfnff/gfnff_ini.f90 index b3fe0bf5d..f1b65be1f 100644 --- a/src/gfnff/gfnff_ini.f90 +++ b/src/gfnff/gfnff_ini.f90 @@ -1422,6 +1422,7 @@ integer function itabrow6(i) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !Set up fix hblist just like for the HB term + allocate(topo%isABH(mol%n), source=.false.) call bond_hbset0(mol%n,mol%at,mol%xyz,mol%npbc,bond_hbn,topo,neigh,hbthr1,hbthr2) allocate(bond_hbl(6,bond_hbn)) allocate(neigh%nr_hb(neigh%nbond), source=0) @@ -1430,12 +1431,33 @@ integer function itabrow6(i) !Set up AH, B and nr. of B list call bond_hb_AHB_set0(mol%n,mol%at,neigh%nbond,bond_hbn,bond_hbl,AHB_nr,neigh) allocate( lin_AHB(4,0:AHB_nr), source=0 ) - call bond_hb_AHB_set1(mol%n,mol%at,neigh%nbond,bond_hbn,bond_hbl,AHB_nr,lin_AHB,topo%bond_hb_nr,topo%b_max,neigh) + call bond_hb_AHB_set1(mol%n,mol%at,neigh%nbond,bond_hbn,bond_hbl,AHB_nr,lin_AHB,topo%bond_hb_nr,topo%b_max,topo,neigh) allocate( topo%bond_hb_AH(4,topo%bond_hb_nr), source = 0 ) allocate( topo%bond_hb_B(2,topo%b_max,topo%bond_hb_nr), source = 0 ) allocate( topo%bond_hb_Bn(topo%bond_hb_nr), source = 0 ) call bond_hb_AHB_set(mol%n,mol%at,neigh%nbond,bond_hbn,bond_hbl,AHB_nr,lin_AHB,topo,neigh) + ! create mapping from atom index to hb index, for AB and H seperately + allocate(topo%hb_mapABH(mol%n), source=0) + j=0 ! H counter + k=0 ! AB counter + do i=1, mol%n + ! check if atom i is A,B, or H + if (topo%isABH(i)) then + ! check if it is H + if (mol%at(i).eq.1) then + j = j + 1 + topo%hb_mapABH(i) = j + ! then it is A or B + else + k = k + 1 + topo%hb_mapABH(i) = k + end if + end if + end do + topo%hb_mapNAB=k + topo%hb_mapNH=j + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! bend diff --git a/src/gfnff/gfnff_ini2.f90 b/src/gfnff/gfnff_ini2.f90 index abddb7ffb..d335eabad 100644 --- a/src/gfnff/gfnff_ini2.f90 +++ b/src/gfnff/gfnff_ini2.f90 @@ -1107,12 +1107,13 @@ subroutine bond_hb_AHB_set(n,at,numbond,bond_hbn,bond_hbl,tot_AHB_nr,lin_AHB,top end subroutine bond_hb_AHB_set -subroutine bond_hb_AHB_set1(n,at,numbond,bond_hbn,bond_hbl,tot_AHB_nr,lin_AHB,AH_count,bmax,neigh) +subroutine bond_hb_AHB_set1(n,at,numbond,bond_hbn,bond_hbl,tot_AHB_nr,lin_AHB,AH_count,bmax,topo,neigh) use xtb_gfnff_param use xtb_gfnff_neighbor implicit none !Dummy type(TNeigh), intent(inout) :: neigh + type(TGFFTopology), intent(inout) :: topo integer,intent(in) :: n integer,intent(in) :: numbond integer,intent(in) :: at(n) @@ -1172,6 +1173,7 @@ subroutine bond_hb_AHB_set1(n,at,numbond,bond_hbn,bond_hbl,tot_AHB_nr,lin_AHB,AH lin_AHB(2,tot_count) = hbH lin_AHB(3,tot_count) = iTrA lin_AHB(4,tot_count) = iTrH + topo%isABH(Bat)=.true. if (lin_AHB(1,tot_count)-lin_AHB(1,tot_count-1).eq.0.and.& &lin_AHB(2,tot_count)-lin_AHB(2,tot_count-1).eq.0) then lin_diff=0 @@ -1190,6 +1192,8 @@ subroutine bond_hb_AHB_set1(n,at,numbond,bond_hbn,bond_hbl,tot_AHB_nr,lin_AHB,AH cycle end if end do + topo%isABH(hbA)=.true. + topo%isABH(hbH)=.true. neigh%nr_hb(i) = B_count end if end do diff --git a/src/gfnff/topology.f90 b/src/gfnff/topology.f90 index 9ec00629d..445e28148 100644 --- a/src/gfnff/topology.f90 +++ b/src/gfnff/topology.f90 @@ -84,6 +84,10 @@ module xtb_gfnff_topology real(wp),allocatable:: qfrag (:) ! fragment charge (for EEQ) real(wp),allocatable:: hbbas (:) ! HB donor atom basicity real(wp),allocatable:: hbaci (:) ! HB acceptor atom acidity + integer, allocatable:: hb_mapABH(:) + logical, allocatable:: isABH(:) + integer :: hb_mapNAB + integer :: hb_mapNH integer, allocatable :: ispinsyst(:,:) integer, allocatable :: nspinsyst(:) diff --git a/src/restart.f90 b/src/restart.f90 index dc1d189ff..15996d9fa 100644 --- a/src/restart.f90 +++ b/src/restart.f90 @@ -125,11 +125,14 @@ subroutine read_restart_gff(env,fname,n,version,success,verbose,topo,neigh) & topo%natxbAB,topo%nbatm,topo%nfrag,topo%nsystem,topo%maxsystem read(ich) topo%nbond_blist,topo%nbond_vbond,topo%nangl_alloc,topo%ntors_alloc,topo%bond_hb_nr,topo%b_max read(ich) neigh%numnb, neigh%numctr, neigh%nbond, neigh%iTrDim + read(ich) topo%hb_mapNAB, topo%hb_mapNH topo%nbond = neigh%nbond call gfnff_param_alloc(topo,neigh, n) if (.not.allocated(topo%ispinsyst)) allocate( topo%ispinsyst(n,topo%maxsystem), source = 0 ) if (.not.allocated(topo%nspinsyst)) allocate( topo%nspinsyst(topo%maxsystem), source = 0 ) if (.not.allocated(neigh%nr_hb)) allocate(neigh%nr_hb(neigh%nbond)) + if (.not.allocated(topo%hb_mapABH)) allocate(topo%hb_mapABH(n)) + if (.not.allocated(topo%isABH)) allocate(topo%isABH(n)) read(ich) neigh%blist read(ich) topo%alist read(ich) topo%tlist @@ -145,6 +148,8 @@ subroutine read_restart_gff(env,fname,n,version,success,verbose,topo,neigh) read(ich) topo%bond_hb_B read(ich) topo%bond_hb_Bn read(ich) neigh%nr_hb + read(ich) topo%hb_mapABH + read(ich) topo%isABH read(ich) topo%vangl,topo%vtors,topo%chieeq, & & topo%gameeq,topo%alpeeq,topo%alphanb,topo%qa, & & topo%xyze0,topo%zetac6,& @@ -214,6 +219,7 @@ subroutine write_restart_gff(env,fname,nat,version,topo,neigh) & topo%natxbAB,topo%nbatm,topo%nfrag,topo%nsystem, topo%maxsystem write(ich) topo%nbond_blist,topo%nbond_vbond,topo%nangl_alloc,topo%ntors_alloc,topo%bond_hb_nr,topo%b_max write(ich) neigh%numnb, neigh%numctr, neigh%nbond, neigh%iTrDim + write(ich) topo%hb_mapNAB, topo%hb_mapNH !Arrays Integers write(ich) neigh%blist write(ich) topo%alist @@ -230,6 +236,8 @@ subroutine write_restart_gff(env,fname,nat,version,topo,neigh) write(ich) topo%bond_hb_B write(ich) topo%bond_hb_Bn write(ich) neigh%nr_hb + write(ich) topo%hb_mapABH + write(ich) topo%isABH !Arrays Reals write(ich) topo%vangl,topo%vtors,topo%chieeq,& & topo%gameeq,topo%alpeeq,topo%alphanb,topo%qa, &