From 31fa6d8c22645c2231ed2a8899f88eed7bd63238 Mon Sep 17 00:00:00 2001 From: Thomas Rose <39367840+Thomas3R@users.noreply.github.com> Date: Wed, 18 Sep 2024 15:16:14 +0200 Subject: [PATCH 1/2] Allocate set%ffnb dynamically. --- src/gfnff/gfnff_ini.f90 | 8 ++++--- src/set_module.f90 | 50 ++++++++++++++++++++++++++++++++++++++++- src/setparam.f90 | 3 +-- 3 files changed, 55 insertions(+), 6 deletions(-) diff --git a/src/gfnff/gfnff_ini.f90 b/src/gfnff/gfnff_ini.f90 index 2335b00d6..9ca886df8 100644 --- a/src/gfnff/gfnff_ini.f90 +++ b/src/gfnff/gfnff_ini.f90 @@ -2450,10 +2450,12 @@ subroutine gfnff_topo_changes(env, neigh) integer :: int_tmp(40) integer :: i,j,idx,iTr,d1,d2,numnb,nnb - ! check if hardcoded size of ffnb is still up to date - if (size(set%ffnb, dim=1).ne.neigh%numnb) call env%error('The array set%ffnb has not been adjusted to changes in neigh%numnb.', source) ! only do something if there are changes stored in set%ffnb - if(set%ffnb(1,1).ne.-1) then + if(allocated(set%ffnb)) then + ! check if hardcoded size of ffnb is still up to date + if (size(set%ffnb, dim=1).ne.neigh%numnb) call env%error('The array set%ffnb has not been adjusted to changes in neigh%numnb.', source) + ! there should not be any "-1" in set%ffnb anymore, if it was set up correctly + if (any(set%ffnb.eq.-1)) call env%error('GFN-FF neighbor list could not be adjusted!', source) d2=size(set%ffnb, dim=2) do i=1, d2 if (set%ffnb(1,i).eq.-1) exit diff --git a/src/set_module.f90 b/src/set_module.f90 index c81703d56..d91a47ef5 100644 --- a/src/set_module.f90 +++ b/src/set_module.f90 @@ -781,7 +781,10 @@ subroutine rdcontrol(fname,env,copy_file) case('cube' ); call rdblock(env,set_cube, line,id,copy,err,ncount) case('write' ); call rdblock(env,set_write, line,id,copy,err,ncount) case('gfn' ); call rdblock(env,set_gfn, line,id,copy,err,ncount) - case('ffnb' ); call rdblock(env,set_ffnb, line,id,copy,err,ncount) + case('ffnb' ) + ! dynamic allocation of ffnb array requires reading fname before calling rdblock + call alloc_ffnb(env, fname) + call rdblock(env,set_ffnb, line,id,copy,err,ncount) case('scc' ); call rdblock(env,set_scc, line,id,copy,err,ncount) case('oniom' ); call rdblock(env,set_oniom, line,id,copy,err,ncount) case('opt' ); call rdblock(env,set_opt, line,id,copy,err,ncount) @@ -1500,6 +1503,51 @@ subroutine set_gfn(env,key,val) end select end subroutine set_gfn +! determine number of GFN-FF neighbor list changes in control file +! and allocate set%ffnb accordingly +subroutine alloc_ffnb(env, fname) + type(TEnvironment), intent(inout) :: env + character(len=*),intent(in) :: fname + character(len=*), parameter :: source = 'alloc_ffnb' + character(len=:),allocatable :: line + integer :: copy, err + integer :: id, ie + logical :: is_ffnb_block + ! character,private,parameter :: flag = '$' ! is defined for this module + integer :: n_changes ! number of atoms that neigh%nb should be adjusted for + + copy=-1 ! do not copy the control file + n_changes = 0 + is_ffnb_block = .false. + + call open_file(id,fname,'r') + if (id.eq.-1) then + call env%warning("could not find '"//fname//"'", source) + return + endif + ! read first line + call mirror_line(id,copy,line,err) + ! read control file and check + count_n:do + ! check if the $ffnb block has been reached + if (line(1:5).eq."$ffnb".or.is_ffnb_block) then + is_ffnb_block = .true. + call mirror_line(id,copy,line,err) + if (is_iostat_end(err)) exit count_n ! check if EOF ! + if (index(line,flag).ne.0) exit count_n ! check if new flag ! + ie = index(line,equal) ! find the equal sign ! + if (ie.eq.0) cycle ! cycle if there is no equal sign + n_changes = n_changes + 1 + else ! otherwise read the next line + call mirror_line(id,copy,line,err) + if (is_iostat_end(err)) exit count_n ! check if EOF ! + end if + end do count_n + if (.not.allocated(set%ffnb)) allocate(set%ffnb(42,n_changes), source=-1) + +end subroutine alloc_ffnb + + subroutine set_ffnb(env,key,val) implicit none character(len=*), parameter :: source = 'set_ffnb' diff --git a/src/setparam.f90 b/src/setparam.f90 index 13047c724..20f4e0baf 100644 --- a/src/setparam.f90 +++ b/src/setparam.f90 @@ -517,9 +517,8 @@ module xtb_setparam !> PTB settings type(TPTBSetup) :: ptbsetup !> GFN-FF manual setup of nb list via xcontrol - ! allows a maximum of 164 atoms neighbors to be changed ! ffnb(42,i) stores the number of neighbors of atom i - integer :: ffnb(42,164) = -1 + integer, allocatable :: ffnb(:,:) end type TSet type(TSet) :: set From 9da477df4a564a35881f83d4acd7ba09cf700abd Mon Sep 17 00:00:00 2001 From: Thomas3R <39367840+Thomas3R@users.noreply.github.com> Date: Thu, 19 Sep 2024 12:48:35 +0200 Subject: [PATCH 2/2] Update src/set_module.f90 Co-authored-by: Marcel Mueller --- src/set_module.f90 | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/src/set_module.f90 b/src/set_module.f90 index d91a47ef5..dd5f93ca2 100644 --- a/src/set_module.f90 +++ b/src/set_module.f90 @@ -1510,15 +1510,11 @@ subroutine alloc_ffnb(env, fname) character(len=*),intent(in) :: fname character(len=*), parameter :: source = 'alloc_ffnb' character(len=:),allocatable :: line - integer :: copy, err - integer :: id, ie - logical :: is_ffnb_block - ! character,private,parameter :: flag = '$' ! is defined for this module - integer :: n_changes ! number of atoms that neigh%nb should be adjusted for - - copy=-1 ! do not copy the control file - n_changes = 0 - is_ffnb_block = .false. + + integer :: id, ie, err + logical :: is_ffnb_block = .false. + integer :: copy = -1 + integer :: n_changes = 0 ! number of atoms that neigh%nb should be adjusted for call open_file(id,fname,'r') if (id.eq.-1) then