CACmb/src/opt_group.f90

module opt_group

    !This module contains all code associated with dislocations

    use parameters
    use elements
    use subroutines
    use box 
    implicit none

    integer :: group_ele_num, group_atom_num, remesh_size
    character(len=15) :: type, shape !Type indicates what element type is selected and shape is the group shape
    real(kind=dp) :: block_bd(6), disp_vec(3)
    logical :: displace

    integer, allocatable :: element_index(:), atom_index(:) 

    public 
    contains

    subroutine group(arg_pos)
        !Main calling function for the group option
        integer, intent(inout) :: arg_pos

        print *, '-----------------------Option Group-------------------------'

        group_ele_num = 0
        group_atom_num = 0
        remesh_size=0
        if(allocated(element_index)) deallocate(element_index)
        if(allocated(atom_index)) deallocate(atom_index)

        call parse_group(arg_pos)

        call get_group

        !Now call the transformation functions for the group
        if(displace) call displace_group

        if(remesh_size > 0) call remesh_group
    end subroutine group

    subroutine parse_group(arg_pos)
        !Parse the group command
        integer, intent(inout) :: arg_pos

        integer :: i,arglen
        character(len=100) :: textholder

        !Parse type and shape command
        arg_pos = arg_pos + 1
        call get_command_argument(arg_pos, type, arglen)
        if (arglen==0) STOP "Missing select_type in group command"
        select case(trim(adjustl(type)))
        case('atoms', 'elements', 'both')
            continue
        case default
            print *, "Select_type ", trim(adjustl(type)), " is not an accept group selection criteria. ", &
                     "Please select from atoms, nodes, or both."
        end select

        arg_pos = arg_pos + 1
        call get_command_argument(arg_pos, shape, arglen)
        if (arglen==0) STOP "Missing group_shape in group command"

        !Now parse the arguments required by the user selected shape
        select case(trim(adjustl(shape)))
        case('block')
            do i= 1, 6
                arg_pos  = arg_pos + 1
                call get_command_argument(arg_pos, textholder, arglen)
                if (arglen==0) STOP "Missing block boundary in dislgen command"
                call parse_pos(int((i+1)/2), textholder, block_bd(i))   
            end do 

        case default
            print *, "Group shape ", trim(adjustl(shape)), " is not currently accepted. Please check documentation ", &
                     "for accepted group shapes."
        end select

        !Now parse the additional options which may be present
        do while(.true.)
            if(arg_pos > command_argument_count()) exit
            !Pull out the next argument which should either be a keyword or an option
            arg_pos=arg_pos+1
            call get_command_argument(arg_pos, textholder)
            textholder=adjustl(textholder)

            !Choose what to based on what the option string is 
            select case(trim(textholder))
            case('displace')
                displace = .true.
                do i = 1,3 
                    arg_pos = arg_pos + 1
                    call get_command_argument(arg_pos, textholder, arglen)
                    if (arglen==0) stop "Missing vector component for shift command"
                    read(textholder, *) disp_vec(i)
                end do
            case('remesh')
                arg_pos = arg_pos + 1
                call get_command_argument(arg_pos, textholder, arglen)
                if (arglen==0) stop "Missing remesh element size in group command"
                read(textholder, *) remesh_size
            case default
                !If it isn't an available option to opt_disl then we just exit
                exit 
            end select
        end do
    end subroutine parse_group

    subroutine get_group
        !This subroutine finds all elements and/or atoms within the group boundaries
        !specified by the user.
        integer :: i, inod, ibasis
        integer, allocatable :: resize_array(:) 
        real(kind=dp) :: r_center(3)

        select case(trim(adjustl(shape)))
        case('block')

            print *, "Group has block shape with boundaries: ", block_bd

            !Allocate variables to arbitrary size
            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)))
            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)))
                        end do
                    end do

                    if (in_block_bd(r_center, block_bd)) 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 
            end select

            !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
                    if(in_block_bd(r_atom(:,i),block_bd)) then 
                        group_atom_num = group_atom_num + 1
                        if (group_atom_num > size(atom_index)) then 
                            allocate(resize_array(size(atom_index) + 1024))
                            resize_array(1:group_atom_num -1) = atom_index
                            resize_array(group_atom_num:) = 0
                            call move_alloc(resize_array, atom_index)
                        end if

                        atom_index(group_atom_num) = i
                    end if
                end do
            end select
        end select 

        print *, 'Group contains ', group_ele_num, " elements and ", group_atom_num, " atoms."
    end subroutine get_group 

    subroutine displace_group
        !This subroutine applies a displacement to elements/atoms in the groups

        integer :: i, inod, ibasis

        print *, "Elements/atoms in group displaced by ", disp_vec

        !Displace atoms
        do i = 1, group_atom_num
            r_atom(:,atom_index(i)) = r_atom(:,atom_index(i)) + disp_vec
        end do  

        !Displace elements
        do i = 1, group_ele_num
            do inod = 1, ng_node(lat_ele(element_index(i)))
                do ibasis = 1, basisnum(lat_ele(element_index(i)))
                    r_node(:,ibasis,inod,element_index(i)) = r_node(:,ibasis,inod,element_index(i)) + disp_vec
                end do 
            end do 
        end do

        !If we don't include the wrap command then we have to increase the size of the box
        if (.not.(wrap_flag)) then 
            do i = 1,3
                if (disp_vec(i) < -lim_zero) then 
                    box_bd(2*i-1) = box_bd(2*i-1) - disp_vec(i)
                else if (disp_vec(i) > lim_zero) then 
                    box_bd(2*i) = box_bd(2*i) + disp_vec(i)
                end if
            end do
        end if

    end subroutine displace_group

    subroutine remesh_group
        !This command is used to remesh the group to a desired element size

        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)

        !Refining to atoms and remeshing to elements are different processes so check which code we need to run
        select case(remesh_size)

        !Refining to atoms
        case(2)
            if(group_ele_num > 0) then 
                orig_atom_num = atom_num
                !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)
                    !Get the interpolated atom positions
                    call interpolate_atoms(type_ele(ie), size_ele(ie), lat_ele(ie), r_node(:,:,:,ie), type_interp, r_interp)

                    !Loop over all interpolated atoms and add them to the system, we apply periodic boundaries 
                    !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), r_interp(:,j))
                    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."

            end if                
        !Remeshing to elements, currently not available
        case default
            print *, "Remeshing to elements is currently not available. Please refine to atoms by passing a remsh size of 2"
        end select

        
    end subroutine remesh_group
end module opt_group