LCOV - code coverage report
Current view: top level - src/79_seqpar_mpi - m_chebfiwf.F90 (source / functions) Coverage Total Hit
Test: coverage.info Lines: 87.9 % 99 87
Test Date: 2026-09-19 17:42:43 Functions: 100.0 % 3 3

            Line data    Source code
       1              : !!****f* ABINIT/m_chebfiwf
       2              : !! NAME
       3              : !! m_chebfiwf
       4              : !!
       5              : !! FUNCTION
       6              : !! This module contains a routine updating the whole wave functions at a given k-point,
       7              : !! using the Chebyshev filtering method (2021 implementation using xG abstraction layer)
       8              : !! for a given spin-polarization, from a fixed hamiltonian
       9              : !! but might also simply compute eigenvectors and eigenvalues at this k point.
      10              : !! it will also update the matrix elements of the hamiltonian.
      11              : !!
      12              : !! COPYRIGHT
      13              : !! Copyright (C) 2018-2026 ABINIT group (BS, IML)
      14              : !! This file is distributed under the terms of the
      15              : !! gnu general public license, see ~abinit/COPYING
      16              : !! or http://www.gnu.org/copyleft/gpl.txt .
      17              : !! for the initials of contributors, see ~abinit/doc/developers/contributors.txt .
      18              : !!
      19              : !! SOURCE
      20              : 
      21              : #if defined HAVE_CONFIG_H
      22              : #include "config.h"
      23              : #endif
      24              : 
      25              : #include "abi_common.h"
      26              : 
      27              : ! nvtx related macro definition
      28              : #include "nvtx_macros.h"
      29              : 
      30              : module m_chebfiwf
      31              : 
      32              :  use defs_abitypes
      33              :  use defs_basis
      34              :  use m_abicore
      35              :  use m_errors
      36              :  use m_fstrings
      37              :  use m_time
      38              : 
      39              :  use m_chebfi
      40              :  use m_chebfi2
      41              :  use m_invovl
      42              : 
      43              :  use m_cgtools,     only : dotprod_g
      44              :  use m_dtset,       only : dataset_type
      45              : 
      46              :  use m_hamiltonian, only : gs_hamiltonian_type
      47              :  use m_pawcprj,     only : pawcprj_type
      48              :  use m_nonlop,      only : nonlop
      49              :  use m_prep_kgb,    only : prep_getghc, prep_nonlop
      50              :  use m_pawcprj,     only : pawcprj_type, pawcprj_alloc, pawcprj_free
      51              :  use m_getghc,      only : multithreaded_getghc
      52              :  use m_gemm_nonlop_projectors , only : gemm_nonlop_use_gemm
      53              : 
      54              :  use m_xg
      55              :  use m_xgTransposer
      56              : 
      57              : #if defined(HAVE_GPU_MARKERS)
      58              :  use m_nvtx_data
      59              : #endif
      60              : 
      61              : #if defined(HAVE_GPU)
      62              :  use m_gpu_toolbox
      63              : #endif
      64              : 
      65              : #if defined(HAVE_YAKL)
      66              :  use gator_mod
      67              : #endif
      68              : 
      69              :  use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_double,c_size_t
      70              : 
      71              :  use m_xmpi
      72              :  use m_xomp
      73              : #ifdef HAVE_OPENMP
      74              :  use omp_lib
      75              : #endif
      76              : 
      77              :  implicit none
      78              : 
      79              :  private
      80              : 
      81              :  integer, parameter :: l_tim_getghc=7
      82              :  real(dp), parameter :: inv_sqrt2 = 1/sqrt2
      83              : 
      84              : ! For use in getghc_gsc1
      85              :  integer, save :: l_cpopt
      86              :  integer, save :: l_icplx
      87              :  integer, save :: l_nspinor
      88              :  logical, save :: l_paw
      89              :  integer, save :: l_prtvol
      90              :  integer, save :: l_sij_opt
      91              :  integer, save :: l_paral_kgb
      92              :  integer, save :: l_useria
      93              :  integer, save :: l_block_sliced
      94              : 
      95              :  type(mpi_type),pointer,save :: l_mpi_enreg
      96              :  type(gs_hamiltonian_type),pointer,save :: l_gs_hamk
      97              : 
      98              :  integer, parameter :: DEBUG_ROWS = 5
      99              :  integer, parameter :: DEBUG_COLUMNS = 5
     100              : 
     101              :  public :: chebfiwf2
     102              : 
     103              :  CONTAINS  !========================================================================================
     104              : !!***
     105              : 
     106              : !!****f* m_chebfiwf/chebfiwf2
     107              : !! NAME
     108              : !! chebfiwf2
     109              : !!
     110              : !! FUNCTION
     111              : !! This routine updates the whole wave functions set at a given k-point,
     112              : !! using the Chebfi method (2021 version using xG abstraction layer)
     113              : !!
     114              : !! INPUTS
     115              : !!  dtset= input variables for this dataset
     116              : !!  mpi_enreg= MPI-parallelisation information
     117              : !!  nband= number of bands at this k point
     118              : !!  npw= number of plane waves at this k point
     119              : !!  nspinor= number of spinorial components of the wavefunctions
     120              : !!  prtvol= control print volume and debugging
     121              : !!
     122              : !! OUTPUT
     123              : !!  eig(nband)= eigenvalues (hartree) for all bands
     124              : !!  enl_out(nband)= contribution of each band to the nl part of energy
     125              : !!  resid(nband)= residuals for each band
     126              : !!
     127              : !! SIDE EFFECTS
     128              : !!  cg(2,npw*nspinor*nband)= planewave coefficients of wavefunctions
     129              : !!  gs_hamk <type(gs_hamiltonian_type)>=all data for the hamiltonian at k
     130              : !!
     131              : !! SOURCE
     132              : 
     133         9024 : subroutine chebfiwf2(cg,dtset,eig,occ,enl_out,gs_hamk,mpi_enreg,&
     134         9024 : &                    nband,npw,nspinor,prtvol,resid)
     135              : 
     136              :  implicit none
     137              : 
     138              :  ! Arguments ------------------------------------
     139              :  integer,intent(in) :: nband,npw,prtvol,nspinor
     140              :  type(mpi_type),target,intent(in) :: mpi_enreg
     141              :  real(dp),target,intent(inout) :: cg(2,npw*nspinor*nband)
     142              :  real(dp),target,intent(out) :: resid(nband)
     143              :  real(dp),intent(out) :: enl_out(nband)
     144              :  real(dp),target,intent(out) :: eig(nband)
     145              :  real(dp),target,intent(in) :: occ(nband)
     146              :  type(dataset_type),intent(in) :: dtset
     147              :  type(gs_hamiltonian_type),target,intent(inout) :: gs_hamk
     148              : 
     149              :  ! Local variables-------------------------------
     150              :  ! scalars
     151              :  integer, parameter :: tim_chebfiwf2 = 1750
     152              :  integer, parameter :: tim_nonlop = 1753
     153              :  integer :: iband,shift,space,blockdim,total_spacedim,ierr
     154              :  integer :: me_g0,me_g0_fft
     155              :  logical :: transfer_cg
     156              :  integer(kind=c_size_t) :: localMem
     157         9024 :  type(chebfi_t) :: chebfi
     158              :  type(xgBlock_t) :: xgx0,xgeigen,xgocc,xgresidu
     159              :  ! arrays
     160              :  real(dp) :: tsec(2)
     161              :  integer(kind=c_size_t) :: chebfiMem(2)
     162         9024 :  real(dp), allocatable :: gvnlxc(:,:),occ_tmp(:)
     163              : 
     164              :  ! Parameters for nonlop call in NC
     165              :  integer,parameter :: choice=1, paw_opt=0, signs=1
     166              :  real(dp) :: gsc_dummy(1,1)
     167       126976 :  type(pawcprj_type) :: cprj_dum(gs_hamk%natom,1)
     168              : 
     169              : ! *********************************************************************
     170              : 
     171              : !################ INITIALIZATION  #####################################
     172              : !######################################################################
     173              : 
     174         9024 :   call timab(tim_chebfiwf2,1,tsec)
     175              : 
     176              : !Set module variables
     177         9024 :  l_paw = (gs_hamk%usepaw==1)
     178         9024 :  l_cpopt=-1;l_sij_opt=0;if (l_paw) l_sij_opt=1
     179         9024 :  l_nspinor = nspinor
     180         9024 :  l_prtvol = prtvol
     181         9024 :  l_mpi_enreg => mpi_enreg
     182         9024 :  l_gs_hamk => gs_hamk
     183         9024 :  l_paral_kgb = dtset%paral_kgb
     184         9024 :  l_block_sliced = dtset%invovl_blksliced
     185              : 
     186              : !Variables
     187         9024 :  blockdim=l_mpi_enreg%nproc_band*l_mpi_enreg%bandpp
     188              :  !for debug
     189         9024 :  l_useria=dtset%useria
     190              : 
     191              : !Depends on istwfk
     192         9024 :  if ( gs_hamk%istwf_k > 1 ) then ! Real only
     193              :    ! SPACE_CR mean that we have complex numbers but no re*im terms only re*re
     194              :    ! and im*im so that a vector of complex is consider as a long vector of real
     195              :    ! therefore the number of data is (2*npw*nspinor)*nband
     196              :    ! This space is completely equivalent to SPACE_R but will correctly set and
     197              :    ! get the array data into the xgBlock
     198         3536 :    space = SPACE_CR
     199         3536 :    l_icplx = 2
     200              :  else ! complex
     201         5488 :    space = SPACE_C
     202         5488 :    l_icplx = 1
     203              :  end if
     204              : 
     205         9024 :  me_g0 = -1
     206         9024 :  me_g0_fft = -1
     207         9024 :  if (space==SPACE_CR) then
     208         3536 :    me_g0 = 0
     209         3536 :    me_g0_fft = 0
     210         3536 :    if (gs_hamk%istwf_k == 2) then
     211          442 :      if (l_mpi_enreg%me_g0 == 1) me_g0 = 1
     212          442 :      if (l_mpi_enreg%me_g0_fft == 1) me_g0_fft = 1
     213              :    end if
     214              :  end if
     215              : 
     216              : !Memory info
     217         9024 :  if ( prtvol >= 3 ) then
     218            0 :    if (l_mpi_enreg%paral_kgb == 1) then
     219            0 :      total_spacedim = l_icplx*npw*nspinor
     220            0 :      call xmpi_sum(total_spacedim,l_mpi_enreg%comm_bandspinorfft,ierr)
     221              :    else
     222            0 :      total_spacedim = 0
     223              :    end if
     224              :    chebfiMem = chebfi_memInfo(nband,l_icplx*npw*nspinor,space,l_mpi_enreg%paral_kgb, &
     225            0 : &                             total_spacedim,l_mpi_enreg%bandpp) !blockdim
     226            0 :    localMem = (int(2,c_size_t)*npw*nspinor*nband+3*nband)*kind(1.d0) !blockdim
     227            0 :    write(std_out,'(1x,A,F10.6,1x,A)') "Each MPI process calling chebfi should need around ", &
     228            0 :    (localMem+sum(chebfiMem))/1e9,"GB of peak memory as follows :"
     229            0 :    write(std_out,'(4x,A,F10.6,1x,A)') "Permanent memory in chebfiwf : ",real(localMem)/1e9,"GB"
     230            0 :    write(std_out,'(4x,A,F10.6,1x,A)') "Permanent memory in m_chebfi : ",real(chebfiMem(1))/1e9,"GB"
     231            0 :    write(std_out,'(4x,A,F10.6,1x,A)') "Temporary memory in m_chebfi : ",real(chebfiMem(2))/1e9,"GB"
     232              :  end if
     233              : 
     234         9024 :  transfer_cg = .false.
     235              : #ifdef HAVE_OPENMP_OFFLOAD
     236              :  !$OMP TARGET ENTER DATA MAP(to:eig,resid,occ) IF(gs_hamk%gpu_option==ABI_GPU_OPENMP)
     237              :  transfer_cg = .not. xomp_target_is_present(c_loc(cg))
     238              :  !$OMP TARGET ENTER DATA MAP(to:cg) IF(gs_hamk%gpu_option==ABI_GPU_OPENMP .and. transfer_cg)
     239              : #endif
     240              : 
     241              :  call xgBlock_map(xgx0,cg,space,npw*nspinor,nband,comm=l_mpi_enreg%comm_bandspinorfft,me_g0=me_g0,&
     242         9024 :    & gpu_option=dtset%gpu_option)
     243              : 
     244         9024 :  call xgBlock_map_1d(xgeigen,eig,SPACE_R,nband,gpu_option=dtset%gpu_option)
     245              : 
     246         9024 :  call xgBlock_map_1d(xgresidu,resid,SPACE_R,nband,gpu_option=dtset%gpu_option)
     247              : 
     248              :  ! Occupancies in chebyshev are used for convergence criteria only
     249         9024 :  if (dtset%nbdbuf==-101.and.nspinor==1.and.dtset%nsppol==1) then
     250         2448 :    ABI_MALLOC(occ_tmp,(nband))
     251         7344 :    occ_tmp(:) = half*occ(:)
     252          816 :    call xgBlock_map_1d(xgocc,occ_tmp,SPACE_R,nband,gpu_option=dtset%gpu_option)
     253              :  else
     254         8208 :    call xgBlock_map_1d(xgocc,occ,SPACE_R,nband,gpu_option=dtset%gpu_option)
     255              :  end if
     256              : 
     257         9024 :  call timab(tim_chebfiwf2,2,tsec) ! IL TODO this should be deactivated
     258              : 
     259              :  ABI_NVTX_START_RANGE(NVTX_CHEBFI2_INIT)
     260              :  call chebfi_init(chebfi,nband,npw*nspinor,dtset%tolwfr_diago,dtset%ecut, &
     261              : &                 dtset%paral_kgb,l_mpi_enreg%bandpp, &
     262              : &                 dtset%mdeg_filter, dtset%nbdbuf, space,1, &
     263              : &                 l_mpi_enreg%comm_bandspinorfft,me_g0,me_g0_fft,l_paw,&
     264              : &                 l_mpi_enreg%comm_spinorfft,l_mpi_enreg%comm_band,&
     265              : &                 dtset%chebfi_oracle,dtset%oracle_factor,dtset%oracle_min_occ,&
     266              : &                 l_gs_hamk%gpu_option,gpu_kokkos_nthrd=dtset%gpu_kokkos_nthrd,&
     267         9024 : &                 gpu_thread_limit=dtset%gpu_thread_limit)
     268              :  ABI_NVTX_END_RANGE()
     269              : 
     270              : !################    RUUUUUUUN    #####################################
     271              : !######################################################################
     272              : 
     273         9024 :  call chebfi_run(chebfi,xgx0,getghc_gsc1,getBm1X,xgeigen,xgocc,xgresidu,nspinor)
     274              : 
     275         9024 :  if (allocated(occ_tmp)) then
     276          816 :    ABI_FREE(occ_tmp)
     277              :  end if
     278              : 
     279         9024 :  if ( .not. l_paw ) then
     280         1496 :    call timab(tim_nonlop,1,tsec)
     281              : #ifdef FC_CRAY
     282              :    ABI_MALLOC(gvnlxc,(1,1))
     283              : #else
     284         1496 :    ABI_MALLOC(gvnlxc,(0,0))
     285              : #endif
     286              :    !end if
     287              : 
     288              :    ABI_NVTX_START_RANGE(NVTX_CHEBFI2_NONLOP)
     289              :    !Call nonlop
     290         1496 :    if (l_paral_kgb==0) then
     291              : 
     292              :      call nonlop(choice,l_cpopt,cprj_dum,enl_out,l_gs_hamk,0,eig,mpi_enreg,nband,1,paw_opt,&
     293          408 : &                signs,gsc_dummy,l_tim_getghc,cg,gvnlxc)
     294              : 
     295              :    else
     296              : #ifdef HAVE_OPENMP_OFFLOAD
     297              :      !$OMP TARGET UPDATE FROM(cg) IF(gs_hamk%gpu_option==ABI_GPU_OPENMP)
     298              : #endif
     299         2176 :      do iband=1,nband/blockdim
     300         1088 :        shift = (iband-1)*blockdim*npw*nspinor
     301              :        call prep_nonlop(choice,l_cpopt,cprj_dum, &
     302              : &        enl_out((iband-1)*blockdim+1:iband*blockdim),l_gs_hamk,0,&
     303              : &        eig((iband-1)*blockdim+1:iband*blockdim),blockdim,mpi_enreg,1,paw_opt,signs,&
     304              : &        gsc_dummy,l_tim_getghc,cg(:,shift+1:shift+blockdim*npw*nspinor),gvnlxc(:,:),&
     305         2176 : &        already_transposed=.false.)
     306              :      end do
     307              :    end if
     308              :    ABI_NVTX_END_RANGE()
     309         1496 :    ABI_FREE(gvnlxc)
     310         1496 :    call timab(tim_nonlop,2,tsec)
     311              :  end if
     312              : 
     313              : !Free chebfi
     314         9024 :  call chebfi_free(chebfi)
     315              : 
     316              : #ifdef HAVE_OPENMP_OFFLOAD
     317              :  !$OMP TARGET UPDATE FROM(eig,resid) IF(gs_hamk%gpu_option==ABI_GPU_OPENMP)
     318              :  !$OMP TARGET EXIT DATA MAP(delete:eig,resid,occ) IF(gs_hamk%gpu_option==ABI_GPU_OPENMP)
     319              :  !$OMP TARGET EXIT DATA MAP(from:cg) IF(gs_hamk%gpu_option==ABI_GPU_OPENMP .and. transfer_cg)
     320              : #endif
     321              : 
     322         9024 :  call timab(tim_chebfiwf2,2,tsec)
     323              : 
     324              :  DBG_EXIT("COLL")
     325              : 
     326        27072 : end subroutine chebfiwf2
     327              : !!***
     328              : 
     329              : !----------------------------------------------------------------------
     330              : 
     331              : !!****f* m_chebfiwf/getghc_gsc1
     332              : !! NAME
     333              : !! getghc_gsc1
     334              : !!
     335              : !! FUNCTION
     336              : !! This routine computes H|C> and possibly S|C> for a given wave function C.
     337              : !!  It acts as a driver for getghc, taken into account parallelism, multithreading, etc.
     338              : !!
     339              : !! SIDE EFFECTS
     340              : !!  X  <type(xgBlock_t)>= memory block containing |C>
     341              : !!  AX <type(xgBlock_t)>= memory block containing H|C>
     342              : !!  BX <type(xgBlock_t)>= memory block containing S|C>
     343              : !!
     344              : !! SOURCE
     345              : 
     346        72586 : subroutine getghc_gsc1(X,AX,BX)
     347              : 
     348              :  implicit none
     349              : 
     350              : !Arguments ------------------------------------
     351              :  type(xgBlock_t), intent(inout) :: X
     352              :  type(xgBlock_t), intent(inout) :: AX
     353              :  type(xgBlock_t), intent(inout) :: BX
     354              :  integer         :: blockdim
     355              :  integer         :: spacedim
     356      1020684 :  type(pawcprj_type) :: cprj_dum(l_gs_hamk%natom,1)
     357              : 
     358              : !Local variables-------------------------------
     359              : !scalars
     360              :  real(dp) :: eval
     361              : !arrays
     362        72586 :  real(dp), pointer :: cg(:,:)
     363        72586 :  real(dp), pointer :: ghc(:,:)
     364        72586 :  real(dp), pointer :: gsc(:,:)
     365              :  real(dp)          :: gvnlxc(1,1)
     366              : 
     367              : ! *********************************************************************
     368              : 
     369              :  ABI_NVTX_START_RANGE(NVTX_GETGHC)
     370              : 
     371        72586 :  call xgBlock_getSize(X,spacedim,blockdim)
     372        72586 :  call xgBlock_check(X,AX)
     373        72586 :  call xgBlock_check(X,BX)
     374              : 
     375        72586 :  call xgBlock_reverseMap(X,cg,rows=1,cols=spacedim*blockdim)
     376        72586 :  call xgBlock_reverseMap(AX,ghc,rows=1,cols=spacedim*blockdim)
     377        72586 :  call xgBlock_reverseMap(BX,gsc,rows=1,cols=spacedim*blockdim)
     378              : 
     379              :  call multithreaded_getghc(l_cpopt,cg,cprj_dum,ghc,gsc,&
     380        72586 :    l_gs_hamk,gvnlxc,eval,l_mpi_enreg,blockdim,l_prtvol,l_sij_opt,l_tim_getghc,0)
     381              : 
     382              : #if defined(HAVE_GPU_CUDA) && defined(HAVE_YAKL)
     383              :  call gpu_device_synchronize()
     384              : #endif
     385              : 
     386        72586 :  if ( .not. l_paw ) call xgBlock_copy(X,BX)
     387              : 
     388              :  ABI_NVTX_END_RANGE()
     389              : 
     390       145172 : end subroutine getghc_gsc1
     391              : !!***
     392              : 
     393              : !----------------------------------------------------------------------
     394              : 
     395              : !!****f* m_chebfiwf/getBm1X
     396              : !! NAME
     397              : !! getBm1X
     398              : !!
     399              : !! FUNCTION
     400              : !! This routine computes S^-1|C> for a given wave function C.
     401              : !!  It acts as a driver for apply_invovl.
     402              : !!
     403              : !! SIDE EFFECTS
     404              : !!  X  <type(xgBlock_t)>= memory block containing |C>
     405              : !!  Bm1X <type(xgBlock_t)>= memory block containing S^-1|C>
     406              : !!
     407              : !! SOURCE
     408              : 
     409        51718 : subroutine getBm1X(X,Bm1X)
     410              : 
     411              :  implicit none
     412              : 
     413              : !Arguments ------------------------------------
     414              :  type(xgBlock_t), intent(inout) :: X
     415              :  type(xgBlock_t), intent(inout) :: Bm1X
     416              : 
     417              : !Local variables-------------------------------
     418              : !scalars
     419              :  integer :: blockdim
     420              :  integer :: spacedim
     421              : !arrays
     422        51718 :  real(dp), pointer :: ghc_filter(:,:)
     423        51718 :  real(dp), pointer :: gsm1hc_filter(:,:)
     424        51718 :  type(pawcprj_type), allocatable :: cwaveprj_next(:,:) !dummy
     425              : 
     426              : ! *********************************************************************
     427              : 
     428        51718 :  call xgBlock_getSize(X,spacedim,blockdim)
     429              : 
     430        51718 :  if(l_paw) then
     431              : 
     432        51718 :    call xgBlock_reverseMap(X,ghc_filter,rows=1,cols=spacedim*blockdim)
     433        51718 :    call xgBlock_reverseMap(Bm1X,gsm1hc_filter,rows=1,cols=spacedim*blockdim)
     434              : 
     435              :    !cwaveprj_next is dummy
     436        51718 :    if(gemm_nonlop_use_gemm) then
     437         1152 :      ABI_MALLOC(cwaveprj_next, (1,1))
     438              :    else
     439      1247656 :      ABI_MALLOC(cwaveprj_next, (l_gs_hamk%natom,l_nspinor*blockdim))
     440        51430 :      call pawcprj_alloc(cwaveprj_next,0,l_gs_hamk%dimcprj)
     441              :    end if
     442              : 
     443              :    ABI_NVTX_START_RANGE(NVTX_INVOVL)
     444              :    call apply_invovl(l_gs_hamk, ghc_filter(:,:), gsm1hc_filter(:,:), cwaveprj_next(:,:), &
     445        51718 :        spacedim/l_nspinor, blockdim, l_mpi_enreg, l_nspinor, l_block_sliced)
     446              :    ABI_NVTX_END_RANGE()
     447              : 
     448        51718 :    call pawcprj_free(cwaveprj_next)
     449       761990 :    ABI_FREE(cwaveprj_next)
     450              : 
     451              :  else
     452              : 
     453            0 :    call xgBlock_copy(X,Bm1X)
     454              : 
     455              :  end if
     456              : 
     457       103436 : end subroutine getBm1X
     458              : !!***
     459              : 
     460              : end module m_chebfiwf
     461              : !!***
        

Generated by: LCOV version 2.3-1