Working writing to lammpsCAC format

master
Alex Selimov 5 years ago
parent 033b44dc40
commit 54aa50b605

@ -6,8 +6,8 @@ module io
implicit none implicit none
integer :: outfilenum = 0 integer :: outfilenum = 0, infilenum = 0
character(len=100) :: outfiles(10) character(len=100) :: outfiles(10), infiles(10)
public public
contains contains
@ -41,6 +41,7 @@ module io
if((scan(overwrite, "n") > 0).or.(scan(overwrite, "N") > 0)) then if((scan(overwrite, "n") > 0).or.(scan(overwrite, "N") > 0)) then
print *, "Please specify a new filename with extension:" print *, "Please specify a new filename with extension:"
read(*,*) temp_outfile read(*,*) temp_outfile
cycle
else if((scan(overwrite, "y") > 0).or.(scan(overwrite, "Y") > 0)) then else if((scan(overwrite, "y") > 0).or.(scan(overwrite, "Y") > 0)) then
continue continue
else else
@ -56,21 +57,13 @@ module io
cycle cycle
end if end if
select case(temp_outfile(scan(temp_outfile,'.',.true.)+1:)) select case(temp_outfile(scan(temp_outfile,'.',.true.)+1:))
case('xyz') case('xyz','lmp','vtk','cac')
outfilenum=outfilenum+1
outfiles(outfilenum) = temp_outfile
exit
case('lmp')
outfilenum=outfilenum+1
outfiles(outfilenum) = temp_outfile
exit
case('vtk')
outfilenum=outfilenum+1 outfilenum=outfilenum+1
outfiles(outfilenum) = temp_outfile outfiles(outfilenum) = temp_outfile
exit exit
case default case default
print *, "File type: ", trim(temp_outfile(scan(temp_outfile,'.',.true.):)), " not currently accepted. ", & print *, "File type: ", trim(temp_outfile(scan(temp_outfile,'.',.true.):)), " not currently accepted. ", &
"please input a filename with extension from following list: xyz, lmp, vtk." "please input a filename with extension from following list: xyz, lmp, vtk, cac."
read(*,*) temp_outfile read(*,*) temp_outfile
end select end select
@ -78,6 +71,52 @@ module io
end subroutine get_out_file end subroutine get_out_file
subroutine get_in_file(filename)
implicit none
character(len=100), intent(in) :: filename
character(len=100) :: temp_infile
logical :: file_exists
!If no filename is provided then this function is called with none and prompts user input
if (filename=='none') then
print *, "Please specify a filename with extension to read in:"
read(*,*) temp_infile
else
temp_infile = filename
end if
!Infinite loop which only exists if user provides valid filetype
do while(.true.)
!Check to see if file exists, if it doesn't then ask the user for another input
inquire(file=trim(temp_infile), exist=file_exists)
if (.not.file_exists) then
print *, "The file ", temp_infile, "does not exist, please input an existing file to read in."
read(*,*) temp_infile
cycle
end if
if (scan(temp_outfile,'.',.true.) == 0) then
print *, "No extension included on filename, please type a full filename that includes an extension."
read(*,*) temp_infile
cycle
end if
select case(temp_outfile(scan(temp_outfile,'.',.true.)+1:))
case('cac')
infilenum=infilenum+1
infiles(infilenum) = temp_infile
exit
case default
print *, "File type: ", trim(temp_infile(scan(temp_outfile,'.',.true.):)), " not currently accepted. ", &
"please input a filename with extension from following list: cac."
read(*,*) temp_infile
end select
end do
end subroutine get_in_file
subroutine write_out subroutine write_out
!This subroutine loops over alll of the outfile types defined and calls the correct writing subroutine !This subroutine loops over alll of the outfile types defined and calls the correct writing subroutine
@ -96,6 +135,8 @@ module io
call write_lmp(outfiles(i)) call write_lmp(outfiles(i))
case('vtk') case('vtk')
call write_vtk(outfiles(i)) call write_vtk(outfiles(i))
case('cac')
call write_lmpcac(outfiles(i))
case default case default
print *, "The extension ", trim(adjustl(outfiles(i)(scan(outfiles(i),'.',.true.)+1:))), & print *, "The extension ", trim(adjustl(outfiles(i)(scan(outfiles(i),'.',.true.)+1:))), &
" is not accepted for writing. Please select from: xyz and try again" " is not accepted for writing. Please select from: xyz and try again"
@ -201,6 +242,71 @@ module io
end do end do
end subroutine write_lmp end subroutine write_lmp
subroutine write_lmpcac(file)
!This subroutine writes out a .lmp style dump file
character(len=100), intent(in) :: file
integer :: write_num, i, inod, ibasis
real(kind=dp) :: mass
1 format(i16, ' Eight_Node', 4i16)
2 format(i16, ' Atom', 4i16)
3 format(3i16,3f23.15)
open(unit=11, file=trim(adjustl(file)), action='write', status='replace',position='rewind')
!Comment line
write(11, '(a)') '# CAC input file made with cacmb'
write(11, '(a)')
!Calculate total atom number
write_num = atom_num + ele_num
!Write total number of atoms + elements
write(11, '(i16, a)') write_num, ' cac elements'
!Write number of atom types
write(11, '(i16, a)') atom_types, ' atom types'
write(11,'(a)') ' '
!Write box bd
write(11, '(2f23.15, a)') box_bd(1:2), ' xlo xhi'
write(11, '(2f23.15, a)') box_bd(3:4), ' ylo yhi'
write(11, '(2f23.15, a)') box_bd(5:6), ' zlo zhi'
!Masses
write(11, '(a)') 'Masses'
write(11, '(a)') ' '
do i =1, atom_types
call atommass(type_to_name(i),mass)
write(11, '(i16, f23.15, 2a)') i, mass, ' # ', type_to_name(i)
end do
write(11, '(a)') ' '
write(11, '(a)') 'CAC Elements'
write(11, '(a)') ' '
!Write element nodal positions
do i = 1, ele_num
select case(trim(adjustl(type_ele(i))))
case('fcc')
!The first entry is the element specifier
write(11,1) i, basisnum(lat_ele(i)), size_ele(i), size_ele(i), size_ele(i)
do ibasis = 1, basisnum(lat_ele(i))
do inod = 1, 8
!Nodal information for every node
write(11,3) inod, ibasis, basis_type(ibasis,lat_ele(i)), r_node(:,ibasis,inod,i)
end do
end do
end select
end do
do i = 1, atom_num
!Element specifier dictating that it is an atom
write(11,2) ele_num+i, 1, 1, 1, 1
!Write the atomic information
write(11,3) 1, 1, type_atom(i), r_atom(:,i)
end do
end subroutine write_lmpcac
subroutine write_vtk(file) subroutine write_vtk(file)
!This subroutine writes out a vtk style dump file !This subroutine writes out a vtk style dump file
integer :: i, j, inod, ibasis integer :: i, j, inod, ibasis
@ -257,7 +363,7 @@ module io
do i = 1, ele_num do i = 1, ele_num
do inod=1, ng_node(lat_ele(i)) do inod=1, ng_node(lat_ele(i))
do ibasis = 1, basisnum(lat_ele(i)) do ibasis = 1, basisnum(lat_ele(i))
write(11, '(3f23.1)') sum(r_node(:,:,inod,i),2)/basisnum(lat_ele(i)) write(11, '(3f23.15)') sum(r_node(:,:,inod,i),2)/basisnum(lat_ele(i))
end do end do
end do end do
end do end do
@ -276,4 +382,29 @@ module io
end do end do
close(11) close(11)
end subroutine end subroutine
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! READ SUBROUTINES !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! subroutine read_lmpcac(file, box_bd)
! !This subroutine reads in a lmpcac file which can be used with different options and modes
! !Arguments
! character(len=100), intent(in) :: file
! real(kind=wp), dimension(6), intent(out) :: box_bd
! !Internal variables
! character(len=1000) :: line
! integer :: read_num, atom_lim, ele_lim
! !Open the lmpcac file
! open(unit=11, file=file, action='read', position='rewind')
! !Skip header lines
! read(11,*) line
! read(11,*) line
! !Read total number of elements
! end subroutine read_lmpcac
end module io end module io

@ -432,7 +432,6 @@ module mode_create
end do end do
!Now figure out how many lattice points could not be contained in elements !Now figure out how many lattice points could not be contained in elements
print *, count(lat_points)
allocate(r_atom_lat(3,count(lat_points))) allocate(r_atom_lat(3,count(lat_points)))
lat_atom_num = 0 lat_atom_num = 0
do ix = 1, bd_in_array(3) do ix = 1, bd_in_array(3)
@ -453,7 +452,6 @@ module mode_create
end do end do
end do end do
print *, lat_atom_num
end if end if
end subroutine build_with_rhomb end subroutine build_with_rhomb

Loading…
Cancel
Save