diff --git a/src/call_mode.f90 b/src/call_mode.f90 index 8c58d3f..f571520 100644 --- a/src/call_mode.f90 +++ b/src/call_mode.f90 @@ -4,6 +4,7 @@ subroutine call_mode(arg_num,mode) use mode_create use mode_convert + use mode_merge use parameters implicit none @@ -15,9 +16,11 @@ subroutine call_mode(arg_num,mode) case('--create') call create case('--convert') - call 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/io.f90 b/src/io.f90 index e5c111d..20fac52 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -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 \ No newline at end of file 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