TABLE OF CONTENTS


ABINIT/m_wfutils [ Modules ]

[ Top ] [ Modules ]

NAME

  m_wfutils

FUNCTION

  parameters and function for wave functions copy

COPYRIGHT

  Copyright (C) 2001-2018 ABINIT group (CS,GZ,FB)
  This file is distributed under the terms of the
  GNU General Public License, see ~ABINIT/Infos/copyright
  or http://www.gnu.org/copyleft/gpl.txt .

SOURCE

17 #if defined HAVE_CONFIG_H
18 #include "config.h"
19 #endif
20 
21 #include "abi_common.h"
22 
23 module m_wfutils
24 
25  use defs_basis
26  use m_abicore
27  use m_errors
28 
29  use m_cgtools,  only : cg_to_reim, cg_from_reim
30  use m_time,     only : timab
31 
32  implicit none
33 
34  private
35 
36  public :: setWFParameter ! Definition of wave functions parameters for copy functions.
37  public :: wfcopy         ! Copy of wave functions arrays.
38 
39 ! Global variables
40  integer,save,public ABI_PROTECTED :: x_cplx   ! fortran data type for wave functions arrays real or complex.
41  integer,save,public ABI_PROTECTED :: x_me_g0  ! processor number
42  integer,save,public ABI_PROTECTED :: x_npw_k  ! number of plane waves at this k point
43  integer,save,public ABI_PROTECTED :: x_nspinor! number of spinorial components of the wavefunctions on current proc
44  integer,save,public ABI_PROTECTED :: x_icg    ! shift to be applied on the location of data in the array cg
45  integer,save,public ABI_PROTECTED :: x_igsc   ! shift to be applied on the location of data in the array gsc
46  integer,save,public ABI_PROTECTED :: x_blocksize
47 
48 contains

m_wfutils/setWFParameter [ Functions ]

[ Top ] [ m_wfutils ] [ Functions ]

NAME

 setWFParameter

FUNCTION

 Initialize wave functions parameters for copy functions

INPUTS

  cplx=fortran data type for wave functions arrays real or complex
  me_g0=1 if this node treats G=0.
  npw_k=number of plane waves at this k point
  nspinor=number of spinorial components of the wavefunctions on current proc
  icg=shift to be applied on the location of data in the array cg
  igsc=shift to be applied on the location of data in the array gsc
  blocksize=size of blocks

PARENTS

      lobpcgwf

CHILDREN

SOURCE

 75 subroutine setWFParameter(cplx,me_g0,npw_k,nspinor,icg,igsc,blocksize)
 76 
 77 
 78 !This section has been created automatically by the script Abilint (TD).
 79 !Do not modify the following lines by hand.
 80 #undef ABI_FUNC
 81 #define ABI_FUNC 'setWFParameter'
 82 !End of the abilint section
 83 
 84  implicit none
 85 
 86 !Arguments ------------------------------------
 87  integer, intent(in) :: cplx,me_g0,npw_k,nspinor
 88  integer, intent(in) :: icg,igsc,blocksize
 89 
 90 ! *********************************************************************
 91 
 92  ! Copy values in global variables
 93  x_cplx=cplx
 94  x_me_g0=me_g0
 95  x_npw_k=npw_k
 96  x_nspinor=nspinor
 97  x_icg=icg
 98  x_igsc=igsc
 99  x_blocksize=blocksize
100 
101 end subroutine setWFParameter

m_wfutils/wfcopy [ Functions ]

[ Top ] [ m_wfutils ] [ Functions ]

NAME

 wfcopy

FUNCTION

 copy of wave functions arrays.
 called from lobpcg in REAL or COMPLEX wave functions.

INPUTS

   direction=copy direction 
                'D' direct (global array to local)
                'I' indirect (local to global)
   size=number of elements
   tsrc=source array
   incsrc=size increment for tsrc array
   tdest=destination array
   incdest=increment for tdest array
   blockiter=number of block iteration in case REAL
   iblock=block index
   indtype=indexation type in array
   withbbloc=apply block on band for each block

TODO

  Split the two cases so that we can avoid the array descriptors.

PARENTS

   lobpcgwf

CHILDREN

   dcopy, zcopy

SOURCE

220 subroutine wfcopy(direction,size,tsrc,incsrc,tdest,incdest,blockiter,iblock,indtype,&
221 &                withbbloc,timopt,tim_wfcopy) ! optional arguments
222 
223 
224 !This section has been created automatically by the script Abilint (TD).
225 !Do not modify the following lines by hand.
226 #undef ABI_FUNC
227 #define ABI_FUNC 'wfcopy'
228 !End of the abilint section
229 
230  implicit none
231 
232 !Arguments ------------------------------------
233  character(len=1), intent(in) :: direction
234  integer, intent(in) :: size,incsrc,incdest
235  integer, intent(in) :: blockiter,iblock
236  character(len=1), intent(in) :: indtype
237  logical, optional, intent(in) :: withbbloc
238  integer, intent(in), optional :: timopt,tim_wfcopy
239 !arrays
240  real(dp), DEV_CONTARRD intent(in) :: tsrc(:,:)
241  real(dp), DEV_CONTARRD intent(inout) :: tdest(:,:)
242 
243 !Local variables ------------------------------------
244  integer,parameter :: ndat1=1
245  logical :: bblock=.false.
246  integer :: lig,g1,g2,vectsize,rvectsize
247  integer :: blocksize,bblocksize,iblocksize,iband
248  real(dp) :: factor
249  real(dp) :: tsec(2)
250 
251 ! *********************************************************************
252 
253  if (present(tim_wfcopy).and.present(timopt)) then
254    if(abs(timopt)==3) then
255      call timab(tim_wfcopy,1,tsec)
256    end if
257  end if
258 
259  if (present(withbbloc)) bblock=withbbloc
260 
261  if (indtype == 'C') then
262    lig=x_icg
263  else if (indtype == 'S') then
264    lig=x_igsc
265  else
266    lig=0
267  endif
268 
269  rvectsize=x_npw_k*x_nspinor
270  if (x_me_g0 == 1) then
271    vectsize=2*rvectsize-1
272  else
273    vectsize=2*rvectsize
274  endif
275  if (x_cplx == 2) vectsize=x_npw_k*x_nspinor
276 
277  blocksize  = x_blocksize
278  bblocksize=(iblock-1)*blocksize
279 
280  if (direction == 'D') then
281 
282    if (x_cplx == 1) then
283      ! Pack real and imag part.
284      factor=sqrt(two)
285      do iblocksize=1,blockiter
286        iband=iblocksize
287        if (bblock) then
288          iband=iblocksize+bblocksize
289        endif
290        if (x_me_g0 == 1) then
291          tdest(1 ,iblocksize)=tsrc(1,wfindex(iband,indtype))
292          g1 = wfindex(iband,  indtype)+1
293          g2 = wfindex(iband+1,indtype)-1
294          call dcopy(rvectsize-1,tsrc(1,g1:g2),1,tdest(2:rvectsize,iblocksize),1)
295          tdest(2:rvectsize,iblocksize) = factor * tdest(2:rvectsize,iblocksize)
296 
297          call dcopy(rvectsize-1,tsrc(2,g1:g2),1,tdest(rvectsize+1:vectsize,iblocksize),1)
298          tdest(rvectsize+1:vectsize,iblocksize) = factor * tdest(rvectsize+1:vectsize,iblocksize)
299          ! MG FIXME: Here gfortran4.9 allocates temporary arrays due to factor.
300          !call cg_to_reim(rvectsize-1,ndat1,tsrc(1:,g1:),factor,tdest(2:,iblocksize))
301        else
302          g1 = wfindex(iband,  indtype)
303          g2 = wfindex(iband+1,indtype)-1
304          call dcopy(rvectsize,tsrc(1,g1:g2),1,tdest(1:rvectsize,iblocksize),1)
305          tdest(1:rvectsize,iblocksize) = factor * tdest(1:rvectsize,iblocksize)
306 
307          call dcopy(rvectsize,tsrc(2,g1:g2),1,tdest(rvectsize+1:vectsize,iblocksize),1)
308          tdest(rvectsize+1:vectsize,iblocksize) = factor * tdest(rvectsize+1:vectsize,iblocksize)
309          !call cg_to_reim(rvectsize,ndat1,tsrc(1:,g1:),factor,tdest(1:,iblocksize))
310        end if
311      end do
312    else
313      if (indtype == 'C') then
314        if (bblock) then
315          g1 = vectsize*((iblock-1)*blocksize)+lig+1
316          g2 = vectsize*(iblock*blocksize)+lig
317          call zcopy(size,tsrc(:,g1:g2),incsrc,tdest(:,1:blocksize),incdest)
318        else
319          g1 = lig+1
320          g2 = vectsize*((iblock-1)*blocksize)+lig
321          call zcopy(size,tsrc(:,g1:g2),incsrc,tdest(:,1:bblocksize),incdest)
322        end if
323      else if (indtype == 'S') then
324        g1 = lig+1
325        g2 = vectsize*((iblock-1)*blocksize)+lig
326        call zcopy(size,tsrc(:,g1:g2),incsrc,tdest(:,1:bblocksize),incdest)
327      else
328        call zcopy(size,tsrc,incsrc,tdest,incdest)
329      endif
330    end if
331 
332  else if (direction == 'I') then
333    if (x_cplx == 1) then
334      ! Unpack real and imag blocks.
335      factor=one/sqrt(two)
336      do iblocksize=1,blockiter
337        iband=iblocksize
338        if ( bblock ) then
339          iband=iblocksize+(iblock-1)*blocksize
340        end if
341        if (x_me_g0 == 1) then
342          tdest(1,wfindex(iband,indtype))=tsrc(1,iblocksize)
343          tdest(2,wfindex(iband,indtype))=zero
344 
345          g1 = wfindex(iband,indtype)+1
346          g2 = wfindex(iband+1,indtype)-1
347          call dcopy(rvectsize-1,tsrc(2:rvectsize,iblocksize),1,tdest(1,g1:g2),1)
348          tdest(1,g1:g2) = factor * tdest(1,g1:g2)
349 
350          call dcopy(rvectsize-1,tsrc(rvectsize+1:vectsize,iblocksize),1,tdest(2,g1:g2),1)
351          tdest(2,g1:g2) = factor * tdest(2,g1:g2)
352          !call cg_from_reim(rvectsize-1,ndat1,tsrc(2:,iblocksize),factor,tdest(1,g1:))
353        else
354          g1 = wfindex(iband,indtype)
355          g2 = wfindex(iband+1,indtype)-1
356          call dcopy(rvectsize,tsrc(1:rvectsize,iblocksize),1,tdest(1,g1:g2),1)
357          tdest(1,g1:g2) = factor * tdest(1,g1:g2)
358          call dcopy(rvectsize,tsrc(rvectsize+1:vectsize,iblocksize),1,tdest(2,g1:g2),1)
359          tdest(2,g1:g2) = factor * tdest(2,g1:g2)
360          !call cg_from_reim(rvectsize,ndat1,tsrc(1:,iblocksize),factor,tdest(1:,g1))
361        end if
362      end do
363    else
364      if (indtype == 'C') then
365        g1 = vectsize*((iblock-1)*blocksize)+lig+1
366        g2 = vectsize*(iblock*blocksize)+lig
367        call zcopy(size,tsrc,1,tdest(:,g1:g2),1)
368      else if ( indtype == 'S' ) then
369        g1 = vectsize*((iblock-1)*blocksize)+lig+1
370        g2 = vectsize*(iblock*blocksize)+lig
371        call zcopy(size,tsrc,1,tdest(:,g1:g2),1)
372      else
373        call zcopy(size,tsrc,1,tdest,1)
374      end if
375    end if
376  else 
377    MSG_ERROR("Wrong direction: "//trim(direction))
378  endif
379 
380  if (present(tim_wfcopy).and.present(timopt)) then
381    if(abs(timopt)==3) then
382      call timab(tim_wfcopy,2,tsec)
383    end if
384  end if
385 
386 end subroutine wfcopy