kmesh_shell_from_file Subroutine

private subroutine kmesh_shell_from_file(kmesh_input, print_output, bvec_inp, bweight, dnn, kpt_cart, recip_lattice, lmn, multi, num_kpts, seedname, stdout, timer, error, comm)

Uses

  • proc~~kmesh_shell_from_file~~UsesGraph proc~kmesh_shell_from_file kmesh_shell_from_file module~w90_constants w90_constants proc~kmesh_shell_from_file->module~w90_constants module~w90_io w90_io proc~kmesh_shell_from_file->module~w90_io module~w90_types w90_types proc~kmesh_shell_from_file->module~w90_types module~w90_io->module~w90_constants module~w90_types->module~w90_constants

Find the B1 weights for a set of b-vectors given in a file. This routine is activated via kmesh_shell_from_file = T It is not intended for regular use.

Arguments

Type IntentOptional Attributes Name
type(kmesh_input_type), intent(inout) :: kmesh_input
type(print_output_type), intent(in) :: print_output
real(kind=dp), intent(inout), allocatable :: bvec_inp(:,:,:)
real(kind=dp), intent(out) :: bweight(max_shells)
real(kind=dp), intent(in) :: dnn(kmesh_input%search_shells)
real(kind=dp), intent(in) :: kpt_cart(:,:)
real(kind=dp), intent(in) :: recip_lattice(3,3)
integer, intent(in) :: lmn(:,:)
integer, intent(inout) :: multi(kmesh_input%search_shells)
integer, intent(in) :: num_kpts
character(len=50), intent(in) :: seedname
integer, intent(in) :: stdout
type(timer_list_type), intent(inout) :: timer
type(w90_error_type), intent(out), allocatable :: error
type(w90_comm_type), intent(in) :: comm

Calls

proc~~kmesh_shell_from_file~~CallsGraph proc~kmesh_shell_from_file kmesh_shell_from_file dgesvd dgesvd proc~kmesh_shell_from_file->dgesvd proc~io_stopwatch_start io_stopwatch_start proc~kmesh_shell_from_file->proc~io_stopwatch_start proc~io_stopwatch_stop io_stopwatch_stop proc~kmesh_shell_from_file->proc~io_stopwatch_stop proc~kmesh_get_bvectors kmesh_get_bvectors proc~kmesh_shell_from_file->proc~kmesh_get_bvectors proc~set_error_alloc set_error_alloc proc~kmesh_shell_from_file->proc~set_error_alloc proc~set_error_fatal set_error_fatal proc~kmesh_shell_from_file->proc~set_error_fatal proc~set_error_file set_error_file proc~kmesh_shell_from_file->proc~set_error_file proc~set_error_input set_error_input proc~kmesh_shell_from_file->proc~set_error_input proc~kmesh_get_bvectors->proc~io_stopwatch_start proc~kmesh_get_bvectors->proc~io_stopwatch_stop proc~kmesh_get_bvectors->proc~set_error_fatal proc~comms_sync_error comms_sync_error proc~set_error_alloc->proc~comms_sync_error proc~set_base_error set_base_error proc~set_error_alloc->proc~set_base_error proc~set_error_fatal->proc~comms_sync_error proc~set_error_fatal->proc~set_base_error proc~set_error_file->proc~comms_sync_error proc~set_error_file->proc~set_base_error proc~set_error_input->proc~comms_sync_error proc~set_error_input->proc~set_base_error

Called by

proc~~kmesh_shell_from_file~~CalledByGraph proc~kmesh_shell_from_file kmesh_shell_from_file proc~kmesh_get kmesh_get proc~kmesh_get->proc~kmesh_shell_from_file proc~w90_create_kmesh w90_create_kmesh proc~w90_create_kmesh->proc~kmesh_get program~postw90 postw90 program~postw90->proc~kmesh_get proc~w90_get_gkpb~2 w90_get_gkpb proc~w90_get_gkpb~2->proc~w90_create_kmesh proc~w90_get_nnkp~2 w90_get_nnkp proc~w90_get_nnkp~2->proc~w90_create_kmesh proc~w90_get_nn~2 w90_get_nn proc~w90_get_nn~2->proc~w90_create_kmesh proc~write_kmesh write_kmesh proc~write_kmesh->proc~w90_create_kmesh proc~w90_get_gkpb w90_get_gkpb proc~w90_get_gkpb->proc~w90_get_gkpb~2 proc~w90_get_nn w90_get_nn proc~w90_get_nn->proc~w90_get_nn~2 proc~w90_get_nnkp w90_get_nnkp proc~w90_get_nnkp->proc~w90_get_nnkp~2 program~wannier wannier program~wannier->proc~w90_get_nn~2 program~wannier->proc~write_kmesh

Source Code

  subroutine kmesh_shell_from_file(kmesh_input, print_output, bvec_inp, bweight, dnn, kpt_cart, &
                                   recip_lattice, lmn, multi, num_kpts, seedname, stdout, timer, &
                                   error, comm)
    !================================================
    !!  Find the B1 weights for a set of b-vectors given in a file.
    !!  This routine is activated via kmesh_shell_from_file = T
    !!  It is not intended for regular use.
    !
    !================================================

    use w90_constants, only: eps7, maxlen
    use w90_io, only: io_stopwatch_start, io_stopwatch_stop
    use w90_types, only: kmesh_input_type, print_output_type, timer_list_type

    implicit none

    ! arguments
    type(print_output_type), intent(in) :: print_output
    type(kmesh_input_type), intent(inout) :: kmesh_input
    type(timer_list_type), intent(inout) :: timer
    type(w90_error_type), allocatable, intent(out) :: error
    type(w90_comm_type), intent(in) :: comm

    integer, intent(in) :: num_kpts, stdout
    integer, intent(in) :: lmn(:, :)
    integer, intent(inout) :: multi(kmesh_input%search_shells)   ! the number of kpoints in the shell

    real(kind=dp), intent(in) :: recip_lattice(3, 3)
    real(kind=dp), intent(in) ::kpt_cart(:, :)
    real(kind=dp), allocatable, intent(inout) :: bvec_inp(:, :, :)
    real(kind=dp), intent(in) :: dnn(kmesh_input%search_shells)  ! the bvectors
    real(kind=dp), intent(out) :: bweight(max_shells)

    character(len=50), intent(in)  :: seedname

    ! local variables
    real(kind=dp), allocatable :: bvector(:, :)

    real(kind=dp), dimension(:), allocatable :: singv
    real(kind=dp), dimension(:, :), allocatable :: amat, umat, vmat, smat

    integer, parameter :: lwork = max_shells*10
    real(kind=dp) :: work(lwork)
    integer       :: bvec_list(num_nnmax, max_shells)
    real(kind=dp), parameter :: target(6) = (/1.0_dp, 1.0_dp, 1.0_dp, 0.0_dp, 0.0_dp, 0.0_dp/)
    integer :: ierr, loop_b, loop_s, info

    integer :: loop, shell, pos, kshell_in, counter, length, i, loop2, num_lines, tot_num_lines
    character(len=maxlen) :: dummy, dummy2

    if (print_output%timing_level > 1) call io_stopwatch_start('kmesh: shell_from_file', timer)

    allocate (bvector(3, sum(multi)), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error allocating bvector in kmesh_shell_from_file', comm)
      return
    end if
    bvector = 0.0_dp; bweight = 0.0_dp

    if (print_output%iprint > 0) then
      write (stdout, '(1x,a)') '| The b-vectors are defined in the kshell file                               |'
    end if

    counter = 1
    do shell = 1, kmesh_input%search_shells
      ! get the b vectors
      call kmesh_get_bvectors(kmesh_input, print_output, bvector(:, counter:counter + multi(shell) - 1), &
                              kpt_cart, recip_lattice, dnn(shell), lmn, 1, multi(shell), num_kpts, &
                              timer, error, comm)
      if (allocated(error)) return

      counter = counter + multi(shell)
    end do

    open (newunit=kshell_in, file=trim(seedname)//'.kshell', form='formatted', status='old', &
          action='read', iostat=ierr)
    if (ierr /= 0) then
      call set_error_file(error, 'Error: Problem (1) opening input file '//trim(seedname)//'.kshell', comm)
      return
    end if

    num_lines = 0; tot_num_lines = 0
    do
      read (kshell_in, '(a)', iostat=ierr) dummy
      if (ierr == 0) then !read ok, proceed
        dummy = adjustl(dummy)
        tot_num_lines = tot_num_lines + 1
        if (.not. dummy(1:1) == '!' .and. .not. dummy(1:1) == '#') then
          if (len(trim(dummy)) > 0) num_lines = num_lines + 1
        end if
      else if (ierr > 0) then !error case
        call set_error_input(error, 'Error: Problem (2) reading input file '//trim(seedname)//'.kshell', comm)
        return
      else if (ierr < 0) then !end of record or end of file
        exit
      end if
    end do

    rewind (kshell_in)
    kmesh_input%num_shells = num_lines

    multi(:) = 0
    bvec_list = 1
    counter = 0
    do loop = 1, tot_num_lines
      read (kshell_in, '(a)', err=103, end=103) dummy2
      dummy2 = adjustl(dummy2)
      if (dummy2(1:1) == '!' .or. dummy2(1:1) == '#' .or. (len(trim(dummy2)) == 0)) cycle
      counter = counter + 1
      kmesh_input%shell_list(counter) = counter
      dummy = dummy2
      length = 1
      dummy = adjustl(dummy)
      do
        pos = index(dummy, ' ')
        dummy = dummy(pos + 1:)
        dummy = adjustl(dummy)
        if (len_trim(dummy) > 0) then
          length = length + 1
        else
          exit
        end if

      end do
      multi(counter) = length
      read (dummy2, *, err=230, end=230) (bvec_list(i, loop), i=1, length)
    end do

    allocate (bvec_inp(3, maxval(multi), kmesh_input%num_shells), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error allocating bvec_inp in kmesh_shell_from_file', comm)
      return
    end if

    bvec_inp = 0.0_dp
    do loop = 1, kmesh_input%num_shells
      do loop2 = 1, multi(loop)
        bvec_inp(:, loop2, loop) = bvector(:, bvec_list(loop2, loop))
      end do
    end do

    if (print_output%iprint >= 3) then
      do shell = 1, kmesh_input%num_shells
        write (stdout, '(1x,a8,1x,I2,a14,1x,I2,49x,a)') '| Shell:', shell, ' Multiplicity:', multi(shell), '|'
        do loop = 1, multi(shell)
          write (stdout, '(1x,a10,I2,1x,a1,4x,3f12.6,5x,a9,9x,a)') '| b-vector ', loop, ':', &
            bvec_inp(:, loop, shell)/print_output%lenconfac, '('//trim(print_output%length_unit)//'^-1)', '|'
        end do
      end do
    end if

    allocate (amat(max_shells, kmesh_input%num_shells), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error allocating amat in kmesh_shell_from_file', comm)
      return
    end if
    allocate (umat(max_shells, max_shells), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error allocating umat in kmesh_shell_from_file', comm)
      return
    end if
    allocate (vmat(kmesh_input%num_shells, kmesh_input%num_shells), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error allocating vmat in kmesh_shell_from_file', comm)
      return
    end if
    allocate (smat(kmesh_input%num_shells, max_shells), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error allocating smat in kmesh_shell_from_file', comm)
      return
    end if
    allocate (singv(kmesh_input%num_shells), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error allocating singv in kmesh_shell_from_file', comm)
      return
    end if
    amat = 0.0_dp; umat = 0.0_dp; vmat = 0.0_dp; smat = 0.0_dp; singv = 0.0_dp

    do loop_s = 1, kmesh_input%num_shells
      do loop_b = 1, multi(loop_s)
        amat(1, loop_s) = amat(1, loop_s) + bvec_inp(1, loop_b, loop_s)*bvec_inp(1, loop_b, loop_s)
        amat(2, loop_s) = amat(2, loop_s) + bvec_inp(2, loop_b, loop_s)*bvec_inp(2, loop_b, loop_s)
        amat(3, loop_s) = amat(3, loop_s) + bvec_inp(3, loop_b, loop_s)*bvec_inp(3, loop_b, loop_s)
        amat(4, loop_s) = amat(4, loop_s) + bvec_inp(1, loop_b, loop_s)*bvec_inp(2, loop_b, loop_s)
        amat(5, loop_s) = amat(5, loop_s) + bvec_inp(2, loop_b, loop_s)*bvec_inp(3, loop_b, loop_s)
        amat(6, loop_s) = amat(6, loop_s) + bvec_inp(3, loop_b, loop_s)*bvec_inp(1, loop_b, loop_s)
      end do
    end do

    info = 0
    call dgesvd('A', 'A', max_shells, kmesh_input%num_shells, amat, max_shells, singv, umat, &
                max_shells, vmat, kmesh_input%num_shells, work, lwork, info)
    if (info < 0) then
      if (print_output%iprint > 0) then
        write (stdout, '(1x,a,1x,I1,1x,a)') 'kmesh_shell_fixed: Argument', abs(info), &
          'of dgesvd is incorrect'
      end if
      call set_error_fatal(error, 'kmesh_shell_from_file: Problem with Singular Value Decomposition', comm)
      return
    else if (info > 0) then
      call set_error_fatal(error, 'kmesh_shell_from_file: Singular Value Decomposition did not converge', comm)
      return
    end if

    if (any(abs(singv) < eps7)) then
      call set_error_fatal(error, 'kmesh_shell_from_file: Singular Value Decomposition has found a very small singular value', comm)
      return
    end if

    smat = 0.0_dp
    do loop_s = 1, kmesh_input%num_shells
      smat(loop_s, loop_s) = 1/singv(loop_s)
    end do

    bweight(1:kmesh_input%num_shells) = matmul(transpose(vmat), matmul(smat, matmul(transpose(umat), target)))
    if (print_output%iprint >= 2) then
      do loop_s = 1, kmesh_input%num_shells
        write (stdout, '(1x,a,I2,a,f12.7,5x,a8,36x,a)') '| Shell: ', loop_s, &
          ' w_b ', bweight(loop_s)*print_output%lenconfac**2, '('//trim(print_output%length_unit)//'^2)', '|'
      end do
    end if

    ! note: B1 condition is not tested here; test follows this function call

    if (print_output%timing_level > 1) call io_stopwatch_stop('kmesh: shell_from_file', timer)
    return

103 call set_error_input(error, 'Error: Problem (3) reading input file '//trim(seedname)//'.kshell', comm)
    return
230 call set_error_input(error, 'Error: Problem reading in kmesh_shell_from_file', comm)
    return

  end subroutine kmesh_shell_from_file