From 0ad06a2d6bc673457956dcb1fb1854af07323cd8 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Thu, 5 Mar 2020 16:19:30 -0500 Subject: [PATCH 1/3] Working changes to boundary command --- src/Makefile | 4 ++-- src/box.f90 | 2 ++ src/call_option.f90 | 1 + src/elements.f90 | 7 ++++--- src/main.f90 | 3 +++ src/subroutines.f90 | 12 +++++++----- 6 files changed, 19 insertions(+), 10 deletions(-) diff --git a/src/Makefile b/src/Makefile index 9a3fced..2e314ca 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,6 +1,6 @@ FC=ifort -FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays -#FFLAGS=-mcmodel=large -Ofast -no-wrap-margin -heap-arrays +#FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays +FFLAGS=-mcmodel=large -Ofast -no-wrap-margin -heap-arrays MODES=mode_create.o mode_merge.o mode_convert.o OPTIONS=opt_disl.o opt_group.o opt_orient.o opt_delete.o OBJECTS=main.o elements.o io.o subroutines.o functions.o atoms.o call_mode.o box.o $(MODES) $(OPTIONS) call_option.o diff --git a/src/box.f90 b/src/box.f90 index de8ef59..f98ed88 100644 --- a/src/box.f90 +++ b/src/box.f90 @@ -6,6 +6,7 @@ module box real(kind=dp) :: box_bd(6) !Global box boundaries character(len=3) :: box_bc !Box boundary conditions (periodic or shrinkwrapped) + logical :: bound_called !The subbox variables contain values for each subbox, being the boxes read in through some !command. Currently only mode_merge will require sub_boxes, for mode_create it will always !allocate to only 1 sub_box @@ -27,6 +28,7 @@ module box !Initialize some box functions box_bd(:) = 0.0_dp box_bc = 'ppp' + bound_called=.false. end subroutine box_init subroutine alloc_sub_box(n) diff --git a/src/call_option.f90 b/src/call_option.f90 index 1755d89..ac31b77 100644 --- a/src/call_option.f90 +++ b/src/call_option.f90 @@ -28,6 +28,7 @@ subroutine call_option(option, arg_pos) arg_pos=arg_pos+1 call get_command_argument(arg_pos, box_bc) arg_pos=arg_pos+1 + bound_called = .true. case('-delete') call run_delete(arg_pos) case default diff --git a/src/elements.f90 b/src/elements.f90 index f63b6b2..935b6f8 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -479,15 +479,16 @@ module elements do j = 1, 3 if (r_node(j,ibasis,inod,i) > max_bd(j)) max_bd(j) = r_node(j,ibasis,inod,i) + lim_zero if (r_node(j,ibasis,inod,i) < min_bd(j)) min_bd(j) = r_node(j,ibasis,inod,i) -lim_zero - end do end do end do end do do j = 1, 3 - box_bd(2*j) = max_bd(j) - box_bd(2*j-1) = min_bd(j) + if(box_bc(j:j) == 's') then + box_bd(2*j) = max_bd(j) + box_bd(2*j-1) = min_bd(j) + end if end do end subroutine diff --git a/src/main.f90 b/src/main.f90 index 85b3b49..958a3c0 100644 --- a/src/main.f90 +++ b/src/main.f90 @@ -101,6 +101,9 @@ program main !If wrap flag was passed then call the wrap atoms command if(wrap_flag) call wrap_atoms + !If we called the boundary command then we adjust the box bounds + if(bound_called) call def_new_box + !Check to make sure a file was passed to be written out and then write out ! Before building do a check on the file if (outfilenum == 0) then diff --git a/src/subroutines.f90 b/src/subroutines.f90 index 0be8d0e..b40b344 100644 --- a/src/subroutines.f90 +++ b/src/subroutines.f90 @@ -230,11 +230,13 @@ module subroutines integer :: j real(kind=dp) ::box_len do j = 1, 3 - box_len = box_bd(2*j) - box_bd(2*j-1) - if (r(j) > box_bd(2*j)) then - r(j) = r(j) - box_len - else if (r(j) < box_bd(2*j-1)) then - r(j) = r(j) + box_len + if(box_bc(j:j) == 'p') then + box_len = box_bd(2*j) - box_bd(2*j-1) + if (r(j) > box_bd(2*j)) then + r(j) = r(j) - box_len + else if (r(j) < box_bd(2*j-1)) then + r(j) = r(j) + box_len + end if end if end do end subroutine From 6642c2a1b7bf66902139306c7ffb564e4302e0ea Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Fri, 13 Mar 2020 15:08:43 -0400 Subject: [PATCH 2/3] FIx to opt-orient command due to difference with how boundary command worked --- src/opt_orient.f90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/opt_orient.f90 b/src/opt_orient.f90 index c1bef1e..812754f 100644 --- a/src/opt_orient.f90 +++ b/src/opt_orient.f90 @@ -22,6 +22,7 @@ module opt_orient integer :: i, ibasis, inod logical :: isortho, isrighthanded real(kind=dp) :: inv_sub_box_ori(3,3,sub_box_num) + character(len=3) :: old_box_bc !First parse the orient command call parse_orient(arg_pos) @@ -31,7 +32,7 @@ module opt_orient !Find all inverse orientation matrices for all sub_boxes do i = 1, sub_box_num - call matrix_inverse(sub_box_ori, 3, inv_sub_box_ori) + call matrix_inverse(sub_box_ori(:,:,i), 3, inv_sub_box_ori(:,:,i)) end do !Now transform all atoms @@ -62,8 +63,11 @@ module opt_orient !Save original box boundaries orig_box_bd = box_bd - !Now find new box boundaries + !Now find new box boundaries, have to temporarily define the box as shrink wrapped for def new box to work + old_box_bc = box_Bc + box_bc = 'sss' call def_new_box + box_bc = old_box_bc end subroutine orient subroutine parse_orient(arg_pos) From 44a9dbaead38b7f3dd87a775678ec46051d2ac62 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Fri, 13 Mar 2020 15:11:22 -0400 Subject: [PATCH 3/3] Add tol variable replacing lim_zero as a tolerance for real checks --- src/elements.f90 | 8 ++++---- src/parameters.f90 | 3 ++- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/elements.f90 b/src/elements.f90 index 935b6f8..e9fc928 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -468,8 +468,8 @@ module elements do i = 1, atom_num do j = 1, 3 - if (r_atom(j,i) > max_bd(j)) max_bd(j) = r_atom(j,i) + lim_zero - if (r_atom(j,i) < min_bd(j)) min_bd(j) = r_atom(j,i) - lim_zero + if (r_atom(j,i) > max_bd(j)) max_bd(j) = r_atom(j,i) + tol + if (r_atom(j,i) < min_bd(j)) min_bd(j) = r_atom(j,i) - tol end do end do @@ -477,8 +477,8 @@ module elements do inod = 1, ng_node(lat_ele(i)) do ibasis = 1, basisnum(lat_ele(i)) do j = 1, 3 - if (r_node(j,ibasis,inod,i) > max_bd(j)) max_bd(j) = r_node(j,ibasis,inod,i) + lim_zero - if (r_node(j,ibasis,inod,i) < min_bd(j)) min_bd(j) = r_node(j,ibasis,inod,i) -lim_zero + if (r_node(j,ibasis,inod,i) > max_bd(j)) max_bd(j) = r_node(j,ibasis,inod,i) + tol + if (r_node(j,ibasis,inod,i) < min_bd(j)) min_bd(j) = r_node(j,ibasis,inod,i) - tol end do end do end do diff --git a/src/parameters.f90 b/src/parameters.f90 index 2fa3e37..f261552 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -6,7 +6,8 @@ module parameters integer, parameter :: dp= selected_real_kind(15,307) !Parameters for floating point tolerance real(kind=dp), parameter :: lim_zero = epsilon(1.0_dp), & - lim_large = huge(1.0_dp) + lim_large = huge(1.0_dp), & + tol = 10.0_dp**(-6.0_dp) logical, save :: lmpcac !Numeric constants