Branch data     Line data    Source code

       1                 :             : ! ***************************************************************************************************
       2                 :             : !  Copyright (C) 2020-2023 Green-X library
       3                 :             : !  This file is distributed under the terms of the APACHE2 License.
       4                 :             : !
       5                 :             : ! ***************************************************************************************************
       6                 :             : !> \brief This module contains auxiliary procedures and data structures for the main minimax routines
       7                 :             : ! ***************************************************************************************************
       8                 :             : module minimax_utils
       9                 :             : #if defined HAVE_CONFIG_H
      10                 :             : #include "config.h"
      11                 :             : #endif
      12                 :             : #include "abi_common.h"
      13                 :             : #include "gx_common.h"
      14                 :             :   use defs_basis,     only: dp
      15                 :             :   use m_errors
      16                 :             :   !use kinds, only: dp
      17                 :             :   implicit none
      18                 :             : 
      19                 :             :   private
      20                 :             : 
      21                 :             :   type, public :: er_aw_aux
      22                 :             :      ! Sorted array of the energy ranges
      23                 :             :      real(kind=dp), dimension(:), allocatable :: energy_range
      24                 :             :      ! Matrices with coefficients and weights per energy region
      25                 :             :      real(kind=dp), dimension(:, :), allocatable :: aw_erange_matrix
      26                 :             :    contains
      27                 :             :      procedure :: get_coeff_weight => coeffs_and_weights
      28                 :             :   end type er_aw_aux
      29                 :             : 
      30                 :             :   !> Transformation types
      31                 :             :   integer, parameter, public :: cosine_tw = 1
      32                 :             :   integer, parameter, public :: cosine_wt = 2
      33                 :             :   integer, parameter, public :: sine_tw = 3
      34                 :             : 
      35                 :             : contains
      36                 :             : 
      37                 :             :   !> \brief Find first element in unsorted array that is strictly greater than a given value
      38                 :             :   !>        This algorithm is O(n), difficult to do better with unsorted arrays
      39                 :             :   !! @param[in] lenght - lenght of sorted array
      40                 :             :   !! @param[in] einter - sorted array of the energy intervals
      41                 :             :   !! @param[in] eval - the energy value
      42                 :           4 :   function find_erange(length, einter, eval) result(idx)
      43                 :             :     integer, intent(in)                          :: length
      44                 :             :     real(kind=dp), dimension(length), intent(in) :: einter
      45                 :             :     real(kind=dp), intent(in)                    :: eval
      46                 :             :     integer                                      :: idx
      47                 :             : 
      48                 :             :     ! Auxiliary variables
      49                 :             :     integer                                      :: jdx
      50                 :             :     real(kind=dp)                                :: tmp_min_max
      51                 :             : 
      52                 :             :     ! Begin work
      53                 :           4 :     tmp_min_max = huge(0.0_dp)
      54                 :           4 :     idx = length + 1
      55                 :             : 
      56         [ +  + ]:         113 :     do jdx = 1, length
      57   [ +  +  +  + ]:         113 :        if (eval < einter(jdx) .and. einter(jdx) < tmp_min_max) then
      58                 :         109 :           idx = jdx
      59                 :         109 :           tmp_min_max = einter(jdx)
      60                 :             :        end if
      61                 :             :     end do
      62                 :             : 
      63                 :           4 :   end function find_erange
      64                 :             : 
      65                 :             :   !> \brief Selects the energy region and scales weights and coefficients
      66                 :             :   !! @param[in] grid_size - the grid size
      67                 :             :   !! @param[in] bup - length of the energy region array
      68                 :             :   !! @param[in] e_range - the selected energy range
      69                 :             :   !! @param[inout] e_ratio - an heuristic correction factor
      70                 :             :   !! @param[inout] ac_we - vector containing coefficients and weights
      71         [ -  + ]:           4 :   subroutine coeffs_and_weights(this, grid_size, bup, e_range, ac_we, e_ratio)
      72                 :             :     class(er_aw_aux), intent(in)               :: this
      73                 :             :     integer, intent(in)                        :: grid_size
      74                 :             :     integer, intent(in)                        :: bup
      75                 :             :     real(kind=dp), intent(in)                  :: e_range
      76                 :             :     real(kind=dp), dimension(:), intent(inout) :: ac_we
      77                 :             :     real(kind=dp), intent(inout)               :: e_ratio
      78                 :             : 
      79                 :             :     ! Internal variables
      80                 :             :     integer                                    :: ien
      81                 :             : 
      82                 :             :     ! Select energy region
      83                 :           4 :     ien = find_erange(bup, this%energy_range, e_range)
      84                 :             : 
      85                 :             :     ! Scale grids for large sizes when erange falls in the first energy range
      86   [ +  +  -  + ]:           4 :     if (ien == 1 .and. grid_size > 20) then
      87                 :           0 :        e_ratio = this%energy_range(1) / e_range
      88         [ #  # ]:           0 :        if (e_ratio > 1.5_dp) then
      89                 :           0 :           e_ratio = e_ratio / 1.5_dp
      90                 :             :        endif
      91                 :             :     end if
      92                 :             : 
      93         [ +  + ]:         124 :     ac_we(:) = this%aw_erange_matrix(:, ien)
      94                 :             : 
      95                 :           4 :   end subroutine coeffs_and_weights
      96                 :             : 
      97   [ #  #  #  #  :           0 : end module minimax_utils
          #  #  #  #  #  
             #  #  #  #  
                      # ]