aselimov
/
CACmb
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Added mode merge, adjusted how file reading works to accomodate model merge

Browse Source
master
Alex 5 years ago
parent fb2abc60d1
commit 3c7461f094
3 changed files with 154 additions and 27 deletions
Show Stats Download Patch File Download Diff File

5
src/call_mode.f90
Unescape View File

@ -4,6 +4,7 @@ subroutine call_mode(arg_num,mode)
use mode_create
use mode_convert
use mode_merge
use parameters
implicit none
@ -16,8 +17,10 @@ subroutine call_mode(arg_num,mode)
call create
case('--convert')
call convert
case('--merge')
call merge
case default
print *, "Mode ", mode, " currently not accepted. Please check documentation for ", &
print *, "Mode ", trim(adjustl(mode)), " currently not accepted. Please check documentation for ", &
"accepted modes and rerun."
stop 3

72
src/io.f90
Unescape View File

@ -278,7 +278,7 @@ module io
!This subroutine writes the cacmb formatted file which provides necessary information for building models
character(len=100), intent(in) :: file
integer :: i, j, inod, ibasis
integer :: i, j, k, inod, ibasis
!Open the .mb file for writing
open(unit=11, file=trim(adjustl(file)), action='write', status='replace',position='rewind')
@ -288,10 +288,11 @@ module io
write(11,*) box_bd(:)
!Write the number of sub_boxes in the system
write(11,*) sub_box_num
!For every subbox write the orientation and sub box boundary
!For every subbox write the orientation, sub box boundary, and sub_box_array_bds
do i = 1, sub_box_num
write(11,*) sub_box_ori(:,:,i)
write(11,*) sub_box_bd(:,i)
write(11,*) ((sub_box_array_bd(j,k,i), j = 1, 2), k = 1, 2)
end do
!Write the number of atom types in the current model and all of their names
@ -346,7 +347,7 @@ module io
!Check to see if file exists, if it does then ask user if they would like to overwrite the file
inquire(file=trim(temp_infile), exist=file_exists)
if (.not.file_exists) then
print *, "The file ", filename, " does not exist. Please input a filename that exists"
print *, "The file ", trim(adjustl(filename)), " does not exist. Please input a filename that exists"
read(*,*) temp_infile
cycle
end if
@ -366,52 +367,70 @@ module io
end subroutine get_in_file
subroutine read_in
subroutine read_in(i, displace, temp_box_bd)
!This subroutine loops over alll of the outfile types defined and calls the correct writing subroutine
integer :: i
integer, intent(in) :: i
real(kind=dp), dimension(3), intent(in) :: displace
real(kind=dp), dimension(6), intent(out) :: temp_box_bd
do i = 1, infilenum
!Pull out the extension of the file and call the correct write subroutine
select case(trim(adjustl(infiles(i)(scan(infiles(i),'.',.true.)+1:))))
case('mb')
call read_mb(infiles(i))
case default
print *, "The extension ", trim(adjustl(outfiles(i)(scan(outfiles(i),'.',.true.)+1:))), &
" is not accepted for writing. Please select from: mb and try again"
stop
!Pull out the extension of the file and call the correct write subroutine
select case(trim(adjustl(infiles(i)(scan(infiles(i),'.',.true.)+1:))))
case('mb')
call read_mb(infiles(i), displace, temp_box_bd)
case default
print *, "The extension ", trim(adjustl(outfiles(i)(scan(outfiles(i),'.',.true.)+1:))), &
" is not accepted for writing. Please select from: mb and try again"
stop
end select
end select
end do
end subroutine read_in
subroutine read_mb(file)
subroutine read_mb(file, displace, temp_box_bd)
!This subroutine reads in an mb file for operation
character(len=100), intent(in) :: file
real(kind=dp), dimension(3), intent(in) :: displace
real(kind = dp), dimension(6), intent(out) :: temp_box_bd
integer :: i, j, k, n, inod, ibasis, type, size, in_atoms, in_eles
character(len=100) :: etype
real(kind=dp) :: temp_box_bd(6), r(3)
real(kind=dp) :: r(3), newdisplace(3)
real(kind=dp), allocatable :: r_innode(:,:,:)
!First open the file
open(unit=11, file=trim(adjustl(file)), action='read',position='rewind')
!Read in the box boundary and grow the current active box bd
read(11, *) temp_box_bd(:)
call grow_box(temp_box_bd)
do i = 1, 3
newdisplace(i) = displace(i) - temp_box_bd(2*i-1)
temp_box_bd(2*i-1) = temp_box_bd(2*i-1) + newdisplace(i)
temp_box_bd(2*i) = temp_box_bd(2*i) + newdisplace(i)
end do
!Read in the number of sub_boxes and allocate the variables
read(11, *) n
call alloc_sub_box(n)
if (sub_box_num == 0) then
call alloc_sub_box(n)
else
call grow_sub_box(n)
end if
!Read in subbox orientations and boundaries
do i = 1, sub_box_num
do i = 1, n
!Read in orientation with column major ordering
read(11,*) ((sub_box_ori(j, k, i), j = 1, 3), k = 1, 3)
read(11,*) ((sub_box_ori(j, k, sub_box_num+i), j = 1, 3), k = 1, 3)
!Read in subbox boundaries
read(11,*) sub_box_bd(:,i)
read(11,*) sub_box_bd(:,sub_box_num+i)
sub_box_bd(:,sub_box_num+i) = sub_box_bd(:, sub_box_num+i) + displace(:)
!Read in sub_box_array_bd
read(11,*) ((sub_box_ori(j, k, sub_box_num+i), j = 1, 2), k = 1, 2)
end do
sub_box_num = sub_box_num + n
!Read in the number of atom types and all their names
read(11, *) atom_types, (type_to_name(i), i = 1, atom_types)
@ -424,14 +443,14 @@ module io
read(11,*) ((basis_type(i,j), i = 1, basisnum(j)), j = 1, lattice_types)
!Read number of elements and atoms and allocate arrays
read(11, *) in_atoms,in_eles
read(11, *) in_atoms, in_eles
call grow_ele_arrays(in_eles, in_atoms)
allocate(r_innode(3,max_basisnum, max_ng_node))
!Read the atoms
do i = 1, in_atoms
read(11,*) j, type, r(:)
call add_atom(type, r)
call add_atom(type, r+newdisplace)
end do
!Read the elements
@ -440,11 +459,14 @@ module io
do inod = 1, ng_node(type)
do ibasis =1, basisnum(type)
read(11,*) j, k, r_innode(:, ibasis, inod)
r_innode(:,ibasis,inod) = r_innode(:, ibasis, inod) + newdisplace
end do
end do
call add_element(etype, size, type, r_innode)
end do
!Close the file being read
close(11)
end subroutine read_mb
end module io

102
src/mode_merge.f90
Unescape View File

@ -0,0 +1,102 @@
module mode_merge
!This module contains the code needed for merging several .mb files together
use parameters
use atoms
use io
use subroutines
use elements
character(len=4) :: dim
integer :: in_num
public
contains
subroutine merge
integer :: i
real(kind=dp) :: displace(3), temp_box_bd(6)
!First we parse the merge command
call parse_command
!Now loop over all files and stack them
do i = 1, in_num
displace(:) = 0.0_dp
if ((i==1).or.(trim(adjustl(dim)) == 'none')) then
call read_in(i, displace, temp_box_bd)
call grow_box(temp_box_bd)
else
select case(trim(adjustl(dim)))
case('x')
displace(1) = box_bd(2)
case('y')
displace(2) = box_bd(4)
case('z')
displace(3) = box_bd(6)
end select
call read_in(i, displace, temp_box_bd)
call grow_box(temp_box_bd)
end if
end do
return
end subroutine merge
subroutine parse_command
character(len=100) :: textholder
integer :: i, stat, arglen, arg_pos
!Get dimension to concatenate along
call get_command_argument(2, dim, arglen)
if (arglen == 0) STOP "Missing dim in mode_merge command"
select case(trim(adjustl(dim)))
case('x','y','z','none')
continue
case default
print *, dim, " not accepted as a dimension in mode_merge"
stop 3
end select
!Get number of files to read in
call get_command_argument(3, textholder, arglen)
if (arglen == 0) STOP "Number of files to read missing in mode_merge command"
read(textholder, *, iostat = stat) in_num
if (stat > 0) STOP "Error reading number of files in, must be integer"
!Now loop and pull out all files
do i = 1, in_num
call get_command_argument(3+i, textholder, arglen)
if (arglen == 0) STOP "Fewer files to read in then specified"
!Make sure this file is readable
call get_in_file(textholder)
end do
!Set argpos accordingly
arg_pos = 3+in_num+1
!Now options loop
!Check for optional keywords
do while(.true.)
if(arg_pos > command_argument_count()) exit
!Pull out the next argument which should either be a keyword or an option
call get_command_argument(arg_pos, textholder)
textholder=adjustl(textholder)
arg_pos=arg_pos+1
!Choose what to based on what the option string is
select case(trim(textholder))
case default
!Check to see if it is an option command, if so then mode_create must be finished
if(textholder(1:1) == '-') then
exit
!Check to see if a filename was passed
elseif(scan(textholder,'.',.true.) > 0) then
call get_out_file(textholder)
end if
end select
end do
end subroutine parse_command
end module mode_merge
Write Preview
Loading…
Cancel
Save