From f5af38bba9a8d65cfd4980ad7996b0c55c69c46b Mon Sep 17 00:00:00 2001 From: Philipp Pracht Date: Thu, 22 Aug 2024 17:09:32 +0200 Subject: [PATCH] debugging cont release --- .github/workflows/build.yml | 34 +++++----- src/parsing/parse_block.f90 | 14 ++-- src/parsing/parse_datastruct.f90 | 16 +++-- src/parsing/parse_keyvalue.f90 | 52 ++++++++++++++- src/parsing/parse_xtbinput.f90 | 107 +++++++++++++++++++++++-------- 5 files changed, 170 insertions(+), 53 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index ed10d045..20dda827 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -29,20 +29,20 @@ jobs: build: [cmake] build-type: [debug] compiler: [gnu] - version: [11, 12] + version: [12] include: - - os: ubuntu-latest - build: cmake - build-type: debug - compiler: intel - version: 2023.1.0 - - - os: macos-latest - build: cmake - build-type: debug - compiler: gnu - version: 12 +# - os: ubuntu-latest +# build: cmake +# build-type: debug +# compiler: intel +# version: 2023.1.0 +# +# - os: macos-latest +# build: cmake +# build-type: debug +# compiler: gnu +# version: 12 - os: ubuntu-latest build: cmake @@ -50,11 +50,11 @@ jobs: compiler: gnu version: 12 - - os: ubuntu-latest - build: meson - build-type: debugoptimized - compiler: intel - version: 2023.1.0 +# - os: ubuntu-latest +# build: meson +# build-type: debugoptimized +# compiler: intel +# version: 2023.1.0 defaults: run: diff --git a/src/parsing/parse_block.f90 b/src/parsing/parse_block.f90 index 44678796..46be7b42 100644 --- a/src/parsing/parse_block.f90 +++ b/src/parsing/parse_block.f90 @@ -47,14 +47,20 @@ subroutine blk_addkv(self,kv) class(datablock) :: self type(keyvalue) :: kv type(keyvalue),allocatable :: newlist(:) - integer :: i,j + integer :: i,j,ii i = self%nkv j = i+1 allocate (newlist(j)) - newlist(1:i) = self%kv_list(1:i) - newlist(j) = kv - call move_alloc(newlist,self%kv_list) + if(allocated(self%kv_list))then + do ii=1,i + newlist(ii) = self%kv_list(ii)%copy() + enddo + deallocate(self%kv_list) + endif + newlist(j) = kv%copy() + allocate(self%kv_list, source=newlist) self%nkv = j + deallocate(newlist) end subroutine blk_addkv !========================================================================================! diff --git a/src/parsing/parse_datastruct.f90 b/src/parsing/parse_datastruct.f90 index 7dd7e95d..0bd99534 100644 --- a/src/parsing/parse_datastruct.f90 +++ b/src/parsing/parse_datastruct.f90 @@ -67,12 +67,14 @@ subroutine root_addkv(self,kv) class(root_object) :: self type(keyvalue) :: kv type(keyvalue),allocatable :: newlist(:) - integer :: i,j + integer :: i,j,ii i = self%nkv j = i+1 allocate (newlist(j)) - newlist(1:i) = self%kv_list(1:i) - newlist(j) = kv + do ii=1,i + newlist(ii) = self%kv_list(ii)%copy() + enddo + newlist(j) = kv%copy() call move_alloc(newlist,self%kv_list) self%nkv = j end subroutine root_addkv @@ -86,10 +88,14 @@ subroutine root_addblk(self,blk) i = self%nblk j = i+1 allocate (newlist(j)) - newlist(1:i) = self%blk_list(1:i) + if(allocated(self%blk_list))then + newlist(1:i) = self%blk_list(1:i) + deallocate(self%blk_list) + endif newlist(j) = blk - call move_alloc(newlist,self%blk_list) + !call move_alloc(newlist,self%blk_list) self%nblk = j + allocate(self%blk_list, source=newlist) end subroutine root_addblk subroutine root_lowercase_keys(self) diff --git a/src/parsing/parse_keyvalue.f90 b/src/parsing/parse_keyvalue.f90 index 677b7686..a0066547 100644 --- a/src/parsing/parse_keyvalue.f90 +++ b/src/parsing/parse_keyvalue.f90 @@ -44,6 +44,7 @@ module parse_keyvalue procedure :: deallocate => deallocate_kv procedure :: set_valuestring => kv_set_valuestring procedure :: add_raw_array_string => kv_add_raw_array_string + procedure :: copy => copy_kv end type keyvalue character(len=*),parameter :: kv_indicator = '=' !> used for fallback parsing @@ -89,6 +90,55 @@ subroutine deallocate_kv(self) return end subroutine + function copy_kv(self) result(kv) + implicit none + class(keyvalue) :: self + type(keyvalue) :: kv + integer :: k,i + if (allocated(self%key)) kv%key = self%key + if (allocated(self%rawvalue)) kv%rawvalue = self%rawvalue + kv%id = self%id + kv%value_f = self%value_f + kv%value_i = self%value_i + kv%value_b = self%value_b + if (allocated(self%value_c)) kv%value_c = self%value_c + kv%na = self%na + if (allocated(self%value_rawa))then + k = len(self%rawvalue) + allocate(kv%value_rawa(kv%na), source=repeat(' ',k)) + do i=1,self%na + kv%value_rawa(i) = self%value_rawa(i) + enddo + endif + if (allocated(self%value_fa))then + allocate(kv%value_fa(kv%na), source=0.0_wp) + do i=1,self%na + kv%value_fa(i) = self%value_fa(i) + enddo + endif + if (allocated(self%value_ia))then + allocate(kv%value_ia(kv%na), source=0) + do i=1,self%na + kv%value_ia(i) = self%value_ia(i) + enddo + endif + if (allocated(self%value_ba))then + allocate(kv%value_ba(kv%na), source=.false.) + do i=1,self%na + kv%value_ba(i) = self%value_ba(i) + enddo + endif + if (allocated(self%value_ca))then + k = len(self%rawvalue) + allocate(kv%value_ca(kv%na), source=repeat(' ',k)) + do i=1,self%na + kv%value_ca(i) = self%value_ca(i) + enddo + endif + return + end function copy_kv + + !========================================================================================! !> The following routines are used only in the fallback implementation! @@ -445,7 +495,7 @@ end function is_float subroutine kv_set_valuestring(self) implicit none class(keyvalue) :: self - character(len=20) :: atmp + character(len=100) :: atmp character(len=:),allocatable :: btmp integer :: i if (allocated(self%rawvalue)) deallocate (self%rawvalue) diff --git a/src/parsing/parse_xtbinput.f90 b/src/parsing/parse_xtbinput.f90 index ea32797c..270682a0 100644 --- a/src/parsing/parse_xtbinput.f90 +++ b/src/parsing/parse_xtbinput.f90 @@ -62,8 +62,8 @@ subroutine parse_xtb_inputfile(env,fname) type(systemdata) :: env character(len=*) :: fname - type(root_object) :: dict - type(datablock) :: blk + type(root_object),allocatable,target :: dict + type(datablock),pointer :: blk logical :: ex character(len=:),allocatable :: hdr integer :: i,j,k,l @@ -71,6 +71,7 @@ subroutine parse_xtb_inputfile(env,fname) inquire (file=fname,exist=ex) if (.not.ex) return + allocate(dict) call parse_xtb_input_fallback(fname,dict) !call dict%print() @@ -78,7 +79,7 @@ subroutine parse_xtb_inputfile(env,fname) & ' to set up calculators ...' !> iterate through the blocks and save the necessary information do i = 1,dict%nblk - blk = dict%blk_list(i) + blk => dict%blk_list(i) hdr = trim(blk%header) select case (hdr) case ('constrain') @@ -107,8 +108,8 @@ subroutine get_xtb_constraint_block(env,blk) type(systemdata),intent(inout) :: env type(filetype) :: file integer :: i,j,k,io - type(keyvalue) :: kv - type(datablock),intent(in) :: blk + type(keyvalue),pointer :: kv + type(datablock),intent(in),target :: blk real(wp) :: force_constant,dist,angl real(wp) :: rdum type(coord) :: mol @@ -125,7 +126,7 @@ subroutine get_xtb_constraint_block(env,blk) !>--- a default xtb force constant (in Eh), must be read first, if present force_constant = 0.05 do i = 1,blk%nkv - kv = blk%kv_list(i) + kv => blk%kv_list(i) select case (kv%key) case ('force constant') @@ -154,13 +155,14 @@ subroutine get_xtb_constraint_block(env,blk) !>--- then the common constraints: distance, angle, dihedral do i = 1,blk%nkv - kv = blk%kv_list(i) + kv => blk%kv_list(i) + call get_xtb_rawa(kv,kv%rawvalue,io) select case (kv%key) case ('force constant','reference') !> already read above case ('distance','bond') - if (kv%na .eq. 3) then + if (kv%na .eq. 3 .or. kv%na .eq. 4) then read (kv%value_rawa(1),*,iostat=io) i1 if (io == 0) read (kv%value_rawa(2),*,iostat=io) i2 if (io == 0) then @@ -171,13 +173,18 @@ subroutine get_xtb_constraint_block(env,blk) dist = mol%dist(i1,i2) end if else - read (kv%value_rawa(3),*) dist + read (kv%value_rawa(3),*,iostat=io) dist dist = dist*aatoau end if - call cons%deallocate() - call cons%bondconstraint(i1,i2,dist,force_constant) - if (debug) call cons%print(stdout) - call env%calc%add(cons) + !if(io == 0 .and. kv%na == 4)then + ! read (kv%value_rawa(3),*,iostat=io) rdum + !endif + if(io == 0)then + call cons%deallocate() + call cons%bondconstraint(i1,i2,dist,force_constant) + if (debug) call cons%print(stdout) + call env%calc%add(cons) + endif end if end if @@ -324,8 +331,8 @@ subroutine get_xtb_wall_block(env,blk) type(systemdata),intent(inout) :: env type(filetype) :: file integer :: i,j,k,io - type(keyvalue) :: kv - type(datablock),intent(in) :: blk + type(keyvalue),pointer :: kv + type(datablock),intent(in),target :: blk real(wp) :: force_constant,dist,angl real(wp) :: T,alpha,beta real(wp) :: rdum,rabc(3),r1,r2,r3 @@ -350,7 +357,7 @@ subroutine get_xtb_wall_block(env,blk) !>--- get the parameters first do i = 1,blk%nkv - kv = blk%kv_list(i) + kv => blk%kv_list(i) select case (kv%key) case ('force constant') !> already read above @@ -381,7 +388,8 @@ subroutine get_xtb_wall_block(env,blk) !>--- create the potentials do i = 1,blk%nkv - kv = blk%kv_list(i) + kv => blk%kv_list(i) + call get_xtb_rawa(kv,kv%rawvalue,io) select case (kv%key) case ('force constant','potential','alpha','beta','temp') !> created in higher prio loop already @@ -455,8 +463,8 @@ subroutine get_xtb_fix_block(env,blk) type(systemdata),intent(inout) :: env type(filetype) :: file integer :: i,j,k,io - type(keyvalue) :: kv - type(datablock),intent(in) :: blk + type(keyvalue),pointer :: kv + type(datablock),intent(in),target :: blk real(wp) :: force_constant,dist,angl real(wp) :: T,alpha,beta real(wp) :: rdum,rabc(3),r1,r2,r3 @@ -471,7 +479,8 @@ subroutine get_xtb_fix_block(env,blk) !>--- get the parameters first do i = 1,blk%nkv - kv = blk%kv_list(i) + kv => blk%kv_list(i) + call get_xtb_rawa(kv,kv%rawvalue,io) select case (kv%key) case ('atoms') @@ -530,8 +539,8 @@ subroutine get_xtb_metadyn_block(env,blk) type(systemdata),intent(inout) :: env type(filetype) :: file integer :: i,j,k,io - type(keyvalue) :: kv - type(datablock),intent(in) :: blk + type(keyvalue),pointer :: kv + type(datablock),intent(in),target :: blk real(wp) :: force_constant,dist,angl real(wp) :: T,alpha,beta real(wp) :: rdum,rabc(3),r1,r2,r3 @@ -546,7 +555,8 @@ subroutine get_xtb_metadyn_block(env,blk) !>--- get the parameters first do i = 1,blk%nkv - kv = blk%kv_list(i) + kv => blk%kv_list(i) + call get_xtb_rawa(kv,kv%rawvalue,io) select case (kv%key) case ('atoms') @@ -633,7 +643,6 @@ subroutine parse_xtb_input_fallback(fname,dict) !>--- the loop where the input file is read do i = 1,file%nlines if (file%current_line > i) cycle - !> key-value pairs of the root dict (ignored for xtb) if (get_root_kv) then call get_keyvalue(kvdum,file%line(i),io) @@ -706,6 +715,9 @@ subroutine read_xtbdatablock(file,i,blk) call get_xtb_keyvalue(kvdum,rawline,io) if (io == 0) then call blk%addkv(kvdum) + if(.not.allocated(blk%kv_list(blk%nkv)%value_rawa))then + allocate(blk%kv_list(blk%nkv)%value_rawa, source=kvdum%value_rawa) + endif end if end do @@ -715,7 +727,7 @@ end subroutine read_xtbdatablock subroutine get_xtb_keyvalue(kv,str,io) implicit none - class(keyvalue) :: kv + class(keyvalue),intent(inout) :: kv character(len=*) :: str integer,intent(out) :: io character(len=:),allocatable :: tmpstr @@ -771,6 +783,7 @@ subroutine get_xtb_keyvalue(kv,str,io) do i = 1,j if (na == kv%na) then !> for the last argument kv%value_rawa(na) = trim(adjustl(vtmp(plast:))) + exit end if if (vtmp(i:i) .eq. ',') then kv%value_rawa(na) = trim(adjustl(vtmp(plast:i-1))) @@ -778,10 +791,52 @@ subroutine get_xtb_keyvalue(kv,str,io) na = na+1 end if end do - end if end subroutine get_xtb_keyvalue + + subroutine get_xtb_rawa(kv,str,io) + implicit none + class(keyvalue),intent(inout) :: kv + character(len=*) :: str + integer,intent(out) :: io + character(len=:),allocatable :: ktmp + character(len=:),allocatable :: vtmp + integer :: i,j,k,na,plast + integer :: l(3) + + if(allocated(kv%value_rawa)) deallocate(kv%value_rawa) + + vtmp = trim(adjustl(str)) + + !> comma denotes an array of strings + k = index(vtmp,',') + if (k .ne. 0) then + j = len_trim(vtmp) + na = 1 + !> count elements + do i = 1,j + if (vtmp(i:i) .eq. ',') na = na+1 + end do + !> allocate + kv%na = na + allocate (kv%value_rawa(na),source=repeat(' ',j)) + plast = 1 + na = 1 + do i = 1,j + if (na == kv%na) then !> for the last argument + kv%value_rawa(na) = trim(adjustl(vtmp(plast:))) + exit + end if + if (vtmp(i:i) .eq. ',') then + kv%value_rawa(na) = trim(adjustl(vtmp(plast:i-1))) + plast = i+1 + na = na+1 + end if + end do + end if + end subroutine get_xtb_rawa + !========================================================================================! !> for given input file parse the next block subroutine parse_xtbinfile_block(file,i,rawblk)