diff --git a/README.md b/README.md index 9fa35ee..d390177 100644 --- a/README.md +++ b/README.md @@ -91,4 +91,24 @@ origin x y z Default origin is `0 0 0`. This command just sets the origin for where the simulation cell starts building. -*Example:* `origin 10 0 1` \ No newline at end of file +*Example:* `origin 10 0 1` + +### Mode Convert + +``` +cacmb --convert infile outfile +``` + +This mode converts a file `infile` to a file of `outfile`. The extensions determine the conversion process. + +### Mode Merge + +``` +cacmb --merge dim N infiles outfile +``` + +This mode merges multiple data files and creates one big simulation cell. The parameters are: + +`N` - The number of files which are being read + +`dim` - the dimension they are to be stacked along, can be either `x`, `y`, or `z`. If the argument `none` is passed then the cells are just overlaid. Future options will include a delete overlap command. \ No newline at end of file diff --git a/src/Makefile b/src/Makefile index 58507b4..22c84eb 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,8 +1,8 @@ FC=ifort -FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone +FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin #FFLAGS=-c -mcmodel=large -Ofast -MODES=mode_create.o -OBJECTS=main.o elements.o io.o subroutines.o functions.o atoms.o call_mode.o $(MODES) +MODES=mode_create.o mode_merge.o mode_convert.o +OBJECTS=main.o elements.o io.o subroutines.o functions.o atoms.o call_mode.o box.o $(MODES) .SUFFIXES: .SUFFIXES: .c .f .f90 .F90 .o @@ -28,6 +28,6 @@ $(OBJECTS) : parameters.o atoms.o subroutines.o testfuncs.o : functions.o main.o io.o build_subroutines.o: elements.o call_mode.o : $(MODES) -$(MODES) io.o: atoms.o +$(MODES) io.o: atoms.o box.o $(MODES) main.o : io.o testfuncs.o elements.o mode_create.o: subroutines.o diff --git a/src/box.f90 b/src/box.f90 new file mode 100644 index 0000000..ad5fe55 --- /dev/null +++ b/src/box.f90 @@ -0,0 +1,75 @@ +module box + !This module contains information on the properties of the current box. + use parameters + + implicit none + + real(kind=dp) :: box_bd(6) !Global box boundaries + + !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 + integer :: sub_box_num = 0 + integer, allocatable :: sub_box_array_bd(:,:,:)!Boundaries in the atom and element arrays for each sub_box + real(kind=dp), allocatable :: sub_box_ori(:,:,:)!Orientations for each of the subboxes + real(kind=dp), allocatable :: sub_box_bd(:,:)!Boundaries for each of the sub_boxes + + public + contains + + subroutine box_init + !Initialize some box functions + box_bd(:) = 0.0_dp + end subroutine box_init + + subroutine alloc_sub_box(n) + !Allocate the sub_box variables + + integer, intent(in) :: n + + allocate(sub_box_ori(3,3,n), sub_box_bd(6,n), sub_box_array_bd(2,2,n)) + + end subroutine alloc_sub_box + + subroutine grow_sub_box(n) + !Grows sub box arrays, this is only called when a new file is read in + integer, intent(in) :: n + + integer, allocatable :: temp_array_bd(:,:,:), temp_file(:) + real(kind=dp), allocatable :: temp_ori(:,:,:), temp_bd(:,:) + !Allocate temporary arrays + allocate(temp_ori(3,3,sub_box_num+n),temp_bd(6,sub_box_num+n), & + temp_array_bd(2,2,sub_box_num+n), temp_file(sub_box_num+n)) + + !Move allocation for all sub_box_arrays + temp_ori(:,:,1:sub_box_num) = sub_box_ori + temp_ori(:,:,sub_box_num+1:) = 0.0_dp + call move_alloc(temp_ori, sub_box_ori) + + temp_bd(:, 1:sub_box_num) = sub_box_bd + temp_bd(:, sub_box_num+1:) = 0.0_dp + call move_alloc(temp_bd, sub_box_bd) + + temp_array_bd(:,:,1:sub_box_num) = sub_box_array_bd + temp_array_bd(:,:,sub_box_num+1:) = 0.0_dp + call move_alloc(temp_array_bd, sub_box_array_bd) + + return + end subroutine grow_sub_box + + subroutine grow_box(temp_box_bd) + !This function takes in a temporary box boundary and adjusts the overall box boundaries + !to include it + + real(kind=dp), dimension(6), intent(in) :: temp_box_bd + + integer :: i + + do i = 1, 3 + if(temp_box_bd(2*i-1) < box_bd(2*i-1)) box_bd(2*i-1) = temp_box_bd(2*i-1) + if(temp_box_bd(2*i) > box_bd(2*i)) box_bd(2*i) = temp_box_bd(2*i) + end do + return + end subroutine grow_box + +end module box \ No newline at end of file diff --git a/src/call_mode.f90 b/src/call_mode.f90 index 1ad4f0f..f571520 100644 --- a/src/call_mode.f90 +++ b/src/call_mode.f90 @@ -3,6 +3,8 @@ subroutine call_mode(arg_num,mode) !mode module. use mode_create + use mode_convert + use mode_merge use parameters implicit none @@ -12,10 +14,13 @@ subroutine call_mode(arg_num,mode) select case(mode) case('--create') - call create() - + 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 diff --git a/src/elements.f90 b/src/elements.f90 index 21de971..28e0e5e 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -7,7 +7,6 @@ module elements implicit none !Data structures used to represent the CAC elements. Each index represents an element - integer,allocatable :: tag_ele(:) !Element tag (used to keep track of id's character(len=100), allocatable :: type_ele(:) !Element type integer, allocatable :: size_ele(:), lat_ele(:) !Element siz real(kind=dp), allocatable :: r_node(:,:,:,:) !Nodal position array @@ -16,7 +15,7 @@ module elements integer :: node_num=0 !Total number of nodes !Data structure used to represent atoms - integer, allocatable :: tag_atom(:), type_atom(:)!atom id + integer, allocatable :: type_atom(:)!atom type real(kind =dp),allocatable :: r_atom(:,:) !atom position integer :: atom_num=0 !Number of atoms @@ -30,19 +29,15 @@ module elements !Below are lattice type arrays which provide information on the general form of the elements. !We currently have a limit of 10 lattice types for simplicities sake but this can be easily increased. - + 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 !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), basis_type(10,10)!Max basis atom number, number of basis atoms in each lattice type - real(kind=dp) :: basis_pos(3,10,10) !Basis atom positions - - !Simulation cell parameters - real(kind=dp) :: box_bd(6) - + integer :: max_basisnum, basisnum(10) !Max basis atom number, number of basis atoms in each lattice type + integer :: basis_type(10,10) public contains @@ -89,7 +84,6 @@ module elements max_basisnum = 0 basisnum(:) = 0 - basis_pos(:,:,:) = 0.0_dp ng_node(:) = 0 end subroutine lattice_init @@ -124,7 +118,7 @@ module elements !Allocate element arrays if(n > 0) then - allocate(tag_ele(n), type_ele(n), size_ele(n), lat_ele(n), r_node(3,max_basisnum, max_ng_node,n), & + allocate(type_ele(n), size_ele(n), lat_ele(n), r_node(3,max_basisnum, max_ng_node,n), & stat=allostat) if(allostat > 0) then print *, "Error allocating element arrays in elements.f90 because of: ", allostat @@ -134,7 +128,7 @@ module elements if(m > 0) then !Allocate atom arrays - allocate(tag_atom(m), type_atom(m), r_atom(3,m), stat=allostat) + allocate(type_atom(m), r_atom(3,m), stat=allostat) if(allostat > 0) then print *, "Error allocating atom arrays in elements.f90 because of: ", allostat stop @@ -142,6 +136,58 @@ module elements end if end subroutine + subroutine grow_ele_arrays(n, m) + + integer, intent(in) :: n, m + + integer :: ele_size, atom_size, buffer_size + integer, allocatable :: temp_int(:) + real(kind=dp), allocatable :: temp_ele_real(:,:,:,:), temp_real(:,:) + character(len=100), allocatable :: char_temp(:) + + !The default size we grow the + buffer_size = 1024 + !Figure out the size of the atom and element arrays + ele_size = size(size_ele) + atom_size = size(type_atom) + + !Check if we need to grow the ele_size, if so grow all the variables + if ( n+ele_num > size(size_ele)) then + + allocate(temp_int(n+ele_num+buffer_size)) + temp_int(1:ele_size) = lat_ele + temp_int(ele_size+1:) = 0 + call move_alloc(temp_int(1:ele_size), lat_ele) + + allocate(temp_int(n+ele_num+buffer_size)) + temp_int(1:ele_size) = size_ele + temp_int(ele_size+1:) = 0 + call move_alloc(temp_int(1:ele_size), size_ele) + + allocate(char_temp(n+ele_num+buffer_size)) + char_temp(1:ele_size) = type_ele + call move_alloc(char_temp, type_ele) + + allocate(temp_ele_real(3, max_basisnum, max_ng_node, n+ele_num+buffer_size)) + temp_ele_real(:,:,:,1:ele_size) = r_node + temp_ele_real(:,:,:,ele_size+1:) = 0.0_dp + call move_alloc(temp_ele_real, r_node) + end if + + !Now grow atom arrays if needed + if (m+atom_num > atom_size) then + allocate(temp_int(m+atom_num+buffer_size)) + temp_int(1:atom_size) = type_atom + temp_int(atom_size+1:) = 0 + call move_alloc(temp_int, type_atom) + + allocate(temp_real(3,m+atom_num+buffer_size)) + temp_real(:,1:atom_size) = r_atom + temp_real(:, atom_size+1:) = 0.0_dp + call move_alloc(temp_real, r_atom) + end if + end subroutine + subroutine add_element(type, size, lat, r) !Subroutine which adds an element to the element arrays integer, intent(in) :: size, lat @@ -149,7 +195,6 @@ module elements real(kind=dp), intent(in) :: r(3, max_basisnum, max_ng_node) ele_num = ele_num + 1 - tag_ele(ele_num) = ele_num type_ele(ele_num) = type size_ele(ele_num) = size lat_ele(ele_num) = lat @@ -165,7 +210,6 @@ module elements real(kind=dp), intent(in), dimension(3) :: r atom_num = atom_num+1 - tag_atom(atom_num) = atom_num type_atom(atom_num) = type r_atom(:,atom_num) = r(:) @@ -304,4 +348,5 @@ module elements return end subroutine rhombshape + end module elements \ No newline at end of file diff --git a/src/io.f90 b/src/io.f90 index 7850ee2..20fac52 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -3,15 +3,17 @@ module io use elements use parameters use atoms + use box implicit none - integer :: outfilenum = 0 - character(len=100) :: outfiles(10) + integer :: outfilenum = 0, infilenum = 0 + character(len=100) :: outfiles(10), infiles(10) public contains + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Subroutines for writing out data files !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine get_out_file(filename) implicit none @@ -56,18 +58,10 @@ module io cycle end if select case(temp_outfile(scan(temp_outfile,'.',.true.)+1:)) - case('xyz') + case('xyz', 'lmp', 'vtk', 'mb') outfilenum=outfilenum+1 outfiles(outfilenum) = temp_outfile exit - case('lmp') - outfilenum=outfilenum+1 - outfiles(outfilenum) = temp_outfile - exit - case('vtk') - outfilenum=outfilenum+1 - outfiles(outfilenum)=temp_outfile - exit case default 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." @@ -96,6 +90,8 @@ module io call write_lmp(outfiles(i)) case('vtk') call write_vtk(outfiles(i)) + case('mb') + call write_mb(outfiles(i)) case default print *, "The extension ", trim(adjustl(outfiles(i)(scan(outfiles(i),'.',.true.)+1:))), & " is not accepted for writing. Please select from: xyz and try again" @@ -276,4 +272,201 @@ module io end do close(11) end subroutine + + subroutine write_mb(file) + + !This subroutine writes the cacmb formatted file which provides necessary information for building models + character(len=100), intent(in) :: file + + 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') + + !First write the box boundary information + !Write the global box boundaries + write(11,*) box_bd(:) + !Write the number of sub_boxes in the system + write(11,*) sub_box_num + !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 + write(11,*) atom_types, (type_to_name(i), i=1, atom_types) + !Write the number of lattice_types, basisnum and number of nodes for each lattice type + write(11,*) lattice_types, (basisnum(i), i = 1, lattice_types), (ng_node(i), i = 1, lattice_types) + !Now for every lattice type write the basis atom types + write(11,*) ((basis_type(i,j), i = 1, basisnum(j)), j = 1, lattice_types) + + !Now write the numbers of elements and atoms + write(11,*) atom_num, ele_num + + !Write out atoms first + do i = 1, atom_num + write(11,*) i, type_atom(i), r_atom(:,i) + end do + + !Write out the elements, this is written in two stages, one line for the element and then 1 line for + !every basis at every node + do i = 1, ele_num + write(11, *) i, lat_ele(i), size_ele(i), type_ele(i) + do inod = 1, ng_node(lat_ele(i)) + do ibasis =1, basisnum(lat_ele(i)) + write(11,*) inod, ibasis, r_node(:, ibasis, inod, i) + end do + end do + end do + + end subroutine write_mb + + !!!!!!!!!!!!! Below are subroutines for reading files !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + 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 or extension to output to:" + 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 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 ", trim(adjustl(filename)), " does not exist. Please input a filename that exists" + read(*,*) temp_infile + cycle + end if + + select case(temp_infile(scan(temp_infile,'.',.true.)+1:)) + case('xyz', 'lmp', 'vtk', 'mb') + infilenum=infilenum+1 + infiles(infilenum) = temp_infile + exit + case default + print *, "File type: ", trim(temp_infile(scan(temp_infile,'.',.true.):)), "not currently accepted. ", & + "please input a filename with extension from following list: mb." + read(*,*) temp_infile + + end select + end do + + end subroutine get_in_file + + 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, intent(in) :: i + real(kind=dp), dimension(3), intent(in) :: displace + real(kind=dp), dimension(6), intent(out) :: temp_box_bd + + !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 subroutine read_in + + 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) :: 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(:) + + 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 + + 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, n + !Read in orientation with column major ordering + 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(:,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) + !Read the number of lattice types, basisnum, and number of nodes for each lattice type + read(11,*) lattice_types, (basisnum(i), i = 1, lattice_types), (ng_node(i), i = 1, lattice_types) + !Define max_ng_node and max_basis_num + max_basisnum = maxval(basisnum) + max_ng_node = maxval(ng_node) + !Read the basis atom types for every lattice + 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 + 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+newdisplace) + end do + + !Read the elements + do i = 1, in_eles + read(11, *) n, type, size, etype + 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 \ No newline at end of file diff --git a/src/main.f90 b/src/main.f90 index 7f76b6b..c7ac008 100644 --- a/src/main.f90 +++ b/src/main.f90 @@ -20,8 +20,10 @@ program main integer :: arg_num character(len=100) :: mode + !Call initialization functions call lattice_init - + call box_init + ! Command line parsing arg_num = command_argument_count() diff --git a/src/mode_convert.f90 b/src/mode_convert.f90 new file mode 100644 index 0000000..d6e1d9b --- /dev/null +++ b/src/mode_convert.f90 @@ -0,0 +1,28 @@ +module mode_convert + + use parameters + use box + use elements + use io + + public + contains + + subroutine convert + !This subroutine converts a single input file from one format to another + character(len=100) :: infile, outfile + real(kind = dp) :: temp_box_bd(6) + !We have to allocate the element and atom arrays with a size of 1 for the read in code to work + call alloc_ele_arrays(1,1) + !First read in the file + call get_command_argument(2, infile) + call get_in_file(infile) + call read_in(1, (/0.0_dp,0.0_dp,0.0_dp/), temp_box_bd) + call grow_box(temp_box_bd) + + !Now get the outfile, writing is done after all the codes complete + call get_command_argument(3, outfile) + call get_out_file(outfile) + + end subroutine convert +end module mode_convert \ No newline at end of file diff --git a/src/mode_create.f90 b/src/mode_create.f90 index 52342e2..b82cc82 100644 --- a/src/mode_create.f90 +++ b/src/mode_create.f90 @@ -6,13 +6,15 @@ module mode_create use io use subroutines use elements + use box implicit none character(len=100) :: name, element_type real(kind = dp) :: lattice_parameter, orient(3,3), cell_mat(3,8), box_len(3), basis(3,3), origin(3), maxlen(3), & orient_inv(3,3), box_vert(3,8), maxbd(3), lattice_space(3) - integer :: esize, duplicate(3), ix, iy, iz, box_lat_vert(3,8), lat_ele_num, lat_atom_num, bd_in_lat(6) + integer :: esize, duplicate(3), ix, iy, iz, box_lat_vert(3,8), lat_ele_num, lat_atom_num, bd_in_lat(6), & + basis_pos(3,10) logical :: dup_flag, dim_flag real(kind=dp), allocatable :: r_lat(:,:,:), r_atom_lat(:,:) @@ -98,7 +100,7 @@ module mode_create !Add the basis atoms to the unit cell do inod = 1, max_ng_node do ibasis = 1, basisnum(1) - r_node_temp(:,ibasis,inod) = cell_mat(:,inod) + basis_pos(:,ibasis,1) + origin(:) + r_node_temp(:,ibasis,inod) = cell_mat(:,inod) + basis_pos(:,ibasis) + origin(:) end do end do do i = 1,3 @@ -115,7 +117,7 @@ module mode_create if(lat_atom_num > 0) then do i = 1, lat_atom_num do ibasis = 1, basisnum(1) - call add_atom(basis_type(ibasis,1), (r_atom_lat(:,i)*lattice_parameter)+basis_pos(:,ibasis,1)) + call add_atom(basis_type(ibasis, 1), (r_atom_lat(:,i)*lattice_parameter)+basis_pos(:,ibasis)) end do end do deallocate(r_atom_lat) @@ -125,7 +127,7 @@ module mode_create do i = 1, lat_ele_num do inod= 1, ng_node(1) do ibasis = 1, basisnum(1) - r_node_temp(:,ibasis,inod) = (r_lat(:,inod,i)*lattice_parameter)+basis_pos(:,ibasis,1) + r_node_temp(:,ibasis,inod) = (r_lat(:,inod,i)*lattice_parameter)+basis_pos(:,ibasis) end do end do call add_element(element_type, esize, 1, r_node_temp) @@ -133,6 +135,14 @@ module mode_create end if end if + !The last thing we do is setup the sub_box_boundaries + call alloc_sub_box(1) + sub_box_num = 1 + sub_box_ori(:,:,1) = orient + sub_box_bd(:,1) = box_bd + sub_box_array_bd(1,:,1) = 1 + sub_box_array_bd(2,1,1) = atom_num + sub_box_array_bd(2,2,1) = ele_num end subroutine create !This subroutine parses the command and pulls out information needed for mode_create subroutine parse_command() @@ -258,13 +268,17 @@ module mode_create !Now normalize the orientation matrix orient = matrix_normal(orient,3) + !Set lattice_num to 1 + lattice_types = 1 + !If we haven't defined a basis then define the basis and add the default basis atom type and position if (basisnum(1) == 0) then max_basisnum = 1 basisnum(1) = 1 call add_atom_type(name, basis_type(1,1)) !If basis command not defined then we use name as the atom_name - basis_pos(:,1,1) = 0.0_dp + basis_pos(:,1) = 0.0_dp end if + ! end subroutine subroutine build_with_rhomb(box_in_lat, transform_matrix) @@ -274,9 +288,9 @@ module mode_create integer, dimension(3,8), intent(in) :: box_in_lat !The box vertices transformed to lattice space real(kind=dp), dimension(3,3), intent(in) :: transform_matrix !The transformation matrix from lattice_space to real space !Internal variables - integer :: i, inod, bd_in_lat(6), bd_in_array(6), ix, iy, iz, numlatpoints, templatpoints, ele(3,8), rzero(3), ilat, & - type_interp(basisnum(1)*esize**3), vlat(3), temp_lat(3,8), m, n, o - real(kind=dp) :: v(3), temp_nodes(3,1,8), ele_atoms(3,esize**3), r_interp(3,basisnum(1)*esize**3) + integer :: i, inod, bd_in_lat(6), bd_in_array(6), ix, iy, iz, numlatpoints, ele(3,8), rzero(3), & + vlat(3), temp_lat(3,8), m, n, o + real(kind=dp) :: v(3), temp_nodes(3,1,8) real(kind=dp), allocatable :: resize_lat_array(:,:) logical, allocatable :: lat_points(:,:,:) logical :: node_in_bd(8) @@ -432,12 +446,11 @@ module mode_create end do !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))) lat_atom_num = 0 - do ix = 1, bd_in_array(3) + do iz = 1, bd_in_array(3) do iy = 1, bd_in_array(2) - do iz = 1, bd_in_array(1) + do ix = 1, bd_in_array(1) !If this point is a lattice point then save the lattice point as an atom if (lat_points(ix,iy,iz)) then v= (/ real(ix,dp), real(iy, dp), real(iz,dp) /) @@ -453,7 +466,6 @@ module mode_create end do end do - print *, lat_atom_num end if end subroutine build_with_rhomb diff --git a/src/mode_merge.f90 b/src/mode_merge.f90 new file mode 100644 index 0000000..0919b70 --- /dev/null +++ b/src/mode_merge.f90 @@ -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 \ No newline at end of file