From acd902db4ba0c72fe3c5ab99132ba95bcbd381fa Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Tue, 21 Apr 2020 13:25:33 -0400 Subject: [PATCH 01/60] working changes to bcc files --- src/elements.f90 | 27 ++++++++++++++++++++++++--- src/mode_create.f90 | 40 ++++++++++++++++++++++++++++++---------- 2 files changed, 54 insertions(+), 13 deletions(-) diff --git a/src/elements.f90 b/src/elements.f90 index e9fc928..5240640 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -27,7 +27,7 @@ module elements integer :: atom_types = 0 !Variables for creating elements based on primitive cells - real(kind=dp) :: cubic_cell(3,8), fcc_cell(3,8), fcc_mat(3,3), fcc_inv(3,3) + real(kind=dp) :: cubic_cell(3,8), fcc_cell(3,8), fcc_mat(3,3), fcc_inv(3,3), bcc_cell(3,8), bcc_mat(3,3), bcc_inv(3,3) integer :: cubic_faces(4,6) !Below are lattice type arrays which provide information on the general form of the elements. @@ -86,7 +86,26 @@ module elements 0.0_dp, 0.5_dp, 0.5_dp, & 0.5_dp, 0.0_dp, 0.5_dp /), & shape(fcc_mat)) + + !Initialize the bcc primitive cell + bcc_cell = reshape((/ 0.0_dp, 0.0_dp, 0.0_dp, & + 0.5_dp, -0.5_dp, 0.5_dp, & + 1.0_dp, 0.0_dp, 1.0_dp, & + 0.5_dp, 0.5_dp, 0.5_dp, & + 0.5_dp, 0.5_dp, -0.5_dp, & + 0.0_dp, 0.0_dp, 1.0_dp, & + 0.5_dp, 0.5_dp, 1.5_dp /), & + shape(bcc_cell)) + + bcc_mat = reshape((/ 0.5_dp, 0.5_dp, -0.5_dp, & + -0.5_dp, 0.5_dp, 0.5_dp, & + 0.5_dp, 0.5_dp, 0.5_dp /), & + shape(bcc_mat)) + + + call matrix_inverse(fcc_mat,3,fcc_inv) + call matrix_inverse(bcc_mat,3,bcc_inv) max_basisnum = 0 basisnum(:) = 0 @@ -300,6 +319,8 @@ module elements select case(trim(adjustl(element_types(i)))) case('fcc') ng_node(i) = 8 + case('bcc') + ng_node(i) = 8 end select if(ng_node(i) > max_ng_node) max_ng_node = ng_node(i) @@ -345,7 +366,7 @@ module elements end select select case(trim(adjustl(type))) - case('fcc') + case('fcc','bcc') allocate(a_shape(8)) !Now loop over all the possible sites do it = 1, esize @@ -632,4 +653,4 @@ module elements end select end subroutine -end module elements \ No newline at end of file +end module elements diff --git a/src/mode_create.f90 b/src/mode_create.f90 index ffdfc05..545cea4 100644 --- a/src/mode_create.f90 +++ b/src/mode_create.f90 @@ -63,10 +63,17 @@ module mode_create do i = 1, 8 box_vert(:,i) = duplicate(:)*esize*lattice_space(:)*cubic_cell(:,i) + (origin(:)/lattice_parameter) end do - !Now get the rotated box vertex positions in lattice space. Should be integer units - box_lat_vert = int(matmul(fcc_inv, matmul(orient_inv, box_vert)))+1 + !Now get the rotated box vertex positions in lattice space. Should be integer units and get the new maxlen + select case(trim(adjustl(element_type))) + case('fcc') + box_lat_vert = int(matmul(fcc_inv, matmul(orient_inv, box_vert)))+1 + maxbd = maxval(matmul(orient,matmul(fcc_mat,box_lat_vert)),2) + case('bcc') + box_lat_vert = int(matmul(bcc_inv, matmul(orient_inv, box_vert)))+1 + maxbd = maxval(matmul(orient,matmul(bcc_mat,box_lat_vert)),2) + end select + !Find the new maxlen - maxbd = maxval(matmul(orient,matmul(fcc_mat,box_lat_vert)),2) do i = 1, 3 box_bd(2*i) = maxval(box_vert(i,:)) - 0.25_dp*lattice_space(i) box_bd(2*i-1) = origin(i)-0.25_dp*lattice_space(i) @@ -83,7 +90,12 @@ module mode_create box_vert(:,i) = (cubic_cell(:,i)*box_len(:) + origin(:))/lattice_parameter end do !Now get the rotated box vertex positions in lattice space. Should be integer units - box_lat_vert = int(matmul(fcc_inv, matmul(orient_inv, box_vert)))+1 + select case(trim(adjustl(element_type))) + case('fcc') + box_lat_vert = int(matmul(fcc_inv, matmul(orient_inv, box_vert)))+1 + case('bcc') + box_lat_vert = int(matmul(bcc_inv, matmul(orient_inv, box_vert)))+1 + end select !Now get the box_bd in lattice units do i = 1, 3 @@ -117,8 +129,9 @@ module mode_create !Call the build function with the correct transformation matrix select case(trim(adjustl(element_type))) case('fcc') - call build_with_rhomb(box_lat_vert, fcc_mat) + case('bcc') + call build_with_rhomb(box_lat_vert, bcc_mat) case default print *, "Element type ", trim(adjustl(element_type)), " not accepted in mode create, please specify a supported ", & "element type" @@ -270,13 +283,20 @@ module mode_create lattice_space(i) = 0.5_dp * lattice_space(i) !Check if one direction is 112 - else if ((is_equal(abs(orient(i,1)), abs(orient(i,2))).and.(is_equal(abs(orient(i,3)),2.0_dp*abs(orient(i,1))))).or.& - (is_equal(abs(orient(i,2)), abs(orient(i,3))).and.(is_equal(abs(orient(i,1)),2.0_dp*abs(orient(i,2))))).or.& - (is_equal(abs(orient(i,3)), abs(orient(i,1))).and.(is_equal(abs(orient(i,2)),2.0_dp*abs(orient(i,3))))))& - then + else if((is_equal(abs(orient(i,1)), abs(orient(i,2))).and.(is_equal(abs(orient(i,3)),2.0_dp*abs(orient(i,1))))).or.& + (is_equal(abs(orient(i,2)), abs(orient(i,3))).and.(is_equal(abs(orient(i,1)),2.0_dp*abs(orient(i,2))))).or.& + (is_equal(abs(orient(i,3)), abs(orient(i,1))).and.(is_equal(abs(orient(i,2)),2.0_dp*abs(orient(i,3))))))& + then lattice_space(i) = 0.5_dp * lattice_space(i) + end if + end do + case('bcc') + do i = 1, 3 + !Check if the direction is 111 + if((is_equal(abs(orient(i,1)),abs(orient(i,2)))).and.(is_equal(abs(orient(i,2)),abs(orient(i,3))))) then + lattice_space(i) = 0.5_dp * lattice_space(i) end if end do end select @@ -518,4 +538,4 @@ module mode_create end subroutine error_message -end module mode_create \ No newline at end of file +end module mode_create From e6d7741060527382721d9672b11d3342ac8d15fc Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Tue, 21 Apr 2020 13:25:55 -0400 Subject: [PATCH 02/60] Working changes to io.f90 --- src/io.f90 | 66 ++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 64 insertions(+), 2 deletions(-) diff --git a/src/io.f90 b/src/io.f90 index f929e29..1e1d956 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -161,7 +161,7 @@ module io !Calculate total atom number write_num = atom_num do i = 1,ele_num - if(type_ele(i) == 'fcc') write_num = write_num + size_ele(i)**3 + if((type_ele(i) == 'fcc').or.(type_ele(i) == 'bcc')) write_num = write_num + size_ele(i)**3 end do !Write total number of atoms + elements write(11, '(i16, a)') write_num, ' atoms' @@ -196,7 +196,7 @@ module io do i = 1, ele_num call interpolate_atoms(type_ele(i), size_ele(i), lat_ele(i), r_node(:,:,:,i), type_interp, r_interp) select case(trim(adjustl(type_ele(i)))) - case('fcc') + case('fcc','bcc') do iatom = 1, basisnum(lat_ele(i))*size_ele(i)**3 interp_num = interp_num+1 call apply_periodic(r_interp(:,iatom)) @@ -949,4 +949,66 @@ module io call set_max_esize end if end subroutine read_pycac + + subroutine read_cac(file, displace, temp_box_bd) + !This subroutine is used to read .cac files which are used with the lammpsCAC format + character(len=100), intent(in) :: file + real(kind=dp), dimension(3), intent(in) :: displace + real(kind = dp), dimension(6), intent(out) :: temp_box_bd + + 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) + + + !First open the file + open(unit=11, file=trim(adjustl(file)), action='read',position='rewind') + + !Read header information + read(11, *) textholder + read(11, *) textholder + + !Read number of elements + read(11, *) ele_in, textholder + read(11, *) type_in, textholder + + !Read box_boundaries + 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 useless information + read(11,*) textholder + read(11,*) textholder + + !Read atomic masses + do i = 1, type_in + read(11,*) j, mass, textholder + call ATOMMASSSPECIES(mass, atom_species) + call add_atom_type(atom_species, type_map(i)) + end do + + !Read useless info + do i = 1, 3 + read(11,*) textholder + end do + + !Start the reading loop + do i = 1, ele_in + read(11,*) j, ele, element_type, in_basis, esize + select case(trim(adjustl(element_type))) + case('Eight_Node') + !Read in all the data + do j = 1, 8*in_basis + read(11, *) inod, ibasis, in_basis_types(ibasis), r_in(:,ibasis,inod) + end do + + ! + end select + end do + + end subroutine read_cac end module io From b3e05da6a4e55e01df9de7dae899dea4b1cc8f7d Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Wed, 22 Apr 2020 12:52:37 -0400 Subject: [PATCH 03/60] Working changes for reading .cac files --- README.md | 5 ++--- src/call_option.f90 | 4 +++- src/elements.f90 | 38 +++++++++++++++++++++++++++++++++-- src/io.f90 | 49 +++++++++++++++++++++++++++++++++++---------- src/main.f90 | 5 +++++ 5 files changed, 84 insertions(+), 17 deletions(-) diff --git a/README.md b/README.md index 3455000..8f20ec6 100644 --- a/README.md +++ b/README.md @@ -191,7 +191,7 @@ This option creates a circular planar vacancy cluster of radius `radius` normal This option selects a group of either elements, nodes, atoms and applies some transformation to them. -`select_type` - Either `nodes`, `atoms`, `elements`, `nodes/atoms`, `all`. When using the option `nodes` only nodes which are within the group are selected, `elements` selects elements based on whether the element center is within the group, `nodes/atoms` selects both nodes and atoms for the group. `all` selects elements based on the element center and atoms based on their position. +`select_type` - Either `atoms`, `elements`,`both`. `elements` selects elements based on whether the element center is within the group, `nodes/atoms` selects both nodes and atoms for the group. `both` selects elements based on the element center and atoms based on their position. `group_shape` - Specifies what shape the group takes and dictates which options must be passed. Each shape requires different arguments and these arguments are represented by the placeholder `shape_arguments`. The accepted group shapes and arguments are below: @@ -230,7 +230,7 @@ This command wraps atoms back into the simulation cell as though periodic bounda **Remesh** ``` -remesh esize lattice_parameter lattice_type +remesh esize ``` This command remeshes the atoms/elements within the group to the new element size `esize`. Currently only accepts an `esize` of 2 which refines it to full atomistics. When remeshing to atomistics the group can contain any orientations of elements but when remeshing to different finite elements, the group must contain all atoms/elements with the same orientation. `lattice_parameter` is the lattice parameter for the elements within the group and `lattice_type` is the lattice type (integer) that these new elements will be assigned to. @@ -294,7 +294,6 @@ This command will delete all overlapping atoms within a specific cutoff radius ` This option is primarily used when reading data from non .mb formats. This code simply sets the orientation variable for the specified sub box `sbox`. **** - ## Position Specification Specifying positions in cacmb can be done through a variety of ways. Examples of each format is shown below. diff --git a/src/call_option.f90 b/src/call_option.f90 index ead7af0..b8cc3b8 100644 --- a/src/call_option.f90 +++ b/src/call_option.f90 @@ -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 \ No newline at end of file +end subroutine call_option diff --git a/src/elements.f90 b/src/elements.f90 index e9fc928..6265b3c 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -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 \ No newline at end of file + 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 diff --git a/src/io.f90 b/src/io.f90 index 1e1d956..22692e8 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -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 diff --git a/src/main.f90 b/src/main.f90 index 958a3c0..8d153ce 100644 --- a/src/main.f90 +++ b/src/main.f90 @@ -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 From 4038cab76fe4630e39710819423ce6ec11365302 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Thu, 23 Apr 2020 12:17:04 -0400 Subject: [PATCH 04/60] Latest working changes to read-CAC --- src/elements.f90 | 2 - src/io.f90 | 97 ++++++++++++++++++++++++++++++++++++++---------- 2 files changed, 77 insertions(+), 22 deletions(-) diff --git a/src/elements.f90 b/src/elements.f90 index 6265b3c..484057f 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -294,8 +294,6 @@ module elements integer :: i - max_ng_node = 0 - do i=1, n select case(trim(adjustl(element_types(i)))) case('fcc') diff --git a/src/io.f90 b/src/io.f90 index 22692e8..964a816 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -776,7 +776,7 @@ module io integer :: i, inod, ibasis, j, k, in_eles, in_atoms, ele_types, in_lat_num, in_atom_types, & atom_type_map(10), etype_map(10), etype, lat_type, new_lattice_map(10), & atom_type - real(kind=dp) :: newdisplace(3), r_in(3,1,8), r_in_atom(3), new_displace(3) + real(kind=dp) :: newdisplace(3), r_in(3,1,8), r_in_atom(3) character(len=100) :: textholder, in_lattype_map(10) character(len=2) :: atomic_element !First open the file @@ -950,7 +950,7 @@ module io end if end subroutine read_pycac - subroutine read_cac(file, displace, temp_box_bd) + subroutine read_lmpcac(file, displace, temp_box_bd) !This subroutine is used to read .cac files which are used with the lammpsCAC format character(len=100), intent(in) :: file real(kind=dp), dimension(3), intent(in) :: displace @@ -958,8 +958,8 @@ 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), lat_vec(3), in_ori(3,3) + integer :: i, j, k, 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,3), in_ori(3,3), temp_box_bd(6), newdisplace(3) !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 @@ -968,6 +968,9 @@ module io end if !Open the file open(unit=11, file=trim(adjustl(file)), action='read',position='rewind') + + !Now initialiaze some important variables + max_basis_num = 10 !Read header information read(11, *) textholder @@ -979,9 +982,38 @@ module io !Read box_boundaries 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,*) temp_box_bd(1:2), texholder + read(11,*) temp_box_bd(3:4), texholder + read(11,*) temp_box_bd(5:6), texholder + + !Shift the box boundaries if needed + do i = 1, 3 + if (abs(displace(i)) > lim_zero) then + newdisplace(i) = displace(i) - temp_box_bd(2*i-1) + else + newdisplace(i)=displace(i) + end if + 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 + + !Grow box boundaries + call grow_box(temp_box_bd) + + !Allocate sub_box + if (sub_box_num == 0) then + call alloc_sub_box(1) + else + call grow_sub_box(1) + end if + + !Because orientations and other needed sub_box information isn't really + !present within the .cac file we just default a lot of it. + sub_box_ori(:,:,sub_box_num+1) = identity_mat(3) + sub_box_bd(:, sub_box_num+1) = temp_box_bd + sub_box_num = sub_box_num + 1 + + !Read useless information read(11,*) textholder read(11,*) textholder @@ -1001,25 +1033,50 @@ module io !Start the reading loop do i = 1, ele_in read(11,*) j, ele, element_type, in_basis, esize + !Check to see if we need to grow the max_basis_num select case(trim(adjustl(element_type))) case('Eight_Node') - !Read in all the data - do j = 1, 8*in_basis - read(11, *) inod, ibasis, in_basis_types(ibasis), r_in(:,ibasis,inod) + !Read in all the data + do j = 1, 8*in_basis + read(11, *) inod, ibasis, in_basis_types(ibasis), r_in(:,ibasis,inod) + end do + + !Now calculate the lattice vectors and shift the nodal points from the corners to the center of the unit cell + !Please check the nodal numbering figure in the readme in order to understand which nodes are used for the + !calculation + lat_vec(:,1) = (r_node(:,1,2) - r_node(:,1,1))/esize + lat_vec(:,2) = (r_node(:,1,4) - r_node(:,1,1))/esize + lat_vec(:,3) = (r_node(:,1,5) - r_node(:,1,1))/esize + + !Now shift all the nodal positions + select case(trim(adjustl(in_lattice_type))) + case('fcc','FCC') + do ibasis = 1, in_basis + r_in(:,ibasis,1) = r_in(:,ibasis,1) + lat_vec(:,1) + lat_vec(:,2) + lat_vec(:,3) + newdisplace + r_in(:,ibasis,2) = r_in(:,ibasis,2) - lat_vec(:,1) + lat_vec(:,2) + lat_vec(:,3) + newdisplace + r_in(:,ibasis,3) = r_in(:,ibasis,3) - lat_vec(:,1) - lat_vec(:,2) + lat_vec(:,3) + newdisplace + r_in(:,ibasis,4) = r_in(:,ibasis,4) + lat_vec(:,1) - lat_vec(:,2) + lat_vec(:,3) + newdisplace + r_in(:,ibasis,5) = r_in(:,ibasis,5) + lat_vec(:,1) + lat_vec(:,2) - lat_vec(:,3) + newdisplace + r_in(:,ibasis,6) = r_in(:,ibasis,6) - lat_vec(:,1) + lat_vec(:,2) - lat_vec(:,3) + newdisplace + r_in(:,ibasis,7) = r_in(:,ibasis,7) - lat_vec(:,1) - lat_vec(:,2) - lat_vec(:,3) + newdisplace + r_in(:,ibasis,8) = r_in(:,ibasis,8) + lat_vec(:,1) - lat_vec(:,2) - lat_vec(:,3) + newdisplace 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) - - + case default + print *, in_lattice_type, " is not an accepted lattice type. Please select from: fcc" + end select + !Now map it to either an existing or new lattice type + call lattice_map(in_basis, in_basis_types, 8, in_lapa, lat_type) + + !Now add the element + call add_element(in_lattice_type, esize, lat_type, sub_box_num, r_in) + + case('Atom') + read(11, *) inod, ibasis, in_basis_types(ibasis), r_in(:,1,1) + call add_atom(in_basis_types(ibasis), sub_box_num, r_in(:,1,1)) end select end do - end subroutine read_cac + end subroutine read_lmpcac subroutine set_cac(apos) !This code parses input values From 3a59b23be786278c6bca02ec0de2f27a240849d0 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Sat, 25 Apr 2020 14:42:57 -0400 Subject: [PATCH 05/60] Working bcc crystal structure when viewing in .lmp or .vtk format --- src/elements.f90 | 14 +++++++++----- src/io.f90 | 6 +++++- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/src/elements.f90 b/src/elements.f90 index 5240640..7e7f1c5 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -92,14 +92,15 @@ module elements 0.5_dp, -0.5_dp, 0.5_dp, & 1.0_dp, 0.0_dp, 1.0_dp, & 0.5_dp, 0.5_dp, 0.5_dp, & - 0.5_dp, 0.5_dp, -0.5_dp, & + -0.5_dp, 0.5_dp, 0.5_dp, & 0.0_dp, 0.0_dp, 1.0_dp, & - 0.5_dp, 0.5_dp, 1.5_dp /), & + 0.5_dp, 0.5_dp, 1.5_dp, & + 0.0_dp, 1.0_dp, 1.0_dp /), & shape(bcc_cell)) - bcc_mat = reshape((/ 0.5_dp, 0.5_dp, -0.5_dp, & - -0.5_dp, 0.5_dp, 0.5_dp, & - 0.5_dp, 0.5_dp, 0.5_dp /), & + bcc_mat = reshape((/ 0.5_dp, -0.5_dp, 0.5_dp, & + 0.5_dp, 0.5_dp, 0.5_dp, & + -0.5_dp, 0.5_dp, 0.5_dp /), & shape(bcc_mat)) @@ -148,6 +149,9 @@ module elements end if cell_mat(:, 1:8) = fcc_cell + adjustVar(:,1:8) cell_mat(:,1:8) = lapa * ((esize-1)*matmul(orient_mat, cell_mat(:,1:8))) + case('bcc') + cell_mat(:,1:8) = bcc_cell + cell_mat(:,1:8) = lapa* ((esize-1)*matmul(orient_mat, cell_mat(:,1:8))) case default print *, "Element type ", trim(ele_type), " currently not accepted" stop diff --git a/src/io.f90 b/src/io.f90 index f929e29..e46f941 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -162,7 +162,9 @@ module io write_num = atom_num do i = 1,ele_num if(type_ele(i) == 'fcc') write_num = write_num + size_ele(i)**3 + if(type_ele(i) == 'bcc') write_num = write_num + size_ele(i)**3 end do + !Write total number of atoms + elements write(11, '(i16, a)') write_num, ' atoms' !Write number of atom types @@ -196,7 +198,7 @@ module io do i = 1, ele_num call interpolate_atoms(type_ele(i), size_ele(i), lat_ele(i), r_node(:,:,:,i), type_interp, r_interp) select case(trim(adjustl(type_ele(i)))) - case('fcc') + case('fcc','bcc') do iatom = 1, basisnum(lat_ele(i))*size_ele(i)**3 interp_num = interp_num+1 call apply_periodic(r_interp(:,iatom)) @@ -339,6 +341,7 @@ module io end do close(11) + !Now we write the vtk file for the elements open(unit=11, file='cg_'//trim(adjustl(file)), action='write', status='replace',position='rewind') write(11,1) write(11,2) @@ -357,6 +360,7 @@ module io write(11,5) ele_num do i = 1, ele_num if(trim(adjustl(type_ele(i))) == 'fcc') write(11, '(i16)') 12 + if(trim(adjustl(type_ele(i))) == 'bcc') write(11, '(i16)') 12 end do write(11,12) ele_num write(11,20) From b28875b3e15669af54a0d6ad142fe21aaddd64b8 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Wed, 20 May 2020 09:51:02 -0400 Subject: [PATCH 06/60] Added keyword for group selection based on nodal position instead of centroid --- src/opt_group.f90 | 62 ++++++++++++++++++++++++++++++++--------------- 1 file changed, 42 insertions(+), 20 deletions(-) diff --git a/src/opt_group.f90 b/src/opt_group.f90 index dd5a1fb..45029f2 100644 --- a/src/opt_group.f90 +++ b/src/opt_group.f90 @@ -11,7 +11,7 @@ module opt_group integer :: group_ele_num, group_atom_num, remesh_size,normal, dim1, dim2 character(len=15) :: type, shape !Type indicates what element type is selected and shape is the group shape real(kind=dp) :: block_bd(6), centroid(3), vertices(3,3),disp_vec(3), tip_radius, bwidth - logical :: displace, delete, max_remesh, refine + logical :: displace, delete, max_remesh, refine, group_nodes integer, allocatable :: element_index(:), atom_index(:) @@ -334,6 +334,8 @@ module opt_group max_remesh =.true. case('delete') delete=.true. + case('nodes') + group_nodes=.true. case default !If it isn't an available option to opt_disl then we just exit exit @@ -363,29 +365,49 @@ module opt_group !Check the type to see whether we need to find the elements within the group select case(trim(adjustl(type))) case('elements', 'both') - do i = 1, ele_num - r_center(:) = 0.0_dp - do inod = 1, ng_node(lat_ele(i)) - do ibasis = 1, basisnum(lat_ele(i)) - r_center = r_center + r_node(:,ibasis,inod,i)/(basisnum(lat_ele(i))*ng_node(lat_ele(i))) + if(.not.(group_nodes)) then + do i = 1, ele_num + r_center(:) = 0.0_dp + do inod = 1, ng_node(lat_ele(i)) + do ibasis = 1, basisnum(lat_ele(i)) + r_center = r_center + r_node(:,ibasis,inod,i)/(basisnum(lat_ele(i))*ng_node(lat_ele(i))) + end do end do - end do - if (in_group(r_center)) then - group_ele_num = group_ele_num + 1 - if(group_ele_num > size(element_index)) then - allocate(resize_array(size(element_index) + 1024)) - resize_array(1:group_ele_num-1) = element_index - resize_array(group_ele_num:) = 0 - call move_alloc(resize_array, element_index) - end if + if (in_group(r_center)) then + group_ele_num = group_ele_num + 1 + if(group_ele_num > size(element_index)) then + allocate(resize_array(size(element_index) + 1024)) + resize_array(1:group_ele_num-1) = element_index + resize_array(group_ele_num:) = 0 + call move_alloc(resize_array, element_index) + end if - element_index(group_ele_num) = i - end if - end do + element_index(group_ele_num) = i + end if + end do + else if(group_nodes) then + eleloop:do i = 1, ele_num + r_center(:) = 0.0_dp + do inod = 1, ng_node(lat_ele(i)) + do ibasis = 1, basisnum(lat_ele(i)) + if (in_group(r_node(:,ibasis,inod,i))) then + group_ele_num = group_ele_num + 1 + if(group_ele_num > size(element_index)) then + allocate(resize_array(size(element_index) + 1024)) + resize_array(1:group_ele_num-1) = element_index + resize_array(group_ele_num:) = 0 + call move_alloc(resize_array, element_index) + end if + element_index(group_ele_num) = i + cycle eleloop + end if + end do + end do + end do eleloop + end if end select - - !Check the type to see if we need to find the atoms within the group + !Check the type to see if we need to find the atoms within the group select case(trim(adjustl(type))) case('atoms','both') do i = 1, atom_num From 8cb9787ea2691df860f94d306ecfde747eaef9c9 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Wed, 20 May 2020 11:07:21 -0400 Subject: [PATCH 07/60] Added functionality so you can refine elements prior to operating on the group --- src/opt_group.f90 | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/src/opt_group.f90 b/src/opt_group.f90 index 45029f2..c3edc8a 100644 --- a/src/opt_group.f90 +++ b/src/opt_group.f90 @@ -37,16 +37,27 @@ module opt_group call parse_group(arg_pos) - call get_group !Now call the transformation functions for the group - if(displace) call displace_group + if(refine) then + call get_group + call refine_group + end if - if(remesh_size > 0) call remesh_group + if(displace)then + call get_group + call displace_group + end if - if(delete) call delete_group + if(delete)then + call get_group + call delete_group + end if - if(refine) call refine_group + if(remesh_size > 0)then + call get_group + call remesh_group + end if end subroutine group @@ -360,7 +371,11 @@ module opt_group return end select - !Allocate variables to arbitrary size + !Reset group if needed + if(allocated(element_index)) deallocate(element_index,atom_index) + + group_ele_num = 0 + group_atom_num = 0 allocate(element_index(1024), atom_index(1024)) !Check the type to see whether we need to find the elements within the group select case(trim(adjustl(type))) From 8693d7aaa9424573a5233ead520cbcecabf7452d Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Wed, 20 May 2020 11:59:49 -0400 Subject: [PATCH 08/60] Initial testing of efill code --- src/mode_create.f90 | 132 +++++++++++++++++++++++++++----------------- 1 file changed, 81 insertions(+), 51 deletions(-) diff --git a/src/mode_create.f90 b/src/mode_create.f90 index ed60daf..546e345 100644 --- a/src/mode_create.f90 +++ b/src/mode_create.f90 @@ -14,8 +14,8 @@ module mode_create 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), duplicate(3) integer :: esize, 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 + basis_pos(3,10), esize_nums, esize_index(10) + logical :: dup_flag, dim_flag, efill real(kind=dp), allocatable :: r_lat(:,:,:), r_atom_lat(:,:) public @@ -26,7 +26,7 @@ module mode_create integer, intent(out) :: arg_pos - integer :: i, ibasis, inod + integer :: i, ibasis, inod, ei, curr_esize real(kind=dp), allocatable :: r_node_temp(:,:,:) print *, '-----------------------Mode Create---------------------------' @@ -148,7 +148,15 @@ module mode_create 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, 1, r_node_temp) + + curr_esize=esize + do ei = 1, esize_nums + if(i < esize_index(ei)) then + call add_element(element_type, curr_esize, 1, 1, r_node_temp) + exit + end if + curr_esize=curr_esize/2 + 1 + end do end do end if end if @@ -248,6 +256,9 @@ module mode_create end do end do + case('efill') + arg_pos=arg_pos+1 + efill = .true. case default !If it isn't an option then you have to exit arg_pos = arg_pos -1 @@ -314,7 +325,7 @@ module mode_create 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, ele(3,8), rzero(3), & - vlat(3), temp_lat(3,8), m, n, o + vlat(3), temp_lat(3,8), m, n, o, curr_esize, ei real(kind=dp) :: v(3), temp_nodes(3,1,8) logical, allocatable :: lat_points(:,:,:) logical :: node_in_bd(8) @@ -322,6 +333,19 @@ module mode_create !Do some value initialization max_esize = esize + !Now initialize the code if we are doing efill. This means calculate the number of times we can divide the esize in 2 with + !the value still being > 7 + if(efill) then + curr_esize=esize + esize_nums=0 + do while (curr_esize >= 7) + esize_nums=esize_nums+1 + curr_esize = curr_esize/2 + 1 + end do + else + esize_nums=1 + end if + !First find the bounding lattice points (min and max points for the box in each dimension) numlatpoints = 1 do i = 1, 3 @@ -415,60 +439,66 @@ module mode_create !Now build the finite element region lat_ele_num = 0 lat_atom_num = 0 - allocate(r_lat(3,8,numlatpoints/esize)) - - !Redefined the second 3 indices as the number of elements that fit in the bounds - do i = 1, 3 - bd_in_array(3+i) = bd_in_array(i)/esize - end do - - !Now start the element at rzero - do inod=1, 8 - ele(:,inod) = ele(:,inod) + rzero - end do - do iz = -bd_in_array(6), bd_in_array(6) - do iy = -bd_in_array(5), bd_in_array(5) - do ix = -bd_in_array(4), bd_in_array(4) - node_in_bd(:) = .false. - temp_nodes(:,:,:) = 0.0_dp - temp_lat(:,:) = 0 - do inod = 1, 8 - vlat= ele(:,inod) + (/ ix*(esize), iy*(esize), iz*(esize) /) - !Transform point back to real space for easier checking - ! v = matmul(orient, matmul(transform_matrix,v)) - do i = 1,3 - v(i) = real(vlat(i) + bd_in_lat(2*i-1) - 5) - end do - temp_nodes(:,1, inod) = matmul(orient, matmul(transform_matrix, v)) - temp_lat(:,inod) = vlat + curr_esize=esize/(2**(esize_nums-1)) + 1 + allocate(r_lat(3,8,numlatpoints/curr_esize)) - !Check to see if the lattice point values are greater then the array limits - if(any(vlat > shape(lat_points)).or.any(vlat < 1)) then - continue - !If within array boundaries check to see if it is a lattice point - else if(lat_points(vlat(1),vlat(2),vlat(3))) then - node_in_bd(inod) = .true. - end if - end do + curr_esize=esize + do ei = 1, esize_nums + ele(:,:) = (curr_esize-1) * cubic_cell(:,:) + !Redefined the second 3 indices as the number of elements that fit in the bounds + do i = 1, 3 + bd_in_array(3+i) = bd_in_array(i)/curr_esize + end do - if(all(node_in_bd)) then - lat_ele_num = lat_ele_num+1 - r_lat(:,:,lat_ele_num) = temp_nodes(:,1,:) - - !Now set all the lattice points contained within an element to false - do o = minval(temp_lat(3,:)), maxval(temp_lat(3,:)) - do n = minval(temp_lat(2,:)), maxval(temp_lat(2,:)) - do m = minval(temp_lat(1,:)), maxval(temp_lat(1,:)) - lat_points(m,n,o) = .false. - end do + !Now start the element at rzero + do inod=1, 8 + ele(:,inod) = ele(:,inod) + rzero + end do + do iz = -bd_in_array(6), bd_in_array(6) + do iy = -bd_in_array(5), bd_in_array(5) + do ix = -bd_in_array(4), bd_in_array(4) + node_in_bd(:) = .false. + temp_nodes(:,:,:) = 0.0_dp + temp_lat(:,:) = 0 + do inod = 1, 8 + vlat= ele(:,inod) + (/ ix*(curr_esize), iy*(curr_esize), iz*(curr_esize) /) + !Transform point back to real space for easier checking + ! v = matmul(orient, matmul(transform_matrix,v)) + do i = 1,3 + v(i) = real(vlat(i) + bd_in_lat(2*i-1) - 5) end do + temp_nodes(:,1, inod) = matmul(orient, matmul(transform_matrix, v)) + temp_lat(:,inod) = vlat + + !Check to see if the lattice point values are greater then the array limits + if(any(vlat > shape(lat_points)).or.any(vlat < 1)) then + continue + !If within array boundaries check to see if it is a lattice point + else if(lat_points(vlat(1),vlat(2),vlat(3))) then + node_in_bd(inod) = .true. + end if end do - end if + if(all(node_in_bd)) then + lat_ele_num = lat_ele_num+1 + r_lat(:,:,lat_ele_num) = temp_nodes(:,1,:) + + !Now set all the lattice points contained within an element to false + do o = minval(temp_lat(3,:)), maxval(temp_lat(3,:)) + do n = minval(temp_lat(2,:)), maxval(temp_lat(2,:)) + do m = minval(temp_lat(1,:)), maxval(temp_lat(1,:)) + lat_points(m,n,o) = .false. + end do + end do + end do + + end if + end do end do end do + esize_index(ei) = lat_ele_num + curr_esize=curr_esize/2 + 1 end do - !Now figure out how many lattice points could not be contained in elements allocate(r_atom_lat(3,count(lat_points))) lat_atom_num = 0 From 5dda0e3b81130486e847bb50a4252b0ce837d891 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Wed, 20 May 2020 15:09:12 -0400 Subject: [PATCH 09/60] Added efill option --- README.md | 17 +++++++---------- src/mode_create.f90 | 9 ++++----- 2 files changed, 11 insertions(+), 15 deletions(-) diff --git a/README.md b/README.md index 5bdd240..257393e 100644 --- a/README.md +++ b/README.md @@ -45,16 +45,6 @@ Default orientation is `[100] [010] [001]`. If this keyword is present then the *Example:* `orient [-112] [110] [-11-1]` -**Basis** - -``` -basis num atom_name x y z -``` - -Default basis has `atom_name = name` with position (0,0,0). If used then the `atom_name x y z` must be include `num` times. - -*Example:* `basis 2 Mg 0 0 0 Mg 0.5 0.288675 0.81647` - **Duplicate** ``` @@ -92,6 +82,13 @@ basis basisnum bname bx by bz ``` This function allows you to define a custom basis. `bname bx by bz` must be repeated `basisnum` times. + +**efill** +``` +efill +``` +This command will rerun the creation algorithm with multiple times starting with an esize of `esize` and decreasing it by half on every iteration in an effort to maximize the reduction of degrees of freedom in the system. + ### Mode Convert ``` diff --git a/src/mode_create.f90 b/src/mode_create.f90 index 546e345..f33efdf 100644 --- a/src/mode_create.f90 +++ b/src/mode_create.f90 @@ -151,11 +151,11 @@ module mode_create curr_esize=esize do ei = 1, esize_nums - if(i < esize_index(ei)) then + if(i <= esize_index(ei)) then call add_element(element_type, curr_esize, 1, 1, r_node_temp) exit end if - curr_esize=curr_esize/2 + 1 + curr_esize=esize/(2**ei) - 1 end do end do end if @@ -257,7 +257,6 @@ module mode_create end do case('efill') - arg_pos=arg_pos+1 efill = .true. case default !If it isn't an option then you have to exit @@ -340,7 +339,7 @@ module mode_create esize_nums=0 do while (curr_esize >= 7) esize_nums=esize_nums+1 - curr_esize = curr_esize/2 + 1 + curr_esize = esize/(2**esize_nums) -1 end do else esize_nums=1 @@ -497,7 +496,7 @@ module mode_create end do end do esize_index(ei) = lat_ele_num - curr_esize=curr_esize/2 + 1 + curr_esize=esize/(2**ei) - 1 end do !Now figure out how many lattice points could not be contained in elements allocate(r_atom_lat(3,count(lat_points))) From e5eec7a7cdba1e60082e69c0e344b9ea17209477 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Tue, 26 May 2020 11:51:46 -0400 Subject: [PATCH 10/60] Added random option which can be used to create vacancy fields --- README.md | 9 +++++++++ src/opt_group.f90 | 44 +++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 50 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index 257393e..93955f4 100644 --- a/README.md +++ b/README.md @@ -258,6 +258,15 @@ delete This command deletes all selected atoms and elements within the group. + +**Random** +``` +random n +``` + +This command selects `n` random atoms and `n` random elements within your group bounds. If using group type `atoms` or `elements` then only `n` random atoms or elements are selected. This random atoms/elements then form the new group. + + ### Option overwrite ``` diff --git a/src/opt_group.f90 b/src/opt_group.f90 index c3edc8a..f0bb067 100644 --- a/src/opt_group.f90 +++ b/src/opt_group.f90 @@ -8,7 +8,7 @@ module opt_group use box implicit none - integer :: group_ele_num, group_atom_num, remesh_size,normal, dim1, dim2 + integer :: group_ele_num, group_atom_num, remesh_size,normal, dim1, dim2, random_num character(len=15) :: type, shape !Type indicates what element type is selected and shape is the group shape real(kind=dp) :: block_bd(6), centroid(3), vertices(3,3),disp_vec(3), tip_radius, bwidth logical :: displace, delete, max_remesh, refine, group_nodes @@ -27,6 +27,7 @@ module opt_group group_ele_num = 0 group_atom_num = 0 remesh_size=0 + random_num=0 displace=.false. delete=.false. max_remesh=.false. @@ -347,6 +348,11 @@ module opt_group delete=.true. case('nodes') group_nodes=.true. + case('random') + arg_pos = arg_pos + 1 + call get_command_argument(arg_pos, textholder, arglen) + if (arglen==0) stop "Missing number of random atoms in group command" + read(textholder, *) random_num case default !If it isn't an available option to opt_disl then we just exit exit @@ -357,15 +363,18 @@ module opt_group subroutine get_group !This subroutine finds all elements and/or atoms within the group boundaries !specified by the user. - integer :: i, j, inod, ibasis + integer :: i, j, inod, ibasis, temp integer, allocatable :: resize_array(:) - real(kind=dp) :: r_center(3) + real(kind=dp) :: r_center(3), rand select case(trim(adjustl(shape))) case('block') print *, "Group has block shape with boundaries: ", block_bd case ('wedge') print *, "Group has wedge shape with dim1", dim1, "and dim2", dim2, "and vertices ", vertices + case ('notch') + print *, "Group has notch shape with dim1", dim1, "and dim2", dim2, " tip radius ", tip_radius, "and vertices ", & + vertices case('id') print *, 'Group contains ', group_ele_num, " elements and ", group_atom_num, " atoms." return @@ -401,6 +410,7 @@ module opt_group element_index(group_ele_num) = i end if end do + else if(group_nodes) then eleloop:do i = 1, ele_num r_center(:) = 0.0_dp @@ -421,6 +431,21 @@ module opt_group end do end do eleloop end if + + if(random_num > 0) then + !If we have the random option enabled then we select random_num number of elements from the group and overwrite + !the group with those elements + do i = 1, random_num + call random_number(rand) + j = i + floor((group_ele_num+1-i)*rand) + temp = element_index(j) + element_index(j) = element_index(i) + element_index(i) = temp + end do + + group_ele_num = random_num + end if + end select !Check the type to see if we need to find the atoms within the group select case(trim(adjustl(type))) @@ -438,6 +463,19 @@ module opt_group atom_index(group_atom_num) = i end if end do + if(random_num > 0) then + !If we have the random option enabled then we select random_num number of atom from the group and overwrite + !the group with those atom + do i = 1, random_num + call random_number(rand) + j = i + floor((group_atom_num+1-i)*rand) + temp = atom_index(j) + atom_index(j) = atom_index(i) + atom_index(i) = temp + end do + + group_atom_num = random_num + end if end select j = 0 From 080f19d6440a48fbabd6166fa7651b22e15883ce Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Tue, 26 May 2020 17:42:48 -0400 Subject: [PATCH 11/60] Update .xyz file format to include element and atom files --- src/io.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/io.f90 b/src/io.f90 index d178baf..5ee7c7d 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -133,14 +133,14 @@ module io do i = 1, ele_num do inod = 1, ng_node(lat_ele(i)) do ibasis = 1, basisnum(lat_ele(i)) - write(11, '(i16, 3f23.15)') basis_type(ibasis,lat_ele(i)), r_node(:,ibasis,inod,i) + write(11, '(2i16, 3f23.15)') basis_type(ibasis,lat_ele(i)), 0, r_node(:,ibasis,inod,i) end do end do end do !Write atom positions do i = 1, atom_num - write(11, '(i16, 3f23.15)') type_atom(i), r_atom(:,i) + write(11, '(2i16, 3f23.15)') type_atom(i), 1, r_atom(:,i) end do !Finish writing From aef9da49be23a10f9e9bbfcd8a4f1cbf7386966f Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Tue, 26 May 2020 17:43:12 -0400 Subject: [PATCH 12/60] Added greater range of element sizes --- src/mode_create.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/mode_create.f90 b/src/mode_create.f90 index f33efdf..ca7331f 100644 --- a/src/mode_create.f90 +++ b/src/mode_create.f90 @@ -155,7 +155,7 @@ module mode_create call add_element(element_type, curr_esize, 1, 1, r_node_temp) exit end if - curr_esize=esize/(2**ei) - 1 + curr_esize=curr_esize-2 end do end do end if @@ -339,7 +339,7 @@ module mode_create esize_nums=0 do while (curr_esize >= 7) esize_nums=esize_nums+1 - curr_esize = esize/(2**esize_nums) -1 + curr_esize = curr_esize -2 end do else esize_nums=1 @@ -438,7 +438,7 @@ module mode_create !Now build the finite element region lat_ele_num = 0 lat_atom_num = 0 - curr_esize=esize/(2**(esize_nums-1)) + 1 + curr_esize=esize - 2*(esize_nums-1) allocate(r_lat(3,8,numlatpoints/curr_esize)) curr_esize=esize @@ -496,7 +496,7 @@ module mode_create end do end do esize_index(ei) = lat_ele_num - curr_esize=esize/(2**ei) - 1 + curr_esize=curr_esize-2 end do !Now figure out how many lattice points could not be contained in elements allocate(r_atom_lat(3,count(lat_points))) From 43025d0b67a3778f373e10f08d36c4ed7f3993fe Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Wed, 27 May 2020 14:37:30 -0400 Subject: [PATCH 13/60] Quick fix to efill code --- src/mode_create.f90 | 15 ++++----------- 1 file changed, 4 insertions(+), 11 deletions(-) diff --git a/src/mode_create.f90 b/src/mode_create.f90 index ca7331f..5c347ab 100644 --- a/src/mode_create.f90 +++ b/src/mode_create.f90 @@ -18,6 +18,7 @@ module mode_create logical :: dup_flag, dim_flag, efill real(kind=dp), allocatable :: r_lat(:,:,:), r_atom_lat(:,:) + integer, allocatable :: elat(:) public contains @@ -149,14 +150,7 @@ module mode_create end do end do - curr_esize=esize - do ei = 1, esize_nums - if(i <= esize_index(ei)) then - call add_element(element_type, curr_esize, 1, 1, r_node_temp) - exit - end if - curr_esize=curr_esize-2 - end do + call add_element(element_type, elat(i), 1, 1, r_node_temp) end do end if end if @@ -439,7 +433,7 @@ module mode_create lat_ele_num = 0 lat_atom_num = 0 curr_esize=esize - 2*(esize_nums-1) - allocate(r_lat(3,8,numlatpoints/curr_esize)) + allocate(r_lat(3,8,numlatpoints/curr_esize), elat(numlatpoints/curr_esize)) curr_esize=esize do ei = 1, esize_nums @@ -481,7 +475,7 @@ module mode_create if(all(node_in_bd)) then lat_ele_num = lat_ele_num+1 r_lat(:,:,lat_ele_num) = temp_nodes(:,1,:) - + elat(lat_ele_num) = curr_esize !Now set all the lattice points contained within an element to false do o = minval(temp_lat(3,:)), maxval(temp_lat(3,:)) do n = minval(temp_lat(2,:)), maxval(temp_lat(2,:)) @@ -495,7 +489,6 @@ module mode_create end do end do end do - esize_index(ei) = lat_ele_num curr_esize=curr_esize-2 end do !Now figure out how many lattice points could not be contained in elements From 65c2b380cd4936b066938dbeae866cefb7bfdd31 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Wed, 27 May 2020 14:53:44 -0400 Subject: [PATCH 14/60] Added flip option to group to invert group selection --- README.md | 24 +++++++++++++++++++----- src/opt_group.f90 | 11 +++++++---- 2 files changed, 26 insertions(+), 9 deletions(-) diff --git a/README.md b/README.md index 93955f4..4c4e5ed 100644 --- a/README.md +++ b/README.md @@ -185,15 +185,15 @@ This option creates a circular planar vacancy cluster of radius `radius` normal `-group select_type group_shape shape_arguments additional keywords` -This option selects a group of either elements, nodes, atoms and applies some transformation to them. +This option selects a group of either elements or atoms and applies some transformation to them. -`select_type` - Either `nodes`, `atoms`, `elements`, `nodes/atoms`, `all`. When using the option `nodes` only nodes which are within the group are selected, `elements` selects elements based on whether the element center is within the group, `nodes/atoms` selects both nodes and atoms for the group. `all` selects elements based on the element center and atoms based on their position. + `select_type` - Either `atoms`, `elements`, or 'both'. `elements` selects elements based on whether the element center is within the group. `both` selects elements based on the element center and atoms based on their position. `group_shape` - Specifies what shape the group takes and dictates which options must be passed. Each shape requires different arguments and these arguments are represented by the placeholder `shape_arguments`. The accepted group shapes and arguments are below: *Block:* -`-group nodes block xlo xhi ylo yhi zlo zhi` +`-group atoms block xlo xhi ylo yhi zlo zhi` This selects a group residing in a block with edges perpendicular to the simulation cell. The block boundaries are given by `xlo xhi ylo yhi zlo zhi`. @@ -201,7 +201,7 @@ This selects a group residing in a block with edges perpendicular to the simulat *Wedge:* -`-group nodes wedge dim1 dim2 bx by bz bw` +`-group atoms wedge dim1 dim2 bx by bz bw` This selects a group which are within a wedge shape. The options are given as follows: `dim1` - The dimension containing the plane normal of the wedge base. `dim2` - The thickness dimension. Wedge groups are currently required to span the entire cell thickness in one dimensions which is normal to the triangular face. This through thickness dimension is dim2. @@ -210,7 +210,7 @@ This selects a group which are within a wedge shape. The options are given as fo *Notch:* -`-group nodes notch dim1 dim2 bx by bz bw tr` +`-group atoms notch dim1 dim2 bx by bz bw tr` This shape is similar to a wedge shape except instead of becoming atomically sharp, it finishes in a rounded tip with tip radius `tr`. Options are as follows. `dim1` - The dimension containing the plane normal of the wedge base. `dim2` - The thickness dimension. Wedge groups are currently required to span the entire cell thickness in one dimensions which is normal to the triangular face. This through thickness dimension is dim2. @@ -266,7 +266,21 @@ random n This command selects `n` random atoms and `n` random elements within your group bounds. If using group type `atoms` or `elements` then only `n` random atoms or elements are selected. This random atoms/elements then form the new group. +**Nodes** +``` +nodes +``` + +This keyword changes the selection criteria when using `elements` or `both` to element nodes instead of element centroids. + +**Flip** + +``` +flip +``` + +This keyword changes the group selection criteria from the atoms/elements inside a region to the atoms/elements outside the group. ### Option overwrite ``` diff --git a/src/opt_group.f90 b/src/opt_group.f90 index f0bb067..080d0e6 100644 --- a/src/opt_group.f90 +++ b/src/opt_group.f90 @@ -11,7 +11,7 @@ module opt_group integer :: group_ele_num, group_atom_num, remesh_size,normal, dim1, dim2, random_num character(len=15) :: type, shape !Type indicates what element type is selected and shape is the group shape real(kind=dp) :: block_bd(6), centroid(3), vertices(3,3),disp_vec(3), tip_radius, bwidth - logical :: displace, delete, max_remesh, refine, group_nodes + logical :: displace, delete, max_remesh, refine, group_nodes, flip integer, allocatable :: element_index(:), atom_index(:) @@ -32,6 +32,7 @@ module opt_group delete=.false. max_remesh=.false. refine = .false. + flip = .false. if(allocated(element_index)) deallocate(element_index) if(allocated(atom_index)) deallocate(atom_index) @@ -353,6 +354,8 @@ module opt_group call get_command_argument(arg_pos, textholder, arglen) if (arglen==0) stop "Missing number of random atoms in group command" read(textholder, *) random_num + case('flip') + flip=.true. case default !If it isn't an available option to opt_disl then we just exit exit @@ -398,7 +401,7 @@ module opt_group end do end do - if (in_group(r_center)) then + if (in_group(r_center).neqv.flip) then group_ele_num = group_ele_num + 1 if(group_ele_num > size(element_index)) then allocate(resize_array(size(element_index) + 1024)) @@ -416,7 +419,7 @@ module opt_group r_center(:) = 0.0_dp do inod = 1, ng_node(lat_ele(i)) do ibasis = 1, basisnum(lat_ele(i)) - if (in_group(r_node(:,ibasis,inod,i))) then + if (in_group(r_node(:,ibasis,inod,i)).neqv.flip) then group_ele_num = group_ele_num + 1 if(group_ele_num > size(element_index)) then allocate(resize_array(size(element_index) + 1024)) @@ -451,7 +454,7 @@ module opt_group select case(trim(adjustl(type))) case('atoms','both') do i = 1, atom_num - if(in_group(r_atom(:,i))) then + if(in_group(r_atom(:,i)).neqv.flip) then group_atom_num = group_atom_num + 1 if (group_atom_num > size(atom_index)) then allocate(resize_array(size(atom_index) + 1024)) From d01d0b0c57504b6c596094b3e0d93c4feb3b0a63 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Fri, 29 May 2020 10:02:34 -0400 Subject: [PATCH 15/60] Quick fix to code to allow for reading in larger numbers of esizes --- src/io.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/io.f90 b/src/io.f90 index 5ee7c7d..cd3e3f6 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -774,7 +774,7 @@ module io real(kind = dp), dimension(6), intent(out) :: temp_box_bd integer :: i, inod, ibasis, j, k, in_eles, in_atoms, ele_types, in_lat_num, in_atom_types, & - atom_type_map(10), etype_map(10), etype, lat_type, new_lattice_map(10), & + atom_type_map(100), etype_map(100), etype, lat_type, new_lattice_map(100), & atom_type real(kind=dp) :: newdisplace(3), r_in(3,1,8), r_in_atom(3), new_displace(3) character(len=100) :: textholder, in_lattype_map(10) From b52d7761e09795fc9fd050615d1edcb68a26dc75 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Tue, 2 Jun 2020 16:42:12 -0400 Subject: [PATCH 16/60] First working version of reading in .cac format. Works for two separate orientations --- src/call_option.f90 | 2 +- src/elements.f90 | 5 +++-- src/io.f90 | 54 +++++++++++++++++++++++++-------------------- src/main.f90 | 2 -- 4 files changed, 34 insertions(+), 29 deletions(-) diff --git a/src/call_option.f90 b/src/call_option.f90 index b8cc3b8..368e542 100644 --- a/src/call_option.f90 +++ b/src/call_option.f90 @@ -34,7 +34,7 @@ subroutine call_option(option, arg_pos) case('-delete') call run_delete(arg_pos) case('-set_cac') - arg_pos = arg_pos+3 + arg_pos=arg_pos +3 case default print *, 'Option ', trim(adjustl(option)), ' is not currently accepted.' stop 3 diff --git a/src/elements.f90 b/src/elements.f90 index 484057f..6252427 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -646,7 +646,7 @@ module elements 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 + if(basis_type(ibasis,j) /= in_btypes(ibasis)) cycle lat_loop end do lat_type = j exit lat_loop @@ -657,9 +657,10 @@ module elements if( lat_type == 0) then lattice_types = lattice_types + 1 basisnum(lattice_types) = in_bnum - basis_types(:,lattice_types) = in_btypes + basis_type(:,lattice_types) = in_btypes ng_node(lattice_types) = in_ngnodes lapa(lattice_types) = in_lapa + lat_type = lattice_types end if end subroutine lattice_map diff --git a/src/io.f90 b/src/io.f90 index 964a816..ab90f85 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -591,7 +591,7 @@ module io end if select case(temp_infile(scan(temp_infile,'.',.true.)+1:)) - case('restart', 'mb') + case('restart', 'mb', 'cac') infilenum=infilenum+1 infiles(infilenum) = temp_infile exit @@ -618,6 +618,8 @@ module io call read_mb(infiles(i), displace, temp_box_bd) case('restart') call read_pycac(infiles(i), displace, temp_box_bd) + case('cac') + call read_lmpcac(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" @@ -956,10 +958,11 @@ module io real(kind=dp), dimension(3), intent(in) :: displace real(kind = dp), dimension(6), intent(out) :: temp_box_bd - character(len=100) :: textholder, element_type, esize + character(len=100) :: textholder, element_type character(len=2) :: atom_species - integer :: i, j, k, 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,3), in_ori(3,3), temp_box_bd(6), newdisplace(3) + integer :: i, j, k, ele_in, type_in, type_map(10), in_basis, node_types(10,8), inod, ibasis, in_basis_types(10), esize, & + lat_type + real(kind=dp) :: mass, r_in(3,10,8), lat_vec(3,3), in_ori(3,3), newdisplace(3) !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 @@ -969,22 +972,21 @@ module io !Open the file open(unit=11, file=trim(adjustl(file)), action='read',position='rewind') - !Now initialiaze some important variables - max_basis_num = 10 + !Now initialiaze some important variables if they aren't defined + if (max_basisnum==0) max_basisnum = 10 + if (max_ng_node==0) max_ng_node=8 !Read header information read(11, *) textholder - read(11, *) textholder !Read number of elements read(11, *) ele_in, textholder read(11, *) type_in, textholder !Read box_boundaries - read(11,*) textholder - read(11,*) temp_box_bd(1:2), texholder - read(11,*) temp_box_bd(3:4), texholder - read(11,*) temp_box_bd(5:6), texholder + read(11,*) temp_box_bd(1:2), textholder + read(11,*) temp_box_bd(3:4), textholder + read(11,*) temp_box_bd(5:6), textholder !Shift the box boundaries if needed do i = 1, 3 @@ -1016,7 +1018,6 @@ module io !Read useless information read(11,*) textholder - read(11,*) textholder !Read atomic masses do i = 1, type_in @@ -1026,13 +1027,11 @@ module io end do !Read useless info - do i = 1, 3 - read(11,*) textholder - end do + read(11,*) textholder !Start the reading loop do i = 1, ele_in - read(11,*) j, ele, element_type, in_basis, esize + read(11,*) j, element_type, in_basis, esize !Check to see if we need to grow the max_basis_num select case(trim(adjustl(element_type))) case('Eight_Node') @@ -1044,10 +1043,10 @@ module io !Now calculate the lattice vectors and shift the nodal points from the corners to the center of the unit cell !Please check the nodal numbering figure in the readme in order to understand which nodes are used for the !calculation - lat_vec(:,1) = (r_node(:,1,2) - r_node(:,1,1))/esize - lat_vec(:,2) = (r_node(:,1,4) - r_node(:,1,1))/esize - lat_vec(:,3) = (r_node(:,1,5) - r_node(:,1,1))/esize - + lat_vec(:,1) = (r_in(:,1,2) - r_in(:,1,1))/(2*esize) + lat_vec(:,2) = (r_in(:,1,4) - r_in(:,1,1))/(2*esize) + lat_vec(:,3) = (r_in(:,1,5) - r_in(:,1,1))/(2*esize) + !Now shift all the nodal positions select case(trim(adjustl(in_lattice_type))) case('fcc','FCC') @@ -1068,7 +1067,7 @@ module io call lattice_map(in_basis, in_basis_types, 8, in_lapa, lat_type) !Now add the element - call add_element(in_lattice_type, esize, lat_type, sub_box_num, r_in) + call add_element(in_lattice_type, esize, lat_type, sub_box_num, r_in(:,1:max_basisnum,1:max_ng_node)) case('Atom') read(11, *) inod, ibasis, in_basis_types(ibasis), r_in(:,1,1) @@ -1082,17 +1081,24 @@ module io !This code parses input values integer, intent(in) :: apos integer :: arglen, arg_pos + + character(len=100) :: textholder arg_pos = apos + 1 - call get_command_argument(arg_pos, in_lapa, arglen) + call get_command_argument(arg_pos, textholder, arglen) if (arglen==0) then print *, "Missing lattice parameter for set_input_lat" end if + read(textholder,*) in_lapa + print *, in_lapa arg_pos = arg_pos + 1 - call get_command_argument(arg_pos, in_lattice_type, arglen) + call get_command_argument(arg_pos, textholder, arglen) if (arglen==0) then print *, "Missing lattice type for set_input_lat" end if - end subroutine set_input_lat(arg_pos) + read(textholder,*) in_lattice_type + print *, in_lattice_type + + end subroutine set_cac end module io diff --git a/src/main.f90 b/src/main.f90 index 8d153ce..53fa4fa 100644 --- a/src/main.f90 +++ b/src/main.f90 @@ -61,10 +61,8 @@ program main 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 From 338587b7b74cddbcdeb94546cf304ec68ccc16c5 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Thu, 4 Jun 2020 12:13:42 -0400 Subject: [PATCH 17/60] Added sphere as a possible group shape --- README.md | 5 +++++ src/opt_group.f90 | 40 ++++++++++++++++++++++++++++++++-------- 2 files changed, 37 insertions(+), 8 deletions(-) diff --git a/README.md b/README.md index 4c4e5ed..d285495 100644 --- a/README.md +++ b/README.md @@ -218,6 +218,11 @@ This shape is similar to a wedge shape except instead of becoming atomically sha `bw` - Base width `tr` - Tip radius +*Sphere* + +`-group atoms sphere x y z r` +This shape selects all atoms within a sphere centered at `(x,y,z)` with radius `r`. + **Displace:** ``` diff --git a/src/opt_group.f90 b/src/opt_group.f90 index 080d0e6..281ab28 100644 --- a/src/opt_group.f90 +++ b/src/opt_group.f90 @@ -10,7 +10,7 @@ module opt_group integer :: group_ele_num, group_atom_num, remesh_size,normal, dim1, dim2, random_num character(len=15) :: type, shape !Type indicates what element type is selected and shape is the group shape - real(kind=dp) :: block_bd(6), centroid(3), vertices(3,3),disp_vec(3), tip_radius, bwidth + real(kind=dp) :: block_bd(6), centroid(3), vertices(3,3),disp_vec(3), radius, bwidth logical :: displace, delete, max_remesh, refine, group_nodes, flip integer, allocatable :: element_index(:), atom_index(:) @@ -171,7 +171,7 @@ module opt_group arg_pos = arg_pos + 1 call get_command_argument(arg_pos, textholder, arglen) if (arglen==0) STOP "Missing tip radius in group notch command" - read(textholder,*) tip_radius + read(textholder,*) radius !Calculate the vertex positions vertices(:,1) = centroid @@ -201,7 +201,7 @@ module opt_group !Now update the centroid so that the desire tip diameter matches the wedge with if (bwidth > 0) then - centroid(dim1) = centroid(dim1) + 2*tip_radius*(H)/bwidth + centroid(dim1) = centroid(dim1) + 2*radius*(H)/bwidth end if !Read the ID type shape for group case('id') @@ -313,6 +313,21 @@ module opt_group if(i ==1) arg_pos = arg_pos + 1 end do end select + + case('sphere') + !First extract the sphere centroid + do i = 1, 3 + arg_pos = arg_pos + 1 + call get_command_argument(arg_pos, textholder, arglen) + if (arglen==0) STOP "Missing sphere centroid in group command" + call parse_pos(i, textholder, centroid(i)) + end do + !Now get the tip radius + arg_pos=arg_pos+1 + call get_command_argument(arg_pos, textholder, arglen) + if (arglen==0) STOP "Missing sphere radius in group command" + read(textholder, *) radius + case default print *, "Group shape ", trim(adjustl(shape)), " is not currently accepted. Please check documentation ", & "for accepted group shapes." @@ -376,11 +391,13 @@ module opt_group case ('wedge') print *, "Group has wedge shape with dim1", dim1, "and dim2", dim2, "and vertices ", vertices case ('notch') - print *, "Group has notch shape with dim1", dim1, "and dim2", dim2, " tip radius ", tip_radius, "and vertices ", & + print *, "Group has notch shape with dim1", dim1, "and dim2", dim2, " tip radius ", radius, "and vertices ", & vertices case('id') print *, 'Group contains ', group_ele_num, " elements and ", group_atom_num, " atoms." return + case('sphere') + print *, "Group has sphere shape with centroid ", centroid(:), " and radius ", radius end select !Reset group if needed @@ -837,7 +854,7 @@ module opt_group function in_group(r) !This subroutine determines if a point is within the group boundaries real(kind=dp), intent(in) :: r(3) - real(kind=dp) :: r_notch + real(kind=dp) :: rnorm integer :: dim3, i logical :: in_group @@ -857,9 +874,16 @@ module opt_group if (r(dim1) < centroid(dim1)) in_group = .false. end if - r_notch = sqrt((r(dim1) - centroid(dim1))**2 + (r(dim3)-centroid(dim3))**2) - in_group = in_group.or.(r_notch < tip_radius) + rnorm = sqrt((r(dim1) - centroid(dim1))**2 + (r(dim3)-centroid(dim3))**2) + in_group = in_group.or.(rnorm < radius) - end select + case('sphere') + rnorm = norm2(r(:) - centroid(:)) + if (rnorm <= radius) then + in_group = .true. + else + in_group = .false. + end if + end select end function in_group end module opt_group From de15d0f8ae5a18c0491aaf15f62b5829f32438df Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Mon, 8 Jun 2020 22:11:37 -0400 Subject: [PATCH 18/60] Update to doc for remesh command --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index d285495..6068e39 100644 --- a/README.md +++ b/README.md @@ -242,10 +242,10 @@ This command wraps atoms back into the simulation cell as though periodic bounda **Remesh** ``` -remesh esize lattice_parameter lattice_type +remesh esize ``` -This command remeshes the atoms/elements within the group to the new element size `esize`. Currently only accepts an `esize` of 2 which refines it to full atomistics. When remeshing to atomistics the group can contain any orientations of elements but when remeshing to different finite elements, the group must contain all atoms/elements with the same orientation. `lattice_parameter` is the lattice parameter for the elements within the group and `lattice_type` is the lattice type (integer) that these new elements will be assigned to. +This command remeshes the atoms/elements within the group to the new element size `esize`. **Max** From a47c384a3f61fb5df80582f3993918f722f38d26 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Mon, 29 Jun 2020 18:51:01 -0400 Subject: [PATCH 19/60] Added tags to the element and atom arrays --- src/Makefile | 4 ++-- src/elements.f90 | 44 ++++++++++++++++++++++++++++++++++++-------- src/io.f90 | 20 ++++++++++---------- src/mode_create.f90 | 6 +++--- src/opt_group.f90 | 6 +++--- 5 files changed, 54 insertions(+), 26 deletions(-) diff --git a/src/Makefile b/src/Makefile index 642fce5..87f9306 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,6 +1,6 @@ FC=ifort -#FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays -FFLAGS=-mcmodel=large -Ofast -no-wrap-margin -heap-arrays +FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays +#FFLAGS=-mcmodel=large -Ofast -no-wrap-margin -heap-arrays MODES=mode_create.o mode_merge.o mode_convert.o OPTIONS=opt_disl.o opt_group.o opt_orient.o opt_delete.o OBJECTS=main.o elements.o io.o subroutines.o functions.o atoms.o call_mode.o box.o $(MODES) $(OPTIONS) call_option.o sorts.o diff --git a/src/elements.f90 b/src/elements.f90 index 0dffecc..954719f 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -11,7 +11,7 @@ module elements !Data structures used to represent the CAC elements. Each index represents an element character(len=100), allocatable :: type_ele(:) !Element type - integer, allocatable :: size_ele(:), lat_ele(:), sbox_ele(:) !Element size + integer, allocatable :: size_ele(:), lat_ele(:), sbox_ele(:), tag_ele(:) !Element size real(kind=dp), allocatable :: r_node(:,:,:,:) !Nodal position array integer, save :: ele_num !Number of elements @@ -19,7 +19,7 @@ module elements !Data structure used to represent atoms integer, allocatable :: type_atom(:)!atom type - integer, allocatable :: sbox_atom(:) + integer, allocatable :: sbox_atom(:), tag_atom(:) real(kind =dp),allocatable :: r_atom(:,:) !atom position integer :: atom_num=0 !Number of atoms @@ -146,7 +146,7 @@ module elements !Allocate element arrays if(n > 0) then - allocate(type_ele(n), size_ele(n), lat_ele(n), sbox_ele(n), r_node(3,max_basisnum, max_ng_node,n), & + allocate(type_ele(n), tag_ele(n), size_ele(n), lat_ele(n), sbox_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 @@ -156,7 +156,7 @@ module elements if(m > 0) then !Allocate atom arrays - allocate(type_atom(m), sbox_atom(m), r_atom(3,m), stat=allostat) + allocate(type_atom(m), sbox_atom(m), tag_atom(m), r_atom(3,m), stat=allostat) if(allostat > 0) then print *, "Error allocating atom arrays in elements.f90 because of: ", allostat stop @@ -187,6 +187,11 @@ module elements temp_int(ele_size+1:) = 0 call move_alloc(temp_int, lat_ele) + allocate(temp_int(n+ele_num+buffer_size)) + temp_int(1:ele_size) = tag_ele + temp_int(ele_size+1:) = 0 + call move_alloc(temp_int, tag_ele) + allocate(temp_int(n+ele_num+buffer_size)) temp_int(1:ele_size) = size_ele temp_int(ele_size+1:) = 0 @@ -214,6 +219,11 @@ module elements temp_int(atom_size+1:) = 0 call move_alloc(temp_int, type_atom) + allocate(temp_int(m+atom_num+buffer_size)) + temp_int(1:atom_size) = tag_atom + temp_int(atom_size+1:) = 0 + call move_alloc(temp_int, tag_atom) + allocate(temp_int(m+atom_num+buffer_size)) temp_int(1:atom_size) = sbox_atom temp_int(atom_size+1:) = 0 @@ -226,15 +236,25 @@ module elements end if end subroutine - subroutine add_element(type, size, lat, sbox, r) + subroutine add_element(tag, type, size, lat, sbox, r) !Subroutine which adds an element to the element arrays - integer, intent(in) :: size, lat, sbox + integer, intent(in) :: size, lat, sbox, tag character(len=100), intent(in) :: type real(kind=dp), intent(in) :: r(3, max_basisnum, max_ng_node) + integer :: newtag + ele_num = ele_num + 1 + + if (tag==0) then + newtag = ele_num !If we don't assign a tag then pass the tag as the ele_num + else + newtag = tag + end if + !Check to see if we need to grow the arrays call grow_ele_arrays(1,0) + tag_ele(ele_num) = newtag type_ele(ele_num) = type size_ele(ele_num) = size lat_ele(ele_num) = lat @@ -245,14 +265,22 @@ module elements end subroutine add_element - subroutine add_atom(type, sbox, r) + subroutine add_atom(tag, type, sbox, r) !Subroutine which adds an atom to the atom arrays - integer, intent(in) :: type, sbox + integer, intent(in) :: type, sbox, tag real(kind=dp), intent(in), dimension(3) :: r + integer :: newtag + atom_num = atom_num+1 + if(tag==0) then + newtag = atom_num !If we don't assign a tag then pass the tag as the atom_num + else + newtag = tag + end if !Check to see if we need to grow the arrays call grow_ele_arrays(0,1) + tag_atom(atom_num) = tag type_atom(atom_num) = type r_atom(:,atom_num) = r(:) sbox_atom(atom_num) = sbox diff --git a/src/io.f90 b/src/io.f90 index cd3e3f6..6aafafc 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -543,13 +543,13 @@ module io !Write out atoms first do i = 1, atom_num - write(11,*) i, type_atom(i), sbox_atom(i), r_atom(:,i) + write(11,*) tag_atom(i), type_atom(i), sbox_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), sbox_ele(i), type_ele(i) + write(11, *) tag_ele(i), lat_ele(i), size_ele(i), sbox_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) @@ -738,19 +738,19 @@ module io do i = 1, in_atoms read(11,*) j, type, sbox, r(:) r = r+newdisplace - call add_atom(new_type_to_type(type), sbox+sub_box_num, r) + call add_atom(j, new_type_to_type(type), sbox+sub_box_num, r) end do !Read the elements do i = 1, in_eles - read(11, *) l, type, size, sbox, etype + read(11, *) j, type, size, sbox, etype do inod = 1, ng_node(type) do ibasis =1, basisnum(type) - read(11,*) j, k, r_innode(:, ibasis, inod) + read(11,*) k, l, r_innode(:, ibasis, inod) r_innode(:,ibasis,inod) = r_innode(:, ibasis, inod) + newdisplace end do end do - call add_element(etype, size, new_lattice_map(type), sbox+sub_box_num, r_innode) + call add_element(j, etype, size, new_lattice_map(type), sbox+sub_box_num, r_innode) end do !Close the file being read @@ -773,7 +773,7 @@ module io real(kind=dp), dimension(3), intent(in) :: displace real(kind = dp), dimension(6), intent(out) :: temp_box_bd - integer :: i, inod, ibasis, j, k, in_eles, in_atoms, ele_types, in_lat_num, in_atom_types, & + integer :: i, inod, ibasis, j, k, l, in_eles, in_atoms, ele_types, in_lat_num, in_atom_types, & atom_type_map(100), etype_map(100), etype, lat_type, new_lattice_map(100), & atom_type real(kind=dp) :: newdisplace(3), r_in(3,1,8), r_in_atom(3), new_displace(3) @@ -919,10 +919,10 @@ module io do i = 1, in_eles read(11,*) j, etype, k, lat_type do inod = 1, 8 - read(11, *) j, k, r_in(:,1,inod) + read(11, *) k, l, r_in(:,1,inod) r_in(:,1,inod) = r_in(:,1,inod) + newdisplace end do - call add_element(in_lattype_map(lat_type), etype_map(etype), new_lattice_map(lat_type), sub_box_num + 1, r_in) + call add_element(j, in_lattype_map(lat_type), etype_map(etype), new_lattice_map(lat_type), sub_box_num + 1, r_in) end do end if @@ -937,7 +937,7 @@ module io do i = 1, in_atoms read(11,*) j, k, atom_type, r_in_atom(:) r_in_atom = r_in_atom + newdisplace - call add_atom(atom_type_map(atom_type), sub_box_num + 1, r_in_atom) + call add_atom(j,atom_type_map(atom_type), sub_box_num + 1, r_in_atom) end do !Close file close(11) diff --git a/src/mode_create.f90 b/src/mode_create.f90 index 5c347ab..454fcb7 100644 --- a/src/mode_create.f90 +++ b/src/mode_create.f90 @@ -109,7 +109,7 @@ module mode_create box_bd(2*i) = maxval(r_node_temp(i,:,:))+10.0_dp**-6.0_dp box_bd(2*i-1) = minval(r_node_temp(i,:,:)) - 10.0_dp**-6.0_dp end do - call add_element(element_type, esize, 1, 1, r_node_temp) + call add_element(0,element_type, esize, 1, 1, r_node_temp) end if !If we passed the dup_flag or dim_flag then we have to convert the lattice points and add them to the atom/element arrays @@ -136,7 +136,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), 1, (r_atom_lat(:,i)*lattice_parameter)+basis_pos(:,ibasis)) + call add_atom(0,basis_type(ibasis, 1), 1, (r_atom_lat(:,i)*lattice_parameter)+basis_pos(:,ibasis)) end do end do deallocate(r_atom_lat) @@ -150,7 +150,7 @@ module mode_create end do end do - call add_element(element_type, elat(i), 1, 1, r_node_temp) + call add_element(0,element_type, elat(i), 1, 1, r_node_temp) end do end if end if diff --git a/src/opt_group.f90 b/src/opt_group.f90 index 281ab28..c24b857 100644 --- a/src/opt_group.f90 +++ b/src/opt_group.f90 @@ -564,7 +564,7 @@ module opt_group !here as well to make sure they are in the box do j = 1, basisnum(lat_ele(ie))*size_ele(ie)**3 call apply_periodic(r_interp(:,j)) - call add_atom(type_interp(j), sbox_ele(ie), r_interp(:,j)) + call add_atom(0,type_interp(j), sbox_ele(ie), r_interp(:,j)) end do end do !Once all atoms are added we delete all of the elements @@ -800,7 +800,7 @@ module opt_group !Add the element, for the sbox we just set it to the same sbox that we get the orientation !from. In this case it is from the sbox of the first atom in the group. new_ele = new_ele+1 - call add_element(remesh_ele_type, working_esize, ilat, sbox_atom(atom_index(1)),r_new_node) + call add_element(0,remesh_ele_type, working_esize, ilat, sbox_atom(atom_index(1)),r_new_node) end if end if @@ -821,7 +821,7 @@ module opt_group lat_points(ix,iy,iz) = .false. r = matmul(orient, matmul(fcc_mat, vlat))*lapa(ilat) new_atom=new_atom+1 - call add_atom(basis_type(1,ilat), is, r) + call add_atom(0,basis_type(1,ilat), is, r) end if end do end do From a0ecc7da90e46c6a0f7c642e2530886e3040faf0 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Tue, 30 Jun 2020 11:00:02 -0400 Subject: [PATCH 20/60] Fix to problem with read-CAC due to changes in add_atom and add_element methods) --- src/io.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/io.f90 b/src/io.f90 index 79e63d4..0f7623b 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -1067,11 +1067,11 @@ module io call lattice_map(in_basis, in_basis_types, 8, in_lapa, lat_type) !Now add the element - call add_element(in_lattice_type, esize, lat_type, sub_box_num, r_in(:,1:max_basisnum,1:max_ng_node)) + call add_element(0,in_lattice_type, esize, lat_type, sub_box_num, r_in(:,1:max_basisnum,1:max_ng_node)) case('Atom') read(11, *) inod, ibasis, in_basis_types(ibasis), r_in(:,1,1) - call add_atom(in_basis_types(ibasis), sub_box_num, r_in(:,1,1)) + call add_atom(0,in_basis_types(ibasis), sub_box_num, r_in(:,1,1)) end select end do From 724e5732877d2dd42d1d3189184fad55fe211935 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Mon, 10 Aug 2020 15:52:19 -0400 Subject: [PATCH 21/60] Added deform box option and allowed for reading time information from restart files --- src/Makefile | 2 +- src/box.f90 | 3 +- src/call_option.f90 | 3 ++ src/elements.f90 | 2 + src/io.f90 | 20 +++++---- src/opt_deform.f90 | 98 +++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 117 insertions(+), 11 deletions(-) create mode 100644 src/opt_deform.f90 diff --git a/src/Makefile b/src/Makefile index 87f9306..fde4484 100644 --- a/src/Makefile +++ b/src/Makefile @@ -2,7 +2,7 @@ FC=ifort FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays #FFLAGS=-mcmodel=large -Ofast -no-wrap-margin -heap-arrays MODES=mode_create.o mode_merge.o mode_convert.o -OPTIONS=opt_disl.o opt_group.o opt_orient.o opt_delete.o +OPTIONS=opt_disl.o opt_group.o opt_orient.o opt_delete.o opt_deform.o OBJECTS=main.o elements.o io.o subroutines.o functions.o atoms.o call_mode.o box.o $(MODES) $(OPTIONS) call_option.o sorts.o .SUFFIXES: diff --git a/src/box.f90 b/src/box.f90 index c6e7948..faf268c 100644 --- a/src/box.f90 +++ b/src/box.f90 @@ -14,7 +14,6 @@ module 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 - !Below are some simulation parameters which may be adjusted if reading in restart files integer :: timestep=0 real(kind=dp) :: total_time=0.0_dp @@ -98,4 +97,4 @@ module box end do return end subroutine in_sub_box -end module box \ No newline at end of file +end module box diff --git a/src/call_option.f90 b/src/call_option.f90 index 368e542..1c3759e 100644 --- a/src/call_option.f90 +++ b/src/call_option.f90 @@ -3,6 +3,7 @@ subroutine call_option(option, arg_pos) use opt_disl use opt_group use opt_orient + use opt_deform use opt_delete use box implicit none @@ -31,6 +32,8 @@ subroutine call_option(option, arg_pos) bound_called = .true. case('-sbox_ori') call sbox_ori(arg_pos) + case('-deform') + call deform(arg_pos) case('-delete') call run_delete(arg_pos) case('-set_cac') diff --git a/src/elements.f90 b/src/elements.f90 index 7f8cef4..6df859b 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -503,6 +503,7 @@ module elements size_ele(sorted_index(i)) = 0 lat_ele(sorted_index(i)) = 0 sbox_ele(sorted_index(i)) = 0 + tag_ele(sorted_index(i)) = 0 else node_num = node_num - ng_node(lat_ele(sorted_index(i))) r_node(:,:,:,sorted_index(i)) = r_node(:,:,:,ele_num) @@ -510,6 +511,7 @@ module elements size_ele(sorted_index(i)) = size_ele(ele_num) lat_ele(sorted_index(i)) = lat_ele(ele_num) sbox_ele(sorted_index(i)) = sbox_ele(ele_num) + tag_ele(sorted_index(i)) = tag_ele(ele_num) end if ele_num = ele_num - 1 end do diff --git a/src/io.f90 b/src/io.f90 index ba3a389..aba4dd9 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -491,7 +491,7 @@ module io exit endif end do - write(11, '(4i16)') i, etype, 1, basis_type(1,lat_ele(i)) + write(11, '(4i16)') tag_ele(i), etype, 1, basis_type(1,lat_ele(i)) do inod = 1, ng_node(lat_ele(i)) do ibasis = 1, basisnum(lat_ele(i)) ip = ip + 1 @@ -505,7 +505,7 @@ module io if(atom_num /= 0) then write(11,14) do i = 1, atom_num - write(11, '(3i16, 3f23.15)') i, 1, type_atom(i), r_atom(:,i) + write(11, '(3i16, 3f23.15)') tag_atom(i), 1, type_atom(i), r_atom(:,i) end do end if @@ -781,19 +781,19 @@ module io integer :: i, inod, ibasis, j, k, l, in_eles, in_atoms, ele_types, in_lat_num, in_atom_types, & atom_type_map(100), etype_map(100), etype, lat_type, new_lattice_map(100), & - atom_type + atom_type, stat real(kind=dp) :: newdisplace(3), r_in(3,1,8), r_in_atom(3) character(len=100) :: textholder, in_lattype_map(10) character(len=2) :: atomic_element !First open the file open(unit=11, file=trim(adjustl(file)), action='read',position='rewind') - !Disregard unneeded information - do i = 1, 3 - read(11,*) textholder - end do + !Read the timestep information + read(11,*) textholder + read(11,*) timestep, total_time !Read element number + read(11,*) textholder read(11,*) in_eles !Discard info and read ng_max_node @@ -941,7 +941,11 @@ module io end if do i = 1, in_atoms - read(11,*) j, k, atom_type, r_in_atom(:) + read(11,*, iostat=stat) j, k, atom_type, r_in_atom(:) + if(stat > 0) then + print *, j + stop + end if r_in_atom = r_in_atom + newdisplace call add_atom(j,atom_type_map(atom_type), sub_box_num + 1, r_in_atom) end do diff --git a/src/opt_deform.f90 b/src/opt_deform.f90 new file mode 100644 index 0000000..c9be654 --- /dev/null +++ b/src/opt_deform.f90 @@ -0,0 +1,98 @@ +module opt_deform + !This module constains the deform option which applies a uniaxial strain to the system + use parameters + use subroutines + use elements + use box + + implicit none + + + real(kind=dp), save :: applied_strain + integer, save :: sdim + + public + contains + + subroutine deform(arg_pos) + !This subroutine applies the simulation box deformation to the system + + integer, intent(inout) :: arg_pos + + character(len=1) :: dims(3) + integer :: i, j, k + real(kind=dp) :: frac_atom(atom_num), frac_node(max_basisnum, max_ng_node, ele_num) + + !initialize some variables + dims(1) = 'x' + dims(2) = 'y' + dims(3) = 'z' + + !First parse the input command + call parse_deform(arg_pos) + print *, '-----------------------Option Deform------------------------' + !Now convert all positions in the specified dimension to fractional coordinates + do i = 1, atom_num + frac_atom(i) = (r_atom(sdim, i) - box_bd(2*sdim-1))/(box_bd(2*sdim)-box_bd(2*sdim-1)) + end do + do i = 1, ele_num + do j = 1, ng_node(lat_ele(i)) + do k = 1, basisnum(lat_ele(i)) + frac_node(k,j,i) = (r_node(sdim,k,j,i) - box_bd(2*sdim-1))/(box_bd(2*sdim)-box_bd(2*sdim-1)) + end do + end do + end do + + print *, "Original box bounds in ", dims(sdim), " are ", box_bd(2*sdim-1:2*sdim) + box_bd(2*sdim) = box_bd(2*sdim) + applied_strain + print *, "New box bounds are ", box_bd(2*sdim-1:2*sdim) + + !Now reassign the positions + do i = 1, atom_num + r_atom(sdim,i) = frac_atom(i)*(box_bd(2*sdim)-box_bd(2*sdim-1)) + box_bd(2*sdim-1) + end do + do i = 1, ele_num + do j = 1, ng_node(lat_ele(i)) + do k = 1, basisnum(lat_ele(i)) + r_node(sdim,k,j,i) = frac_node(k,j,i)*(box_bd(2*sdim)-box_bd(2*sdim-1)) + box_bd(2*sdim-1) + end do + end do + end do + + end subroutine deform + + subroutine parse_deform(arg_pos) + + integer, intent(inout) :: arg_pos + integer :: arg_len + character(len=100) :: textholder + + !Pull out the dimension to be strained + arg_pos=arg_pos+1 + call get_command_argument(arg_pos, textholder, arg_len) + if (arg_len == 0) stop "Missing dim in deform command" + + select case(trim(adjustl(textholder))) + case('x','X') + sdim = 1 + case('y','Y') + sdim = 2 + case('z','Z') + sdim = 3 + case default + print *, "Dimension ", trim(adjustl(textholder)), " is not accepted. Please select either x, y, or z" + end select + + !Now pull out the strain vector, currently only accepts a real number by which to reduce the simulation cell size by in + !that dimension + arg_pos = arg_pos + 1 + call get_command_argument(arg_pos, textholder, arg_len) + if (arg_len == 0) stop "Missing strain in deform command" + read(textholder, *) applied_strain + + arg_pos = arg_pos + 1 + + end subroutine parse_deform + + +end module opt_deform From 96e2242573982e74592baf083e281d672e05adc0 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Fri, 14 Aug 2020 10:29:53 -0400 Subject: [PATCH 22/60] Fix to writing pycac files --- src/io.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/io.f90 b/src/io.f90 index aba4dd9..7bbf3c2 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -491,7 +491,7 @@ module io exit endif end do - write(11, '(4i16)') tag_ele(i), etype, 1, basis_type(1,lat_ele(i)) + write(11, '(4i16)') i, etype, 1, basis_type(1,lat_ele(i)) do inod = 1, ng_node(lat_ele(i)) do ibasis = 1, basisnum(lat_ele(i)) ip = ip + 1 @@ -505,7 +505,7 @@ module io if(atom_num /= 0) then write(11,14) do i = 1, atom_num - write(11, '(3i16, 3f23.15)') tag_atom(i), 1, type_atom(i), r_atom(:,i) + write(11, '(3i16, 3f23.15)') i, 1, type_atom(i), r_atom(:,i) end do end if From c4afde27438aabbc2924ca6884ec6ffb5dac6dc5 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Sun, 13 Sep 2020 15:04:08 -0400 Subject: [PATCH 23/60] Working changes to group --- src/opt_group.f90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/opt_group.f90 b/src/opt_group.f90 index c24b857..eea9424 100644 --- a/src/opt_group.f90 +++ b/src/opt_group.f90 @@ -8,7 +8,7 @@ module opt_group use box implicit none - integer :: group_ele_num, group_atom_num, remesh_size,normal, dim1, dim2, random_num + integer :: group_ele_num, group_atom_num, remesh_size,normal, dim1, dim2, random_num, group_type character(len=15) :: type, shape !Type indicates what element type is selected and shape is the group shape real(kind=dp) :: block_bd(6), centroid(3), vertices(3,3),disp_vec(3), radius, bwidth logical :: displace, delete, max_remesh, refine, group_nodes, flip @@ -850,6 +850,12 @@ module opt_group call delete_elements(group_ele_num, element_index) end subroutine delete_group + + subroutine change_group + !This subroutine changes all atoms and nodes at atoms within a group to a specific type + + print *, "Changing ", group_atom_num " atoms and ", group_ele_num, " elements to atom type ", group_type + end subroutine change_group function in_group(r) !This subroutine determines if a point is within the group boundaries From 4c75fac13ce1cfe0038e36ba17f830cf4661fe6c Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Sun, 13 Sep 2020 15:47:55 -0400 Subject: [PATCH 24/60] Working change group type command --- src/opt_group.f90 | 35 ++++++++++++++++++++++++++++++++--- 1 file changed, 32 insertions(+), 3 deletions(-) diff --git a/src/opt_group.f90 b/src/opt_group.f90 index eea9424..03dfd68 100644 --- a/src/opt_group.f90 +++ b/src/opt_group.f90 @@ -28,6 +28,7 @@ module opt_group group_atom_num = 0 remesh_size=0 random_num=0 + group_type=0 displace=.false. delete=.false. max_remesh=.false. @@ -61,6 +62,11 @@ module opt_group call remesh_group end if + if(group_type > 0) then + call get_group + call change_group_type + end if + end subroutine group subroutine parse_group(arg_pos) @@ -371,6 +377,11 @@ module opt_group read(textholder, *) random_num case('flip') flip=.true. + case('type') + arg_pos = arg_pos + 1 + call get_command_argument(arg_pos, textholder, arglen) + if (arglen==0) stop "Missing atom type for group" + call add_atom_type(textholder, group_type) case default !If it isn't an available option to opt_disl then we just exit exit @@ -851,11 +862,29 @@ module opt_group end subroutine delete_group - subroutine change_group + subroutine change_group_type !This subroutine changes all atoms and nodes at atoms within a group to a specific type + integer :: i, j, ltype,ibasis, inod, basis_type(10) + + print *, "Changing ", group_atom_num, " atoms and ", group_ele_num, " elements to atom type ", group_type + + !Change all atom group types + do i = 1, group_atom_num + j = atom_index(i) + type_atom(j) = group_type + end do + + !Map to a new lattice type for all element + do i =1, group_ele_num + j = element_index(i) + ltype = lat_ele(j) + do ibasis = 1, basisnum(ltype) + basis_type(ibasis) = group_type + end do + call lattice_map(basisnum(ltype), basis_type, ng_node(ltype), lapa(ltype), lat_ele(j)) + end do - print *, "Changing ", group_atom_num " atoms and ", group_ele_num, " elements to atom type ", group_type - end subroutine change_group + end subroutine change_group_type function in_group(r) !This subroutine determines if a point is within the group boundaries From 73fca4a0d8335bddd0d564fafece2ed323526dbb Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Tue, 22 Sep 2020 17:23:20 -0400 Subject: [PATCH 25/60] Added efill zigzag code which adjusts the efill option --- src/mode_create.f90 | 97 +++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 89 insertions(+), 8 deletions(-) diff --git a/src/mode_create.f90 b/src/mode_create.f90 index e9d7fb2..4a69533 100644 --- a/src/mode_create.f90 +++ b/src/mode_create.f90 @@ -10,12 +10,12 @@ module mode_create implicit none - character(len=100) :: name, element_type + 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), duplicate(3) integer :: esize, ix, iy, iz, box_lat_vert(3,8), lat_ele_num, lat_atom_num, bd_in_lat(6), & basis_pos(3,10), esize_nums, esize_index(10) - logical :: dup_flag, dim_flag, efill + logical :: dup_flag, dim_flag, efill(3) real(kind=dp), allocatable :: r_lat(:,:,:), r_atom_lat(:,:) integer, allocatable :: elat(:) @@ -46,6 +46,7 @@ module mode_create basisnum = 0 lat_ele_num = 0 lat_atom_num = 0 + efill(:) = .false. !First we parse the command call parse_command(arg_pos) @@ -264,7 +265,30 @@ module mode_create end do case('efill') - efill = .true. + call get_command_argument(arg_pos, textholder) + select case(trim(adjustl(textholder))) + case('x') + efill(1) = .true. + case('y') + efill(2) = .true. + case('z') + efill(3) = .true. + case('xy','yx') + efill(1) = .true. + efill(2) = .true. + case('yz','zy') + efill(2) = .true. + efill(3) = .true. + case('xz','zx') + efill(1) = .true. + efill(3) = .true. + case('xyz','xzy','yxz','yzx','zxy','zyx') + efill(:) = .true. + case default + print *, "Error: ", trim(adjustl(textholder)), " is not an acceptable argument for the efill argument" + stop 3 + end select + arg_pos = arg_pos + 1 case default !If it isn't an option then you have to exit arg_pos = arg_pos -1 @@ -339,16 +363,20 @@ module mode_create !Internal variables 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, curr_esize, ei - real(kind=dp) :: v(3), temp_nodes(3,1,8) + real(kind=dp) :: v(3), temp_nodes(3,1,8), r(3), centroid_bd(6) logical, allocatable :: lat_points(:,:,:) - logical :: node_in_bd(8) + logical :: node_in_bd(8), add !Do some value initialization max_esize = esize + do i = 1,3 + centroid_bd(2*i) = -huge(1.0_dp) + centroid_bd(2*i-1) = huge(1.0_dp) + end do !Now initialize the code if we are doing efill. This means calculate the number of times we can divide the esize in 2 with !the value still being > 7 - if(efill) then + if(any(efill)) then curr_esize=esize esize_nums=0 do while (curr_esize >= 7) @@ -485,14 +513,18 @@ module mode_create !Check to see if the lattice point values are greater then the array limits if(any(vlat > shape(lat_points)).or.any(vlat < 1)) then - continue + exit !If within array boundaries check to see if it is a lattice point else if(lat_points(vlat(1),vlat(2),vlat(3))) then node_in_bd(inod) = .true. + else + exit end if end do - if(all(node_in_bd)) then + !If we are on the first round of element building then we can just add the element if all(node_in_bd) is + !true + if(all(node_in_bd).and.(ei==1)) then lat_ele_num = lat_ele_num+1 r_lat(:,:,lat_ele_num) = temp_nodes(:,1,:) elat(lat_ele_num) = curr_esize @@ -505,11 +537,60 @@ module mode_create end do end do + !Otherwise we have to also do a box boundary check + else if(all(node_in_bd)) then + r(:) = 0.0_dp + add = .false. + do inod = 1,8 + r = r+ temp_nodes(:,1,inod)/8.0_dp + end do + + !Here we check to make sure the centroid of the element we are adding is outside of the bounds set + !by the centroids of the elements of the initial iteration + + do i = 1,3 + if(efill(i)) then + if((r(i) > centroid_bd(2*i)).or.(r(i) < centroid_bd(2*i-1)))then + add = .true. + exit + end if + end if + end do + if(add) then + lat_ele_num = lat_ele_num+1 + r_lat(:,:,lat_ele_num) = temp_nodes(:,1,:) + elat(lat_ele_num) = curr_esize + !Now set all the lattice points contained within an element to false + do o = minval(temp_lat(3,:)), maxval(temp_lat(3,:)) + do n = minval(temp_lat(2,:)), maxval(temp_lat(2,:)) + do m = minval(temp_lat(1,:)), maxval(temp_lat(1,:)) + lat_points(m,n,o) = .false. + end do + end do + end do + end if end if end do end do end do curr_esize=curr_esize-2 + !If we are running efill code, after the first iteration we have to calculate the min and max element centroids in + !each dimension + if((ei == 1).and.(any(efill))) then + do i = 1, lat_ele_num + !Calculate the current element centroid + r(:) = 0.0_dp + do inod = 1,8 + r = r + r_lat(:,inod,i)/8.0_dp + end do + + !Check to see if it's a min or max + do o = 1,3 + if(r(o) > centroid_bd(2*o)) centroid_bd(2*o) = r(o) + if(r(o) < centroid_bd(2*o-1)) centroid_bd(2*o-1) = r(o) + end do + end do + end if end do !Now figure out how many lattice points could not be contained in elements allocate(r_atom_lat(3,count(lat_points))) From 9ed8dca69c1369230a9f87fcee2f80cd585a3c53 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Tue, 22 Sep 2020 17:25:02 -0400 Subject: [PATCH 26/60] Updated docs --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 8dd0971..1ab2d7c 100644 --- a/README.md +++ b/README.md @@ -85,9 +85,9 @@ This function allows you to define a custom basis. `bname bx by bz` must be repe **efill** ``` -efill +efill xyz ``` -This command will rerun the creation algorithm with multiple times starting with an esize of `esize` and decreasing it by half on every iteration in an effort to maximize the reduction of degrees of freedom in the system. +This command will rerun the creation algorithm with multiple times starting with an esize of `esize` and decreasing it by half on every iteration in an effort to maximize the reduction of degrees of freedom in the system. You must specify which dimensions will be filled. The code accepts `x`, `y`, `z`, `xy`, `yz`, `xz`, and `xyz` specifying which boundaries to fill in. ### Mode Convert From 1e1c08e546c82912f2a9364a997bf82df638af81 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Sat, 3 Oct 2020 23:42:33 -0400 Subject: [PATCH 27/60] Added group shape all to seleect all of a specific type --- src/opt_group.f90 | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/src/opt_group.f90 b/src/opt_group.f90 index 03dfd68..855e04e 100644 --- a/src/opt_group.f90 +++ b/src/opt_group.f90 @@ -8,7 +8,7 @@ module opt_group use box implicit none - integer :: group_ele_num, group_atom_num, remesh_size,normal, dim1, dim2, random_num, group_type + integer :: group_ele_num, group_atom_num, remesh_size,normal, dim1, dim2, random_num, group_type, notsize character(len=15) :: type, shape !Type indicates what element type is selected and shape is the group shape real(kind=dp) :: block_bd(6), centroid(3), vertices(3,3),disp_vec(3), radius, bwidth logical :: displace, delete, max_remesh, refine, group_nodes, flip @@ -29,6 +29,7 @@ module opt_group remesh_size=0 random_num=0 group_type=0 + notsize=0 displace=.false. delete=.false. max_remesh=.false. @@ -334,6 +335,10 @@ module opt_group if (arglen==0) STOP "Missing sphere radius in group command" read(textholder, *) radius + case('all') + !Do nothing if the shape is all + continue + case default print *, "Group shape ", trim(adjustl(shape)), " is not currently accepted. Please check documentation ", & "for accepted group shapes." @@ -382,6 +387,12 @@ module opt_group call get_command_argument(arg_pos, textholder, arglen) if (arglen==0) stop "Missing atom type for group" call add_atom_type(textholder, group_type) + case('notsize') + arg_pos = arg_pos + 1 + call get_command_argument(arg_pos, textholder, arglen) + if(arglen ==0) stop "Missing notsize size" + read(textholder, *) notsize + print *, "Ignoring elements with size ", notsize case default !If it isn't an available option to opt_disl then we just exit exit @@ -409,6 +420,8 @@ module opt_group return case('sphere') print *, "Group has sphere shape with centroid ", centroid(:), " and radius ", radius + case('all') + print *, "Group has all of type ", type end select !Reset group if needed @@ -429,7 +442,7 @@ module opt_group end do end do - if (in_group(r_center).neqv.flip) then + if ((in_group(r_center).neqv.flip).and.(size_ele(i)/= notsize)) then group_ele_num = group_ele_num + 1 if(group_ele_num > size(element_index)) then allocate(resize_array(size(element_index) + 1024)) @@ -447,7 +460,7 @@ module opt_group r_center(:) = 0.0_dp do inod = 1, ng_node(lat_ele(i)) do ibasis = 1, basisnum(lat_ele(i)) - if (in_group(r_node(:,ibasis,inod,i)).neqv.flip) then + if ((in_group(r_node(:,ibasis,inod,i)).neqv.flip).and.(size_ele(i)/=notsize)) then group_ele_num = group_ele_num + 1 if(group_ele_num > size(element_index)) then allocate(resize_array(size(element_index) + 1024)) @@ -919,6 +932,8 @@ module opt_group else in_group = .false. end if + case('all') + in_group = .true. end select end function in_group end module opt_group From fb236f4ab4a9445bf7686213999602601e79ad8d Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Mon, 12 Oct 2020 13:26:15 -0400 Subject: [PATCH 28/60] Fix to opt_orient to preserve boundary conditions --- src/opt_orient.f90 | 33 ++++++++++++++++++++++++--------- 1 file changed, 24 insertions(+), 9 deletions(-) diff --git a/src/opt_orient.f90 b/src/opt_orient.f90 index 4ec4b4c..e60049b 100644 --- a/src/opt_orient.f90 +++ b/src/opt_orient.f90 @@ -11,6 +11,7 @@ module opt_orient real(kind=dp), save :: new_orient(3,3) real(kind=dp), dimension(6) :: orig_box_bd real(kind=dp), allocatable :: orig_sub_box_ori(:,:,:) + character(len=3) :: orig_box_bc public contains @@ -19,10 +20,10 @@ module opt_orient integer, intent(inout) :: arg_pos - integer :: i, ibasis, inod - logical :: isortho, isrighthanded + integer :: i, j, k, ibasis, inod + logical :: isortho, isrighthanded, matching real(kind=dp) :: inv_sub_box_ori(3,3,sub_box_num) - character(len=3) :: old_box_bc + !First parse the orient command call parse_orient(arg_pos) @@ -63,11 +64,24 @@ module opt_orient !Save original box boundaries orig_box_bd = box_bd - !Now find new box boundaries, have to temporarily define the box as shrink wrapped for def new box to work - old_box_bc = box_Bc - box_bc = 'sss' - call def_new_box - box_bc = old_box_bc + !Now find new box boundaries, if any orientations are the same we leave them as they are. If they are different then we have + !to shrink wrap them + + orig_box_bc = box_bc + do i = 1,3 + matching=.true. + sbox_loop:do j = 1, sub_box_num + do k = 1, 3 + if(.not.is_equal(orig_sub_box_ori(i,k,j), new_orient(i,k))) then + matching = .false. + exit sbox_loop + end if + end do + end do sbox_loop + if(.not.matching) box_bc(i:i)='s' + end do + + call def_new_box end subroutine orient subroutine parse_orient(arg_pos) @@ -129,8 +143,9 @@ module opt_orient end do end do - !Restore original box boundaries + !Restore original box boundaries and box BC box_bd = orig_box_bd + box_bc = orig_box_bc end subroutine unorient subroutine sbox_ori(arg_pos) From b658202a1ee7f7099c87ea4fb751669e34522fec Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Mon, 12 Oct 2020 13:26:58 -0400 Subject: [PATCH 29/60] First testing version of code --- README.md | 7 +++ src/Makefile | 2 +- src/opt_redef_box.f90 | 126 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 134 insertions(+), 1 deletion(-) create mode 100644 src/opt_redef_box.f90 diff --git a/README.md b/README.md index 1ab2d7c..c83516c 100644 --- a/README.md +++ b/README.md @@ -328,6 +328,13 @@ This command will delete all overlapping atoms within a specific cutoff radius ` This option is primarily used when reading data from non .mb formats. This code simply sets the orientation variable for the specified sub box `sbox`. +### Option redef_box +``` +-redef_box redef_dim {xlo xhi} {ylo yhi} {zlo zhi} +``` +This option allows for the user to redefine box boundaries deleting atoms/elements outside of the new box boundaries. Elements are refined to atmoistics if they intersect the newly defined box boundaries. +The arguments are described below: +`redef_dim` - The dimensions to be redefined. Can be any permutation of `x`, `y`, `z`, `xy`, `yz`, `xz`, `xyz`. The order of the dimensions dictates the order that the new dimensions must be defined **** ## Position Specification diff --git a/src/Makefile b/src/Makefile index fde4484..feb933f 100644 --- a/src/Makefile +++ b/src/Makefile @@ -2,7 +2,7 @@ FC=ifort FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays #FFLAGS=-mcmodel=large -Ofast -no-wrap-margin -heap-arrays MODES=mode_create.o mode_merge.o mode_convert.o -OPTIONS=opt_disl.o opt_group.o opt_orient.o opt_delete.o opt_deform.o +OPTIONS=opt_disl.o opt_group.o opt_orient.o opt_delete.o opt_deform.o opt_redef_box.o OBJECTS=main.o elements.o io.o subroutines.o functions.o atoms.o call_mode.o box.o $(MODES) $(OPTIONS) call_option.o sorts.o .SUFFIXES: diff --git a/src/opt_redef_box.f90 b/src/opt_redef_box.f90 new file mode 100644 index 0000000..c1a2dee --- /dev/null +++ b/src/opt_redef_box.f90 @@ -0,0 +1,126 @@ +module opt_redef_box + + use box + use elements + use subroutines + implicit none + + character(len=3) :: redef_dim, new_bc + real(kind=dp) :: new_bd(6) + public + contains + + subroutine redef_box(arg_pos) + !This is the main calling function for opt_redef_box + integer, intent(inout) :: arg_pos + integer :: i, inod, ibasis, iatom, delete_list(atom_num), delete_num, type_interp(max_basisnum*max_esize**3) + real(kind=dp):: r_interp(3, max_basisnum*max_esize**3) + logical :: node_out(8) + + !First parse the argument + call parse_redef_box(arg_pos) + + !Now first filter atoms that don't fit in the new box bounds and delete them + delete_num = 0 + do i = 1, atom_num + if(.not.in_block_bd(r_atom(:,i),new_bd)) then + delete_num = delete_num + 1 + delete_list(delete_num) = i + end if + end do + call delete_atoms(delete_num, delete_list(1:delete_num)) + + !Now loop over all elements + delete_num = 0 + delete_list(:) = 0 + do i = 1, ele_num + !Determine if all nodes are within the new boundaries + do inod = 1, ng_node(lat_ele(i)) + do ibasis = 1, basisnum(lat_ele(i)) + node_out(:) = .false. + if(.not.in_block_bd(r_node(:,ibasis,inod,i), new_bd)) then + node_out(inod) = .true. + end if + end do + end do + + !If all nodes are out just add the element to the delete list + if(all(node_out)) then + delete_num = delete_num +1 + delete_list(delete_num) = i + + !If any nodes are out we add the element to the delete list, but then loop over the interpoalted atoms to figure out + !which ones fit inside the boundary to keep the box rectangular + else if (any(node_out)) then + delete_num = delete_num +1 + delete_list(delete_num) = i + + call interpolate_atoms(type_ele(i), size_ele(i), lat_ele(i), r_node(:,:,:,i), type_interp, r_interp) + + !loop over all interpolated atoms and add them to the system + do iatom = 1, basisnum(lat_ele(i))*size_ele(i)**3 + if(in_block_bd(r_interp(:,iatom), new_bd)) then + call add_atom(0,type_interp(iatom), sbox_ele(i), r_interp(:,iatom)) + end if + end do + end if + end do + + call delete_elements(delete_num, delete_list) + + box_bd=new_bd + box_bc = new_bc + + end subroutine redef_box + + subroutine parse_redef_box(arg_pos) + !Parse the command + integer, intent(inout) :: arg_pos + + integer :: i, j, arglen + character(len=100) textholder + + + !First read in the dimensions that we are redefining + redef_dim = '' + arg_pos=arg_pos+1 + call get_command_argument(arg_pos, redef_dim, arglen) + select case(trim(adjustl(redef_dim))) + case('x','y','z','xy','yx','xz','zx','yz','zy','xyz','yxz','xzy','zyx','zxy','yzx') + continue + case default + print *, "Incorrect redef_dim ", redef_dim, "please select any permuation of x, y, z, xy, yz, xz, xyz" + stop 3 + end select + + !Now read in the new dimensions + new_bd = box_bd + new_bc = box_bc + do i = 1, 3 + select case(trim(adjustl(redef_dim(i:i)))) + case('x') + j = 1 + case('y') + j = 2 + case('z') + j = 3 + case default + exit + end select + + arg_pos=arg_pos +1 + call get_command_argument(arg_pos, textholder, arglen) + if(arglen == 0) stop "Missing a box dimension in opt_redef_box" + call parse_pos(j, textholder,new_bd(2*j-1)) + + arg_pos=arg_pos +1 + call get_command_argument(arg_pos, textholder, arglen) + if(arglen == 0) stop "Missing a box dimension in opt_redef_box" + call parse_pos(j, textholder,new_bd(2*j)) + new_bc(j:j) = 's' + end do + + arg_pos = arg_pos + 1 + end subroutine parse_redef_box + +end module opt_redef_box From c42db27f571510f1b6c937a44351fee4447ca78e Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Tue, 13 Oct 2020 11:57:20 -0400 Subject: [PATCH 30/60] Working redef box option --- src/call_option.f90 | 3 +++ src/opt_redef_box.f90 | 4 ++-- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/call_option.f90 b/src/call_option.f90 index 1c3759e..d55e1ee 100644 --- a/src/call_option.f90 +++ b/src/call_option.f90 @@ -5,6 +5,7 @@ subroutine call_option(option, arg_pos) use opt_orient use opt_deform use opt_delete + use opt_redef_box use box implicit none @@ -38,6 +39,8 @@ subroutine call_option(option, arg_pos) call run_delete(arg_pos) case('-set_cac') arg_pos=arg_pos +3 + case('-redef_box') + call redef_box(arg_pos) case default print *, 'Option ', trim(adjustl(option)), ' is not currently accepted.' stop 3 diff --git a/src/opt_redef_box.f90 b/src/opt_redef_box.f90 index c1a2dee..8d0d30f 100644 --- a/src/opt_redef_box.f90 +++ b/src/opt_redef_box.f90 @@ -35,9 +35,9 @@ module opt_redef_box delete_list(:) = 0 do i = 1, ele_num !Determine if all nodes are within the new boundaries + node_out(:) = .false. do inod = 1, ng_node(lat_ele(i)) do ibasis = 1, basisnum(lat_ele(i)) - node_out(:) = .false. if(.not.in_block_bd(r_node(:,ibasis,inod,i), new_bd)) then node_out(inod) = .true. end if @@ -66,7 +66,7 @@ module opt_redef_box end if end do - call delete_elements(delete_num, delete_list) + call delete_elements(delete_num, delete_list(1:delete_num)) box_bd=new_bd box_bc = new_bc From dadc1f7a4a332462c1f17acada7c9090370ad62e Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Thu, 15 Oct 2020 20:41:15 -0400 Subject: [PATCH 31/60] Fixed the efill option to preserve interelement discontinuities --- src/mode_create.f90 | 273 +++++++++++++++++++++----------------------- 1 file changed, 127 insertions(+), 146 deletions(-) diff --git a/src/mode_create.f90 b/src/mode_create.f90 index 4a69533..bcec2d5 100644 --- a/src/mode_create.f90 +++ b/src/mode_create.f90 @@ -15,7 +15,7 @@ module mode_create orient_inv(3,3), box_vert(3,8), maxbd(3), lattice_space(3), duplicate(3) integer :: esize, ix, iy, iz, box_lat_vert(3,8), lat_ele_num, lat_atom_num, bd_in_lat(6), & basis_pos(3,10), esize_nums, esize_index(10) - logical :: dup_flag, dim_flag, efill(3) + logical :: dup_flag, dim_flag, efill real(kind=dp), allocatable :: r_lat(:,:,:), r_atom_lat(:,:) integer, allocatable :: elat(:) @@ -46,7 +46,7 @@ module mode_create basisnum = 0 lat_ele_num = 0 lat_atom_num = 0 - efill(:) = .false. + efill = .false. !First we parse the command call parse_command(arg_pos) @@ -119,8 +119,8 @@ module mode_create end do end do do i = 1,3 - box_bd(2*i) = maxval(r_node_temp(i,:,:))+10.0_dp**-6.0_dp - box_bd(2*i-1) = minval(r_node_temp(i,:,:)) - 10.0_dp**-6.0_dp + box_bd(2*i) = maxval(r_node_temp(i,:,:))+10.0_dp**(-6.0_dp) + box_bd(2*i-1) = minval(r_node_temp(i,:,:)) - 10.0_dp**(-6.0_dp) end do call add_element(0,element_type, esize, 1, 1, r_node_temp) end if @@ -265,30 +265,7 @@ module mode_create end do case('efill') - call get_command_argument(arg_pos, textholder) - select case(trim(adjustl(textholder))) - case('x') - efill(1) = .true. - case('y') - efill(2) = .true. - case('z') - efill(3) = .true. - case('xy','yx') - efill(1) = .true. - efill(2) = .true. - case('yz','zy') - efill(2) = .true. - efill(3) = .true. - case('xz','zx') - efill(1) = .true. - efill(3) = .true. - case('xyz','xzy','yxz','yzx','zxy','zyx') - efill(:) = .true. - case default - print *, "Error: ", trim(adjustl(textholder)), " is not an acceptable argument for the efill argument" - stop 3 - end select - arg_pos = arg_pos + 1 + efill=.true. case default !If it isn't an option then you have to exit arg_pos = arg_pos -1 @@ -361,11 +338,12 @@ 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, ele(3,8), rzero(3), & - vlat(3), temp_lat(3,8), m, n, o, curr_esize, ei + integer :: i, inod, bd_in_lat(6), bd_in_array(6), ix, iy, iz, numlatpoints, ele(3,8), rzero(3), efill_size, & + vlat(3), temp_lat(3,8), m, n, o, j, k, nump_ele, efill_temp_lat(3,8), filzero(3), bd_ele_lat(6),& + efill_ele(3,8), ebd(6) real(kind=dp) :: v(3), temp_nodes(3,1,8), r(3), centroid_bd(6) logical, allocatable :: lat_points(:,:,:) - logical :: node_in_bd(8), add + logical :: node_in_bd(8), add, lat_points_ele(esize,esize,esize), intersect_bd(3) !Do some value initialization max_esize = esize @@ -374,19 +352,6 @@ module mode_create centroid_bd(2*i-1) = huge(1.0_dp) end do - !Now initialize the code if we are doing efill. This means calculate the number of times we can divide the esize in 2 with - !the value still being > 7 - if(any(efill)) then - curr_esize=esize - esize_nums=0 - do while (curr_esize >= 7) - esize_nums=esize_nums+1 - curr_esize = curr_esize -2 - end do - else - esize_nums=1 - end if - !First find the bounding lattice points (min and max points for the box in each dimension) numlatpoints = 1 do i = 1, 3 @@ -480,117 +445,134 @@ module mode_create !Now build the finite element region lat_ele_num = 0 lat_atom_num = 0 - curr_esize=esize - 2*(esize_nums-1) - allocate(r_lat(3,8,numlatpoints/curr_esize), elat(numlatpoints/curr_esize)) + allocate(r_lat(3,8,numlatpoints/esize), elat(numlatpoints/esize)) - curr_esize=esize - do ei = 1, esize_nums - ele(:,:) = (curr_esize-1) * cubic_cell(:,:) - !Redefined the second 3 indices as the number of elements that fit in the bounds - do i = 1, 3 - bd_in_array(3+i) = bd_in_array(i)/curr_esize - end do + ele(:,:) = (esize-1) * cubic_cell(:,:) + !Redefined the second 3 indices as the number of elements that fit in the bounds + do i = 1, 3 + bd_in_array(3+i) = bd_in_array(i)/esize + end do - !Now start the element at rzero - do inod=1, 8 - ele(:,inod) = ele(:,inod) + rzero - end do - do iz = -bd_in_array(6), bd_in_array(6) - do iy = -bd_in_array(5), bd_in_array(5) - do ix = -bd_in_array(4), bd_in_array(4) - node_in_bd(:) = .false. - temp_nodes(:,:,:) = 0.0_dp - temp_lat(:,:) = 0 - do inod = 1, 8 - vlat= ele(:,inod) + (/ ix*(curr_esize), iy*(curr_esize), iz*(curr_esize) /) - !Transform point back to real space for easier checking - ! v = matmul(orient, matmul(transform_matrix,v)) - do i = 1,3 - v(i) = real(vlat(i) + bd_in_lat(2*i-1) - 5) - end do - temp_nodes(:,1, inod) = matmul(orient, matmul(transform_matrix, v)) - temp_lat(:,inod) = vlat - - !Check to see if the lattice point values are greater then the array limits - if(any(vlat > shape(lat_points)).or.any(vlat < 1)) then - exit - !If within array boundaries check to see if it is a lattice point - else if(lat_points(vlat(1),vlat(2),vlat(3))) then - node_in_bd(inod) = .true. - else - exit - end if + !Now start the element at rzero + do inod=1, 8 + ele(:,inod) = ele(:,inod) + rzero + end do + do iz = -bd_in_array(6), bd_in_array(6) + do iy = -bd_in_array(5), bd_in_array(5) + do ix = -bd_in_array(4), bd_in_array(4) + node_in_bd(:) = .false. + temp_nodes(:,:,:) = 0.0_dp + temp_lat(:,:) = 0 + do inod = 1, 8 + vlat= ele(:,inod) + (/ ix*(esize), iy*(esize), iz*(esize) /) + !Transform point back to real space for easier checking + ! v = matmul(orient, matmul(transform_matrix,v)) + do i = 1,3 + v(i) = real(vlat(i) + bd_in_lat(2*i-1) - 5) end do + temp_nodes(:,1, inod) = matmul(orient, matmul(transform_matrix, v)) + temp_lat(:,inod) = vlat - !If we are on the first round of element building then we can just add the element if all(node_in_bd) is - !true - if(all(node_in_bd).and.(ei==1)) then - lat_ele_num = lat_ele_num+1 - r_lat(:,:,lat_ele_num) = temp_nodes(:,1,:) - elat(lat_ele_num) = curr_esize - !Now set all the lattice points contained within an element to false - do o = minval(temp_lat(3,:)), maxval(temp_lat(3,:)) - do n = minval(temp_lat(2,:)), maxval(temp_lat(2,:)) - do m = minval(temp_lat(1,:)), maxval(temp_lat(1,:)) - lat_points(m,n,o) = .false. - end do - end do - end do + !Check to see if the lattice point values are greater then the array limits + if(any(vlat > shape(lat_points)).or.any(vlat < 1)) then + continue + !If within array boundaries check to see if it is a lattice point + else if(lat_points(vlat(1),vlat(2),vlat(3))) then + node_in_bd(inod) = .true. + end if + end do - !Otherwise we have to also do a box boundary check - else if(all(node_in_bd)) then - r(:) = 0.0_dp - add = .false. - do inod = 1,8 - r = r+ temp_nodes(:,1,inod)/8.0_dp + !If we are on the first round of element building then we can just add the element if all(node_in_bd) is + !true + if(all(node_in_bd)) then + lat_ele_num = lat_ele_num+1 + r_lat(:,:,lat_ele_num) = temp_nodes(:,1,:) + elat(lat_ele_num) = esize + !Now set all the lattice points contained within an element to false + do o = minval(temp_lat(3,:)), maxval(temp_lat(3,:)) + do n = minval(temp_lat(2,:)), maxval(temp_lat(2,:)) + do m = minval(temp_lat(1,:)), maxval(temp_lat(1,:)) + lat_points(m,n,o) = .false. + end do end do + end do - !Here we check to make sure the centroid of the element we are adding is outside of the bounds set - !by the centroids of the elements of the initial iteration + !If any nodes are in the boundary and we want to efill then run the efill code + else if(any(node_in_bd).and.efill) then - do i = 1,3 - if(efill(i)) then - if((r(i) > centroid_bd(2*i)).or.(r(i) < centroid_bd(2*i-1)))then - add = .true. - exit - end if - end if - end do - if(add) then - lat_ele_num = lat_ele_num+1 - r_lat(:,:,lat_ele_num) = temp_nodes(:,1,:) - elat(lat_ele_num) = curr_esize - !Now set all the lattice points contained within an element to false - do o = minval(temp_lat(3,:)), maxval(temp_lat(3,:)) - do n = minval(temp_lat(2,:)), maxval(temp_lat(2,:)) - do m = minval(temp_lat(1,:)), maxval(temp_lat(1,:)) - lat_points(m,n,o) = .false. - end do - end do - end do + !Pull out the section of the lat points array + lat_points_ele(:,:,:)=.false. + do i = 1,3 + if (minval(temp_lat(i,:)) size(lat_points,i)) then + bd_ele_lat(2*i) = size(temp_lat(i,:)) + else + bd_ele_lat(2*i) = maxval(temp_lat(i,:)) + end if + end do + + lat_points_ele(1:(bd_ele_lat(2)-bd_ele_lat(1)),1:(bd_ele_lat(4)-bd_ele_lat(3)),& + 1:(bd_ele_lat(6)-bd_ele_lat(5)))= lat_points(bd_ele_lat(1):bd_ele_lat(2), & + bd_ele_lat(3):bd_ele_lat(4), & + bd_ele_lat(5):bd_ele_lat(6)) + !Now start looping through elements and try to fit as many as you can + efill_size = esize-2 + i=1 + j=1 + k=1 + nump_ele = count(lat_points_ele) + do i = 1, 3 + filzero(i) = bd_ele_lat(2*i-1) -1 + end do + do while(efill_size>9) + !First check whether there are enough lattice points to house the current element size + efill_ele=cubic_cell*(efill_size-1) + if (nump_ele < efill_size**3) then + efill_size = efill_size - 2 + else + ze: do k = 1, (esize-efill_size) + ye: do j = 1, (esize-efill_size) + xe: do i = 1, (esize-efill_size) + do inod = 1,8 + vlat = efill_ele(:,inod) + (/ i, j, k /) + if (.not.lat_points_ele(vlat(1),vlat(2),vlat(3))) cycle xe + do o = 1,3 + v(o) = real(vlat(o) + filzero(o) + bd_in_lat(2*o-1) -5) + end do + temp_nodes(:,1, inod) = matmul(orient, matmul(transform_matrix, v)) + efill_temp_lat(:,inod) = vlat + end do + + do o = 1,3 + ebd(2*o-1) = minval(efill_temp_lat(o,:)) + ebd(2*o) = maxval(efill_temp_lat(o,:)) + end do + lat_ele_num = lat_ele_num+1 + r_lat(:,:,lat_ele_num) = temp_nodes(:,1,:) + elat(lat_ele_num) = efill_size + nump_ele = nump_ele - efill_size**3 + !Now set all the lattice points contained within an element to false + do o = ebd(5), ebd(6) + do n = ebd(3), ebd(4) + do m = ebd(1), ebd(2) + lat_points(m+filzero(1),n+filzero(2),o+filzero(3)) = .false. + lat_points_ele(m,n,o) = .false. + end do + end do + end do + end do xe + end do ye + end do ze + efill_size = efill_size-2 + end if + end do + end if end do end do - curr_esize=curr_esize-2 - !If we are running efill code, after the first iteration we have to calculate the min and max element centroids in - !each dimension - if((ei == 1).and.(any(efill))) then - do i = 1, lat_ele_num - !Calculate the current element centroid - r(:) = 0.0_dp - do inod = 1,8 - r = r + r_lat(:,inod,i)/8.0_dp - end do - - !Check to see if it's a min or max - do o = 1,3 - if(r(o) > centroid_bd(2*o)) centroid_bd(2*o) = r(o) - if(r(o) < centroid_bd(2*o-1)) centroid_bd(2*o-1) = r(o) - end do - end do - end if end do !Now figure out how many lattice points could not be contained in elements allocate(r_atom_lat(3,count(lat_points))) @@ -641,6 +623,5 @@ module mode_create STOP 3 end subroutine error_message - - + end module mode_create From 5949f04103656972d64f706f0a3c1ca723d772ef Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Fri, 16 Oct 2020 19:48:06 -0400 Subject: [PATCH 32/60] Working read from pycac.out file format --- src/Makefile | 2 +- src/call_mode.f90 | 3 +- src/call_option.f90 | 2 + src/elements.f90 | 69 +++++++++++++++++++-- src/io.f90 | 144 ++++++++++++++++++++++++++++++++++++++++++-- src/main.f90 | 5 +- src/parameters.f90 | 4 +- 7 files changed, 213 insertions(+), 16 deletions(-) diff --git a/src/Makefile b/src/Makefile index feb933f..c58e37c 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,7 +1,7 @@ FC=ifort FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays #FFLAGS=-mcmodel=large -Ofast -no-wrap-margin -heap-arrays -MODES=mode_create.o mode_merge.o mode_convert.o +MODES=mode_create.o mode_merge.o mode_convert.o OPTIONS=opt_disl.o opt_group.o opt_orient.o opt_delete.o opt_deform.o opt_redef_box.o OBJECTS=main.o elements.o io.o subroutines.o functions.o atoms.o call_mode.o box.o $(MODES) $(OPTIONS) call_option.o sorts.o diff --git a/src/call_mode.f90 b/src/call_mode.f90 index fb187c1..7eae059 100644 --- a/src/call_mode.f90 +++ b/src/call_mode.f90 @@ -1,4 +1,4 @@ -subroutine call_mode(arg_pos,mode) +subroutine call_mode(arg_pos) !This code is used to parse the command line argument for the mode information and calls the required !mode module. @@ -10,7 +10,6 @@ subroutine call_mode(arg_pos,mode) implicit none integer, intent(out) :: arg_pos - character(len=100), intent(in) :: mode select case(mode) case('--create') diff --git a/src/call_option.f90 b/src/call_option.f90 index d55e1ee..aeb17b5 100644 --- a/src/call_option.f90 +++ b/src/call_option.f90 @@ -39,6 +39,8 @@ subroutine call_option(option, arg_pos) call run_delete(arg_pos) case('-set_cac') arg_pos=arg_pos +3 + case('-set_types') + arg_pos = arg_pos + 3 + atom_types case('-redef_box') call redef_box(arg_pos) case default diff --git a/src/elements.f90 b/src/elements.f90 index 6df859b..a12d263 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -13,6 +13,8 @@ module elements character(len=100), allocatable :: type_ele(:) !Element type integer, allocatable :: size_ele(:), lat_ele(:), sbox_ele(:), tag_ele(:) !Element size real(kind=dp), allocatable :: r_node(:,:,:,:) !Nodal position array + !Element result data structures + real(kind=8), allocatable :: force_node(:,:,:,:), virial_node(:,:,:,:), energy_node(:,:,:) integer, save :: ele_num !Number of elements integer, save :: node_num !Total number of nodes @@ -22,6 +24,8 @@ module elements integer, allocatable :: sbox_atom(:), tag_atom(:) real(kind =dp),allocatable :: r_atom(:,:) !atom position integer :: atom_num=0 !Number of atoms + !Atom result data structures information + real(kind=8), allocatable :: force_atom(:,:), virial_atom(:,:), energy_atom(:) !Mapping atom type to provided name character(len=2), dimension(10) :: type_to_name @@ -669,17 +673,17 @@ module elements esize = size_ele(ie) select case(iface) case(1) - pos = (/ real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp, -10.0_dp**-2.0_dp /) + pos = (/ real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp, -10.0_dp**(-2.0_dp) /) case(2) - pos = (/ real(esize-1,dp)/2.0_dp, -10.0_dp**-2.0_dp, real(esize-1,dp)/2.0_dp /) + pos = (/ real(esize-1,dp)/2.0_dp, -10.0_dp**(-2.0_dp), real(esize-1,dp)/2.0_dp /) case(3) - pos = (/ (esize-1)+10.0_dp**-2.0_dp, real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp /) + pos = (/ (esize-1)+10.0_dp**(-2.0_dp), real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp /) case(4) - pos = (/ real(esize-1,dp)/2.0_dp, (esize-1)+10.0_dp**-2.0_dp, real(esize-1,dp)/2.0_dp /) + pos = (/ real(esize-1,dp)/2.0_dp, (esize-1)+10.0_dp**(-2.0_dp), real(esize-1,dp)/2.0_dp /) case(5) - pos = (/ -10.0_dp**-2.0_dp, real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp /) + pos = (/ -10.0_dp**(-2.0_dp), real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp /) case(6) - pos = (/ real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp, (esize-1)+10.0_dp**-2.0_dp /) + pos = (/ real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp, (esize-1)+10.0_dp**(-2.0_dp) /) end select !Now transform it to real space and adjust it to the position of the element in the first node. @@ -736,4 +740,57 @@ module elements end subroutine lattice_map + subroutine alloc_dat_arrays(n,m) + !This subroutine used to provide initial allocation for the atom and element data arrays + integer, intent(in) :: n,m !n-size of element arrays, m-size of atom arrays + integer :: allostat + + !Allocate element arrays + if (n > 0) then + allocate(force_node(3,max_basisnum, max_ng_node, n), & + virial_node(6,max_basisnum, max_ng_node, n), & + energy_node(max_basisnum,max_ng_node,n), & + stat=allostat) + if(allostat > 0) then + print *, "Error allocating element data arrays in mode_metric becaus of:", allostat + stop + end if + + end if + + if (m > 0) then + allocate(force_atom(3, m), & + virial_atom(6, m), & + energy_atom(m), & + stat=allostat) + if(allostat > 0) then + print *, "Error allocating atom data arrays in mode_metric becaus of:", allostat + stop + end if + end if + + end subroutine + + subroutine add_atom_data(ia, eng, force, virial) + !Function which sets the atom data arrays + integer, intent(in) :: ia + real(kind=dp), intent(in) :: eng, force(3), virial(6) + + energy_atom(ia) = eng + force_atom(:,ia) = force(:) + virial_atom(:,ia) = virial(:) + return + end subroutine add_atom_data + + subroutine add_element_data(ie, eng, force, virial) + !Function which sets the element data arrays + integer, intent(in) :: ie + real(kind=dp), intent(in) :: eng(max_basisnum, max_ng_node), & + force(3,max_basisnum, max_ng_node), & + virial(6,max_basisnum,max_ng_node) + energy_node(:,:,ie) = eng + force_node(:,:,:,ie) = force + virial_node(:,:,:,ie) = virial + return + end subroutine add_element_data end module elements diff --git a/src/io.f90 b/src/io.f90 index 7bbf3c2..e1ec449 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -106,7 +106,7 @@ module io call write_lmpcac(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" + " is not accepted for writing. Please select from: xyz, lmp, vtk, mb, restart, cac and try again" stop end select @@ -599,9 +599,24 @@ module io infilenum=infilenum+1 infiles(infilenum) = temp_infile exit + case('out') + if(atom_types == 0) then + print *, "Please run -set_types command prior to running code requiring reading in pycac_*.out files" + stop 3 + end if + select case(trim(adjustl(mode))) + case('--convert','--metric') + infilenum = infilenum+1 + infiles(infilenum) = temp_infile + exit + case default + print *, "Files of type .out cannot be used with mode ", trim(adjustl(mode)) + stop 3 + end select + 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, restart." + "please input a filename with extension from following list: mb, restart, cac, or out." read(*,*) temp_infile end select @@ -624,9 +639,11 @@ module io call read_pycac(infiles(i), displace, temp_box_bd) case('cac') call read_lmpcac(infiles(i), displace, temp_box_bd) + case('out') + call read_pycac_out(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" + " is not accepted for reading. Please select from: mb,restart,cac,out and try again" stop end select @@ -781,7 +798,7 @@ module io integer :: i, inod, ibasis, j, k, l, in_eles, in_atoms, ele_types, in_lat_num, in_atom_types, & atom_type_map(100), etype_map(100), etype, lat_type, new_lattice_map(100), & - atom_type, stat + atom_type, stat real(kind=dp) :: newdisplace(3), r_in(3,1,8), r_in_atom(3) character(len=100) :: textholder, in_lattype_map(10) character(len=2) :: atomic_element @@ -960,6 +977,102 @@ module io end if end subroutine read_pycac + subroutine read_pycac_out(file, displace, temp_box_bd) + !This subroutine reads in the pyCAC dump file + + + !Arguments + character(len=100), intent(in) :: file + real(kind=dp), dimension(3), intent(in) :: displace + real(kind=dp), dimension(6), intent(out) :: temp_box_bd + + !Internal Variables + integer :: i, in_eles, in_atoms, inbtypes(10), lat_type, ia, ie, inod, & + id, type_node, ilat, esize, tag, type + real(kind=dp) :: newdisplace(3), ra(3), in_lapa, ea, fa(3), va(6), & + ee(1,8), fe(3,1,8), ve(3,1,8), re(3,1,8) + character(len=100) :: textholder, fcc + + + open(unit=11, file=trim(adjustl(file)), action='read',position='rewind') + + !Now initialize some important variables if they aren't defined + if (max_basisnum==0) max_basisnum = 1 + if (max_ng_node==0) max_ng_node=8 + fcc="fcc" + + !Skip header comment lines + read(11, *) textholder + read(11, *) textholder + + !Read atom number and element number and grow element arrays by needed amount + read(11,*) textholder, in_atoms, textholder, in_eles + call grow_ele_arrays(in_eles, in_atoms) + call alloc_dat_arrays(in_eles, in_atoms) + + !Read boundary information + read(11,*) textholder, box_bc(1:1), box_bc(2:2), box_bc(3:3), temp_box_bd(:) + do i = 1, 3 + if (abs(displace(i)) > lim_zero) then + newdisplace(i) = displace(i) - temp_box_bd(2*i-1) + else + newdisplace(i)=displace(i) + end if + 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 + + call grow_box(temp_box_bd) + + !Allocate sub_box boundaries + if (sub_box_num == 0) then + call alloc_sub_box(1) + else + call grow_sub_box(1) + end if + + !Because orientations and other needed sub_box information isn't really + !present within the .cac file we just default a lot of it. + sub_box_ori(:,:,sub_box_num+1) = identity_mat(3) + sub_box_bd(:, sub_box_num+1) = temp_box_bd + sub_box_num = sub_box_num + 1 + + if(in_atoms > 0 ) then + !Read atom header + read(11,*) textholder + do ia = 1, in_atoms + read(11,*) tag, type, ra(:), ea, fa(:), va(:) + call add_atom(tag, type, sub_box_num, ra) + call add_atom_data(atom_num, ea, fa, va) + end do + + end if + + if(in_eles > 0) then + !Add the lattice_types based on the atom types + inbtypes=0 + do i = 1, maxval(type_atom) + inbtypes(1) = i + call lattice_map(1, inbtypes, 8 , 1.0_dp, ilat) !Please check documentation on pycac.out formats + end do + !Read element and node headers + read(11,*) textholder + read(11,*) textholder + + !read element information, currently only 8 node elements with 1 basis + do ie =1, in_eles + read(11,*) tag, lat_type, textholder, textholder, esize + do inod =1, 8 + read(11,*) textholder, textholder, textholder, re(:,1,inod), ee(1,inod), fe(:,1,inod), ve(:,1,inod) + end do + call add_element(tag, fcc, esize+1, lat_type, sub_box_num, re) + call add_element_data(ele_num, ee, fe, ve) + end do + end if + call set_max_esize + return + end subroutine + subroutine read_lmpcac(file, displace, temp_box_bd) !This subroutine is used to read .cac files which are used with the lammpsCAC format character(len=100), intent(in) :: file @@ -980,7 +1093,7 @@ module io !Open the file open(unit=11, file=trim(adjustl(file)), action='read',position='rewind') - !Now initialiaze some important variables if they aren't defined + !Now initialize some important variables if they aren't defined if (max_basisnum==0) max_basisnum = 10 if (max_ng_node==0) max_ng_node=8 @@ -1109,4 +1222,25 @@ module io print *, in_lattice_type end subroutine set_cac + + subroutine set_types(apos) + !This code + integer, intent(in) :: apos + integer :: i, j,arglen, arg_pos, ntypes + + character(len=100) :: textholder + + arg_pos = apos + 1 + call get_command_argument(arg_pos, textholder, arglen) + if (arglen==0) stop "Missing numtypes in io" + read(textholder,*) ntypes + + do i=1,ntypes + arg_pos = arg_pos + 1 + call get_command_argument(arg_pos, textholder, arglen) + call add_atom_type(textholder, j) + end do + + return + end subroutine set_types end module io diff --git a/src/main.f90 b/src/main.f90 index 53fa4fa..b305138 100644 --- a/src/main.f90 +++ b/src/main.f90 @@ -63,6 +63,8 @@ program main case('-set_cac') call set_cac(i) + case('-set_types') + call set_types(i) end select end do !Determine if a mode is being used and what it is. The first argument has to be the mode @@ -71,7 +73,8 @@ program main argument = trim(adjustl(argument)) if (argument(1:2) == '--') then - call call_mode(end_mode_arg, argument) + mode = argument + call call_mode(end_mode_arg) end if !Check to make sure a mode was called diff --git a/src/parameters.f90 b/src/parameters.f90 index f261552..825245d 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -12,5 +12,7 @@ module parameters !Numeric constants real(kind=dp), parameter :: pi = 3.14159265358979323846_dp - + + !Mode type that is being called + character(len=100) :: mode end module parameters From 95e2ad0b4da6272945df58a91046c0b7373cf88c Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Mon, 19 Oct 2020 15:14:12 -0400 Subject: [PATCH 33/60] Current working changes to control-box code --- README.md | 7 ++++- src/box.f90 | 6 +++++ src/elements.f90 | 7 +++++ src/io.f90 | 65 ++++++++++++++++++++------------------------- src/opt_delete.f90 | 1 + src/subroutines.f90 | 61 +----------------------------------------- 6 files changed, 50 insertions(+), 97 deletions(-) diff --git a/README.md b/README.md index c83516c..036981d 100644 --- a/README.md +++ b/README.md @@ -58,7 +58,7 @@ Default duplicate is `1 1 1`. This is used to replicate the element along each d **Dimensions** ``` -dimensions dimx dimy dimz +dim dimx dimy dimz ``` There is no default dimensions as duplicate is the default option. This command assigns a box with user-assigned dimensions and fills it with the desired element. By default atoms fill in the jagged edges at the boundaries if the dimensions command is included. @@ -129,6 +129,11 @@ wrap This will wrap atomic positions back inside the box. Effectively as if periodic boundary conditions are applied so that atoms which exit from one side of the simulation cell enter back in through the other. +###Mode Metric +``` +--metric cmetric nfiles {filepaths} +``` + ## Options Options are additional portions of code which have additional functionality. Options are performed in the order that they appear in the argument list and can be added to any mode. If wanting to use strictly options use `--convert` to specify input and output files. diff --git a/src/box.f90 b/src/box.f90 index faf268c..83d81a8 100644 --- a/src/box.f90 +++ b/src/box.f90 @@ -97,4 +97,10 @@ module box end do return end subroutine in_sub_box + + subroutine reset_box + !This subroutine just resets the box boundary and position + box_bc = "ppp" + box_bd(:) = 0 + end subroutine reset_box end module box diff --git a/src/elements.f90 b/src/elements.f90 index a12d263..ab1a60e 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -793,4 +793,11 @@ module elements virial_node(:,:,:,ie) = virial return end subroutine add_element_data + + subroutine reset_data + !This function resets all of the data arrays for the elements and atoms + atom_num = 0 + ele_num = 0 + node_num = 0 + end subroutine reset_data end module elements diff --git a/src/io.f90 b/src/io.f90 index e1ec449..556ce1f 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -583,49 +583,41 @@ module io 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 an existing file to read." + stop 3 + end if - !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 + select case(temp_infile(scan(temp_infile,'.',.true.)+1:)) + case('restart', 'mb', 'cac') + infilenum=infilenum+1 + infiles(infilenum) = temp_infile + case('out') + if(atom_types == 0) then + print *, "Please run -set_types command prior to running code requiring reading in pycac_*.out files" + stop 3 end if - - select case(temp_infile(scan(temp_infile,'.',.true.)+1:)) - case('restart', 'mb', 'cac') - infilenum=infilenum+1 - infiles(infilenum) = temp_infile - exit - case('out') - if(atom_types == 0) then - print *, "Please run -set_types command prior to running code requiring reading in pycac_*.out files" - stop 3 - end if - select case(trim(adjustl(mode))) - case('--convert','--metric') - infilenum = infilenum+1 - infiles(infilenum) = temp_infile - exit - case default - print *, "Files of type .out cannot be used with mode ", trim(adjustl(mode)) - stop 3 - end select - - 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, restart, cac, or out." - read(*,*) temp_infile - + select case(trim(adjustl(mode))) + case('--convert','--metric') + infilenum = infilenum+1 + infiles(infilenum) = temp_infile + case default + print *, "Files of type .out cannot be used with mode ", trim(adjustl(mode)) + stop 3 end select - end do + + 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, restart, cac, or out." + stop 3 + end select 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 + !This subroutine reads in file i integer, intent(in) :: i real(kind=dp), dimension(3), intent(in) :: displace @@ -1067,6 +1059,7 @@ module io end do call add_element(tag, fcc, esize+1, lat_type, sub_box_num, re) call add_element_data(ele_num, ee, fe, ve) + node_num = node_num + 8 end do end if call set_max_esize diff --git a/src/opt_delete.f90 b/src/opt_delete.f90 index 09cefb1..c3bcc9e 100644 --- a/src/opt_delete.f90 +++ b/src/opt_delete.f90 @@ -3,6 +3,7 @@ module opt_delete use parameters use subroutines use elements + use neighbors implicit none diff --git a/src/subroutines.f90 b/src/subroutines.f90 index 1015968..b272c16 100644 --- a/src/subroutines.f90 +++ b/src/subroutines.f90 @@ -198,66 +198,6 @@ module subroutines end do end subroutine - subroutine build_cell_list(numinlist, r_list, rc_off, cell_num, num_in_cell, cell_list, which_cell) - !This subroutine builds a cell list based on rc_off - - !----------------------------------------Input/output variables------------------------------------------- - - integer, intent(in) :: numinlist !The number of points within r_list - - real(kind=dp), dimension(3,numinlist), intent(in) :: r_list !List of points to be used for the construction of - !the cell list. - - real(kind=dp), intent(in) :: rc_off ! Cutoff radius which dictates the size of the cells - - integer, dimension(3), intent(inout) :: cell_num !Number of cells in each dimension. - - integer, allocatable, intent(inout) :: num_in_cell(:,:,:) !Number of points within each cell - - integer, allocatable, intent(inout) :: cell_list(:,:,:,:) !Index of points from r_list within each cell. - - integer, dimension(3,numinlist), intent(out) :: which_cell !The cell index for each point in r_list - - !----------------------------------------Begin Subroutine ------------------------------------------- - - integer :: i, j, cell_lim, c(3) - real(kind=dp) :: box_len(3) - integer, allocatable :: resize_cell_list(:,:,:,:) - - !First calculate the number of cells that we need in each dimension - do i = 1,3 - box_len(i) = box_bd(2*i) - box_bd(2*i-1) - cell_num(i) = int(box_len(i)/(rc_off/2))+1 - end do - - !Initialize/allocate variables - cell_lim = 10 - allocate(num_in_cell(cell_num(1),cell_num(2),cell_num(3)), cell_list(cell_lim, cell_num(1), cell_num(2), cell_num(3))) - - !Now place points within cell - do i = 1, numinlist - !c is the position of the cell that the point belongs to - do j = 1, 3 - c(j) = int((r_list(j,i)-box_bd(2*j-1))/(rc_off/2)) + 1 - end do - - !Place the index in the correct position, growing if necessary - num_in_cell(c(1),c(2),c(3)) = num_in_cell(c(1),c(2),c(3)) + 1 - if (num_in_cell(c(1),c(2),c(3)) > cell_lim) then - allocate(resize_cell_list(cell_lim+10,cell_num(1),cell_num(2),cell_num(3))) - resize_cell_list(1:cell_lim, :, :, :) = cell_list - resize_cell_list(cell_lim+1:, :, :, :) = 0 - call move_alloc(resize_cell_list, cell_list) - end if - - cell_list(num_in_cell(c(1),c(2),c(3)),c(1),c(2),c(3)) = i - which_cell(:,i) = c - end do - - return - end subroutine build_cell_list - - subroutine check_right_ortho(ori, isortho, isrighthanded) !This subroutine checks whether provided orientations in the form: ! | x1 x2 x3 | @@ -301,4 +241,5 @@ module subroutines return end subroutine check_right_ortho + end module subroutines From 3e140df1a9e48e81fc2098e5945e0cf702cdbe74 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Mon, 19 Oct 2020 15:15:15 -0400 Subject: [PATCH 34/60] Correcting problem with README --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index c83516c..d038308 100644 --- a/README.md +++ b/README.md @@ -58,7 +58,7 @@ Default duplicate is `1 1 1`. This is used to replicate the element along each d **Dimensions** ``` -dimensions dimx dimy dimz +dim dimx dimy dimz ``` There is no default dimensions as duplicate is the default option. This command assigns a box with user-assigned dimensions and fills it with the desired element. By default atoms fill in the jagged edges at the boundaries if the dimensions command is included. From 6e085176975f908e1e5421cceb76892b8edc4fed Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Tue, 20 Oct 2020 01:03:31 -0400 Subject: [PATCH 35/60] Working continuum metric calculation code --- src/Makefile | 5 +- src/call_mode.f90 | 3 + src/elements.f90 | 10 +- src/functions.f90 | 120 ++++++++++++++++++++++ src/io.f90 | 4 +- src/main.f90 | 12 ++- src/mode_metric.f90 | 245 ++++++++++++++++++++++++++++++++++++++++++++ src/neighbors.f90 | 142 +++++++++++++++++++++++++ 8 files changed, 531 insertions(+), 10 deletions(-) create mode 100644 src/mode_metric.f90 create mode 100644 src/neighbors.f90 diff --git a/src/Makefile b/src/Makefile index c58e37c..6106104 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,9 +1,9 @@ FC=ifort FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays #FFLAGS=-mcmodel=large -Ofast -no-wrap-margin -heap-arrays -MODES=mode_create.o mode_merge.o mode_convert.o +MODES=mode_create.o mode_merge.o mode_convert.o mode_metric.o OPTIONS=opt_disl.o opt_group.o opt_orient.o opt_delete.o opt_deform.o opt_redef_box.o -OBJECTS=main.o elements.o io.o subroutines.o functions.o atoms.o call_mode.o box.o $(MODES) $(OPTIONS) call_option.o sorts.o +OBJECTS=main.o elements.o io.o subroutines.o functions.o atoms.o call_mode.o box.o neighbors.o $(MODES) $(OPTIONS) call_option.o sorts.o .SUFFIXES: .SUFFIXES: .c .f .f90 .F90 .o @@ -42,3 +42,4 @@ elements.o : sorts.o $(MODES) $(OPTIONS) subroutines.o io.o : atoms.o box.o $(MODES) main.o : io.o testfuncs.o elements.o mode_create.o $(OPTIONS) $(MODES): subroutines.o +opt_delete.o mode_metric.o : neighbors.o diff --git a/src/call_mode.f90 b/src/call_mode.f90 index 7eae059..8d73e25 100644 --- a/src/call_mode.f90 +++ b/src/call_mode.f90 @@ -5,6 +5,7 @@ subroutine call_mode(arg_pos) use mode_create use mode_convert use mode_merge + use mode_metric use parameters implicit none @@ -18,6 +19,8 @@ subroutine call_mode(arg_pos) call convert(arg_pos) case('--merge') call merge(arg_pos) + case('--metric') + call metric(arg_pos) case default print *, "Mode ", trim(adjustl(mode)), " currently not accepted. Please check documentation for ", & "accepted modes and rerun." diff --git a/src/elements.f90 b/src/elements.f90 index ab1a60e..1254a43 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -747,24 +747,30 @@ module elements !Allocate element arrays if (n > 0) then + if (allocated(force_node)) then + deallocate(force_node, virial_node, energy_node) + end if allocate(force_node(3,max_basisnum, max_ng_node, n), & virial_node(6,max_basisnum, max_ng_node, n), & energy_node(max_basisnum,max_ng_node,n), & stat=allostat) if(allostat > 0) then - print *, "Error allocating element data arrays in mode_metric becaus of:", allostat + print *, "Error allocating element data arrays in mode_metric because of:", allostat stop end if end if if (m > 0) then + if (allocated(force_atom)) then + deallocate(force_atom, virial_atom, energy_atom) + end if allocate(force_atom(3, m), & virial_atom(6, m), & energy_atom(m), & stat=allostat) if(allostat > 0) then - print *, "Error allocating atom data arrays in mode_metric becaus of:", allostat + print *, "Error allocating atom data arrays in mode_metric because of:", allostat stop end if end if diff --git a/src/functions.f90 b/src/functions.f90 index 6fed2b7..0a8bc49 100644 --- a/src/functions.f90 +++ b/src/functions.f90 @@ -271,4 +271,124 @@ END FUNCTION StrDnCase norm_dis(1:3) = (rk - rl) norm_dis(4) = norm2(rk-rl) end function + + pure function matinv3(A) result(B) + !! Performs a direct calculation of the inverse of a 3×3 matrix. + real(kind=dp), intent(in) :: A(3,3) !! Matrix + real(kind=dp) :: B(3,3) !! Inverse matrix + real(kind=dp) :: detinv + + if(abs(A(1,1)*A(2,2)*A(3,3) - A(1,1)*A(2,3)*A(3,2)& + - A(1,2)*A(2,1)*A(3,3) + A(1,2)*A(2,3)*A(3,1)& + + A(1,3)*A(2,1)*A(3,2) - A(1,3)*A(2,2)*A(3,1)) < lim_zero) then + B(:,:) = 0 + return + else + ! Calculate the inverse determinant of the matrix + + detinv = 1/(A(1,1)*A(2,2)*A(3,3) - A(1,1)*A(2,3)*A(3,2)& + - A(1,2)*A(2,1)*A(3,3) + A(1,2)*A(2,3)*A(3,1)& + + A(1,3)*A(2,1)*A(3,2) - A(1,3)*A(2,2)*A(3,1)) + + ! Calculate the inverse of the matrix + B(1,1) = +detinv * (A(2,2)*A(3,3) - A(2,3)*A(3,2)) + B(2,1) = -detinv * (A(2,1)*A(3,3) - A(2,3)*A(3,1)) + B(3,1) = +detinv * (A(2,1)*A(3,2) - A(2,2)*A(3,1)) + B(1,2) = -detinv * (A(1,2)*A(3,3) - A(1,3)*A(3,2)) + B(2,2) = +detinv * (A(1,1)*A(3,3) - A(1,3)*A(3,1)) + B(3,2) = -detinv * (A(1,1)*A(3,2) - A(1,2)*A(3,1)) + B(1,3) = +detinv * (A(1,2)*A(2,3) - A(1,3)*A(2,2)) + B(2,3) = -detinv * (A(1,1)*A(2,3) - A(1,3)*A(2,1)) + B(3,3) = +detinv * (A(1,1)*A(2,2) - A(1,2)*A(2,1)) + end if + end function + + pure function transpose3(A) result(B) + !!Transposes matrix A + real(kind=dp), intent(in) :: A(3,3) + real(kind=dp) :: B(3,3) + + integer :: i, j + forall(i =1:3,j=1:3) B(i,j) = A(j,i) + + end function transpose3 + + pure function sqrt3(A) result(B) + !This calculates the square of matrix A fulfilling the equation B*B = A according to + !the algorithm by Franca1989 + + real(kind=dp), intent(in) :: A(3,3) + real(kind=dp) :: B(3,3) + + real(kind=dp) :: Ione, Itwo, Ithree, l, k, phi, Asq(3,3), lambda, Bone, Btwo, Bthree, p + + !Step 1 is calculating the invariants of C + Ione = A(1,1) + A(2,2) + A(3,3) + Asq = matmul(A,A) + Itwo = 0.5_dp *(Ione*Ione - (Asq(1,1) + Asq(2,2) + Asq(3,3))) + Ithree = (A(1,1)*A(2,2)*A(3,3) - A(1,1)*A(2,3)*A(3,2)& + - A(1,2)*A(2,1)*A(3,3) + A(1,2)*A(2,3)*A(3,1)& + + A(1,3)*A(2,1)*A(3,2) - A(1,3)*A(2,2)*A(3,1)) + + if (Ithree < 0) then + B(:,:)=0.0_dp + return + end if + !Check for an isotropic matrix + k = Ione*Ione - 3*Itwo + if (k < lim_zero) then + lambda = sqrt(Ione/3.0_dp) + B = lambda*identity_mat(3) + else + l = Ione*(Ione*Ione - 9.0_dp/2.0_dp * Itwo) + 27.0_dp/2.0_dp * Ithree + p = l/(k**(1.5_dp)) + + if (p > 1.0 ) then + B(:,:) = 0.0_dp + return + end if + + if ((p< -1).or.(p>1)) then + B(:,:) = 0.0_dp + return + end if + phi = acos(p) + lambda = sqrt(1.0_dp/3.0_dp * (Ione + 2*sqrt(k)*cos(phi/3))) + + !Now calculate invariantes of B + Bthree = sqrt(Ithree) + if((-lambda*lambda + Ione + 2*Ithree/lambda) < 0) then + B(:,:) = 0.0_dp + return + end if + Bone = lambda + sqrt(- lambda*lambda + Ione + 2*Ithree/lambda) + Btwo = (Bone*Bone - Ione)/2.0_dp + + !Now calculate B + if(abs(Bone*Btwo -Bthree) < lim_zero) then + B(:,:) = 0.0_dp + return + end if + B = 1/(Bone*Btwo - Bthree) *(Bone*Bthree*identity_mat(3) + (Bone*Bone - Btwo)*A - matmul(A,A)) + end if + end function sqrt3 + + pure function permutation(i,j,k) result(e) + !Calculates the permutation tensor + integer, intent(in) :: i,j,k + integer :: e + + if ( ((i==1).and.(j==2).and.(k==3)).or. & + ((i==2).and.(j==3).and.(k==1)).or. & + ((i==3).and.(j==1).and.(k==2))) then + e=1 + else if( ((i==2).and.(j==1).and.(k==3)).or. & + ((i==1).and.(j==3).and.(k==2)).or. & + ((i==3).and.(j==2).and.(k==1))) then + e=-1 + else + e=0 + end if + end function permutation + end module functions diff --git a/src/io.f90 b/src/io.f90 index 556ce1f..9c02ba1 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -984,6 +984,7 @@ module io real(kind=dp) :: newdisplace(3), ra(3), in_lapa, ea, fa(3), va(6), & ee(1,8), fe(3,1,8), ve(3,1,8), re(3,1,8) character(len=100) :: textholder, fcc + character(len=1000) :: line open(unit=11, file=trim(adjustl(file)), action='read',position='rewind') @@ -1033,7 +1034,8 @@ module io !Read atom header read(11,*) textholder do ia = 1, in_atoms - read(11,*) tag, type, ra(:), ea, fa(:), va(:) + read(11,'(a)') line(:) + read(line,*) tag, type, ra(:), ea, fa(:), va(:) call add_atom(tag, type, sub_box_num, ra) call add_atom_data(atom_num, ea, fa, va) end do diff --git a/src/main.f90 b/src/main.f90 index b305138..9f7a484 100644 --- a/src/main.f90 +++ b/src/main.f90 @@ -111,11 +111,13 @@ program main if(bound_called) call def_new_box !Check to make sure a file was passed to be written out and then write out - ! Before building do a check on the file - if (outfilenum == 0) then - argument = 'none' - call get_out_file(argument) + ! Before building do a check on the file + if (trim(adjustl(mode)) /= "--metric") then + if ((outfilenum == 0)) then + argument = 'none' + call get_out_file(argument) + end if + call write_out end if - call write_out end program main diff --git a/src/mode_metric.f90 b/src/mode_metric.f90 new file mode 100644 index 0000000..279e710 --- /dev/null +++ b/src/mode_metric.f90 @@ -0,0 +1,245 @@ +module mode_metric + !This mode is used to calculate continuum metrics for the j + + use parameters + use io + use elements + use neighbors + + implicit none + + integer :: nfiles + character(len=100) :: metric_type + real(kind=dp), allocatable :: met(:,:) + + !Save reference positions + integer :: np, npreal, nmet + real(kind=dp), allocatable :: r_zero(:,:), r_curr(:,:) + + public + contains + subroutine metric(arg_pos) + !This is the main calling subroutine for the metric code + integer, intent(out) :: arg_pos + character(len=100) :: infile, outfile + + integer :: i, ibasis, inod, np_temp, ppos + real(kind=dp), dimension(6) :: temp_box_bd + + !These are the variables containing the cell list information + integer, dimension(3) :: cell_num + integer, allocatable :: num_in_cell(:,:,:), which_cell(:,:) + integer, allocatable :: cell_list(:,:,:,:) + + !Parse the command arguments + call parse_command(arg_pos) + + !Now read the first file + call read_in(1, (/ 0.0_dp, 0.0_dp, 0.0_dp /), temp_box_bd) + np = atom_num + max_basisnum*max_ng_node*ele_num + print *,np + allocate(r_zero(3,atom_num+max_basisnum*max_ng_node*ele_num), & + r_curr(3,atom_num+max_basisnum*max_ng_node*ele_num)) + r_zero(:,:) = -huge(1.0_dp) + + !Set up the met variable for the user desired metric + select case(trim(adjustl(metric_type))) + case('def_grad') + allocate(met(9, np)) + case('microrotation') + allocate(met(3,np)) + end select + + !Now set the reference positions + call convert_positions(r_zero, npreal) + + !Now calculate the neighbor list for the reference configuration + call calc_neighbor(5.0_dp, r_zero, np) + + !Reset element and box + call reset_data + call reset_box + + !Now loop over new files + do i = 2, nfiles + call read_in(i, (/ 0.0_dp, 0.0_dp, 0.0_dp /), temp_box_bd) + call convert_positions(r_curr, np_temp) + if (npreal /= np_temp) then + print *, "Error in mode_metric where number of points in ", i, "th file is ", np_temp, " and number of points in" & + // "reference file is", npreal + end if + call calc_metric + !Now create the output file num and write out to xyz format + ppos = scan(trim(infiles(i)),".", BACK= .true.) + if ( ppos > 0 ) then + outfile = infiles(i)(1:ppos)//'xyz' + else + outfile = infiles(i)//'.xyz' + end if + call write_metric_xyz(outfile) + call reset_data + call reset_box + end do + end subroutine metric + + subroutine parse_command(arg_pos) + !This subroutine parses the arguments for mode metric + integer, intent(out) :: arg_pos + + integer :: i, arglen + character(len=100) :: textholder + logical :: file_exists + + !First read the metric to be used + call get_command_argument(2,metric_type,arglen) + if (arglen == 0) stop "Incomplete mode metric command, check documentation" + select case(trim(adjustl(metric_type))) + case("microrotation") + continue + case default + print *, "Mode metric does not accept metric ", metric_type, ". Please select from: microrotation" + stop 3 + end select + + !Now read the number of files to read and allocate the variables + call get_command_argument(3, textholder, arglen) + if (arglen == 0) stop "Incomplete mode metric command, check documentation" + read(textholder, *) nfiles + + !Now read the files to be read + do i = 1, nfiles + call get_command_argument(3+i, textholder, arglen) + call get_in_file(textholder) + end do + + arg_pos = 4+nfiles + return + end subroutine parse_command + + subroutine calc_metric + !This subroutine calculates the continuum metric that we require + integer :: i, j, k, nei, ip, jp + real(kind=dp) :: def_grad(3,3), omega(3,3), eta(3,3), rij(3), eta_inv(3,3), ftf(3,3), & + U(3,3), R(3,3), Rskew(3,3), oldrij(3) + + !Loop over all points + do ip = 1, np + eta(:,:) = 0.0_dp + omega(:,:) = 0.0_dp + def_grad(:,:) = 0.0_dp + do jp = 1, nei_num(ip) + !Calculate the neighbor vec in current configuration + nei = nei_list(jp, ip) + rij = r_curr(:,nei) - r_curr(:,ip) + oldrij = r_zero(:,nei) - r_zero(:,ip) + + !Calculate eta and omega + do i = 1,3 + do j = 1,3 + omega(i,j) = omega(i,j) + rij(i) * oldrij(j) + eta(i,j) = eta(i,j) + oldrij(i) * oldrij(j) + end do + end do + end do + + eta_inv=matinv3(eta) + def_grad=matmul(omega,eta_inv) + + select case(trim(adjustl(metric_type))) + case('def_grad') + k = 1 + do i = 1,3 + do j = 1, 3 + met(k, ip) = def_grad(i,j) + end do + end do + case('microrotation') + met(:,ip) = 0.0_dp + if(.not.all(def_grad == 0)) then + !Now calculate microrotation + ftf = matmul(transpose3(def_grad), def_grad) + U = sqrt3(ftf) + if(.not.all(abs(U) < lim_zero)) then + R = matmul(def_grad, matinv3(U)) + Rskew = 0.5_dp * ( R - transpose3(R)) + do k =1,3 + do j = 1,3 + do i = 1,3 + met(k,ip) = met(k,ip) -0.5*permutation(i,j,k)*Rskew(i,j) + end do + end do + end do + end if + end if + end select + end do + return + end subroutine + + subroutine convert_positions(rout, npoints) + !This subroutine just converts current atom and element arrays to a single point based form + real(kind=dp), dimension(3,atom_num+max_ng_node*max_basisnum*ele_num), intent(inout) :: rout + integer, intent(out) :: npoints + + integer :: i, inod, ibasis + + npoints=0 + print *, atom_num + max_ng_node*max_basisnum*ele_num + print *, rout(:,1) + + if(atom_num > 0) then + do i = 1, atom_num + rout(:,tag_atom(i)) = r_atom(:,i) + npoints = npoints + 1 + end do + end if + + if (ele_num > 0) then + do i = 1, ele_num + do inod = 1, ng_node(lat_ele(i)) + do ibasis = 1, basisnum(lat_ele(i)) + rout(:, atom_num+(tag_ele(i)-1)*max_ng_node*max_basisnum + (inod-1)*max_basisnum + ibasis) & + = r_node(:,ibasis,inod,i) + npoints = npoints + 1 + end do + end do + end do + end if + + end subroutine convert_positions + + subroutine write_metric_xyz(outfile) + character(len=100), intent(in) :: outfile + + integer :: i, inod, ibasis + real(kind = dp) :: r(3), eng + open (unit=11, file=trim(adjustl(outfile)), action='write', position='rewind', status = 'replace') + !Write the header + write(11,*) npreal + + select case(metric_type) + case('def_grad') + write(11,*) "type x y z F11 F12 F13 F21 F22 F23 F31 F32 F33" + case('microrotation') + write(11,*) "type x y z micro1 micro2 micro3" + end select + + if(atom_num > 0) then + do i = 1, atom_num + write(11,*) type_atom(i), r_atom(:,i), met(:,tag_atom(i)) + end do + end if + + if (ele_num > 0) then + do i = 1, ele_num + do inod = 1, ng_node(lat_ele(i)) + do ibasis = 1, basisnum(lat_ele(i)) + write(11,*) basis_type(ibasis,lat_ele(i)), r_node(:,ibasis,inod,i), & + met(:, atom_num+(tag_ele(i)-1)*max_ng_node*max_basisnum + (inod-1)*max_basisnum + ibasis) + end do + end do + end do + end if + end subroutine write_metric_xyz + +end module mode_metric diff --git a/src/neighbors.f90 b/src/neighbors.f90 new file mode 100644 index 0000000..0faebca --- /dev/null +++ b/src/neighbors.f90 @@ -0,0 +1,142 @@ +module neighbors + + use parameters + use elements + use subroutines + use functions + + integer, allocatable :: nei_list(:,:), nei_num(:) + real(kind=dp), allocatable :: init_vec(:,:,:), output(:), microrotation(:,:) + public + contains + + subroutine build_cell_list(numinlist, r_list, rc_off, cell_num, num_in_cell, cell_list, which_cell) + !This subroutine builds a cell list based on rc_off + + !----------------------------------------Input/output variables------------------------------------------- + + integer, intent(in) :: numinlist !The number of points within r_list + + real(kind=dp), dimension(3,numinlist), intent(in) :: r_list !List of points to be used for the construction of + !the cell list. + + real(kind=dp), intent(in) :: rc_off ! Cutoff radius which dictates the size of the cells + + integer, dimension(3), intent(inout) :: cell_num !Number of cells in each dimension. + + integer, allocatable, intent(inout) :: num_in_cell(:,:,:) !Number of points within each cell + + integer, allocatable, intent(inout) :: cell_list(:,:,:,:) !Index of points from r_list within each cell. + + integer, dimension(3,numinlist), intent(out) :: which_cell !The cell index for each point in r_list + + !----------------------------------------Begin Subroutine ------------------------------------------- + + integer :: i, j, cell_lim, c(3) + real(kind=dp) :: box_len(3) + integer, allocatable :: resize_cell_list(:,:,:,:) + + !First calculate the number of cells that we need in each dimension + do i = 1,3 + box_len(i) = box_bd(2*i) - box_bd(2*i-1) + cell_num(i) = int(box_len(i)/(rc_off/2))+1 + end do + + !Initialize/allocate variables + cell_lim = 10 + allocate(num_in_cell(cell_num(1),cell_num(2),cell_num(3)), cell_list(cell_lim, cell_num(1), cell_num(2), cell_num(3))) + + !Now place points within cell + do i = 1, numinlist + !Check to see if the current point is a filler point and if so just skip it + if(r_list(1,i) < -huge(1.0_dp)+1) cycle + + !c is the position of the cell that the point belongs to + do j = 1, 3 + c(j) = int((r_list(j,i)-box_bd(2*j-1))/(rc_off/2)) + 1 + end do + + !Place the index in the correct position, growing if necessary + num_in_cell(c(1),c(2),c(3)) = num_in_cell(c(1),c(2),c(3)) + 1 + if (num_in_cell(c(1),c(2),c(3)) > cell_lim) then + allocate(resize_cell_list(cell_lim+10,cell_num(1),cell_num(2),cell_num(3))) + resize_cell_list(1:cell_lim, :, :, :) = cell_list + resize_cell_list(cell_lim+1:, :, :, :) = 0 + call move_alloc(resize_cell_list, cell_list) + end if + + cell_list(num_in_cell(c(1),c(2),c(3)),c(1),c(2),c(3)) = i + which_cell(:,i) = c + end do + + return + end subroutine build_cell_list + + subroutine calc_neighbor(rc_off, r_list, n) + !This function populates the neighbor list in this module + + real(kind=dp), intent(in) :: rc_off + integer, intent(in) :: n + real(kind=dp), dimension(3,n) :: r_list + + integer :: i, c(3), ci, cj, ck, num_nei, nei + !Variables for cell list code + integer, dimension(3) ::cell_num + integer, allocatable :: num_in_cell(:,:,:), cell_list(:,:,:,:) + integer :: which_cell(3,n) + + !First reallocate the neighbor list codes + if (allocated(nei_list)) then + deallocate(nei_list,nei_num) + end if + + allocate(nei_list(100,n),nei_num(n)) + + !Now first pass the position list and and point num to the cell algorithm + call build_cell_list(n, r_list, rc_off, cell_num, num_in_cell, cell_list, which_cell) + + !Now loop over every point and find it's neighbors + pointloop: do i = 1, n + + !First check to see if the point is a filler point, if so then skip it + if(r_list(1,i) < -Huge(-1.0_dp)+1) cycle + + !c is the position of the cell that the point + c = which_cell(:,i) + + !Loop over all neighboring cells + do ci = -1, 1, 1 + do cj = -1, 1, 1 + do ck = -1, 1, 1 + !First check to make sure that the neighboring cell exists + if(any((c + (/ ck, cj, ci /)) == 0)) cycle + if( (c(1) + ck > cell_num(1)).or.(c(2) + cj > cell_num(2)).or. & + (c(3) + ci > cell_num(3))) cycle + + do num_nei = 1, num_in_cell(c(1) + ck, c(2) + cj, c(3) + ci) + nei = cell_list(num_nei,c(1) + ck, c(2) + cj, c(3) + ci) + + !Check to make sure the atom isn't the same index as the atom we are checking + !and that the neighbor hasn't already been deleted + if((nei /= i)) then + + !Now check to see if it is in the cutoff radius, if it is add it to the neighbor list for that + !atom and calculate the initial neighbor vector + if (norm2(r_list(:,nei)-r_list(:,i)) < rc_off) then + + nei_num(i) = nei_num(i) + 1 + nei_list(nei_num(i), i) = nei + + end if + end if + end do + end do + end do + end do + + end do pointloop + + return + end subroutine calc_neighbor + +end module neighbors From 2ea388b82ad3c49ab5cb0c7c7e5699e68369fb4c Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Fri, 23 Oct 2020 11:37:28 -0400 Subject: [PATCH 36/60] Current working changes with some updates to comments for accuracy --- src/elements.f90 | 5 ++--- src/mode_metric.f90 | 18 ++++++++++-------- src/opt_disl.f90 | 1 - src/opt_group.f90 | 2 +- 4 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/elements.f90 b/src/elements.f90 index 1254a43..226eb60 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -501,6 +501,7 @@ module elements !We go from largest index to smallest index just to make sure that we don't miss !accidentally overwrite values which need to be deleted do i = num, 1, -1 + node_num = node_num - ng_node(lat_ele(sorted_index(i))) if(sorted_index(i) == ele_num) then r_node(:,:,:,sorted_index(i)) = 0.0_dp type_ele(sorted_index(i)) ='' @@ -509,7 +510,6 @@ module elements sbox_ele(sorted_index(i)) = 0 tag_ele(sorted_index(i)) = 0 else - node_num = node_num - ng_node(lat_ele(sorted_index(i))) r_node(:,:,:,sorted_index(i)) = r_node(:,:,:,ele_num) type_ele(sorted_index(i)) = type_ele(ele_num) size_ele(sorted_index(i)) = size_ele(ele_num) @@ -538,8 +538,7 @@ module elements max_bd(:) = -huge(1.0_dp) min_bd(:) = huge(1.0_dp) - - do i = 1, atom_num +do i = 1, atom_num do j = 1, 3 if (r_atom(j,i) > max_bd(j)) max_bd(j) = r_atom(j,i) + tol if (r_atom(j,i) < min_bd(j)) min_bd(j) = r_atom(j,i) - tol diff --git a/src/mode_metric.f90 b/src/mode_metric.f90 index 279e710..10838c6 100644 --- a/src/mode_metric.f90 +++ b/src/mode_metric.f90 @@ -10,11 +10,11 @@ module mode_metric integer :: nfiles character(len=100) :: metric_type - real(kind=dp), allocatable :: met(:,:) + real(kind=dp) :: rc_off !Save reference positions integer :: np, npreal, nmet - real(kind=dp), allocatable :: r_zero(:,:), r_curr(:,:) + real(kind=dp), allocatable :: r_zero(:,:), r_curr(:,:), met(:,:) public contains @@ -37,7 +37,6 @@ module mode_metric !Now read the first file call read_in(1, (/ 0.0_dp, 0.0_dp, 0.0_dp /), temp_box_bd) np = atom_num + max_basisnum*max_ng_node*ele_num - print *,np allocate(r_zero(3,atom_num+max_basisnum*max_ng_node*ele_num), & r_curr(3,atom_num+max_basisnum*max_ng_node*ele_num)) r_zero(:,:) = -huge(1.0_dp) @@ -101,18 +100,23 @@ module mode_metric stop 3 end select + !Now read the cutoff radius + call get_command_argument(3,textholder,arglen) + if (arglen == 0) stop "Incomplete mode metric command, check documentation" + read(textholder, *) rc_off + !Now read the number of files to read and allocate the variables - call get_command_argument(3, textholder, arglen) + call get_command_argument(4, textholder, arglen) if (arglen == 0) stop "Incomplete mode metric command, check documentation" read(textholder, *) nfiles !Now read the files to be read do i = 1, nfiles - call get_command_argument(3+i, textholder, arglen) + call get_command_argument(4+i, textholder, arglen) call get_in_file(textholder) end do - arg_pos = 4+nfiles + arg_pos = 5+nfiles return end subroutine parse_command @@ -184,8 +188,6 @@ module mode_metric integer :: i, inod, ibasis npoints=0 - print *, atom_num + max_ng_node*max_basisnum*ele_num - print *, rout(:,1) if(atom_num > 0) then do i = 1, atom_num diff --git a/src/opt_disl.f90 b/src/opt_disl.f90 index 19f8ed8..dc0e72c 100644 --- a/src/opt_disl.f90 +++ b/src/opt_disl.f90 @@ -561,7 +561,6 @@ module opt_disl !Now reset the list for the scanning algorithm delete_num = 0 - !Now scan over all atoms again and find the closest vloop_size number of atoms to the initial atom !that reside on the same plane. If loop_radius is > 0 then we build a circular vacancy cluster if(loop_radius > 0) then do i = 1, atom_num diff --git a/src/opt_group.f90 b/src/opt_group.f90 index 855e04e..33cf685 100644 --- a/src/opt_group.f90 +++ b/src/opt_group.f90 @@ -87,7 +87,7 @@ module opt_group continue case default print *, "Select_type ", trim(adjustl(type)), " is not an accept group selection criteria. ", & - "Please select from atoms, nodes, or both." + "Please select from atoms, elements, or both." end select arg_pos = arg_pos + 1 From b5629b1563940375f69b770a9af9a7b996e5cead Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Fri, 23 Oct 2020 14:13:35 -0400 Subject: [PATCH 37/60] Working changes to slip_plane code --- src/Makefile | 2 +- src/call_option.f90 | 3 +++ src/elements.f90 | 20 ++++++++++++++++++++ src/mode_create.f90 | 2 +- src/parameters.f90 | 3 ++- 5 files changed, 27 insertions(+), 3 deletions(-) diff --git a/src/Makefile b/src/Makefile index feb933f..3b170e7 100644 --- a/src/Makefile +++ b/src/Makefile @@ -2,7 +2,7 @@ FC=ifort FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays #FFLAGS=-mcmodel=large -Ofast -no-wrap-margin -heap-arrays MODES=mode_create.o mode_merge.o mode_convert.o -OPTIONS=opt_disl.o opt_group.o opt_orient.o opt_delete.o opt_deform.o opt_redef_box.o +OPTIONS=opt_disl.o opt_group.o opt_orient.o opt_delete.o opt_deform.o opt_redef_box.o opt_slip_plane.o OBJECTS=main.o elements.o io.o subroutines.o functions.o atoms.o call_mode.o box.o $(MODES) $(OPTIONS) call_option.o sorts.o .SUFFIXES: diff --git a/src/call_option.f90 b/src/call_option.f90 index d55e1ee..af63333 100644 --- a/src/call_option.f90 +++ b/src/call_option.f90 @@ -6,6 +6,7 @@ subroutine call_option(option, arg_pos) use opt_deform use opt_delete use opt_redef_box + use opt_slip_plane use box implicit none @@ -41,6 +42,8 @@ subroutine call_option(option, arg_pos) arg_pos=arg_pos +3 case('-redef_box') call redef_box(arg_pos) + case('-slip_plane') + call run_slip_plane(arg_pos) case default print *, 'Option ', trim(adjustl(option)), ' is not currently accepted.' stop 3 diff --git a/src/elements.f90 b/src/elements.f90 index 6df859b..a1ab9bc 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -736,4 +736,24 @@ module elements end subroutine lattice_map + subroutine get_interp_pos(i,j,k, ie, r) + !This returns the position of an interpolated basis from an element ie. + !i, j, k should be in natural coordinates + + integer, intent(in) :: i, j, k, r, s, t, ie, inod -= + real(kind=dp), dimension(3,max_basisnum), intent(out) :: r + + r = (1.0_dp*(i-1)-(size_ele(ie)-1)/2)/(1.0_dp*(size_ele(ie)-1)/2) + s = (1.0_dp*(j-1)-(size_ele(ie)-1)/2)/(1.0_dp*(size_ele(ie)-1)/2) + t = (1.0_dp*(k-1)-(size_ele(ie)-1)/2)/(1.0_dp*(size_ele(ie)-1)/2) + r(:) = 0 + do ibasis = 1, bnum + do inod = 1, 8 + r(:,ibasis) = r(:,ibasis) + a_shape(inod) * r_node(:,ibasis,inod,ie) + end do + end do + + + end subroutine + end module elements diff --git a/src/mode_create.f90 b/src/mode_create.f90 index bcec2d5..00d7d8b 100644 --- a/src/mode_create.f90 +++ b/src/mode_create.f90 @@ -528,7 +528,7 @@ module mode_create do i = 1, 3 filzero(i) = bd_ele_lat(2*i-1) -1 end do - do while(efill_size>9) + do while(efill_size>min_efillsize) !First check whether there are enough lattice points to house the current element size efill_ele=cubic_cell*(efill_size-1) if (nump_ele < efill_size**3) then diff --git a/src/parameters.f90 b/src/parameters.f90 index f261552..8677381 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -3,7 +3,8 @@ module parameters implicit none !Default precision - integer, parameter :: dp= selected_real_kind(15,307) + integer, parameter :: dp= selected_real_kind(15,307), & + min_efillsize = 11 !Parameters for floating point tolerance real(kind=dp), parameter :: lim_zero = epsilon(1.0_dp), & lim_large = huge(1.0_dp), & From 22e250093b1a9fc1c7f9c5fcf60e7162aef13fad Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Fri, 23 Oct 2020 17:17:40 -0400 Subject: [PATCH 38/60] Working changes. Working on the efill code --- src/elements.f90 | 4 +- src/opt_slip_plane.f90 | 151 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 153 insertions(+), 2 deletions(-) create mode 100644 src/opt_slip_plane.f90 diff --git a/src/elements.f90 b/src/elements.f90 index a1ab9bc..42eec2d 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -747,8 +747,8 @@ module elements s = (1.0_dp*(j-1)-(size_ele(ie)-1)/2)/(1.0_dp*(size_ele(ie)-1)/2) t = (1.0_dp*(k-1)-(size_ele(ie)-1)/2)/(1.0_dp*(size_ele(ie)-1)/2) r(:) = 0 - do ibasis = 1, bnum - do inod = 1, 8 + do ibasis = 1, basisnum(lat_ele(ie)) + do inod = 1, ng_node(lat_ele(ie)) r(:,ibasis) = r(:,ibasis) + a_shape(inod) * r_node(:,ibasis,inod,ie) end do end do diff --git a/src/opt_slip_plane.f90 b/src/opt_slip_plane.f90 new file mode 100644 index 0000000..36a3d4d --- /dev/null +++ b/src/opt_slip_plane.f90 @@ -0,0 +1,151 @@ +module opt_slip_plane + use parameters + use elements + use functions + use subroutines + + implicit none + + integer :: sdim + real(kind=dp) :: spos + logical :: efill + + public + contains + + subroutine run_slip_plane(arg_pos) + !Main calling function for the slip_plane option + integer, intent(inout) :: arg_pos + + integer :: ie, ia, slip_enum, old_atom_num, esize, new_ele_num, n, m, o, ele(3,8), nump_ele, inod, vlat(3), & + rfill(3,max_basisnum, max_ng_node) + + integer, allocatable :: slip_eles(:), temp_int(:) + real(kind=dp) :: r_interp(3, max_basisnum*max_esize**3) + integer :: type_interp(max_basisnum*max_esize**3) + logical :: lat_points(max_esize,max_esize, max_esize) + + + print *, '---------------------Option Slip_Plane----------------------' + + !Initialize variables + efill = .false. + slip_enum = 0 + old_atom_num = atom_num + + !!Parse the argument + call parse(arg_pos) + + + !If we are running the efill code then we have to initiate some variables + if(efill) then + new_ele_num = 0 + end if + allocate(slip_eles(1024)) + !Now loop over all elements, find which ones intersect + do ie = 1, ele_num + if( (spos < maxval(r_node(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie)),ie))).and. & + (spos > minval(r_node(sdim,1:basisnum(lat_ele(ie),1:ng_node(lat_ele(ie)),ie)))) then + slip_enum = slip_enum + 1 + if (slip_enum > size(slip_eles)) then + allocate(temp_int(size(slip_eles)+1024)) + temp_int(1:size(slip_eles)) = slip_eles + temp_int(size(slip_eles)+1:) = 0 + call move_alloc(temp_int, slip_eles) + end if + slip_eles(slip_enum) = ie + + !If we aren't efilling then just refine the element + if(.not.efill) then + call interpolate_atoms(type_ele(ie), size_ele(ie), lat_ele(ie), r_node(:,:,:,ie), type_interp, r_interp) + do ia = 1, basisnum(lat_ele(ie)) * size_ele(ie)**3 + call apply_periodic(r_interp(:,ia)) + call add_atom(0, type_interp(ia), sbox_ele(ie), r_interp(:,ia)) + end do + !If we are efilling then the code is slightly more complex + else + !First populate the lat points array + lat_points(1:size_ele(ie),1:size_ele(ie), 1:size_ele(ie)) = .true. + + !Now start trying to remesh the region, leaving the slip plane as a discontinuity + esize = size_ele(ie) - 2 + nump_ele = size_ele(ie)**3 + do while(esize > min_efillsize + if(nump_ele < esize**3) then + esize = esize - 2 + else + ele = cubic_cell*(esize -1) + do o = 1, size_ele(ie) - esize + do n = 1, size_ele(ie) - esize + do m = 1, size_ele(ie) - esize + do inod = 1, ng_node(lat_ele(ie) + vlat = ele(:,inod) + (/ m, n, o /) + call get_interp_pos(vlat(1), vlat(2), vlat(3), ie, rfill(:,:,inod)) + + end do + !Check to see if the plane intersects this element if not then add it + if((spos < maxval(rfill(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie)),ie))).and. & + (spos > minval(rfill(sdim,1:basisnum(lat_ele(ie),1:ng_node(lat_ele(ie)),ie)))) then + nump_ele = nump_ele - esize**3 + + end if + end do + end do + end do + end if + end if + end if + end do + + !Once we finish adding elements delete the old ones + call delete_elements(slip_enum, slip_eles(1:slip_enum)) + + !Output data + if(.not.efill) then + print *, "We refine ", slip_enum, " elements into ", atom_num - old_atom_num , " atoms" + end if + + end subroutine run_slip_plane + + subroutine parse(arg_pos) + !This subroutine parses the input arguments to the mode + integer, intent(inout) :: arg_pos + + integer :: arglen + character(len = 100) :: textholder + + !First read the dimension + arg_pos = arg_pos +1 + call get_command_argument(arg_pos,textholder, arglen) + if(arglen == 0) stop "Incorrect slip_plane command. Please check documentation for correct format" + + !Check to make sure that the dimension is correct + select case(trim(adjustl(textholder))) + case('x','X') + sdim = 1 + case('y','Y') + sdim = 2 + case('z','Z') + sdim = 3 + case default + print *, "Error: dimension ", trim(adjustl(textholder)), " is not accepted. Please select from x, y, or z" + end select + + !Now parse the position of the slip plane + arg_pos = arg_pos + 1 + call get_command_argument(arg_pos, textholder, arglen) + if(arglen == 0) stop "Incorrect slip_plane command. Please check documentation for correct format" + call parse_pos(sdim, textholder, spos) + + !Now check to see if efill was passed + arg_pos = arg_pos + 1 + if(.not.(arg_pos > command_argument_count())) then + call get_command_argument(arg_pos, textholder, arglen) + if(arglen == 0) stop "Incorrect slip_plane command. Please check documentation for correct format" + if(trim(adjustl(textholder)) == "efill") then + arg_pos = arg_pos +1 + efill = .true. + end if + end if + end subroutine parse +end module opt_slip_plane From f63335708b5c38be318e8e5452e23b6e3ba7c102 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Sat, 24 Oct 2020 09:13:16 -0400 Subject: [PATCH 39/60] Working changes --- src/Makefile | 13 +++++++-- src/elements.f90 | 36 +++++++++++++----------- src/mode_create.f90 | 2 +- src/opt_group.f90 | 5 ++-- src/opt_slip_plane.f90 | 63 +++++++++++++++++++++--------------------- 5 files changed, 66 insertions(+), 53 deletions(-) diff --git a/src/Makefile b/src/Makefile index 3b170e7..b7b0c5e 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,6 +1,13 @@ -FC=ifort -FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays +FC=gfortran + +#Ifort flags +#FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays #FFLAGS=-mcmodel=large -Ofast -no-wrap-margin -heap-arrays + +#gfortran flags +#FFLAGS=-mcmodel=large -O3 -g +FFLAGS=-mcmodel=large -O0 -g -fbacktrace -fcheck=all + MODES=mode_create.o mode_merge.o mode_convert.o OPTIONS=opt_disl.o opt_group.o opt_orient.o opt_delete.o opt_deform.o opt_redef_box.o opt_slip_plane.o OBJECTS=main.o elements.o io.o subroutines.o functions.o atoms.o call_mode.o box.o $(MODES) $(OPTIONS) call_option.o sorts.o @@ -16,7 +23,7 @@ cacmb: $(OBJECTS) .PHONY: clean clean: - $(RM) cacmb *.o + $(RM) cacmb *.o *.mod testfuncs: testfuncs.o functions.o subroutines.o $(FC) testfuncs.o functions.o subroutines.o box.o elements.o -o $@ diff --git a/src/elements.f90 b/src/elements.f90 index 42eec2d..47bc22c 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -211,17 +211,17 @@ module elements call move_alloc(temp_int, lat_ele) allocate(temp_int(n+ele_num+buffer_size)) - temp_int(1:ele_size) = tag_ele + temp_int(1:ele_size) = tag_ele(1:ele_size) temp_int(ele_size+1:) = 0 call move_alloc(temp_int, tag_ele) allocate(temp_int(n+ele_num+buffer_size)) - temp_int(1:ele_size) = size_ele + temp_int(1:ele_size) = size_ele(1:ele_size) temp_int(ele_size+1:) = 0 call move_alloc(temp_int, size_ele) allocate(temp_int(n+ele_num+buffer_size)) - temp_int(1:ele_size) = lat_ele + temp_int(1:ele_size) = lat_ele(1:ele_size) temp_int(ele_size+1:) = 0 call move_alloc(temp_int, sbox_ele) @@ -282,8 +282,8 @@ module elements size_ele(ele_num) = size lat_ele(ele_num) = lat sbox_ele(ele_num) = sbox - r_node(:,:,:,ele_num) = r(:,:,:) - node_num = node_num + ng_node(lat) + r_node(:,:,:,ele_num) = r(:,:,:) + node_num = node_num + ng_node(lat) end subroutine add_element @@ -669,17 +669,17 @@ module elements esize = size_ele(ie) select case(iface) case(1) - pos = (/ real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp, -10.0_dp**-2.0_dp /) + pos = (/ real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp, -10.0_dp**(-2.0_dp) /) case(2) - pos = (/ real(esize-1,dp)/2.0_dp, -10.0_dp**-2.0_dp, real(esize-1,dp)/2.0_dp /) + pos = (/ real(esize-1,dp)/2.0_dp, -10.0_dp**(-2.0_dp), real(esize-1,dp)/2.0_dp /) case(3) - pos = (/ (esize-1)+10.0_dp**-2.0_dp, real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp /) + pos = (/ (esize-1)+10.0_dp**(-2.0_dp), real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp /) case(4) - pos = (/ real(esize-1,dp)/2.0_dp, (esize-1)+10.0_dp**-2.0_dp, real(esize-1,dp)/2.0_dp /) + pos = (/ real(esize-1,dp)/2.0_dp, (esize-1)+10.0_dp**(-2.0_dp), real(esize-1,dp)/2.0_dp /) case(5) - pos = (/ -10.0_dp**-2.0_dp, real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp /) + pos = (/ -10.0_dp**(-2.0_dp), real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp /) case(6) - pos = (/ real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp, (esize-1)+10.0_dp**-2.0_dp /) + pos = (/ real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp, (esize-1)+10.0_dp**(-2.0_dp) /) end select !Now transform it to real space and adjust it to the position of the element in the first node. @@ -736,20 +736,24 @@ module elements end subroutine lattice_map - subroutine get_interp_pos(i,j,k, ie, r) + subroutine get_interp_pos(i,j,k, ie, rout) !This returns the position of an interpolated basis from an element ie. !i, j, k should be in natural coordinates - integer, intent(in) :: i, j, k, r, s, t, ie, inod -= - real(kind=dp), dimension(3,max_basisnum), intent(out) :: r + integer, intent(in) :: i, j, k + real(kind=dp), dimension(3,max_basisnum), intent(out) :: rout + + integer :: ie, ibasis, inod + real(kind=dp) :: a_shape(8), r, s, t r = (1.0_dp*(i-1)-(size_ele(ie)-1)/2)/(1.0_dp*(size_ele(ie)-1)/2) s = (1.0_dp*(j-1)-(size_ele(ie)-1)/2)/(1.0_dp*(size_ele(ie)-1)/2) t = (1.0_dp*(k-1)-(size_ele(ie)-1)/2)/(1.0_dp*(size_ele(ie)-1)/2) - r(:) = 0 + rout(:,:) = 0 do ibasis = 1, basisnum(lat_ele(ie)) do inod = 1, ng_node(lat_ele(ie)) - r(:,ibasis) = r(:,ibasis) + a_shape(inod) * r_node(:,ibasis,inod,ie) + call rhombshape(r,s,t,a_shape) + rout(:,ibasis) = rout(:,ibasis) + a_shape(inod) * r_node(:,ibasis,inod,ie) end do end do diff --git a/src/mode_create.f90 b/src/mode_create.f90 index 00d7d8b..7994f55 100644 --- a/src/mode_create.f90 +++ b/src/mode_create.f90 @@ -135,7 +135,7 @@ module mode_create case('bcc') call build_with_rhomb(box_lat_vert, bcc_mat) case default - print *, "Element type ", trim(adjustl(element_type)), " not accepted in mode create, please specify a supported ", & + print *, "Element type ", trim(adjustl(element_type)), " not accepted in mode create, please specify a supported ",& "element type" stop 3 end select diff --git a/src/opt_group.f90 b/src/opt_group.f90 index 855e04e..0956677 100644 --- a/src/opt_group.f90 +++ b/src/opt_group.f90 @@ -300,7 +300,7 @@ module opt_group case('elements','element') if (group_ele_num > 0) then - print *, "Elements specifier used more than once in group id command with type both, either use type ", & + print *, "Elements specifier used more than once in group id command with type both, either use type ",& "elements or include atoms identifier" stop 3 @@ -824,7 +824,8 @@ module opt_group !Add the element, for the sbox we just set it to the same sbox that we get the orientation !from. In this case it is from the sbox of the first atom in the group. new_ele = new_ele+1 - call add_element(0,remesh_ele_type, working_esize, ilat, sbox_atom(atom_index(1)),r_new_node) + call add_element(0,remesh_ele_type, working_esize, ilat, & + sbox_atom(atom_index(1)),r_new_node) end if end if diff --git a/src/opt_slip_plane.f90 b/src/opt_slip_plane.f90 index 36a3d4d..4e4f1c1 100644 --- a/src/opt_slip_plane.f90 +++ b/src/opt_slip_plane.f90 @@ -17,11 +17,11 @@ module opt_slip_plane !Main calling function for the slip_plane option integer, intent(inout) :: arg_pos - integer :: ie, ia, slip_enum, old_atom_num, esize, new_ele_num, n, m, o, ele(3,8), nump_ele, inod, vlat(3), & - rfill(3,max_basisnum, max_ng_node) - + integer :: ie, ia, slip_enum, old_atom_num, esize, new_ele_num, n, m, o, ele(3,8), nump_ele, inod, vlat(3) + integer, allocatable :: slip_eles(:), temp_int(:) - real(kind=dp) :: r_interp(3, max_basisnum*max_esize**3) + real(kind=dp) :: r_interp(3, max_basisnum*max_esize**3), rfill(3,max_basisnum, max_ng_node) + integer :: type_interp(max_basisnum*max_esize**3) logical :: lat_points(max_esize,max_esize, max_esize) @@ -45,7 +45,7 @@ module opt_slip_plane !Now loop over all elements, find which ones intersect do ie = 1, ele_num if( (spos < maxval(r_node(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie)),ie))).and. & - (spos > minval(r_node(sdim,1:basisnum(lat_ele(ie),1:ng_node(lat_ele(ie)),ie)))) then + (spos > minval(r_node(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie)),ie)))) then slip_enum = slip_enum + 1 if (slip_enum > size(slip_eles)) then allocate(temp_int(size(slip_eles)+1024)) @@ -64,35 +64,36 @@ module opt_slip_plane end do !If we are efilling then the code is slightly more complex else - !First populate the lat points array - lat_points(1:size_ele(ie),1:size_ele(ie), 1:size_ele(ie)) = .true. - - !Now start trying to remesh the region, leaving the slip plane as a discontinuity - esize = size_ele(ie) - 2 - nump_ele = size_ele(ie)**3 - do while(esize > min_efillsize - if(nump_ele < esize**3) then - esize = esize - 2 - else - ele = cubic_cell*(esize -1) - do o = 1, size_ele(ie) - esize - do n = 1, size_ele(ie) - esize - do m = 1, size_ele(ie) - esize - do inod = 1, ng_node(lat_ele(ie) - vlat = ele(:,inod) + (/ m, n, o /) - call get_interp_pos(vlat(1), vlat(2), vlat(3), ie, rfill(:,:,inod)) - + !First populate the lat points array + lat_points(1:size_ele(ie),1:size_ele(ie), 1:size_ele(ie)) = .true. + + !Now start trying to remesh the region, leaving the slip plane as a discontinuity + esize = size_ele(ie) - 2 + nump_ele = size_ele(ie)**3 + do while(esize > min_efillsize) + if(nump_ele < esize**3) then + esize = esize - 2 + else + ele = cubic_cell*(esize -1) + do o = 1, size_ele(ie) - esize + do n = 1, size_ele(ie) - esize + do m = 1, size_ele(ie) - esize + do inod = 1, ng_node(lat_ele(ie)) + vlat = ele(:,inod) + (/ m, n, o /) + call get_interp_pos(vlat(1), vlat(2), vlat(3), ie, rfill(:,:,inod)) + end do + !Check to see if the plane intersects this element if not then add it + if((spos < maxval(rfill(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie))))).and. & + (spos > minval(rfill(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie)))))) then + nump_ele = nump_ele - esize**3 + lat_points(m:m+esize, n:n+esize, o:o+esize) = .false. + call add_element(0, type_ele(ie), esize, lat_ele(ie), sbox_ele(ie), rfill) + end if end do - !Check to see if the plane intersects this element if not then add it - if((spos < maxval(rfill(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie)),ie))).and. & - (spos > minval(rfill(sdim,1:basisnum(lat_ele(ie),1:ng_node(lat_ele(ie)),ie)))) then - nump_ele = nump_ele - esize**3 - - end if end do end do - end do - end if + end if + end do end if end if end do From 51079148ccfa421bb1a51e3426e900963dcf4870 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Sat, 24 Oct 2020 09:53:58 -0400 Subject: [PATCH 40/60] Get code working with gfortran --- src/Makefile | 5 +- src/elements.f90 | 132 ++++++++++++++++++++++++-------------------- src/mode_create.f90 | 2 +- src/opt_group.f90 | 5 +- 4 files changed, 78 insertions(+), 66 deletions(-) diff --git a/src/Makefile b/src/Makefile index feb933f..18881ae 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,6 +1,7 @@ -FC=ifort -FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays +FC=gfortran +#FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays #FFLAGS=-mcmodel=large -Ofast -no-wrap-margin -heap-arrays +FFLAGS=-mcmodel=large -O3 -g MODES=mode_create.o mode_merge.o mode_convert.o OPTIONS=opt_disl.o opt_group.o opt_orient.o opt_delete.o opt_deform.o opt_redef_box.o OBJECTS=main.o elements.o io.o subroutines.o functions.o atoms.o call_mode.o box.o $(MODES) $(OPTIONS) call_option.o sorts.o diff --git a/src/elements.f90 b/src/elements.f90 index 6df859b..7ca48c8 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -198,64 +198,74 @@ module elements !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, lat_ele) - - allocate(temp_int(n+ele_num+buffer_size)) - temp_int(1:ele_size) = tag_ele - temp_int(ele_size+1:) = 0 - call move_alloc(temp_int, tag_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, size_ele) - - 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, sbox_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) + + !First check to make sure if it is allocated + if (allocated(size_ele)) then + !Figure out the size of the atom and element arrays + ele_size = size(size_ele) + + !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, lat_ele) + + allocate(temp_int(n+ele_num+buffer_size)) + temp_int(1:ele_size) = tag_ele + temp_int(ele_size+1:) = 0 + call move_alloc(temp_int, tag_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, size_ele) + + 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, sbox_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 + else + call alloc_ele_arrays(n,0) 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_int(m+atom_num+buffer_size)) - temp_int(1:atom_size) = tag_atom - temp_int(atom_size+1:) = 0 - call move_alloc(temp_int, tag_atom) - - allocate(temp_int(m+atom_num+buffer_size)) - temp_int(1:atom_size) = sbox_atom - temp_int(atom_size+1:) = 0 - call move_alloc(temp_int, sbox_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) + if (allocated(type_atom)) then + atom_size = size(type_atom) + 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_int(m+atom_num+buffer_size)) + temp_int(1:atom_size) = tag_atom + temp_int(atom_size+1:) = 0 + call move_alloc(temp_int, tag_atom) + + allocate(temp_int(m+atom_num+buffer_size)) + temp_int(1:atom_size) = sbox_atom + temp_int(atom_size+1:) = 0 + call move_alloc(temp_int, sbox_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 + else + call alloc_ele_arrays(0,m) end if end subroutine @@ -669,17 +679,17 @@ module elements esize = size_ele(ie) select case(iface) case(1) - pos = (/ real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp, -10.0_dp**-2.0_dp /) + pos = (/ real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp, -10.0_dp**(-2.0_dp) /) case(2) - pos = (/ real(esize-1,dp)/2.0_dp, -10.0_dp**-2.0_dp, real(esize-1,dp)/2.0_dp /) + pos = (/ real(esize-1,dp)/2.0_dp, -10.0_dp**(-2.0_dp), real(esize-1,dp)/2.0_dp /) case(3) - pos = (/ (esize-1)+10.0_dp**-2.0_dp, real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp /) + pos = (/ (esize-1)+10.0_dp**(-2.0_dp), real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp /) case(4) - pos = (/ real(esize-1,dp)/2.0_dp, (esize-1)+10.0_dp**-2.0_dp, real(esize-1,dp)/2.0_dp /) + pos = (/ real(esize-1,dp)/2.0_dp, (esize-1)+10.0_dp**(-2.0_dp), real(esize-1,dp)/2.0_dp /) case(5) - pos = (/ -10.0_dp**-2.0_dp, real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp /) + pos = (/ -10.0_dp**(-2.0_dp), real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp /) case(6) - pos = (/ real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp, (esize-1)+10.0_dp**-2.0_dp /) + pos = (/ real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp, (esize-1)+10.0_dp**(-2.0_dp) /) end select !Now transform it to real space and adjust it to the position of the element in the first node. diff --git a/src/mode_create.f90 b/src/mode_create.f90 index bcec2d5..6f1ca28 100644 --- a/src/mode_create.f90 +++ b/src/mode_create.f90 @@ -135,7 +135,7 @@ module mode_create case('bcc') call build_with_rhomb(box_lat_vert, bcc_mat) case default - print *, "Element type ", trim(adjustl(element_type)), " not accepted in mode create, please specify a supported ", & + print *, "Element type ", trim(adjustl(element_type)), " not accepted in mode create, please specify a supported ",& "element type" stop 3 end select diff --git a/src/opt_group.f90 b/src/opt_group.f90 index 855e04e..0956677 100644 --- a/src/opt_group.f90 +++ b/src/opt_group.f90 @@ -300,7 +300,7 @@ module opt_group case('elements','element') if (group_ele_num > 0) then - print *, "Elements specifier used more than once in group id command with type both, either use type ", & + print *, "Elements specifier used more than once in group id command with type both, either use type ",& "elements or include atoms identifier" stop 3 @@ -824,7 +824,8 @@ module opt_group !Add the element, for the sbox we just set it to the same sbox that we get the orientation !from. In this case it is from the sbox of the first atom in the group. new_ele = new_ele+1 - call add_element(0,remesh_ele_type, working_esize, ilat, sbox_atom(atom_index(1)),r_new_node) + call add_element(0,remesh_ele_type, working_esize, ilat, & + sbox_atom(atom_index(1)),r_new_node) end if end if From b9ce916e42ecc864259d3a6c44b43a4b267cf65e Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Tue, 27 Oct 2020 13:23:00 -0400 Subject: [PATCH 41/60] Current working changes to option-slip-plane --- src/Makefile | 4 ++-- src/elements.f90 | 11 ++++++----- src/opt_slip_plane.f90 | 22 +++++++++++++++++++--- 3 files changed, 27 insertions(+), 10 deletions(-) diff --git a/src/Makefile b/src/Makefile index 95f074a..4d6971d 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,8 +1,8 @@ FC=ifort #Ifort flags -#FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays -FFLAGS=-mcmodel=large -Ofast -no-wrap-margin -heap-arrays +FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays +#FFLAGS=-mcmodel=large -Ofast -no-wrap-margin -heap-arrays #gfortran flags #FFLAGS=-mcmodel=large -O3 -g diff --git a/src/elements.f90 b/src/elements.f90 index 429a07b..8a5f54e 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -201,24 +201,25 @@ module elements !First check to make sure if it is allocated if (allocated(size_ele)) then + !Figure out the size of the atom and element arrays ele_size = size(size_ele) !Check if we need to grow the ele_size, if so grow all the variables - if ( n+ele_size > size(size_ele)) then + if ( n+ele_num > size(size_ele)) then allocate(temp_int(n+ele_size+buffer_size)) - temp_int(1:ele_size) = lat_ele + temp_int(1:ele_size) = lat_ele(1:ele_size) temp_int(ele_size+1:) = 0 call move_alloc(temp_int, lat_ele) allocate(temp_int(n+ele_size+buffer_size)) - temp_int(1:ele_size) = tag_ele + temp_int(1:ele_size) = tag_ele(1:ele_size) temp_int(ele_size+1:) = 0 call move_alloc(temp_int, tag_ele) allocate(temp_int(n+ele_size+buffer_size)) - temp_int(1:ele_size) = size_ele + temp_int(1:ele_size) = size_ele(1:ele_size) temp_int(ele_size+1:) = 0 call move_alloc(temp_int, size_ele) @@ -278,6 +279,7 @@ module elements integer :: newtag ele_num = ele_num + 1 + node_num = node_num + ng_node(lat) if (tag==0) then newtag = ele_num !If we don't assign a tag then pass the tag as the ele_num @@ -293,7 +295,6 @@ module elements lat_ele(ele_num) = lat sbox_ele(ele_num) = sbox r_node(:,:,:,ele_num) = r(:,:,:) - node_num = node_num + ng_node(lat) end subroutine add_element diff --git a/src/opt_slip_plane.f90 b/src/opt_slip_plane.f90 index 4e4f1c1..c6c8468 100644 --- a/src/opt_slip_plane.f90 +++ b/src/opt_slip_plane.f90 @@ -17,10 +17,10 @@ module opt_slip_plane !Main calling function for the slip_plane option integer, intent(inout) :: arg_pos - integer :: ie, ia, slip_enum, old_atom_num, esize, new_ele_num, n, m, o, ele(3,8), nump_ele, inod, vlat(3) + integer :: ie, ia, slip_enum, old_atom_num, esize, new_ele_num, n, m, o, ele(3,8), nump_ele, inod, vlat(3), ibasis integer, allocatable :: slip_eles(:), temp_int(:) - real(kind=dp) :: r_interp(3, max_basisnum*max_esize**3), rfill(3,max_basisnum, max_ng_node) + real(kind=dp) :: r_interp(3, max_basisnum*max_esize**3), rfill(3,max_basisnum, max_ng_node), ratom(3,max_basisnum) integer :: type_interp(max_basisnum*max_esize**3) logical :: lat_points(max_esize,max_esize, max_esize) @@ -86,14 +86,28 @@ module opt_slip_plane if((spos < maxval(rfill(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie))))).and. & (spos > minval(rfill(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie)))))) then nump_ele = nump_ele - esize**3 - lat_points(m:m+esize, n:n+esize, o:o+esize) = .false. + lat_points(m:m+esize-1, n:n+esize-1, o:o+esize-1) = .false. call add_element(0, type_ele(ie), esize, lat_ele(ie), sbox_ele(ie), rfill) + new_ele_num = new_ele_num + 1 end if end do end do end do end if end do + ! Now add the leftover lattice points as atoms + do o = 1, size_ele(ie) + do n = 1, size_ele(ie) + do m = 1, size_ele(ie) + if(lat_points(m,n,o)) then + call get_interp_pos(m,n,o, ie, ratom(:,:)) + do ibasis = 1, basisnum(lat_ele(ie)) + call add_atom(0, basis_type(ibasis,lat_ele(ie)), sbox_ele(ie), ratom(:,ibasis)) + end do + end if + end do + end do + end do end if end if end do @@ -104,6 +118,8 @@ module opt_slip_plane !Output data if(.not.efill) then print *, "We refine ", slip_enum, " elements into ", atom_num - old_atom_num , " atoms" + else + print *, "We refine ", slip_enum, " elements into ", atom_num - old_atom_num , " atoms and ", new_ele_num, " elements" end if end subroutine run_slip_plane From 84a84e578a28f7bdbf652cf51b747d04b9c55a72 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Tue, 27 Oct 2020 16:44:03 -0400 Subject: [PATCH 42/60] Working version of slip_plane ooption with effill --- src/opt_slip_plane.f90 | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/src/opt_slip_plane.f90 b/src/opt_slip_plane.f90 index c6c8468..e607ae8 100644 --- a/src/opt_slip_plane.f90 +++ b/src/opt_slip_plane.f90 @@ -20,7 +20,8 @@ module opt_slip_plane integer :: ie, ia, slip_enum, old_atom_num, esize, new_ele_num, n, m, o, ele(3,8), nump_ele, inod, vlat(3), ibasis integer, allocatable :: slip_eles(:), temp_int(:) - real(kind=dp) :: r_interp(3, max_basisnum*max_esize**3), rfill(3,max_basisnum, max_ng_node), ratom(3,max_basisnum) + real(kind=dp) :: r_interp(3, max_basisnum*max_esize**3), rfill(3,max_basisnum, max_ng_node), ratom(3,max_basisnum), & + maxp, minp integer :: type_interp(max_basisnum*max_esize**3) logical :: lat_points(max_esize,max_esize, max_esize) @@ -77,23 +78,29 @@ module opt_slip_plane ele = cubic_cell*(esize -1) do o = 1, size_ele(ie) - esize do n = 1, size_ele(ie) - esize - do m = 1, size_ele(ie) - esize + latloop:do m = 1, size_ele(ie) - esize do inod = 1, ng_node(lat_ele(ie)) vlat = ele(:,inod) + (/ m, n, o /) + if (.not.lat_points(vlat(1), vlat(2),vlat(3))) cycle latloop call get_interp_pos(vlat(1), vlat(2), vlat(3), ie, rfill(:,:,inod)) end do + + !Check to make sure all lattice points exist for the current element + if(any(lat_points(m:m+esize-1, n:n+esize-1, o:o+esize-1) == 0)) cycle latloop !Check to see if the plane intersects this element if not then add it - if((spos < maxval(rfill(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie))))).and. & - (spos > minval(rfill(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie)))))) then + maxp = maxval(rfill(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie)))) + minp = minval(rfill(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie)))) + if(.not.(spos < maxp).and.(spos > minp))then nump_ele = nump_ele - esize**3 lat_points(m:m+esize-1, n:n+esize-1, o:o+esize-1) = .false. call add_element(0, type_ele(ie), esize, lat_ele(ie), sbox_ele(ie), rfill) new_ele_num = new_ele_num + 1 end if - end do + end do latloop end do end do end if + esize= esize-2 end do ! Now add the leftover lattice points as atoms do o = 1, size_ele(ie) @@ -102,6 +109,7 @@ module opt_slip_plane if(lat_points(m,n,o)) then call get_interp_pos(m,n,o, ie, ratom(:,:)) do ibasis = 1, basisnum(lat_ele(ie)) + call apply_periodic(r_atom(:,ibasis)) call add_atom(0, basis_type(ibasis,lat_ele(ie)), sbox_ele(ie), ratom(:,ibasis)) end do end if From fd901648f23d7cb53856d84d65d392bd8fa69443 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Wed, 28 Oct 2020 10:45:05 -0400 Subject: [PATCH 43/60] Update license from gplv3 to MIT --- LICENSE | 676 +------------------------------------------------------- 1 file changed, 5 insertions(+), 671 deletions(-) diff --git a/LICENSE b/LICENSE index f288702..a14982c 100644 --- a/LICENSE +++ b/LICENSE @@ -1,674 +1,8 @@ - GNU GENERAL PUBLIC LICENSE - Version 3, 29 June 2007 +The MIT License (MIT) +Copyright © 2020 - Copyright (C) 2007 Free Software Foundation, Inc. - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. +Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: - Preamble +The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. - The GNU General Public License is a free, copyleft license for -software and other kinds of works. - - The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -the GNU General Public License is intended to guarantee your freedom to -share and change all versions of a program--to make sure it remains free -software for all its users. We, the Free Software Foundation, use the -GNU General Public License for most of our software; it applies also to -any other work released this way by its authors. You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - - To protect your rights, we need to prevent others from denying you -these rights or asking you to surrender the rights. Therefore, you have -certain responsibilities if you distribute copies of the software, or if -you modify it: responsibilities to respect the freedom of others. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must pass on to the recipients the same -freedoms that you received. You must make sure that they, too, receive -or can get the source code. And you must show them these terms so they -know their rights. - - Developers that use the GNU GPL protect your rights with two steps: -(1) assert copyright on the software, and (2) offer you this License -giving you legal permission to copy, distribute and/or modify it. - - For the developers' and authors' protection, the GPL clearly explains -that there is no warranty for this free software. For both users' and -authors' sake, the GPL requires that modified versions be marked as -changed, so that their problems will not be attributed erroneously to -authors of previous versions. - - Some devices are designed to deny users access to install or run -modified versions of the software inside them, although the manufacturer -can do so. This is fundamentally incompatible with the aim of -protecting users' freedom to change the software. The systematic -pattern of such abuse occurs in the area of products for individuals to -use, which is precisely where it is most unacceptable. Therefore, we -have designed this version of the GPL to prohibit the practice for those -products. If such problems arise substantially in other domains, we -stand ready to extend this provision to those domains in future versions -of the GPL, as needed to protect the freedom of users. - - Finally, every program is threatened constantly by software patents. -States should not allow patents to restrict development and use of -software on general-purpose computers, but in those that do, we wish to -avoid the special danger that patents applied to a free program could -make it effectively proprietary. To prevent this, the GPL assures that -patents cannot be used to render the program non-free. - - The precise terms and conditions for copying, distribution and -modification follow. - - TERMS AND CONDITIONS - - 0. Definitions. - - "This License" refers to version 3 of the GNU General Public License. - - "Copyright" also means copyright-like laws that apply to other kinds of -works, such as semiconductor masks. - - "The Program" refers to any copyrightable work licensed under this -License. Each licensee is addressed as "you". "Licensees" and -"recipients" may be individuals or organizations. - - To "modify" a work means to copy from or adapt all or part of the work -in a fashion requiring copyright permission, other than the making of an -exact copy. The resulting work is called a "modified version" of the -earlier work or a work "based on" the earlier work. - - A "covered work" means either the unmodified Program or a work based -on the Program. - - To "propagate" a work means to do anything with it that, without -permission, would make you directly or secondarily liable for -infringement under applicable copyright law, except executing it on a -computer or modifying a private copy. Propagation includes copying, -distribution (with or without modification), making available to the -public, and in some countries other activities as well. - - To "convey" a work means any kind of propagation that enables other -parties to make or receive copies. Mere interaction with a user through -a computer network, with no transfer of a copy, is not conveying. - - An interactive user interface displays "Appropriate Legal Notices" -to the extent that it includes a convenient and prominently visible -feature that (1) displays an appropriate copyright notice, and (2) -tells the user that there is no warranty for the work (except to the -extent that warranties are provided), that licensees may convey the -work under this License, and how to view a copy of this License. If -the interface presents a list of user commands or options, such as a -menu, a prominent item in the list meets this criterion. - - 1. Source Code. - - The "source code" for a work means the preferred form of the work -for making modifications to it. "Object code" means any non-source -form of a work. - - A "Standard Interface" means an interface that either is an official -standard defined by a recognized standards body, or, in the case of -interfaces specified for a particular programming language, one that -is widely used among developers working in that language. - - The "System Libraries" of an executable work include anything, other -than the work as a whole, that (a) is included in the normal form of -packaging a Major Component, but which is not part of that Major -Component, and (b) serves only to enable use of the work with that -Major Component, or to implement a Standard Interface for which an -implementation is available to the public in source code form. A -"Major Component", in this context, means a major essential component -(kernel, window system, and so on) of the specific operating system -(if any) on which the executable work runs, or a compiler used to -produce the work, or an object code interpreter used to run it. - - The "Corresponding Source" for a work in object code form means all -the source code needed to generate, install, and (for an executable -work) run the object code and to modify the work, including scripts to -control those activities. However, it does not include the work's -System Libraries, or general-purpose tools or generally available free -programs which are used unmodified in performing those activities but -which are not part of the work. For example, Corresponding Source -includes interface definition files associated with source files for -the work, and the source code for shared libraries and dynamically -linked subprograms that the work is specifically designed to require, -such as by intimate data communication or control flow between those -subprograms and other parts of the work. - - The Corresponding Source need not include anything that users -can regenerate automatically from other parts of the Corresponding -Source. - - The Corresponding Source for a work in source code form is that -same work. - - 2. Basic Permissions. - - All rights granted under this License are granted for the term of -copyright on the Program, and are irrevocable provided the stated -conditions are met. This License explicitly affirms your unlimited -permission to run the unmodified Program. The output from running a -covered work is covered by this License only if the output, given its -content, constitutes a covered work. This License acknowledges your -rights of fair use or other equivalent, as provided by copyright law. - - You may make, run and propagate covered works that you do not -convey, without conditions so long as your license otherwise remains -in force. You may convey covered works to others for the sole purpose -of having them make modifications exclusively for you, or provide you -with facilities for running those works, provided that you comply with -the terms of this License in conveying all material for which you do -not control copyright. Those thus making or running the covered works -for you must do so exclusively on your behalf, under your direction -and control, on terms that prohibit them from making any copies of -your copyrighted material outside their relationship with you. - - Conveying under any other circumstances is permitted solely under -the conditions stated below. Sublicensing is not allowed; section 10 -makes it unnecessary. - - 3. Protecting Users' Legal Rights From Anti-Circumvention Law. - - No covered work shall be deemed part of an effective technological -measure under any applicable law fulfilling obligations under article -11 of the WIPO copyright treaty adopted on 20 December 1996, or -similar laws prohibiting or restricting circumvention of such -measures. - - When you convey a covered work, you waive any legal power to forbid -circumvention of technological measures to the extent such circumvention -is effected by exercising rights under this License with respect to -the covered work, and you disclaim any intention to limit operation or -modification of the work as a means of enforcing, against the work's -users, your or third parties' legal rights to forbid circumvention of -technological measures. - - 4. Conveying Verbatim Copies. - - You may convey verbatim copies of the Program's source code as you -receive it, in any medium, provided that you conspicuously and -appropriately publish on each copy an appropriate copyright notice; -keep intact all notices stating that this License and any -non-permissive terms added in accord with section 7 apply to the code; -keep intact all notices of the absence of any warranty; and give all -recipients a copy of this License along with the Program. - - You may charge any price or no price for each copy that you convey, -and you may offer support or warranty protection for a fee. - - 5. Conveying Modified Source Versions. - - You may convey a work based on the Program, or the modifications to -produce it from the Program, in the form of source code under the -terms of section 4, provided that you also meet all of these conditions: - - a) The work must carry prominent notices stating that you modified - it, and giving a relevant date. - - b) The work must carry prominent notices stating that it is - released under this License and any conditions added under section - 7. This requirement modifies the requirement in section 4 to - "keep intact all notices". - - c) You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable section 7 - additional terms, to the whole of the work, and all its parts, - regardless of how they are packaged. This License gives no - permission to license the work in any other way, but it does not - invalidate such permission if you have separately received it. - - d) If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has interactive - interfaces that do not display Appropriate Legal Notices, your - work need not make them do so. - - A compilation of a covered work with other separate and independent -works, which are not by their nature extensions of the covered work, -and which are not combined with it such as to form a larger program, -in or on a volume of a storage or distribution medium, is called an -"aggregate" if the compilation and its resulting copyright are not -used to limit the access or legal rights of the compilation's users -beyond what the individual works permit. Inclusion of a covered work -in an aggregate does not cause this License to apply to the other -parts of the aggregate. - - 6. Conveying Non-Source Forms. - - You may convey a covered work in object code form under the terms -of sections 4 and 5, provided that you also convey the -machine-readable Corresponding Source under the terms of this License, -in one of these ways: - - a) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. - - b) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that product - model, to give anyone who possesses the object code either (1) a - copy of the Corresponding Source for all the software in the - product that is covered by this License, on a durable physical - medium customarily used for software interchange, for a price no - more than your reasonable cost of physically performing this - conveying of source, or (2) access to copy the - Corresponding Source from a network server at no charge. - - c) Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, and - only if you received the object code with such an offer, in accord - with subsection 6b. - - d) Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to the - Corresponding Source in the same way through the same place at no - further charge. You need not require recipients to copy the - Corresponding Source along with the object code. If the place to - copy the object code is a network server, the Corresponding Source - may be on a different server (operated by you or a third party) - that supports equivalent copying facilities, provided you maintain - clear directions next to the object code saying where to find the - Corresponding Source. Regardless of what server hosts the - Corresponding Source, you remain obligated to ensure that it is - available for as long as needed to satisfy these requirements. - - e) Convey the object code using peer-to-peer transmission, provided - you inform other peers where the object code and Corresponding - Source of the work are being offered to the general public at no - charge under subsection 6d. - - A separable portion of the object code, whose source code is excluded -from the Corresponding Source as a System Library, need not be -included in conveying the object code work. - - A "User Product" is either (1) a "consumer product", which means any -tangible personal property which is normally used for personal, family, -or household purposes, or (2) anything designed or sold for incorporation -into a dwelling. In determining whether a product is a consumer product, -doubtful cases shall be resolved in favor of coverage. For a particular -product received by a particular user, "normally used" refers to a -typical or common use of that class of product, regardless of the status -of the particular user or of the way in which the particular user -actually uses, or expects or is expected to use, the product. A product -is a consumer product regardless of whether the product has substantial -commercial, industrial or non-consumer uses, unless such uses represent -the only significant mode of use of the product. - - "Installation Information" for a User Product means any methods, -procedures, authorization keys, or other information required to install -and execute modified versions of a covered work in that User Product from -a modified version of its Corresponding Source. The information must -suffice to ensure that the continued functioning of the modified object -code is in no case prevented or interfered with solely because -modification has been made. - - If you convey an object code work under this section in, or with, or -specifically for use in, a User Product, and the conveying occurs as -part of a transaction in which the right of possession and use of the -User Product is transferred to the recipient in perpetuity or for a -fixed term (regardless of how the transaction is characterized), the -Corresponding Source conveyed under this section must be accompanied -by the Installation Information. But this requirement does not apply -if neither you nor any third party retains the ability to install -modified object code on the User Product (for example, the work has -been installed in ROM). - - The requirement to provide Installation Information does not include a -requirement to continue to provide support service, warranty, or updates -for a work that has been modified or installed by the recipient, or for -the User Product in which it has been modified or installed. Access to a -network may be denied when the modification itself materially and -adversely affects the operation of the network or violates the rules and -protocols for communication across the network. - - Corresponding Source conveyed, and Installation Information provided, -in accord with this section must be in a format that is publicly -documented (and with an implementation available to the public in -source code form), and must require no special password or key for -unpacking, reading or copying. - - 7. Additional Terms. - - "Additional permissions" are terms that supplement the terms of this -License by making exceptions from one or more of its conditions. -Additional permissions that are applicable to the entire Program shall -be treated as though they were included in this License, to the extent -that they are valid under applicable law. If additional permissions -apply only to part of the Program, that part may be used separately -under those permissions, but the entire Program remains governed by -this License without regard to the additional permissions. - - When you convey a copy of a covered work, you may at your option -remove any additional permissions from that copy, or from any part of -it. (Additional permissions may be written to require their own -removal in certain cases when you modify the work.) You may place -additional permissions on material, added by you to a covered work, -for which you have or can give appropriate copyright permission. - - Notwithstanding any other provision of this License, for material you -add to a covered work, you may (if authorized by the copyright holders of -that material) supplement the terms of this License with terms: - - a) Disclaiming warranty or limiting liability differently from the - terms of sections 15 and 16 of this License; or - - b) Requiring preservation of specified reasonable legal notices or - author attributions in that material or in the Appropriate Legal - Notices displayed by works containing it; or - - c) Prohibiting misrepresentation of the origin of that material, or - requiring that modified versions of such material be marked in - reasonable ways as different from the original version; or - - d) Limiting the use for publicity purposes of names of licensors or - authors of the material; or - - e) Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or - - f) Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified versions of - it) with contractual assumptions of liability to the recipient, for - any liability that these contractual assumptions directly impose on - those licensors and authors. - - All other non-permissive additional terms are considered "further -restrictions" within the meaning of section 10. If the Program as you -received it, or any part of it, contains a notice stating that it is -governed by this License along with a term that is a further -restriction, you may remove that term. If a license document contains -a further restriction but permits relicensing or conveying under this -License, you may add to a covered work material governed by the terms -of that license document, provided that the further restriction does -not survive such relicensing or conveying. - - If you add terms to a covered work in accord with this section, you -must place, in the relevant source files, a statement of the -additional terms that apply to those files, or a notice indicating -where to find the applicable terms. - - Additional terms, permissive or non-permissive, may be stated in the -form of a separately written license, or stated as exceptions; -the above requirements apply either way. - - 8. Termination. - - You may not propagate or modify a covered work except as expressly -provided under this License. Any attempt otherwise to propagate or -modify it is void, and will automatically terminate your rights under -this License (including any patent licenses granted under the third -paragraph of section 11). - - However, if you cease all violation of this License, then your -license from a particular copyright holder is reinstated (a) -provisionally, unless and until the copyright holder explicitly and -finally terminates your license, and (b) permanently, if the copyright -holder fails to notify you of the violation by some reasonable means -prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. - - Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, you do not qualify to receive new licenses for the same -material under section 10. - - 9. Acceptance Not Required for Having Copies. - - You are not required to accept this License in order to receive or -run a copy of the Program. Ancillary propagation of a covered work -occurring solely as a consequence of using peer-to-peer transmission -to receive a copy likewise does not require acceptance. However, -nothing other than this License grants you permission to propagate or -modify any covered work. These actions infringe copyright if you do -not accept this License. Therefore, by modifying or propagating a -covered work, you indicate your acceptance of this License to do so. - - 10. Automatic Licensing of Downstream Recipients. - - Each time you convey a covered work, the recipient automatically -receives a license from the original licensors, to run, modify and -propagate that work, subject to this License. You are not responsible -for enforcing compliance by third parties with this License. - - An "entity transaction" is a transaction transferring control of an -organization, or substantially all assets of one, or subdividing an -organization, or merging organizations. If propagation of a covered -work results from an entity transaction, each party to that -transaction who receives a copy of the work also receives whatever -licenses to the work the party's predecessor in interest had or could -give under the previous paragraph, plus a right to possession of the -Corresponding Source of the work from the predecessor in interest, if -the predecessor has it or can get it with reasonable efforts. - - You may not impose any further restrictions on the exercise of the -rights granted or affirmed under this License. For example, you may -not impose a license fee, royalty, or other charge for exercise of -rights granted under this License, and you may not initiate litigation -(including a cross-claim or counterclaim in a lawsuit) alleging that -any patent claim is infringed by making, using, selling, offering for -sale, or importing the Program or any portion of it. - - 11. Patents. - - A "contributor" is a copyright holder who authorizes use under this -License of the Program or a work on which the Program is based. The -work thus licensed is called the contributor's "contributor version". - - A contributor's "essential patent claims" are all patent claims -owned or controlled by the contributor, whether already acquired or -hereafter acquired, that would be infringed by some manner, permitted -by this License, of making, using, or selling its contributor version, -but do not include claims that would be infringed only as a -consequence of further modification of the contributor version. For -purposes of this definition, "control" includes the right to grant -patent sublicenses in a manner consistent with the requirements of -this License. - - Each contributor grants you a non-exclusive, worldwide, royalty-free -patent license under the contributor's essential patent claims, to -make, use, sell, offer for sale, import and otherwise run, modify and -propagate the contents of its contributor version. - - In the following three paragraphs, a "patent license" is any express -agreement or commitment, however denominated, not to enforce a patent -(such as an express permission to practice a patent or covenant not to -sue for patent infringement). To "grant" such a patent license to a -party means to make such an agreement or commitment not to enforce a -patent against the party. - - If you convey a covered work, knowingly relying on a patent license, -and the Corresponding Source of the work is not available for anyone -to copy, free of charge and under the terms of this License, through a -publicly available network server or other readily accessible means, -then you must either (1) cause the Corresponding Source to be so -available, or (2) arrange to deprive yourself of the benefit of the -patent license for this particular work, or (3) arrange, in a manner -consistent with the requirements of this License, to extend the patent -license to downstream recipients. "Knowingly relying" means you have -actual knowledge that, but for the patent license, your conveying the -covered work in a country, or your recipient's use of the covered work -in a country, would infringe one or more identifiable patents in that -country that you have reason to believe are valid. - - If, pursuant to or in connection with a single transaction or -arrangement, you convey, or propagate by procuring conveyance of, a -covered work, and grant a patent license to some of the parties -receiving the covered work authorizing them to use, propagate, modify -or convey a specific copy of the covered work, then the patent license -you grant is automatically extended to all recipients of the covered -work and works based on it. - - A patent license is "discriminatory" if it does not include within -the scope of its coverage, prohibits the exercise of, or is -conditioned on the non-exercise of one or more of the rights that are -specifically granted under this License. You may not convey a covered -work if you are a party to an arrangement with a third party that is -in the business of distributing software, under which you make payment -to the third party based on the extent of your activity of conveying -the work, and under which the third party grants, to any of the -parties who would receive the covered work from you, a discriminatory -patent license (a) in connection with copies of the covered work -conveyed by you (or copies made from those copies), or (b) primarily -for and in connection with specific products or compilations that -contain the covered work, unless you entered into that arrangement, -or that patent license was granted, prior to 28 March 2007. - - Nothing in this License shall be construed as excluding or limiting -any implied license or other defenses to infringement that may -otherwise be available to you under applicable patent law. - - 12. No Surrender of Others' Freedom. - - If conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot convey a -covered work so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you may -not convey it at all. For example, if you agree to terms that obligate you -to collect a royalty for further conveying from those to whom you convey -the Program, the only way you could satisfy both those terms and this -License would be to refrain entirely from conveying the Program. - - 13. Use with the GNU Affero General Public License. - - Notwithstanding any other provision of this License, you have -permission to link or combine any covered work with a work licensed -under version 3 of the GNU Affero General Public License into a single -combined work, and to convey the resulting work. The terms of this -License will continue to apply to the part which is the covered work, -but the special requirements of the GNU Affero General Public License, -section 13, concerning interaction through a network will apply to the -combination as such. - - 14. Revised Versions of this License. - - The Free Software Foundation may publish revised and/or new versions of -the GNU General Public License from time to time. Such new versions will -be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - - Each version is given a distinguishing version number. If the -Program specifies that a certain numbered version of the GNU General -Public License "or any later version" applies to it, you have the -option of following the terms and conditions either of that numbered -version or of any later version published by the Free Software -Foundation. If the Program does not specify a version number of the -GNU General Public License, you may choose any version ever published -by the Free Software Foundation. - - If the Program specifies that a proxy can decide which future -versions of the GNU General Public License can be used, that proxy's -public statement of acceptance of a version permanently authorizes you -to choose that version for the Program. - - Later license versions may give you additional or different -permissions. However, no additional obligations are imposed on any -author or copyright holder as a result of your choosing to follow a -later version. - - 15. Disclaimer of Warranty. - - THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT -HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY -OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, -THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM -IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF -ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. Limitation of Liability. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS -THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY -GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE -USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF -DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD -PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), -EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF -SUCH DAMAGES. - - 17. Interpretation of Sections 15 and 16. - - If the disclaimer of warranty and limitation of liability provided -above cannot be given local legal effect according to their terms, -reviewing courts shall apply local law that most closely approximates -an absolute waiver of all civil liability in connection with the -Program, unless a warranty or assumption of liability accompanies a -copy of the Program in return for a fee. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . - -Also add information on how to contact you by electronic and paper mail. - - If the program does terminal interaction, make it output a short -notice like this when it starts in an interactive mode: - - Copyright (C) - This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, your program's commands -might be different; for a GUI interface, you would use an "about box". - - You should also get your employer (if you work as a programmer) or school, -if any, to sign a "copyright disclaimer" for the program, if necessary. -For more information on this, and how to apply and follow the GNU GPL, see -. - - The GNU General Public License does not permit incorporating your program -into proprietary programs. If your program is a subroutine library, you -may consider it more useful to permit linking proprietary applications with -the library. If this is what you want to do, use the GNU Lesser General -Public License instead of this License. But first, please read -. +THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.T From 068b5d99a9cfbda25b10d13d7bcf910f74cdfa41 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Wed, 28 Oct 2020 17:51:23 -0400 Subject: [PATCH 44/60] Fix to gfortran compatibility --- src/elements.f90 | 6 +++++- src/io.f90 | 4 ++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/src/elements.f90 b/src/elements.f90 index 7ca48c8..4b3d5e0 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -370,7 +370,11 @@ module elements subroutine set_max_esize !This subroutine sets the maximum esize - max_esize=maxval(size_ele) + if(allocated(size_ele)) then + max_esize=maxval(size_ele) + else + max_esize = 2 + end if end subroutine subroutine interpolate_atoms(type, esize, lat_type, r_in, type_interp, r_interp) diff --git a/src/io.f90 b/src/io.f90 index 7bbf3c2..2787b73 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -133,14 +133,14 @@ module io do i = 1, ele_num do inod = 1, ng_node(lat_ele(i)) do ibasis = 1, basisnum(lat_ele(i)) - write(11, '(2i16, 3f23.15)') basis_type(ibasis,lat_ele(i)), 0, r_node(:,ibasis,inod,i) + write(11, '(2i16, 3f23.15)') basis_type(ibasis,lat_ele(i)), 1, r_node(:,ibasis,inod,i) end do end do end do !Write atom positions do i = 1, atom_num - write(11, '(2i16, 3f23.15)') type_atom(i), 1, r_atom(:,i) + write(11, '(2i16, 3f23.15)') type_atom(i), 0, r_atom(:,i) end do !Finish writing From a528dc4c5245d4a6a4d1c033547b920dd1eed4f8 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Wed, 28 Oct 2020 17:53:12 -0400 Subject: [PATCH 45/60] Final fix to get working opt_slip_plane --- src/opt_slip_plane.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/opt_slip_plane.f90 b/src/opt_slip_plane.f90 index e607ae8..80da930 100644 --- a/src/opt_slip_plane.f90 +++ b/src/opt_slip_plane.f90 @@ -86,7 +86,7 @@ module opt_slip_plane end do !Check to make sure all lattice points exist for the current element - if(any(lat_points(m:m+esize-1, n:n+esize-1, o:o+esize-1) == 0)) cycle latloop + if(any(.not.lat_points(m:m+esize-1, n:n+esize-1, o:o+esize-1))) cycle latloop !Check to see if the plane intersects this element if not then add it maxp = maxval(rfill(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie)))) minp = minval(rfill(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie)))) From 153b95194f3da151972d7fa8cd74a8908bab8142 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Sun, 1 Nov 2020 21:08:42 -0500 Subject: [PATCH 46/60] Mode calc with tot_virial calculation --- src/box.f90 | 7 ++++ src/call_mode.f90 | 3 ++ src/elements.f90 | 6 +++ src/functions.f90 | 8 ++++ src/mode_calc.f90 | 95 +++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 119 insertions(+) create mode 100644 src/mode_calc.f90 diff --git a/src/box.f90 b/src/box.f90 index 83d81a8..c179136 100644 --- a/src/box.f90 +++ b/src/box.f90 @@ -103,4 +103,11 @@ module box box_bc = "ppp" box_bd(:) = 0 end subroutine reset_box + + pure function box_volume() + real(kind = dp) :: box_volume + + box_volume = (box_bd(2) - box_bd(1)) * (box_bd(4) - box_bd(3))*(box_bd(6) - box_bd(5)) + return + end function end module box diff --git a/src/call_mode.f90 b/src/call_mode.f90 index 8d73e25..b933751 100644 --- a/src/call_mode.f90 +++ b/src/call_mode.f90 @@ -6,6 +6,7 @@ subroutine call_mode(arg_pos) use mode_convert use mode_merge use mode_metric + use mode_calc use parameters implicit none @@ -21,6 +22,8 @@ subroutine call_mode(arg_pos) call merge(arg_pos) case('--metric') call metric(arg_pos) + case('--calc') + call calc(arg_pos) case default print *, "Mode ", trim(adjustl(mode)), " currently not accepted. Please check documentation for ", & "accepted modes and rerun." diff --git a/src/elements.f90 b/src/elements.f90 index 62b56f0..5d3b3c6 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -50,6 +50,9 @@ module elements !Additional module level variables we need logical :: wrap_flag + + !flags for data variables + logical :: vflag public contains @@ -136,6 +139,7 @@ module elements real(kind=dp), dimension(3,max_ng_node) :: adjustVar adjustVar(:,:) = 0.0_dp + vflag = .false. select case(trim(ele_type)) @@ -823,6 +827,7 @@ do i = 1, atom_num energy_atom(ia) = eng force_atom(:,ia) = force(:) virial_atom(:,ia) = virial(:) + vflag = .true. return end subroutine add_atom_data @@ -832,6 +837,7 @@ do i = 1, atom_num real(kind=dp), intent(in) :: eng(max_basisnum, max_ng_node), & force(3,max_basisnum, max_ng_node), & virial(6,max_basisnum,max_ng_node) + vflag = .true. energy_node(:,:,ie) = eng force_node(:,:,:,ie) = force virial_node(:,:,:,ie) = virial diff --git a/src/functions.f90 b/src/functions.f90 index 0a8bc49..ebd9a50 100644 --- a/src/functions.f90 +++ b/src/functions.f90 @@ -391,4 +391,12 @@ END FUNCTION StrDnCase end if end function permutation + pure function evtogp(virial) + real(kind=dp), dimension(6), intent(in) :: virial + real(kind=dp), dimension(6) :: evtogp + + evtogp = virial * 1e21_dp * 1.602176565e-19_dp + + end function + end module functions diff --git a/src/mode_calc.f90 b/src/mode_calc.f90 new file mode 100644 index 0000000..497c90b --- /dev/null +++ b/src/mode_calc.f90 @@ -0,0 +1,95 @@ +module mode_calc + !This mode is used to calculate various quantities based on input information + use parameters + use io + use subroutines + use elements + use box + + character(len=100) :: calc_opt + real(kind=dp), allocatable :: calculated(:) + public + contains + subroutine calc(arg_pos) + !Main calling subroutine for mode_create + integer, intent(out) :: arg_pos + + print *, '------------------------Mode Calc----------------------------' + + !First parse command + call parse(arg_pos) + + print *, "Calculating ", trim(adjustl(calc_opt)), " for ", ele_num, " elements and ", atom_num, " atoms." + !Now call the correct calc function based on calc_opt + select case(trim(adjustl(calc_opt))) + case('tot_virial') + allocate(calculated(6)) + call calc_tot_virial + case default + print *, trim(adjustl(calc_opt)), " is not accepted as a calc option in mode_calc" + stop 3 + end select + end subroutine calc + + subroutine parse(arg_pos) + !This parses the mode calc options + integer, intent(out) :: arg_pos + + character(len = 100) :: infile + integer:: arglen + real(kind=dp) :: temp_box_bd(6) + + call get_command_argument(2, infile, arglen) + if (arglen == 0 ) stop "Missing calc option in mode calc" + 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) + + call get_command_argument(3, calc_opt, arglen) + if (arglen == 0 ) stop "Missing calc option in mode calc" + + arg_pos = 4 + end subroutine parse + + subroutine calc_tot_virial + !Calculate the the total box pressure in GPa + + integer :: i, j, ibasis, inod + real(kind=dp) :: avg_virial(6) + + !First check to make sure that the virial was set for the atoms/elements + if(.not.vflag) then + print *, "Virial data has not been sent/may not be available with your current input file " + stop 3 + end if + + !Sum the atom virials + calculated = 0 + do i = 1, atom_num + do j = 1, 6 + calculated(j) = calculated(j) + virial_atom(j, i) + end do + end do + + !Sum the nodal virials + do i = 1, ele_num + avg_virial(:) = 0 + do inod = 1, ng_node(lat_ele(i)) + do ibasis = 1, basisnum(lat_ele(i)) + do j = 1,6 + avg_virial(j) = avg_virial(j) + virial_node(j,ibasis,inod,i)/(basisnum(lat_ele(i))*ng_node(lat_ele(i))) + end do + end do + end do + + !Now add the total virial from the element + calculated = calculated + avg_virial*(esize**3.0_dp) + end do + + !Now calculate the total box virial and convert to GPa + calculated = evtogp(calculated)/box_volume() + + print *, "Total virial is calculated as : (v11, v22, v33, v32, v31, v21)" + print *, calculated + end subroutine +end module mode_calc From 0620a07847e9a2b83425aa5a15f81422edc82928 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Mon, 2 Nov 2020 19:50:03 -0500 Subject: [PATCH 47/60] Added some calc and metric changes --- src/Makefile | 11 ++++++----- src/io.f90 | 2 +- src/main.f90 | 2 +- src/mode_metric.f90 | 9 +++++---- 4 files changed, 13 insertions(+), 11 deletions(-) diff --git a/src/Makefile b/src/Makefile index 22aaa6b..2068b93 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,14 +1,15 @@ -FC=ifort +FC=gfortran #Ifort flags -FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays +#FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays + #FFLAGS=-mcmodel=large -Ofast -no-wrap-margin -heap-arrays #gfortran flags -#FFLAGS=-mcmodel=large -O3 -g +FFLAGS=-mcmodel=large -O3 -g #FFLAGS=-mcmodel=large -O0 -g -fbacktrace -fcheck=all -MODES=mode_create.o mode_merge.o mode_convert.o mode_metric.o +MODES=mode_create.o mode_merge.o mode_convert.o mode_metric.o mode_calc.o OPTIONS=opt_disl.o opt_group.o opt_orient.o opt_delete.o opt_deform.o opt_redef_box.o opt_slip_plane.o OBJECTS=main.o elements.o io.o subroutines.o functions.o atoms.o call_mode.o box.o neighbors.o $(MODES) $(OPTIONS) call_option.o sorts.o @@ -23,7 +24,7 @@ cacmb: $(OBJECTS) .PHONY: clean clean: - $(RM) cacmb *.o *.mod + $(RM) cacmb *.o *.mod *genmod* testfuncs: testfuncs.o functions.o subroutines.o $(FC) testfuncs.o functions.o subroutines.o box.o elements.o -o $@ diff --git a/src/io.f90 b/src/io.f90 index 3c9e096..b1bd053 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -600,7 +600,7 @@ module io stop 3 end if select case(trim(adjustl(mode))) - case('--convert','--metric') + case('--calc', '--convert','--metric') infilenum = infilenum+1 infiles(infilenum) = temp_infile case default diff --git a/src/main.f90 b/src/main.f90 index 9f7a484..d73270f 100644 --- a/src/main.f90 +++ b/src/main.f90 @@ -112,7 +112,7 @@ program main !Check to make sure a file was passed to be written out and then write out ! Before building do a check on the file - if (trim(adjustl(mode)) /= "--metric") then + if ((trim(adjustl(mode)) /= "--metric").and.(trim(adjustl(mode)) /= "--calc"))then if ((outfilenum == 0)) then argument = 'none' call get_out_file(argument) diff --git a/src/mode_metric.f90 b/src/mode_metric.f90 index 10838c6..60d2867 100644 --- a/src/mode_metric.f90 +++ b/src/mode_metric.f90 @@ -93,10 +93,10 @@ module mode_metric call get_command_argument(2,metric_type,arglen) if (arglen == 0) stop "Incomplete mode metric command, check documentation" select case(trim(adjustl(metric_type))) - case("microrotation") + case("microrotation", "def_grad") continue case default - print *, "Mode metric does not accept metric ", metric_type, ". Please select from: microrotation" + print *, "Mode metric does not accept metric ", metric_type, ". Please select from: microrotation, def_grad" stop 3 end select @@ -155,6 +155,7 @@ module mode_metric do i = 1,3 do j = 1, 3 met(k, ip) = def_grad(i,j) + k = k + 1 end do end do case('microrotation') @@ -228,7 +229,7 @@ module mode_metric if(atom_num > 0) then do i = 1, atom_num - write(11,*) type_atom(i), r_atom(:,i), met(:,tag_atom(i)) + write(11,*) 0, type_atom(i), r_atom(:,i), met(:,tag_atom(i)) end do end if @@ -236,7 +237,7 @@ module mode_metric do i = 1, ele_num do inod = 1, ng_node(lat_ele(i)) do ibasis = 1, basisnum(lat_ele(i)) - write(11,*) basis_type(ibasis,lat_ele(i)), r_node(:,ibasis,inod,i), & + write(11,*) 1, basis_type(ibasis,lat_ele(i)), r_node(:,ibasis,inod,i), & met(:, atom_num+(tag_ele(i)-1)*max_ng_node*max_basisnum + (inod-1)*max_basisnum + ibasis) end do end do From 077574ea8d5c6621a70f52e3762b9ace25e9eab1 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Wed, 18 Nov 2020 16:03:28 -0500 Subject: [PATCH 48/60] Added disl option --- src/call_option.f90 | 2 +- src/io.f90 | 8 ++- src/opt_disl.f90 | 146 ++++++++++++++++++++++++++++++++++++++++++ src/opt_redef_box.f90 | 3 +- 4 files changed, 156 insertions(+), 3 deletions(-) diff --git a/src/call_option.f90 b/src/call_option.f90 index a195a0e..92dbe12 100644 --- a/src/call_option.f90 +++ b/src/call_option.f90 @@ -14,7 +14,7 @@ subroutine call_option(option, arg_pos) character(len=100), intent(in) :: option select case(trim(adjustl(option))) - case('-dislgen', '-disloop','-vacancydisloop') + case('-disl','-dislgen', '-disloop','-vacancydisloop') call dislocation(option, arg_pos) case('-group') call group(arg_pos) diff --git a/src/io.f90 b/src/io.f90 index b1bd053..0a2f179 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -119,7 +119,7 @@ module io !This is the simplest visualization subroutine, it writes out all nodal positions and atom positions to an xyz file character(len=100), intent(in) :: file - integer :: i, inod, ibasis + integer :: i, inod, ibasis, p_node, p_atom open(unit=11, file=trim(adjustl(file)), action='write', status='replace',position='rewind') @@ -128,21 +128,27 @@ module io !Write comment line write(11, '(a)') "#Node + atom file created using cacmb" + p_node=0 + p_atom = 0 !Write nodal positions do i = 1, ele_num do inod = 1, ng_node(lat_ele(i)) do ibasis = 1, basisnum(lat_ele(i)) write(11, '(2i16, 3f23.15)') basis_type(ibasis,lat_ele(i)), 1, r_node(:,ibasis,inod,i) + p_node = p_node + 1 end do end do end do + if(p_node /= node_num) print *, "Error with node num" !Write atom positions do i = 1, atom_num write(11, '(2i16, 3f23.15)') type_atom(i), 0, r_atom(:,i) + p_atom=p_atom +1 end do + if(p_atom /= atom_num) print *, "Error with atom num" !Finish writing close(11) end subroutine write_xyz diff --git a/src/opt_disl.f90 b/src/opt_disl.f90 index dc0e72c..351b850 100644 --- a/src/opt_disl.f90 +++ b/src/opt_disl.f90 @@ -9,6 +9,7 @@ module opt_disl implicit none integer :: vloop_size ! Number of atoms to remove in planar vacancy cluster + integer :: iline, islip_plane real(kind=dp), dimension(3) :: line, slip_plane, centroid!dislocation line, slip plane vectors, centroid, real(kind=dp) :: burgers(3) !burgers vector of loop real(kind=dp) :: poisson, char_angle, lattice_parameter!Poisson ratio and character angle, lattice_parameter for burgers vector @@ -31,6 +32,9 @@ module opt_disl print *, '--------------------Option Dislocation-----------------------' select case(trim(adjustl(option))) + case('-disl') + call parse_disl(arg_pos) + call disl case('-dislgen') call parse_dislgen(arg_pos) call dislgen @@ -43,6 +47,148 @@ module opt_disl end select end subroutine dislocation + subroutine parse_disl(arg_pos) + + !Parse disl command + + integer, intent(inout) :: arg_pos + + integer :: i,arglen + character(len=100) :: textholder + character(len=1) :: parse_dim + + !Parse all of the commands + arg_pos = arg_pos + 1 + line(:) = 0.0_dp + + call get_command_argument(arg_pos, parse_dim, arglen) + if (arglen==0) STOP "Missing line dim in disl command" + select case(parse_dim) + case('x','X') + iline=1 + case('y','Y') + iline=2 + case('z','Z') + iline=3 + end select + + arg_pos=arg_pos + 1 + call get_command_argument(arg_pos, parse_dim, arglen) + if (arglen==0) STOP "Missing plane dim in disl command" + select case(parse_dim) + case('x','X') + islip_plane=1 + case('y','Y') + islip_plane=2 + case('z','Z') + islip_plane=3 + end select + do i = 1, 3 + arg_pos = arg_pos + 1 + call get_command_argument(arg_pos, textholder, arglen) + if (arglen==0) STOP "Missing centroid in disl command" + call parse_pos(i, textholder, centroid(i)) + end do + + arg_pos = arg_pos + 1 + call get_command_argument(arg_pos, textholder, arglen) + if (arglen==0) STOP "Missing parameter in disl command" + read(textholder, *) b + + + arg_pos = arg_pos + 1 + call get_command_argument(arg_pos, textholder, arglen) + if (arglen==0) STOP "Missing character angle in disl command" + read(textholder, *) char_angle + + + arg_pos = arg_pos + 1 + call get_command_argument(arg_pos, textholder, arglen) + if (arglen==0) STOP "Missing poisson in disl command" + read(textholder, *) poisson + + arg_pos = arg_pos + 1 + end subroutine parse_disl + + subroutine disl + !This subroutine creates the actual dislocation + + integer :: i, sub_box, inod, ibasis, ix, iy, iz + real(kind=dp) :: ss_ori(3,3), ss_inv(3,3), be, bs, slipx(3), disp_transform(3,3), inv_transform(3,3), & + actan, r(3), disp(3) + + print *, "Dislocation with centroid ", centroid, " is inserted" + + !Calculate screw and edge burgers vectors + be = sin(char_angle*pi/180.0_dp)*b + bs = cos(char_angle*pi/180.0_dp)*b + + !Map box dimensions to dislocation dimensions, iz is along the dislocation line and iy is along the slip plane + iz = iline + iy = islip_plane + do i = 1, 3 + if ((i /= iy).and.(i /=iz)) then + ix = i + exit + end if + end do + + if(atom_num > 0) then + do i = 1, atom_num + r=r_atom(:,i) - centroid + if (r(ix) == 0) then + actan=pi/2 + else + actan = datan2(r(iy),r(ix)) + end if + + if ((r(ix)**2 + r(iy)**2) == 0) cycle + + !This is the elastic displacement field for dislocation according to Hirth and Lowe + disp(ix) = be/(2.0_dp*pi) * (actan + (r(ix)*r(iy))/(2.0_dp*(1.0_dp-poisson)*(r(ix)**2.0_dp + r(iy)**2.0_dp))) + disp(iy) = -be/(2.0_dp*pi)*((1.0_dp-2.0_dp*poisson)/(4.0_dp-4.0_dp*poisson) * & + log(r(ix)**2.0_dp + r(iy)**2.0_dp) & + + (r(ix)**2.0_dp - r(iy)**2.0_dp)/(4.0_dp*(1.0_dp-poisson)& + *(r(ix)**2.0_dp+r(iy)**2.0_dp))) + disp(3) = bs/(2.0_dp*pi) * actan + + r_atom(:,i) = r_atom(:,i) + disp + end do + end if + + if(ele_num > 0) then + do i = 1, ele_num + do inod=1, ng_node(lat_ele(i)) + do ibasis = 1, basisnum(lat_ele(i)) + r = r_node(:,ibasis,inod,i)-centroid + if (r(ix) == 0) then + actan = pi/2 + else + actan = datan2(r(iy),r(ix)) + end if + + if ((r(ix)**2 + r(iy)**2) == 0) cycle + + !This is the elastic displacement field for dislocation according to Hirth and Lowe + disp(ix) = be/(2.0_dp*pi)*(actan + (r(ix)*r(iy))/(2.0_dp*(1.0_dp-poisson)*(r(ix)**2.0_dp + r(iy)**2.0_dp))) + disp(iy) = -be/(2.0_dp*pi)*((1.0_dp-2.0_dp*poisson)/(4.0_dp-4.0_dp*poisson) * & + log(r(ix)**2.0_dp + r(iy)**2.0_dp) & + + (r(ix)**2.0_dp - r(iy)**2.0_dp)/(4.0_dp*(1.0_dp-poisson)& + *(r(ix)**2.0_dp+r(iy)**2.0_dp))) + disp(3) = bs/(2.0_dp*pi) * actan + + + r_node(:,ibasis,inod,i) = r_node(:,ibasis,inod,i) + disp + end do + end do + end do + end if + + !Now make sure all atoms are wrapped back into the simulation cell + call wrap_atoms + + end subroutine disl + subroutine parse_dislgen(arg_pos) !Parse dislgen command diff --git a/src/opt_redef_box.f90 b/src/opt_redef_box.f90 index 8d0d30f..b9d8e47 100644 --- a/src/opt_redef_box.f90 +++ b/src/opt_redef_box.f90 @@ -68,12 +68,13 @@ module opt_redef_box call delete_elements(delete_num, delete_list(1:delete_num)) + print *, new_bd box_bd=new_bd box_bc = new_bc end subroutine redef_box - subroutine parse_redef_box(arg_pos) + subroutine parse_redef_box(arg_pos) !Parse the command integer, intent(inout) :: arg_pos From f92e80f9dbd6ee1fa18592d79822c3adfc103f2d Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Thu, 19 Nov 2020 13:57:57 -0500 Subject: [PATCH 49/60] Added fixes to redef_box and to writing pycac restart files --- src/box.f90 | 13 +++++++++---- src/io.f90 | 7 ++++--- src/mode_convert.f90 | 3 ++- src/mode_merge.f90 | 5 ++--- src/opt_redef_box.f90 | 5 +++++ 5 files changed, 22 insertions(+), 11 deletions(-) diff --git a/src/box.f90 b/src/box.f90 index c179136..9f2c7b2 100644 --- a/src/box.f90 +++ b/src/box.f90 @@ -73,10 +73,15 @@ module box 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 + if(all(abs(box_bd) < lim_zero)) then + box_bd = temp_box_bd + else + 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 + end if + return end subroutine grow_box diff --git a/src/io.f90 b/src/io.f90 index b1bd053..95760c9 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -379,7 +379,7 @@ module io !NOTE: This code doesn't work for arbitrary number of basis atoms per node. It assumes that the !each element has only 1 atom type at the node. character(len=100), intent(in) :: file - integer :: interp_max, i, j, inod, ibasis, ip, unique_index(50), unique_size(50), unique_num, & + integer :: interp_max, i, j, inod, ibasis, ip, unique_index(50), unique_size(50), unique_type(50), unique_num, & etype real(kind=dp) :: box_vec(3) @@ -426,6 +426,7 @@ module io unique_num = unique_num + 1 unique_index(unique_num) = i unique_size(unique_num) = size_ele(i) + unique_type(unique_num) = lat_ele(i) end do eleloop !Calculate the max number of atoms per element @@ -486,7 +487,7 @@ module io do i = 1, ele_num !Figure out the ele type do j = 1, unique_num - if ( unique_size(j) == size_ele(i)) then + if ( (unique_size(j) == size_ele(i)).and.(unique_type(j) == lat_ele(i))) then etype = j exit endif @@ -670,7 +671,7 @@ module io 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 - + call grow_box(temp_box_bd) !Read in the number of sub_boxes and allocate the variables read(11, *) n diff --git a/src/mode_convert.f90 b/src/mode_convert.f90 index 3bb8a3b..eb89994 100644 --- a/src/mode_convert.f90 +++ b/src/mode_convert.f90 @@ -14,6 +14,7 @@ module mode_convert character(len=100) :: infile real(kind = dp) :: temp_box_bd(6) !First read in the file + temp_box_bd(:) = 0.0_dp 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) @@ -21,4 +22,4 @@ module mode_convert arg_pos = 3 end subroutine convert -end module mode_convert \ No newline at end of file +end module mode_convert diff --git a/src/mode_merge.f90 b/src/mode_merge.f90 index afc9bba..242ecd2 100644 --- a/src/mode_merge.f90 +++ b/src/mode_merge.f90 @@ -25,6 +25,7 @@ module mode_merge shift_flag = .false. shift_vec(:) = 0.0_dp + temp_box_bd(:) = 0.0_dp !First we parse the merge command call parse_command(arg_pos) @@ -41,7 +42,6 @@ module mode_merge 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') @@ -53,7 +53,6 @@ module mode_merge end select call read_in(i, displace, temp_box_bd) - call grow_box(temp_box_bd) end if if(shift_flag) call shift(new_starts, i) @@ -168,4 +167,4 @@ module mode_merge end if end subroutine shift -end module mode_merge \ No newline at end of file +end module mode_merge diff --git a/src/opt_redef_box.f90 b/src/opt_redef_box.f90 index 8d0d30f..da86342 100644 --- a/src/opt_redef_box.f90 +++ b/src/opt_redef_box.f90 @@ -20,6 +20,10 @@ module opt_redef_box !First parse the argument call parse_redef_box(arg_pos) + print *, '------------------------------------------------------------' + print *, 'Option redef_box' + print *, '------------------------------------------------------------' + !Now first filter atoms that don't fit in the new box bounds and delete them delete_num = 0 do i = 1, atom_num @@ -68,6 +72,7 @@ module opt_redef_box call delete_elements(delete_num, delete_list(1:delete_num)) + print *, "Old box_bd: ", box_bd, " is redefined to new box boundaries: ", new_bd box_bd=new_bd box_bc = new_bc From 4f3d88b7746f62d99994da3198de6c4290e50745 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Mon, 30 Nov 2020 11:52:38 -0500 Subject: [PATCH 50/60] Fix to reading and writing .xyz data --- src/io.f90 | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/io.f90 b/src/io.f90 index 95760c9..29ac73e 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -119,7 +119,7 @@ module io !This is the simplest visualization subroutine, it writes out all nodal positions and atom positions to an xyz file character(len=100), intent(in) :: file - integer :: i, inod, ibasis + integer :: i, inod, ibasis, outn open(unit=11, file=trim(adjustl(file)), action='write', status='replace',position='rewind') @@ -128,21 +128,32 @@ module io !Write comment line write(11, '(a)') "#Node + atom file created using cacmb" + outn=0 !Write nodal positions do i = 1, ele_num do inod = 1, ng_node(lat_ele(i)) do ibasis = 1, basisnum(lat_ele(i)) write(11, '(2i16, 3f23.15)') basis_type(ibasis,lat_ele(i)), 1, r_node(:,ibasis,inod,i) + outn = outn + 1 end do end do end do + if(outn /= node_num) then + print *, "outn", outn, " doesn't equal node_num ", node_num + end if + !Write atom positions do i = 1, atom_num write(11, '(2i16, 3f23.15)') type_atom(i), 0, r_atom(:,i) + outn = outn + 1 end do + if((outn-atom_num) /= atom_num) then + print *, "outn", (outn-node_num), " doesn't equal atom_num ", atom_num + end if + !Finish writing close(11) end subroutine write_xyz @@ -1062,7 +1073,6 @@ module io end do call add_element(tag, fcc, esize+1, lat_type, sub_box_num, re) call add_element_data(ele_num, ee, fe, ve) - node_num = node_num + 8 end do end if call set_max_esize From 2c425201028e967be1b261562607dae6508db1fe Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Wed, 2 Dec 2020 16:28:10 -0500 Subject: [PATCH 51/60] Restructure group code, add group shell, and add refinefill option --- src/elements.f90 | 3 +- src/opt_group.f90 | 277 ++++++++++++++++++++++++++++++++++++++-------- 2 files changed, 231 insertions(+), 49 deletions(-) diff --git a/src/elements.f90 b/src/elements.f90 index 5d3b3c6..fffa9cb 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -779,8 +779,7 @@ do i = 1, atom_num end do end do - - end subroutine + end subroutine get_interp_pos subroutine alloc_dat_arrays(n,m) !This subroutine used to provide initial allocation for the atom and element data arrays diff --git a/src/opt_group.f90 b/src/opt_group.f90 index 6fe2896..384b369 100644 --- a/src/opt_group.f90 +++ b/src/opt_group.f90 @@ -10,8 +10,8 @@ module opt_group integer :: group_ele_num, group_atom_num, remesh_size,normal, dim1, dim2, random_num, group_type, notsize character(len=15) :: type, shape !Type indicates what element type is selected and shape is the group shape - real(kind=dp) :: block_bd(6), centroid(3), vertices(3,3),disp_vec(3), radius, bwidth - logical :: displace, delete, max_remesh, refine, group_nodes, flip + real(kind=dp) :: block_bd(6), centroid(3), vertices(3,3),disp_vec(3), radius, bwidth, shell_thickness + logical :: displace, delete, max_remesh, refine, group_nodes, flip, efill, refinefill integer, allocatable :: element_index(:), atom_index(:) @@ -22,7 +22,9 @@ module opt_group !Main calling function for the group option integer, intent(inout) :: arg_pos - print *, '-----------------------Option Group-------------------------' + print *, '------------------------------------------------------------' + print *, 'Option Group' + print *, '------------------------------------------------------------' group_ele_num = 0 group_atom_num = 0 @@ -48,6 +50,11 @@ module opt_group call refine_group end if + if(refinefill) then + call get_group + call refinefill_group + end if + if(displace)then call get_group call displace_group @@ -335,6 +342,28 @@ module opt_group if (arglen==0) STOP "Missing sphere radius in group command" read(textholder, *) radius + case('shell') + + !First extract the shell centroid + do i = 1, 3 + arg_pos = arg_pos + 1 + call get_command_argument(arg_pos, textholder, arglen) + if (arglen==0) STOP "Missing shell centroid in group command" + call parse_pos(i, textholder, centroid(i)) + end do + + !Now get the radius + arg_pos=arg_pos+1 + call get_command_argument(arg_pos, textholder, arglen) + if (arglen==0) STOP "Missing shell radius in group command" + read(textholder, *) radius + + !Now get the shell thickness + arg_pos=arg_pos+1 + call get_command_argument(arg_pos, textholder, arglen) + if (arglen==0) STOP "Missing shell thickness in group command" + read(textholder, *) shell_thickness + case('all') !Do nothing if the shape is all continue @@ -364,6 +393,8 @@ module opt_group end do case('refine') refine=.true. + case('refinefill') + refinefill=.true. case('remesh') arg_pos = arg_pos + 1 call get_command_argument(arg_pos, textholder, arglen) @@ -382,6 +413,8 @@ module opt_group read(textholder, *) random_num case('flip') flip=.true. + case('efill') + efill=.true. case('type') arg_pos = arg_pos + 1 call get_command_argument(arg_pos, textholder, arglen) @@ -403,7 +436,7 @@ module opt_group subroutine get_group !This subroutine finds all elements and/or atoms within the group boundaries !specified by the user. - integer :: i, j, inod, ibasis, temp + integer :: i, j, inod, ibasis, temp, node_in_out(max_ng_node) integer, allocatable :: resize_array(:) real(kind=dp) :: r_center(3), rand @@ -433,48 +466,19 @@ module opt_group !Check the type to see whether we need to find the elements within the group select case(trim(adjustl(type))) case('elements', 'both') - if(.not.(group_nodes)) then - do i = 1, ele_num - r_center(:) = 0.0_dp - do inod = 1, ng_node(lat_ele(i)) - do ibasis = 1, basisnum(lat_ele(i)) - r_center = r_center + r_node(:,ibasis,inod,i)/(basisnum(lat_ele(i))*ng_node(lat_ele(i))) - end do - end do - - if ((in_group(r_center).neqv.flip).and.(size_ele(i)/= notsize)) then - group_ele_num = group_ele_num + 1 - if(group_ele_num > size(element_index)) then - allocate(resize_array(size(element_index) + 1024)) - resize_array(1:group_ele_num-1) = element_index - resize_array(group_ele_num:) = 0 - call move_alloc(resize_array, element_index) - end if - - element_index(group_ele_num) = i - end if - end do + do i = 1, ele_num + if(in_group_ele(size_ele(i), lat_ele(i), r_node(:,:,:,i))) then + group_ele_num = group_ele_num + 1 + if(group_ele_num > size(element_index)) then + allocate(resize_array(size(element_index) + 1024)) + resize_array(1:group_ele_num-1) = element_index + resize_array(group_ele_num:) = 0 + call move_alloc(resize_array, element_index) + end if - else if(group_nodes) then - eleloop:do i = 1, ele_num - r_center(:) = 0.0_dp - do inod = 1, ng_node(lat_ele(i)) - do ibasis = 1, basisnum(lat_ele(i)) - if ((in_group(r_node(:,ibasis,inod,i)).neqv.flip).and.(size_ele(i)/=notsize)) then - group_ele_num = group_ele_num + 1 - if(group_ele_num > size(element_index)) then - allocate(resize_array(size(element_index) + 1024)) - resize_array(1:group_ele_num-1) = element_index - resize_array(group_ele_num:) = 0 - call move_alloc(resize_array, element_index) - end if - element_index(group_ele_num) = i - cycle eleloop - end if - end do - end do - end do eleloop - end if + element_index(group_ele_num) = i + end if + end do if(random_num > 0) then !If we have the random option enabled then we select random_num number of elements from the group and overwrite @@ -569,7 +573,7 @@ module opt_group end subroutine displace_group subroutine refine_group - !This command is used to remesh the group to a desired element size + !This command is used to refine the group to full atomistics integer :: i, j, ie, type_interp(max_basisnum*max_esize**3), add_atom_num, orig_atom_num real(kind=dp) :: r_interp(3, max_basisnum*max_esize**3) @@ -596,7 +600,104 @@ module opt_group print *, group_ele_num, " elements of group are refined to ", atom_num -orig_atom_num, " atoms." end if - end subroutine + end subroutine refine_group + + subroutine refinefill_group + !This command is used to refine the group to full atomistics + + integer :: i, j, ie, type_interp(max_basisnum*max_esize**3), add_atom_num, orig_atom_num, m, n, o, esize, & + ele(3,8), new_ele_num, ibasis, inod, vlat(3), nump_ele + real(kind=dp) :: r_interp(3, max_basisnum*max_esize**3), rfill(3,max_basisnum,max_ng_node), ravg(3), ratom(3,max_basisnum) + logical :: lat_points(max_esize, max_esize, max_esize) + + !Refining to atoms + if(group_ele_num > 0) then + orig_atom_num = atom_num + new_ele_num = 0 + !Estimate number of atoms we are adding, this doesn't have to be exact + add_atom_num = group_ele_num*basisnum(lat_ele(element_index(1)))*size_ele(element_index(1))**3 + call grow_ele_arrays(0,add_atom_num) + do i = 1, group_ele_num + ie = element_index(i) + !Find all possible elements that we can make while making sure they aren't in the group + lat_points(1:size_ele(ie),1:size_ele(ie),1:size_ele(ie)) = .true. + + !Now calculate the number of elemets which are available for remeshing + call interpolate_atoms(type_ele(ie), size_ele(ie), lat_ele(ie), r_node(:,:,:,ie), type_interp, r_interp) + nump_ele = size_ele(ie)**3 + do o =1, size_ele(ie) + do n = 1, size_ele(ie) + do m =1, size_ele(ie) + call get_interp_pos(m,n,o,i,rfill(:,:,1)) + + ravg(:) = 0 + do ibasis = 1, basisnum(lat_ele(ie)) + ravg = ravg + rfill(:,ibasis, 1)/basisnum(lat_ele(ie)) + end do + + if( in_group(ravg)) then + nump_ele = nump_ele - 1 + end if + end do + end do + end do + + !Now start the remeshing loop for the element + esize = size_ele(ie) - 2 + do while(esize > min_efillsize) + if(nump_ele < min_efillsize**3) then + exit + else if (nump_ele < esize**3) then + esize = esize - 2 + else + ele = cubic_cell*(esize-1) + do o = 1, size_ele(ie) - esize + do n = 1, size_ele(ie) - esize + latloop:do m = 1, size_ele(ie) - esize + do inod = 1, ng_node(lat_ele(ie)) + vlat = ele(:,inod) + (/ m, n, o /) + if (.not.lat_points(vlat(1), vlat(2),vlat(3))) cycle latloop + call get_interp_pos(vlat(1), vlat(2), vlat(3), ie, rfill(:,:,inod)) + end do + + !Check to make sure all lattice points exist for the current element + if(any(.not.lat_points(m:m+esize-1, n:n+esize-1, o:o+esize-1))) cycle latloop + if (.not.in_group_ele(esize, lat_ele(ie), rfill)) then + nump_ele=nump_ele - esize**3 + lat_points(m:m+esize-1, n:n+esize-1, o:o+esize-1) = .false. + call add_element(0,type_ele(ie), esize, lat_ele(ie), sbox_ele(ie), rfill) + new_ele_num = new_ele_num + 1 + end if + + end do latloop + end do + end do + esize=esize-2 + end if + end do + !Now add the leftover lattice points as atoms + do o = 1, size_ele(i) + do n = 1, size_ele(i) + do m = 1, size_ele(i) + if(lat_points(m,n,o)) then + call get_interp_pos(m,n,o, ie, ratom(:,:)) + do ibasis = 1, basisnum(lat_ele(ie)) + call apply_periodic(r_atom(:,ibasis)) + call add_atom(0, basis_type(ibasis,lat_ele(ie)), sbox_ele(ie), ratom(:,ibasis)) + end do + end if + end do + end do + end do + + end do + !Once all atoms are added we delete all of the elements + call delete_elements(group_ele_num, element_index) + print *, group_ele_num, " elements of group are refined to ", atom_num -orig_atom_num, " atoms and ", new_ele_num, & + " elements." + end if + + end subroutine refinefill_group subroutine remesh_group !This command is used to remesh the group to a desired element size @@ -900,6 +1001,11 @@ module opt_group end subroutine change_group_type + + subroutine split_group_elements + ! + end subroutine split_group_elements + function in_group(r) !This subroutine determines if a point is within the group boundaries real(kind=dp), intent(in) :: r(3) @@ -933,8 +1039,85 @@ module opt_group else in_group = .false. end if + case('shell') + rnorm = norm2(r(:) - centroid(:)) + if ((rnorm >= radius).and.(rnorm<=(radius + shell_thickness))) then + in_group = .true. + else + in_group = .false. + end if case('all') in_group = .true. end select end function in_group + + function in_group_ele(esize, elat, rn) + !This figures out if the elements are in the group boundaries + real(kind=dp), intent(in) :: rn(3,max_basisnum, max_ng_node) + integer, intent(in) :: esize, elat + logical :: in_group_ele + + integer :: i, inod, ibasis, node_in_out(max_ng_node) + real(kind=dp) :: r_center(3) + + in_group_ele=.false. + + if(trim(adjustl(shape)) == 'shell') then + node_in_out(:) = -1 + !First calculate whether each element node is within the shell region, inside the shell sphere, or outside the + !shell region + nodeloop:do inod = 1, ng_node(elat) + r_center(:)=0.0_dp + do ibasis = 1, basisnum(elat) + r_center(:)= r_center(:) + rn(:,ibasis,inod)/basisnum(elat) + end do + + if((in_group(rn(:, ibasis, inod)).neqv.flip).and.(size_ele(i)/=notsize)) then + node_in_out(inod) = 2 + exit nodeloop + end if + + shape ='sphere' + if((in_group(rn(:, ibasis, inod)).neqv.flip).and.(esize/=notsize)) then + node_in_out(inod) = 1 + else + node_in_out(inod) = 0 + end if + shape='shell' + end do nodeloop + + !If any nodes are within the shell region, or if the shell region interescts an element then add it to the group + if(any(node_in_out == 2).or.(any(node_in_out==1).and.(any(node_in_out==0)))) then + in_group_ele=.true. + return + end if + + else if(.not.(group_nodes)) then + r_center(:) = 0.0_dp + do inod = 1, ng_node(elat) + do ibasis = 1, basisnum(elat) + r_center = r_center + rn(:,ibasis,inod)/(basisnum(elat)*ng_node(elat)) + end do + end do + + if ((in_group(r_center).neqv.flip).and.(esize/= notsize)) then + in_group_ele=.true. + return + end if + + else if(group_nodes) then + r_center(:) = 0.0_dp + do inod = 1, ng_node(elat) + do ibasis = 1, basisnum(elat) + if ((in_group(rn(:,ibasis,inod)).neqv.flip).and.(esize/=notsize)) then + in_group_ele=.true. + return + end if + end do + end do + end if + + + end function in_group_ele + end module opt_group From 29df0f9eb2ae79d8444e49d33e58df975c099bd7 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Thu, 3 Dec 2020 09:21:31 -0500 Subject: [PATCH 52/60] Fix to opt_group which got the code working --- src/opt_group.f90 | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/src/opt_group.f90 b/src/opt_group.f90 index 384b369..603bf6e 100644 --- a/src/opt_group.f90 +++ b/src/opt_group.f90 @@ -606,7 +606,7 @@ module opt_group !This command is used to refine the group to full atomistics integer :: i, j, ie, type_interp(max_basisnum*max_esize**3), add_atom_num, orig_atom_num, m, n, o, esize, & - ele(3,8), new_ele_num, ibasis, inod, vlat(3), nump_ele + ele(3,8), new_ele_num, ibasis, inod, vlat(3), nump_ele, added_points real(kind=dp) :: r_interp(3, max_basisnum*max_esize**3), rfill(3,max_basisnum,max_ng_node), ravg(3), ratom(3,max_basisnum) logical :: lat_points(max_esize, max_esize, max_esize) @@ -623,7 +623,6 @@ module opt_group lat_points(1:size_ele(ie),1:size_ele(ie),1:size_ele(ie)) = .true. !Now calculate the number of elemets which are available for remeshing - call interpolate_atoms(type_ele(ie), size_ele(ie), lat_ele(ie), r_node(:,:,:,ie), type_interp, r_interp) nump_ele = size_ele(ie)**3 do o =1, size_ele(ie) do n = 1, size_ele(ie) @@ -644,6 +643,7 @@ module opt_group !Now start the remeshing loop for the element esize = size_ele(ie) - 2 + added_points=0 do while(esize > min_efillsize) if(nump_ele < min_efillsize**3) then exit @@ -667,6 +667,7 @@ module opt_group lat_points(m:m+esize-1, n:n+esize-1, o:o+esize-1) = .false. call add_element(0,type_ele(ie), esize, lat_ele(ie), sbox_ele(ie), rfill) new_ele_num = new_ele_num + 1 + added_points = added_points + esize**3 end if end do latloop @@ -676,20 +677,25 @@ module opt_group end if end do !Now add the leftover lattice points as atoms - do o = 1, size_ele(i) - do n = 1, size_ele(i) - do m = 1, size_ele(i) + do o = 1, size_ele(ie) + do n = 1, size_ele(ie) + do m = 1, size_ele(ie) if(lat_points(m,n,o)) then call get_interp_pos(m,n,o, ie, ratom(:,:)) do ibasis = 1, basisnum(lat_ele(ie)) - call apply_periodic(r_atom(:,ibasis)) + call apply_periodic(ratom(:,ibasis)) call add_atom(0, basis_type(ibasis,lat_ele(ie)), sbox_ele(ie), ratom(:,ibasis)) + added_points=added_points + 1 end do end if end do end do end do + if (added_points /= (size_ele(ie)**3)) then + + print *, "Element ", ie, " is refined incorrectly in refinefill" + end if end do !Once all atoms are added we delete all of the elements call delete_elements(group_ele_num, element_index) From fa5047b7352e687162b627da7f48be9d4d16e5ed Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Fri, 4 Dec 2020 12:17:09 -0500 Subject: [PATCH 53/60] Fix to error checking in writing .xyz files --- src/io.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/io.f90 b/src/io.f90 index 29ac73e..f168a4f 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -150,7 +150,7 @@ module io outn = outn + 1 end do - if((outn-atom_num) /= atom_num) then + if((outn-node_num) /= atom_num) then print *, "outn", (outn-node_num), " doesn't equal atom_num ", atom_num end if From 7a55aa03debc0c285e525b703819dfb8b5fa651b Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Sun, 10 Jan 2021 01:32:16 +0000 Subject: [PATCH 54/60] Revert "Update license from gplv3 to MIT" This reverts commit fd901648f23d7cb53856d84d65d392bd8fa69443 --- LICENSE | 676 +++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 671 insertions(+), 5 deletions(-) diff --git a/LICENSE b/LICENSE index a14982c..f288702 100644 --- a/LICENSE +++ b/LICENSE @@ -1,8 +1,674 @@ -The MIT License (MIT) -Copyright © 2020 + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 -Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. -The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. + Preamble -THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.T + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. From fe3cc92bc01a945c9254d06a83ef65b12a655fb2 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Tue, 12 Jan 2021 11:46:50 -0500 Subject: [PATCH 55/60] Fix problem with set_types --- src/call_option.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/call_option.f90 b/src/call_option.f90 index 92dbe12..dd8abc9 100644 --- a/src/call_option.f90 +++ b/src/call_option.f90 @@ -41,7 +41,7 @@ subroutine call_option(option, arg_pos) case('-set_cac') arg_pos=arg_pos +3 case('-set_types') - arg_pos = arg_pos + 3 + atom_types + arg_pos = arg_pos + 2 + atom_types case('-redef_box') call redef_box(arg_pos) case('-slip_plane') From 77ef2bd063d7d699692fd815538ead77d1c4924b Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Tue, 12 Jan 2021 11:51:46 -0500 Subject: [PATCH 56/60] Update metric file to make it similar to the xyz file in io subroutine --- src/mode_metric.f90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/mode_metric.f90 b/src/mode_metric.f90 index 60d2867..dbe910e 100644 --- a/src/mode_metric.f90 +++ b/src/mode_metric.f90 @@ -46,7 +46,7 @@ module mode_metric case('def_grad') allocate(met(9, np)) case('microrotation') - allocate(met(3,np)) + allocate(met(4,np)) end select !Now set the reference positions @@ -174,6 +174,7 @@ module mode_metric end do end do end do + met(4,ip) = norm2(met(1:3,ip)) end if end if end select @@ -222,14 +223,14 @@ module mode_metric select case(metric_type) case('def_grad') - write(11,*) "type x y z F11 F12 F13 F21 F22 F23 F31 F32 F33" + write(11,*) "type element x y z F11 F12 F13 F21 F22 F23 F31 F32 F33" case('microrotation') - write(11,*) "type x y z micro1 micro2 micro3" + write(11,*) "type element x y z micro1 micro2 micro3 norm2(micro)" end select if(atom_num > 0) then do i = 1, atom_num - write(11,*) 0, type_atom(i), r_atom(:,i), met(:,tag_atom(i)) + write(11,*) type_atom(i), 0, r_atom(:,i), met(:,tag_atom(i)) end do end if @@ -237,7 +238,7 @@ module mode_metric do i = 1, ele_num do inod = 1, ng_node(lat_ele(i)) do ibasis = 1, basisnum(lat_ele(i)) - write(11,*) 1, basis_type(ibasis,lat_ele(i)), r_node(:,ibasis,inod,i), & + write(11,*) basis_type(ibasis,lat_ele(i)), 1, r_node(:,ibasis,inod,i), & met(:, atom_num+(tag_ele(i)-1)*max_ng_node*max_basisnum + (inod-1)*max_basisnum + ibasis) end do end do From 361c8cae530538c8700f924ae7b19fed5f5e3755 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Tue, 12 Jan 2021 11:52:28 -0500 Subject: [PATCH 57/60] Some fixes to opt_disl code --- src/opt_disl.f90 | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) diff --git a/src/opt_disl.f90 b/src/opt_disl.f90 index 351b850..1833daa 100644 --- a/src/opt_disl.f90 +++ b/src/opt_disl.f90 @@ -150,8 +150,8 @@ module opt_disl log(r(ix)**2.0_dp + r(iy)**2.0_dp) & + (r(ix)**2.0_dp - r(iy)**2.0_dp)/(4.0_dp*(1.0_dp-poisson)& *(r(ix)**2.0_dp+r(iy)**2.0_dp))) - disp(3) = bs/(2.0_dp*pi) * actan - + disp(iz) = bs/(2.0_dp*pi) * actan + r_atom(:,i) = r_atom(:,i) + disp end do end if @@ -175,7 +175,7 @@ module opt_disl log(r(ix)**2.0_dp + r(iy)**2.0_dp) & + (r(ix)**2.0_dp - r(iy)**2.0_dp)/(4.0_dp*(1.0_dp-poisson)& *(r(ix)**2.0_dp+r(iy)**2.0_dp))) - disp(3) = bs/(2.0_dp*pi) * actan + disp(iz) = bs/(2.0_dp*pi) * actan r_node(:,ibasis,inod,i) = r_node(:,ibasis,inod,i) + disp @@ -184,8 +184,6 @@ module opt_disl end do end if - !Now make sure all atoms are wrapped back into the simulation cell - call wrap_atoms end subroutine disl @@ -269,6 +267,7 @@ module opt_disl call matrix_inverse(ss_ori, 3, ss_inv) !Apply the rotation + print *, ss_inv disp_transform = matmul(sub_box_ori(:,:,i), ss_inv) call matrix_inverse(disp_transform,3,inv_transform) @@ -329,8 +328,6 @@ module opt_disl end do end if - !Now make sure all atoms are wrapped back into the simulation cell - call wrap_atoms end subroutine dislgen @@ -544,8 +541,6 @@ module opt_disl end do return - !Now make sure all atoms are wrapped back into the simulation cell - call wrap_atoms end subroutine !******************************************************** From 90bdc160cb1c02d5511e39e2a03845e6e23cfc4e Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Fri, 12 Feb 2021 12:35:04 -0500 Subject: [PATCH 58/60] Update to Make file and working compile --- src/Makefile | 80 ++++++++++---------- src/Makefile.dep | 175 ++++++++++++++++++++++++++++++++++++++++++++ src/call_mode.f90 | 34 --------- src/call_option.f90 | 53 -------------- src/caller.f90 | 91 +++++++++++++++++++++++ src/main.f90 | 1 + src/opt_orient.f90 | 4 +- 7 files changed, 307 insertions(+), 131 deletions(-) create mode 100644 src/Makefile.dep delete mode 100644 src/call_mode.f90 delete mode 100644 src/call_option.f90 create mode 100644 src/caller.f90 diff --git a/src/Makefile b/src/Makefile index 2068b93..158d9db 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,53 +1,49 @@ -FC=gfortran +.SUFFIXES: .c .f .f90 .F90 .o +.DEFAULT_GOAL := all -#Ifort flags -#FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays +FC=mpif90 +FFLAGS=-Wall -mcmodel=large -O0 -g -fbacktrace -fcheck=all -ffpe-trap=invalid,zero,overflow,underflow,denormal -#FFLAGS=-mcmodel=large -Ofast -no-wrap-margin -heap-arrays +OBJDIR=obj +SRCS := $(wildcard *.f90) +OBJECTS := $(addprefix $(OBJDIR)/,$(SRCS:%.f90=%.o)) -#gfortran flags -FFLAGS=-mcmodel=large -O3 -g -#FFLAGS=-mcmodel=large -O0 -g -fbacktrace -fcheck=all -MODES=mode_create.o mode_merge.o mode_convert.o mode_metric.o mode_calc.o -OPTIONS=opt_disl.o opt_group.o opt_orient.o opt_delete.o opt_deform.o opt_redef_box.o opt_slip_plane.o -OBJECTS=main.o elements.o io.o subroutines.o functions.o atoms.o call_mode.o box.o neighbors.o $(MODES) $(OPTIONS) call_option.o sorts.o -.SUFFIXES: -.SUFFIXES: .c .f .f90 .F90 .o +#----------------- DEPENDENCIES -----------------# +# GENERATED USING https://github.com/ZedThree/fort_depend.py **requires python3** +# > pip install fortdepend +# > fortdepend -o Makefile.dep -i mpi -b obj/ +include Makefile.dep + +#----------------- DEFAULTS -----------------# +all: cacmb -cacmb: $(OBJECTS) - $(FC) $(FFLAGS) $(OBJECTS) parameters.o -o $@ +.PHONY: deps +cacmb: $(OBJECTS) $(OBJDIR)/main.o + $(FC) $(FFLAGS) $(OBJECTS) -o $@ + +$(OBJDIR)/%.o: %.f90 + @mkdir -p $(@D) + $(FC) $(FFLAGS) -c -o $@ $< -J$(OBJDIR) .f90.o: $(FC) $(FFLAGS) -c $< + +deps: + @fortdepend -o Makefile.dep -i mpi -b obj -w + +#----------------- CLEAN UP -----------------# + .PHONY: clean -clean: - $(RM) cacmb *.o *.mod *genmod* - -testfuncs: testfuncs.o functions.o subroutines.o - $(FC) testfuncs.o functions.o subroutines.o box.o elements.o -o $@ - -.PHONY: cleantest -cleantest: - $(RM) testfuncs testfuncs.o - -.PHONY: test -test: testfuncs - ./testfuncs - -.PHONY: install -install: cacmb - cp ./cacmb /usr/local/bin - -$(OBJECTS) : parameters.o -atoms.o subroutines.o testfuncs.o box.o : functions.o -main.o io.o $(MODES) $(OPTIONS) : elements.o -call_mode.o : $(MODES) -call_option.o : $(OPTIONS) -elements.o : sorts.o -$(MODES) $(OPTIONS) subroutines.o io.o : atoms.o box.o -$(MODES) main.o : io.o -testfuncs.o elements.o mode_create.o $(OPTIONS) $(MODES): subroutines.o -opt_delete.o mode_metric.o : neighbors.o +clean: + $(RM) *.mod *.o + $(RM) $(OBJDIR)/*.mod $(OBJDIR)/*.o CAC + @$(RM) -rf obj/ + +.PHONY: clean-all +clean-all: clean + +# DEBUGGING VARIABLE PRINT +print-% : ; @echo $* = $($*) diff --git a/src/Makefile.dep b/src/Makefile.dep new file mode 100644 index 0000000..55f461d --- /dev/null +++ b/src/Makefile.dep @@ -0,0 +1,175 @@ +# This file is generated automatically. DO NOT EDIT! + +obj/main : \ + obj/atoms.o \ + obj/box.o \ + obj/caller.o \ + obj/elements.o \ + obj/functions.o \ + obj/io.o \ + obj/main.o \ + obj/mode_calc.o \ + obj/mode_check.o \ + obj/mode_convert.o \ + obj/mode_create.o \ + obj/mode_merge.o \ + obj/mode_metric.o \ + obj/neighbors.o \ + obj/opt_deform.o \ + obj/opt_delete.o \ + obj/opt_disl.o \ + obj/opt_group.o \ + obj/opt_orient.o \ + obj/opt_redef_box.o \ + obj/opt_slip_plane.o \ + obj/parameters.o \ + obj/sorts.o \ + obj/subroutines.o + +obj/atoms.o : \ + obj/functions.o \ + obj/parameters.o + +obj/box.o : \ + obj/functions.o \ + obj/parameters.o + +obj/caller.o : \ + obj/box.o \ + obj/mode_calc.o \ + obj/mode_check.o \ + obj/mode_convert.o \ + obj/mode_create.o \ + obj/mode_merge.o \ + obj/mode_metric.o \ + obj/opt_deform.o \ + obj/opt_delete.o \ + obj/opt_disl.o \ + obj/opt_group.o \ + obj/opt_orient.o \ + obj/opt_redef_box.o \ + obj/opt_slip_plane.o \ + obj/parameters.o + +obj/elements.o : \ + obj/box.o \ + obj/functions.o \ + obj/parameters.o \ + obj/sorts.o \ + obj/subroutines.o + +obj/functions.o : \ + obj/parameters.o + +obj/io.o : \ + obj/atoms.o \ + obj/box.o \ + obj/elements.o \ + obj/parameters.o + +obj/main.o : \ + obj/caller.o \ + obj/elements.o \ + obj/io.o \ + obj/parameters.o + +obj/mode_calc.o : \ + obj/box.o \ + obj/elements.o \ + obj/io.o \ + obj/parameters.o \ + obj/subroutines.o + +obj/mode_check.o : \ + obj/atoms.o \ + obj/box.o \ + obj/elements.o \ + obj/functions.o \ + obj/io.o \ + obj/neighbors.o \ + obj/parameters.o \ + obj/subroutines.o + +obj/mode_convert.o : \ + obj/box.o \ + obj/elements.o \ + obj/io.o \ + obj/parameters.o + +obj/mode_create.o : \ + obj/atoms.o \ + obj/box.o \ + obj/elements.o \ + obj/io.o \ + obj/parameters.o \ + obj/subroutines.o + +obj/mode_merge.o : \ + obj/atoms.o \ + obj/elements.o \ + obj/io.o \ + obj/parameters.o \ + obj/subroutines.o + +obj/mode_metric.o : \ + obj/elements.o \ + obj/io.o \ + obj/neighbors.o \ + obj/parameters.o + +obj/neighbors.o : \ + obj/elements.o \ + obj/functions.o \ + obj/parameters.o \ + obj/subroutines.o + +obj/opt_deform.o : \ + obj/box.o \ + obj/elements.o \ + obj/parameters.o \ + obj/subroutines.o + +obj/opt_delete.o : \ + obj/elements.o \ + obj/neighbors.o \ + obj/parameters.o \ + obj/subroutines.o + +obj/opt_disl.o : \ + obj/box.o \ + obj/elements.o \ + obj/parameters.o \ + obj/subroutines.o + +obj/opt_group.o : \ + obj/box.o \ + obj/elements.o \ + obj/parameters.o \ + obj/subroutines.o + +obj/opt_orient.o : \ + obj/box.o \ + obj/elements.o \ + obj/parameters.o \ + obj/subroutines.o + +obj/opt_redef_box.o : \ + obj/box.o \ + obj/elements.o \ + obj/subroutines.o + +obj/opt_slip_plane.o : \ + obj/elements.o \ + obj/functions.o \ + obj/parameters.o \ + obj/subroutines.o + +obj/parameters.o : + +obj/sorts.o : \ + obj/parameters.o + +obj/subroutines.o : \ + obj/box.o \ + obj/functions.o \ + obj/parameters.o diff --git a/src/call_mode.f90 b/src/call_mode.f90 deleted file mode 100644 index b933751..0000000 --- a/src/call_mode.f90 +++ /dev/null @@ -1,34 +0,0 @@ -subroutine call_mode(arg_pos) - !This code is used to parse the command line argument for the mode information and calls the required - !mode module. - - use mode_create - use mode_convert - use mode_merge - use mode_metric - use mode_calc - use parameters - - implicit none - - integer, intent(out) :: arg_pos - - select case(mode) - case('--create') - call create(arg_pos) - case('--convert') - call convert(arg_pos) - case('--merge') - call merge(arg_pos) - case('--metric') - call metric(arg_pos) - case('--calc') - call calc(arg_pos) - case default - print *, "Mode ", trim(adjustl(mode)), " currently not accepted. Please check documentation for ", & - "accepted modes and rerun." - - stop 3 - - end select -end subroutine call_mode diff --git a/src/call_option.f90 b/src/call_option.f90 deleted file mode 100644 index dd8abc9..0000000 --- a/src/call_option.f90 +++ /dev/null @@ -1,53 +0,0 @@ -subroutine call_option(option, arg_pos) - use parameters - use opt_disl - use opt_group - use opt_orient - use opt_deform - use opt_delete - use opt_redef_box - use opt_slip_plane - use box - implicit none - - integer, intent(inout) :: arg_pos - character(len=100), intent(in) :: option - - select case(trim(adjustl(option))) - case('-disl','-dislgen', '-disloop','-vacancydisloop') - call dislocation(option, arg_pos) - case('-group') - call group(arg_pos) - case('-ow') - arg_pos = arg_pos + 1 - case('-wrap') - arg_pos = arg_pos + 1 - case('-orient') - call orient(arg_pos) - case('-unorient') - call unorient - arg_pos = arg_pos + 1 - case('-boundary') - arg_pos=arg_pos+1 - call get_command_argument(arg_pos, box_bc) - arg_pos=arg_pos+1 - bound_called = .true. - case('-sbox_ori') - call sbox_ori(arg_pos) - case('-deform') - call deform(arg_pos) - case('-delete') - call run_delete(arg_pos) - case('-set_cac') - arg_pos=arg_pos +3 - case('-set_types') - arg_pos = arg_pos + 2 + atom_types - case('-redef_box') - call redef_box(arg_pos) - case('-slip_plane') - call run_slip_plane(arg_pos) - case default - print *, 'Option ', trim(adjustl(option)), ' is not currently accepted.' - stop 3 - end select -end subroutine call_option diff --git a/src/caller.f90 b/src/caller.f90 new file mode 100644 index 0000000..df29501 --- /dev/null +++ b/src/caller.f90 @@ -0,0 +1,91 @@ +module caller + !this module just calls modes and options + + use mode_create + use mode_convert + use mode_merge + use mode_metric + use mode_calc + use parameters + use opt_disl + use opt_group + use opt_orient + use opt_deform + use opt_delete + use opt_redef_box + use opt_slip_plane + use box + + + implicit none + public + contains + subroutine call_mode(arg_pos) + !This code is used to parse the command line argument for the mode information and calls the required + !mode module. + + integer, intent(out) :: arg_pos + + select case(mode) + case('--create') + call create(arg_pos) + case('--convert') + call convert(arg_pos) + case('--merge') + call merge(arg_pos) + case('--metric') + call metric(arg_pos) + case('--calc') + call calc(arg_pos) + case default + print *, "Mode ", trim(adjustl(mode)), " currently not accepted. Please check documentation for ", & + "accepted modes and rerun." + + stop 3 + end select + end subroutine call_mode + + subroutine call_option(option, arg_pos) + integer, intent(inout) :: arg_pos + character(len=100), intent(in) :: option + + select case(trim(adjustl(option))) + case('-disl','-dislgen', '-disloop','-vacancydisloop') + call dislocation(option, arg_pos) + case('-group') + call group(arg_pos) + case('-ow') + arg_pos = arg_pos + 1 + case('-wrap') + arg_pos = arg_pos + 1 + case('-orient') + call orient_opt(arg_pos) + case('-unorient') + call unorient + arg_pos = arg_pos + 1 + case('-boundary') + arg_pos=arg_pos+1 + call get_command_argument(arg_pos, box_bc) + arg_pos=arg_pos+1 + bound_called = .true. + case('-sbox_ori') + call sbox_ori(arg_pos) + case('-deform') + call deform(arg_pos) + case('-delete') + call run_delete(arg_pos) + case('-set_cac') + arg_pos=arg_pos +3 + case('-set_types') + arg_pos = arg_pos + 3 + atom_types + case('-redef_box') + call redef_box(arg_pos) + case('-slip_plane') + call run_slip_plane(arg_pos) + case default + print *, 'Option ', trim(adjustl(option)), ' is not currently accepted.' + stop 3 + end select + end subroutine call_option + +end module caller diff --git a/src/main.f90 b/src/main.f90 index d73270f..e508ece 100644 --- a/src/main.f90 +++ b/src/main.f90 @@ -15,6 +15,7 @@ program main use parameters use elements use io + use caller integer :: i, end_mode_arg, arg_num, arg_pos diff --git a/src/opt_orient.f90 b/src/opt_orient.f90 index e60049b..fd42cb1 100644 --- a/src/opt_orient.f90 +++ b/src/opt_orient.f90 @@ -16,7 +16,7 @@ module opt_orient public contains - subroutine orient(arg_pos) + subroutine orient_opt(arg_pos) integer, intent(inout) :: arg_pos @@ -82,7 +82,7 @@ module opt_orient end do call def_new_box - end subroutine orient + end subroutine orient_opt subroutine parse_orient(arg_pos) !This parses the orient option From fc8186f3a1a2282519c5e4b84119aa24326c25a0 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Mon, 15 Feb 2021 14:33:17 -0500 Subject: [PATCH 59/60] Update to match new cac inputs/output formats --- src/Makefile.dep | 18 +-- src/elements.f90 | 17 ++- src/io.f90 | 295 +++++++++++++++++++++-------------------------- src/str.f90 | 33 ++++++ 4 files changed, 184 insertions(+), 179 deletions(-) create mode 100644 src/str.f90 diff --git a/src/Makefile.dep b/src/Makefile.dep index 55f461d..54ee834 100644 --- a/src/Makefile.dep +++ b/src/Makefile.dep @@ -9,7 +9,6 @@ obj/main : \ obj/io.o \ obj/main.o \ obj/mode_calc.o \ - obj/mode_check.o \ obj/mode_convert.o \ obj/mode_create.o \ obj/mode_merge.o \ @@ -24,6 +23,7 @@ obj/main : \ obj/opt_slip_plane.o \ obj/parameters.o \ obj/sorts.o \ + obj/str.o \ obj/subroutines.o obj/atoms.o : \ @@ -37,7 +37,6 @@ obj/box.o : \ obj/caller.o : \ obj/box.o \ obj/mode_calc.o \ - obj/mode_check.o \ obj/mode_convert.o \ obj/mode_create.o \ obj/mode_merge.o \ @@ -65,7 +64,8 @@ obj/io.o : \ obj/atoms.o \ obj/box.o \ obj/elements.o \ - obj/parameters.o + obj/parameters.o \ + obj/str.o obj/main.o : \ obj/caller.o \ @@ -80,16 +80,6 @@ obj/mode_calc.o : \ obj/parameters.o \ obj/subroutines.o -obj/mode_check.o : \ - obj/atoms.o \ - obj/box.o \ - obj/elements.o \ - obj/functions.o \ - obj/io.o \ - obj/neighbors.o \ - obj/parameters.o \ - obj/subroutines.o - obj/mode_convert.o : \ obj/box.o \ obj/elements.o \ @@ -169,6 +159,8 @@ obj/parameters.o : obj/sorts.o : \ obj/parameters.o +obj/str.o : + obj/subroutines.o : \ obj/box.o \ obj/functions.o \ diff --git a/src/elements.f90 b/src/elements.f90 index fffa9cb..6d71e0a 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -14,10 +14,11 @@ module elements integer, allocatable :: size_ele(:), lat_ele(:), sbox_ele(:), tag_ele(:) !Element size real(kind=dp), allocatable :: r_node(:,:,:,:) !Nodal position array !Element result data structures - real(kind=8), allocatable :: force_node(:,:,:,:), virial_node(:,:,:,:), energy_node(:,:,:) + real(kind=dp), allocatable :: force_node(:,:,:,:), virial_node(:,:,:,:), energy_node(:,:,:) integer, save :: ele_num !Number of elements integer, save :: node_num !Total number of nodes + integer, save :: node_atoms !Count of all basis atoms at nodes summed over all nodes !Data structure used to represent atoms integer, allocatable :: type_atom(:)!atom type @@ -120,6 +121,7 @@ module elements basisnum(:) = 0 ng_node(:) = 0 node_num = 0 + node_atoms = 0 ele_num = 0 atom_num = 0 end subroutine lattice_init @@ -288,6 +290,7 @@ module elements ele_num = ele_num + 1 node_num = node_num + ng_node(lat) + node_atoms = node_atoms + ng_node(lat)*basisnum(lat) if (tag==0) then newtag = ele_num !If we don't assign a tag then pass the tag as the ele_num @@ -386,7 +389,7 @@ module elements end if end subroutine - subroutine interpolate_atoms(type, esize, lat_type, r_in, type_interp, r_interp) + subroutine interpolate_atoms(type, esize, lat_type, r_in, type_interp, r_interp, eng, f, v, data_interp) !This subroutine returns the interpolated atoms from the elements. !Arguments @@ -396,6 +399,9 @@ module elements real(kind=dp), dimension(3,max_basisnum, max_ng_node), intent(in) :: r_in !Nodal positions integer, dimension(max_basisnum*max_esize**3), intent(out) :: type_interp !Interpolated atomic positions real(kind=dp), dimension(3, max_basisnum*max_esize**3), intent(out) :: r_interp !Interpolated atomic positions + real(kind = dp), optional, intent(in) :: eng(max_basisnum, max_ng_node), f(3, max_basisnum, max_ng_node), & + v(6, max_basisnum, max_ng_node) + real(kind=dp), dimension(10, max_basisnum*max_esize**3), optional,intent(out) :: data_interp !Interpolated atomic positions !Internal variables integer :: it, is, ir, ibasis, inod, ia, bnum, lat_type_temp @@ -405,6 +411,7 @@ module elements !Initialize some variables r_interp(:,:) = 0.0_dp type_interp(:) = 0 + if(present(data_interp)) data_interp = 0.0_dp ia = 0 !Define bnum based on the input lattice type. If lat_type=0 then we are interpolating lattice points which means @@ -437,6 +444,12 @@ module elements type_interp(ia) = basis_type(ibasis,lat_type_temp) r_interp(:,ia) = r_interp(:,ia) + a_shape(inod) * r_in(:,ibasis,inod) + if(present(data_interp)) then + !If data is present then interpolate data arrays as well + data_interp(1,ia) = data_interp(1,ia) + eng(ibasis, inod)*a_shape(inod) + data_interp(2:4,ia) = data_interp(2:4,ia) + f(:, ibasis, inod)*a_shape(inod) + data_interp(5:10,ia) = data_interp(5:10,ia) + v(:, ibasis, inod)*a_shape(inod) + end if end do end do diff --git a/src/io.f90 b/src/io.f90 index f168a4f..6ee5e64 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -4,6 +4,7 @@ module io use parameters use atoms use box + use str implicit none @@ -59,7 +60,7 @@ module io cycle end if select case(temp_outfile(scan(temp_outfile,'.',.true.)+1:)) - case('xyz', 'lmp', 'vtk', 'mb', 'restart') + case('xyz', 'lmp', 'vtk', 'mb', 'restart', 'dump') outfilenum=outfilenum+1 outfiles(outfilenum) = temp_outfile exit @@ -104,6 +105,8 @@ module io call write_pycac(outfiles(i)) case('cac') call write_lmpcac(outfiles(i)) + case('dump') + call write_ldump(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, lmp, vtk, mb, restart, cac and try again" @@ -124,7 +127,7 @@ module io open(unit=11, file=trim(adjustl(file)), action='write', status='replace',position='rewind') !Write total number of atoms + elements - write(11, '(i16)') node_num+atom_num + write(11, '(i16)') node_atoms+atom_num !Write comment line write(11, '(a)') "#Node + atom file created using cacmb" @@ -140,8 +143,8 @@ module io end do end do - if(outn /= node_num) then - print *, "outn", outn, " doesn't equal node_num ", node_num + if(outn /= node_atoms) then + print *, "outn", outn, " doesn't equal node_atoms ", node_atoms end if !Write atom positions @@ -150,8 +153,8 @@ module io outn = outn + 1 end do - if((outn-node_num) /= atom_num) then - print *, "outn", (outn-node_num), " doesn't equal atom_num ", atom_num + if((outn-node_atoms) /= atom_num) then + print *, "outn", (outn-node_atoms), " doesn't equal atom_num ", atom_num end if !Finish writing @@ -219,6 +222,87 @@ module io end do end subroutine write_lmp + subroutine write_ldump(file) + !This subroutine will only work if element data is defined + character(len = *), intent(in) :: file + integer :: write_num, i, iatom + logical :: write_dat + integer :: type_interp(max_basisnum*max_esize**3), interp_num + real(kind=dp) :: r_interp(3, max_basisnum*max_esize**3), data_interp(10, max_basisnum*max_esize**3) + + + +1 format('ITEM: TIMESTEP'/i16) +2 format('ITEM: NUMBER OF ATOMS' /i16) +3 format('ITEM: BOX BOUNDS ', 2a1, ' ', 2a1, ' ', 2a1 / & + 2f23.15 / 2f23.15 / 2f23.15) +4 format('ITEM: ATOMS id type x y z energy fx fy fz s11 s22 s33 s23 s13 s12') +5 format('ITEM: ATOMS id type x y z') + + open(unit=11, file=trim(adjustl(file)), action='write', status='replace',position='rewind') + + !Write header information + write(11,1) timestep + + !Calculate total atom number + write_num = atom_num + do i = 1,ele_num + if(type_ele(i) == 'fcc') write_num = write_num + size_ele(i)**3 + if(type_ele(i) == 'bcc') write_num = write_num + size_ele(i)**3 + end do + !Write total number of atoms + write(11,2) write_num + !Write box information + write(11,3) box_bc(1:1), box_bc(1:1), box_bc(2:2), box_bc(2:2), box_bc(3:3), box_bc(3:3), box_bd(:) + + !Now pick if we are interpolating data or not + if(allocated(force_node).or.allocated(force_atom)) then + write(11, 4) + write_dat = .true. + else + write(11, 5) + write_dat = .false. + end if + + if (write_dat) then + do i = 1, atom_num + write(11, '(2i16, 13f23.15)') i, type_atom(i), r_atom(:,i), energy_atom(i), force_atom(:,i), virial_atom(:,i) + end do + else + do i = 1, atom_num + write(11, '(2i16, 3f23.15)') i, type_atom(i), r_atom(:,i) + end do + end if + + !Write refined element atomic positions + interp_num = 0 + do i = 1, ele_num + if(write_dat) then + call interpolate_atoms(type_ele(i), size_ele(i), lat_ele(i), r_node(:,:,:,i), type_interp, r_interp, & + energy_node(:,:,i), force_node(:,:,:,i), virial_node(:,:,:,i), data_interp) + else + call interpolate_atoms(type_ele(i), size_ele(i), lat_ele(i), r_node(:,:,:,i), type_interp, r_interp) + end if + select case(trim(adjustl(type_ele(i)))) + case('fcc','bcc') + if(write_dat) then + do iatom = 1, basisnum(lat_ele(i))*size_ele(i)**3 + interp_num = interp_num+1 + call apply_periodic(r_interp(:,iatom)) + write(11, '(2i16, 13f23.15)') atom_num+interp_num, type_interp(iatom), r_interp(:,iatom), & + data_interp(:,iatom) + end do + else + do iatom = 1, basisnum(lat_ele(i))*size_ele(i)**3 + interp_num = interp_num+1 + call apply_periodic(r_interp(:,iatom)) + write(11, '(2i16, 3f23.15)') atom_num+interp_num, type_interp(iatom), r_interp(:,iatom) + end do + end if + end select + end do + end subroutine write_ldump + subroutine write_lmpcac(file) !This subroutine writes out a .lmp style dump file character(len=100), intent(in) :: file @@ -392,54 +476,30 @@ module io character(len=100), intent(in) :: file integer :: interp_max, i, j, inod, ibasis, ip, unique_index(50), unique_size(50), unique_type(50), unique_num, & etype - real(kind=dp) :: box_vec(3) + real(kind=dp) :: box_vec(3), masses(10) 1 format('time' / i16, f23.15) 2 format('number of elements' / i16) 3 format('number of nodes' / i16) -4 format('element types' / i16) 5 format('number of atoms' / i16) -6 format('number of grains' / i16) 7 format('boundary ' / 3a1) 8 format('box bound' / 6f23.15) 9 format('box length' / 3f23.15) 10 format('box matrix') 11 format(3f23.15) 12 format('coarse-grained domain') -13 format('ie ele_type grain_ele lat_type_ele'/ 'ip ibasis x y z') -14 format('atomistic domain' / 'ia grain_atom type_atom x y z') -15 format('maximum lattice periodicity length' / 3f23.15) -16 format('Number of lattice types and atom types '/ 2i16) -17 format('lattice type IDs') -18 format('lattice types for grains') -19 format('max nodes per element' / i16) +13 format('ie basis_num ng_node esize'/ 'ip ibasis type x y z') +14 format('atomistic domain' / 'ia type_atom x y z') +19 format('max nodes per element and basis per nodes' / 2i16) 20 format('max interpo per element' / i16) 21 format('atom types to elements') open(unit=11, file=trim(adjustl(file)), action='write', status='replace',position='rewind') + !Below writes the header information for the restart file write(11,1) timestep, total_time write(11,2) ele_num - !Below writes the header information for the restart file - - - !First figure out all of the unique element types - unique_num = 0 - unique_index(:) = 0 - eleloop:do i = 1, ele_num - do j =1 , unique_num - if ( ( size_ele(i) == size_ele( unique_index(j) ) ).and. & - ( lat_ele(i) == lat_ele(unique_index(j)) ) ) then - cycle eleloop - end if - end do - unique_num = unique_num + 1 - unique_index(unique_num) = i - unique_size(unique_num) = size_ele(i) - unique_type(unique_num) = lat_ele(i) - end do eleloop - !Calculate the max number of atoms per element select case(max_ng_node) case(8) @@ -447,31 +507,19 @@ module io case default interp_max = 0 end select + write(11,20) interp_max + !Write write(11,3) node_num - write(11,19) max_ng_node - write(11,4) unique_num + write(11,19) max_ng_node, max_basisnum write(11,5) atom_num - write(11,6) 1 !Grain_num is ignored - write(11,16) lattice_types, atom_types - write(11,21) do i = 1, atom_types - write(11,*) i, type_to_name(i) + call atommass(type_to_name(i),masses(i)) end do + write(11,*) "masses: " + write(11, *) (masses(i), i = 1, atom_types) write(11,7) box_bc(1:1), box_bc(2:2), box_bc(3:3) - write(11,18) - write(11,'(2i16)') 1,1 !This is another throwaway line that is meaningless - write(11,17) - !This may have to be updated in the future but currently the only 8 node element is fcc - do i = 1, lattice_types - select case(ng_node(i)) - case(8) - write(11, *) i, 'fcc' - end select - end do - write(11,15) 1.0_dp, 1.0_dp, 1.0_dp !Another throwaway line that isn't needed write(11,8) box_bd - write(11,9) box_bd(2)-box_bd(1), box_bd(4) - box_bd(3), box_bd(6)-box_bd(5) write(11,10) !Current boxes are limited to being rectangular do i = 1,3 @@ -479,35 +527,18 @@ module io box_vec(i) = box_bd(2*i) - box_bd(2*i-1) write(11,11) box_vec end do - !We write this as box_mat ori and box_mat current - do i = 1,3 - box_vec(:) = 0.0_dp - box_vec(i) = box_bd(2*i) - box_bd(2*i-1) - write(11,11) box_vec - end do !write the element information if(ele_num > 0) then write(11,12) - - do i = 1, unique_num - write(11,'(3i16)') i, size_ele(unique_index(i))-1, basis_type(1,lat_ele(unique_index(i))) - end do ip = 0 write(11,13) do i = 1, ele_num - !Figure out the ele type - do j = 1, unique_num - if ( (unique_size(j) == size_ele(i)).and.(unique_type(j) == lat_ele(i))) then - etype = j - exit - endif - end do - write(11, '(4i16)') i, etype, 1, basis_type(1,lat_ele(i)) + write(11, '(4i16)') i, basisnum(lat_ele(i)), 2, (size_ele(i)-1) do inod = 1, ng_node(lat_ele(i)) do ibasis = 1, basisnum(lat_ele(i)) ip = ip + 1 - write(11, '(2i16, 3f23.15)') ip, ibasis, r_node(:, ibasis, inod, i) + write(11, '(3i16, 3f23.15)') ip, ibasis, basis_type(ibasis, lat_ele(i)), r_node(:, ibasis, inod, i) end do end do end do @@ -517,7 +548,7 @@ module io if(atom_num /= 0) then write(11,14) do i = 1, atom_num - write(11, '(3i16, 3f23.15)') i, 1, type_atom(i), r_atom(:,i) + write(11, '(2i16, 3f23.15)') i, type_atom(i), r_atom(:,i) end do end if @@ -803,7 +834,7 @@ module io integer :: i, inod, ibasis, j, k, l, in_eles, in_atoms, ele_types, in_lat_num, in_atom_types, & atom_type_map(100), etype_map(100), etype, lat_type, new_lattice_map(100), & atom_type, stat - real(kind=dp) :: newdisplace(3), r_in(3,1,8), r_in_atom(3) + real(kind=dp) :: newdisplace(3), r_in(3,1,8), r_in_atom(3), atomic_masses(10) character(len=100) :: textholder, in_lattype_map(10) character(len=2) :: atomic_element !First open the file @@ -817,31 +848,25 @@ module io read(11,*) textholder read(11,*) in_eles - !Discard info and read ng_max_node - do i = 1, 5 + !Discard info and read ng_max_node and max_basisnum + do i = 1, 5 read(11,*) textholder end do - read(11,*) max_ng_node - - !Read element types (only needed inside this subroutine) - read(11,*) textholder - read(11,*) ele_types + read(11,*) max_ng_node, max_basisnum !Read in atom num read(11,*) textholder read(11,*) in_atoms - !read in lattice_types and atom types - do i = 1,3 - read(11,*) textholder - end do - read(11,*) in_lat_num, in_atom_types - + !read in atom masses + read(11, *) textholder + read(11, '(a)') textholder + j = tok_count(textholder) + read(textholder, *) (atomic_masses(i), i=1, j) - !Read define atom_types by name - read(11,*) textholder + !Read define atom_types by mass do i = 1, in_atom_types - read(11,*) j, atomic_element + call atommassspecies(atomic_masses(i), atomic_element) call add_atom_type(atomic_element, atom_type_map(i)) end do @@ -849,22 +874,6 @@ module io read(11,*) textholder read(11,*) box_bc - !Disregard useless info - do i = 1, 3 - read(11,*) textholder - end do - - !Read in lat_type map - do i = 1, in_lat_num - read(11,*) j, in_lattype_map(i) - ng_node(lattice_types+i) = 8 !Only cubic elements are currently supported in pyCAC - end do - - !Disregard useless info - do i =1 , 3 - read(11,*) textholder - end do - !Read box boundaries and displace them if necessary read(11,*) temp_box_bd(:) do i = 1, 3 @@ -892,56 +901,13 @@ module io sub_box_bd(:, sub_box_num+1) = temp_box_bd !Read in more useless info - do i = 1, 10 + do i = 1, 9 read(11,*) textholder end do - !Now read the ele_type to size and lat map - do i = 1, ele_types - read(11,*) j, etype_map(i) - etype_map(i) = etype_map(i) + 1 - end do - - - !Now set up the lattice types. In this code it assumes that lattice_type 1 maps to - !atom type 1 because it only allows 1 atom per basis in pyCAC at the moment. - do i = 1, in_lat_num - basisnum(lattice_types+i) = 1 - basis_type(1,lattice_types+i) = atom_type_map(i) - end do - - !Figure out the lattice type maps in case we have repeated lattice_types - k = lattice_types + 1 - new_lattice_map(:) = 0 - new_loop:do i = 1, in_lat_num - old_loop:do j = 1, lattice_types - !First check all the lattice level variables - if ((basisnum(lattice_types+i) == basisnum(j)).and. & - (ng_node(lattice_types+i) == ng_node(j))) then - !Now check the basis level variables - do ibasis =1, basisnum(i) - if(basis_type(ibasis,lattice_types+i) /= basis_type(ibasis,j)) then - cycle old_loop - end if - end do - new_lattice_map(i) = j - cycle new_loop - end if - end do old_loop - new_lattice_map(i) = k - k = k+1 - end do new_loop - - !Read more useless data - read(11,*) textholder - - !set max values and allocate variables - max_basisnum = maxval(basisnum) - max_ng_node = maxval(ng_node) - call grow_ele_arrays(in_eles, in_atoms) - !Now start reading the elements if(in_eles > 0) then + read(11,*) textholder read(11,*) textholder do i = 1, in_eles read(11,*) j, etype, k, lat_type @@ -992,9 +958,9 @@ module io !Internal Variables integer :: i, in_eles, in_atoms, inbtypes(10), lat_type, ia, ie, inod, & - id, type_node, ilat, esize, tag, type + id, type_node, ilat, esize, tag, type, bnum, n, ibasis, ip real(kind=dp) :: newdisplace(3), ra(3), in_lapa, ea, fa(3), va(6), & - ee(1,8), fe(3,1,8), ve(3,1,8), re(3,1,8) + ee(10,8), fe(3,10,8), ve(6,10,8), re(3,10,8) character(len=100) :: textholder, fcc character(len=1000) :: line @@ -1002,7 +968,7 @@ module io open(unit=11, file=trim(adjustl(file)), action='read',position='rewind') !Now initialize some important variables if they aren't defined - if (max_basisnum==0) max_basisnum = 1 + if (max_basisnum==0) max_basisnum = 10 if (max_ng_node==0) max_ng_node=8 fcc="fcc" @@ -1010,6 +976,9 @@ module io read(11, *) textholder read(11, *) textholder + !Read the timestep + read(11, *) textholder, timestep + !Read atom number and element number and grow element arrays by needed amount read(11,*) textholder, in_atoms, textholder, in_eles call grow_ele_arrays(in_eles, in_atoms) @@ -1055,30 +1024,28 @@ module io end if if(in_eles > 0) then - !Add the lattice_types based on the atom types - inbtypes=0 - do i = 1, maxval(type_atom) - inbtypes(1) = i - call lattice_map(1, inbtypes, 8 , 1.0_dp, ilat) !Please check documentation on pycac.out formats - end do !Read element and node headers read(11,*) textholder read(11,*) textholder !read element information, currently only 8 node elements with 1 basis do ie =1, in_eles - read(11,*) tag, lat_type, textholder, textholder, esize - do inod =1, 8 - read(11,*) textholder, textholder, textholder, re(:,1,inod), ee(1,inod), fe(:,1,inod), ve(:,1,inod) + read(11,*) tag, n, bnum, esize + inbtypes(:) = 0 + do inod =1, n*bnum + read(11,*) ip, ibasis, inbtypes(ibasis), re(:,ibasis,ip), ee(ibasis,ip), fe(:,ibasis,ip), ve(:,ibasis,ip) end do + call lattice_map(bnum, inbtypes, n, 1.0_dp, lat_type) call add_element(tag, fcc, esize+1, lat_type, sub_box_num, re) call add_element_data(ele_num, ee, fe, ve) end do end if call set_max_esize return - end subroutine + end subroutine + + subroutine read_lmpcac(file, displace, temp_box_bd) !This subroutine is used to read .cac files which are used with the lammpsCAC format character(len=100), intent(in) :: file diff --git a/src/str.f90 b/src/str.f90 new file mode 100644 index 0000000..2d0ed73 --- /dev/null +++ b/src/str.f90 @@ -0,0 +1,33 @@ +module str + + !this module has some string manipulation commands + public + contains + + pure function tok_count(text) + !counts number of tokens in a string + character(len = *), intent(in) :: text + integer :: tok_count + integer :: i, j + logical :: in_tok + + j = len(trim(adjustl(text))) + in_tok = .false. + tok_count = 0 + do i = 1, j + !This checks if it is a white space character which is the delimiter + if(trim(adjustl(text(i:i))) == ' ') then + !If previously we were in token and the current character is the delimiter + !Then we are no longer in the token + if(in_tok) in_tok = .false. + + !If the character isn't a white space character and we previously weren't in the token then set in_tok + !to true and increment token count + else if(.not.in_tok) then + in_tok = .true. + tok_count = tok_count + 1 + end if + end do + return + end function tok_count +end module str From 2e7571cfa53ceaedcc1cdc91e667c0ca425ff587 Mon Sep 17 00:00:00 2001 From: Alex Selimov Date: Tue, 16 Feb 2021 09:37:25 -0500 Subject: [PATCH 60/60] Update to change style of restart and pycac.out files --- src/elements.f90 | 5 ++--- src/io.f90 | 1 + 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/elements.f90 b/src/elements.f90 index 6d71e0a..a70af56 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -405,7 +405,7 @@ module elements !Internal variables integer :: it, is, ir, ibasis, inod, ia, bnum, lat_type_temp - real(kind=dp), allocatable :: a_shape(:) + real(kind=dp) :: a_shape(max_ng_node) real(kind=dp) :: t, s, r !Initialize some variables @@ -428,7 +428,6 @@ module elements select case(trim(adjustl(type))) case('fcc','bcc') - allocate(a_shape(8)) !Now loop over all the possible sites do it = 1, esize t = (1.0_dp*(it-1)-(esize-1)/2)/(1.0_dp*(esize-1)/2) @@ -468,7 +467,7 @@ module elements subroutine rhombshape(r,s,t, shape_fun) !Shape function for rhombohedral elements real(kind=8), intent(in) :: r, s, t - real(kind=8), intent(out) :: shape_fun(8) + real(kind=8), intent(out) :: shape_fun(:) shape_fun(1) = (1.0-r)*(1.0-s)*(1.0-t)/8.0 shape_fun(2) = (1.0+r)*(1.0-s)*(1.0-t)/8.0 diff --git a/src/io.f90 b/src/io.f90 index 6ee5e64..f8dd0b4 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -241,6 +241,7 @@ module io open(unit=11, file=trim(adjustl(file)), action='write', status='replace',position='rewind') + print *, max_basisnum, max_esize !Write header information write(11,1) timestep