Working changes for reading .cac files

This commit is contained in:
Alex Selimov 2020-04-22 12:52:37 -04:00
parent e6d7741060
commit b3e05da6a4
5 changed files with 83 additions and 16 deletions

View file

@ -33,8 +33,10 @@ subroutine call_option(option, arg_pos)
call sbox_ori(arg_pos)
case('-delete')
call run_delete(arg_pos)
case('-set_cac')
arg_pos = arg_pos+3
case default
print *, 'Option ', trim(adjustl(option)), ' is not currently accepted.'
stop 3
end select
end subroutine call_option
end subroutine call_option

View file

@ -35,13 +35,13 @@ module elements
integer :: lattice_types = 0
integer :: max_ng_node, ng_node(10) !Max number of nodes per element and number of nodes per element for each lattice type
integer :: max_esize=0 !Maximum number of atoms per side of element
real(kind=dp) :: lapa(10)
!These variables contain information on the basis, for simplicities sake we limit
!the user to the definition of 10 lattice types with 10 basis atoms at each lattice point.
!This can be easily increased with no change to efficiency
integer :: max_basisnum, basisnum(10) !Max basis atom number, number of basis atoms in each lattice type
integer :: basis_type(10,10)
real(kind=dp) :: lapa(10)
!Additional module level variables we need
logical :: wrap_flag
@ -632,4 +632,38 @@ module elements
end select
end subroutine
end module elements
subroutine lattice_map(in_bnum, in_btypes, in_ngnodes, in_lapa, lat_type)
!This subroutine maps an input lattice type to either a new lattice type or an existing one depending on basis_type and
!number of nodes at the atoms
integer, intent(in) :: in_ngnodes, in_bnum, in_btypes(10) !Input variables
real(kind=dp), intent(in) :: in_lapa
integer, intent(out) :: lat_type
integer j, ibasis
lat_type = 0
lat_loop:do j = 1, lattice_types
!Check all the lattice level variables
if ((basisnum(j) == in_bnum).and.(ng_node(j) == in_ngnodes).and.(is_equal(lapa(j),in_lapa))) then
!Now check lattice level variables
do ibasis = 1, basisnum(j)
if(basis_type(ibasis,j) /= in_btypes(ibasis)) cycle old_loop
end do
lat_type = j
exit lat_loop
end if
end do lat_loop
!If it doesn't match an existing lattice type we add it
if( lat_type == 0) then
lattice_types = lattice_types + 1
basisnum(lattice_types) = in_bnum
basis_types(:,lattice_types) = in_btypes
ng_node(lattice_types) = in_ngnodes
lapa(lattice_types) = in_lapa
end if
end subroutine lattice_map
end module elements

View file

@ -8,9 +8,9 @@ module io
implicit none
integer :: outfilenum = 0, infilenum = 0
character(len=100) :: outfiles(100), infiles(100)
character(len=100) :: outfiles(100), infiles(100), in_lattice_type=''
logical :: force_overwrite
real(kind=dp) :: in_lapa=0.0
public
contains
@ -958,12 +958,15 @@ module io
character(len=100) :: textholder, element_type, esize
character(len=2) :: atom_species
integer :: i, j, ele_in, type_in, type_map(10), in_basis, node_types(10,8), inod, ibasis, in_basis_types(10)
real(kind=dp) :: mass, r_in(3,10,8)
integer :: i, j, ele_in, type_in, type_map(10), in_basis, node_types(10,8), inod, ibasis, in_basis_types(10)
real(kind=dp) :: mass, r_in(3,10,8), lat_vec(3), in_ori(3,3)
!First open the file
!First check to make sure that we have set the needed variables
if(is_equal(in_lapa,0.0_dp).or.(in_lattice_type=='')) then
print *, "Please use set_cac to set needed parameters to read in .cac file"
stop 3
end if
!Open the file
open(unit=11, file=trim(adjustl(file)), action='read',position='rewind')
!Read header information
@ -978,8 +981,7 @@ module io
read(11,*) textholder
read(11,*) box_bd(1:2), texholder
read(11,*) box_bd(3:4), texholder
read(11,*) box_bd(5:6), texholder
read(11,*) box_bd(5:6), texholder
!Read useless information
read(11,*) textholder
read(11,*) textholder
@ -1005,10 +1007,35 @@ module io
do j = 1, 8*in_basis
read(11, *) inod, ibasis, in_basis_types(ibasis), r_in(:,ibasis,inod)
end do
!Now calculate the orientation matrix based on the lattice type.
lat_vec = r_in(:,1,2) - r_in(:,1,1)
lat_vec = lat_vec / norm2(lat_vec)
!Now figure out if is an existing lattice_type
call lattice_map(in_basis, in_basis_types, 8, in_lapa, lat_type)
!
end select
end do
end subroutine read_cac
subroutine set_cac(apos)
!This code parses input values
integer, intent(in) :: apos
integer :: arglen, arg_pos
arg_pos = apos + 1
call get_command_argument(arg_pos, in_lapa, arglen)
if (arglen==0) then
print *, "Missing lattice parameter for set_input_lat"
end if
arg_pos = arg_pos + 1
call get_command_argument(arg_pos, in_lattice_type, arglen)
if (arglen==0) then
print *, "Missing lattice type for set_input_lat"
end if
end subroutine set_input_lat(arg_pos)
end module io

View file

@ -60,6 +60,11 @@ program main
!This lets us know if we need to wrap atomic positions back into the cell
case('-wrap')
wrap_flag=.true.
!This gives necessary information in order to correctly read .cac files
case('-set_cac')
call set_cac(i)
end select
end do
!Determine if a mode is being used and what it is. The first argument has to be the mode