diff --git a/src/io.f90 b/src/io.f90 index 99f9e96..27d81f6 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -363,7 +363,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, lat_size, inod, ibasis, ip + integer :: interp_max, i, j, lat_size, inod, ibasis, ip, unique_index(10), unique_num real(kind=dp) :: box_vec(3) 1 format('time' / i16, f23.15) @@ -442,14 +442,21 @@ module io !write the element information if(ele_num > 0) then write(11,12) - do i = 1, lattice_types - do j = 1, ele_num - if (lat_ele(j) == i) then - lat_size = size_ele(j)-1 - exit + !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 - write(11,'(3i16)') i, lat_size, basis_type(1,i) + end do + unique_num = unique_num + 1 + unique_index(unique_num) = i + end do eleloop + do i = 1, unique_num + write(11,'(3i16)') i, size_ele(i)-1, basis_type(1,i) end do ip = 0 write(11,13) @@ -600,8 +607,8 @@ module io real(kind=dp), dimension(3), intent(in) :: displace real(kind = dp), dimension(6), intent(out) :: temp_box_bd - integer :: i, j, k, n, inod, ibasis, type, size, in_atoms, in_eles, new_atom_types, & - new_type_to_type(10), new_lattice_types, sbox + integer :: i, j, k, l, n, inod, ibasis, type, size, in_atoms, in_eles, new_atom_types, & + new_type_to_type(10), new_lattice_types, sbox, new_lattice_map(10) character(len=100) :: etype real(kind=dp) :: r(3), newdisplace(3) real(kind=dp), allocatable :: r_innode(:,:,:) @@ -662,9 +669,33 @@ module io do i = 1, basisnum(j) basis_type(i,j) = new_type_to_type(basis_type(i,j)) end do - end do + end do !Read the lattice parameters for every lattice type read(11,*) (lapa(i), i = lattice_types+1, lattice_types+new_lattice_types) + + !Now we loop over all new lattice types and check to see if they are exactly the same as any old lattice types + !If they are then we map the new type to the old type. + k = lattice_types + 1 + new_lattice_map(:) = 0 + new_loop:do i = 1, new_lattice_types + old_loop:do j = 1, lattice_types + !First check all the lattice level variables + if ((basisnum(i) == basisnum(j)).and. & + (ng_node(i) == ng_node(j))) then + !Now check the basis level variables + do ibasis =1, basisnum(i) + if(basis_type(ibasis,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 number of elements and atoms and allocate arrays read(11, *) in_atoms, in_eles call grow_ele_arrays(in_eles, in_atoms) @@ -678,15 +709,14 @@ module io !Read the elements do i = 1, in_eles - read(11, *) n, type, size, sbox, etype + read(11, *) l, type, size, sbox, etype do inod = 1, ng_node(type) do ibasis =1, basisnum(type) read(11,*) j, k, r_innode(:, ibasis, inod) r_innode(:,ibasis,inod) = r_innode(:, ibasis, inod) + newdisplace end do end do - type = type + lattice_types - call add_element(etype, size, type, sbox+n, r_innode) + call add_element(etype, size, new_lattice_map(type), sbox+n, r_innode) end do !Close the file being read @@ -694,7 +724,7 @@ module io !Only increment the lattice types if there are elements, if there are no elements then we !just overwrite the arrays - if(in_eles > 0) lattice_types = lattice_types + new_lattice_types + if(in_eles > 0) lattice_types = maxval(new_lattice_map) sub_box_num = sub_box_num + n