TABLE OF CONTENTS


m_wfd/copy_kdata_0D [ Functions ]

[ Top ] [ Functions ]

NAME

  copy_kdata_0D

FUNCTION

  Deallocate memory

PARENTS

      m_wfd

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

737 subroutine copy_kdata_0D(Kdata_in,Kdata_out)
738 
739 
740 !This section has been created automatically by the script Abilint (TD).
741 !Do not modify the following lines by hand.
742 #undef ABI_FUNC
743 #define ABI_FUNC 'copy_kdata_0D'
744 !End of the abilint section
745 
746  implicit none
747 
748 !Arguments ------------------------------------
749 !scalars
750  type(kdata_t),intent(in) :: Kdata_in
751  type(kdata_t),intent(inout) :: Kdata_out
752 
753 !************************************************************************
754 
755  !@kdata_t
756  Kdata_out%istwfk  = Kdata_in%istwfk
757  Kdata_out%npw     = Kdata_in%npw
758  Kdata_out%useylm  = Kdata_in%useylm
759  Kdata_out%has_ylm = Kdata_in%has_ylm
760 
761  call alloc_copy(Kdata_in%kg_k, Kdata_out%kg_k)
762  call alloc_copy(Kdata_in%igfft0,Kdata_out%igfft0)
763  call alloc_copy(Kdata_in%gbound, Kdata_out%gbound)
764 
765  call alloc_copy(Kdata_in%ph3d,Kdata_out%ph3d)
766  call alloc_copy(Kdata_in%phkxred,Kdata_out%phkxred)
767  call alloc_copy(Kdata_in%fnl_dir0der0,Kdata_out%fnl_dir0der0)
768  call alloc_copy(Kdata_in%ylm,Kdata_out%ylm)
769 
770  Kdata_out%gbnds=Kdata_in%gbnds
771 
772 end subroutine copy_kdata_0D

m_wfd/copy_kdata_1D [ Functions ]

[ Top ] [ Functions ]

NAME

  copy_kdata_1D

FUNCTION

   Deallocate memory.

PARENTS

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

794 subroutine copy_kdata_1D(Kdata_in,Kdata_out)
795 
796 
797 !This section has been created automatically by the script Abilint (TD).
798 !Do not modify the following lines by hand.
799 #undef ABI_FUNC
800 #define ABI_FUNC 'copy_kdata_1D'
801 !End of the abilint section
802 
803  implicit none
804 
805 !Arguments ------------------------------------
806 !scalars
807  type(kdata_t),intent(in) :: Kdata_in(:)
808  type(kdata_t),intent(inout) :: Kdata_out(:)
809 
810 !Local variables ------------------------------
811 !scalars
812  integer :: ik
813 
814 !************************************************************************
815 
816  if (size(Kdata_in,DIM=1) /= size(Kdata_out,DIM=1)) then
817    MSG_ERROR("copy_kdata_1D: wrong sizes !")
818  end if
819 
820  do ik=LBOUND(Kdata_in,DIM=1),UBOUND(Kdata_in,DIM=1)
821    call copy_kdata_0d(Kdata_in(ik),Kdata_out(ik))
822  end do
823 
824 end subroutine copy_kdata_1D

m_wfd/copy_wave_3D [ Functions ]

[ Top ] [ Functions ]

NAME

  copy_wave_3D

FUNCTION

   Copy method used for a 3-D arrays of wave_t datatyps.

INPUTS

OUTPUT

PARENTS

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

2610 subroutine copy_wave_3D(Wave_in,Wave_out)
2611 
2612 
2613 !This section has been created automatically by the script Abilint (TD).
2614 !Do not modify the following lines by hand.
2615 #undef ABI_FUNC
2616 #define ABI_FUNC 'copy_wave_3D'
2617 !End of the abilint section
2618 
2619  implicit none
2620 
2621 !Arguments ------------------------------------
2622 !scalars
2623  type(wave_t),intent(in) :: Wave_in(:,:,:)
2624  type(wave_t),intent(inout) :: Wave_out(:,:,:)
2625 
2626 !Local variables ------------------------------
2627 !scalars
2628  integer :: i1,i2,i3
2629 
2630 !************************************************************************
2631 
2632  do i3=LBOUND(Wave_in,DIM=3),UBOUND(Wave_in,DIM=3)
2633    do i2=LBOUND(Wave_in,DIM=2),UBOUND(Wave_in,DIM=2)
2634      do i1=LBOUND(Wave_in,DIM=1),UBOUND(Wave_in,DIM=1)
2635        call wave_copy_0D(Wave_in(i1,i2,i3),Wave_out(i1,i2,i3))
2636      end do
2637    end do
2638  end do
2639 
2640 end subroutine copy_wave_3D

m_wfd/kdata_free_0D [ Functions ]

[ Top ] [ Functions ]

NAME

  kdata_free_0D

FUNCTION

  Deallocate memory

PARENTS

      m_wfd

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

626 subroutine kdata_free_0D(Kdata)
627 
628 
629 !This section has been created automatically by the script Abilint (TD).
630 !Do not modify the following lines by hand.
631 #undef ABI_FUNC
632 #define ABI_FUNC 'kdata_free_0D'
633 !End of the abilint section
634 
635  implicit none
636 
637 !Arguments ------------------------------------
638 !scalars
639  type(kdata_t),intent(inout) :: Kdata
640 
641 !************************************************************************
642 
643  !@kdata_t
644  if (allocated(Kdata%kg_k)) then
645    ABI_FREE(Kdata%kg_k)
646  end if
647  if (allocated(Kdata%igfft0)) then
648    ABI_FREE(Kdata%igfft0)
649  end if
650  if (allocated(Kdata%gbound)) then
651    ABI_FREE(Kdata%gbound)
652  end if
653 
654  if (allocated(Kdata%ph3d)) then
655    ABI_FREE(Kdata%ph3d)
656  end if
657  if (allocated(Kdata%phkxred)) then
658    ABI_FREE(Kdata%phkxred)
659  end if
660  if (allocated(Kdata%fnl_dir0der0)) then
661    ABI_FREE(Kdata%fnl_dir0der0)
662  end if
663  if (allocated(Kdata%ylm)) then
664    ABI_FREE(Kdata%ylm)
665  end if
666 
667 end subroutine kdata_free_0D

m_wfd/kdata_free_1D [ Functions ]

[ Top ] [ Functions ]

NAME

  kdata_free_1D

FUNCTION

   Deallocate memory.

PARENTS

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

689 subroutine kdata_free_1D(Kdata)
690 
691 
692 !This section has been created automatically by the script Abilint (TD).
693 !Do not modify the following lines by hand.
694 #undef ABI_FUNC
695 #define ABI_FUNC 'kdata_free_1D'
696 !End of the abilint section
697 
698  implicit none
699 
700 !Arguments ------------------------------------
701 !scalars
702  type(kdata_t),intent(inout) :: Kdata(:)
703 
704 !Local variables ------------------------------
705 !scalars
706  integer :: ik
707 
708 !************************************************************************
709 
710  do ik=LBOUND(Kdata,DIM=1),UBOUND(Kdata,DIM=1)
711    call kdata_free_0D(Kdata(ik))
712  end do
713 
714 end subroutine kdata_free_1D

m_wfd/kdata_init [ Functions ]

[ Top ] [ Functions ]

NAME

  kdata_init

FUNCTION

  Main creation method for the kdata_t datatype.

PARENTS

      debug_tools,m_shirley,m_wfd

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

463 subroutine kdata_init(Kdata,Cryst,Psps,kpoint,istwfk,ngfft,MPI_enreg,ecut,kg_k)
464 
465 
466 !This section has been created automatically by the script Abilint (TD).
467 !Do not modify the following lines by hand.
468 #undef ABI_FUNC
469 #define ABI_FUNC 'kdata_init'
470 !End of the abilint section
471 
472  implicit none
473 
474 !Arguments ------------------------------------
475 !scalars
476  integer,intent(in) :: istwfk
477  real(dp),optional,intent(in) :: ecut
478  type(crystal_t),intent(in) :: Cryst
479  type(pseudopotential_type),intent(in) :: Psps
480  type(kdata_t),intent(inout) :: Kdata
481  type(MPI_type),intent(in) :: MPI_enreg
482 !arrays
483  integer,optional,target,intent(in) :: kg_k(:,:)
484  integer,intent(in) :: ngfft(18)
485  real(dp),intent(in) :: kpoint(3)
486 
487 !Local variables ------------------------------
488 !scalars
489  integer,parameter :: dum_unkg=0,dum_unylm=0,ider0=0,idir0=0
490  integer :: mpw_,npw_k,dimffnl,useylmgr,nkpg,iatom
491  integer :: mkmem_,nkpt_,optder,mgfft
492  integer :: iatm,matblk,ng1,ng2,ng3 !,ig1,ig2,ig3,ipw
493  real(dp) :: arg
494  logical :: ltest
495  !character(len=500) :: msg
496 !arrays
497  integer :: nband_(1),npwarr_(1)
498  real(dp),allocatable :: ylmgr_k(:,:,:),kpg_k(:,:)
499  real(dp),allocatable :: ph1d(:,:)
500  logical,allocatable :: kg_mask(:)
501 
502 !************************************************************************
503 
504  !@kdata_t
505  Kdata%istwfk = istwfk
506  Kdata%useylm = Psps%useylm
507 
508  if (PRESENT(ecut)) then
509   ! Calculate G-sphere from input ecut.
510   ltest = (.not.allocated(Kdata%kg_k))
511   ABI_CHECK(ltest,"Kdata%kg_k is allocated!")
512   call get_kg(kpoint,istwfk,ecut,Cryst%gmet,npw_k,Kdata%kg_k)
513 
514  else if (PRESENT(kg_k)) then ! Use input g-vectors.
515    npw_k = SIZE(kg_k,DIM=2)
516    ABI_MALLOC(Kdata%kg_k,(3,npw_k))
517    Kdata%kg_k = kg_k
518  else
519    MSG_ERROR("Either ecut or kg_k must be present")
520  end if
521  Kdata%npw = npw_k
522 
523  mgfft = MAXVAL(ngfft(1:3))
524  !
525  ! Finds the boundary of the basis sphere of G vectors (for this k point)
526  ! for use in improved zero padding of ffts in 3 dimensions.
527  ABI_MALLOC(Kdata%gbound,(2*mgfft+8,2))
528  call sphereboundary(Kdata%gbound,istwfk,Kdata%kg_k,mgfft,npw_k)
529  !
530  ! Index of the G-sphere in the FFT box.
531  ABI_MALLOC(Kdata%igfft0,(npw_k))
532  ABI_MALLOC(kg_mask,(npw_k))
533  call kgindex(Kdata%igfft0,Kdata%kg_k,kg_mask,MPI_enreg,ngfft,npw_k)
534 
535  ABI_CHECK(ALL(kg_mask),"FFT para not yet implemented")
536  ABI_FREE(kg_mask)
537 
538  ! Compute e^{ik.Ra} for each atom. Packed according to the atom type (atindx).
539  ABI_MALLOC(Kdata%phkxred,(2,Cryst%natom))
540  do iatom=1,Cryst%natom
541    iatm=Cryst%atindx(iatom)
542    arg=two_pi*(DOT_PRODUCT(kpoint,Cryst%xred(:,iatom)))
543    Kdata%phkxred(1,iatm)=DCOS(arg)
544    Kdata%phkxred(2,iatm)=DSIN(arg)
545  end do
546  !
547  ! Calculate 1-dim structure factor phase information.
548  mgfft = MAXVAL(ngfft(1:3))
549  ABI_MALLOC(ph1d,(2,3*(2*mgfft+1)*Cryst%natom))
550  call getph(Cryst%atindx,Cryst%natom,ngfft(1),ngfft(2),ngfft(3),ph1d,Cryst%xred)
551 
552  matblk=Cryst%natom
553  ABI_MALLOC(Kdata%ph3d,(2,npw_k,matblk))
554  call ph1d3d(1,Cryst%natom,Kdata%kg_k,matblk,Cryst%natom,npw_k,ngfft(1),ngfft(2),ngfft(3),Kdata%phkxred,ph1d,Kdata%ph3d)
555  ABI_FREE(ph1d)
556  !
557  ! * Compute spherical harmonics if required.
558  Kdata%has_ylm = 0
559  ABI_MALLOC(Kdata%ylm,(npw_k,Psps%mpsang**2*Psps%useylm))
560  useylmgr=0
561  ABI_MALLOC(ylmgr_k,(npw_k,3,Psps%mpsang**2*useylmgr))
562 
563  if (Kdata%useylm==1) then
564    mkmem_=1; mpw_=npw_k; nband_=0; nkpt_=1; npwarr_(1)=npw_k
565    optder=0 ! only Ylm(K) are computed.
566 
567    call initylmg(Cryst%gprimd,Kdata%kg_k,kpoint,mkmem_,MPI_enreg,Psps%mpsang,mpw_,nband_,nkpt_,&
568 &    npwarr_,1,optder,Cryst%rprimd,Kdata%ylm,ylmgr_k)
569 
570    Kdata%has_ylm=2
571  end if
572  !
573  ! * Compute (k+G) vectors.
574  nkpg=0
575  ABI_MALLOC(kpg_k,(npw_k,nkpg))
576  if (nkpg>0) then
577    call mkkpg(Kdata%kg_k,kpg_k,kpoint,nkpg,npw_k)
578  end if
579  !
580  ! * Compute nonlocal form factors fnl_dir0der0 for all (k+G).
581  dimffnl=1+3*ider0
582  ABI_MALLOC(Kdata%fnl_dir0der0,(npw_k,dimffnl,Psps%lmnmax,Cryst%ntypat))
583 
584  call mkffnl(Psps%dimekb,dimffnl,Psps%ekb,Kdata%fnl_dir0der0,Psps%ffspl,&
585 &  Cryst%gmet,Cryst%gprimd,ider0,idir0,Psps%indlmn,Kdata%kg_k,kpg_k,kpoint,Psps%lmnmax,&
586 &  Psps%lnmax,Psps%mpsang,Psps%mqgrid_ff,nkpg,npw_k,Cryst%ntypat,&
587 &  Psps%pspso,Psps%qgrid_ff,Cryst%rmet,Psps%usepaw,Psps%useylm,Kdata%ylm,ylmgr_k)
588 
589  ABI_FREE(kpg_k)
590  ABI_FREE(ylmgr_k)
591  !
592  ! Setup of tables used to symmetrize u(g)
593  ! TODO: Be careful here as FFT parallelism won't work.
594  ! Remove these tables.
595  Kdata%gbnds(:,1) = MINVAL(Kdata%kg_k(:,:),DIM=2)
596  Kdata%gbnds(:,2) = MAXVAL(Kdata%kg_k(:,:),DIM=2)
597 
598  ng1 = Kdata%gbnds(1,2) + ABS(Kdata%gbnds(1,1)) + 1
599  ng2 = Kdata%gbnds(2,2) + ABS(Kdata%gbnds(2,1)) + 1
600  ng3 = Kdata%gbnds(3,2) + ABS(Kdata%gbnds(3,1)) + 1
601  !write(std_out,*)"ng1,ng2,ng3: ",ng1,ng2,ng3
602 
603 end subroutine kdata_init

m_wfd/kdata_t [ Types ]

[ Top ] [ Types ]

NAME

 kdata_t

FUNCTION

 Datatype storing k-dependent quantities and tables needed for performing the zero-padded FFT of wavefunctions.

SOURCE

 97  type,public :: kdata_t
 98 
 99    integer :: istwfk
100    ! Storage mode for this k point.
101 
102    integer :: npw
103    ! Number of plane-waves for this k-point.
104 
105    integer :: useylm
106    ! 1 if nonlocal part is applied using real spherical Harmonics. 0 for Legendre polynomial.
107 
108    integer :: has_ylm
109    ! 0 if ylm is allocated.
110    ! 1 if ylm is allocated.
111    ! 2 if ylm is already computed.
112 
113    integer :: gbnds(3,2)
114    ! gbnds(:,1)=Minval of kg_k.
115    ! gbnds(:,2)=Maxval of kg_k.
116    ! TODO: TO BE REMOVED when k-centered basis sets will be used.
117 
118    integer,allocatable :: kg_k(:,:)
119    ! kg_k(3,npw)
120    ! G vector coordinates in reduced cordinates.
121 
122    integer,allocatable :: igfft0(:)
123    ! TODO Remove this array, not used anymore
124    ! igfft0(npw)
125    ! Index of the G-sphere in the FFT box.
126 
127    integer,allocatable :: gbound(:,:)
128    ! gbound(2*mgfft+8,2))
129    ! The boundary of the basis sphere of G vectors at a given k point.
130    ! for use in improved zero padding of ffts in 3 dimensions.
131 
132    !% real(dp) :: kpoint(3)
133 
134    real(dp),allocatable :: ph3d(:,:,:)
135    ! ph3d(2,npw,natom)
136    ! 3-dim structure factors, for each atom and each plane wave.
137 
138    real(dp),allocatable :: phkxred(:,:)
139    ! phkxred(2,natom))
140    ! e^{ik.Ra} for each atom. Packed according to the atom type (atindx).
141 
142    real(dp),allocatable :: fnl_dir0der0(:,:,:,:)
143    ! fnl_dir0der0(npw,1,lmnmax,ntypat)
144    ! nonlocal form factors.
145    ! fnl(k+G).ylm(k+G) if PAW
146    ! f_ln(k+G)/|k+G|^l if NC
147 
148    real(dp),allocatable :: ylm(:,:)
149    ! ylm(npw,mpsang**2*useylm)
150    ! Real spherical harmonics for each k+G
151 
152  end type kdata_t
153 
154  public :: kdata_init
155  public :: kdata_free
156  public :: kdata_copy
157 
158  interface kdata_free
159    module procedure kdata_free_0D
160    module procedure kdata_free_1D
161  end interface kdata_free
162 
163  interface kdata_copy
164    module procedure copy_kdata_0D
165    module procedure copy_kdata_1D
166  end interface kdata_copy

m_wfd/test_charge [ Functions ]

[ Top ] [ Functions ]

NAME

 test_charge

FUNCTION

  Reports info on the electronic charge as well as Drude plasma frequency.
  Mainly used in the GW part.

INPUTS

  nelectron_exp=Expected total number of electrons (used to normalize the charge)

OUTPUT

PARENTS

      bethe_salpeter,mrgscr,screening,sigma

CHILDREN

      wrtout

SOURCE

7065 subroutine test_charge(nfftf,nelectron_exp,nspden,rhor,ucvol,&
7066 & usepaw,usexcnhat,usefinegrid,compch_sph,compch_fft,omegaplasma)
7067 
7068 
7069 !This section has been created automatically by the script Abilint (TD).
7070 !Do not modify the following lines by hand.
7071 #undef ABI_FUNC
7072 #define ABI_FUNC 'test_charge'
7073 !End of the abilint section
7074 
7075  implicit none
7076 
7077 !Arguments ------------------------------------
7078 !scalars
7079  integer,intent(in) :: nfftf,nspden,usefinegrid,usepaw,usexcnhat
7080  real(dp),intent(in) :: compch_fft,compch_sph,ucvol,nelectron_exp
7081  real(dp),intent(out) :: omegaplasma
7082 !arrays
7083  real(dp),intent(inout) :: rhor(nfftf,nspden)
7084 
7085 !Local variables ------------------------------
7086 !scalars
7087  real(dp) :: nelectron_tot,nelectron_fft
7088  real(dp) :: nelectron_pw,nelectron_sph,rhoav,rs,nratio
7089  character(len=500) :: msg
7090 
7091 !*************************************************************************
7092 
7093 ! ABI_UNUSED(usexcnhat)
7094 if (usexcnhat==0)then
7095 end if
7096 
7097  ! === For PAW output of compensation charges ===
7098  if (usepaw==1) then
7099 !if (usepaw==1.and.usexcnhat>0) then ! TODO I still dont understand this if!
7100    write(msg,'(4a)')ch10,' PAW TEST:',ch10,' ==== Compensation charge inside spheres ============'
7101    if (compch_sph<greatest_real.and.compch_fft<greatest_real) &
7102 &    write(msg,'(3a)')TRIM(msg),ch10,' The following values must be close...'
7103    if (compch_sph<greatest_real) &
7104 &    write(msg,'(3a,f22.15)')TRIM(msg),ch10,' Compensation charge over spherical meshes = ',compch_sph
7105    if (compch_fft<greatest_real) then
7106      if (usefinegrid==1) then
7107        write(msg,'(3a,f22.15)')TRIM(msg),ch10,' Compensation charge over fine fft grid    = ',compch_fft
7108      else
7109        write(msg,'(3a,f22.15)')TRIM(msg),ch10,' Compensation charge over fft grid         = ',compch_fft
7110      end if
7111    end if
7112    call wrtout(ab_out,msg,'COLL')
7113    call wrtout(std_out,msg,'COLL')
7114    write(msg,'(a)')ch10
7115    call wrtout(ab_out,msg,'COLL')
7116    call wrtout(std_out,msg,'COLL')
7117  end if !PAW
7118 
7119  nelectron_pw =SUM(rhor(:,1))*ucvol/nfftf
7120  nelectron_tot=nelectron_pw
7121  nratio       =nelectron_exp/nelectron_tot
7122 
7123  if (usepaw==1) then
7124    nelectron_sph=nelectron_pw+compch_sph
7125    nelectron_fft=nelectron_pw+compch_fft
7126    nelectron_tot=nelectron_sph
7127    nratio=(nelectron_exp-nelectron_sph)/nelectron_pw
7128  end if
7129 
7130  rhoav=nelectron_tot/ucvol ; rs=(three/(four_pi*rhoav))**third
7131  if (usepaw==0) then
7132   write(msg,'(2(a,f9.4))')&
7133 &   ' Number of electrons calculated from density = ',nelectron_tot,'; Expected = ',nelectron_exp
7134  else
7135    write(msg,'(2(a,f9.4),a)')&
7136 &   ' Total number of electrons per unit cell = ',nelectron_sph,' (Spherical mesh), ',nelectron_fft,' (FFT mesh)'
7137  end if
7138  call wrtout(std_out,msg,'COLL')
7139  call wrtout(ab_out,msg,'COLL')
7140 
7141 !$write(msg,'(a,f9.4)')' Renormalizing smooth charge density using nratio = ',nratio
7142 !! rhor(:,:)=nratio*rhor(:,:)
7143 
7144  write(msg,'(a,f9.6)')' average of density, n = ',rhoav
7145  call wrtout(std_out,msg,'COLL')
7146  call wrtout(ab_out,msg,'COLL')
7147  write(msg,'(a,f9.4)')' r_s = ',rs
7148  call wrtout(std_out,msg,'COLL')
7149  call wrtout(ab_out,msg,'COLL')
7150  omegaplasma=SQRT(four_pi*rhoav)
7151  write(msg,'(a,f9.4,2a)')' omega_plasma = ',omegaplasma*Ha_eV,' [eV]',ch10
7152  call wrtout(std_out,msg,'COLL')
7153  call wrtout(ab_out,msg,'COLL')
7154 
7155 end subroutine test_charge

m_wfd/wave_copy_0D [ Functions ]

[ Top ] [ Functions ]

NAME

  wave_copy_0D

FUNCTION

  Copy method for the wave_t datatype.

INPUTS

SIDE EFFECTS

PARENTS

      m_wfd

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

2528 subroutine wave_copy_0D(Wave_in,Wave_out)
2529 
2530 
2531 !This section has been created automatically by the script Abilint (TD).
2532 !Do not modify the following lines by hand.
2533 #undef ABI_FUNC
2534 #define ABI_FUNC 'wave_copy_0D'
2535 !End of the abilint section
2536 
2537  implicit none
2538 
2539 !Arguments ------------------------------------
2540 !scalars
2541  type(wave_t),intent(in) :: Wave_in
2542  type(wave_t),intent(inout) :: Wave_out
2543 
2544 !Local variables ------------------------------
2545  integer :: natom,nspinor,iatom,ispinor
2546 
2547 !************************************************************************
2548 
2549  !@wave_t
2550  !@pawcprj_type
2551 
2552  call deep_copy(Wave_in%has_ug,Wave_out%has_ug)
2553  call deep_copy(Wave_in%has_ur,Wave_out%has_ur)
2554  call deep_copy(Wave_in%has_cprj,Wave_out%has_cprj)
2555  call deep_copy(Wave_in%cprj_order,Wave_out%cprj_order)
2556 
2557  ABI_MALLOC(Wave_out%ug, (SIZE(Wave_in%ug)))
2558  ABI_MALLOC(Wave_out%ur, (SIZE(Wave_in%ur)))
2559  Wave_out%ug = Wave_in%ug
2560  Wave_out%ur = Wave_in%ur
2561 
2562  ! TODO: SHOULD CHECK whether it's possible to pass allocatable arrays to procedures.
2563  !call deep_copy(Wave_in%ug,Wave_out%ug)
2564  !call deep_copy(Wave_in%ur,Wave_out%ur)
2565 
2566  natom   = size(Wave_in%Cprj,dim=1)
2567  nspinor = size(Wave_in%Cprj,dim=2)
2568  if ((size(Wave_out%Cprj,dim=1) .ne. natom) .or. (size(Wave_out%Cprj,dim=2) .ne. nspinor)) then
2569    if (allocated(Wave_out%Cprj))  then
2570      ABI_DT_FREE(Wave_out%Cprj)
2571    end if
2572    ABI_DT_MALLOC(Wave_out%Cprj,(natom,nspinor))
2573  end if
2574 
2575  do ispinor=1,nspinor
2576    do iatom=1,natom
2577     Wave_out%Cprj(iatom,ispinor)%ncpgr=Wave_in%Cprj(iatom,ispinor)%ncpgr
2578     Wave_out%Cprj(iatom,ispinor)%nlmn=Wave_in%Cprj(iatom,ispinor)%nlmn
2579     call alloc_copy(Wave_in%Cprj(iatom,ispinor)%cp,Wave_out%Cprj(iatom,ispinor)%cp)
2580     call alloc_copy(Wave_in%Cprj(iatom,ispinor)%dcp,Wave_out%Cprj(iatom,ispinor)%dcp)
2581    end do
2582  end do
2583 
2584 end subroutine wave_copy_0D

m_wfd/wave_free_0D [ Functions ]

[ Top ] [ Functions ]

NAME

  wave_free_0D

FUNCTION

  Main destruction method for the wave_t datatype.

INPUTS

  [what]=String defining what has to be freed.
     "A" =Both ug and ur and Cprj. Default.
     "G" =Only ug.
     "R" =Only ur
     "C" =Only PAW Cprj.

SIDE EFFECTS

  Memory in Wave is deallocated depending on what

PARENTS

      m_wfd

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

2362 subroutine wave_free_0D(Wave,what)
2363 
2364 
2365 !This section has been created automatically by the script Abilint (TD).
2366 !Do not modify the following lines by hand.
2367 #undef ABI_FUNC
2368 #define ABI_FUNC 'wave_free_0D'
2369 !End of the abilint section
2370 
2371  implicit none
2372 
2373 !Arguments ------------------------------------
2374 !scalars
2375  character(len=*),optional,intent(in) :: what
2376  type(wave_t),intent(inout) :: Wave
2377 
2378 !Local variables ------------------------------
2379 !scalars
2380  character(len=10) :: my_what
2381 
2382 !************************************************************************
2383 
2384  !@wave_t
2385  my_what="ALL"; if (PRESENT(what)) my_what=toupper(what)
2386 
2387  if (.not.firstchar(my_what,["A", "G", "R", "C"] )) then
2388    MSG_ERROR("unknow what: "//TRIM(what))
2389  end if
2390 
2391  if (firstchar(my_what,["A", "G"])) then
2392    if (allocated(Wave%ug))  then
2393      ABI_FREE(Wave%ug)
2394    end if
2395    Wave%has_ug=WFD_NOWAVE
2396  end if
2397 
2398  if (firstchar(my_what,["A", "R"])) then
2399    if (allocated(Wave%ur))  then
2400      ABI_FREE(Wave%ur)
2401    end if
2402    Wave%has_ur=WFD_NOWAVE
2403  end if
2404 
2405  if (firstchar(my_what,["A", "C"])) then
2406    if (allocated(Wave%Cprj)) then
2407      call pawcprj_free(Wave%Cprj)
2408      ABI_DT_FREE(Wave%Cprj)
2409    end if
2410    Wave%has_cprj=WFD_NOWAVE
2411  end if
2412 
2413 end subroutine wave_free_0D

m_wfd/wave_free_3D [ Functions ]

[ Top ] [ Functions ]

NAME

  wave_free_3D

FUNCTION

   Destruction method used for a 3-D arrays of wave_t datatyps.

INPUTS

  Wave(:,:,:)<wave_t>=The array of structures.
  [what]=String defining what has to be freed.
     "A"=Both ug and ur as PAW Cprj, if any. Default.
     "G"  =Only ug.
     "R"  =Only ur
     "C"  =Only PAW Cprj.
  [mask(:,:,:)]=Mask used to select the elements that have to be deallocated. All of them, if not specified.

SIDE EFFECTS

  Memory in Wave is deallocated depending on what and mask.

OUTPUT

PARENTS

      m_wfd

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

2450 subroutine wave_free_3D(Wave,what,mask)
2451 
2452 
2453 !This section has been created automatically by the script Abilint (TD).
2454 !Do not modify the following lines by hand.
2455 #undef ABI_FUNC
2456 #define ABI_FUNC 'wave_free_3D'
2457 !End of the abilint section
2458 
2459  implicit none
2460 
2461 !Arguments ------------------------------------
2462 !scalars
2463  character(len=*),optional,intent(in) :: what
2464  type(wave_t),intent(inout) :: Wave(:,:,:)
2465 !arrays
2466  logical,optional,intent(in) :: mask(:,:,:)
2467 
2468 !Local variables ------------------------------
2469 !scalars
2470  integer :: i1,i2,i3
2471  logical :: do_free
2472  character(len=10) :: my_what
2473 
2474 !************************************************************************
2475 
2476  my_what="ALL"; if (PRESENT(what)) my_what=toupper(what)
2477  do_free = .TRUE.
2478 
2479  if (PRESENT(mask)) then
2480     do i3=LBOUND(Wave,DIM=3),UBOUND(Wave,DIM=3)
2481        do i2=LBOUND(Wave,DIM=2),UBOUND(Wave,DIM=2)
2482           do i1=LBOUND(Wave,DIM=1),UBOUND(Wave,DIM=1)
2483              ! do_free=.TRUE.; if (PRESENT(mask)) do_free=mask(i1,i2,i3)
2484              do_free=mask(i1,i2,i3)
2485              if (do_free) then
2486                call wave_free_0D(Wave(i1,i2,i3),what=my_what)
2487              end if
2488           end do
2489        end do
2490     end do
2491  else
2492     do i3=LBOUND(Wave,DIM=3),UBOUND(Wave,DIM=3)
2493        do i2=LBOUND(Wave,DIM=2),UBOUND(Wave,DIM=2)
2494           do i1=LBOUND(Wave,DIM=1),UBOUND(Wave,DIM=1)
2495              call wave_free_0D(Wave(i1,i2,i3),what=my_what)
2496           end do
2497        end do
2498     end do
2499  end if
2500 
2501 end subroutine wave_free_3D

m_wfd/wave_init_0D [ Functions ]

[ Top ] [ Functions ]

NAME

  wave_init_0D

FUNCTION

   Main creation method for the wave_t data type

INPUTS

  usepaw=1 if PAW is used.
  npw =Number of plane-waves for ug
  nfft=Number of FFT points for the real space wavefunction.
  nspinor=Number of spinor components.
  natom=Number of atoms in cprj matrix elements.
  nlmn_size(natom)=Number of (n,l,m) channel for each atom.  Ordering of atoms depends on cprj_order
  cprj_order=Flag defining the ordering of the atoms in the cprj matrix elements (CPR_RANDOM|CPR_SORTED).
    Use to know if we have to reorder the matrix elements when wfd_get_cprj is called.

OUTPUT

  Wave<wave_t>=The structure fully initialized.

PARENTS

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

2279 subroutine wave_init_0D(Wave,usepaw,npw,nfft,nspinor,natom,nlmn_size,cprj_order)
2280 
2281 
2282 !This section has been created automatically by the script Abilint (TD).
2283 !Do not modify the following lines by hand.
2284 #undef ABI_FUNC
2285 #define ABI_FUNC 'wave_init_0D'
2286 !End of the abilint section
2287 
2288  implicit none
2289 
2290 !Arguments ------------------------------------
2291 !scalars
2292  integer,intent(in) :: npw,nfft,nspinor,usepaw,natom,cprj_order
2293  type(wave_t),intent(inout) :: Wave
2294 !arrays
2295  integer,intent(in) :: nlmn_size(:)
2296 
2297 !Local variables ------------------------------
2298 !scalars
2299  integer,parameter :: ncpgr0=0  ! For the time being, no derivatives
2300 
2301 !************************************************************************
2302 
2303  !Wave%npw_k   = npw
2304  !Wave%nfft    = nfft
2305  !Wave%nspinor = nspinor
2306  !Wave%natom   = natom
2307 
2308  !@wave_t
2309  if (npw >0) then
2310    ABI_MALLOC(Wave%ug,(npw*nspinor))
2311    Wave%has_ug=WFD_ALLOCATED
2312    Wave%ug=huge(one_gw)
2313    !Wave%ug=czero_gw
2314    if (usepaw==1) then
2315      ABI_DT_MALLOC(Wave%Cprj,(natom,nspinor))
2316      call pawcprj_alloc(Wave%Cprj,ncpgr0,nlmn_size)
2317      Wave%has_cprj=WFD_ALLOCATED
2318      Wave%cprj_order=cprj_order
2319    end if
2320  end if
2321 
2322  if (nfft>0) then
2323    ABI_MALLOC(Wave%ur,(nfft*nspinor))
2324    Wave%ur=huge(one_gw)
2325    !Wave%ur=czero
2326    Wave%has_ur=WFD_ALLOCATED
2327  end if
2328 
2329 end subroutine wave_init_0D

m_wfd/wave_t [ Types ]

[ Top ] [ Types ]

NAME

 wave_t

FUNCTION

  Structure used to store a single wavefunction in reciprocal space and, optionally, its real space representation.

SOURCE

180  type, public :: wave_t
181 
182   !integer :: npw_k
183   !integer :: nfft
184   !integer :: nspinor
185   !integer :: natom
186 
187   !! integer :: cplex
188   ! 1 for real wavefunctions u(r)
189   ! 2 for complex wavefunctions u(r).
190   ! At gamma we always have real u(r) provided that time-reversal can be used.
191   ! In systems with both time-reversal and spatial inversion, wavefunctions can be chosen to be real.
192   ! One might use this to reduce memory in wave_t.
193 
194   integer :: has_ug=WFD_NOWAVE
195   ! Flag giving the status of ug.
196 
197   integer :: has_ur=WFD_NOWAVE
198   ! Flag giving the status of ur.
199 
200   integer :: has_cprj=WFD_NOWAVE
201   ! Flag giving the status of cprj.
202 
203   integer :: cprj_order=CPR_RANDOM
204   ! Flag defining whether cprj are sorted by atom type or ordered according
205   ! to the typat variable used in the input file.
206 
207   complex(gwpc),allocatable :: ug(:)
208   ! ug(npw_k*nspinor)
209   ! The periodic part of the Bloch wavefunction in reciprocal space.
210 
211   complex(gwpc),allocatable :: ur(:)
212   ! ur(nfft*nspinor)
213   ! The periodic part of the Bloch wavefunction in real space.
214 
215   type(pawcprj_type),allocatable :: Cprj(:,:)
216   ! Cprj(natom,nspinor)
217   ! PAW projected wave function <Proj_i|Cnk> with all NL projectors.
218 
219  end type wave_t
220 
221  public :: wave_init
222  public :: wave_free
223  !public :: wave_bcast
224  public :: wave_copy
225 
226  interface wave_init
227    module procedure wave_init_0D
228  end interface wave_init
229 
230  interface wave_free
231    module procedure wave_free_0D
232    module procedure wave_free_3D
233  end interface wave_free
234 
235  !interface wave_bcast
236  !  module procedure wave_bcast_0D
237  !end interface wave_bcast
238 
239  interface wave_copy
240    module procedure wave_copy_0D
241    module procedure copy_wave_3D
242  end interface wave_copy

m_wfd/wfd_bands_of_rank [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_bands_of_rank

FUNCTION

  Return the list of band index of the ug owned by a given processor at given (k,s).

INPUTS

  Wfd
  rank=The MPI rank of the processor.
  ik_ibz=Index of the k-point in the IBZ
  spin=spin index

OUTPUT

  how_manyb=The number of bands owned by this node
  rank_band_list(Wfd%mband)=The first how_manyb values are the bands treated by the node.

PARENTS

      m_wfd

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

3434 subroutine wfd_bands_of_rank(Wfd,rank,ik_ibz,spin,how_manyb,rank_band_list)
3435 
3436 
3437 !This section has been created automatically by the script Abilint (TD).
3438 !Do not modify the following lines by hand.
3439 #undef ABI_FUNC
3440 #define ABI_FUNC 'wfd_bands_of_rank'
3441 !End of the abilint section
3442 
3443  implicit none
3444 
3445 !Arguments ------------------------------------
3446 !scalars
3447  integer,intent(in) :: ik_ibz,spin,rank
3448  integer,intent(out) :: how_manyb
3449  type(wfd_t),intent(in) :: Wfd
3450 !arrays
3451  integer,intent(out) :: rank_band_list(Wfd%mband)
3452 
3453 !Local variables ------------------------------
3454 !scalars
3455  integer :: band
3456  logical :: it_has
3457 
3458 !************************************************************************
3459 
3460  how_manyb=0; rank_band_list=-1
3461  do band=1,Wfd%nband(ik_ibz,spin)
3462    it_has = wfd_rank_has_ug(Wfd,rank,band,ik_ibz,spin)
3463    if (it_has) then
3464      how_manyb = how_manyb +1
3465      rank_band_list(how_manyb)=band
3466    end if
3467  end do
3468 
3469 end subroutine wfd_bands_of_rank

m_wfd/wfd_barrier [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_barrier

FUNCTION

  Synch all nodes in Wfd%comm.

INPUTS

  Wfd<wfd_t>

PARENTS

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

5394 subroutine wfd_barrier(Wfd)
5395 
5396 
5397 !This section has been created automatically by the script Abilint (TD).
5398 !Do not modify the following lines by hand.
5399 #undef ABI_FUNC
5400 #define ABI_FUNC 'wfd_barrier'
5401 !End of the abilint section
5402 
5403  implicit none
5404 
5405 !Arguments ------------------------------------
5406 !scalars
5407  type(wfd_t),intent(in) :: Wfd
5408 
5409 !************************************************************************
5410 
5411  call xmpi_barrier(Wfd%comm)
5412 
5413 end subroutine wfd_barrier

m_wfd/wfd_bks_distrb [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_bks_distrb

FUNCTION

  Build a local logical table indexed by bands, k-points and spin that defines
  the distribution of the load inside the loops according to the availability of the ug.

INPUTS

  Wfd<wfd_t>=
  [bks_mask(Wfd%mband,Wfd%nkibz,Wfd%nsppol)]=Mask used to skip selecter (b,k,s) entries.
  [got(Wfd%nproc)]=The number of tasks already assigned to the nodes.

OUTPUT

  bks_distrbk(Wfd%mband,Wfd%nkibz,Wfd%nsppol)=Global table with the rank of the node treating (b,k,s)

PARENTS

      wfd_pawrhoij

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

4432 subroutine wfd_bks_distrb(Wfd,bks_distrb,got,bks_mask)
4433 
4434 
4435 !This section has been created automatically by the script Abilint (TD).
4436 !Do not modify the following lines by hand.
4437 #undef ABI_FUNC
4438 #define ABI_FUNC 'wfd_bks_distrb'
4439 !End of the abilint section
4440 
4441  implicit none
4442 
4443 !Arguments ------------------------------------
4444 !scalars
4445  type(wfd_t),intent(in) :: Wfd
4446 !arrays
4447  integer,intent(out) :: bks_distrb(Wfd%mband,Wfd%nkibz,Wfd%nsppol)
4448  integer,optional,intent(inout) :: got(Wfd%nproc)
4449  logical,optional,intent(in) :: bks_mask(Wfd%mband,Wfd%nkibz,Wfd%nsppol)
4450 
4451 !Local variables ------------------------------
4452 !scalars
4453  integer :: ik_ibz,spin,band,how_many,idle
4454  character(len=500) :: msg
4455 !arrays
4456  integer :: get_more(Wfd%nproc),proc_ranks(Wfd%nproc)
4457  logical :: rank_mask(Wfd%nproc)
4458 
4459 !************************************************************************
4460 
4461  get_more=0; if (PRESENT(got)) get_more=got
4462 
4463  ! Initialize the table here to avoid problem with the cycle instruction below.
4464  bks_distrb = xmpi_undefined_rank
4465 
4466  do spin=1,Wfd%nsppol
4467    do ik_ibz=1,Wfd%nkibz
4468      do band=1,Wfd%nband(ik_ibz,spin)
4469        if (PRESENT(bks_mask)) then
4470          if (.not.bks_mask(band,ik_ibz,spin)) CYCLE
4471        end if
4472 
4473        call wfd_who_has_ug(Wfd,band,ik_ibz,spin,how_many,proc_ranks)
4474 
4475        if (how_many==1) then
4476          ! I am the only one owing this band. Add it to list.
4477          bks_distrb(band,ik_ibz,spin) = proc_ranks(1)
4478 
4479        else if (how_many>1) then
4480          ! This band is duplicated. Assign it trying to obtain a good load distribution.
4481          rank_mask=.FALSE.; rank_mask(proc_ranks(1:how_many)+1)=.TRUE.
4482          idle = imin_loc(get_more,mask=rank_mask)
4483          get_more(idle) = get_more(idle) + 1
4484          bks_distrb(band,ik_ibz,spin) = proc_ranks(idle)
4485 
4486        else
4487          call wfd_dump_errinfo(Wfd)
4488          write(msg,'(a,3(i0,1x))')" Nobody has (band, ik_ibz, spin): ",band,ik_ibz,spin
4489          MSG_ERROR(msg)
4490        end if
4491 
4492      end do
4493    end do
4494  end do
4495 
4496  if (PRESENT(got)) got=get_more
4497 
4498 end subroutine wfd_bks_distrb

m_wfd/wfd_change_ngfft [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_change_ngfft

FUNCTION

   Reallocate and reinitialize internal tables for performing FFTs of wavefunctions.

INPUTS

  Cryst<crystal_t>=Info on unit cell.
  Psps<pseudopotential_type>=Pseudopotential info.
  new_ngfft(18)=FFT descriptor for the new FFT mesh.

SIDE EFFECTS

  Wfd<wfd_t>=Wavefunction descriptor with new internal tables for FFT defined by new_ngfft.

PARENTS

      calc_sigc_me,calc_sigx_me,calc_vhxc_me,cchi0,cchi0q0,cchi0q0_intraband
      classify_bands,cohsex_me,exc_build_block,exc_build_ham,exc_plot
      m_bseinterp,m_shirley,m_wfd,prep_calc_ucrpa,screening,sigma,wfd_mkrho
      wfk_analyze

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

5053 subroutine wfd_change_ngfft(Wfd,Cryst,Psps,new_ngfft)
5054 
5055 
5056 !This section has been created automatically by the script Abilint (TD).
5057 !Do not modify the following lines by hand.
5058 #undef ABI_FUNC
5059 #define ABI_FUNC 'wfd_change_ngfft'
5060 !End of the abilint section
5061 
5062  implicit none
5063 
5064 !Arguments ------------------------------------
5065 !scalars
5066  integer,intent(in) :: new_ngfft(18)
5067  type(crystal_t),intent(in) :: Cryst
5068  type(pseudopotential_type),intent(in) :: Psps
5069  type(wfd_t),intent(inout) :: Wfd
5070 !arrays
5071 
5072 !Local variables ------------------------------
5073 !scalars
5074  integer,parameter :: npw0=0
5075  integer :: npw_k,ik_ibz,istwf_k
5076  logical :: iscompatibleFFT
5077  character(len=500) :: msg
5078 !arrays
5079  integer,allocatable :: kg_k(:,:)
5080 
5081 !************************************************************************
5082 
5083  DBG_ENTER("COLL")
5084 
5085  !@wfd_t
5086  if ( ALL(Wfd%ngfft(1:3) == new_ngfft(1:3)) ) RETURN ! Nothing to do.
5087 
5088  if (Wfd%prtvol > 0) then
5089    write(msg,"(a,3(i0,1x),a,3(i0,1x),a)")"Changing FFT mesh: [",Wfd%ngfft(1:3),"] ==> [",new_ngfft(1:3),"]"
5090    MSG_COMMENT(msg)
5091  end if
5092  !
5093  ! Change FFT dimensions.
5094  Wfd%ngfft  = new_ngfft
5095  Wfd%mgfft  = MAXVAL(new_ngfft(1:3))
5096  Wfd%nfftot = PRODUCT(new_ngfft(1:3))
5097  Wfd%nfft   = Wfd%nfftot ! No FFT parallelism.
5098 
5099  !Re-initialize fft distribution
5100  call destroy_distribfft(Wfd%MPI_enreg%distribfft)
5101  call init_distribfft(Wfd%MPI_enreg%distribfft,'c',Wfd%MPI_enreg%nproc_fft,new_ngfft(2),new_ngfft(3))
5102 
5103  if (allocated(Wfd%ph1d)) then
5104    ABI_FREE(Wfd%ph1d)
5105  end if
5106 
5107  ABI_MALLOC(Wfd%ph1d,(2,3*(2*Wfd%mgfft+1)*Cryst%natom))
5108  call getph(Cryst%atindx,Cryst%natom,Wfd%ngfft(1),Wfd%ngfft(2),Wfd%ngfft(3),Wfd%ph1d,Cryst%xred)
5109  !
5110  ! Recalculate FFT tables.
5111  ! Calculate the FFT index of $ R^{-1} (r-\tau) $ used to symmetrize u_Rk.
5112  if (allocated(Wfd%irottb)) then
5113    ABI_FREE(Wfd%irottb)
5114  end if
5115 
5116  ABI_MALLOC(Wfd%irottb,(Wfd%nfftot,Cryst%nsym))
5117  call rotate_FFT_mesh(Cryst%nsym,Cryst%symrel,Cryst%tnons,Wfd%ngfft,Wfd%irottb,iscompatibleFFT)
5118 
5119  if (.not.iscompatibleFFT) then
5120    msg = "Real space FFT mesh not compatible with symmetries. Wavefunction symmetrization should not be done in real space!"
5121    MSG_WARNING(msg)
5122  end if
5123  !
5124  ! Is the new real space FFT mesh compatible with the rotational part?
5125  Wfd%rfft_is_symok = check_rot_fft(Cryst%nsym,Cryst%symrel,Wfd%ngfft(1),Wfd%ngfft(2),Wfd%ngfft(3))
5126  !
5127  ! Reallocate ur buffers with correct dimensions.
5128  call wave_free_3D(Wfd%Wave,what="R")
5129 
5130  ! Reinit Kdata_t
5131  do ik_ibz=1,Wfd%nkibz
5132    if (wfd_ihave_ug(Wfd,0,ik_ibz,0)) then
5133      istwf_k = Wfd%istwfk(ik_ibz)
5134      npw_k   = Wfd%Kdata(ik_ibz)%npw
5135      ABI_MALLOC(kg_k,(3,npw_k))
5136      kg_k = Wfd%Kdata(ik_ibz)%kg_k
5137      call kdata_free(Wfd%Kdata(ik_ibz))
5138      call kdata_init(Wfd%Kdata(ik_ibz),Cryst,Psps,Wfd%kibz(:,ik_ibz),istwf_k,new_ngfft,Wfd%MPI_enreg,kg_k=kg_k)
5139      ABI_FREE(kg_k)
5140    end if
5141  end do
5142 
5143  DBG_EXIT("COLL")
5144 
5145 end subroutine wfd_change_ngfft

m_wfd/wfd_copy [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_copy

FUNCTION

  Duplicates a wfd_t data type.

PARENTS

      screening,sigma

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

1269 subroutine wfd_copy(Wfd_in,Wfd_out)
1270 
1271 
1272 !This section has been created automatically by the script Abilint (TD).
1273 !Do not modify the following lines by hand.
1274 #undef ABI_FUNC
1275 #define ABI_FUNC 'wfd_copy'
1276 !End of the abilint section
1277 
1278  implicit none
1279 
1280 !Arguments ------------------------------------
1281  type(wfd_t),intent(inout) :: Wfd_in,Wfd_out
1282 !Local variables ------------------------------
1283 !scalars
1284  integer :: band, ik_ibz, spin
1285 
1286 !************************************************************************
1287 
1288  DBG_ENTER("COLL")
1289 
1290  !@wfd_t
1291  call deep_copy(Wfd_in%id             ,Wfd_out%id)
1292  call deep_copy(Wfd_in%debug_level    ,Wfd_out%debug_level)
1293  call deep_copy(Wfd_in%lmnmax         ,Wfd_out%lmnmax)
1294  call deep_copy(Wfd_in%mband          ,Wfd_out%mband)
1295  call deep_copy(Wfd_in%mgfft          ,Wfd_out%mgfft)
1296  call deep_copy(Wfd_in%natom          ,Wfd_out%natom)
1297  call deep_copy(Wfd_in%nfft           ,Wfd_out%nfft)
1298  call deep_copy(Wfd_in%nfftot         ,Wfd_out%nfftot)
1299  call deep_copy(Wfd_in%nkibz          ,Wfd_out%nkibz)
1300  call deep_copy(Wfd_in%npwwfn         ,Wfd_out%npwwfn)
1301  call deep_copy(Wfd_in%nspden         ,Wfd_out%nspden)
1302  call deep_copy(Wfd_in%nspinor        ,Wfd_out%nspinor)
1303  call deep_copy(Wfd_in%nsppol         ,Wfd_out%nsppol)
1304  call deep_copy(Wfd_in%ntypat         ,Wfd_out%ntypat)
1305  call deep_copy(Wfd_in%paral_kgb      ,Wfd_out%paral_kgb)
1306  call deep_copy(Wfd_in%usepaw         ,Wfd_out%usepaw)
1307  call deep_copy(Wfd_in%prtvol         ,Wfd_out%prtvol)
1308  call deep_copy(Wfd_in%pawprtvol      ,Wfd_out%pawprtvol)
1309  call deep_copy(Wfd_in%usewvl         ,Wfd_out%usewvl)
1310  call deep_copy(Wfd_in%comm           ,Wfd_out%comm)
1311  call deep_copy(Wfd_in%master         ,Wfd_out%master)
1312  call deep_copy(Wfd_in%my_rank        ,Wfd_out%my_rank)
1313  call deep_copy(Wfd_in%nproc          ,Wfd_out%nproc)
1314  call deep_copy(Wfd_in%rfft_is_symok  ,Wfd_out%rfft_is_symok)
1315  call deep_copy(Wfd_in%dilatmx        ,Wfd_out%dilatmx)
1316  call deep_copy(Wfd_in%ecut           ,Wfd_out%ecut)
1317  call deep_copy(Wfd_in%ecutsm         ,Wfd_out%ecutsm)
1318  call deep_copy(Wfd_in%gamma_centered ,Wfd_out%gamma_centered)
1319 
1320 !arrays
1321  Wfd_out%ngfft =Wfd_in%ngfft
1322  Wfd_out%nloalg=Wfd_in%nloalg
1323 
1324  call alloc_copy(Wfd_in%gvec          ,Wfd_out%gvec)
1325  call alloc_copy(Wfd_in%irottb        ,Wfd_out%irottb)
1326  call alloc_copy(Wfd_in%istwfk        ,Wfd_out%istwfk)
1327  call alloc_copy(Wfd_in%nband         ,Wfd_out%nband)
1328  call alloc_copy(Wfd_in%indlmn        ,Wfd_out%indlmn)
1329  call alloc_copy(Wfd_in%nlmn_atm      ,Wfd_out%nlmn_atm)
1330  call alloc_copy(Wfd_in%nlmn_sort     ,Wfd_out%nlmn_sort)
1331  call alloc_copy(Wfd_in%nlmn_type     ,Wfd_out%nlmn_type)
1332  call alloc_copy(Wfd_in%npwarr        ,Wfd_out%npwarr)
1333  call alloc_copy(Wfd_in%kibz          ,Wfd_out%kibz)
1334  call alloc_copy(Wfd_in%bks_tab       ,Wfd_out%bks_tab)
1335  call alloc_copy(Wfd_in%bks_comm      ,Wfd_out%bks_comm)
1336  call alloc_copy(Wfd_in%ph1d          ,Wfd_out%ph1d)
1337  call alloc_copy(Wfd_in%keep_ur       ,Wfd_out%keep_ur)
1338 
1339 ! types
1340  if (size(Wfd_in%Kdata,DIM=1) .ne. size(Wfd_out%Kdata,DIM=1)) then
1341   if (allocated(Wfd_out%Kdata))  then
1342     ABI_DT_FREE(Wfd_out%Kdata)
1343   end if
1344   ABI_DT_MALLOC(Wfd_out%Kdata,(Wfd_out%nkibz))
1345  end if
1346 
1347  call kdata_copy(Wfd_in%Kdata,Wfd_out%Kdata)
1348 
1349  if (size(Wfd_in%Wave) .ne. size(Wfd_out%Wave)) then
1350   if (allocated(Wfd_out%Wave))  then
1351     ABI_DT_FREE(Wfd_out%Wave)
1352   end if
1353   ABI_DT_MALLOC(Wfd_out%Wave,(Wfd_out%mband,Wfd_out%nkibz,Wfd_out%nsppol))
1354  end if
1355  do spin = LBOUND(Wfd_in%Wave,DIM=3), UBOUND(Wfd_in%Wave,DIM=3)
1356    do ik_ibz = LBOUND(Wfd_in%Wave,DIM=2), UBOUND(Wfd_in%Wave,DIM=2)
1357      do band = LBOUND(Wfd_in%Wave,DIM=1), UBOUND(Wfd_in%Wave,DIM=1)
1358        if (Wfd_in%bks_tab(band,ik_ibz,spin,Wfd_in%my_rank) .gt. 0) then
1359          call wave_copy_0D(Wfd_in%Wave(band,ik_ibz,spin), Wfd_out%Wave(band,ik_ibz,spin))
1360        end if
1361      end do
1362    end do
1363  end do
1364 
1365  call copy_mpi_enreg(Wfd_in%MPI_enreg,Wfd_out%MPI_enreg)
1366 
1367 end subroutine wfd_copy

m_wfd/wfd_copy_cg [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_copy_cg

FUNCTION

  Return a copy u(g) in a real(dp) array. Useful if we have to interface
  the wavefunction descriptor with Abinit code expecting cg(2,npw_k*nspinor) arrays
  The routine takes also into account the fact that the ug in wfs could be stored in single-precision.

INPUTS

  wfd<wfd_t>=the wavefunction descriptor.
  band=Band index.
  ik_ibz=Index of the k-point in the IBZ.
  spin=Spin index

OUTPUT

  cg(npw_k*nspinor)=The wavefunction in real space in the Abinit cg convention.

PARENTS

      m_gkk,m_phgamma,m_phpi,m_sigmaph

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

1711 subroutine wfd_copy_cg(wfd,band,ik_ibz,spin,cg)
1712 
1713 
1714 !This section has been created automatically by the script Abilint (TD).
1715 !Do not modify the following lines by hand.
1716 #undef ABI_FUNC
1717 #define ABI_FUNC 'wfd_copy_cg'
1718 !End of the abilint section
1719 
1720  implicit none
1721 
1722 !Arguments ------------------------------------
1723 !scalars
1724  integer,intent(in) :: band,ik_ibz,spin
1725  type(wfd_t),intent(in) :: wfd
1726 !arrays
1727  real(dp),intent(out) :: cg(2,*) ! npw_k*wfd%nspinor)
1728 
1729 !Local variables ------------------------------
1730 !scalars
1731  integer :: siz
1732  character(len=500) :: msg
1733 !************************************************************************
1734 
1735  if (wfd%debug_level > 0) then
1736    if (.not. wfd_ihave_ug(wfd,band,ik_ibz,spin,"Stored")) then
1737      write(msg,'(a,3(i0,1x),a)')" ug for (band, ik_ibz, spin): ",band,ik_ibz,spin," is not stored in memory!"
1738      MSG_ERROR(msg)
1739    end if
1740  end if
1741 
1742  siz = wfd%npwarr(ik_ibz) * wfd%nspinor
1743 #ifdef HAVE_GW_DPC
1744  call zcopy(siz, wfd%wave(band,ik_ibz,spin)%ug, 1, cg, 1)
1745 #else
1746  cg(1,1:siz) = dble(wfd%wave(band,ik_ibz,spin)%ug)
1747  cg(2,1:siz) = aimag(wfd%wave(band,ik_ibz,spin)%ug)
1748 #endif
1749 
1750 end subroutine wfd_copy_cg

m_wfd/wfd_distribute_bands [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_distribute_bands

FUNCTION

  Distribute a set of bands taking into account the distribution of the ug.

INPUTS

  band=the index of the band.
  ik_ibz=Index of the k-point in the IBZ
  spin=spin index
  [got(Wfd%nproc)]=The number of tasks already assigned to the nodes.
  [bmask(Wfd%mband)]=The routine will raise an error if one band index
    is not treated by any processor. bmask can be used to select the subset of
    indices that are expected to be available.

OUTPUT

   my_nband=The number of bands that will be treated by this node.
   my_band_list(1:my_nband)=The band indices for this node

PARENTS

      cchi0q0_intraband,m_sigma,m_wfd,sigma

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

4126 subroutine wfd_distribute_bands(Wfd,ik_ibz,spin,my_nband,my_band_list,got,bmask)
4127 
4128 
4129 !This section has been created automatically by the script Abilint (TD).
4130 !Do not modify the following lines by hand.
4131 #undef ABI_FUNC
4132 #define ABI_FUNC 'wfd_distribute_bands'
4133 !End of the abilint section
4134 
4135  implicit none
4136 
4137 !Arguments ------------------------------------
4138 !scalars
4139  integer,intent(in) :: ik_ibz,spin
4140  integer,intent(out) :: my_nband
4141  type(wfd_t),intent(in) :: Wfd
4142 !arrays
4143  integer,intent(out) :: my_band_list(Wfd%mband)
4144  integer,optional,intent(inout) :: got(Wfd%nproc)
4145  logical,optional,intent(in) :: bmask(Wfd%mband)
4146 
4147 !Local variables ------------------------------
4148 !scalars
4149  integer :: band,how_many,idle
4150  character(len=500) :: msg
4151 !arrays
4152  integer :: proc_ranks(Wfd%nproc),get_more(Wfd%nproc)
4153  logical :: rank_mask(Wfd%nproc)
4154 
4155 !************************************************************************
4156 
4157  my_nband=0; my_band_list=0
4158  get_more=0; if (PRESENT(got)) get_more = got
4159 
4160  do band=1,Wfd%nband(ik_ibz,spin)
4161    if (PRESENT(bmask)) then
4162      if (.not.bmask(band)) CYCLE
4163    end if
4164 
4165    call wfd_who_has_ug(Wfd,band,ik_ibz,spin,how_many,proc_ranks)
4166 
4167    if (how_many==1) then ! I am the only one owing this band. Add it to list.
4168      if (proc_ranks(1) == Wfd%my_rank) then
4169        my_nband=my_nband + 1
4170        my_band_list(my_nband) = band
4171      end if
4172    else if (how_many>1) then  ! This band is duplicated. Assign it trying to obtain a good load distribution.
4173      rank_mask=.FALSE.; rank_mask(proc_ranks(1:how_many)+1)=.TRUE.
4174      idle = imin_loc(get_more,mask=rank_mask)
4175      get_more(idle) = get_more(idle) + 1
4176      if (Wfd%my_rank==idle-1) then
4177        my_nband=my_nband + 1
4178        my_band_list(my_nband) = band
4179      end if
4180    else
4181      write(msg,'(a,3(i0,1x))')" No processor has (band, ik_ibz, spin): ",band,ik_ibz,spin
4182      MSG_ERROR(msg)
4183    end if
4184  end do
4185 
4186  if (PRESENT(got)) got = get_more
4187 
4188 end subroutine wfd_distribute_bands

m_wfd/wfd_distribute_bbp [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_distribute_bbp

FUNCTION

  Distribute a set of (b,b') indices taking into account the MPI distribution of the ug.
  It is used to calculate matrix elements of the form <b,k,s|O|b',k,s>

INPUTS

  Wfd<wfd_t>=
  ik_ibz=The index of the k-point in the IBZ.
  spin=Spin index.
  allup=String used to select or not the upper triangle. Possible values:
    "All"  =Entire (b,b') matrix will be distributed.
    "Upper"=Only the upper triangle is distributed.
  [got(%nproc)]=The number of tasks already assigned to the nodes. Used to optimize the work load.
    Be careful when this routine is called inside several loops since each node should call the routine
    at each iteration with the same (local) copy of got so that bbp_distrb will assume the same value on each node.
  [bbp_mask(%mband,%mband)]= mask used to select a subset of (b,b') indices.

OUTPUT

  my_nbbp=The number of (b,b') indices treated by this node.
  bbp_distrb(%mband%mband)=The rank of the node that will treat (b,b').

PARENTS

      calc_optical_mels,calc_vhxc_me,cchi0q0

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

4706 subroutine wfd_distribute_bbp(Wfd,ik_ibz,spin,allup,my_nbbp,bbp_distrb,got,bbp_mask)
4707 
4708 
4709 !This section has been created automatically by the script Abilint (TD).
4710 !Do not modify the following lines by hand.
4711 #undef ABI_FUNC
4712 #define ABI_FUNC 'wfd_distribute_bbp'
4713 !End of the abilint section
4714 
4715  implicit none
4716 
4717 !Arguments ------------------------------------
4718 !scalars
4719  integer,intent(in) :: ik_ibz,spin
4720  integer,intent(out) :: my_nbbp
4721  type(wfd_t),intent(in) :: Wfd
4722  character(len=*),intent(in) :: allup
4723 !arrays
4724  integer,intent(out) :: bbp_distrb(Wfd%mband,Wfd%mband)
4725  integer,optional,intent(inout) :: got(Wfd%nproc)
4726  logical,optional,intent(in) :: bbp_mask(Wfd%mband,Wfd%mband)
4727 
4728 !Local variables ------------------------------
4729 !arrays
4730  integer :: loc_got(Wfd%nproc)
4731 
4732 !************************************************************************
4733 
4734  ! Just a wrapper around wfd_distribute_kb_kpbp.
4735  loc_got=0; if (PRESENT(got)) loc_got = got
4736 
4737  if (PRESENT(bbp_mask)) then
4738    call wfd_distribute_kb_kpbp(Wfd,ik_ibz,ik_ibz,spin,allup,my_nbbp,bbp_distrb,loc_got,bbp_mask)
4739  else
4740    call wfd_distribute_kb_kpbp(Wfd,ik_ibz,ik_ibz,spin,allup,my_nbbp,bbp_distrb,loc_got)
4741  end if
4742 
4743 end subroutine wfd_distribute_bbp

m_wfd/wfd_distribute_kb_kpbp [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_distribute_kb_kpbp

FUNCTION

  This routines distributes as set of (b,b') indices taking into account the MPI distribution of the ug.
  It is used to calculate matrix elements of the form <b,k,s|O|b',k',s>

INPUTS

  Wfd<wfd_t>=
  ik_ibz =The index of the k-point k  in the IBZ.
  ikp_ibz=The index of the k-point k' in the IBZ.
  spin=Spin index.
  allup=String used to select the upper triangle of the (b,b') matrix. Possible values:
    "All"  =Entire (b,b') matrix will be distributed.
    "Upper"=Only the upper triangle is distributed.
  [got(%nproc)]=The number of tasks already assigned to the nodes. Used to optimize the distribution of the tasks.
    Be careful when this routine is called inside several loops since each node should call the routine
    at each iteration with the same (local) copy of got so that bbp_distrb will assume the same value on each node.
  [bbp_mask(%mband,%mband)]= mask used to select a subset of (b,b') indices.

OUTPUT

  my_nbbp=The number of (b,b') indices treated by this node.
  bbp_distrb(%mband%mband)=The rank of the node that will treat (b,b').

PARENTS

      cchi0,m_wfd

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

4784 subroutine wfd_distribute_kb_kpbp(Wfd,ik_ibz,ikp_ibz,spin,allup,my_nbbp,bbp_distrb,got,bbp_mask)
4785 
4786 
4787 !This section has been created automatically by the script Abilint (TD).
4788 !Do not modify the following lines by hand.
4789 #undef ABI_FUNC
4790 #define ABI_FUNC 'wfd_distribute_kb_kpbp'
4791 !End of the abilint section
4792 
4793  implicit none
4794 
4795 !Arguments ------------------------------------
4796 !scalars
4797  integer,intent(in) :: ik_ibz,ikp_ibz,spin
4798  integer,intent(out) :: my_nbbp
4799  type(wfd_t),intent(in) :: Wfd
4800  character(len=*),intent(in) :: allup
4801 !arrays
4802  integer,intent(out) :: bbp_distrb(Wfd%mband,Wfd%mband)
4803  integer,optional,intent(inout) :: got(Wfd%nproc)
4804  logical,optional,intent(in) :: bbp_mask(Wfd%mband,Wfd%mband)
4805 
4806 !Local variables ------------------------------
4807 !scalars
4808  integer :: my_nband,ib1,ib2,pcb2,pcb1,howmany_b,howmany_bp,workload_min
4809  integer :: rank,ncpus,idle,b1_stop,ierr
4810  character(len=500) :: msg
4811 !arrays
4812  integer :: rank_bandlist_k(Wfd%mband),rank_bandlist_kp(Wfd%mband)
4813  integer :: get_more(Wfd%nproc),my_band_list_k(Wfd%mband)
4814  integer,allocatable :: whocan_k(:,:),whocan_kp(:,:)
4815  logical :: b_mask(Wfd%mband)
4816 
4817 !************************************************************************
4818 
4819  ABI_STAT_MALLOC(whocan_k ,(Wfd%mband,Wfd%nproc), ierr)
4820  ABI_CHECK(ierr==0, "out of memory in whocan_k")
4821  ABI_STAT_MALLOC(whocan_kp,(Wfd%mband,Wfd%nproc), ierr)
4822  ABI_CHECK(ierr==0, "out of memory in whocan_kp")
4823  whocan_k =0 !  Will be set to 1 if this node can calculate something containing (k,b)
4824  whocan_kp=0 !  Will be set to 1 if this node can calculate something containing (kp,bp)
4825 
4826  do rank=0,Wfd%nproc-1
4827 
4828    call wfd_bands_of_rank(Wfd,rank,ik_ibz ,spin,howmany_b, rank_bandlist_k )
4829    do pcb1=1,howmany_b
4830      ib1 = rank_bandlist_k(pcb1)
4831      whocan_k(ib1,rank+1) = 1
4832    end do
4833 
4834    call wfd_bands_of_rank(Wfd,rank,ikp_ibz,spin,howmany_bp,rank_bandlist_kp)
4835    do pcb2=1,howmany_bp
4836      ib2 = rank_bandlist_kp(pcb2)
4837      whocan_kp(ib2,rank+1) = 1
4838    end do
4839 
4840  end do
4841 
4842  get_more=0; if (PRESENT(got)) get_more=got
4843  b1_stop=Wfd%nband(ik_ibz,spin)
4844 
4845  bbp_distrb = xmpi_undefined_rank
4846 
4847  do ib2=1,Wfd%nband(ikp_ibz,spin)
4848    b_mask = .TRUE.; if (PRESENT(bbp_mask)) b_mask = bbp_mask(:,ib2)
4849    if (ANY(b_mask)) then
4850      my_nband=0; my_band_list_k=0
4851      if (firstchar(allup,(/"U","u"/))) b1_stop = MIN(ib2,Wfd%nband(ik_ibz,spin)) ! Only the upper triangle of the (b1,b2) matrix.
4852 
4853      do ib1=1,b1_stop
4854        if (b_mask(ib1)) then
4855          !
4856          ! find which CPUs can do the calculation (k,b)->(kp,bp)
4857          ! find the one which is less busy
4858          ncpus=0
4859          workload_min=HUGE(0)
4860          do rank=0,Wfd%nproc-1
4861            if( whocan_k(ib1,rank+1)==1 .AND.  whocan_kp(ib2,rank+1)==1 ) then
4862              ncpus=ncpus+1
4863              if( get_more(rank+1) < workload_min ) then
4864                idle=rank+1
4865                workload_min=get_more(idle)
4866              end if
4867 
4868            end if
4869          end do
4870 
4871          if(ncpus>0) then
4872            bbp_distrb(ib1,ib2)=idle-1
4873            get_more(idle) = get_more(idle) + 1
4874 
4875          else
4876            call wfd_dump_errinfo(Wfd)
4877            write(msg,'(a,5(i0,1x))')" Nobody has (band1, ik_ibz) (band2, ikp_ibz) spin: ",ib1,ik_ibz,ib2,ikp_ibz,spin
4878            MSG_ERROR(msg)
4879          end if
4880 
4881        end if
4882      end do ! ib1
4883    end if
4884  end do ! ib2
4885 
4886  ABI_FREE(whocan_k)
4887  ABI_FREE(whocan_kp)
4888 
4889  my_nbbp = COUNT(bbp_distrb==Wfd%my_rank)
4890  if (PRESENT(got)) got=get_more
4891 
4892 end subroutine wfd_distribute_kb_kpbp

m_wfd/wfd_dump_errinfo [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_dump_errinfo

FUNCTION

INPUTS

  Wfd<wfd_t>=

OUTPUT

PARENTS

      m_wfd

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

4617 subroutine wfd_dump_errinfo(Wfd,onfile)
4618 
4619 
4620 !This section has been created automatically by the script Abilint (TD).
4621 !Do not modify the following lines by hand.
4622 #undef ABI_FUNC
4623 #define ABI_FUNC 'wfd_dump_errinfo'
4624 !End of the abilint section
4625 
4626  implicit none
4627 
4628 !Arguments ------------------------------------
4629 !scalars
4630  logical,optional,intent(in) :: onfile
4631  type(wfd_t),intent(in) :: Wfd
4632 !arrays
4633 
4634 !Local variables ------------------------------
4635 !scalars
4636  integer :: ik_ibz,spin,band,how_manyb,unt_dbg
4637  character(len=10) :: strank
4638  character(len=500) :: msg
4639  character(len=fnlen) :: fname_dbg
4640 !arrays
4641  integer :: my_band_list(Wfd%mband)
4642 
4643 !************************************************************************
4644 
4645  unt_dbg=std_out
4646 
4647  if (PRESENT(onfile)) then
4648    if (onfile) then
4649      call int2char10(Wfd%my_rank,strank)
4650      fname_dbg = "WFD_DEBUG_RANK"//TRIM(strank)
4651      if (open_file(fname_dbg,msg,newunit=unt_dbg,form="formatted") /= 0) then
4652        MSG_ERROR(msg)
4653      end if
4654    end if
4655  end if
4656 
4657  write(unt_dbg,*)" (k,b,s) states owned by rank: ",Wfd%my_rank
4658  do spin=1,Wfd%nsppol
4659    do ik_ibz=1,Wfd%nkibz
4660       write(unt_dbg,*)" ug stored at (ik_ibz, spin) ",ik_ibz,spin
4661       call wfd_mybands(Wfd,ik_ibz,spin,how_manyb,my_band_list,"Stored")
4662       write(unt_dbg,*) (my_band_list(band),band=1,how_manyb)
4663     end do
4664  end do
4665 
4666 end subroutine wfd_dump_errinfo

m_wfd/wfd_everybody_has_ug [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_everybody_has_ug

FUNCTION

  Return .TRUE. if all the nodes inside comm own the specified ug state.

INPUTS

  band=the index of the band.
  ik_ibz=Index of the k-point in the IBZ
  spin=spin index

PARENTS

SOURCE

3868 function wfd_everybody_has_ug(Wfd,band,ik_ibz,spin) result(answer)
3869 
3870 
3871 !This section has been created automatically by the script Abilint (TD).
3872 !Do not modify the following lines by hand.
3873 #undef ABI_FUNC
3874 #define ABI_FUNC 'wfd_everybody_has_ug'
3875 !End of the abilint section
3876 
3877  implicit none
3878 
3879 !Arguments ------------------------------------
3880 !scalars
3881  integer,intent(in) :: band,ik_ibz,spin
3882  logical :: answer
3883  type(wfd_t),intent(in) :: Wfd
3884 
3885 !Local variables ------------------------------
3886 !scalars
3887  integer :: how_many,nzeros,ib
3888 !arrays
3889  integer :: proc_ranks(Wfd%nproc),indices(3)
3890 
3891 !************************************************************************
3892 
3893  indices = (/band,ik_ibz,spin/)
3894 
3895  if ( ALL(indices/=(/0,0,0/)) ) then
3896    call wfd_who_has_ug(Wfd,band,ik_ibz,spin,how_many,proc_ranks)
3897    answer = (how_many==Wfd%nproc); RETURN
3898  else
3899    nzeros = COUNT(indices==0)
3900    if (nzeros==3) MSG_ERROR("All indices are zero!")
3901 
3902    answer=.TRUE.
3903    MSG_WARNING("Some cases are not coded!") ! TODO
3904 
3905    if (band==0) then
3906 
3907      if (nzeros==1)  then     ! All the bands for the given k-point and spin?
3908        ib=0
3909        do while(answer.and.ib<Wfd%nband(ik_ibz,spin))
3910          ib=ib+1
3911          call wfd_who_has_ug(Wfd,ib,ik_ibz,spin,how_many,proc_ranks)
3912          answer = (how_many==Wfd%nproc)
3913        end do; RETURN
3914 
3915      else if (ik_ibz==0) then ! All the bands and all the k-points for the the given spin?
3916 
3917      else if (spin==0) then   ! All the bands and all the spins for the given k-point?
3918 
3919      end if
3920 
3921    else if (ik_ibz==0) then
3922      if (nzeros==1) then     ! All the k-points for the the given band and spin?
3923 
3924      else if (band==0) then  ! All the k-points and all the bands for the the given spin?
3925 
3926      else if (spin==0) then  ! All the k-points and all the spins for the the given band?
3927 
3928      end if
3929 
3930    else
3931      if (nzeros==1) then      ! All the spins for the the given band and k-point?
3932 
3933      else if (ik_ibz==0) then ! All the spins and all the k-points for the the given band?
3934 
3935      else if (band==0) then   ! All the spins and all the bands for the the given k-point?
3936 
3937      end if
3938    end if
3939 
3940    MSG_ERROR("Not implemented error")
3941  end if
3942 
3943 end function wfd_everybody_has_ug

m_wfd/wfd_extract_cgblock [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_extract_cgblock

FUNCTION

  This routine extract a block of wavefunctions for a given spin and k-points.
  The wavefunctions are stored in a real(dp) array with the same convention
  as the one used in the GS part of Abinit, i.e cg_block(2,nspinor*npw_k*num_bands)

INPUTS

   Wfd<wfd_t>=Wavefunction descriptor.
   band_list(:)=List of bands to extract
   ik_ibz=k-point index
   spin=Spin index.

OUTPUT

   cgblock(nspinor*npw_k*num_bands)=A contiguous block of memory with the set of u(g)

PARENTS

      m_wfd

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

2785 subroutine wfd_extract_cgblock(Wfd,band_list,ik_ibz,spin,cgblock)
2786 
2787 
2788 !This section has been created automatically by the script Abilint (TD).
2789 !Do not modify the following lines by hand.
2790 #undef ABI_FUNC
2791 #define ABI_FUNC 'wfd_extract_cgblock'
2792 !End of the abilint section
2793 
2794  implicit none
2795 
2796 !Arguments ------------------------------------
2797 !scalars
2798  integer,intent(in) :: ik_ibz,spin
2799  type(wfd_t),intent(in) :: Wfd
2800 !arrays
2801  integer,intent(in) :: band_list(:)
2802  real(dp),intent(out) :: cgblock(:,:)
2803 
2804 !Local variables ------------------------------
2805 !scalars
2806  integer :: ii,band,start,istop,npw_k
2807  character(len=500) :: msg
2808 
2809 !************************************************************************
2810 
2811  npw_k = Wfd%npwarr(ik_ibz)
2812 
2813  if (size(cgblock, dim=1)/=2) then
2814    MSG_ERROR("Wrong size(1) in assumed shape array")
2815  end if
2816 
2817  if (size(cgblock, dim=2)/=Wfd%nspinor* npw_k * size(band_list)) then
2818    MSG_ERROR("Wrong size in assumed shape array")
2819  end if
2820 
2821  start = 1
2822  do ii=1,size(band_list)
2823    band = band_list(ii)
2824    if (Wfd%Wave(band,ik_ibz,spin)%has_ug /= WFD_STORED) then
2825      write(msg,"(3(a,i0),a)")"u(g) for band: ",band,", ik_ibz: ",ik_ibz,", spin: ",spin," is not stored!"
2826      MSG_ERROR(msg)
2827    end if
2828    istop = start + Wfd%nspinor*npw_k - 1
2829    cgblock(1,start:istop) = REAL(Wfd%Wave(band,ik_ibz,spin)%ug)
2830    cgblock(2,start:istop) = AIMAG(Wfd%Wave(band,ik_ibz,spin)%ug)
2831    start = start + Wfd%nspinor * npw_k
2832  end do
2833 
2834 end subroutine wfd_extract_cgblock

m_wfd/wfd_free [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_free

FUNCTION

  Free the memory allocated in the wfd_t data type.

PARENTS

      bethe_salpeter,m_gkk,m_phgamma,m_phpi,m_shirley,m_sigmaph,screening
      sigma,wfk_analyze

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

1161 subroutine wfd_free(Wfd)
1162 
1163 
1164 !This section has been created automatically by the script Abilint (TD).
1165 !Do not modify the following lines by hand.
1166 #undef ABI_FUNC
1167 #define ABI_FUNC 'wfd_free'
1168 !End of the abilint section
1169 
1170  implicit none
1171 
1172 !Arguments ------------------------------------
1173 !scalars
1174  type(wfd_t),intent(inout) :: Wfd
1175 !************************************************************************
1176 
1177  DBG_ENTER("COLL")
1178 
1179  !@wfd_t
1180  ! integer.
1181  if (allocated(Wfd%gvec)) then
1182    ABI_FREE(Wfd%gvec)
1183  end if
1184  if (allocated(Wfd%irottb)) then
1185    ABI_FREE(Wfd%irottb)
1186  end if
1187  if (allocated(Wfd%istwfk)) then
1188    ABI_FREE(Wfd%istwfk)
1189  end if
1190  if (allocated(Wfd%nband)) then
1191    ABI_FREE(Wfd%nband)
1192  end if
1193  if (allocated(Wfd%indlmn)) then
1194    ABI_FREE(Wfd%indlmn)
1195  end if
1196  if (allocated(Wfd%nlmn_atm)) then
1197    ABI_FREE(Wfd%nlmn_atm)
1198  end if
1199  if (allocated(Wfd%nlmn_sort)) then
1200    ABI_FREE(Wfd%nlmn_sort)
1201  end if
1202  if (allocated(Wfd%nlmn_type)) then
1203    ABI_FREE(Wfd%nlmn_type)
1204  end if
1205  if (allocated(Wfd%npwarr)) then
1206    ABI_FREE(Wfd%npwarr)
1207  end if
1208  if (allocated(Wfd%bks_tab)) then
1209    ABI_FREE(Wfd%bks_tab)
1210  end if
1211 
1212  ! Free the MPI communicators.
1213  if (allocated(Wfd%bks_comm)) then
1214    call xmpi_comm_free(Wfd%bks_comm)
1215    ABI_FREE(Wfd%bks_comm)
1216  end if
1217 
1218  ! real arrays.
1219  if (allocated(Wfd%kibz)) then
1220    ABI_FREE(Wfd%kibz)
1221  end if
1222  if (allocated(Wfd%ph1d)) then
1223    ABI_FREE(Wfd%ph1d)
1224  end if
1225  !
1226  ! logical arrays.
1227  if (allocated(Wfd%keep_ur)) then
1228    ABI_FREE(Wfd%keep_ur)
1229  end if
1230  !
1231  ! datatypes.
1232  if (allocated(Wfd%Kdata)) then
1233    call kdata_free(Wfd%Kdata)
1234    ABI_DT_FREE(Wfd%Kdata)
1235  end if
1236 
1237  if (allocated(Wfd%Wave)) then
1238    call wave_free(Wfd%Wave)
1239    ABI_DT_FREE(Wfd%Wave)
1240  end if
1241 
1242  call destroy_mpi_enreg(Wfd%MPI_enreg)
1243 
1244  DBG_EXIT("COLL")
1245 
1246 end subroutine wfd_free

m_wfd/wfd_from_wfk [ Functions ]

[ Top ] [ Functions ]

NAME

 wfd_from_wfk

FUNCTION

  This routine opens the specified WFK file, initializes the wavefunction descriptor with the
  values reported in the header and reads the wavefunctions from file. The API is very simple
  and it does not allow the user to specify how the wavefunctions should be MPI distributed.
  All the wavefunction are stored on each node, only the spin is distributed.

INPUTS

  wfk_fname=Name of the WFK file.
  iomode=Option specifying the fileformat as well as the IO mode to be used.
  Psps<pseudopotential_type>=variables related to pseudopotentials
  Pawtab(ntypat*usepaw)<type(pawtab_type)>=paw tabulated starting data.
  ngfft(18)=Information about 3D FFT, see ~abinit/doc/variables/vargs.htm#ngfft
  nloalg(3)=Governs the choice of the algorithm for nonlocal operator. See doc.
  keep_ur=Logical flag defining whether the set of u(r) should be saved in memory
  comm=MPI communicator

OUTPUT

  Wfd<wfd_t>=Initialized wavefunction descritptor.

PARENTS

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

6132 subroutine wfd_from_wfk(Wfd,wfk_fname,iomode,Psps,Pawtab,ngfft,nloalg,keep_ur,comm)
6133 
6134 
6135 !This section has been created automatically by the script Abilint (TD).
6136 !Do not modify the following lines by hand.
6137 #undef ABI_FUNC
6138 #define ABI_FUNC 'wfd_from_wfk'
6139 !End of the abilint section
6140 
6141  implicit none
6142 
6143 !Arguments ------------------------------------
6144 !scalars
6145  integer,intent(in) :: iomode,comm
6146  character(len=*),intent(in) :: wfk_fname
6147  logical,intent(in) :: keep_ur
6148  type(wfd_t),intent(out) :: Wfd
6149  type(pseudopotential_type),intent(in) :: Psps
6150 !arrays
6151  integer,intent(in) :: ngfft(18),nloalg(3)
6152  type(Pawtab_type),intent(in) :: Pawtab(:)  ! Crystal%ntypat*Psps%usepaw
6153 
6154 !Local variables ------------------------------
6155 !scalars
6156  integer,parameter :: paral_kgb0=0,prtvol0=0,pawprtvol0=0,timrev2=2,npwwfn1=1
6157  integer :: mband,nprocs,my_rank,fform
6158  real(dp),parameter :: dilatmx1=one
6159  type(Hdr_type) :: Hdr
6160  type(crystal_t) :: Crystal
6161 !arrays
6162  integer,allocatable :: wfd_nband(:,:),gvec(:,:)
6163  logical,allocatable :: bks_mask(:,:,:),keep_ur_tab(:,:,:)
6164 
6165 !************************************************************************
6166 
6167  DBG_ENTER("COLL")
6168 
6169  nprocs = xmpi_comm_size(comm)
6170  my_rank = xmpi_comm_rank(comm)
6171 
6172  ! Read the Abinit header
6173  call hdr_read_from_fname(Hdr,wfk_fname,fform,comm)
6174  if (fform==0) then
6175    MSG_ERROR("Received fform=0 while reading WFK file: "//trim(wfk_fname))
6176  end if
6177 
6178  ! Initialize the crystalline structure from the header.
6179  call crystal_from_hdr(Crystal,Hdr,timrev2)
6180 
6181  ! Initialize the wavefunction descriptor
6182  ABI_MALLOC(wfd_nband, (Hdr%nkpt, Hdr%nsppol))
6183  wfd_nband(:,:) = reshape(Hdr%nband, [Hdr%nkpt, Hdr%nsppol])
6184  mband = maxval(Hdr%nband)
6185 
6186  ABI_MALLOC(bks_mask, (mband,Hdr%nkpt,Hdr%nsppol))
6187  ABI_MALLOC(keep_ur_tab, (mband,Hdr%nkpt,Hdr%nsppol))
6188  bks_mask = .True.; keep_ur_tab = keep_ur
6189 
6190  ! Distribute spin if nprocs > 1
6191  if (Hdr%nsppol == 2 .and. nprocs>1) then
6192    if (my_rank < nprocs/2) then
6193       bks_mask(:,:,2) = .False.
6194     else
6195       bks_mask(:,:,1) = .False.
6196     end if
6197  end if
6198 
6199  ! Use k-centered G-spheres, gvec is not used. Note the use of opt_ecut.
6200  ABI_MALLOC(gvec, (3,npwwfn1))
6201  gvec = 0
6202 
6203  call wfd_init(Wfd,Crystal,Pawtab,Psps,keep_ur_tab,paral_kgb0,npwwfn1,mband,wfd_nband,Hdr%nkpt,Hdr%nsppol,bks_mask,&
6204 &  Hdr%nspden,Hdr%nspinor,Hdr%ecutsm,dilatmx1,Hdr%istwfk,Hdr%kptns,ngfft,gvec,nloalg,prtvol0,pawprtvol0,comm,opt_ecut=Hdr%ecut)
6205 
6206  ABI_FREE(gvec)
6207  ABI_FREE(keep_ur_tab)
6208  ABI_FREE(bks_mask)
6209  ABI_FREE(wfd_nband)
6210 
6211  call hdr_free(Hdr)
6212  call crystal_free(Crystal)
6213 
6214  ! Read wavefunction from files.
6215  call wfd_read_wfk(Wfd,wfk_fname,iomode)
6216 
6217  DBG_EXIT("COLL")
6218 
6219 end subroutine wfd_from_wfk

m_wfd/wfd_get_cprj [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_get_cprj

FUNCTION

  Return a copy of Cprj either by calculating it on-the-fly or by just retrieving the data already stored in the data type.

INPUTS

  Wfd<wfd_t>=the wavefunction descriptor.
  band=Band index.
  ik_ibz=Index of the k-point in the IBZ.
  spin=Spin index
  sorted=.TRUE. if the output cprj matrix elements have to be sorted by atom type.

OUTPUT

  Cprj_out(Wfd%natom,Wfd%nspinor) <type(pawcprj_type)>=Unsorted matrix elements.

PARENTS

      calc_optical_mels,calc_sigc_me,calc_sigx_me,calc_vhxc_me,cchi0,cchi0q0
      cchi0q0_intraband,cohsex_me,debug_tools,exc_build_block,exc_build_ham
      m_shirley,m_wfd,prep_calc_ucrpa,sigma,wfd_pawrhoij,wfd_vnlpsi

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

4928 subroutine wfd_get_cprj(Wfd,band,ik_ibz,spin,Cryst,Cprj_out,sorted)
4929 
4930 
4931 !This section has been created automatically by the script Abilint (TD).
4932 !Do not modify the following lines by hand.
4933 #undef ABI_FUNC
4934 #define ABI_FUNC 'wfd_get_cprj'
4935 !End of the abilint section
4936 
4937  implicit none
4938 
4939 !Arguments ------------------------------------
4940 !scalars
4941  integer,intent(in) :: band,ik_ibz,spin
4942  logical,intent(in) :: sorted
4943  type(wfd_t),intent(inout) :: Wfd
4944  type(crystal_t),intent(in) :: Cryst
4945 !arrays
4946  type(pawcprj_type),intent(inout) :: Cprj_out(Wfd%natom,Wfd%nspinor)
4947 
4948 !Local variables ------------------------------
4949 !scalars
4950  integer,parameter :: choice1=1,idir0=0
4951  integer :: want_order,iatom,sidx
4952  character(len=500) :: msg
4953 
4954 !************************************************************************
4955 
4956  want_order=CPR_RANDOM; if (sorted) want_order=CPR_SORTED
4957 
4958  SELECT CASE (Wfd%Wave(band,ik_ibz,spin)%has_cprj)
4959 
4960  CASE (WFD_NOWAVE, WFD_ALLOCATED)  ! Have to calculate it!
4961 
4962    if (.not.wfd_ihave_ug(Wfd,band,ik_ibz,spin,"Stored")) then
4963      write(msg,'(a,3(i0,1x),a)')" ug for (band, ik_ibz, spin): ",band,ik_ibz,spin," is not stored in memory!"
4964      MSG_ERROR(msg)
4965    end if
4966    ! Get cprj.
4967    call wfd_ug2cprj(Wfd,band,ik_ibz,spin,choice1,idir0,Wfd%natom,Cryst,Cprj_out,sorted=sorted)
4968 
4969    if (Wfd%Wave(band,ik_ibz,spin)%has_cprj==WFD_ALLOCATED) then
4970      ! Store it.
4971      if ( want_order == Wfd%Wave(band,ik_ibz,spin)%cprj_order) then
4972        call pawcprj_copy(Cprj_out,Wfd%Wave(band,ik_ibz,spin)%Cprj)
4973        Wfd%Wave(band,ik_ibz,spin)%has_cprj=WFD_STORED
4974 
4975      else
4976        ! Have to reorder cprj_out
4977        select case (want_order)
4978        case (CPR_SORTED)
4979          do iatom=1,Cryst%natom
4980            sidx = Cryst%atindx(iatom) ! random --> sorted table.
4981            call pawcprj_copy(Cprj_out(sidx:sidx,:),Wfd%Wave(band,ik_ibz,spin)%Cprj(iatom:iatom,:))
4982          end do
4983        case (CPR_RANDOM)
4984          do sidx=1,Cryst%natom
4985            iatom = Cryst%atindx1(sidx) ! sorted --> random table.
4986            call pawcprj_copy(Cprj_out(iatom:iatom,:),Wfd%Wave(band,ik_ibz,spin)%Cprj(sidx:sidx,:))
4987          end do
4988        case default
4989          MSG_ERROR(sjoin(" Wrong value for want_order ", itoa(want_order)))
4990        end select
4991      end if
4992    end if
4993 
4994  CASE (WFD_STORED) ! copy it back.
4995    if (want_order == Wfd%Wave(band,ik_ibz,spin)%cprj_order) then
4996      call pawcprj_copy(Wfd%Wave(band,ik_ibz,spin)%Cprj,Cprj_out)
4997 
4998    else
4999      select case (want_order)
5000      case (CPR_SORTED)
5001        do iatom=1,Cryst%natom
5002          sidx = Cryst%atindx(iatom) ! random --> sorted table.
5003          call pawcprj_copy(Wfd%Wave(band,ik_ibz,spin)%Cprj(iatom:iatom,:),Cprj_out(sidx:sidx,:))
5004        end do
5005      case (CPR_RANDOM)
5006        do sidx=1,Cryst%natom
5007          iatom = Cryst%atindx1(sidx) ! sorted --> random table.
5008          call pawcprj_copy(Wfd%Wave(band,ik_ibz,spin)%Cprj(sidx:sidx,:),Cprj_out(iatom:iatom,:))
5009        end do
5010      case default
5011        MSG_ERROR(sjoin("Wrong value for want_order:", itoa(want_order)))
5012      end select
5013    end if
5014 
5015  CASE DEFAULT
5016    MSG_BUG(sjoin("Wrong has_cprj: ", itoa(Wfd%Wave(band,ik_ibz,spin)%has_cprj)))
5017  END SELECT
5018 
5019 end subroutine wfd_get_cprj

m_wfd/wfd_get_many_ur [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_get_many_ur

FUNCTION

  Get many wave functions in real space, either by doing a G-->R FFT
  or by just retrieving the data already stored in Wfd.

INPUTS

  Wfd<wfd_t>=the wavefunction descriptor.
  ndat=Number of wavefunctions required
  bands(:)=Band indices.
  ik_ibz=Index of the k-point in the IBZ.
  spin=Spin index

OUTPUT

  ur(Wfd%nfft*Wfd%nspinor*SIZE(bands))=The wavefunction in real space.

PARENTS

      calc_sigc_me,calc_sigx_me,cohsex_me

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

1647 subroutine wfd_get_many_ur(Wfd,bands,ik_ibz,spin,ur)
1648 
1649 
1650 !This section has been created automatically by the script Abilint (TD).
1651 !Do not modify the following lines by hand.
1652 #undef ABI_FUNC
1653 #define ABI_FUNC 'wfd_get_many_ur'
1654 !End of the abilint section
1655 
1656  implicit none
1657 
1658 !Arguments ------------------------------------
1659 !scalars
1660  integer,intent(in) :: ik_ibz,spin
1661  type(wfd_t),intent(inout) :: Wfd
1662 !arrays
1663  integer,intent(in) :: bands(:)
1664  complex(gwpc),intent(out) :: ur(Wfd%nfft*Wfd%nspinor*SIZE(bands))
1665 
1666 !Local variables ------------------------------
1667 !scalars
1668  integer :: dat,ptr,band
1669 !************************************************************************
1670 
1671  do dat=1,SIZE(bands)
1672    band = bands(dat)
1673    ptr = 1 + (dat-1)*Wfd%nfft*Wfd%nspinor
1674    call wfd_get_ur(Wfd,band,ik_ibz,spin,ur(ptr))
1675  end do
1676 
1677 end subroutine wfd_get_many_ur

m_wfd/wfd_get_socpert [ Functions ]

[ Top ] [ Functions ]

NAME

 wfd_get_socpert

FUNCTION

INPUTS

 cryst<crystal_t>= data type gathering info on symmetries and unit cell
 psps<pseudopotential_type>=variables related to pseudopotentials
 pawtab(psps%ntypat) <type(pawtab_type)>=paw tabulated starting data
 paw_ij(natom)<type(paw_ij_type)>=data structure containing PAW arrays given on (i,j) channels.

OUTPUT

PARENTS

CHILDREN

SOURCE

6607 !!!  subroutine wfd_get_socpert(wfd, cryst, psps, pawtab, bks_mask, osoc_bks)
6608 !!!
6609 !!!   !use m_pawcprj
6610 !!!   use m_hamiltonian,    only : destroy_hamiltonian, init_hamiltonian, &
6611 !!!                                load_spin_hamiltonian,load_k_hamiltonian, gs_hamiltonian_type
6612 !!!
6613 !!!   implicit none
6614 !!!
6615 !!!  !Arguments ------------------------------------
6616 !!!  !scalars
6617 !!!   type(wfd_t),target,intent(inout) :: wfd
6618 !!!   type(crystal_t),intent(in) :: cryst
6619 !!!   type(pseudopotential_type),intent(in) :: psps
6620 !!!  ! arrays
6621 !!!   logical,intent(in) :: bks_mask(wfd%mband, wfd%nkibz, wfd%nsppol)
6622 !!!   real(dp),allocatable,intent(out) :: osoc_bks(:, :, :)
6623 !!!   type(Pawtab_type),intent(in) :: pawtab(psps%ntypat*psps%usepaw)
6624 !!!   !type(paw_ij_type),intent(in) :: paw_ij(cryst%natom*psps%usepaw)
6625 !!!
6626 !!!  !Local variables ------------------------------
6627 !!!  !scalars
6628 !!!   integer,parameter :: nspinor2=2,nspden4=4,nsppol1=1,spin1=1
6629 !!!   integer,parameter :: ndat1=1,nnlout0=0,tim_nonlop0=0,idir0=0 !,ider0=0,
6630 !!!   integer :: natom,band,spin,ik_ibz,npw_k,istwf_k,nkpg !,ig,optder,matblk,mkmem_,nkpg,dimffnl,nspinortot
6631 !!!   integer :: choice,cpopt,cp_dim,paw_opt,signs,ierr
6632 !!!   !character(len=500) :: msg
6633 !!!   type(gs_hamiltonian_type) :: ham_k
6634 !!!  !arrays
6635 !!!   integer :: bks_distrb(wfd%mband, wfd%nkibz, wfd%nsppol)
6636 !!!   integer, ABI_CONTIGUOUS pointer :: kg_k(:,:)
6637 !!!   !real(dp) :: kptns_(3,1),ylmgr_dum(1,1,1),shifts(3)
6638 !!!   !real(dp),allocatable :: ylm_k(:,:),dum_ylm_gr_k(:,:,:)
6639 !!!   !real(dp),pointer :: ffnl_k(:,:,:,:)
6640 !!!   real(dp) :: kpoint(3),dum_enlout(0),dummy_lambda(1),soc(2)
6641 !!!   real(dp),allocatable :: kpg_k(:,:),vnl_psi(:,:),vectin(:,:) !,s_psi(:,:)
6642 !!!   real(dp),allocatable :: opaw_psi(:,:) !2, npw_k*wfd%nspinor*wfd%usepaw) ! <G|1+S|Cnk>
6643 !!!   real(dp),ABI_CONTIGUOUS pointer :: ffnl_k(:,:,:,:),ph3d_k(:,:,:)
6644 !!!   type(pawcprj_type),allocatable :: cprj(:,:)
6645 !!!
6646 !!!  !************************************************************************
6647 !!!
6648 !!!   DBG_ENTER("COLL")
6649 !!!   ABI_CHECK(wfd%paral_kgb == 0, "paral_kgb not coded")
6650 !!!
6651 !!!   natom = cryst%natom
6652 !!!
6653 !!!   signs  = 2  ! => apply the non-local operator to a function in G-space.
6654 !!!   choice = 1  ! => <G|V_nonlocal|vectin>.
6655 !!!   cpopt  =-1; paw_opt= 0
6656 !!!   if (wfd%usepaw==1) then
6657 !!!     paw_opt=4 ! both PAW nonlocal part of H (Dij) and overlap matrix (Sij)
6658 !!!     cpopt=3   ! <p_lmn|in> are already in memory
6659 !!!
6660 !!!     cp_dim = ((cpopt+5) / 5)
6661 !!!     ABI_DT_MALLOC(cprj, (natom, nspinor2*cp_dim))
6662 !!!     call pawcprj_alloc(cprj, 0, wfd%nlmn_sort)
6663 !!!   end if
6664 !!!
6665 !!!   ! Initialize the Hamiltonian on the coarse FFT mesh.
6666 !!!   call init_hamiltonian(ham_k, psps, pawtab, nspinor2, nsppol1, nspden4, natom, cryst%typat, cryst%xred, &
6667 !!!      wfd%nfft, wfd%mgfft, wfd%ngfft, cryst%rprimd, wfd%nloalg)
6668 !!!   !ham_k%ekb(:,:,1) = zero
6669 !!!
6670 !!!   ! Continue to prepare the GS Hamiltonian (note spin1)
6671 !!!   call load_spin_hamiltonian(ham_k, spin1, with_nonlocal=.True.)
6672 !!!
6673 !!!   ! Distribute (b, k, s) states.
6674 !!!   call wfd_bks_distrb(wfd, bks_distrb, bks_mask=bks_mask)
6675 !!!
6676 !!!   ABI_CALLOC(osoc_bks, (wfd%mband, wfd%nkibz, wfd%nsppol))
6677 !!!   osoc_bks = zero
6678 !!!
6679 !!!   do spin=1,wfd%nsppol
6680 !!!     do ik_ibz=1,wfd%nkibz
6681 !!!       if (all(bks_distrb(:, ik_ibz, spin) /= wfd%my_rank)) cycle
6682 !!!
6683 !!!       kpoint = wfd%kibz(:, ik_ibz)
6684 !!!       npw_k = wfd%Kdata(ik_ibz)%npw; istwf_k = wfd%istwfk(ik_ibz)
6685 !!!       ABI_CHECK(istwf_k == 1, "istwf_k must be 1 if SOC term is computed with perturbation theory.")
6686 !!!       kg_k => wfd%kdata(ik_ibz)%kg_k
6687 !!!       ffnl_k => wfd%Kdata(ik_ibz)%fnl_dir0der0
6688 !!!       ph3d_k => wfd%Kdata(ik_ibz)%ph3d
6689 !!!
6690 !!!       ABI_MALLOC(vectin, (2, npw_k * nspinor2))
6691 !!!       ABI_MALLOC(vnl_psi, (2, npw_k * nspinor2))
6692 !!!       !ABI_MALLOC(cvnl_psi, (npw_k * nspinor2))
6693 !!!       !ABI_MALLOC(s_psi, (2, npw_k * nspinor2 * psps%usepaw))
6694 !!!
6695 !!!       ! Compute (k+G) vectors (only if psps%useylm=1)
6696 !!!       nkpg = 3 * wfd%nloalg(3)
6697 !!!       ABI_MALLOC(kpg_k, (npw_k, nkpg))
6698 !!!       if (nkpg > 0) then
6699 !!!         call mkkpg(kg_k, kpg_k, kpoint, nkpg, npw_k)
6700 !!!       end if
6701 !!!
6702 !!!       ! Load k-dependent part in the Hamiltonian datastructure
6703 !!!       !matblk = min(NLO_MINCAT, maxval(ham_k%nattyp)); if (wfd%nloalg(2) > 0) matblk = natom
6704 !!!       !ABI_MALLOC(ph3d_k,(2, npw_k, matblk))
6705 !!!       call load_k_hamiltonian(ham_k, kpt_k=kpoint, npw_k=npw_k, istwf_k=istwf_k, kg_k=kg_k, &
6706 !!!                               kpg_k=kpg_k, ffnl_k=ffnl_k, ph3d_k=ph3d_k, compute_ph3d=(wfd%paral_kgb/=1))
6707 !!!
6708 !!!       ! THIS PART IS NEEDED FOR THE CALL TO opernl although some quantities won't be used.
6709 !!!       ! Now I do things cleanly then we try to pass zero-sized arrays!
6710 !!!       !ABI_MALLOC(ylm_k, (npw_k, psps%mpsang**2 * psps%useylm))
6711 !!!       !if (psps%useylm == 1) then
6712 !!!       !  kptns_(:,1) = k4intp; optder = 0; mkmem_ = 1
6713 !!!       !  ABI_MALLOC(dum_ylm_gr_k,(npw_k,3+6*(optder/2),psps%mpsang**2))
6714 !!!       !  ! Here mband is not used if paral_compil_kpt=0
6715 !!!       !  call initylmg(cryst%gprimd, kg_k, kptns_, mkmem_, wfd%MPI_enreg, psps%mpsang, npw_k, [1], 1,&
6716 !!!       !    [npw_k], 1, optder, cryst%rprimd, ylm_k, dum_ylm_gr_k)
6717 !!!       !  ABI_FREE(dum_ylm_gr_k)
6718 !!!       !end if
6719 !!!
6720 !!!       ! ========================================================
6721 !!!       ! ==== Compute nonlocal form factors ffnl at all (k+G) ====
6722 !!!       ! ========================================================
6723 !!!       !dimffnl = 1 + ider0 ! Derivatives are not needed.
6724 !!!       !ABI_MALLOC(ffnl_k, (npw_k, dimffnl, psps%lmnmax, psps%ntypat))
6725 !!!       !! ffnl_k => Kdata%fnl_dir0der0
6726 !!!       !call mkffnl(psps%dimekb, dimffnl, psps%ekb, ffnl_k, psps%ffspl, cryst%gmet, cryst%gprimd, ider0, idir0, psps%indlmn,&
6727 !!!       !   kg_k, kpg_k, k4intp, psps%lmnmax, psps%lnmax, psps%mpsang, psps%mqgrid_ff, nkpg, npw_k, &
6728 !!!       !   psps%ntypat, psps%pspso, psps%qgrid_ff, cryst%rmet, psps%usepaw, psps%useylm, ylm_k, ylmgr_dum)
6729 !!!       !ABI_FREE(ylm_k)
6730 !!!
6731 !!!       ! Calculate <G|Vnl|psi> for this k-point
6732 !!!       do band=1,wfd%nband(ik_ibz, spin)
6733 !!!         if (bks_distrb(band, ik_ibz, spin) /= wfd%my_rank) cycle
6734 !!!
6735 !!!         ! Input wavefunction coefficients <G|Cnk>.
6736 !!!         ! vectin, (2, npw_k * nspinor2))
6737 !!!         if (spin == 1) then
6738 !!!           vectin(1, 1:npw_k) = dble(wfd%wave(band, ik_ibz, spin)%ug)
6739 !!!           vectin(2, 1:npw_k) = aimag(wfd%wave(band, ik_ibz, spin)%ug)
6740 !!!           vectin(:, npw_k+1:) = zero
6741 !!!         else
6742 !!!           vectin(:, 1:npw_k) = zero
6743 !!!           vectin(1, npw_k+1:) = dble(wfd%wave(band, ik_ibz, spin)%ug)
6744 !!!           vectin(2, npw_k+1:) = aimag(wfd%wave(band, ik_ibz, spin)%ug)
6745 !!!         end if
6746 !!!
6747 !!!         if (wfd%usepaw == 1) call wfd_get_cprj(wfd, band, ik_ibz, spin, cryst, cprj, sorted=.True.)
6748 !!!
6749 !!!         ! TODO: consistency check for only_SO
6750 !!!         call nonlop(choice, cpopt, cprj, dum_enlout, ham_k, idir0, dummy_lambda, wfd%mpi_enreg, ndat1, nnlout0, &
6751 !!!                     paw_opt, signs, opaw_psi, tim_nonlop0, vectin, vnl_psi, only_SO=1)
6752 !!!
6753 !!!         soc = cg_zdotc(npw_k * nspinor2, vectin, vnl_psi)
6754 !!!         write(std_out,*)soc * Ha_eV, "for (b, k, s)",band, ik_ibz, spin
6755 !!!         osoc_bks(band, ik_ibz, spin) = soc(1)
6756 !!!       end do ! band
6757 !!!
6758 !!!       !ABI_FREE(ffnl_k)
6759 !!!       !ABI_FREE(ph3d_k)
6760 !!!       ABI_FREE(vectin)
6761 !!!       ABI_FREE(vnl_psi)
6762 !!!       ABI_FREE(kpg_k)
6763 !!!       !ABI_FREE(cvnl_psi)
6764 !!!       !ABI_FREE(s_psi)
6765 !!!     end do ! ik_ibz
6766 !!!   end do ! spin
6767 !!!
6768 !!!   call xmpi_sum(osoc_bks, wfd%comm, ierr)
6769 !!!
6770 !!!   call destroy_hamiltonian(ham_k)
6771 !!!
6772 !!!   if (wfd%usepaw == 1) then
6773 !!!     call pawcprj_free(cprj)
6774 !!!     ABI_DT_FREE(cprj)
6775 !!!   end if
6776 !!!
6777 !!!   DBG_EXIT("COLL")
6778 !!!
6779 !!!  end subroutine wfd_get_socpert

m_wfd/wfd_get_ug [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_get_ug

FUNCTION

  Get a copy of a wave function in reciprocal space.

INPUTS

  Wfd<wfd_t>=the data type
  band=the index of the band.
  ik_ibz=Index of the k-point in the IBZ
  spin=spin index

OUTPUT

  ug(Wfd%npwwfn*Wfd%nspinor)=The required wavefunction in reciprocal space.

PARENTS

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

3500 subroutine wfd_get_ug(Wfd,band,ik_ibz,spin,ug)
3501 
3502 
3503 !This section has been created automatically by the script Abilint (TD).
3504 !Do not modify the following lines by hand.
3505 #undef ABI_FUNC
3506 #define ABI_FUNC 'wfd_get_ug'
3507 !End of the abilint section
3508 
3509  implicit none
3510 
3511 !Arguments ------------------------------------
3512 !scalars
3513  integer,intent(in) :: band,ik_ibz,spin
3514  type(wfd_t),intent(inout) :: Wfd
3515 !arrays
3516  complex(gwpc),intent(out) :: ug(Wfd%npwarr(ik_ibz)*Wfd%nspinor)
3517 
3518 !Local variables ------------------------------
3519 !scalars
3520  integer :: npw_k
3521  character(len=500) :: msg
3522 !************************************************************************
3523 
3524  if (wfd_ihave_ug(Wfd,band,ik_ibz,spin,"Stored")) then
3525    npw_k = Wfd%npwarr(ik_ibz)
3526    call xcopy(npw_k*Wfd%nspinor,Wfd%Wave(band,ik_ibz,spin)%ug,1,ug,1)
3527  else
3528    write(msg,'(a,i0,a,3i0)')" Node ",Wfd%my_rank," doesn't have (band,ik_ibz,spin)=",band,ik_ibz,spin
3529    MSG_BUG(msg)
3530  end if
3531 
3532 end subroutine wfd_get_ug

m_wfd/wfd_get_ur [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_get_ur

FUNCTION

  Get a wave function in real space, either by doing a G-->R FFT
  or by just retrieving the data already stored in Wfd.

INPUTS

  Wfd<wfd_t>=the wavefunction descriptor.
  band=Band index.
  ik_ibz=Index of the k-point in the IBZ.
  spin=Spin index

OUTPUT

  ur(Wfd%nfft*Wfd%nspinor)=The wavefunction in real space.

PARENTS

      calc_sigc_me,calc_sigx_me,calc_vhxc_me,cchi0,cchi0q0,cchi0q0_intraband
      classify_bands,cohsex_me,exc_build_block,exc_build_ham,exc_den
      m_shirley,m_wfd,prep_calc_ucrpa,wfd_mkrho

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

1785 subroutine wfd_get_ur(Wfd,band,ik_ibz,spin,ur)
1786 
1787 
1788 !This section has been created automatically by the script Abilint (TD).
1789 !Do not modify the following lines by hand.
1790 #undef ABI_FUNC
1791 #define ABI_FUNC 'wfd_get_ur'
1792 !End of the abilint section
1793 
1794  implicit none
1795 
1796 !Arguments ------------------------------------
1797 !scalars
1798  integer,intent(in) :: band,ik_ibz,spin
1799  type(wfd_t),target,intent(inout) :: Wfd
1800 !arrays
1801  complex(gwpc),intent(out) :: ur(Wfd%nfft*Wfd%nspinor)
1802 
1803 !Local variables ------------------------------
1804 !scalars
1805  integer,parameter :: npw0=0,ndat1=1
1806  integer :: npw_k,nfft,nspinor,has_this_ur
1807  character(len=500) :: msg
1808 !arrays
1809  integer,ABI_CONTIGUOUS pointer :: kg_k(:,:),gbound(:,:)
1810  complex(gwpc),ABI_CONTIGUOUS pointer :: wave_ug(:)
1811 !************************************************************************
1812 
1813  has_this_ur = Wfd%Wave(band,ik_ibz,spin)%has_ur
1814 
1815  npw_k  = Wfd%npwarr(ik_ibz)
1816  nfft   = Wfd%nfft
1817  nspinor= Wfd%nspinor
1818 
1819  SELECT CASE (has_this_ur)
1820 
1821  CASE (WFD_NOWAVE, WFD_ALLOCATED)
1822    ! FFT is required.
1823    if (.not.wfd_ihave_ug(Wfd,band,ik_ibz,spin,"Stored")) then
1824      write(msg,'(a,3(i0,1x),a)')" ug for (band, ik_ibz, spin): ",band,ik_ibz,spin," is not stored in memory!"
1825      MSG_ERROR(msg)
1826    end if
1827 
1828    wave_ug => Wfd%Wave(band,ik_ibz,spin)%ug
1829    kg_k    => Wfd%Kdata(ik_ibz)%kg_k
1830    gbound  => Wfd%Kdata(ik_ibz)%gbound(:,:)
1831 
1832    call fft_ug(npw_k,nfft,nspinor,ndat1,Wfd%mgfft,Wfd%ngfft,Wfd%istwfk(ik_ibz),kg_k,gbound,wave_ug,ur)
1833 
1834    if (Wfd%keep_ur(band,ik_ibz,spin)) then ! Store results
1835      if (has_this_ur==WFD_NOWAVE) then ! Alloc buffer for ur.
1836        call wave_init(Wfd%Wave(band,ik_ibz,spin),Wfd%usepaw,npw0,nfft,nspinor,Wfd%natom,Wfd%nlmn_atm,CPR_RANDOM)
1837      end if
1838      call xcopy(nfft*nspinor,ur,1,Wfd%Wave(band,ik_ibz,spin)%ur,1)
1839      Wfd%Wave(band,ik_ibz,spin)%has_ur=WFD_STORED
1840    end if
1841 
1842  CASE (WFD_STORED) ! copy it back.
1843    call xcopy(nfft*nspinor,Wfd%Wave(band,ik_ibz,spin)%ur,1,ur,1)
1844 
1845  CASE DEFAULT
1846    MSG_BUG(sjoin("Wrong has_this_ur:", itoa(has_this_ur)))
1847  END SELECT
1848 
1849 end subroutine wfd_get_ur

m_wfd/wfd_iam_master [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_iam_master

FUNCTION

  Returns true if this rank is the master node. spin index can be specified.

INPUTS

  Wfd<wfd_t>

PARENTS

SOURCE

5164 function wfd_iam_master(Wfd) result(ans)
5165 
5166 
5167 !This section has been created automatically by the script Abilint (TD).
5168 !Do not modify the following lines by hand.
5169 #undef ABI_FUNC
5170 #define ABI_FUNC 'wfd_iam_master'
5171 !End of the abilint section
5172 
5173  implicit none
5174 
5175 !Arguments ------------------------------------
5176 !scalars
5177  type(wfd_t),intent(in) :: Wfd
5178  logical :: ans
5179 
5180 !************************************************************************
5181 
5182  ans = (Wfd%my_rank == Wfd%master)
5183 
5184 end function wfd_iam_master

m_wfd/wfd_ihave [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_ihave

FUNCTION

  This function is used to ask the processor whether it has a particular (ug|ur|cprj) and with which status.

INPUTS

   band=Band index.
   ik_ibz=k-point index
   spin=Spin index.
   what=String defining what has to be tested.
     ug
     ur
     cprj
   [how]=string defining which status is checked.
     Possible mutually exclusive values: "Allocated", "Stored".
     Only the first character is checked (no case-sensitive)
     By default the function returns .TRUE. if the wave is either WFD_ALLOCATED or WFD_STORED.

NOTES

   A zero index can be used to inquire the status of a bunch of states.
   Thus (band,ik_ibz,spin) = (0,1,1) means: Do you have at least one band for the first k-point and the first spin.

PARENTS

SOURCE

3171 function wfd_ihave(Wfd,what,band,ik_ibz,spin,how)
3172 
3173 
3174 !This section has been created automatically by the script Abilint (TD).
3175 !Do not modify the following lines by hand.
3176 #undef ABI_FUNC
3177 #define ABI_FUNC 'wfd_ihave'
3178 !End of the abilint section
3179 
3180  implicit none
3181 
3182 !Arguments ------------------------------------
3183 !scalars
3184  integer,intent(in) :: band,ik_ibz,spin
3185  logical :: wfd_ihave
3186  character(len=*),intent(in) :: what
3187  character(len=*),optional,intent(in) :: how
3188  type(wfd_t),target,intent(in) :: Wfd
3189 
3190 !Local variables ------------------------------
3191 !scalars
3192  integer :: nzeros
3193 !arrays
3194  integer :: indices(3),check(2)
3195  integer,pointer :: has_flags(:,:,:)
3196 
3197 !************************************************************************
3198 
3199  check = [WFD_ALLOCATED, WFD_STORED]
3200  if (PRESENT(how)) then
3201    if (firstchar(how,["A","a"])) check = [WFD_ALLOCATED, WFD_ALLOCATED]
3202    if (firstchar(how,["S","s"])) check = [WFD_STORED, WFD_STORED]
3203  end if
3204 
3205  indices = [band,ik_ibz,spin]
3206 
3207  select case (toupper(what))
3208  case ("UG")
3209    has_flags => Wfd%Wave(:,:,:)%has_ug
3210  case ("UR")
3211    has_flags => Wfd%Wave(:,:,:)%has_ur
3212  case ("CPRJ")
3213    has_flags => Wfd%Wave(:,:,:)%has_cprj
3214  case default
3215    MSG_ERROR("Wrong what"//TRIM(what))
3216  end select
3217 
3218  if ( ALL(indices/=(/0,0,0/)) ) then
3219    wfd_ihave = ( ANY(has_flags(band,ik_ibz,spin) == check )); RETURN
3220  else
3221    nzeros = COUNT(indices==0)
3222    if (nzeros==3) MSG_ERROR("All indices are zero!")
3223 
3224    if (band==0) then
3225      if (nzeros==1) wfd_ihave = ANY( has_flags(:,ik_ibz,spin)==check(1) .or.&
3226 &                                    has_flags(:,ik_ibz,spin)==check(2) )
3227 
3228      if (ik_ibz==0) wfd_ihave = ANY( has_flags(:,:,spin)==check(1) .or.&
3229 &                                    has_flags(:,:,spin)==check(2) )
3230 
3231      if (spin  ==0) wfd_ihave = ANY( has_flags(:,ik_ibz,:)==check(1) .or.&
3232 &                                    has_flags(:,ik_ibz,:)==check(2) )
3233 
3234    else if (ik_ibz==0) then
3235      if (nzeros==1) wfd_ihave = ANY( has_flags(band,:,spin)==check(1) .or.&
3236 &                                    has_flags(band,:,spin)==check(2) )
3237 
3238      if (band  ==0) wfd_ihave = ANY( has_flags(:,:,spin)==check(1) .or.&
3239 &                                    has_flags(:,:,spin)==check(2) )
3240 
3241      if (spin  ==0) wfd_ihave = ANY( has_flags(band,:,:)==check(1) .or.&
3242 &                                    has_flags(band,:,:)==check(2) )
3243    else
3244      if (nzeros==1) wfd_ihave = ANY( has_flags(band,ik_ibz,:)==check(1) .or.&
3245 &                                    has_flags(band,ik_ibz,:)==check(2) )
3246 
3247      if (ik_ibz==0) wfd_ihave = ANY( has_flags(band,:,:)==check(1) .or.&
3248 &                                    has_flags(band,:,:)==check(2) )
3249 
3250      if (band  ==0) wfd_ihave = ANY( has_flags(:,ik_ibz,:)==check(1) .or.&
3251 &                                    has_flags(:,ik_ibz,:)==check(2) )
3252    end if
3253  end if
3254 
3255 end function wfd_ihave

m_wfd/wfd_ihave_cprj [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_ihave_cprj

FUNCTION

  This function is used to ask the processor whether it has a particular cprj and with which status.

INPUTS

   band=Band index.
   ik_ibz=k-point index
   spin=Spin index.
   [how]=string defining which status is checked. By default the function returns
      .TRUE. if the wave is either WFD_ALLOCATED or WFD_STORED.
      Possible mutually exclusive values: "Allocated", "Stored".
      Only the first character is checked (no case-sensitive)

NOTES

   A zero index can be used to inquire the status of a bunch of states.
   Thus (band,ik_ibz,spin) = (0,1,1) means: Do you have at least one band for the first k-point and the first spin.

OUTPUT

PARENTS

SOURCE

3054 function wfd_ihave_cprj(Wfd,band,ik_ibz,spin,how)
3055 
3056 
3057 !This section has been created automatically by the script Abilint (TD).
3058 !Do not modify the following lines by hand.
3059 #undef ABI_FUNC
3060 #define ABI_FUNC 'wfd_ihave_cprj'
3061 !End of the abilint section
3062 
3063  implicit none
3064 
3065 !Arguments ------------------------------------
3066 !scalars
3067  integer,intent(in) :: band,ik_ibz,spin
3068  logical :: wfd_ihave_cprj
3069  character(len=*),optional,intent(in) :: how
3070  type(wfd_t),intent(in) :: Wfd
3071 
3072 !************************************************************************
3073 
3074  if (PRESENT(how)) then
3075    wfd_ihave_cprj = wfd_ihave(Wfd,"CPRJ",band,ik_ibz,spin,how)
3076  else
3077    wfd_ihave_cprj = wfd_ihave(Wfd,"CPRJ",band,ik_ibz,spin)
3078  end if
3079 
3080 end function wfd_ihave_cprj

m_wfd/wfd_ihave_ug [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_ihave_ug

FUNCTION

  This function is used to ask the processor whether it has a particular ug and with which status.

INPUTS

   band=Band index.
   ik_ibz=k-point index
   spin=Spin index.
   [how]=string defining which status is checked.
     Possible mutually exclusive values: "Allocated", "Stored".
     Only the first character is checked (no case-sensitive)
     By default the function returns .TRUE. if the wave is either WFD_ALLOCATED or WFD_STORED.

NOTES

   A zero index can be used to inquire the status of a bunch of states.
   Thus (band,ik_ibz,spin) = (0,1,1) means: Do you have at least one band for the first k-point and the first spin.

PARENTS

SOURCE

2940 function wfd_ihave_ug(Wfd,band,ik_ibz,spin,how)
2941 
2942 
2943 !This section has been created automatically by the script Abilint (TD).
2944 !Do not modify the following lines by hand.
2945 #undef ABI_FUNC
2946 #define ABI_FUNC 'wfd_ihave_ug'
2947 !End of the abilint section
2948 
2949  implicit none
2950 
2951 !Arguments ------------------------------------
2952 !scalars
2953  integer,intent(in) :: band,ik_ibz,spin
2954  logical :: wfd_ihave_ug
2955  character(len=*),optional,intent(in) :: how
2956  type(wfd_t),intent(in) :: Wfd
2957 
2958 !************************************************************************
2959 
2960  if (PRESENT(how)) then
2961    wfd_ihave_ug = wfd_ihave(Wfd,"UG",band,ik_ibz,spin,how)
2962  else
2963    wfd_ihave_ug = wfd_ihave(Wfd,"UG",band,ik_ibz,spin)
2964  end if
2965 
2966 end function wfd_ihave_ug

m_wfd/wfd_ihave_ur [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_ihave_ur

FUNCTION

  This function is used to ask the processor whether it has a particular ur and with which status.

INPUTS

   band=Band index.
   ik_ibz=k-point index
   spin=Spin index.
   [how]=string defining which status is checked. By default the function returns
      .TRUE. if the wave is either WFD_ALLOCATED or WFD_STORED.
      Possible mutually exclusive values: "Allocated", "Stored".
      Only the first character is checked (no case-sensitive)

NOTES

   A zero index can be used to inquire the status of a bunch of states.
   Thus (band,ik_ibz,spin) = (0,1,1) means: Do you have at least one band for the first k-point and the first spin.

OUTPUT

PARENTS

SOURCE

2997 function wfd_ihave_ur(Wfd,band,ik_ibz,spin,how)
2998 
2999 
3000 !This section has been created automatically by the script Abilint (TD).
3001 !Do not modify the following lines by hand.
3002 #undef ABI_FUNC
3003 #define ABI_FUNC 'wfd_ihave_ur'
3004 !End of the abilint section
3005 
3006  implicit none
3007 
3008 !Arguments ------------------------------------
3009 !scalars
3010  integer,intent(in) :: band,ik_ibz,spin
3011  logical :: wfd_ihave_ur
3012  character(len=*),optional,intent(in) :: how
3013  type(wfd_t),intent(in) :: Wfd
3014 
3015 !************************************************************************
3016 
3017  if (PRESENT(how)) then
3018    wfd_ihave_ur = wfd_ihave(Wfd,"UR",band,ik_ibz,spin,how)
3019  else
3020    wfd_ihave_ur = wfd_ihave(Wfd,"UR",band,ik_ibz,spin)
3021  end if
3022 
3023 end function wfd_ihave_ur

m_wfd/wfd_init [ Functions ]

[ Top ] [ Functions ]

NAME

 wfd_init

FUNCTION

  Initialize the object.

INPUTS

  Cryst<crystal_t>=Object defining the unit cell and its symmetries.
  Pawtab(ntypat*usepaw)<type(pawtab_type)>=PAW tabulated starting data.
  Psps<Pseudopotential_type>=datatype storing data on the pseudopotentials.
  ngfft(18)=All needed information about 3D FFT, see ~abinit/doc/variables/vargs.htm#ngfft
  nkibz=Number of irreducible k-points.
  npwwfn=Number of plane waves for u(G).
  nsppol=Number of independent spin polarizations.
  nspden=Number of density components.
  nspinor=Number of spinorial components.
  ecutsm
  dilatmx
  mband
  nband(nkibz,nsppol)
  keep_ur(mband,nkibz,nsppol)=Option for memory storage of u(r).
  paral_kgb=Option for band-FFT parallelism (not yet available)
  gvec(3,npwwfn)=G-vectors in reduced coordinates.
  istwfk(nkibz)=Storage mode.
  kibz(3,nkibz)=Reduced coordinates of the k-points.
  nloalg(3)=Governs the choice of the algorithm for nonlocal operator. See doc.
  prtvol=Verbosity level.
  comm=MPI communicator.

OUTPUT

  Initialize the object with basic dimensions, allocate also memory for u(g) and u(r) according to keep_ur
    %ug in reciprocal space are always allocated.
    %ur in real space only if keep_ur.

PARENTS

      bethe_salpeter,m_gkk,m_phgamma,m_phpi,m_shirley,m_sigmaph,m_wfd
      screening,sigma,wfk_analyze

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

 876 subroutine wfd_init(Wfd,Cryst,Pawtab,Psps,keep_ur,paral_kgb,npwwfn,mband,nband,nkibz,nsppol,bks_mask,&
 877 &  nspden,nspinor,ecutsm,dilatmx,istwfk,kibz,ngfft,gvec,nloalg,prtvol,pawprtvol,comm,opt_ecut)
 878 
 879 
 880 !This section has been created automatically by the script Abilint (TD).
 881 !Do not modify the following lines by hand.
 882 #undef ABI_FUNC
 883 #define ABI_FUNC 'wfd_init'
 884 !End of the abilint section
 885 
 886  implicit none
 887 
 888 !Arguments ------------------------------------
 889 !scalars
 890  integer,intent(in) :: paral_kgb,mband,comm,prtvol,pawprtvol
 891  integer,intent(in) :: nkibz,npwwfn,nsppol,nspden,nspinor
 892  real(dp),optional,intent(in) :: opt_ecut
 893  real(dp),intent(in) :: ecutsm,dilatmx
 894  type(crystal_t),intent(in) :: Cryst
 895  type(pseudopotential_type),intent(in) :: Psps
 896  type(wfd_t),intent(inout) :: Wfd
 897 !array
 898  integer,intent(in) :: ngfft(18),istwfk(nkibz),nband(nkibz,nsppol)
 899  integer,intent(in) :: gvec(3,npwwfn),nloalg(3)
 900  real(dp),intent(in) :: kibz(3,nkibz)
 901  logical,intent(in) :: bks_mask(mband,nkibz,nsppol)
 902  logical,intent(in) :: keep_ur(mband,nkibz,nsppol)
 903  type(Pawtab_type),intent(in) :: Pawtab(Cryst%ntypat*Psps%usepaw)
 904 
 905 !Local variables ------------------------------
 906 !scalars
 907  integer,parameter :: ider0=0,idir0=0,dum_unkg=0,dum_unylm=0,nfft0=0,mpw0=0,ikg0=0
 908  integer :: ig,ik_ibz,spin,band,mpw,exchn2n3d,istwf_k,npw_k,iatom,itypat,iat !,how_manyb
 909  real(dp) :: ug_size,ur_size,cprj_size,gsq,g1,g2,g3
 910  logical :: iscompatibleFFT
 911  character(len=500) :: msg
 912 !arrays
 913  integer :: dum_kg(3,0)
 914  real(dp) :: kpoint(3)
 915  !integer :: my_band_list(Wfd%mband)
 916 
 917 !************************************************************************
 918 
 919  DBG_ENTER("COLL")
 920 
 921  !@wfd_t
 922  call wfd_nullify(Wfd)
 923 
 924  ! Switch to k-centered G-spheres ff opt_ecut is used,
 925  Wfd%gamma_centered=.TRUE.
 926  if (PRESENT(opt_ecut)) then
 927    if (opt_ecut > tol6) then
 928      Wfd%gamma_centered=.FALSE.
 929      MSG_COMMENT("Using k-centered G-spheres.")
 930    end if
 931  end if
 932 
 933  Wfd%id=WFD_ID; WFD_ID=WFD_ID+1
 934 
 935  ! MPI info
 936  Wfd%comm    = comm
 937  Wfd%my_rank = xmpi_comm_rank(Wfd%comm)
 938  Wfd%nproc   = xmpi_comm_size(Wfd%comm)
 939  Wfd%master  = 0
 940 
 941  ABI_MALLOC(Wfd%bks_comm,(0:mband,0:nkibz,0:nsppol))
 942  Wfd%bks_comm = xmpi_comm_null
 943  !
 944  ! Sequential MPI datatype to be passed to abinit routines.
 945  call initmpi_seq(Wfd%MPI_enreg)
 946  call init_distribfft(Wfd%MPI_enreg%distribfft,'c',Wfd%MPI_enreg%nproc_fft,ngfft(2),ngfft(3))
 947  !
 948  ! === Basic dimensions ===
 949  Wfd%nkibz     = nkibz
 950  Wfd%nsppol    = nsppol
 951  Wfd%nspden    = nspden
 952  Wfd%nspinor   = nspinor
 953  Wfd%npwwfn    = npwwfn
 954  Wfd%paral_kgb = paral_kgb
 955  Wfd%nloalg    = nloalg
 956 
 957  Wfd%usepaw = Psps%usepaw
 958  Wfd%usewvl = 0 ! wavelets are not supported.
 959  Wfd%natom  = Cryst%natom
 960  Wfd%ntypat = Cryst%ntypat
 961  Wfd%lmnmax = Psps%lmnmax
 962  Wfd%prtvol = prtvol
 963  Wfd%pawprtvol = pawprtvol
 964 
 965  Wfd%ecutsm  = ecutsm
 966  Wfd%dilatmx = dilatmx
 967 
 968  ABI_MALLOC(Wfd%indlmn,(6,Wfd%lmnmax,Wfd%ntypat))
 969  Wfd%indlmn = Psps%indlmn
 970 
 971  if (Wfd%usepaw==1) then
 972    ABI_MALLOC(Wfd%nlmn_atm,(Cryst%natom))
 973    ABI_MALLOC(Wfd%nlmn_type,(Cryst%ntypat))
 974    do iatom=1,Cryst%natom
 975      Wfd%nlmn_atm(iatom)=Pawtab(Cryst%typat(iatom))%lmn_size
 976    end do
 977 
 978    do itypat=1,Cryst%ntypat
 979      Wfd%nlmn_type(itypat)=Pawtab(itypat)%lmn_size
 980    end do
 981 
 982    ABI_MALLOC(Wfd%nlmn_sort,(Cryst%natom))
 983    iat=0 ! nlmn dims sorted by atom type.
 984    do itypat=1,Cryst%ntypat
 985      Wfd%nlmn_sort(iat+1:iat+Cryst%nattyp(itypat))=Pawtab(itypat)%lmn_size
 986      iat=iat+Cryst%nattyp(itypat)
 987    end do
 988  end if
 989 
 990  ABI_MALLOC(Wfd%keep_ur,(mband,nkibz,nsppol))
 991  Wfd%keep_ur=keep_ur
 992  !
 993  ! Setup of the FFT mesh
 994  Wfd%ngfft  = ngfft
 995  Wfd%mgfft  = MAXVAL (Wfd%ngfft(1:3))
 996  Wfd%nfftot = PRODUCT(Wfd%ngfft(1:3))
 997  Wfd%nfft   = Wfd%nfftot ! At present no FFT parallelism.
 998  !
 999  ! Calculate ecut from input gvec.
1000  if (Wfd%gamma_centered) then
1001    Wfd%ecut=-one
1002    do ig=1,npwwfn
1003      g1=REAL(gvec(1,ig))
1004      g2=REAL(gvec(2,ig))
1005      g3=REAL(gvec(3,ig))
1006      gsq=      Cryst%gmet(1,1)*g1**2+Cryst%gmet(2,2)*g2**2+Cryst%gmet(3,3)*g3**2+ &
1007 &         two*(Cryst%gmet(1,2)*g1*g2+Cryst%gmet(1,3)*g1*g3+Cryst%gmet(2,3)*g2*g3)
1008      Wfd%ecut=MAX(Wfd%ecut,gsq)
1009    end do
1010    Wfd%ecut=two*Wfd%ecut*pi**2
1011  else
1012    Wfd%ecut=opt_ecut
1013  end if
1014  !
1015  ! Precalculate the FFT index of $ R^{-1} (r-\tau) $ used to symmetrize u_Rk.
1016  ABI_MALLOC(Wfd%irottb,(Wfd%nfftot,Cryst%nsym))
1017  call rotate_FFT_mesh(Cryst%nsym,Cryst%symrel,Cryst%tnons,Wfd%ngfft,Wfd%irottb,iscompatibleFFT)
1018 
1019  if (.not.iscompatibleFFT) then
1020    msg = "FFT mesh is not compatible with symmetries. Wavefunction symmetrization might be affected by large errors!"
1021    MSG_WARNING(msg)
1022  end if
1023  !
1024  ! Is the real space mesh compatible with the rotational part?
1025  Wfd%rfft_is_symok = check_rot_fft(Cryst%nsym,Cryst%symrel,Wfd%ngfft(1),Wfd%ngfft(2),Wfd%ngfft(3))
1026 
1027  ABI_MALLOC(Wfd%kibz,(3,Wfd%nkibz))
1028  Wfd%kibz=kibz
1029 
1030  ABI_MALLOC(Wfd%istwfk,(Wfd%nkibz))
1031  Wfd%istwfk=istwfk
1032 
1033  if (ANY(Wfd%istwfk/=1)) then
1034    if (Wfd%gamma_centered) then
1035      MSG_ERROR("if (ANY(Wfd%istwfk/=1) then Wfd%gamma_centered should be false")
1036    end if
1037    MSG_WARNING("istwfk/=1 still under development!")
1038    write(std_out,*)Wfd%istwfk
1039  end if
1040  !
1041  ! * Get the number of planewaves npw_k
1042  ABI_MALLOC(Wfd%npwarr,(Wfd%nkibz))
1043 
1044  if (Wfd%gamma_centered) then
1045    Wfd%npwarr = npwwfn
1046  else
1047    ! TODO Here we should use ecut_eff instead of ecut
1048    exchn2n3d=0
1049    do ik_ibz=1,Wfd%nkibz
1050      istwf_k = Wfd%istwfk(ik_ibz)
1051      kpoint  = Wfd%kibz(:,ik_ibz)
1052      call kpgsph(Wfd%ecut,exchn2n3d,Cryst%gmet,ikg0,ik_ibz,istwf_k,dum_kg,kpoint,0,Wfd%MPI_enreg,mpw0,npw_k)
1053      Wfd%npwarr(ik_ibz)= npw_k
1054    end do
1055  end if
1056 
1057  mpw = MAXVAL(Wfd%npwarr)
1058 
1059  ABI_MALLOC(Wfd%gvec,(3,npwwfn))
1060  Wfd%gvec=gvec  ! TODO For the time being, continue to use Gamma-centered basis set in Wfd%gvec.
1061 
1062  ABI_MALLOC(Wfd%nband,(nkibz,nsppol))
1063  Wfd%nband=nband
1064 
1065  Wfd%mband = mband
1066  ABI_CHECK(MAXVAL(Wfd%nband)==mband,"wrong mband")
1067 
1068  ! Allocate u(g) and, if required, also u(r) ===
1069  ug_size = one*nspinor*mpw*COUNT(bks_mask)
1070  write(msg,'(a,f12.1,a)')' Memory needed for Fourier components u(G) = ',two*gwpc*ug_size*b2Mb,' [Mb]'
1071  call wrtout(std_out,msg,'PERS')
1072 
1073  if (Wfd%usepaw==1) then
1074    cprj_size = one * nspinor*SUM(Wfd%nlmn_atm)*COUNT(bks_mask)
1075    write(msg,'(a,f12.1,a)')' Memory needed for PAW projections Cprj = ',dp*cprj_size*b2Mb,' [Mb]'
1076    call wrtout(std_out,msg,'PERS')
1077  end if
1078 
1079  ur_size = one*nspinor*Wfd%nfft*COUNT(Wfd%keep_ur)
1080  write(msg,'(a,f12.1,a)')' Memory needed for real-space u(r) = ',two*gwpc*ur_size*b2Mb,' [Mb]'
1081  call wrtout(std_out,msg,'PERS')
1082 
1083  ABI_DT_MALLOC(Wfd%Wave,(Wfd%mband,Wfd%nkibz,Wfd%nsppol))
1084 
1085  ! Allocate the wavefunctions in reciprocal space according to bks_mask.
1086  do spin=1,Wfd%nsppol
1087    do ik_ibz=1,Wfd%nkibz
1088      npw_k = Wfd%npwarr(ik_ibz)
1089      do band=1,Wfd%nband(ik_ibz,spin)
1090        if (bks_mask(band,ik_ibz,spin)) then
1091          !if (Wfd%keep_ur(band,ik_ibz,spin)) then
1092          !  call wave_init(Wfd%Wave(band,ik_ibz,spin),Wfd%usepaw,npw_k,Wfd%nfft,Wfd%nspinor,Wfd%natom,Wfd%nlmn_atm,CPR_RANDOM)
1093          !else
1094          call wave_init(Wfd%Wave(band,ik_ibz,spin),Wfd%usepaw,npw_k,nfft0,Wfd%nspinor,Wfd%natom,Wfd%nlmn_atm,CPR_RANDOM)
1095          !end if
1096        end if
1097      end do
1098    end do
1099  end do
1100 
1101  ! Allocate the global table used to keep trace of the distribution, including a possible duplication.
1102  ABI_MALLOC(Wfd%bks_tab,(Wfd%mband,nkibz,nsppol,0:Wfd%nproc-1))
1103  Wfd%bks_tab=WFD_NOWAVE
1104 
1105  ! Update the kbs table storing the distribution of the ug.
1106  call wfd_update_bkstab(Wfd, show=-std_out)
1107  !
1108  ! Initialize the MPI communicators.
1109  ! init MPI communicators:cannot be done here since waves are not stored yet.
1110  !call wfd_set_mpicomm(Wfd)
1111  !
1112  ! ===================================================
1113  ! ==== Precalculate nonlocal form factors for PAW ====
1114  ! ===================================================
1115  !
1116  ! Calculate 1-dim structure factor phase information.
1117  ABI_MALLOC(Wfd%ph1d,(2,3*(2*Wfd%mgfft+1)*Wfd%natom))
1118  call getph(Cryst%atindx,Wfd%natom,Wfd%ngfft(1),Wfd%ngfft(2),Wfd%ngfft(3),Wfd%ph1d,Cryst%xred)
1119 
1120  ABI_DT_MALLOC(Wfd%Kdata,(Wfd%nkibz))
1121 
1122  do ik_ibz=1,Wfd%nkibz
1123    kpoint  = Wfd%kibz(:,ik_ibz)
1124    istwf_k = Wfd%istwfk(ik_ibz)
1125    npw_k   = Wfd%npwarr(ik_ibz)
1126    if (wfd_ihave_ug(Wfd,0,ik_ibz,0)) then
1127      if (Wfd%gamma_centered) then
1128        call kdata_init(Wfd%Kdata(ik_ibz),Cryst,Psps,kpoint,istwf_k,ngfft,Wfd%MPI_enreg,kg_k=Wfd%gvec)
1129      else
1130        call kdata_init(Wfd%Kdata(ik_ibz),Cryst,Psps,kpoint,istwf_k,ngfft,Wfd%MPI_enreg,ecut=Wfd%ecut)
1131      end if
1132    end if
1133  end do
1134 
1135  DBG_EXIT("COLL")
1136 
1137 end subroutine wfd_init

m_wfd/wfd_iterator_bks [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_iterator_bks

FUNCTION

  Iterator used to loop over bands, k-points and spin indices
  taking into account the distribution of the ug.

INPUTS

  Wfd<wfd_t>=
  bks_mask(Wfd%mband.Wfd%nkibz,Wfd%nsppol)= mask used to select the (b,k,s) indices.

OUTPUT

  iter_bks<iter2_t>=Iterator over the bands treated by this node for each k-point and spin.

PARENTS

SOURCE

4361 function wfd_iterator_bks(Wfd, bks_mask) result(iter_bks)
4362 
4363 
4364 !This section has been created automatically by the script Abilint (TD).
4365 !Do not modify the following lines by hand.
4366 #undef ABI_FUNC
4367 #define ABI_FUNC 'wfd_iterator_bks'
4368 !End of the abilint section
4369 
4370  implicit none
4371 
4372 !Arguments ------------------------------------
4373 !scalars
4374  type(wfd_t),intent(in) :: Wfd
4375 !arrays
4376  logical,optional,intent(in) :: bks_mask(Wfd%mband,Wfd%nkibz,Wfd%nsppol)
4377  type(iter2_t) :: iter_bks
4378 
4379 !Local variables ------------------------------
4380 !scalars
4381  integer :: ik_ibz,spin,my_nband
4382 !arrays
4383  integer :: my_band_list(Wfd%mband)
4384 
4385 !************************************************************************
4386 
4387  call iter_alloc(iter_bks,(/Wfd%nkibz,Wfd%nsppol/))
4388 
4389  do spin=1,Wfd%nsppol
4390    do ik_ibz=1,Wfd%nkibz
4391      if (PRESENT(bks_mask)) then
4392        call wfd_distribute_bands(Wfd,ik_ibz,spin,my_nband,my_band_list,bmask=bks_mask(:,ik_ibz,spin))
4393      else
4394        call wfd_distribute_bands(Wfd,ik_ibz,spin,my_nband,my_band_list)
4395      end if
4396      call iter_push(iter_bks,ik_ibz,spin,my_band_list(1:my_nband))
4397    end do
4398  end do
4399 
4400 end function wfd_iterator_bks

m_wfd/wfd_itreat_spin [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_itreat_spin

FUNCTION

  Test if the processor is treating a block of wavefunctions with the specified spin.

INPUTS

   Wfd<type(wfd_t)>=Wavefunction descriptor.
   spin=Spin index.

OUTPUT

   comm_spin=Spin communicator
   rank_spin=Rank of this processor in comm_spin
   nproc_spin=Number of MPI nodes in comm_spin

NOTES

   Output variables are undefined if the function returns False.

PARENTS

SOURCE

3108 function wfd_itreat_spin(Wfd,spin,comm_spin,rank_spin,nproc_spin) result(ans)
3109 
3110 
3111 !This section has been created automatically by the script Abilint (TD).
3112 !Do not modify the following lines by hand.
3113 #undef ABI_FUNC
3114 #define ABI_FUNC 'wfd_itreat_spin'
3115 !End of the abilint section
3116 
3117  implicit none
3118 
3119 !Arguments ------------------------------------
3120 !scalars
3121  integer,intent(in) :: spin
3122  logical :: ans
3123  integer,intent(out) :: comm_spin,rank_spin,nproc_spin
3124  type(wfd_t),intent(in) :: Wfd
3125 
3126 !************************************************************************
3127  comm_spin = Wfd%bks_comm(0,0,spin)
3128  ans = .False.; rank_spin = xmpi_undefined_rank; nproc_spin = -1
3129 
3130  if (comm_spin /= xmpi_comm_null) then
3131    ans = .True.; rank_spin = xmpi_comm_rank(comm_spin); nproc_spin = xmpi_comm_size(comm_spin)
3132  end if
3133 
3134 #ifndef HAVE_MPI
3135  ABI_CHECK(ans, "wfd_itreat_spin must be always true in not HAVE_MPI!!")
3136 #endif
3137 
3138 end function wfd_itreat_spin

m_wfd/wfd_mkall_ur [ Functions ]

[ Top ] [ Functions ]

NAME

 wfd_mkall_ur

FUNCTION

  FFT transform from G to R the entire set of wavefunctions stored in the wfd_t.
  Only those waves whose status is WFD_ALLOCATED are calculated unless force is used.

INPUTS

  Wfd<wfd_t>=Structure containing the wave functions for the GW.

OUTPUT

  ncalc=Number of FFTs performed.
  [force]=If .TRUE. then force FFT even for waves whose status is WFD_STORED.

SIDE EFFECTS

  %ur

PARENTS

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

2028 subroutine wfd_mkall_ur(Wfd,ncalc,force)
2029 
2030 
2031 !This section has been created automatically by the script Abilint (TD).
2032 !Do not modify the following lines by hand.
2033 #undef ABI_FUNC
2034 #define ABI_FUNC 'wfd_mkall_ur'
2035 !End of the abilint section
2036 
2037  implicit none
2038 
2039 !Arguments ------------------------------------
2040 !scalars
2041  integer,intent(out) :: ncalc
2042  logical,optional,intent(in) :: force
2043  type(wfd_t),target,intent(inout) :: Wfd
2044 
2045 !Local variables ------------------------------
2046 !scalars
2047  integer,parameter :: ndat1=1
2048  integer :: spin,ik_ibz,band,npw_k
2049  logical :: do_fft
2050  integer,ABI_CONTIGUOUS pointer :: kg_k(:,:),gbound(:,:)
2051 
2052 !************************************************************************
2053 
2054 ! TODO FFTs should be done in bunches.
2055 !
2056  ncalc=0 !; if (.not.Wfd%keep_ur) RETURN
2057 
2058  do spin=1,Wfd%nsppol
2059    do ik_ibz=1,Wfd%nkibz
2060      npw_k  =  Wfd%npwarr(ik_ibz)
2061      kg_k   => Wfd%Kdata(ik_ibz)%kg_k
2062      gbound => Wfd%Kdata(ik_ibz)%gbound
2063 
2064      do band=1,Wfd%nband(ik_ibz,spin)
2065 
2066        if (.not.Wfd%keep_ur(band,ik_ibz,spin)) CYCLE
2067 
2068        do_fft = wfd_ihave_ur(Wfd,band,ik_ibz,spin,"Allocated")
2069        if (PRESENT(force)) do_fft = (do_fft .or. wfd_ihave_ur(Wfd,band,ik_ibz,spin,"Stored"))
2070 
2071        if (do_fft) then
2072          call fft_ug(npw_k,Wfd%nfft,Wfd%nspinor,ndat1,Wfd%mgfft,Wfd%ngfft,Wfd%istwfk(ik_ibz),kg_k,gbound,&
2073             Wfd%Wave(band,ik_ibz,spin)%ug,Wfd%Wave(band,ik_ibz,spin)%ur)
2074 
2075          ncalc = ncalc + 1
2076          Wfd%Wave(band,ik_ibz,spin)%has_ur=WFD_STORED  ! Update the status
2077        end if
2078 
2079      end do
2080    end do
2081  end do
2082 
2083 end subroutine wfd_mkall_ur

m_wfd/wfd_mkrho [ Functions ]

[ Top ] [ Functions ]

NAME

 wfd_mkrho

FUNCTION

 Calculate the charge density on the fine FFT grid in real space.

INPUTS

  ngfftf(18)=array containing all the information for the "fine" FFT.
  Cryst<crystal_t> Info on the crystalline structure
  optcalc=option for calculation. If =0 (default value) perform calculation
    of electronic density. If =1, perform calculation of kinetic energy density.
    In both cases, the result is returned in rhor.
  Psps<type(pseudopotential_type)>=variables related to pseudopotentials
  nfftf=Total number of points on the fine FFT grid (for this processor)
  Kmesh<kmesh_t>= Info on the k-sampling:
  Wfd<wfd_t)=datatype gathering info on the wavefunctions.
 [optcalc]=Optional option used to calculate the kinetic energy density. Defaults to 0.

OUTPUT

  rhor(nfftf,nspden)=The density in the real space on the fine FFT grid.
   If nsppol==2, total charge in first half, spin-up component in second half.
   (for non-collinear magnetism, first element: total density, 3 next ones: mx,my,mz in units of hbar/2)
   If optcalc==1 (optional argument, default value is 0), then rhor will actually
   contains kinetic energy density (taur) instead of electronic density.

NOTES

 In the case of PAW calculations:
    All computations are done on the fine FFT grid.
    All variables (nfftf,ngfftf,mgfftf) refer to this fine FFT grid.
    All arrays (densities/potentials...) are computed on this fine FFT grid.
    Developers have to be careful when introducing others arrays:
      they have to be stored on the fine FFT grid.
 In the case of norm-conserving calculations:
    The mesh is the usual augmented FFT grid to treat correctly the convolution.

PARENTS

      bethe_salpeter,screening,sigma

CHILDREN

      wrtout

SOURCE

6826 subroutine wfd_mkrho(Wfd,Cryst,Psps,Kmesh,Bands,ngfftf,nfftf,rhor,&
6827 &                    optcalc) ! optional arguments
6828 
6829 
6830 !This section has been created automatically by the script Abilint (TD).
6831 !Do not modify the following lines by hand.
6832 #undef ABI_FUNC
6833 #define ABI_FUNC 'wfd_mkrho'
6834 !End of the abilint section
6835 
6836  implicit none
6837 
6838 !Arguments ------------------------------------
6839 !scalars
6840  integer,intent(in) :: nfftf
6841  integer,intent(in),optional :: optcalc
6842  type(ebands_t),intent(in) :: Bands
6843  type(kmesh_t),intent(in) :: Kmesh
6844  type(crystal_t),intent(in) :: Cryst
6845  type(Pseudopotential_type),intent(in) :: Psps
6846  type(wfd_t),intent(inout) :: Wfd
6847 !arrays
6848  integer,intent(in) :: ngfftf(18)
6849  real(dp),intent(out) :: rhor(nfftf,Wfd%nspden)
6850 
6851 !Local variables ------------------------------
6852 !scalars
6853  integer,parameter :: ndat1=1
6854  integer :: cplex,ib,ib_iter,ierr,ik,ir,is,n1,n2,n3,nfftotf
6855  integer :: alpha,nalpha,ipw,myoptcalc
6856  real(dp) :: kpt_cart,kg_k_cart,gp2pi1,gp2pi2,gp2pi3,cwftmp,bks_weight
6857  character(len=500) :: msg
6858 !arrays
6859  integer,allocatable :: irrzon(:,:,:)
6860  real(dp),allocatable :: phnons(:,:,:),rhog(:,:),rhor_down(:),rhor_mx(:),rhor_my(:),cwavef(:,:)
6861  complex(dpc),allocatable :: wfr_x(:),wfr_y(:)
6862  complex(gwpc),allocatable :: gradug(:),work(:)
6863  complex(gwpc),allocatable,target :: wfr(:)
6864  complex(gwpc), ABI_CONTIGUOUS pointer :: cwavef1(:),cwavef2(:)
6865  type(iter2_t) :: Iter_bks
6866 
6867 !*************************************************************************
6868 
6869  DBG_ENTER("COLL")
6870 
6871  ! Consistency check.
6872  ABI_CHECK(Wfd%nsppol == Bands%nsppol, "Mismatch in nsppol")
6873 
6874  if (ANY(ngfftf(1:3) /= Wfd%ngfft(1:3))) call wfd_change_ngfft(Wfd,Cryst,Psps,ngfftf)
6875 
6876  ! Calculate IBZ contribution to the charge density.
6877  ABI_MALLOC(wfr, (nfftf*Wfd%nspinor))
6878 
6879  if (wfd%nspden == 4) then
6880    ABI_MALLOC(wfr_x, (nfftf))
6881    ABI_MALLOC(wfr_y, (nfftf))
6882    ABI_MALLOC(rhor_down, (nfftf))
6883    ABI_MALLOC(rhor_mx, (nfftf))
6884    ABI_MALLOC(rhor_my, (nfftf))
6885    rhor_down = zero; rhor_mx = zero; rhor_my = zero
6886  end if
6887 
6888  ! Update the (b,k,s) distribution table.
6889  call wfd_update_bkstab(Wfd)
6890 
6891  ! Calculate the unsymmetrized density.
6892  rhor=zero
6893  myoptcalc=0; if (present(optcalc)) myoptcalc=optcalc
6894  nalpha=1; if (myoptcalc==1) nalpha=3
6895  if (myoptcalc == 1 .and. wfd%nspinor == 2) then
6896    MSG_ERROR("kinetic energy density with nspinor == 2 not implemented")
6897  end if
6898 
6899  ! Build the iterator that will distribute the states in an automated way.
6900  Iter_bks = wfd_iterator_bks(Wfd,bks_mask=ABS(Bands%occ)>=tol8)
6901 
6902  do alpha=1,nalpha
6903    do is=1,Wfd%nsppol
6904      do ik=1,Wfd%nkibz
6905        do ib_iter=1,iter_len(Iter_bks,ik,is)
6906          ib = iter_yield(Iter_bks,ib_iter,ik,is)
6907          bks_weight = Bands%occ(ib,ik,is) * Kmesh%wt(ik) / Cryst%ucvol
6908 
6909          call wfd_get_ur(Wfd,ib,ik,is,wfr)
6910 
6911          cwavef1 => wfr(1:nfftf)
6912          if (myoptcalc == 1) then
6913            ABI_MALLOC(gradug,(Wfd%Kdata(ik)%npw))
6914            ABI_MALLOC(cwavef,(2,Wfd%Kdata(ik)%npw))
6915            ABI_MALLOC(work,(nfftf))
6916            cwavef(1,:)= REAL(Wfd%Wave(ib,ik,is)%ug(:))
6917            cwavef(2,:)=AIMAG(Wfd%Wave(ib,ik,is)%ug(:))
6918 !          Multiplication by 2pi i (k+G)_alpha
6919            gp2pi1=Cryst%gprimd(alpha,1)*two_pi
6920            gp2pi2=Cryst%gprimd(alpha,2)*two_pi
6921            gp2pi3=Cryst%gprimd(alpha,3)*two_pi
6922            kpt_cart=gp2pi1*Wfd%kibz(1,ik)+gp2pi2*Wfd%kibz(2,ik)+gp2pi3*Wfd%kibz(3,ik)
6923            do ipw=1,Wfd%Kdata(ik)%npw
6924              kg_k_cart= gp2pi1*Wfd%Kdata(ik)%kg_k(1,ipw) + &
6925 &                       gp2pi2*Wfd%Kdata(ik)%kg_k(2,ipw) + &
6926 &                       gp2pi3*Wfd%Kdata(ik)%kg_k(3,ipw)+kpt_cart
6927 !             ipwsp=ipw!+(ispinor-1)*Wfd%Kdata(ik)%npw
6928              cwftmp=-cwavef(2,ipw)*kg_k_cart
6929              cwavef(2,ipw)=cwavef(1,ipw)*kg_k_cart
6930              cwavef(1,ipw)=cwftmp
6931            end do
6932            gradug(:)=CMPLX(cwavef(1,:),cwavef(2,:),gwpc)
6933            call fft_ug(Wfd%npwarr(ik),nfftf,Wfd%nspinor,ndat1,Wfd%mgfft,Wfd%ngfft,&
6934 &            Wfd%istwfk(ik),Wfd%Kdata(ik)%kg_k,Wfd%Kdata(ik)%gbound,gradug,work)
6935            cwavef1(:)=work(:)
6936            ABI_FREE(work)
6937            ABI_FREE(cwavef)
6938            ABI_FREE(gradug)
6939          end if
6940 
6941 !$OMP PARALLEL DO
6942          do ir=1,nfftf
6943            rhor(ir,is) = rhor(ir,is) + CONJG(cwavef1(ir)) * cwavef1(ir) * bks_weight
6944          end do
6945          !call cplx_addtorho(n1,n2,n3,n4,n5,n6,ndat,weight_r,ur,rho)
6946 
6947          if (wfd%nspinor == 2 .and. wfd%nspden == 1) then
6948            cwavef2 => wfr(1+nfftf:2*nfftf)
6949            do ir=1,nfftf
6950              rhor(ir, 1) = rhor(ir, 1) + CONJG(cwavef2(ir)) * cwavef2(ir) * bks_weight
6951            end do
6952          end if
6953 
6954          if (wfd%nspinor == 2 .and. wfd%nspden == 4) then
6955            cwavef2 => wfr(1+nfftf:2*nfftf)
6956            wfr_x(:) = cwavef1(:) + cwavef2(:)       ! $(\Psi^{1}+\Psi^{2})$
6957            wfr_y(:) = cwavef1(:) -j_dpc*cwavef2(:)  ! $(\Psi^{1}-i\Psi^{2})$
6958 !$OMP PARALLEL DO
6959            do ir=1,nfftf
6960              rhor_down(ir) = rhor_down(ir) + CONJG(cwavef2(ir)) * cwavef2(ir) * bks_weight
6961              rhor_mx(ir) = rhor_mx(ir) + CONJG(wfr_x(ir)) * wfr_x(ir) * bks_weight
6962              rhor_my(ir) = rhor_my(ir) + CONJG(wfr_y(ir)) * wfr_y(ir) * bks_weight
6963            end do
6964          end if
6965 
6966        end do
6967      end do
6968    end do
6969 
6970  end do ! enddo alpha
6971 
6972  call iter_free(Iter_bks)
6973 
6974  select case (myoptcalc)
6975  case (0)
6976    ! density
6977    if (wfd%nspden == 4) then
6978      rhor(:, 2) = rhor_mx
6979      rhor(:, 3) = rhor_my
6980      rhor(:, 4) = rhor_down
6981    end if
6982  case (1)
6983    ! convention for taur = 1/2 Sum_i |grad phi_i|^2
6984    rhor(:,:)=half*rhor(:,:)
6985 
6986  case default
6987    MSG_ERROR(sjoin("Wrong myoptcalc:", itoa(myoptcalc)))
6988  end select
6989 
6990  call xmpi_sum(rhor,Wfd%comm,ierr)
6991 
6992  ! Symmetrization in G-space implementing also the AFM case
6993  n1=ngfftf(1); n2=ngfftf(2); n3=ngfftf(3); nfftotf=n1*n2*n3
6994 
6995  ABI_MALLOC(irrzon,(nfftotf**(1-1/Cryst%nsym),2,(Wfd%nspden/Wfd%nsppol)-3*(Wfd%nspden/4)))
6996  ABI_MALLOC(phnons,(2,nfftotf,(Wfd%nspden/Wfd%nsppol)-3*(Wfd%nspden/4)))
6997 
6998  if (Cryst%nsym/=1) then
6999    call irrzg(irrzon,Wfd%nspden,Wfd%nsppol,Cryst%nsym,n1,n2,n3,phnons,Cryst%symafm,Cryst%symrel,Cryst%tnons)
7000  end if
7001 
7002  ! Symmetrize rho(r), and pack nspden components following abinit conventions.
7003  cplex=1
7004  ABI_MALLOC(rhog,(2,cplex*nfftf))
7005 
7006  call symrhg(cplex,Cryst%gprimd,irrzon,Wfd%MPI_enreg,nfftf,nfftotf,ngfftf,Wfd%nspden,Wfd%nsppol,&
7007 &  Cryst%nsym,Wfd%paral_kgb,phnons,rhog,rhor,Cryst%rprimd,Cryst%symafm,Cryst%symrel)
7008 
7009  ABI_FREE(rhog)
7010  ABI_FREE(phnons)
7011  ABI_FREE(irrzon)
7012 
7013  ! Find and print minimum and maximum total electron density
7014  ! (or total kinetic energy density, or total element of kinetic energy density tensor) and locations
7015  !call wrtout(std_out,'mkrho: echo density (plane-wave part only)','COLL')
7016  !call prtrhomxmn(std_out,wfd%mpi_enreg,nfftf,ngfftf,wfd%nspden,1,rhor,optrhor=optcalc,ucvol=crystl%ucvol)
7017 
7018  write(msg,'(a,f9.4)')' planewave contribution to nelect: ',SUM(rhor(:,1))*Cryst%ucvol/nfftf
7019  call wrtout(std_out,msg,'COLL')
7020 
7021  if (Wfd%nspden==4) then
7022    write(msg,'(a,3f9.4)')&
7023      ' mx, my, mz: ',SUM(rhor(:,2))*Cryst%ucvol/nfftf,SUM(rhor(:,3))*Cryst%ucvol/nfftf,SUM(rhor(:,4))*Cryst%ucvol/nfftf
7024    call wrtout(std_out,msg,'COLL')
7025  end if
7026 
7027  ABI_FREE(wfr)
7028 
7029  if (Wfd%nspden == 4) then
7030    ABI_FREE(wfr_x)
7031    ABI_FREE(wfr_y)
7032    ABI_FREE(rhor_down)
7033    ABI_FREE(rhor_mx)
7034    ABI_FREE(rhor_my)
7035  end if
7036 
7037  DBG_EXIT("COLL")
7038 
7039 end subroutine wfd_mkrho

m_wfd/wfd_mybands [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_mybands

FUNCTION

  Return the list of band indices of the ug owned by this node at given (k,s).

INPUTS

  ik_ibz=Index of the k-point in the IBZ
  spin=spin index
  [how]=string defining which status is checked.
    Possible mutually exclusive values: "Allocated", "Stored".
    Only the first character is checked (no case-sensitive)
    By default the list of bands whose status is either WFD_ALLOCATED or WFD_STORED is returned.

OUTPUT

  how_manyb=The number of bands owned by this node
  my_band_list(Wfd%mband)=The first how_manyb values are the bands treated by this node.

PARENTS

      m_wfd

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

3290 subroutine wfd_mybands(Wfd,ik_ibz,spin,how_manyb,my_band_list,how)
3291 
3292 
3293 !This section has been created automatically by the script Abilint (TD).
3294 !Do not modify the following lines by hand.
3295 #undef ABI_FUNC
3296 #define ABI_FUNC 'wfd_mybands'
3297 !End of the abilint section
3298 
3299  implicit none
3300 
3301 !Arguments ------------------------------------
3302 !scalars
3303  integer,intent(in) :: ik_ibz,spin
3304  integer,intent(out) :: how_manyb
3305  character(len=*),optional,intent(in) :: how
3306  type(wfd_t),intent(in) :: Wfd
3307 !arrays
3308  integer,intent(out) :: my_band_list(Wfd%mband)
3309 
3310 !Local variables ------------------------------
3311 !scalars
3312  integer :: band
3313  logical :: do_have
3314 
3315 !************************************************************************
3316 
3317  how_manyb=0; my_band_list=-1
3318  do band=1,Wfd%nband(ik_ibz,spin)
3319    if (PRESENT(how)) then
3320      do_have = wfd_ihave_ug(Wfd,band,ik_ibz,spin,how=how)
3321    else
3322      do_have = wfd_ihave_ug(Wfd,band,ik_ibz,spin)
3323    end if
3324    if (do_have) then
3325      how_manyb = how_manyb +1
3326      my_band_list(how_manyb)=band
3327    end if
3328  end do
3329 
3330 end subroutine wfd_mybands

m_wfd/wfd_norm2 [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_norm2

FUNCTION

   Compute <u_{bks}|u_{bks}> in reciprocal space

INPUTS

  Wfd<wfd_t>=the wavefunction descriptor.
  Cryst<crystal_t>=Structure describing the crystal structure and its symmetries.
  Pawtab(ntypat*usepaw)<type(pawtab_type)>=PAW tabulated starting data.
  band=Band index.
  ik_bz=Index of the k-point in the BZ.
  spin=Spin index

PARENTS

SOURCE

1391 function wfd_norm2(Wfd,Cryst,Pawtab,band,ik_ibz,spin) result(norm2)
1392 
1393 
1394 !This section has been created automatically by the script Abilint (TD).
1395 !Do not modify the following lines by hand.
1396 #undef ABI_FUNC
1397 #define ABI_FUNC 'wfd_norm2'
1398 !End of the abilint section
1399 
1400  implicit none
1401 
1402 !Arguments ------------------------------------
1403 !scalars
1404  integer,intent(in) :: band,ik_ibz,spin
1405  real(dp) :: norm2
1406  type(crystal_t),intent(in) :: Cryst
1407  type(wfd_t),target,intent(inout) :: Wfd
1408  type(Pawtab_type),intent(in) :: Pawtab(Cryst%ntypat*Wfd%usepaw)
1409 !arrays
1410 
1411 !Local variables ------------------------------
1412 !scalars
1413  integer :: npw_k,istwf_k
1414  complex(dpc) :: cdum
1415 !arrays
1416  real(dp) :: pawovlp(2)
1417  complex(gwpc),ABI_CONTIGUOUS pointer :: ug1(:)
1418  type(pawcprj_type),allocatable :: Cp1(:,:)
1419 
1420 !************************************************************************
1421 
1422  ! Planewave part.
1423  npw_k   = Wfd%npwarr(ik_ibz)
1424  istwf_k = Wfd%istwfk(ik_ibz)
1425 
1426  ug1 => Wfd%Wave(band,ik_ibz,spin)%ug
1427  cdum = xdotc(Wfd%nspinor*npw_k,ug1,1,ug1,1)
1428 
1429  if (istwf_k>1) then
1430    cdum=two*DBLE(cdum)
1431    if (istwf_k==2) cdum=cdum-CONJG(ug1(1))*ug1(1)
1432  end if
1433 
1434  ! Paw on-site term.
1435  if (Wfd%usepaw==1) then
1436    ! Avoid the computation if Cprj are already in memory with the correct order.
1437    if (wfd_ihave_cprj(Wfd,band,ik_ibz,spin,how="Stored") .and. &
1438 &      Wfd%Wave(band,ik_ibz,spin)%cprj_order == CPR_RANDOM) then
1439 
1440 ! TODO  here aliasing is not a problem because Cp is intent(in) but, for optimization
1441 !       purposes, it would be useful to have another version of paw_overlap with a single Cprj.
1442        pawovlp = paw_overlap(Wfd%Wave(band,ik_ibz,spin)%Cprj,&
1443 &                            Wfd%Wave(band,ik_ibz,spin)%Cprj,Cryst%typat,Pawtab)
1444 
1445        cdum = cdum + CMPLX(pawovlp(1),pawovlp(2))
1446 
1447    else
1448      ! Compute Cproj
1449      ABI_DT_MALLOC(Cp1,(Wfd%natom,Wfd%nspinor))
1450      call pawcprj_alloc(Cp1,0,Wfd%nlmn_atm)
1451 
1452      call wfd_get_cprj(Wfd,band,ik_ibz,spin,Cryst,Cp1,sorted=.FALSE.)
1453      pawovlp = paw_overlap(Cp1,Cp1,Cryst%typat,Pawtab)
1454      cdum = cdum + CMPLX(pawovlp(1),pawovlp(2))
1455 
1456      call pawcprj_free(Cp1)
1457      ABI_DT_FREE(Cp1)
1458    end if
1459  end if
1460 
1461  norm2 = DBLE(cdum)
1462 
1463 end function wfd_norm2

m_wfd/wfd_nullify [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_nullify

FUNCTION

  Nullify the pointers of the data structure.

PARENTS

      m_wfd

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

1872 subroutine wfd_nullify(Wfd)
1873 
1874 
1875 !This section has been created automatically by the script Abilint (TD).
1876 !Do not modify the following lines by hand.
1877 #undef ABI_FUNC
1878 #define ABI_FUNC 'wfd_nullify'
1879 !End of the abilint section
1880 
1881  implicit none
1882 
1883 !Arguments ------------------------------------
1884 !scalars
1885  type(wfd_t),intent(inout) :: Wfd
1886 !************************************************************************
1887 
1888  !@wfd_t
1889 ! datatypes
1890  call nullify_mpi_enreg(Wfd%MPI_enreg)
1891 
1892 end subroutine wfd_nullify

m_wfd/wfd_paw_get_aeur [ Functions ]

[ Top ] [ Functions ]

NAME

 wfd_paw_get_aeur

FUNCTION

   Compute the AE PAW wavefunction in real space.

INPUTS

   band,ik_ibz,spin=indices specifying the band, the k-point and the spin.
   Psps<pseudopotential_type>=variables related to pseudopotentials
   Cryst<crystal_t>= data type gathering info on symmetries and unit cell.
   Wfd<wfd_t>=wavefunction descriptor.
   Pawtab(ntypat*usepaw)<type(pawtab_type)>=paw tabulated starting data.
   Pawfgrtab(natom)<pawfgrtab_type>= atomic data given on fine rectangular grid.
     NB: rpaw should be used in nhatgrid to initialize the datatype (optcut=1 option) instead of the radius for the
     shape functions (rpaw /= rshp).
   Paw_onsite(natom)<paw_pwaves_lmn_t>=3D PAW partial waves in real space for each FFT point in the PAW spheres.

OUTPUT

 ur_ae(Wfd%nfft*Wfd%nspinor)=AE PAW wavefunction in real space.
 [ur_ae_onsite(Wfd%nfft*Wfd%nspinor)]
 [ur_ps_onsite(Wfd%nfft*Wfd%nspinor)]

NOTES

  (1) The true wavefunction integrates in real space to the unit cell volume.
      The definition of the cprj matrix elements includes the term 1/SQRT(ucvol) that comes
      from the use of a normalized planewave e^(iG.r)/SQRT(omega) in the FFT transform G-->R (see e.g. opernla_ylm)
      On the contrary, the convention for the G-->R transform employed in the FFT routines used in abinit is
      u(r) = sum_G u(G) e^(iG.r); u(G) = one/omega \int u(r) e^(-iG.r)dr.
      Hence we have to multiply the onsite part by SQRT(uvol) before adding the smooth FFT part in real space.

  (2) Care has to be taken in the calculation of the onsite contribution when the FFT point belongs to the PAW
      sphere of a periodically repeated atom. In this case one evaluates the onsite term associated to the
      atom in the first unit cell then the contribution has to be multiplied by a k- dependent
      phase factor to account for the wrapping of the real-space point in the first unit cell.

PARENTS

      calc_sigc_me,calc_sigx_me,cchi0,cchi0q0,classify_bands,m_wfd
      prep_calc_ucrpa,wfk_analyze

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

6272 subroutine wfd_paw_get_aeur(Wfd,band,ik_ibz,spin,Cryst,Paw_onsite,Psps,Pawtab,Pawfgrtab,ur_ae,ur_ae_onsite,ur_ps_onsite)
6273 
6274 
6275 !This section has been created automatically by the script Abilint (TD).
6276 !Do not modify the following lines by hand.
6277 #undef ABI_FUNC
6278 #define ABI_FUNC 'wfd_paw_get_aeur'
6279 !End of the abilint section
6280 
6281  implicit none
6282 
6283 !Arguments ------------------------------------
6284 !scalars
6285  integer,intent(in) :: band,ik_ibz,spin
6286  type(pseudopotential_type),intent(in) :: Psps
6287  type(crystal_t),intent(in) :: Cryst
6288  type(wfd_t),intent(inout) :: Wfd
6289 !arrays
6290  type(pawtab_type),intent(in) :: Pawtab(Cryst%ntypat)
6291  type(pawfgrtab_type),intent(in) :: Pawfgrtab(Cryst%natom)
6292  type(paw_pwaves_lmn_t),intent(in) :: Paw_onsite(Cryst%natom)
6293  complex(gwpc),intent(out) :: ur_ae(Wfd%nfft*Wfd%nspinor)
6294  complex(gwpc),optional,intent(out) :: ur_ae_onsite(Wfd%nfft*Wfd%nspinor)
6295  complex(gwpc),optional,intent(out) :: ur_ps_onsite(Wfd%nfft*Wfd%nspinor)
6296 
6297 !Local variables-------------------------------
6298 !scalars
6299  integer :: itypat,ln_size,lmn_size,iatom,spinor
6300  integer :: nfgd,ifgd,jlmn,jl,jm,ifftsph
6301  real(dp) :: phj,tphj,arg,re_cp,im_cp
6302  complex(dpc) :: cp,cnorm
6303 !arrays
6304  real(dp) :: kpoint(3)
6305  complex(dpc),allocatable :: ceikr(:),phk_atm(:)
6306  type(pawcprj_type),allocatable :: Cp1(:,:)
6307 
6308 ! *************************************************************************
6309 
6310  ! TODO ngfft should be included in pawfgrtab_type
6311  !% if (ANY(Wfd%ngfft(1:3)/=Pawfgrtab%ngfft(1:3)) then
6312  !!  MSG_ERROR("Wfd%ngfft(1:3)/=Pawfgrtab%ngfft(1:3)")
6313  !% end if
6314 
6315  call wfd_get_ur(Wfd,band,ik_ibz,spin,ur_ae)
6316 
6317  kpoint = Wfd%kibz(:,ik_ibz)
6318 
6319  ABI_MALLOC(ceikr,(Wfd%nfftot))
6320 
6321  call calc_ceikr(kpoint,Wfd%nfftot,Wfd%ngfft,ceikr)
6322  ur_ae = ur_ae * ceikr
6323 
6324  ABI_DT_MALLOC(Cp1,(Wfd%natom,Wfd%nspinor))
6325  call pawcprj_alloc(Cp1,0,Wfd%nlmn_atm)
6326 
6327  call wfd_get_cprj(Wfd,band,ik_ibz,spin,Cryst,Cp1,sorted=.FALSE.)
6328  !
6329  ! === Add onsite term on the augmented FFT mesh ===
6330  if (PRESENT(ur_ae_onsite)) ur_ae_onsite = czero
6331  if (PRESENT(ur_ps_onsite)) ur_ps_onsite = czero
6332 
6333  ABI_CHECK(Wfd%nspinor==1,"nspinor==1 not coded")
6334 
6335  do iatom=1,Cryst%natom
6336    itypat  =Cryst%typat(iatom)
6337    lmn_size=Pawtab(itypat)%lmn_size
6338    ln_size =Pawtab(itypat)%basis_size   ! no. of nl elements in PAW basis.
6339    nfgd    =Pawfgrtab(iatom)%nfgd       ! no. of points in the fine grid for this PAW sphere.
6340 
6341    ABI_MALLOC(phk_atm,(nfgd))
6342    do ifgd=1,nfgd
6343      arg = -two_pi* DOT_PRODUCT(Paw_onsite(iatom)%r0shift(:,ifgd),kpoint)
6344      phk_atm(ifgd) = DCMPLX(COS(arg),SIN(arg))
6345    end do
6346 
6347    do spinor=1,Wfd%nspinor
6348      do jlmn=1,lmn_size
6349        jl=Psps%indlmn(1,jlmn,itypat)
6350        jm=Psps%indlmn(2,jlmn,itypat)
6351        re_cp = Cp1(iatom,spinor)%cp(1,jlmn)
6352        im_cp = Cp1(iatom,spinor)%cp(2,jlmn)
6353        cp = DCMPLX(re_cp, im_cp) * SQRT(Cryst%ucvol) ! Pay attention here. see (1).
6354 
6355        do ifgd=1,nfgd ! loop over fine grid points in current PAW sphere.
6356          ifftsph = Pawfgrtab(iatom)%ifftsph(ifgd) ! index of the point on the grid
6357          phj  = Paw_onsite(iatom)% phi(ifgd,jlmn)
6358          tphj = Paw_onsite(iatom)%tphi(ifgd,jlmn)
6359          ur_ae(ifftsph)           = ur_ae(ifftsph) + cp * (phj-tphj) * phk_atm(ifgd)
6360          if (PRESENT(ur_ae_onsite)) ur_ae_onsite(ifftsph) = ur_ae_onsite(ifftsph) + cp *  phj * phk_atm(ifgd)
6361          if (PRESENT(ur_ps_onsite)) ur_ps_onsite(ifftsph) = ur_ps_onsite(ifftsph) + cp * tphj * phk_atm(ifgd)
6362        end do
6363      end do !jlmn
6364    end do !spinor
6365 
6366    ABI_FREE(phk_atm)
6367  end do !iatom
6368  !
6369  ! * Remove the phase e^{ikr}, u(r) is returned.
6370  ur_ae = ur_ae * CONJG(ceikr)
6371  cnorm = xdotc(Wfd%nfft*Wfd%nspinor,ur_ae,1,ur_ae,1)/Wfd%nfft
6372  !write(std_out,*)" AE PAW norm: (b,k,s)",band,ik_ibz,spin,REAL(cnorm)
6373 
6374  if (PRESENT(ur_ae_onsite)) ur_ae_onsite = ur_ae_onsite * CONJG(ceikr)
6375  if (PRESENT(ur_ps_onsite)) ur_ps_onsite = ur_ps_onsite * CONJG(ceikr)
6376 
6377  call pawcprj_free(Cp1)
6378  ABI_DT_FREE(Cp1)
6379  ABI_FREE(ceikr)
6380 
6381 end subroutine wfd_paw_get_aeur

m_wfd/wfd_pawrhoij [ Functions ]

[ Top ] [ Functions ]

NAME

 wfd_pawrhoij

FUNCTION

 Calculate the PAW quantities rhoij (augmentation occupancies)
 Remember:for each atom, rho_ij=Sum_{n,k} {occ(n,k)*<Cnk|p_i><p_j|Cnk>}

INPUTS

  atindx1(natom)=index table for atoms, inverse of atindx
  cprj(natom,nspinor*mband*mkmem*nsppol)= wave functions projected with non-local projectors:
                                   cprj_nk(i)=<p_i|Cnk> where p_i is a non-local projector.
  istwfk(nkpt)=parameter that describes the storage of wfs
  kptopt=option for the generation of k points
  mband=maximum number of bands
  natom=number of atoms in cell
  nkpt=number of k points
  nspinor=number of spinorial components of the wavefunctions
  nsppol=1 for unpolarized, 2 for spin-polarized
  occ(mband*nkpt*nsppol)=occupation number for each band for each k
  pawprtvol=control print volume and debugging output for PAW

SIDE EFFECTS

  pawrhoij(natom) <type(pawrhoij_type)>= paw rhoij occupancies and related data
  On input: arrays dimensions
  On output:
    pawrhoij(:)%rhoij_(lmn2_size,nspden)=
          Sum_{n,k} {occ(n,k)*conjugate[cprj_nk(ii)].cprj_nk(jj)} (non symetrized)

PARENTS

      paw_qpscgw

CHILDREN

      pawaccrhoij,pawcprj_alloc,pawcprj_free,pawio_print_ij
      pawrhoij_mpisum_unpacked,wfd_bks_distrb,wfd_get_cprj,wrtout

SOURCE

7196 subroutine wfd_pawrhoij(Wfd,Cryst,Bst,kptopt,pawrhoij,pawprtvol)
7197 
7198 
7199 !This section has been created automatically by the script Abilint (TD).
7200 !Do not modify the following lines by hand.
7201 #undef ABI_FUNC
7202 #define ABI_FUNC 'wfd_pawrhoij'
7203 !End of the abilint section
7204 
7205  implicit none
7206 
7207 !Arguments ---------------------------------------------
7208 !scalars
7209  integer,intent(in) :: kptopt,pawprtvol
7210  type(crystal_t),intent(in) :: Cryst
7211  type(wfd_t),intent(inout) :: Wfd
7212  type(ebands_t),intent(in) :: Bst
7213 !arrays
7214  type(pawrhoij_type),intent(inout) :: pawrhoij(Wfd%natom)
7215 
7216 !Local variables ---------------------------------------
7217 !scalars
7218  integer :: cplex,iatom,band,ik_ibz
7219  integer :: spin,natinc,nband_k,nsp2,option,rhoij_cplex,lmn2_size,nspden
7220  logical :: usetimerev
7221  real(dp) :: occup,wtk_k
7222  character(len=500) :: msg
7223 !arrays
7224  integer,allocatable :: idum(:)
7225  !real(dp) :: tsec(2)
7226  character(len=8),parameter :: dspin(6)=(/"up      ","down    ","dens (n)","magn (x)","magn (y)","magn (z)"/)
7227  type(pawcprj_type),allocatable :: cwaveprj(:,:)
7228  integer :: bks_distrb(Wfd%mband,Wfd%nkibz,Wfd%nsppol)
7229  integer :: got(Wfd%nproc)
7230  logical :: bks_mask(Wfd%mband,Wfd%nkibz,Wfd%nsppol)
7231 
7232 !************************************************************************
7233 
7234  DBG_ENTER("COLL")
7235 
7236  ! Allocate temporary cwaveprj storage (sorted by atom type)
7237  ABI_DATATYPE_ALLOCATE(cwaveprj,(Wfd%natom,Wfd%nspinor))
7238  call pawcprj_alloc(cwaveprj,0,Wfd%nlmn_sort)
7239 
7240  ! Initialize output quantities if not already done.
7241  do iatom=1,Wfd%natom
7242    if (pawrhoij(iatom)%use_rhoij_==0) then
7243      rhoij_cplex     = pawrhoij(iatom)%cplex
7244      lmn2_size = pawrhoij(iatom)%lmn2_size
7245      nspden    = pawrhoij(iatom)%nspden
7246      ABI_ALLOCATE(pawrhoij(iatom)%rhoij_,(rhoij_cplex*lmn2_size,nspden))
7247      pawrhoij(iatom)%use_rhoij_=1
7248    end if
7249    pawrhoij(iatom)%rhoij_=zero
7250  end do
7251 
7252  option=1; usetimerev=(kptopt>0.and.kptopt<3)
7253 
7254  ! Distribute (b,k,s).
7255  where (ABS(Bst%occ)>tol8)
7256    bks_mask=.TRUE.
7257  else where
7258    bks_mask=.FALSE.
7259  end where
7260  got=zero
7261 
7262  call wfd_bks_distrb(Wfd,bks_distrb,got,bks_mask)
7263 
7264  do spin=1,Wfd%nsppol
7265    do ik_ibz=1,Wfd%nkibz
7266 
7267      nband_k=Wfd%nband(ik_ibz,spin)
7268      wtk_k=Bst%wtk(ik_ibz)
7269 
7270      cplex=2; if (Wfd%istwfk(ik_ibz)>1) cplex=1
7271 
7272      do band=1,nband_k
7273 
7274        if (bks_distrb(band,ik_ibz,spin) == Wfd%my_rank) then
7275          !locc_test = (abs(Bst%occ(band,ik_ibz,spin))>tol8)
7276          occup = Bst%occ(band,ik_ibz,spin)
7277 
7278           ! Extract cprj for current band cwaveprj are sorted by atom type.
7279           call wfd_get_cprj(Wfd,band,ik_ibz,spin,Cryst,cwaveprj,sorted=.TRUE.)
7280 
7281           ! Accumulate contribution from (occupied) current band
7282           !if (locc_test) then
7283            call pawaccrhoij(Cryst%atindx,cplex,cwaveprj,cwaveprj ,0,spin,Wfd%natom,Wfd%natom,&
7284 &            Wfd%nspinor,occup,option,pawrhoij,usetimerev,wtk_k)
7285           !end if
7286        end if
7287      end do !band
7288 
7289    end do !ik_ibz
7290  end do !spin
7291  !
7292  ! Free temporary cwaveprj storage.
7293  call pawcprj_free(cwaveprj)
7294  ABI_DATATYPE_DEALLOCATE(cwaveprj)
7295  !
7296  !==========================================
7297  ! MPI: need to exchange arrays between procs
7298  ! TODO it should be tested.
7299  call pawrhoij_mpisum_unpacked(pawrhoij,Wfd%comm)
7300  !
7301  ! Print info.
7302  if (abs(pawprtvol)>=1) then
7303    natinc=1; if(Wfd%natom>1.and.pawprtvol>=0) natinc=Wfd%natom-1
7304    do iatom=1,Cryst%natom,natinc
7305      nsp2=pawrhoij(iatom)%nsppol;if (pawrhoij(iatom)%nspden==4) nsp2=4
7306      write(msg, '(4a,i3,a)') ch10," PAW TEST:",ch10,&
7307 &     ' ====== Values of RHOIJ in wfd_pawrhoij (iatom=',iatom,') ======'
7308      if (pawrhoij(iatom)%nspden==2.and.pawrhoij(iatom)%nsppol==1) write(msg,'(3a)') trim(msg),ch10,&
7309 &     '      (antiferromagnetism case: only one spin component)'
7310      call wrtout(std_out,msg,'COLL')
7311      do spin=1,nsp2
7312        if (pawrhoij(iatom)%nspden/=1) then
7313          write(msg, '(3a)') '   Component ',trim(dspin(spin+2*(pawrhoij(iatom)%nspden/4))),':'
7314          call wrtout(std_out,msg,'COLL')
7315        end if
7316        call pawio_print_ij(std_out,pawrhoij(iatom)%rhoij_(:,spin),pawrhoij(iatom)%lmn2_size,&
7317 &       pawrhoij(iatom)%cplex,pawrhoij(iatom)%lmn_size,-1,idum,0,pawprtvol,idum,-1.d0,1)
7318      end do
7319    end do
7320  end if
7321 
7322  DBG_EXIT("COLL")
7323 
7324 end subroutine wfd_pawrhoij

m_wfd/wfd_plot_ur [ Functions ]

[ Top ] [ Functions ]

NAME

 wfd_plot_ur

FUNCTION

  This routine writes the squared modulus of the wavefunctions in real space
  to an external files, one for each (k,b,s). File are written in the XSF format (Xcrysden).
  A subset of (b,k,s) states can be specified via the bks_mask. The routine is MPI parallelized.

INPUTS

  Wfd<wfd_t>=Wavefunction descriptor.
  Cryst<crystal_t>= Information on symmetries and unit cell.
  Psps<pseudopotential_type>=Pseudopotential info.
  Pawtab(ntypat*usepaw)<type(pawtab_type)>=PAW tabulated starting data.
  Pawrad(ntypat*usepaw)<type(pawrad_type)>=paw radial mesh and related data.
  ngfftf(18)=The FFT mesh used for plotting |wfr|**2, it can differ from the one internally used in Wfd.
    For example, PAW wavefunctions should be plotted on a much finer FFT mesh.
  bks_mask(mband,nkibz,nsppol)=logical mask used to select the states to be plotted.

OUTPUT

  Output is written on file.

PARENTS

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

6418 subroutine wfd_plot_ur(Wfd,Cryst,Psps,Pawtab,Pawrad,ngfftf,bks_mask)
6419 
6420 
6421 !This section has been created automatically by the script Abilint (TD).
6422 !Do not modify the following lines by hand.
6423 #undef ABI_FUNC
6424 #define ABI_FUNC 'wfd_plot_ur'
6425 !End of the abilint section
6426 
6427  implicit none
6428 
6429 !Arguments ------------------------------------
6430 !scalars
6431  type(crystal_t),intent(in) :: Cryst
6432  type(Pseudopotential_type),intent(in) :: Psps
6433  type(wfd_t),intent(inout) :: Wfd
6434 !arrays
6435  integer,intent(in) :: ngfftf(18)
6436  logical,target,intent(in) :: bks_mask(Wfd%mband,Wfd%nkibz,Wfd%nsppol)
6437  type(Pawtab_type),intent(in) :: Pawtab(Cryst%ntypat*Wfd%usepaw)
6438  type(Pawrad_type),intent(in) :: Pawrad(Cryst%ntypat*Wfd%usepaw)
6439 
6440 !Local variables ------------------------------
6441 !scalars
6442  integer :: spin,band,ik_ibz,optcut,optgr0,optgr1,optgr2,optrad
6443  integer :: n1,n2,n3,my_nplots,plot,funt,my_nband,cplex
6444  character(len=500) :: msg
6445  character(len=fnlen) :: xsf_fname
6446 !arrays
6447  integer :: got(Wfd%nproc)
6448  integer,allocatable :: l_size_atm(:),my_plot_list(:,:)
6449  integer :: my_band_list(Wfd%mband)
6450  real(dp),allocatable :: data_plot(:)
6451  logical,ABI_CONTIGUOUS pointer :: bmask(:)
6452  complex(gwpc),allocatable :: ur_ae(:),nc_ur(:)
6453  type(Pawfgrtab_type),allocatable :: Pawfgrtab(:)
6454  type(paw_pwaves_lmn_t),allocatable :: Paw_onsite(:)
6455 
6456 !************************************************************************
6457 
6458  if (ALL(.not.bks_mask)) RETURN
6459 
6460  DBG_ENTER("COLL")
6461 
6462  call wrtout(std_out," Plotting |wfs|^2 ...","COLL")
6463  !
6464  ! Change the FFT mesh if needed because we want u(r) on the ngfftf mesh (pawecutd for PAW).
6465  call wfd_change_ngfft(Wfd,Cryst,Psps,ngfftf)
6466  n1 = ngfftf(1); n2 = ngfftf(2); n3 = ngfftf(3)
6467 
6468  ! Distribute the plots among the nodes taking into account the distribution of the waves.
6469  ! my_plot_list gives the list of (b,k,s) states plotted by this node.
6470  ABI_MALLOC(my_plot_list,(3,Wfd%mband*Wfd%nkibz*Wfd%nsppol))
6471 
6472  my_nplots=0; got=0
6473  do spin=1,Wfd%nsppol
6474    do ik_ibz=1,Wfd%nkibz
6475      bmask => bks_mask(:,ik_ibz,spin)
6476      call wfd_distribute_bands(Wfd,ik_ibz,spin,my_nband,my_band_list,got,bmask)
6477 
6478      if (my_nband>0) then
6479        my_plot_list(1,my_nplots+1:my_nplots+my_nband) = my_band_list(1:my_nband)
6480        my_plot_list(2,my_nplots+1:my_nplots+my_nband) = ik_ibz
6481        my_plot_list(3,my_nplots+1:my_nplots+my_nband) = spin
6482        my_nplots = my_nplots + my_nband
6483      end if
6484    end do
6485  end do
6486 
6487  if (Wfd%usepaw==1) then
6488    MSG_WARNING("Testing the calculation of AE PAW wavefunctions.")
6489    ! Use a local pawfgrtab to make sure we use the correction in the paw spheres
6490    ! the usual pawfgrtab uses r_shape which may not be the same as r_paw.
6491    cplex=1
6492    call pawtab_get_lsize(Pawtab,l_size_atm,Cryst%natom,Cryst%typat)
6493    ABI_DT_MALLOC(Pawfgrtab,(Cryst%natom))
6494    call pawfgrtab_init(Pawfgrtab,cplex,l_size_atm,Wfd%nspden,Cryst%typat)
6495    ABI_FREE(l_size_atm)
6496 
6497    optcut=1                     ! use rpaw to construct Pawfgrtab.
6498    optgr0=0; optgr1=0; optgr2=0 ! dont need gY terms locally.
6499    optrad=1                     ! do store r-R.
6500 
6501    call nhatgrid(Cryst%atindx1,Cryst%gmet,Cryst%natom,Cryst%natom,Cryst%nattyp,ngfftf,Cryst%ntypat,&
6502 &    optcut,optgr0,optgr1,optgr2,optrad,Pawfgrtab,Pawtab,Cryst%rprimd,Cryst%typat,Cryst%ucvol,Cryst%xred)
6503 
6504    !Pawfgrtab is ready to use
6505 
6506    if (Wfd%pawprtvol>0) then
6507      call pawfgrtab_print(Pawfgrtab,natom=Cryst%natom,unit=std_out,&
6508 &                         prtvol=Wfd%pawprtvol,mode_paral="COLL")
6509    end if
6510 
6511    ABI_DT_MALLOC(Paw_onsite,(Cryst%natom))
6512    call paw_pwaves_lmn_init(Paw_onsite,Cryst%natom,Cryst%natom,Cryst%ntypat,&
6513 &                           Cryst%rprimd,Cryst%xcart,Pawtab,Pawrad,Pawfgrtab)
6514 
6515    ABI_MALLOC(ur_ae,(Wfd%nfft*Wfd%nspinor))
6516    ABI_MALLOC(data_plot,(Wfd%nfft))
6517 
6518    do plot=1,my_nplots
6519      band  =my_plot_list(1,plot)
6520      ik_ibz=my_plot_list(2,plot)
6521      spin  =my_plot_list(3,plot)
6522 
6523      call wfd_paw_get_aeur(Wfd,band,ik_ibz,spin,Cryst,Paw_onsite,Psps,Pawtab,Pawfgrtab,ur_ae)
6524 
6525      data_plot = DBLE(ur_ae(1:Wfd%nfft)*CONJG(ur_ae(1:Wfd%nfft)))/Cryst%ucvol
6526      if (Wfd%nspinor==2) &
6527 &      data_plot = data_plot + DBLE(ur_ae(Wfd%nfft+1:)*CONJG(ur_ae(Wfd%nfft+1:)))/Cryst%ucvol
6528 
6529      write(xsf_fname,'(3(a,i0),a)') 'PAW_AE_wfk2_sp',spin,'_kpt',ik_ibz,'_bd',band,'.xsf'
6530      if (open_file(xsf_fname,msg,newunit=funt,status='unknown',form='formatted') /= 0) then
6531        MSG_ERROR(msg)
6532      end if
6533 
6534      call printxsf(n1,n2,n3,data_plot,Cryst%rprimd,(/zero,zero,zero/),&
6535 &      Cryst%natom,Cryst%ntypat,Cryst%typat,Cryst%xcart,Cryst%znucl,funt,0)
6536 
6537      close(funt)
6538    end do
6539 
6540    ABI_FREE(ur_ae)
6541    ABI_FREE(data_plot)
6542 
6543    call pawfgrtab_free(Pawfgrtab)
6544    ABI_DT_FREE(Pawfgrtab)
6545    call paw_pwaves_lmn_free(Paw_onsite)
6546    ABI_DT_FREE(Paw_onsite)
6547 
6548  else
6549    ! NC case. Just a simple FFT G-->R and then dump the results.
6550    ABI_MALLOC(nc_ur,(Wfd%nfft*Wfd%nspinor))
6551    ABI_MALLOC(data_plot,(Wfd%nfft))
6552 
6553    do plot=1,my_nplots
6554      band  =my_plot_list(1,plot)
6555      ik_ibz=my_plot_list(2,plot)
6556      spin  =my_plot_list(3,plot)
6557 
6558      call wfd_get_ur(Wfd,band,ik_ibz,spin,nc_ur)
6559 
6560      data_plot = DBLE(nc_ur(1:Wfd%nfft)*CONJG(nc_ur(1:Wfd%nfft)))/Cryst%ucvol
6561      if (Wfd%nspinor==2) &
6562 &      data_plot = data_plot + DBLE(nc_ur(Wfd%nfft+1:)*CONJG(nc_ur(Wfd%nfft+1:)))/Cryst%ucvol
6563 
6564      write(xsf_fname,'(3(a,i0),a)') 'NC_wfk2_sp',spin,'_kpt',ik_ibz,'_bd',band,'.xsf'
6565      if (open_file(xsf_fname,msg,newunit=funt,status='unknown',form='formatted') /= 0) then
6566        MSG_ERROR(msg)
6567      end if
6568      call printxsf(n1,n2,n3,data_plot,Cryst%rprimd,(/zero,zero,zero/),&
6569 &      Cryst%natom,Cryst%ntypat,Cryst%typat,Cryst%xcart,Cryst%znucl,funt,0)
6570 
6571      close(funt)
6572    end do
6573 
6574    ABI_FREE(nc_ur)
6575    ABI_FREE(data_plot)
6576  end if
6577 
6578  ABI_FREE(my_plot_list)
6579 
6580  DBG_EXIT("COLL")
6581 
6582 end subroutine wfd_plot_ur

m_wfd/wfd_print [ Functions ]

[ Top ] [ Functions ]

NAME

 wfd_print

FUNCTION

  Print the content of a wfd_t datatype

INPUTS

  Wfd<wfd_t>=The datatype.
  [header]=String to be printed as header for additional info.
  [unit]=Unit number for output
  [prtvol]=Verbosity level
  [mode_paral]=Either "COLL" or "PERS". Defaults to "COLL".

OUTPUT

  Only printing

PARENTS

      bethe_salpeter,m_gkk,m_phgamma,m_phpi,m_shirley,m_sigmaph,screening
      sigma

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

1926 subroutine wfd_print(Wfd,header,unit,prtvol,mode_paral)
1927 
1928 
1929 !This section has been created automatically by the script Abilint (TD).
1930 !Do not modify the following lines by hand.
1931 #undef ABI_FUNC
1932 #define ABI_FUNC 'wfd_print'
1933 !End of the abilint section
1934 
1935  implicit none
1936 
1937 !Arguments ------------------------------------
1938  integer,optional,intent(in) :: unit,prtvol
1939  character(len=4),optional,intent(in) :: mode_paral
1940  character(len=*),optional,intent(in) :: header
1941  type(wfd_t),intent(in) :: Wfd
1942 
1943 !Local variables-------------------------------
1944 !scalars
1945  integer :: my_prtvol,my_unt,mpw
1946  real(dp) :: ug_size,ur_size,cprj_size
1947  character(len=4) :: my_mode
1948  character(len=500) :: msg
1949 ! *************************************************************************
1950 
1951  my_unt   =std_out; if (PRESENT(unit      )) my_unt   =unit
1952  my_prtvol=0      ; if (PRESENT(prtvol    )) my_prtvol=prtvol
1953  my_mode  ='COLL' ; if (PRESENT(mode_paral)) my_mode  =mode_paral
1954 
1955  msg=' ==== Info on the Wfd% object ==== '
1956  if (PRESENT(header)) msg=' ==== '//TRIM(ADJUSTL(header))//' ==== '
1957  call wrtout(my_unt,msg,my_mode)
1958 
1959  write(msg,'(3(a,i0,a),a,i0,2a,f5.1)')&
1960 &  '  Number of irreducible k-points ........ ',Wfd%nkibz,ch10,&
1961 &  '  Number of spinorial components ........ ',Wfd%nspinor,ch10,&
1962 &  '  Number of spin-density components ..... ',Wfd%nspden,ch10,&
1963 &  '  Number of spin polarizations .......... ',Wfd%nsppol,ch10,&
1964 &  '  Plane wave cutoff energy .............. ',Wfd%ecut
1965  call wrtout(my_unt,msg,my_mode)
1966 
1967  mpw = maxval(Wfd%npwarr)
1968  write(msg,'(a,l1,a,3(a,i0,a))')&
1969    '  Gamma-centered ........................ ',Wfd%gamma_centered,ch10,&
1970 &  '  Max number of G-vectors ............... ',mpw,ch10,&
1971 &  '  Total number of FFT points ............ ',Wfd%nfftot,ch10,&
1972 &  '  Number of FFT points treated by me .... ',Wfd%nfft,ch10
1973  call wrtout(my_unt,msg,my_mode)
1974 
1975  call print_ngfft(Wfd%ngfft,'FFT mesh for wavefunctions',my_unt,my_mode,my_prtvol)
1976 
1977  ! Info on memory needed for u(g), u(r) and PAW cprj
1978  ug_size = one * Wfd%nspinor * mpw * count(Wfd%Wave(:,:,:)%has_ug >= WFD_ALLOCATED)
1979  write(msg,'(a,f12.1,a)')' Memory allocated for Fourier components u(G) = ',two*gwpc*ug_size*b2Mb,' [Mb]'
1980  call wrtout(std_out,msg,'PERS')
1981 
1982  ur_size = one * Wfd%nspinor * Wfd%nfft *count(Wfd%Wave(:,:,:)%has_ur >= WFD_ALLOCATED)
1983  write(msg,'(a,f12.1,a)')' Memory allocated for real-space u(r) = ',two*gwpc*ur_size*b2Mb,' [Mb]'
1984  call wrtout(std_out,msg,'PERS')
1985 
1986  if (Wfd%usepaw==1) then
1987    cprj_size = one * Wfd%nspinor * sum(Wfd%nlmn_atm) * count(Wfd%Wave(:,:,:)%has_cprj >= WFD_ALLOCATED)
1988    write(msg,'(a,f12.1,a)')' Memory allocated for PAW projections Cprj = ',dp*cprj_size*b2Mb,' [Mb]'
1989    call wrtout(std_out,msg,'PERS')
1990  end if
1991 
1992  !TODO
1993  ! Add addition info
1994 
1995 end subroutine wfd_print

m_wfd/wfd_ptr_ug [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_ptr_ug

FUNCTION

  Returns a pointer to ug
  WARNING: Do not use the returned pointer to modify the location of memory.
   The status of the object should always be modified via the appropriate method.
   Use the pointer only if you want to avoid a copy and you are not going to change the ug!

INPUTS

  Wfd<wfd_t>=the data type
  band=the index of the band.
  ik_ibz=Index of the k-point in the IBZ
  spin=spin index

OUTPUT

  wfd_ptr_ug
  ierr=Status error.

PARENTS

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

3567 subroutine wfd_ptr_ug(Wfd,band,ik_ibz,spin,ptr_ug,ierr)
3568 
3569 
3570 !This section has been created automatically by the script Abilint (TD).
3571 !Do not modify the following lines by hand.
3572 #undef ABI_FUNC
3573 #define ABI_FUNC 'wfd_ptr_ug'
3574 !End of the abilint section
3575 
3576  implicit none
3577 
3578 !Arguments ------------------------------------
3579 !scalars
3580  integer,intent(in) :: band,ik_ibz,spin
3581  integer,intent(out) :: ierr
3582  type(wfd_t),target,intent(in) :: Wfd
3583 !arrays
3584  complex(gwpc),ABI_CONTIGUOUS pointer :: ptr_ug(:)
3585 
3586 !************************************************************************
3587 
3588  if (wfd_ihave_ug(Wfd,band,ik_ibz,spin,how="Stored")) then
3589    ierr=0
3590    ptr_ug => Wfd%Wave(band,ik_ibz,spin)%ug
3591  else
3592    !write(msg,'(a,i0,a,3(i0,1x))')" Node ",Wfd%my_rank," doesn't have ug for (band, ik_ibz, spin): ",band,ik_ibz,spin
3593    !MSG_ERROR(msg)
3594    ierr=1
3595    nullify(ptr_ug)
3596  end if
3597 
3598 end subroutine wfd_ptr_ug

m_wfd/wfd_ptr_ur [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_ptr_ur

FUNCTION

  Returns a pointer to ur
  WARNING: Do not use the returned pointer to modify the location of memory.
   The status of the object should always be modified via the appropriate method.
   Use the pointer only if you want to avoid a copy and you are not going to change the ug!

INPUTS

  Wfd<wfd_t>=the data type
  band=the index of the band.
  ik_ibz=Index of the k-point in the IBZ
  spin=spin index

OUTPUT

  wfd_ptr_ur
  ierr=Status error.

PARENTS

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

3633 subroutine wfd_ptr_ur(Wfd,band,ik_ibz,spin,ptr_ur,ierr)
3634 
3635 
3636 !This section has been created automatically by the script Abilint (TD).
3637 !Do not modify the following lines by hand.
3638 #undef ABI_FUNC
3639 #define ABI_FUNC 'wfd_ptr_ur'
3640 !End of the abilint section
3641 
3642  implicit none
3643 
3644 !Arguments ------------------------------------
3645 !scalars
3646  integer,intent(in) :: band,ik_ibz,spin
3647  integer,intent(out) :: ierr
3648  type(wfd_t),target,intent(in) :: Wfd
3649 !arrays
3650  complex(gwpc),ABI_CONTIGUOUS pointer :: ptr_ur(:)
3651 
3652 !Local variables ------------------------------
3653 !scalars
3654  !character(len=500) :: msg
3655 
3656 !************************************************************************
3657 
3658  if (wfd_ihave_ur(Wfd,band,ik_ibz,spin,how="Stored")) then
3659    ptr_ur => Wfd%Wave(band,ik_ibz,spin)%ur
3660    ierr=0
3661  else
3662    !write(msg,'(a,i0,a,3(i0,1x))')" Node ",Wfd%my_rank," doesn't have ug for (band, ik_ibz, spin): ",band,ik_ibz,spin
3663    !MSG_ERROR(msg)
3664    ierr=1
3665    nullify(ptr_ur)
3666  end if
3667 
3668 end subroutine wfd_ptr_ur

m_wfd/wfd_push_ug [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_push_ug

FUNCTION

  This routine changes the status of the object by saving the wavefunction in the correct
  slot inside Wfd%Wave. It also set the corresponding has_ug flag to WFD_STORED.
  If the status of the corresponding ur is (WFD_STORED|WFD_ALLOCATED), then an G->R FFT transform
  is done (see also update_ur)

INPUTS

   band=Band index.
   ik_ibz=k-point index
   spin=Spin index.
   Cryst<crystal_t>=Object defining the unit cell and its symmetries.
   ug(Wfd%npwwfn*Wfd%nspinor)=The ug to be saved.
   [update_ur]=If .FALSE.: no G-->R transform is done even if ur is (WFD_STORED|WFD_ALLOCATED) so be careful.
               Defaults to .TRUE.
   [update_cprj]=If .FALSE.: <C|p_i> matrix elements are not recalculatedd even
     if cprj is (WFD_STORED|WFD_ALLOCATED) so be careful. Defaults to .TRUE.

SIDE EFFECTS

   Wfd<wfd_t>=See above.

PARENTS

      m_shirley,m_wfd

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

2680 subroutine wfd_push_ug(Wfd,band,ik_ibz,spin,Cryst,ug,update_ur,update_cprj)
2681 
2682 
2683 !This section has been created automatically by the script Abilint (TD).
2684 !Do not modify the following lines by hand.
2685 #undef ABI_FUNC
2686 #define ABI_FUNC 'wfd_push_ug'
2687 !End of the abilint section
2688 
2689  implicit none
2690 
2691 !Arguments ------------------------------------
2692 !scalars
2693  integer,intent(in) :: ik_ibz,spin,band
2694  logical,optional,intent(in) :: update_ur,update_cprj
2695  type(wfd_t),intent(inout) :: Wfd
2696  type(crystal_t),intent(in) :: Cryst
2697 !arrays
2698  complex(gwpc),intent(inout) :: ug(:)
2699 
2700 !Local variables ------------------------------
2701 !scalars
2702  integer,parameter :: choice1=1,idir0=0,tim_fourdp=5,ndat1=1
2703  integer :: npw_k
2704  logical :: do_update_ur,do_update_cprj,want_sorted
2705  character(len=500) :: msg
2706 
2707 !************************************************************************
2708 
2709  if (Wfd%debug_level>0) then
2710    if (.not.wfd_ihave_ug(Wfd,band,ik_ibz,spin)) then
2711      write(msg,'(a,i0,a,3(i0,1x))')" Node ",Wfd%my_rank," doesn't have ug for (band, ik_ibz, spin): ",band,ik_ibz,spin
2712      MSG_ERROR(msg)
2713    end if
2714  end if
2715 
2716  if (SIZE(ug)/=Wfd%npwarr(ik_ibz)*Wfd%nspinor) then
2717    MSG_ERROR("Wrong size in assumed shape array")
2718  end if
2719 
2720  !@wfd_t
2721  Wfd%Wave(band,ik_ibz,spin)%ug = ug
2722  Wfd%Wave(band,ik_ibz,spin)%has_ug = WFD_STORED
2723 
2724  if (Wfd%usepaw==1 .and. wfd_ihave_cprj(Wfd,band,ik_ibz,spin)) then
2725    ! Update the corresponding cprj if required.
2726    do_update_cprj=.TRUE.; if (PRESENT(update_cprj)) do_update_cprj=update_cprj
2727    if (do_update_cprj) then
2728      want_sorted = (Wfd%Wave(band,ik_ibz,spin)%cprj_order == CPR_SORTED)
2729      call wfd_ug2cprj(Wfd,band,ik_ibz,spin,choice1,idir0,Wfd%natom,Cryst,Wfd%Wave(band,ik_ibz,spin)%Cprj,sorted=want_sorted)
2730      Wfd%Wave(band,ik_ibz,spin)%has_cprj = WFD_STORED
2731    else
2732      Wfd%Wave(band,ik_ibz,spin)%has_cprj = WFD_ALLOCATED
2733    end if
2734  end if
2735 
2736  if (wfd_ihave_ur(Wfd,band,ik_ibz,spin)) then
2737    ! Update the corresponding ur if required.
2738    do_update_ur=.TRUE.; if (PRESENT(update_ur)) do_update_ur=update_ur
2739 
2740    if (do_update_ur) then
2741      npw_k = Wfd%npwarr(ik_ibz)
2742      call fft_ug(npw_k,Wfd%nfft,Wfd%nspinor,ndat1,Wfd%mgfft,Wfd%ngfft,Wfd%istwfk(ik_ibz),&
2743 &      Wfd%Kdata(ik_ibz)%kg_k,Wfd%Kdata(ik_ibz)%gbound,ug,Wfd%Wave(band,ik_ibz,spin)%ur)
2744      Wfd%Wave(band,ik_ibz,spin)%has_ur = WFD_STORED
2745    else
2746      Wfd%Wave(band,ik_ibz,spin)%has_ur = WFD_ALLOCATED
2747    end if
2748 
2749  end if
2750 
2751 end subroutine wfd_push_ug

m_wfd/wfd_rank_has_ug [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_rank_has_ug

FUNCTION

  This function is used to ask a particular processor whether it has a particular ug and with which status.

INPUTS

   rank=The MPI rank of the processor.
   band=Band index.
   ik_ibz=k-point index
   spin=Spin index.

NOTES

   A zero index can be used to inquire the status of a bunch of states.
   Thus (band,ik_ibz,spin) = (0,1,1) means: Do you have at least one band for the first k-point and the first spin.

PARENTS

SOURCE

2860 function wfd_rank_has_ug(Wfd,rank,band,ik_ibz,spin)
2861 
2862 
2863 !This section has been created automatically by the script Abilint (TD).
2864 !Do not modify the following lines by hand.
2865 #undef ABI_FUNC
2866 #define ABI_FUNC 'wfd_rank_has_ug'
2867 !End of the abilint section
2868 
2869  implicit none
2870 
2871 !Arguments ------------------------------------
2872 !scalars
2873  integer,intent(in) :: band,ik_ibz,spin,rank
2874  logical :: wfd_rank_has_ug
2875  type(wfd_t),intent(in) :: Wfd
2876 
2877 !Local variables ------------------------------
2878 !scalars
2879  integer :: nzeros,bks_flag
2880 !arrays
2881  integer :: indices(3)
2882 
2883 !************************************************************************
2884 
2885  indices = [band,ik_ibz,spin]
2886  bks_flag = WFD_STORED
2887 
2888  if (ALL(indices/= [0,0,0])) then
2889    wfd_rank_has_ug = (Wfd%bks_tab(band,ik_ibz,spin,rank) == bks_flag); RETURN
2890  else
2891    nzeros = COUNT(indices==0)
2892    if (nzeros==3) MSG_ERROR("All indices are zero!")
2893 
2894    if (band==0) then
2895      if (nzeros==1) wfd_rank_has_ug = ANY( Wfd%bks_tab(:,ik_ibz,spin,rank)==bks_flag)
2896      if (ik_ibz==0) wfd_rank_has_ug = ANY( Wfd%bks_tab(:,:,spin,rank)     ==bks_flag)
2897      if (spin  ==0) wfd_rank_has_ug = ANY( Wfd%bks_tab(:,ik_ibz,:,rank)   ==bks_flag)
2898 
2899    else if (ik_ibz==0) then
2900      if (nzeros==1) wfd_rank_has_ug = ANY( Wfd%bks_tab(band,:,spin,rank)==bks_flag)
2901      if (band  ==0) wfd_rank_has_ug = ANY( Wfd%bks_tab(:,:,spin,rank)   ==bks_flag)
2902      if (spin  ==0) wfd_rank_has_ug = ANY( Wfd%bks_tab(band,:,:,rank)   ==bks_flag)
2903 
2904    else
2905      if (nzeros==1) wfd_rank_has_ug = ANY( Wfd%bks_tab(band,ik_ibz,:,rank)==bks_flag)
2906      if (ik_ibz==0) wfd_rank_has_ug = ANY( Wfd%bks_tab(band,:,:,rank)     ==bks_flag)
2907      if (band  ==0) wfd_rank_has_ug = ANY( Wfd%bks_tab(:,ik_ibz,:,rank)   ==bks_flag)
2908    end if
2909  end if
2910 
2911 end function wfd_rank_has_ug

m_wfd/wfd_read_wfk [ Functions ]

[ Top ] [ Functions ]

NAME

 wfd_read_wfk

FUNCTION

  This routine reads the WFK file completing the initialization of the wavefunction
  descriptor used in the GW code.

INPUTS

  wfk_fname=Name of the WFK file.
  iomode=Option specifying the fileformat as well as the IO mode to be used.

SIDE EFFECTS

  Wfd<wfd_t>=All the states owned by this node whose status is (STORED|ALLOCATED) read.

PARENTS

      bethe_salpeter,m_gkk,m_phgamma,m_phpi,m_sigmaph,m_wfd,screening,sigma
      wfk_analyze

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

5833 subroutine wfd_read_wfk(Wfd,wfk_fname,iomode)
5834 
5835 
5836 !This section has been created automatically by the script Abilint (TD).
5837 !Do not modify the following lines by hand.
5838 #undef ABI_FUNC
5839 #define ABI_FUNC 'wfd_read_wfk'
5840 !End of the abilint section
5841 
5842  implicit none
5843 
5844 !Arguments ------------------------------------
5845 !scalars
5846  integer,intent(in) :: iomode
5847  character(len=*),intent(in) :: wfk_fname
5848  type(wfd_t),intent(inout) :: Wfd
5849 
5850 !Local variables ------------------------------
5851 !scalars
5852  integer,parameter :: tim_rwwf0=0,headform0=0,icg0=0,formeig0=0,optkg1=1
5853  integer,parameter :: option1=1 ! for reading cg and eigen,
5854  integer :: wfk_unt,npw_disk,nmiss,ig,sc_mode
5855  integer :: comm,master,my_rank,spin,ik_ibz,fform,ierr ! ,igp
5856  integer :: mcg,nband_wfd,nband_disk,band,mband_disk,bcount
5857  integer :: spinor,cg_spad,gw_spad,icg,igw,cg_bpad,ib,method
5858  real(dp) :: cpu,wall,gflops
5859  character(len=500) :: msg
5860  type(Wfk_t) :: Wfk
5861  type(Hdr_type) :: Hdr
5862 !arrays
5863  integer,allocatable :: gf2wfd(:),kg_k(:,:)
5864  real(dp),allocatable :: eig_k(:),cg_k(:,:) !occ_k(:),
5865  logical,allocatable :: my_readmask(:,:,:)
5866  character(len=6) :: tag_spin(2)
5867 
5868 !************************************************************************
5869 
5870  DBG_ENTER("COLL")
5871 
5872  if (Wfd%gamma_centered) then
5873    MSG_ERROR("gamma_centered not available anymore")
5874  end if
5875 
5876  if (ANY(iomode == [IO_MODE_NETCDF, IO_MODE_FORTRAN_MASTER] )) then
5877    MSG_ERROR(sjoin("Unsupported value for iomode: ",itoa(iomode)))
5878  end if
5879 
5880  sc_mode = xmpio_collective
5881  comm = Wfd%comm; my_rank = Wfd%my_rank; master = Wfd%master
5882 
5883  tag_spin(:)=(/'      ','      '/); if (Wfd%nsppol==2) tag_spin(:)=(/' UP   ',' DOWN '/)
5884 
5885  call wrtout(std_out," wfd_read_wfk: reading "//TRIM(wfk_fname),"COLL")
5886 
5887  wfk_unt = get_unit()
5888  call wfk_open_read(Wfk,wfk_fname,formeig0,iomode,wfk_unt,Wfd%comm,Hdr_out=Hdr)
5889 
5890  ! TODO: Perform consistency check btw Hdr and Wfd.
5891  ! Output the header of the GS wavefunction file.
5892  if (Wfd%prtvol>0) call hdr_echo(hdr, fform, 4, unit=std_out)
5893 
5894  mband_disk = MAXVAL(Hdr%nband)
5895  ABI_CHECK(Wfd%mband <= mband_disk,"Not enough bands stored on file")
5896  !
5897  ! Each node will read the waves whose status if (WFD_ALLOCATED|WFD_STORED).
5898  ABI_MALLOC(my_readmask,(mband_disk,Wfd%nkibz,Wfd%nsppol))
5899  my_readmask=.FALSE.
5900  do spin=1,Wfd%nsppol
5901    do ik_ibz=1,Wfd%nkibz
5902      do band=1,Wfd%nband(ik_ibz,spin)
5903        if (wfd_ihave_ug(Wfd,band,ik_ibz,spin)) then
5904          my_readmask(band,ik_ibz,spin) = .TRUE.
5905          if (wfd_ihave_ug(Wfd,band,ik_ibz,spin,"Stored")) then
5906            MSG_WARNING("Wavefunction is already stored!")
5907          end if
5908        end if
5909      end do
5910    end do
5911  end do
5912 
5913  write(msg,'(3a,i0,a)')" ",ABI_FUNC,": will read ",COUNT(my_readmask)," (b,k,s) states"
5914  call wrtout(std_out,msg,"PERS")
5915  if (wfd%prtvol > 0) call wrtout(std_out,' k       eigenvalues [eV]','COLL')
5916  call cwtime(cpu,wall,gflops,"start")
5917 
5918  method = 2
5919 
5920  if (method == 1) then
5921   do spin=1,Wfd%nsppol
5922     do ik_ibz=1,Wfd%nkibz
5923       npw_disk   = Hdr%npwarr(ik_ibz)
5924       nband_disk = Hdr%nband(ik_ibz+(spin-1)*Hdr%nkpt)
5925 
5926       nband_wfd  = Wfd%nband(ik_ibz,spin)
5927       if (nband_wfd > nband_disk) then
5928         write(msg,'(a,2(i0,1x))')&
5929          " nband_wfd to be read cannot be greater than nband_disk while: ",nband_wfd,nband_disk
5930         MSG_ERROR(msg)
5931       end if
5932 
5933       mcg = npw_disk*Wfd%nspinor*nband_wfd
5934 
5935       ABI_MALLOC(eig_k,((2*Wfk%mband)**formeig0*Wfk%mband))
5936 
5937       ABI_MALLOC(kg_k,(3,optkg1*npw_disk))
5938       ABI_STAT_MALLOC(cg_k,(2,mcg), ierr)
5939       ABI_CHECK(ierr==0, "out of memory in cg_k")
5940 
5941       call wfk_read_band_block(Wfk,(/1,nband_wfd/),ik_ibz,spin,sc_mode,kg_k=kg_k,cg_k=cg_k,eig_k=eig_k)
5942 
5943       if (wfd%prtvol > 0 .and. Wfd%my_rank==Wfd%master) then
5944         if (Wfd%nsppol==2) then
5945           write(std_out,'(i3,a,10f7.2/50(10x,10f7.2/))') ik_ibz,tag_spin(spin),(eig_k(ib)*Ha_eV,ib=1,nband_wfd)
5946         else
5947           write(std_out,'(i3,7x,10f7.2/50(10x,10f7.2/))')ik_ibz,(eig_k(ib)*Ha_eV,ib=1,nband_wfd)
5948         end if
5949       end if
5950       !
5951       ! * Table with the correspondence btw the k-centered sphere of the WFK file
5952       !   and the one used in Wfd (possibly smaller due to ecutwfn).
5953       ABI_MALLOC(gf2wfd,(npw_disk))
5954       if (any(my_readmask(:,ik_ibz,spin))) then
5955         call kg_map(wfd%npwarr(ik_ibz),wfd%kdata(ik_ibz)%kg_k,npw_disk,kg_k,gf2wfd,nmiss)
5956       end if
5957 
5958       !if (nmiss/=0) then
5959       !  write(msg,'(a,2(1x,i0),a,i0)')" For (k,s) ",ik_ibz,spin," the number of missing G is ",nmiss
5960       !  MSG_WARNING(msg)
5961       !end if
5962       !
5963       ! * Conversion of the basis set.
5964       do band=1,Wfd%nband(ik_ibz,spin)
5965 
5966         if (my_readmask(band,ik_ibz,spin)) then
5967           Wfd%Wave(band,ik_ibz,spin)%ug = czero
5968           cg_bpad=npw_disk*Wfd%nspinor*(band-1)
5969           do spinor=1,Wfd%nspinor
5970             cg_spad=(spinor-1)*npw_disk
5971             gw_spad=(spinor-1)*Wfd%npwarr(ik_ibz)
5972             do ig=1,npw_disk
5973               icg = ig+cg_spad+cg_bpad
5974               igw = gf2wfd(ig)+gw_spad
5975               if (gf2wfd(ig) /= 0) then
5976                 Wfd%Wave(band,ik_ibz,spin)%ug(igw) = CMPLX(cg_k(1,icg),cg_k(2,icg))
5977               !else
5978               !  not in thebasis set, set the component to zero.
5979               !  Wfd%Wave(band,ik_ibz,spin)%ug(igw) = czero
5980               end if
5981             end do
5982           end do
5983           Wfd%Wave(band,ik_ibz,spin)%has_ug = WFD_STORED
5984         end if
5985 
5986       end do
5987 
5988       ABI_FREE(eig_k)
5989       ABI_FREE(kg_k)
5990       ABI_FREE(cg_k)
5991       ABI_FREE(gf2wfd)
5992     end do !ik_ibz
5993   end do !spin
5994 
5995  else if (method==2) then
5996 
5997   do spin=1,Wfd%nsppol
5998     do ik_ibz=1,Wfd%nkibz
5999       !write(std_out,*)"about to read ik_ibz: ",ik_ibz,", spin: ",spin
6000       npw_disk   = Hdr%npwarr(ik_ibz)
6001       nband_disk = Hdr%nband(ik_ibz+(spin-1)*Hdr%nkpt)
6002 
6003       nband_wfd  = Wfd%nband(ik_ibz,spin)
6004 
6005       if (nband_wfd > nband_disk) then
6006         write(msg,'(a,2(i0,1x))')&
6007          "nband_wfd to be read cannot be greater than nband_disk while: ",nband_wfd,nband_disk
6008         MSG_ERROR(msg)
6009       end if
6010 
6011       ABI_MALLOC(eig_k,((2*nband_disk)**formeig0*nband_disk))
6012       ABI_MALLOC(kg_k,(3,optkg1*npw_disk))
6013 
6014       mcg = npw_disk*Wfd%nspinor*COUNT(my_readmask(:,ik_ibz,spin))
6015       ABI_STAT_MALLOC(cg_k,(2,mcg), ierr)
6016       ABI_CHECK(ierr==0, "out of memory in cg_k")
6017 
6018       call wfk_read_bmask(Wfk,my_readmask(:,ik_ibz,spin),ik_ibz,spin,sc_mode,kg_k=kg_k,cg_k=cg_k,eig_k=eig_k)
6019 
6020       if (Wfd%my_rank==Wfd%master .and. wfd%prtvol > 0) then
6021         if (Wfd%nsppol==2) then
6022           write(std_out,'(i3,a,10f7.2/50(10x,10f7.2/))') ik_ibz,tag_spin(spin),(eig_k(ib)*Ha_eV,ib=1,nband_wfd)
6023         else
6024           write(std_out,'(i3,7x,10f7.2/50(10x,10f7.2/))')ik_ibz,(eig_k(ib)*Ha_eV,ib=1,nband_wfd)
6025         end if
6026       end if
6027       !
6028       ! * Table with the correspondence btw the k-centered sphere of the WFK file
6029       !   and the one used in Wfd (possibly smaller due to ecutwfn).
6030       ABI_MALLOC(gf2wfd,(npw_disk))
6031       if (any(my_readmask(:,ik_ibz,spin))) then
6032         call kg_map(wfd%npwarr(ik_ibz),wfd%kdata(ik_ibz)%kg_k,npw_disk,kg_k,gf2wfd,nmiss)
6033       end if
6034 
6035       !if (nmiss/=0) then
6036       !  write(msg,'(a,2(1x,i0),a,i0)')" For (k,s) ",ik_ibz,spin," the number of missing G is ",nmiss
6037       !  MSG_WARNING(msg)
6038       !end if
6039       !
6040       ! * Conversion of the basis set.
6041       bcount = 0
6042       do band=1,Wfd%nband(ik_ibz,spin)
6043 
6044         if (my_readmask(band,ik_ibz,spin)) then
6045           Wfd%Wave(band,ik_ibz,spin)%ug = czero
6046           bcount = bcount + 1
6047           cg_bpad=npw_disk*Wfd%nspinor*(bcount-1)
6048           do spinor=1,Wfd%nspinor
6049             cg_spad=(spinor-1)*npw_disk
6050             gw_spad=(spinor-1)*Wfd%npwarr(ik_ibz)
6051             do ig=1,npw_disk
6052               icg = ig+cg_spad+cg_bpad
6053               igw = gf2wfd(ig)+gw_spad
6054               if (gf2wfd(ig) /= 0) then
6055                 Wfd%Wave(band,ik_ibz,spin)%ug(igw) = CMPLX(cg_k(1,icg),cg_k(2,icg))
6056               !else
6057               !  not in thebasis set, set the component to zero.
6058               !  Wfd%Wave(band,ik_ibz,spin)%ug(igw) = czero
6059               end if
6060             end do
6061           end do
6062           Wfd%Wave(band,ik_ibz,spin)%has_ug = WFD_STORED
6063         end if
6064 
6065       end do
6066 
6067       ABI_FREE(eig_k)
6068       ABI_FREE(kg_k)
6069       ABI_FREE(cg_k)
6070       ABI_FREE(gf2wfd)
6071     end do !ik_ibz
6072   end do !spin
6073 
6074  else
6075   MSG_ERROR("Wrong method")
6076  end if
6077 
6078  call cwtime(cpu,wall,gflops,"stop")
6079  write(msg,'(2(a,f9.2))')" cpu_time = ",cpu,", wall_time = ",wall
6080  call wrtout(std_out,msg,"PERS", do_flush=.True.)
6081 
6082  call wfk_close(Wfk)
6083  call hdr_free(Hdr)
6084 
6085  ! Free local memory.
6086  ABI_FREE(my_readmask)
6087 
6088  ! Update the kbs table storing the distribution of the ug and set the MPI communicators.
6089  call wfd_set_mpicomm(Wfd)
6090  !call wfd_update_bkstab(Wfd)
6091 
6092  DBG_EXIT("COLL")
6093 
6094 end subroutine wfd_read_wfk

m_wfd/wfd_reset_ur_cprj [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_reset_ur_cprj

FUNCTION

  Reinitialize the storage mode of the ur treated by this node.

PARENTS

      bethe_salpeter,m_shirley,sigma

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

1586 subroutine wfd_reset_ur_cprj(Wfd)
1587 
1588 
1589 !This section has been created automatically by the script Abilint (TD).
1590 !Do not modify the following lines by hand.
1591 #undef ABI_FUNC
1592 #define ABI_FUNC 'wfd_reset_ur_cprj'
1593 !End of the abilint section
1594 
1595  implicit none
1596 
1597 !Arguments ------------------------------------
1598 !scalars
1599  type(wfd_t),intent(inout) :: Wfd
1600 
1601 !************************************************************************
1602 
1603  where (Wfd%Wave(:,:,:)%has_ur == WFD_STORED)
1604    Wfd%Wave(:,:,:)%has_ur = WFD_ALLOCATED
1605  end where
1606 
1607  if (Wfd%usepaw==1) then
1608    where (Wfd%Wave(:,:,:)%has_cprj == WFD_STORED)
1609      Wfd%Wave(:,:,:)%has_cprj = WFD_ALLOCATED
1610    end where
1611  end if
1612 
1613 end subroutine wfd_reset_ur_cprj

m_wfd/wfd_rotate [ Functions ]

[ Top ] [ Functions ]

NAME

 wfd_rotate

FUNCTION

  This routine performs a linear transformation of the wavefunctions stored in Wfd
  taking into account memory distribution. The transformation is done in reciprocal
  space therefore all the ug should be available. Wavefunctions in real space are then
  obtained via FFT. The implementation assumes that the matrix associated to the
  linear transformation is sparse (No BLAS-3 calls here).

INPUTS

  Cryst<crystal_t>=Object defining the unit cell and its symmetries.
  m_lda_to_qp(mband,mband,nkibz,nsppol)= expansion of the QP amplitudes in terms of KS wavefunctions.
  [bmask(mband,nkibz,nsppol)]=The routine will raise an error if one band index
    is not treated by any processor. bmask can be used to select the subset of
    indices that are expected to be available.

SIDE EFFECTS

   Wfd<wfd_t>=See above.

PARENTS

      bethe_salpeter,screening,sigma

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

4226 subroutine wfd_rotate(Wfd,Cryst,m_lda_to_qp,bmask)
4227 
4228 
4229 !This section has been created automatically by the script Abilint (TD).
4230 !Do not modify the following lines by hand.
4231 #undef ABI_FUNC
4232 #define ABI_FUNC 'wfd_rotate'
4233 !End of the abilint section
4234 
4235  implicit none
4236 
4237 !Arguments ------------------------------------
4238 !scalars
4239  type(wfd_t),intent(inout) :: Wfd
4240  type(crystal_t),intent(in) :: Cryst
4241 !arrays
4242  complex(dpc),target,intent(in) :: m_lda_to_qp(Wfd%mband,Wfd%mband,Wfd%nkibz,Wfd%nsppol)
4243  logical,optional,intent(in) :: bmask(Wfd%mband,Wfd%nkibz,Wfd%nsppol)
4244 
4245 !Local variables-------------------------------
4246 !scalars
4247  integer :: band,ik_ibz,spin,ierr,icol,nnew,inew,my_nband,ib,npw_k,istwf_k
4248  !character(len=500) :: msg
4249 !arrays
4250  integer :: new_list(Wfd%mband),my_band_list(Wfd%mband)
4251  complex(dpc),ABI_CONTIGUOUS pointer :: umat_sk(:,:)
4252  complex(gwpc) :: mcol(Wfd%mband)
4253  complex(gwpc),allocatable :: new_ug(:,:) !, new_ur(:)
4254 
4255 !************************************************************************
4256 
4257  DBG_ENTER("COLL")
4258 
4259  ! Update the distribution table, first.
4260  call wfd_update_bkstab(Wfd)
4261 
4262  ! Calculate: $\Psi^{QP}_{r,b} = \sum_n \Psi^{KS}_{r,n} M_{n,b}$
4263  do spin=1,Wfd%nsppol
4264    do ik_ibz=1,Wfd%nkibz
4265      npw_k  = Wfd%npwarr(ik_ibz)
4266      istwf_k = Wfd%istwfk(ik_ibz)
4267      if (istwf_k /= 1) then
4268        MSG_WARNING("wfd_rotate with istwfk /= 1")
4269      end if
4270      umat_sk => m_lda_to_qp(:,:,ik_ibz,spin)
4271 
4272      ! Select only those states that are mixed by the (sparse) m_lda_to_qp.
4273      nnew=0; new_list=0
4274      do icol=1,Wfd%nband(ik_ibz,spin)
4275        mcol = m_lda_to_qp(:,icol,ik_ibz,spin)
4276        mcol(icol) = mcol(icol) - cone
4277        if (ANY(ABS(mcol)>tol12)) then  ! Avoid a simple copy.
4278          nnew=nnew+1
4279          new_list(nnew)=icol
4280        end if
4281      end do
4282      if (nnew==0) CYCLE ! Nothing to do.
4283 
4284      ! Retrieve the set of band indices that have to be treated by
4285      ! this node taking into account a possible duplication.
4286      if (PRESENT(bmask)) then
4287        call wfd_distribute_bands(Wfd,ik_ibz,spin,my_nband,my_band_list,bmask=bmask(:,ik_ibz,spin))
4288      else
4289        call wfd_distribute_bands(Wfd,ik_ibz,spin,my_nband,my_band_list)
4290      end if
4291 
4292      !if (my_nband>0) then
4293      !  write(std_out,*)" At (ik_ibz,spin) ",ik_ibz,spin,&
4294      !  & ", rank ",Wfd%my_rank," will sum ",my_nband," bands, my_band_list: ",my_band_list(1:my_nband)
4295      !end if
4296      ABI_MALLOC(new_ug,(npw_k*Wfd%nspinor,nnew))
4297      new_ug=czero
4298      do inew=1,nnew
4299        icol = new_list(inew)
4300        do ib=1,my_nband
4301          band = my_band_list(ib)
4302          if (ABS(umat_sk(band,icol))>tol12) then
4303             new_ug(:,inew) = new_ug(:,inew) + umat_sk(band,icol) * Wfd%Wave(band,ik_ibz,spin)%ug
4304          end if
4305        end do
4306      end do
4307 
4308      !if (istwf_k /= 1) then
4309      !  ABI_MALLOC(new_ur, (wfd%nfft * wfd%nspinor * nnew))
4310      !  call fft_ug_dpc(npw_k, wfd%nfft, wfd%nspinor, nnew, wfd%mgfft, wfd%ngfft, istwf_k, &
4311      !                  wfd%kdata(ik_ibz)%kg_k, wfd%kdata(ik_ibz)%gbound, new_ug, new_ur)
4312      !  new_ur = real(new_ur)
4313      !  call fft_ur_dpc(npw_k, wfd%nfft, wfd%nspinor, nnew, wfd%mgfft, wfd%ngfft, istwf_k, &
4314      !                  wfd%kdata(ik_ibz)%kg_k, wfd%kdata(ik_ibz)%gbound, new_ur, new_ug)
4315      !  ABI_FREE(new_ur)
4316      !end if
4317 
4318      call xmpi_sum(new_ug,Wfd%comm,ierr)
4319 
4320      ! Update the input wave functions
4321      do inew=1,nnew
4322        band = new_list(inew)
4323        if (wfd_ihave_ug(Wfd,band,ik_ibz,spin)) call wfd_push_ug(Wfd,band,ik_ibz,spin,Cryst,new_ug(:,inew))
4324      end do
4325 
4326      ABI_FREE(new_ug)
4327    end do !ik_ibz
4328  end do !spin
4329 
4330  ! Reinit the storage mode of Wfd as ug have been changed.
4331  ! This is needed only if FFTs are not done in wfd_push_ug. Do not know which one is faster.
4332  !call wfd_reset_ur_cprj(Wfd)
4333  call xmpi_barrier(Wfd%comm)
4334 
4335  DBG_EXIT("COLL")
4336 
4337 end subroutine wfd_rotate

m_wfd/wfd_sanity_check [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_sanity_check

FUNCTION

  Debugging tool

INPUTS

  Wfd<wfd_t>=

OUTPUT

PARENTS

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

4525 subroutine wfd_sanity_check(Wfd)
4526 
4527 
4528 !This section has been created automatically by the script Abilint (TD).
4529 !Do not modify the following lines by hand.
4530 #undef ABI_FUNC
4531 #define ABI_FUNC 'wfd_sanity_check'
4532 !End of the abilint section
4533 
4534  implicit none
4535 
4536 !Arguments ------------------------------------
4537 !scalars
4538  type(wfd_t),intent(inout) :: Wfd
4539 
4540 !Local variables ------------------------------
4541 !scalars
4542  integer :: ik_ibz,spin,band,mpi_ierr,ierr,how_manyb,unt_dbg,irank
4543  character(len=500) :: msg
4544 !arrays
4545  integer :: my_band_list(Wfd%mband)
4546 
4547 !************************************************************************
4548 
4549  call wfd_update_bkstab(Wfd)
4550  ierr=0
4551 
4552  do spin=1,Wfd%nsppol
4553    do ik_ibz=1,Wfd%nkibz
4554       do band=1,Wfd%nband(ik_ibz,spin)
4555         if (Wfd%bks_tab(band,ik_ibz,spin, Wfd%my_rank) == WFD_STORED .and. .not. wfd_ihave_ug(Wfd,band,ik_ibz,spin,"Stored") ) then
4556           write(msg,'(a,3(i0,1x))')" Found inconsistency in bks_tab for (band, ik_ibz, spin): ",band,ik_ibz,spin
4557           call wrtout(std_out,msg,"PERS")
4558           ierr=ierr+1
4559         end if
4560      end do
4561    end do
4562  end do
4563 
4564  call xmpi_sum(ierr,Wfd%comm,mpi_ierr)
4565 
4566  if (ierr/=0) then
4567    if (open_file("__WFD_DEBUG__",msg,newunit=unt_dbg,form="formatted") /= 0) then
4568      MSG_ERROR(msg)
4569    end if
4570 
4571    do irank=0,Wfd%nproc-1
4572      if (irank==Wfd%my_rank) then
4573        write(unt_dbg,*)" (k,b,s) states owned by rank: ",Wfd%my_rank
4574 
4575        do spin=1,Wfd%nsppol
4576          do ik_ibz=1,Wfd%nkibz
4577             write(unt_dbg,*)" (spin,ik_ibz) ",spin,ik_ibz
4578             call wfd_mybands(Wfd,ik_ibz,spin,how_manyb,my_band_list,"Stored")
4579             write(unt_dbg,*) (my_band_list(band),band=1,how_manyb)
4580           end do
4581        end do
4582 
4583      end if
4584    end do
4585    close(unt_dbg)
4586    call xmpi_barrier(Wfd%comm)
4587    MSG_ERROR("Sanity check failed. Check WFD_DEBUG")
4588  end if
4589 
4590 end subroutine wfd_sanity_check

m_wfd/wfd_set_mpicomm [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_set_mpicomm

FUNCTION

PARENTS

      m_shirley,m_wfd

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

4038 subroutine wfd_set_mpicomm(Wfd)
4039 
4040 
4041 !This section has been created automatically by the script Abilint (TD).
4042 !Do not modify the following lines by hand.
4043 #undef ABI_FUNC
4044 #define ABI_FUNC 'wfd_set_mpicomm'
4045 !End of the abilint section
4046 
4047  implicit none
4048 
4049 !Arguments ------------------------------------
4050 !scalars
4051  type(wfd_t),intent(inout) :: Wfd
4052 
4053 !Local variables ------------------------------
4054 !scalars
4055  integer :: spin,ierr,how_many,spin_comm
4056  integer :: world_group,spin_group
4057  !character(len=500) :: msg
4058 !arrays
4059  integer :: proc_ranks(Wfd%nproc)
4060 
4061 !************************************************************************
4062 
4063  ! First free the old communicators.
4064  call xmpi_comm_free(Wfd%bks_comm)
4065  !
4066  ! Update the bks_tab.
4067  call wfd_update_bkstab(Wfd)
4068 
4069  call xmpi_comm_group(Wfd%comm,world_group,ierr)
4070 
4071  ! Init spin communicators.
4072  do spin=1,Wfd%nsppol
4073    ! The list of procs owining at least one state with this spin.
4074    call wfd_who_has_ug(Wfd,0,0,spin,how_many,proc_ranks)
4075 
4076    if (how_many>0) then
4077      call xmpi_group_incl(world_group,how_many,proc_ranks,spin_group,ierr)
4078      call xmpi_comm_create(Wfd%comm,spin_group,spin_comm,ierr)
4079      Wfd%bks_comm(0,0,spin) = spin_comm
4080      call xmpi_group_free(spin_group)
4081    else
4082      MSG_WARNING(sjoin("Nobody has spin:",itoa(spin)))
4083      Wfd%bks_comm(0,0,spin) = xmpi_comm_null
4084    end if
4085 
4086  end do
4087 
4088  call xmpi_group_free(world_group)
4089 
4090 end subroutine wfd_set_mpicomm

m_wfd/wfd_show_bkstab [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_show_bkstab

FUNCTION

  Print a table showing the distribution of the wavefunctions.

PARENTS

      m_wfd

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

3353 subroutine wfd_show_bkstab(Wfd,unit)
3354 
3355 
3356 !This section has been created automatically by the script Abilint (TD).
3357 !Do not modify the following lines by hand.
3358 #undef ABI_FUNC
3359 #define ABI_FUNC 'wfd_show_bkstab'
3360 !End of the abilint section
3361 
3362  implicit none
3363 
3364 !Arguments ------------------------------------
3365 !scalars
3366  integer,intent(in) :: unit
3367  type(wfd_t),intent(in) :: Wfd
3368 
3369 !Local variables ------------------------------
3370 !scalars
3371  integer :: ik_ibz,spin,band,nband_k,width
3372  character(len=1) :: chlist(0:Wfd%nproc-1)
3373  character(len=500) :: fmt
3374 
3375 !************************************************************************
3376 
3377  width = max(80, Wfd%nproc)
3378 
3379  write(fmt,"(a,i0,a)")"(i5,3x,",Wfd%nproc,"(a))"
3380 
3381  do spin=1,Wfd%nsppol
3382     do ik_ibz=1,Wfd%nkibz
3383       write(unit,"(a)")repeat("=",width)
3384       write(unit,"(2(a,i0))")"Spin: ",spin,", ik_ibz: ",ik_ibz
3385       write(unit,"(a)")"MPI rank ----> (A=allocated, S=Stored, N=NoWave)."
3386       nband_k = Wfd%nband(ik_ibz, spin)
3387       do band=1,nband_k
3388         where (Wfd%bks_tab(band,ik_ibz,spin,:) == WFD_NOWAVE)
3389           chlist = "N"
3390         elsewhere (Wfd%bks_tab(band,ik_ibz,spin,:) == WFD_ALLOCATED)
3391           chlist = "A"
3392         elsewhere (Wfd%bks_tab(band,ik_ibz,spin,:) == WFD_STORED)
3393           chlist = "S"
3394         end where
3395         write(unit,fmt)band,chlist(:)
3396       end do
3397       write(unit,"(a)")repeat("=",width)
3398     end do
3399  end do
3400 
3401 end subroutine wfd_show_bkstab

m_wfd/wfd_sym_ur [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_sym_ur

FUNCTION

  Symmetrize a wave function in real space

INPUTS

  Wfd<wfd_t>=the wavefunction descriptor.
  Cryst<crystal_t>=Structure describing the crystal structure and its symmetries.
  Kmesh<kmesh_t>=Structure describing the BZ sampling
  band=Band index.
  ik_bz=Index of the k-point in the BZ.
  spin=Spin index
  [trans] = "N" if only the symmetried wavefunction is needed, "C" if the complex conjugate is required.
            Default is "N"
  [with_umklp] = Optional flag. If .True. (Default) the umklapp G0 vector in the relation kbz = Sk + G0
                 is taken into account when constructing u_kbz.

OUTPUT

  ur_kbz(Wfd%nfft*Wfd%nspinor)=The symmetrized wavefunction in real space.
  [ur_kibz(Wfd%nfft*Wfd%nspinor)]= Optional output: u(r) in the IBZ.

PARENTS

      debug_tools,exc_plot,m_bseinterp,m_shirley

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

5452 subroutine wfd_sym_ur(Wfd,Cryst,Kmesh,band,ik_bz,spin,ur_kbz,trans,with_umklp,ur_kibz)
5453 
5454 
5455 !This section has been created automatically by the script Abilint (TD).
5456 !Do not modify the following lines by hand.
5457 #undef ABI_FUNC
5458 #define ABI_FUNC 'wfd_sym_ur'
5459 !End of the abilint section
5460 
5461  implicit none
5462 
5463 !Arguments ------------------------------------
5464 !scalars
5465  integer,intent(in) :: band,ik_bz,spin
5466  character(len=*),optional,intent(in) :: trans
5467  logical,optional,intent(in) :: with_umklp
5468  type(crystal_t),intent(in) :: Cryst
5469  type(kmesh_t),intent(in) :: Kmesh
5470  type(wfd_t),intent(inout) :: Wfd
5471 !arrays
5472  complex(gwpc),intent(out) :: ur_kbz(Wfd%nfft*Wfd%nspinor)
5473  complex(gwpc),optional,intent(out) :: ur_kibz(Wfd%nfft*Wfd%nspinor)
5474 
5475 !Local variables ------------------------------
5476 !scalars
5477  integer :: ik_ibz,isym_k,itim_k,nr,ispinor,spad,ir,ir2
5478  integer :: fft_idx,ix,iy,iz,nx,ny,nz,irot
5479  real(dp) :: gdotr
5480  complex(dpc) :: ph_mkt,u2b,u2a
5481  complex(gwpc) :: gwpc_ph_mkt
5482  logical :: isirred,my_with_umklp
5483  character(len=1) :: my_trans
5484  character(len=500) :: msg
5485 !arrays
5486  integer :: umklp(3)
5487  real(dp) :: kbz(3),spinrot_k(4)
5488  complex(dpc) :: spinrot_mat(2,2)
5489  complex(gwpc),allocatable :: ur(:)
5490 
5491 !************************************************************************
5492 
5493  my_trans = "N"; if (PRESENT(trans)) my_trans = toupper(trans(1:1))
5494  my_with_umklp = .TRUE.; if (PRESENT(with_umklp)) my_with_umklp = with_umklp
5495 
5496  ! k_bz =  S k - G0 ==> u_{k_bz} =  e^{iG0.r} u_{Sk}
5497  ! k_bz = -S k - G0 ==> u_{k_bz} =  e^{iG0.r} u_{Sk}^*
5498 
5499  ! u(r,b,kbz)=e^{-2i\pi kibz.(R^{-1}t} u (R{^-1}(r-t),b,kibz)
5500  !           =e^{+2i\pi kibz.(R^{-1}t} u*({R^-1}(r-t),b,kibz) for time-reversal
5501  !
5502  ! * Get ik_ibz, non-symmorphic phase, ph_mkt, and symmetries from ik_bz.
5503  call get_BZ_item(Kmesh,ik_bz,kbz,ik_ibz,isym_k,itim_k,ph_mkt,umklp,isirred)
5504  gwpc_ph_mkt = ph_mkt
5505 
5506  if (isirred) then
5507    ! Avoid symmetrization if this point is irreducible.
5508    call wfd_get_ur(Wfd,band,ik_ibz,spin,ur_kbz)
5509    if (PRESENT(ur_kibz)) then
5510       call xcopy(Wfd%nfft*Wfd%nspinor,ur_kbz,1,ur_kibz,1)
5511    end if
5512    if (my_trans=="C") ur_kbz = GWPC_CONJG(ur_kbz)
5513    RETURN
5514  end if
5515 
5516  ! Reconstruct ur in the BZ from the corresponding wavefunction in IBZ.
5517  ABI_MALLOC(ur, (Wfd%nfft*Wfd%nspinor))
5518 
5519  call wfd_get_ur(Wfd,band,ik_ibz,spin,ur)
5520  if (PRESENT(ur_kibz)) then
5521    call xcopy(Wfd%nfft*Wfd%nspinor,ur,1,ur_kibz,1)
5522  end if
5523 
5524  ! Wfd%irottb(:,isym_k) is the table for rotated FFT points
5525  SELECT CASE (Wfd%nspinor)
5526 
5527  CASE (1)
5528    ! Rotation in real space
5529    do ir=1,Wfd%nfft
5530      irot = Wfd%irottb(ir,isym_k)
5531      ur_kbz(ir) = ur(irot) * gwpc_ph_mkt
5532    end do
5533 
5534    ! Apply time-reversal symmetry if needed.
5535    if (itim_k==2) ur_kbz = GWPC_CONJG(ur_kbz)
5536 
5537    ! Take into account a possible umklapp.
5538    if (ANY(umklp/=0).and. my_with_umklp) then
5539      ! Compute ur_kbz = ur_kbz*eig0r
5540      nx = Wfd%ngfft(1)
5541      ny = Wfd%ngfft(2)
5542      nz = Wfd%ngfft(3)
5543 
5544      fft_idx=0
5545      do iz=0,nz-1
5546        do iy=0,ny-1
5547          do ix=0,nx-1
5548            gdotr= two_pi*( umklp(1)*(ix/DBLE(nx)) &
5549 &                         +umklp(2)*(iy/DBLE(ny)) &
5550 &                         +umklp(3)*(iz/DBLE(nz)) )
5551            fft_idx = fft_idx+1
5552            ur_kbz(fft_idx) = ur_kbz(fft_idx) * DCMPLX(DCOS(gdotr),DSIN(gdotr))
5553          end do
5554        end do
5555      end do
5556    end if
5557 
5558    if (my_trans=="C") ur_kbz = GWPC_CONJG(ur_kbz)
5559 
5560  CASE (2)
5561    MSG_ERROR("Implementation has to be tested")
5562 
5563    nr = Wfd%nfft
5564    spinrot_k = Cryst%spinrot(:,isym_k)
5565    !
5566    ! ==== Apply Time-reversal if required ====
5567    ! \psi_{-k}^1 =  (\psi_k^2)^*
5568    ! \psi_{-k}^2 = -(\psi_k^1)^*
5569    if (itim_k==1) then
5570      ur_kbz = ur
5571    else if (itim_k==2) then
5572      ur_kbz(1:nr)     = GWPC_CONJG(ur(nr+1:2*nr))
5573      ur_kbz(nr+1:2*nr)=-GWPC_CONJG(ur(1:nr))
5574    else
5575      MSG_ERROR('Wrong i2 in spinor')
5576    end if
5577    !
5578    ! Rotate wavefunctions in real space.
5579    do ispinor=1,Wfd%nspinor
5580      spad=(ispinor-1)*nr
5581      do ir=1,nr
5582        ir2 = Wfd%irottb(ir,isym_k)
5583        ur_kbz(ir+spad) = ur_kbz(ir2+spad) * gwpc_ph_mkt
5584      end do
5585    end do
5586    !
5587    ! Rotation in spinor space.
5588    spinrot_mat(1,1)= spinrot_k(1) + j_dpc*spinrot_k(4)
5589    spinrot_mat(1,2)= spinrot_k(3) + j_dpc*spinrot_k(2)
5590    spinrot_mat(2,1)=-spinrot_k(3) + j_dpc*spinrot_k(2)
5591    spinrot_mat(2,2)= spinrot_k(1) - j_dpc*spinrot_k(4)
5592 
5593    do ir=1,nr
5594      u2a=ur_kbz(ir)
5595      u2b=ur_kbz(ir+nr)
5596      ur_kbz(ir)   =spinrot_mat(1,1)*u2a+spinrot_mat(1,2)*u2b
5597      ur_kbz(ir+nr)=spinrot_mat(2,1)*u2a+spinrot_mat(2,2)*u2b
5598    end do
5599 
5600    if (ANY(umklp /=0)) then
5601      !ur_kbz(1:Wfd%nfft)  = ur_kbz(1:Wfd%nfft) *eig0r
5602      !ur_kbz(Wfd%nfft+1:) = ur_kbz(Wfd%nfft+1:)*eig0r
5603    end if
5604 
5605  CASE DEFAULT
5606    write(msg,'(a,i0)')" Wrong value for nspinor: ",Wfd%nspinor
5607    MSG_ERROR(msg)
5608  END SELECT
5609 
5610  ABI_FREE(ur)
5611 
5612 end subroutine wfd_sym_ur

m_wfd/wfd_t [ Types ]

[ Top ] [ Types ]

NAME

 wfd_t

FUNCTION

 Container gathering information on the set of wavefunctions treated by
 this node as well as their distribution inside the MPI communicator.

SOURCE

257  type,public :: wfd_t
258 
259   integer :: id                 !< Identifier.
260   integer :: debug_level=0      ! Internal flag defining the debug level.
261   integer :: lmnmax
262   integer :: mband              ! MAX(nband)
263   integer :: mgfft              ! Maximum size of 1D FFTs i.e. MAXVAL(ngfft(1:3)), used to dimension some arrays.
264   !% integer :: mpsang
265   integer :: natom
266   integer :: nfft               ! Number of FFT points treated by this processor
267   integer :: nfftot             ! Total number of points in the FFT grid
268   integer :: nkibz              ! Number of irreducible k-points
269   integer :: npwwfn             ! Number of G vectors for wavefunctions
270   integer :: nspden             ! Number of independent spin-density components
271   integer :: nspinor            ! Number of spinor components
272   integer :: nsppol             ! Number of independent spin polarizations
273   integer :: ntypat
274   integer :: paral_kgb          ! Option for kgb parallelism
275   integer :: usepaw             ! 1 if PAW is used, 0 otherwise.
276   integer :: prtvol             ! Verbosity level.
277   integer :: pawprtvol          ! Verbosity level for PAW.
278   integer :: usewvl             ! 1 if BigDFT is used, 0 otherwise.
279   !integer :: useylm            ! 1 if nonlocal part is applied using Ylm instead of Pl.
280   integer :: comm               ! The MPI communicator for this pool of processors.
281   integer :: master             ! The rank of master node in comm.
282   integer :: my_rank            ! The rank of my processor inside the MPI communicator comm.
283   integer :: nproc              ! The number of processors in MPI comm.
284 
285   logical :: rfft_is_symok      ! .TRUE. if the real space FFT mesh is compatible with the rotational
286                                 ! part of the space group.
287 
288   real(dp) :: dilatmx
289 
290   real(dp) :: ecut
291    ! Cutoff for plane wave basis set.
292 
293   real(dp) :: ecutsm
294    ! ecutsm=smearing energy for plane wave kinetic energy (Ha)
295    ! Cutoff for plane wave basis set.
296 
297   !% real(dp) :: pawecutdg=zero
298    ! Cutoff for plane wave basis set.
299 
300   logical :: gamma_centered=.TRUE.
301   !logical :: gamma_centered=.FALSE.
302    ! .TRUE. if ug are given on the Gamma-centered G-sphere. Flag nedded to preserve the old Implementation.
303 
304   !% real(dp) :: effmass_free
305   ! Effective mass for electrons
306 
307 !arrays
308   integer :: ngfft(18)
309    ! Information about 3D FFT, see ~abinit/doc/variables/vargs.htm#ngfft
310 
311   integer :: nloalg(3)
312    ! Governs the choice of the algorithm for nonlocal operator. See doc.
313 
314   integer,allocatable :: gvec(:,:)
315   ! gvec(3,npwwfn)
316   ! Reduced coordinates of the planewaves.
317   ! TODO This is redundant and should be removed when k-centered G-sphere will be used.
318 
319   integer,allocatable :: irottb(:,:)
320    ! irottb(nfftot,nsym)
321    ! Index of $R^{-1}(r-\tau)$ in the FFT box.
322 
323   integer,allocatable :: istwfk(:)
324    ! istwfk(nkibz)
325    ! Storage mode for this k-point.
326 
327   integer,allocatable :: nband(:,:)
328    ! nband(nkibz,nsppol)
329    ! Number of bands at each k-point and spin.
330 
331   integer,allocatable :: indlmn(:,:,:)
332    ! indlmn(6,lmnmax,ntypat)
333    ! array giving l,m,n,lm,ln,spin for i=ln  (if useylm=0)
334    !                                or i=lmn (if useylm=1)
335 
336   integer,allocatable :: nlmn_atm(:)
337    ! nlmn_atm(natom)
338    ! Number of (n,l,m) channels for each atom. Only for PAW
339 
340   integer,allocatable :: nlmn_sort(:)
341    ! nlmn_sort(natom)
342    ! Number of (n,l,m) channels for each atom (sorted by atom type). Only for PAW
343 
344   integer,allocatable :: nlmn_type(:)
345    ! nlmn_type(ntypat)
346    ! Number of (n,l,m) channels for each type of atom. Only for PAW.
347 
348   integer,allocatable :: npwarr(:)
349    ! npwarr(nkibz)
350    ! Number of plane waves for this k-point.
351 
352   integer,allocatable :: bks_tab(:,:,:,:)
353    ! bks_tab(mband,nkibz,nsppol,0:nproc-1)
354    ! Global table used to keep trace of the distribution of the (b,k,s) states on each node inside Wfd%comm.
355    ! 1 if the node has this state. 0 otherwise.
356    ! A node owns a wavefunction if the corresponding ug is allocated AND computed.
357    ! If a node owns ur but not ug, or ug is just allocated then its entry in the table is zero.
358 
359   ! TODO: To be removed
360   integer,allocatable :: bks_comm(:,:,:)
361    ! spin_comm(0:mband,0:nkibz,0:nsppol)
362    ! MPI communicators.
363    ! bks_comm(0,0,spin) MPI communicator for spin
364    ! bks_comm(0,ik_ibz,spin)  MPI communicator for k-points.
365 
366   real(dp),allocatable :: kibz(:,:)
367    ! kibz(3,nkibz)
368    ! Reduced coordinates of the k-points in the IBZ.
369 
370   real(dp),allocatable :: ph1d(:,:)
371    ! ph1d(2,3*(2*mgfft+1)*natom)
372    ! 1-dim structure factor phase information.
373 
374   logical,allocatable :: keep_ur(:,:,:)
375    ! keep(mband,nkibz,nsppol)
376    ! Storage strategy: keep or not keep calculated u(r) in memory.
377 
378 ! types
379   type(kdata_t),allocatable :: Kdata(:)
380    ! Kdata(nkibz)
381    ! datatype storing k-dependent quantities.
382 
383   type(wave_t),allocatable :: Wave(:,:,:)
384    ! Wave(mband,nkibz,nsppol)
385    ! Array of structures storing the periodic part of the wavefunctions in reciprocal- and real-space.
386 
387   type(MPI_type) :: MPI_enreg
388    ! The MPI_type structured datatype gather different information about the MPI parallelisation :
389    ! number of processors, the index of my processor, the different groups of processors, etc ...
390 
391  end type wfd_t
392 
393  public :: wfd_init                ! Main creation method.
394  public :: wfd_free                ! Destructor.
395  public :: wfd_copy                ! Copy routine
396  public :: wfd_norm2               ! Compute <u(g)|u(g)> for the same k-point and spin.
397  public :: wfd_xdotc               ! Compute <u_{b1ks}|u_{b2ks}> in reciprocal space
398  public :: wfd_reset_ur_cprj       ! Reinitialize memory storage of u(r) and <p_i|psi>
399  public :: wfd_get_many_ur         ! Get many wavefunctions in real space from its (bands(:),k,s) indices.
400  public :: wfd_copy_cg             ! Return a copy of u(g) in a real(2,npw_k)) array (Abinit convention)
401  public :: wfd_get_ur              ! Get one wavefunction in real space from its (b,k,s) indices.
402  public :: wfd_get_cprj            ! Get one PAW projection <Proj_i|Cnk> with all NL projectors from its (b,k,s) indices.
403  public :: wfd_change_ngfft        ! Reinitialize internal FFT tables.
404  public :: wfd_nullify             ! Set all pointers to null()
405  public :: wfd_print               ! Printout of basic info.
406  public :: wfd_mkall_ur            ! Calculate all ur owned by this node at once.
407  public :: wfd_ug2cprj             ! Get PAW cprj from its (b,k,s) indices.
408  public :: wfd_ptr_ug              ! Return a pointer to ug from its (b,k,s) indices. Use it carefully!
409  public :: wfd_ptr_ur              ! Return a pointer to ur from its (b,k,s) indices. Use it carefully!
410  public :: wfd_wave_free           ! Free internal buffers used to store the wavefunctions.
411  public :: wfd_push_ug             ! Modify the value of u(g)_ks stored in the object.
412  public :: wfd_extract_cgblock     ! Extract a block of wavefunctions for a given spin and k-points (uses the cg storage mode)
413  public :: wfd_ihave_ug            ! True if the node has this ug with the specified status.
414  public :: wfd_ihave_ur            ! True if the node has this ur with the specified status.
415  public :: wfd_ihave_cprj          ! True if the node has this cprj with the specified status.
416  public :: wfd_itreat_spin         ! Test if the processor is treating a block of wavefunctions with the specified spin.
417  public :: wfd_mybands             ! Returns the list of band indices of the u(g) owned by this node at given (k,s).
418  public :: wfd_show_bkstab         ! Print a table showing the distribution of the wavefunctions.
419  public :: wfd_distribute_bands    ! Distribute a set of bands taking into account the distribution of the ug.
420  public :: wfd_iterator_bks        ! Iterator used to loop over bands, k-points and spin indices
421  public :: wfd_bks_distrb          ! Distribute bands, k-points and spins
422  public :: wfd_update_bkstab       ! Update the internal table with info on the distribution of the ugs.
423  public :: wfd_set_mpicomm
424  public :: wfd_rotate              ! Linear transformation of the wavefunctions stored in Wfd
425  public :: wfd_sanity_check        ! Debugging tool
426  public :: wfd_distribute_bbp      ! Distribute a set of (b,b') indices
427  public :: wfd_distribute_kb_kpbp
428  public :: wfd_iam_master
429  public :: wfd_test_ortho          ! Test the orthonormalization of the wavefunctions.
430  public :: wfd_barrier
431  public :: wfd_sym_ur              ! Symmetrize a wave function in real space
432  public :: wfd_paw_get_aeur        ! Compute the AE PAW wavefunction in real space.
433  public :: wfd_plot_ur             ! Write u(r) to an external file in XSF format.
434  public :: wfd_write_wfk           ! Write u(g) to a WFK file.
435  public :: wfd_read_wfk            ! Read u(g) from the WFK file completing the initialization of the object.
436  public :: wfd_from_wfk            ! Simplified interface to initialize the object from a WFK file.
437  !public :: wfd_get_socpert
438  public :: wfd_mkrho               ! Calculate the charge density on the fine FFT grid in real space.
439  public :: test_charge
440  public :: wfd_pawrhoij

m_wfd/wfd_test_ortho [ Functions ]

[ Top ] [ Functions ]

NAME

 wfd_test_ortho

FUNCTION

  Test the orthonormalization of the wavefunctions stored in Wfd.

INPUTS

  Wfd<wfd_t>=wavefunction descriptor.
  Cryst<crystal_t>=Object defining the unit cell and its symmetries.
  Pawtab(ntypat*usepaw)<type(pawtab_type)>=PAW tabulated starting data.

OUTPUT

   Only writing.

PARENTS

      bethe_salpeter,m_gkk,m_phgamma,m_phpi,m_shirley,m_sigmaph,screening
      sigma,wfk_analyze

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

5216 subroutine wfd_test_ortho(Wfd,Cryst,Pawtab,unit,mode_paral)
5217 
5218 
5219 !This section has been created automatically by the script Abilint (TD).
5220 !Do not modify the following lines by hand.
5221 #undef ABI_FUNC
5222 #define ABI_FUNC 'wfd_test_ortho'
5223 !End of the abilint section
5224 
5225  implicit none
5226 
5227 !Arguments ------------------------------------
5228 !scalars
5229  integer,intent(in),optional :: unit
5230  character(len=4),optional,intent(in) :: mode_paral
5231  type(crystal_t),intent(in) :: Cryst
5232  type(wfd_t),target,intent(inout) :: Wfd
5233 !array
5234  type(Pawtab_type),intent(in) :: Pawtab(Cryst%ntypat*Wfd%usepaw)
5235 
5236 !Local variables ------------------------------
5237 !scalars
5238  integer :: ik_ibz,spin,band,band1,band2,ib,ib1,ib2,ierr,how_manyb,my_unt,npw_k,istwf_k
5239  real(dp) :: glob_cinf,my_cinf,glob_csup,my_csup,glob_einf,min_norm2,glob_esup,max_norm2
5240  complex(dpc) :: cdum
5241  logical :: bands_are_spread
5242  character(len=4) :: my_mode
5243  character(len=500) :: msg
5244 !arrays
5245  integer :: my_bandlist(Wfd%mband)
5246  real(dp) :: pawovlp(2)
5247  complex(gwpc),ABI_CONTIGUOUS pointer :: ug1(:),ug2(:)
5248  !complex(gwpc) :: ur(Wfd%nfft*Wfd%nspinor)
5249  character(len=6) :: tag_spin(2)
5250  type(pawcprj_type),allocatable :: Cp1(:,:),Cp2(:,:)
5251 
5252 !************************************************************************
5253 
5254  tag_spin(:)=(/'      ','      '/); if (Wfd%nsppol==2) tag_spin(:)=(/' UP   ',' DOWN '/)
5255 
5256  my_unt   =std_out; if (PRESENT(unit      )) my_unt   =unit
5257  my_mode  ='COLL' ; if (PRESENT(mode_paral)) my_mode  =mode_paral
5258 
5259  if (Wfd%usepaw==1) then
5260    ABI_DT_MALLOC(Cp1,(Wfd%natom,Wfd%nspinor))
5261    call pawcprj_alloc(Cp1,0,Wfd%nlmn_atm)
5262    ABI_DT_MALLOC(Cp2,(Wfd%natom,Wfd%nspinor))
5263    call pawcprj_alloc(Cp2,0,Wfd%nlmn_atm)
5264  end if
5265 
5266  bands_are_spread = .FALSE.
5267 
5268  do spin=1,Wfd%nsppol
5269    min_norm2=greatest_real; max_norm2=-greatest_real
5270    my_cinf=greatest_real;  my_csup=-greatest_real
5271    do ik_ibz=1,Wfd%nkibz
5272      istwf_k = Wfd%istwfk(ik_ibz)
5273      npw_k   = Wfd%npwarr(ik_ibz)
5274      !
5275      ! Select my band indices.
5276      call wfd_mybands(Wfd,ik_ibz,spin,how_manyb,my_bandlist,"Stored")
5277      if (how_manyb/=Wfd%nband(ik_ibz,spin)) bands_are_spread = .TRUE.
5278 
5279      ! 1) Normalization.
5280      do ib=1,how_manyb
5281        band = my_bandlist(ib)
5282        ug1 => Wfd%Wave(band,ik_ibz,spin)%ug
5283        cdum = xdotc(npw_k*Wfd%nspinor,ug1,1,ug1,1)
5284        if (istwf_k>1) then
5285          cdum=two*DBLE(cdum)
5286          if (istwf_k==2) cdum=cdum-CONJG(ug1(1))*ug1(1)
5287        end if
5288        if (Wfd%usepaw==1) then
5289          call wfd_get_cprj(Wfd,band,ik_ibz,spin,Cryst,Cp1,sorted=.FALSE.)
5290          pawovlp = paw_overlap(Cp1,Cp1,Cryst%typat,Pawtab,spinor_comm=Wfd%MPI_enreg%comm_spinor)
5291          cdum = cdum + CMPLX(pawovlp(1),pawovlp(2))
5292        end if
5293        !write(std_out,*)"ik_ibz, band, spin, cdum: ",ik_ibz,band,spin,cdum
5294        if (REAL(cdum)<min_norm2) min_norm2=REAL(cdum)
5295        if (REAL(cdum)>max_norm2) max_norm2=REAL(cdum)
5296      end do
5297 
5298      call xmpi_min(min_norm2,glob_einf,Wfd%comm,ierr) ! TODO should use the communicator for this spin
5299      call xmpi_max(max_norm2,glob_esup,Wfd%comm,ierr)
5300      !
5301      ! 2) Orthogonality of wavefunctions.
5302      do ib1=1,how_manyb
5303        band1 = my_bandlist(ib1)
5304        ug1 => Wfd%Wave(band1,ik_ibz,spin)%ug
5305        if (Wfd%usepaw==1) then
5306          call wfd_get_cprj(Wfd,band1,ik_ibz,spin,Cryst,Cp1,sorted=.FALSE.)
5307        end if
5308 
5309        do ib2=ib1+1,how_manyb
5310          band2 = my_bandlist(ib2)
5311          ug2 => Wfd%Wave(band2,ik_ibz,spin)%ug
5312          if (Wfd%usepaw==1) then
5313            call wfd_get_cprj(Wfd,band2,ik_ibz,spin,Cryst,Cp2,sorted=.FALSE.)
5314          end if
5315          cdum = xdotc(npw_k*Wfd%nspinor,ug1,1,ug2,1)
5316          if (istwf_k>1) then
5317            cdum=two*DBLE(cdum)
5318            if (istwf_k==2) cdum=cdum-CONJG(ug1(1))*ug2(1)
5319          end if
5320          if (Wfd%usepaw==1) then
5321            pawovlp = paw_overlap(Cp1,Cp2,Cryst%typat,Pawtab,spinor_comm=Wfd%MPI_enreg%comm_spinor)
5322            cdum = cdum + CMPLX(pawovlp(1),pawovlp(2))
5323          end if
5324 
5325          if (ABS(cdum)<my_cinf) my_cinf=ABS(cdum)
5326          if (ABS(cdum)>my_csup) my_csup=ABS(cdum)
5327          !if (ABS(cdum) > 0.1) write(std_out,*)" ib1,ib2,ABS_dotprod: ",ib1,ib2,ABS(cdum)
5328        end do !ib2
5329      end do !ib
5330 
5331      ! TODO should use the communicator for this spin
5332      call xmpi_min(my_cinf,glob_cinf,Wfd%comm,ierr)
5333      call xmpi_max(my_csup,glob_csup,Wfd%comm,ierr)
5334    end do ! ik_ibz
5335    !
5336    ! Output results for this spin
5337    write(msg,'(2a)')ch10,' test on the normalization of the wavefunctions'
5338    if (Wfd%nsppol==2) write(msg,'(3a)')ch10,' test on the normalization of the wavefunctions with spin ',tag_spin(spin)
5339    call wrtout(my_unt,msg,mode_paral)
5340    write(msg,'(a,f9.6,a,a,f9.6)')&
5341 &    ' min sum_G |a(n,k,G)| = ',glob_einf,ch10,&
5342 &    ' max sum_G |a(n,k,G)| = ',glob_esup
5343    call wrtout(my_unt,msg,mode_paral)
5344 
5345    write(msg,'(a)')' test on the orthogonalization of the wavefunctions (NB: this is not invariant for degenerate states)'
5346    if (Wfd%nsppol==2) write(msg,'(2a)')' test on the orthogonalization of the wavefunctions with spin ',tag_spin(spin)
5347    call wrtout(my_unt,msg,mode_paral)
5348    write(msg,'(a,f9.6,a,a,f9.6,a)')&
5349 &    '- min sum_G a(n,k,G)a(n",k,G) = ',glob_cinf,ch10,&
5350 &    '- max sum_G a(n,k,G)a(n",k,G) = ',glob_csup,ch10
5351    call wrtout(my_unt,msg,mode_paral)
5352 
5353  end do ! spin
5354 
5355  if (bands_are_spread) then
5356    write(msg,'(3a)')&
5357 &    'Note that the test on the orthogonalization is not complete ',ch10,&
5358 &    'since bands are spread among different processors'
5359    call wrtout(my_unt,msg,mode_paral)
5360  end if
5361 
5362  if (Wfd%usepaw==1) then
5363    call pawcprj_free(Cp1)
5364    ABI_DT_FREE(Cp1)
5365    call pawcprj_free(Cp2)
5366    ABI_DT_FREE(Cp2)
5367  end if
5368 
5369 end subroutine wfd_test_ortho

m_wfd/wfd_ug2cprj [ Functions ]

[ Top ] [ Functions ]

NAME

 wfd_ug2cprj

FUNCTION

  Calculate the projected wave function <Proj_i|Cnk> with all NL projectors for a single
  k-point, band and spin.

INPUTS

  Wfd<wfd_t>=Structure containing the wave functions for the GW.
  ik_ibz=Index of the required k-point
  spin=Required spin index.
  choice=chooses possible output:
    In addition to projected wave function:
    choice=1 => nothing else
          =2 => 1st gradients with respect to atomic position(s)
          =3 => 1st gradients with respect to strain(s)
          =23=> 1st gradients with respect to atm. pos. and strain(s)
          =4 => 2nd derivatives with respect to atomic pos.
          =24=> 1st and 2nd derivatives with respect to atomic pos.
          =5 => 1st gradients with respect to k wavevector
          =6 => 2nd derivatives with respect to strain and atm. pos.
  idir=direction of the derivative, i.e. dir. of - atom to be moved  in the case choice=2
                                                 - strain component  in the case choice=3
                                                 - k point direction in the case choice=5
       Compatible only with choice=2,3,5; if idir=0, all derivatives are computed
  natom
  Cryst
  [sorted]=Logical flags defining if the output Cprj has to be sorted by atom type or not.
    By default, Cprj matrix elements are unsorted.

OUTPUT

  cwaveprj

PARENTS

      classify_bands,m_wfd

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

2133 subroutine wfd_ug2cprj(Wfd,band,ik_ibz,spin,choice,idir,natom,Cryst,cwaveprj,sorted)
2134 
2135 
2136 !This section has been created automatically by the script Abilint (TD).
2137 !Do not modify the following lines by hand.
2138 #undef ABI_FUNC
2139 #define ABI_FUNC 'wfd_ug2cprj'
2140 !End of the abilint section
2141 
2142  implicit none
2143 
2144 !Arguments -------------------------------
2145 !scalars
2146  integer,intent(in) :: choice,idir,natom,band,ik_ibz,spin
2147  logical,optional,intent(in) :: sorted
2148  type(wfd_t),target,intent(inout) :: Wfd
2149  type(crystal_t),intent(in) :: Cryst
2150 !arrays
2151  type(pawcprj_type),intent(inout) :: cwaveprj(natom,Wfd%nspinor)
2152 
2153 !Local variables-------------------------------
2154 !scalars
2155  integer :: cpopt,istwf_k,npw_k,nkpg
2156  integer :: ia,iatm,dimffnl,itypat,iatom,isp
2157  logical :: want_sorted
2158 !arrays
2159  integer,ABI_CONTIGUOUS pointer :: kg_k(:,:)
2160  integer,allocatable :: dimcprj_srt(:)
2161  real(dp) :: kpoint(3)
2162  real(dp),allocatable :: kpg(:,:)
2163  real(dp),ABI_CONTIGUOUS pointer :: phkxred(:,:)
2164  real(dp),allocatable :: cwavef(:,:)
2165  !real(dp),allocatable :: ph1d(2,3*(2*mgfft+1)*natom)
2166  real(dp),ABI_CONTIGUOUS pointer :: ph3d(:,:,:)    ! ph3d(2,npw_k,matblk)
2167  real(dp),ABI_CONTIGUOUS pointer :: ffnl(:,:,:,:)  ! ffnl(npw_k,dimffnl,lmnmax,ntypat)
2168  type(pawcprj_type),allocatable :: Cprj_srt(:,:)
2169 
2170 ! *********************************************************************
2171 
2172  ! different form factors have to be calculated and stored in Kdata.
2173  ABI_CHECK(choice==1,"choice/=1 not coded")
2174 
2175  dimffnl = 1
2176  npw_k   = Wfd%npwarr(ik_ibz)
2177  istwf_k = Wfd%istwfk(ik_ibz)
2178  kpoint  = Wfd%kibz(:,ik_ibz)
2179 
2180  kg_k    => Wfd%Kdata(ik_ibz)%kg_k
2181  ph3d    => Wfd%Kdata(ik_ibz)%ph3d
2182  ffnl    => Wfd%Kdata(ik_ibz)%fnl_dir0der0
2183  phkxred => Wfd%Kdata(ik_ibz)%phkxred
2184 
2185 ! Compute (k+G) vectors
2186  nkpg=0
2187  !% if (choice==3.or.choice==2.or.choice==23) nkpg=3*Wfd%nloalg(3)
2188  !% if (choice==4.or.choice==24) nkpg=9*Wfd%nloalg(3)
2189  ABI_MALLOC(kpg,(npw_k,nkpg))
2190  if (nkpg>0) then
2191    call mkkpg(kg_k,kpg,kpoint,nkpg,npw_k)
2192  end if
2193 
2194  !
2195  ! Copy wavefunction in reciprocal space.
2196  ABI_MALLOC(cwavef,(2,npw_k*Wfd%nspinor))
2197  cwavef(1,:) = DBLE (Wfd%Wave(band,ik_ibz,spin)%ug)
2198  cwavef(2,:) = AIMAG(Wfd%Wave(band,ik_ibz,spin)%ug)
2199 
2200  cpopt   = 0 ! Nothing is already calculated.
2201 
2202  want_sorted=.FALSE.; if (PRESENT(sorted)) want_sorted=sorted
2203 
2204  if (want_sorted) then ! Output cprj are sorted.
2205    call getcprj(choice,cpopt,cwavef,cwaveprj,ffnl,&
2206 &    idir,Wfd%indlmn,istwf_k,kg_k,kpg,kpoint,Wfd%lmnmax,Wfd%mgfft,Wfd%MPI_enreg,&
2207 &    Cryst%natom,Cryst%nattyp,Wfd%ngfft,Wfd%nloalg,npw_k,Wfd%nspinor,Cryst%ntypat,&
2208 &    phkxred,Wfd%ph1d,ph3d,Cryst%ucvol,1)
2209 
2210  else  ! Output cprj are unsorted.
2211 
2212    ABI_MALLOC(dimcprj_srt,(Cryst%natom))
2213    ia=0
2214    do itypat=1,Cryst%ntypat
2215      dimcprj_srt(ia+1:ia+Cryst%nattyp(itypat))=Wfd%nlmn_type(itypat)
2216      ia=ia+Cryst%nattyp(itypat)
2217    end do
2218 
2219    ABI_DT_MALLOC(Cprj_srt,(natom,Wfd%nspinor))
2220    call pawcprj_alloc(Cprj_srt,0,dimcprj_srt)
2221    ABI_FREE(dimcprj_srt)
2222    !
2223    ! Calculate sorted cprj.
2224    call getcprj(choice,cpopt,cwavef,Cprj_srt,ffnl,&
2225 &    idir,Wfd%indlmn,istwf_k,kg_k,kpg,kpoint,Wfd%lmnmax,Wfd%mgfft,Wfd%MPI_enreg,&
2226 &    Cryst%natom,Cryst%nattyp,Wfd%ngfft,Wfd%nloalg,npw_k,Wfd%nspinor,Cryst%ntypat,&
2227 &    phkxred,Wfd%ph1d,ph3d,Cryst%ucvol,1)
2228    !
2229    ! Reorder cprj (sorted --> unsorted)
2230    do iatom=1,Cryst%natom
2231      iatm=Cryst%atindx(iatom)
2232      do isp=1,Wfd%nspinor
2233        cwaveprj(iatom,isp)%cp=Cprj_srt(iatm,isp)%cp
2234      end do
2235    end do
2236 
2237    call pawcprj_free(Cprj_srt)
2238    ABI_DT_FREE(Cprj_srt)
2239  end if
2240 
2241  ABI_FREE(cwavef)
2242  ABI_FREE(kpg)
2243 
2244 end subroutine wfd_ug2cprj

m_wfd/wfd_update_bkstab [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_update_bkstab

FUNCTION

  This routine should be called by all the nodes before any MPI operation involving the object.
  It updates the bks_tab storing information on the distribution of ug.

 INPUT
  [show]=If present and > 0, print tabs to unit show.

SIDE EFFECTS

  Wfd%bks_tab

PARENTS

      m_sigma,m_wfd,wfd_mkrho

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

3973 subroutine wfd_update_bkstab(Wfd,show)
3974 
3975 
3976 !This section has been created automatically by the script Abilint (TD).
3977 !Do not modify the following lines by hand.
3978 #undef ABI_FUNC
3979 #define ABI_FUNC 'wfd_update_bkstab'
3980 !End of the abilint section
3981 
3982  implicit none
3983 
3984 !Arguments ------------------------------------
3985 !scalars
3986  integer,optional,intent(in) :: show
3987  type(wfd_t),intent(inout) :: Wfd
3988 
3989 !Local variables ------------------------------
3990 !scalars
3991  integer :: ierr,nelem
3992  integer,allocatable :: my_vtab(:),gather_vtabs(:)
3993 
3994 !************************************************************************
3995 
3996  ! Fill my slice of the global table.
3997  Wfd%bks_tab(:,:,:,Wfd%my_rank) = Wfd%Wave(:,:,:)%has_ug
3998 
3999  ! Gather flags on each node.
4000  nelem=Wfd%mband*Wfd%nkibz*Wfd%nsppol
4001  ABI_MALLOC(my_vtab,(nelem))
4002  my_vtab(:) = reshape(Wfd%bks_tab(:,:,:,Wfd%my_rank), [nelem])
4003 
4004  ABI_MALLOC(gather_vtabs,(nelem*Wfd%nproc))
4005 
4006  call xmpi_allgather(my_vtab,nelem,gather_vtabs,Wfd%comm,ierr)
4007 
4008  Wfd%bks_tab(:,:,:,:) = reshape(gather_vtabs, [Wfd%mband, Wfd%nkibz, Wfd%nsppol, Wfd%nproc])
4009  ABI_FREE(my_vtab)
4010  ABI_FREE(gather_vtabs)
4011 
4012  if (present(show)) then
4013    if (show>=0) call wfd_show_bkstab(Wfd,unit=show)
4014  end if
4015 
4016 end subroutine wfd_update_bkstab

m_wfd/wfd_wave_free [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_wave_free

FUNCTION

  Collection procedure that frees the set of waves specified by mask.

INPUTS

  mask(Wfd%mband,Wfd%nkibz,Wfd%nsppol)=.TRUE. if the memory allocated for
    this state has to be freed
  [what]=String specifying which array have to be deallocated.
    Possible values (no case-sensitive).
      "All"= To free both ug and ur and PAW Cprj, if any. Default
      "G"  = Only ug
      "R"  = Only ur.
      "C"  = Only PAW Cprj.

SIDE EFFECTS

  Wfd<wfd_t>=See above.

PARENTS

      bethe_salpeter,m_haydock

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

3704 subroutine wfd_wave_free(Wfd,what,bks_mask)
3705 
3706 
3707 !This section has been created automatically by the script Abilint (TD).
3708 !Do not modify the following lines by hand.
3709 #undef ABI_FUNC
3710 #define ABI_FUNC 'wfd_wave_free'
3711 !End of the abilint section
3712 
3713  implicit none
3714 
3715 !Arguments ------------------------------------
3716 !scalars
3717  type(wfd_t),intent(inout) :: Wfd
3718  character(len=*),optional,intent(in) :: what
3719 !arrays
3720  logical,optional,intent(in) :: bks_mask(Wfd%mband,Wfd%nkibz,Wfd%nsppol)
3721 
3722 !Local variables ------------------------------
3723 !scalars
3724  integer :: ik_ibz,spin,band !,ierr
3725  logical :: do_free
3726  character(len=10) :: my_what
3727 !************************************************************************
3728 
3729  my_what="ALL"; if (PRESENT(what)) my_what=toupper(what)
3730 
3731  do spin=1,Wfd%nsppol
3732    do ik_ibz=1,Wfd%nkibz
3733      do band=1,Wfd%nband(ik_ibz,spin)
3734         do_free=.TRUE.; if (PRESENT(bks_mask)) do_free=bks_mask(band,ik_ibz,spin)
3735         if (do_free) then
3736           call wave_free_0D(Wfd%Wave(band,ik_ibz,spin),what=my_what)
3737           if ( firstchar(my_what,(/"A", "G"/) )) then ! Update the associated flags.
3738             Wfd%bks_tab(band,ik_ibz,spin,Wfd%my_rank) = WFD_NOWAVE
3739           end if
3740         end if
3741      end do
3742    end do
3743  end do
3744 
3745  ! Reinit the MPI communicators.
3746  call wfd_set_mpicomm(Wfd)
3747 
3748 end subroutine wfd_wave_free

m_wfd/wfd_who_has_ug [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_who_has_ug

FUNCTION

  Return the number of processors having a particular (b,k,s) state as well as their MPI rank.
  Warning: Wfd%bks_tab is supposed to be up-to-date (see wfd_update_bkstab).

INPUTS

  band=the index of the band.
  ik_ibz=Index of the k-point in the IBZ
  spin=spin index

OUTPUT

  how_many=The number of nodes owing this ug state.
  proc_ranks(1:how_many)=Gives the MPI rank of the nodes owing the state.

PARENTS

      m_wfd

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

3781 subroutine wfd_who_has_ug(Wfd,band,ik_ibz,spin,how_many,proc_ranks)
3782 
3783 
3784 !This section has been created automatically by the script Abilint (TD).
3785 !Do not modify the following lines by hand.
3786 #undef ABI_FUNC
3787 #define ABI_FUNC 'wfd_who_has_ug'
3788 !End of the abilint section
3789 
3790  implicit none
3791 
3792 !Arguments ------------------------------------
3793 !scalars
3794  integer,intent(in) :: band,ik_ibz,spin
3795  integer,intent(out) :: how_many
3796  type(wfd_t),intent(in) :: Wfd
3797 !arrays
3798  integer,intent(out) :: proc_ranks(Wfd%nproc)
3799 
3800 !Local variables ------------------------------
3801 !scalars
3802  integer :: irank
3803  logical :: bks_select,spin_select,kpt_select
3804  character(len=500) :: msg
3805 !arrays
3806 
3807 !************************************************************************
3808 
3809  bks_select  = (band/=0.and.ik_ibz/=0.and.spin/=0)
3810  spin_select = (band==0.and.ik_ibz==0.and.spin/=0)
3811  kpt_select = (band==0.and.ik_ibz/=0.and.spin/=0)
3812 
3813  how_many=0; proc_ranks=-1
3814 
3815  if (bks_select) then
3816    ! List the proc owining this (b,k,s) state.
3817    do irank=0,Wfd%nproc-1
3818      if (Wfd%bks_tab(band,ik_ibz,spin,irank)==WFD_STORED) then
3819        how_many = how_many +1
3820        proc_ranks(how_many)=irank
3821      end if
3822    end do
3823 
3824  else if (spin_select) then
3825    ! List the proc owining at least one state with this spin.
3826    do irank=0,Wfd%nproc-1
3827      if ( ANY(Wfd%bks_tab(:,:,spin,irank)==WFD_STORED) ) then
3828        how_many = how_many +1
3829        proc_ranks(how_many)=irank
3830      end if
3831    end do
3832 
3833  else if (kpt_select) then
3834    ! List the proc owining at least one state with this (k-point, spin).
3835    do irank=0,Wfd%nproc-1
3836      if ( ANY(Wfd%bks_tab(:,ik_ibz,spin,irank)==WFD_STORED) ) then
3837        how_many = how_many +1
3838        proc_ranks(how_many)=irank
3839      end if
3840    end do
3841 
3842  else
3843    write(msg,'(a,3(i0,1x))')" Wrong value for (b,k,s) ",band,ik_ibz,spin
3844    MSG_ERROR(msg)
3845  end if
3846 
3847 end subroutine wfd_who_has_ug

m_wfd/wfd_write_wfk [ Functions ]

[ Top ] [ Functions ]

NAME

 wfd_write_wfk

FUNCTION

  This routine writes the wavefunctions to the specified WFK file
  All the wavefunction are stored on each node, only the spin is distributed.

INPUTS

  Wfd<wfd_t>=Initialized wavefunction descritptor.
  wfk_fname=Name of the WFK file.

OUTPUT

  Only writing

PARENTS

CHILDREN

      nhatgrid,paw_pwaves_lmn_free,paw_pwaves_lmn_init,pawfgrtab_free
      pawfgrtab_init,pawfgrtab_print,pawtab_get_lsize,printxsf
      wfd_change_ngfft,wfd_distribute_bands,wfd_get_ur,wfd_paw_get_aeur
      wrtout

SOURCE

5642 subroutine wfd_write_wfk(Wfd,Hdr,Bands,wfk_fname)
5643 
5644 
5645 !This section has been created automatically by the script Abilint (TD).
5646 !Do not modify the following lines by hand.
5647 #undef ABI_FUNC
5648 #define ABI_FUNC 'wfd_write_wfk'
5649 !End of the abilint section
5650 
5651  implicit none
5652 
5653 !Arguments ------------------------------------
5654 !scalars
5655  character(len=*),intent(in) :: wfk_fname
5656  type(wfd_t),intent(in) :: Wfd
5657  type(Hdr_type),intent(in) :: Hdr
5658  type(ebands_t),intent(in) :: Bands
5659 
5660 !Local variables ------------------------------
5661 !scalars
5662  integer,parameter :: formeig0=0,master=0
5663  integer :: nprocs,my_rank,iomode,cgsize,npw_k,ik_ibz,spin,nband_k,band,ii
5664  integer :: blk,nblocks,how_many,ierr,how_manyb
5665  real(dp) :: cpu,wall,gflops
5666  logical :: iam_master
5667  character(len=500) :: msg
5668  type(wfk_t) :: Wfkfile
5669 !arrays
5670  integer :: band_block(2),proc_ranks(Wfd%nproc),my_band_list(Wfd%mband)
5671  integer,allocatable :: blocks(:,:) !band_list(:),
5672  real(dp),allocatable :: cg_k(:,:)
5673 
5674 !************************************************************************
5675 
5676  DBG_ENTER("COLL")
5677 
5678  nprocs = xmpi_comm_size(Wfd%comm); my_rank = xmpi_comm_rank(Wfd%comm)
5679  iam_master = (my_rank == master)
5680 
5681  ! Select the IO library from the file extension.
5682  iomode = iomode_from_fname(wfk_fname)
5683  write(msg,'(3a,i0)')ABI_FUNC//': writing GS WFK file ',trim(wfk_fname),", with iomode ",iomode
5684  call wrtout(std_out,msg,'PERS')
5685 
5686  if (nprocs > 1 .and. iomode /= IO_MODE_MPI) then
5687    MSG_ERROR("You need MPI-IO to write wavefunctions in parallel")
5688  end if
5689  !
5690  ! Check consistency between Wfd and Header!
5691  ! The ideal approach would be to generate the header from the Wfd but a lot of info are missing
5692  ABI_CHECK(Wfd%nkibz == Hdr%nkpt,"Different number of k-points")
5693  ABI_CHECK(Wfd%nsppol == Hdr%nsppol,"Different number of spins")
5694  ABI_CHECK(Wfd%nspinor == Hdr%nspinor,"Different number of spinors")
5695 
5696  if (any(Wfd%nband /= reshape(Hdr%nband, [Wfd%nkibz, Wfd%nsppol]))) then
5697    MSG_ERROR("Wfd%nband /= Hdr%nband")
5698  end if
5699 
5700  ! Use bks_tab to decide who will write the data. Remember
5701  ! integer,allocatable :: bks_tab(:,:,:,:)
5702  ! Wfd%bks_tab(mband,nkibz,nsppol,0:nproc-1)
5703  ! Global table used to keep trace of the distribution of the (b,k,s) states on each node inside Wfd%comm.
5704  ! 1 if the node has this state. 0 otherwise.
5705  ! A node owns a wavefunction if the corresponding ug is allocated AND computed.
5706  ! If a node owns ur but not ug, or ug is just allocated then its entry in the table is zero.
5707  ! The main difficulties here are:
5708  !
5709  ! 1) FFT parallelism (not coded, indeed)
5710  ! 2) Wavefunctions that are replicated, i.e. the same (b,k,s) is treated by more than one node.
5711 
5712  ierr = 0
5713  do spin=1,Wfd%nsppol
5714    do ik_ibz=1,Wfd%nkibz
5715      do band=1,Wfd%nband(ik_ibz,spin)
5716        call wfd_who_has_ug(Wfd,band,ik_ibz,spin,how_many,proc_ranks)
5717        if (how_many /= 1) then
5718          ierr = ierr + 1
5719          write(msg,'(a,3(i0,1x))')" Found replicated state (b,k,s) ",band,ik_ibz,spin
5720          MSG_WARNING(msg)
5721        end if
5722      end do
5723    end do
5724  end do
5725 
5726  if (ierr /= 0) then
5727    MSG_ERROR("Cannot write WFK file when wavefunctions are replicated")
5728  end if
5729 
5730  call cwtime(cpu,wall,gflops,"start")
5731 
5732  ! Master node opens the file and writes the Abinit header.
5733  if (iam_master) then
5734    call wfk_open_write(WfkFile,Hdr,wfk_fname,formeig0,iomode,get_unit(),xmpi_comm_self,write_hdr=.TRUE.,write_frm=.FALSE.)
5735  end if
5736 
5737  ! Other nodes wait here before opening the same file.
5738  call xmpi_barrier(Wfd%comm)
5739  if (.not.iam_master) then
5740    call wfk_open_write(WfkFile,Hdr,wfk_fname,formeig0,iomode,get_unit(),xmpi_comm_self,write_hdr=.FALSE.,write_frm=.FALSE.)
5741  end if
5742 
5743  do spin=1,Wfd%nsppol
5744    do ik_ibz=1,Wfd%nkibz
5745      if (.not. wfd_ihave_ug(Wfd,band,ik_ibz,spin,"Stored")) cycle
5746      nband_k = Wfd%nband(ik_ibz,spin)
5747      npw_k   = Wfd%npwarr(ik_ibz)
5748 
5749      ! Compute my block of bands for this k-point and spin.
5750      call wfd_mybands(Wfd,ik_ibz,spin,how_manyb,my_band_list,how="Stored")
5751      call list2blocks(my_band_list(1:how_manyb), nblocks, blocks)
5752 
5753      !if (proc_distrb_cycle(mpi_enreg%proc_distrb,ik_ibz,1,nband_k,spin,my_rank)) CYCLE
5754      !call mask2blocks(mpi_enreg%proc_distrb(ik_ibz,:,spin)==my_rank, nblocks,blocks)
5755 
5756      ABI_CHECK(nblocks==1,"nblocks !=1")
5757      write(msg,"(a,3(i0,2x))")"Will write (ik_ibz, spin, nblocks)",ik_ibz,spin,nblocks
5758      call wrtout(std_out,msg,"PERS")
5759 
5760      ! Extract the block of wavefunctions from Wfd.
5761      ! Try to allocate all u(g) first,
5762      ! TODO If not enough memory fallback to a blocked algorithm.
5763      cgsize = Wfd%nspinor * npw_k * how_manyb
5764      ABI_STAT_MALLOC(cg_k, (2,cgsize), ierr)
5765      ABI_CHECK(ierr==0, "out of memory in cg_k")
5766 
5767      ! Extract the set of u(g) for this (kpoint,spin)
5768      ! This works only if all the bands are on the same node.
5769      !band_block = [1, nband_k]
5770      !call wfd_extract_cgblock(Wfd,[(ii, ii=1,nband_k)],ik_ibz,spin,cg_k)
5771 
5772      do blk=1,nblocks
5773        band_block = blocks(:,blk)
5774        call wfd_extract_cgblock(Wfd,[(ii, ii=band_block(1),band_block(2))],ik_ibz,spin,cg_k)
5775 
5776        if (band_block(1)==1) then
5777          ! Write also kg_k, eig_k and occ_k
5778          call wfk_write_band_block(WfkFile,band_block,ik_ibz,spin,xmpio_single,&
5779 &          kg_k=Wfd%Kdata(ik_ibz)%kg_k,cg_k=cg_k,&
5780 &          eig_k=Bands%eig(:,ik_ibz,spin),occ_k=Bands%occ(:,ik_ibz,spin))
5781        else
5782          MSG_ERROR("This should not happen in the present version!")
5783          !call wfk_write_band_block(WfkFile,band_block,ik_ibz,spin,xmpio_single,cg_k=cg_k(:,1+icg:))
5784        end if
5785      end do
5786 
5787      ABI_FREE(cg_k)
5788      ABI_FREE(blocks)
5789    end do
5790  end do
5791 
5792  ! Close the file.
5793  call wfk_close(Wfkfile)
5794 
5795  call cwtime(cpu,wall,gflops,"stop")
5796  write(msg,'(2(a,f8.2))')" write all cg cpu: ",cpu,", wall: ",wall
5797  call wrtout(std_out,msg,"PERS")
5798 
5799  DBG_EXIT("COLL")
5800 
5801 end subroutine wfd_write_wfk

m_wfd/wfd_xdotc [ Functions ]

[ Top ] [ Functions ]

NAME

  wfd_xdotc

FUNCTION

   Compute <u_{b1ks}|u_{b2ks}> in reciprocal space

INPUTS

  Wfd<wfd_t>=the wavefunction descriptor.
  Cryst<crystal_t>=Structure describing the crystal structure and its symmetries.
  Pawtab(ntypat*usepaw)<type(pawtab_type)>=PAW tabulated starting data.
  band1, band2=Band indices.
  ik_bz=Index of the k-point in the BZ.
  spin=Spin index

PARENTS

SOURCE

1487 function wfd_xdotc(Wfd,Cryst,Pawtab,band1,band2,ik_ibz,spin)
1488 
1489 
1490 !This section has been created automatically by the script Abilint (TD).
1491 !Do not modify the following lines by hand.
1492 #undef ABI_FUNC
1493 #define ABI_FUNC 'wfd_xdotc'
1494 !End of the abilint section
1495 
1496  implicit none
1497 
1498 !Arguments ------------------------------------
1499 !scalars
1500  integer,intent(in) :: band1,band2,ik_ibz,spin
1501  complex(gwpc) :: wfd_xdotc
1502  type(wfd_t),target,intent(inout) :: Wfd
1503  type(crystal_t),intent(in) :: Cryst
1504 !arrays
1505  type(Pawtab_type),intent(in) :: Pawtab(Cryst%ntypat*Wfd%usepaw)
1506 
1507 !Local variables ------------------------------
1508 !scalars
1509  integer :: npw_k,istwf_k
1510 !arrays
1511  real(dp) :: pawovlp(2)
1512  complex(gwpc),ABI_CONTIGUOUS pointer :: ug1(:),ug2(:)
1513  type(pawcprj_type),allocatable :: Cp1(:,:),Cp2(:,:)
1514 
1515 !************************************************************************
1516 
1517  ! Planewave part.
1518  npw_k   = Wfd%npwarr(ik_ibz)
1519  istwf_k = Wfd%istwfk(ik_ibz)
1520 
1521  ug1 => Wfd%Wave(band1,ik_ibz,spin)%ug
1522  ug2 => Wfd%Wave(band2,ik_ibz,spin)%ug
1523 
1524  wfd_xdotc = xdotc(npw_k*Wfd%nspinor,ug1,1,ug2,1)
1525  if (istwf_k>1) then
1526    wfd_xdotc=two*DBLE(wfd_xdotc)
1527    if (istwf_k==2) wfd_xdotc = wfd_xdotc-CONJG(ug1(1))*ug2(1)
1528  end if
1529 
1530  ! Paw on-site term.
1531  if (Wfd%usepaw==1) then
1532    ! Avoid the computation if Cprj are already in memory with the correct order.
1533    if (wfd_ihave_cprj(Wfd,band1,ik_ibz,spin,how="Stored") .and. &
1534 &      wfd_ihave_cprj(Wfd,band2,ik_ibz,spin,how="Stored") .and. &
1535 &      Wfd%Wave(band1,ik_ibz,spin)%cprj_order == CPR_RANDOM .and. &
1536 &      Wfd%Wave(band2,ik_ibz,spin)%cprj_order == CPR_RANDOM) then
1537 
1538        pawovlp = paw_overlap(Wfd%Wave(band1,ik_ibz,spin)%Cprj,&
1539 &                            Wfd%Wave(band2,ik_ibz,spin)%Cprj,&
1540 &                            Cryst%typat,Pawtab,spinor_comm=Wfd%MPI_enreg%comm_spinor)
1541        wfd_xdotc = wfd_xdotc + CMPLX(pawovlp(1),pawovlp(2))
1542 
1543    else
1544      ! Compute Cprj
1545      ABI_DT_MALLOC(Cp1,(Wfd%natom,Wfd%nspinor))
1546      call pawcprj_alloc(Cp1,0,Wfd%nlmn_atm)
1547      ABI_DT_MALLOC(Cp2,(Wfd%natom,Wfd%nspinor))
1548      call pawcprj_alloc(Cp2,0,Wfd%nlmn_atm)
1549 
1550      call wfd_get_cprj(Wfd,band1,ik_ibz,spin,Cryst,Cp1,sorted=.FALSE.)
1551      call wfd_get_cprj(Wfd,band2,ik_ibz,spin,Cryst,Cp2,sorted=.FALSE.)
1552 
1553      pawovlp = paw_overlap(Cp1,Cp2,Cryst%typat,Pawtab,spinor_comm=Wfd%MPI_enreg%comm_spinor)
1554      wfd_xdotc = wfd_xdotc + CMPLX(pawovlp(1),pawovlp(2))
1555 
1556      call pawcprj_free(Cp1)
1557      ABI_DT_FREE(Cp1)
1558      call pawcprj_free(Cp2)
1559      ABI_DT_FREE(Cp2)
1560    end if
1561  end if
1562 
1563 end function wfd_xdotc