isdf_utils.F90

Go to the documentation of this file.

!! Copyright (C) 2025. Alexander Buccheri
!!
!! 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 2, 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, write to the Free Software
!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
!! 02110-1301, U
 
#include "global.h"
 
module isdf_utils_oct_m
  use, intrinsic :: iso_fortran_env, only: real64
  use debug_oct_m
  use global_oct_m
  use messages_oct_m
  use mpi_oct_m,            only: mpi_world
  use namespace_oct_m
  use profiling_oct_m
  use smear_oct_m,          only: smear_semiconductor
  use states_elec_oct_m
  implicit none
 
  private
  public :: &
    output_matrix, &
    highest_occupied_index
 
contains
 
  subroutine output_matrix(namespace, fname, matrix)
    type(namespace_t),        intent(in) :: namespace
    character(len=*),         intent(in) :: fname
    real(real64), contiguous, intent(in) :: matrix(:, :)
 
    integer :: i, j, unit
 
    push_sub(output_matrix)
 
    write(message(1),'(a)') "ISDF. Outputting:  " // trim(adjustl(fname))
    call messages_info(1, namespace=namespace, debug_only=.true.)
 
    if (mpi_world%is_root()) then
 
      open(newunit=unit, file=trim(adjustl(fname)))
      do j = 1, size(matrix, 2)
        do i = 1, size(matrix, 1)
          write(unit, *) matrix(i, j)
        enddo
      enddo
      close(unit)
 
    endif
 
    pop_sub(output_matrix)
 
  end subroutine output_matrix
 
  function highest_occupied_index(st, ik_index) result(i_max_occ)
    type(states_elec_t),    intent(in) :: st
    integer,                intent(in) :: ik_index
    integer                            :: i_max_occ
 
    integer                            :: ist
 
    push_sub(highest_occupied_index)
 
    if (st%smear%method /= smear_semiconductor) then
      i_max_occ = st%nst
    endif
 
    i_max_occ = 0
    do ist = 1, st%nst
      if (abs(st%occ(ist, ik_index)) < m_min_occ) exit
      i_max_occ = ist
    enddo
    assert(i_max_occ > 0)
 
    pop_sub(highest_occupied_index)
 
  end function highest_occupied_index
 
end module isdf_utils_oct_m
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: