Fix to opt_orient to preserve boundary conditions

development
Alex Selimov 4 years ago
parent 1e1c08e546
commit fb236f4ab4

@ -11,6 +11,7 @@ module opt_orient
real(kind=dp), save :: new_orient(3,3) real(kind=dp), save :: new_orient(3,3)
real(kind=dp), dimension(6) :: orig_box_bd real(kind=dp), dimension(6) :: orig_box_bd
real(kind=dp), allocatable :: orig_sub_box_ori(:,:,:) real(kind=dp), allocatable :: orig_sub_box_ori(:,:,:)
character(len=3) :: orig_box_bc
public public
contains contains
@ -19,10 +20,10 @@ module opt_orient
integer, intent(inout) :: arg_pos integer, intent(inout) :: arg_pos
integer :: i, ibasis, inod integer :: i, j, k, ibasis, inod
logical :: isortho, isrighthanded logical :: isortho, isrighthanded, matching
real(kind=dp) :: inv_sub_box_ori(3,3,sub_box_num) real(kind=dp) :: inv_sub_box_ori(3,3,sub_box_num)
character(len=3) :: old_box_bc
!First parse the orient command !First parse the orient command
call parse_orient(arg_pos) call parse_orient(arg_pos)
@ -63,11 +64,24 @@ module opt_orient
!Save original box boundaries !Save original box boundaries
orig_box_bd = box_bd orig_box_bd = box_bd
!Now find new box boundaries, have to temporarily define the box as shrink wrapped for def new box to work !Now find new box boundaries, if any orientations are the same we leave them as they are. If they are different then we have
old_box_bc = box_Bc !to shrink wrap them
box_bc = 'sss'
orig_box_bc = box_bc
do i = 1,3
matching=.true.
sbox_loop:do j = 1, sub_box_num
do k = 1, 3
if(.not.is_equal(orig_sub_box_ori(i,k,j), new_orient(i,k))) then
matching = .false.
exit sbox_loop
end if
end do
end do sbox_loop
if(.not.matching) box_bc(i:i)='s'
end do
call def_new_box call def_new_box
box_bc = old_box_bc
end subroutine orient end subroutine orient
subroutine parse_orient(arg_pos) subroutine parse_orient(arg_pos)
@ -129,8 +143,9 @@ module opt_orient
end do end do
end do end do
!Restore original box boundaries !Restore original box boundaries and box BC
box_bd = orig_box_bd box_bd = orig_box_bd
box_bc = orig_box_bc
end subroutine unorient end subroutine unorient
subroutine sbox_ori(arg_pos) subroutine sbox_ori(arg_pos)

Loading…
Cancel
Save