! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       PROGRAM  ASCOT 2014.440 (ver.4.40)                       @@ !
! @@     "Abinitio Simulation Code for Quantum Transport"           @@ !
! @@                                                                @@ !
! @@                                                                @@ !
! @@  AUTHOR(S): Naoki WATANABE, Nobutaka NISHIKAWA (Mizuho I.R.)   @@ !
! @@             Hisashi KONDO (Univ. Tokyo)                        @@ !
! @@                                                09/May/2014     @@ !
! @@                                                                @@ !
! @@  Contact address: Phase System Consortium                      @@ !
! @@                                                                @@ !
! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !

subroutine PAO__set(pao,Ro,m,RF,range)
  use ac_misc_module

  implicit none
  type(PAO_type), intent(inout)   :: pao
  real(8), intent(in) :: Ro(3)
  integer, intent(in)        :: m
  type(RadialFunc_type), target, intent(in) :: RF
  integer, intent(in) :: range(6)

  pao%Ro =  Ro
  pao%m  =  m
  pao%l  =  RF%l
  pao%Rc =  RF%Rc
  pao%RF => RF

  call PAO__setW(pao, range)

  return
end subroutine PAO__set

subroutine PAO__W( wave, pao, Rg )
  use ac_misc_module

  implicit none
  type(PAO_type), intent(in)    :: pao
  real(8), intent(in) :: Rg(3)
  real(8), intent(out)  :: wave

  real(8) :: R(3)
  real(8) :: dR
  real(8) :: fRrl

  R  = Rg-pao%Ro
  dR = sqrt(dot_product(R,R))

  if( dR > pao%Rc ) then
     wave = 0.d0
  else if( dR < 1.d-14 .and. pao%l > 0 ) then
     wave = 0.d0
  else if( dR < 1.d-14 .and. pao%l == 0 ) then
     fRrl = Spline__evaluate(pao%RF%fR,dR)
     wave = fRrl * SphericalHarmonic__rlY(pao%l,pao%m,R)
  else
     fRrl = Spline__evaluate(pao%RF%fR,dR) /(dR**pao%l)
     wave = fRrl * SphericalHarmonic__rlY(pao%l,pao%m,R)
  end if

  return
end subroutine PAO__W

subroutine PAO__gW( gwave, pao, Rg )
  use ac_misc_module

  implicit none
  type(PAO_type), intent(in)    :: pao
  real(8), intent(in) :: Rg(3)
  real(8), intent(out) :: gwave(3)

  real(8) :: R(3)
  real(8) :: dR
  real(8) :: fRrl, dfRrl

  R  = Rg-pao%Ro
  dR = sqrt(dot_product(R,R))

  if( dR > pao%Rc ) then
     gwave = 0.d0
  else if( dR < 1.d-14 ) then
     gwave = 0.d0
  else
     fRrl = Spline__evaluate(pao%RF%fR,dR)/(dR**pao%l)
     dfRrl = Spline__derivative(pao%RF%fR,dR)/(dR**pao%l) - pao%l * fRrl/dR

     gwave = dfRrl * SphericalHarmonic__rlY(pao%l,pao%m,R) / dR * R &
          + fRrl * SphericalHarmonic__drlY(pao%l,pao%m,R)
  end if

  return
end subroutine PAO__gW

subroutine PAO__setW( pao, range )
  use ac_misc_module

  implicit none
  type(PAO_type), intent(out) :: pao
  integer, intent(in) :: range(6)

  integer :: ia, ib, ic
  real(8) :: R(3)

  pao%range = range
  if( pao%range(1) > pao%range(2) ) return
  if( pao%range(3) > pao%range(4) ) return
  if( pao%range(5) > pao%range(6) ) return

  allocate(pao%wave(pao%range(1):pao%range(2), &
       pao%range(3):pao%range(4),pao%range(5):pao%range(6)))

  do ic = pao%range(5), pao%range(6)
     do ib = pao%range(3), pao%range(4)
        do ia = pao%range(1), pao%range(2)
           call Param__Cell__R(R,ia,ib,ic)
           call PAO__W( pao%wave(ia,ib,ic), pao, R )
        end do
     end do
  end do

  allocate(pao%gwave(3,pao%range(1):pao%range(2), &
       pao%range(3):pao%range(4),pao%range(5):pao%range(6)))

  do ic = pao%range(5), pao%range(6)
     do ib = pao%range(3), pao%range(4)
        do ia = pao%range(1), pao%range(2)
           call Param__Cell__R(R,ia,ib,ic)
           call PAO__gW( pao%gwave(:,ia,ib,ic), pao, R )
        end do
     end do
  end do

  return
end subroutine PAO__setW

subroutine PAO__calcWaveV(pao,spin)
  use ac_misc_module

  implicit none
  type(PAO_type), intent(out) :: pao
  integer, intent(in) :: spin

  integer :: ia, ib, ic
  integer :: ia0, ib0, ic0

  allocate(pao%waveV(pao%range(1):pao%range(2), &
       pao%range(3):pao%range(4), pao%range(5):pao%range(6)))

  do ic = pao%range(5), pao%range(6)
     ic0 = modp(ic,Param%Cell%Nc)
     do ib = pao%range(3), pao%range(4)
        ib0 = modp(ib,Param%Cell%Nb)
        do ia = pao%range(1), pao%range(2)
           ia0 = modp(ia,Param%Cell%Na)

           pao%waveV(ia,ib,ic) = pao%wave(ia,ib,ic) * Potential%Vtot(spin,ia0,ib0,ic0)
        end do
     end do
  end do

  return
end subroutine PAO__calcWaveV

subroutine PAO__freeWaveV(pao)
  use ac_misc_module

  implicit none
  type(PAO_type), intent(inout) :: pao

  if( associated(pao%waveV) ) deallocate(pao%waveV)

  return
end subroutine PAO__freeWaveV

subroutine PAO__calcgWaveV(pao,spin)
  use ac_misc_module

  implicit none
  type(PAO_type), intent(out) :: pao
  integer, intent(in) :: spin

  integer :: ia, ib, ic
  integer :: ia0, ib0, ic0

  allocate(pao%gwaveV(3,pao%range(1):pao%range(2), &
       pao%range(3):pao%range(4), pao%range(5):pao%range(6)))

  do ic = pao%range(5), pao%range(6)
     ic0 = modp(ic,Param%Cell%Nc)
     do ib = pao%range(3), pao%range(4)
        ib0 = modp(ib,Param%Cell%Nb)
        do ia = pao%range(1), pao%range(2)
           ia0 = modp(ia,Param%Cell%Na)

           pao%gwaveV(:,ia,ib,ic) = pao%gwave(:,ia,ib,ic) * Potential%Vtot(spin,ia0,ib0,ic0)
        end do
     end do
  end do

  return
end subroutine PAO__calcgWaveV

subroutine PAO__freegWaveV(pao)
  use ac_misc_module

  implicit none
  type(PAO_type), intent(inout) :: pao

  if( associated(pao%gwaveV) ) deallocate(pao%gwaveV)

  return
end subroutine PAO__freegWaveV

subroutine PAO__deallocate(pao)
  use ac_misc_module

  implicit none
  type(PAO_type), intent(inout) :: pao

  if( associated(pao%wave) ) deallocate(pao%wave)
  if( associated(pao%gwave) ) deallocate(pao%gwave)

  return
end subroutine PAO__deallocate

subroutine Base__bracketSK(S,K,pao1,pao2,L)
  use ac_misc_module

  implicit none
  real(8) :: S,K
  type(PAO_type), intent(in) :: pao1,pao2
  real(8), intent(in) :: L(3)

  real(8) :: R(3)
  real(8) :: dR
  integer :: l0,m0
  real(8) :: g,gy,y
  real(8) :: intS,intK

  S = 0.d0
  K = 0.d0

  R  = pao2%Ro + L - pao1%Ro
  dR = sqrt(dot_product(R,R))

  if( dR > pao1%Rc + pao2%Rc ) then
     return
  end if

  do l0=0, min( 2*max( pao1%l, pao2%l ), 6 )
     gy=0.d0
     do m0=-l0, +l0
        g = SphericalHarmonic__Gaunt( pao1%l, pao1%m, pao2%l, pao2%m, l0, m0 )
        if( g == 0.d0 ) cycle
        y = SphericalHarmonic__rlY( l0, m0, R )
        gy = gy + g*y
     end do
     if( gy == 0.d0 ) cycle

     call SphericalBessel__integrateSK( intS, intK, pao1%RF%vK, pao2%RF%vK, l0, dR )
     S = S + gy * intS
     K = K + gy * intK
  end do

  return
end subroutine Base__bracketSK

subroutine Base__bracketdSK( dS, dK, pao1, pao2, L )
  use ac_misc_module

  implicit none
  real(8), intent(out) :: dS(3), dK(3)
  type(PAO_type), intent(in)      :: pao1, pao2
  real(8), intent(in) :: L(3)

  real(8) :: R(3)
  real(8)        :: dR
  integer        :: l0, m0
  real(8)        :: g, gy, y
  real(8) :: dgy(3), dy(3)
  real(8)        :: intS, intK
  real(8)        :: intdS, intdK

  dS = 0.d0
  dK = 0.d0

  R  = pao2%Ro + L - pao1%Ro
  dR = sqrt(dot_product(R,R))

  if( dR > pao1%Rc + pao2%Rc ) then
     return
  end if

  do l0=0, min( 2*max( pao1%l, pao2%l ), 6 )
     gy=0.d0
     dgy=0.d0
     do m0=-l0, +l0
        g = SphericalHarmonic__Gaunt( pao1%l, pao1%m, pao2%l, pao2%m, l0, m0 )
        if( g == 0.d0 ) cycle
        y = SphericalHarmonic__rlY( l0, m0, R )
        dy = SphericalHarmonic__drlY( l0, m0, R )

        gy = gy + g*y
        dgy = dgy + g*dy
     end do
     if( .not. gy == 0.d0 ) then
        call SphericalBessel__integratedSK( intdS, intdK, pao1%RF%vK, pao2%RF%vK, l0, dR )
        dS = dS + gy * intdS * R
        dK = dK + gy * intdK * R
     end if
     if( .not. dot_product(dgy,dgy) == 0.0d0 ) then
        call SphericalBessel__integrateSK( intS, intK, pao1%RF%vK, pao2%RF%vK, l0, dR )
        dS = dS + dgy * intS
        dK = dK + dgy * intK
     end if
  end do

  return
end subroutine Base__bracketdSK

subroutine Base__bracketV( V, a, b, l )
  use ac_misc_module
  use ac_mpi_module

  implicit none
  integer, intent(in) :: a, b, l
  real(8), intent(out) :: V(Base%vnpao(b),Base%vnpao(a))
  real(8), pointer :: vpaoVat(:), vpaoat(:)

  integer :: na, nb, nc
  integer :: i, i1
  integer :: j, j1
  integer :: range(6)
  integer :: ia, ib, ic
  integer :: ja, jb, jc
  real(8) :: wiV, wj

  na = Param%Cell%vLna(l)
  nb = Param%Cell%vLnb(l)
  nc = Param%Cell%vLnc(l)

  i=Base%vipao(a)
  j=Base%vipao(b)

  do i1=MPI%ispao(a), MPI%iepao(a)
     do j1=1, Base%vnpao(b)
        V(j1,i1) = 0.d0
     end do
  end do

  if( .not. Param__Cell__mergeRange2( range, &
       Base%vpao(i)%Ro, Base%vpao(i)%Rc, &
       Base%vpao(j)%Ro, l, &
       Base%vpao(j)%Rc ) ) then
     return
  end if

  allocate( vpaoVat(Base%vnpao(a)) )
  allocate( vpaoat (Base%vnpao(b)) )

  do ic = range(5), range(6)
     jc = ic-nc

     do ib = range(3), range(4)
        jb = ib-nb

        do ia = range(1), range(2)
           ja = ia-na

           do i1=MPI%ispao(a), MPI%iepao(a)
              vpaoVat(i1) = Base%vpao(i+i1-1)%waveV(ia,ib,ic)
           end do

           do j1=1, Base%vnpao(b)
              vpaoat(j1) = Base%vpao(j+j1-1)%wave(ja,jb,jc)
           end do

           do i1=MPI%ispao(a), MPI%iepao(a)
              wiV = vpaoVat(i1)
              if( wiV == 0.d0 ) cycle

              do j1=1, Base%vnpao(b)
                 wj = vpaoat(j1)
                 if( wj == 0.d0 ) cycle

                 V(j1,i1) = V(j1,i1) + wiV*wj
              end do
           end do

        end do
     end do
  end do

  do i1=MPI%ispao(a), MPI%iepao(a)
     do j1=1, Base%vnpao(b)
        V(j1,i1) = V(j1,i1) * Param%Cell%dV
     end do
  end do

  if( associated(vpaoat) )  deallocate(vpaoat)
  if( associated(vpaoVat) ) deallocate(vpaoVat)

  return 
end subroutine Base__bracketV

subroutine Base__bracketdV( dV, a, b, l )
  use ac_misc_module
  use ac_mpi_module

  implicit none
  integer, intent(in) :: a, b, l
  real(8), intent(out) :: dV(3,Base%vnpao(b),Base%vnpao(a))
  real(8), pointer :: vgpaoVat(:,:)
  real(8), pointer :: vpaoat(:)

  integer :: na, nb, nc
  integer :: i, i1
  integer :: j, j1
  integer :: range(6)
  integer :: ia, ib, ic
  integer :: ja, jb, jc

  real(8) :: wj
  real(8) :: gwiV(3)

  na = Param%Cell%vLna(l)
  nb = Param%Cell%vLnb(l)
  nc = Param%Cell%vLnc(l)

  i=Base%vipao(a)
  j=Base%vipao(b)

  do i1=MPI%ispao(a), MPI%iepao(a)
     do j1=1, Base%vnpao(b)
        dV(:,j1,i1) = 0.d0
     end do
  end do

  if( .not. Param__Cell__mergeRange2( range, &
       Base%vpao(i+MPI%ispao(a)-1)%Ro, Base%vpao(i+MPI%ispao(a)-1)%Rc, &
       Base%vpao(j)%Ro, l, &
       Base%vpao(j)%Rc ) ) then
     return
  end if

  allocate( vgpaoVat(3,Base%vnpao(a)) )
  allocate( vpaoat  (Base%vnpao(b)) )


  do ic = range(5), range(6)
     jc = ic-nc
     do ib = range(3), range(4)
        jb = ib-nb
        do ia = range(1), range(2)
           ja = ia-na

           do i1=MPI%ispao(a), MPI%iepao(a)
              vgpaoVat(:,i1) = Base%vpao(i+i1-1)%gwaveV(:,ia,ib,ic)
           end do

           do j1=1, Base%vnpao(b)
              vpaoat(j1) = Base%vpao(j+j1-1)%wave(ja,jb,jc)
           end do

           do i1=MPI%ispao(a), MPI%iepao(a)
              gwiV(:) = vgpaoVat(:,i1)
              if( dot_product( gwiV,gwiV ) == 0.0d0 ) cycle

              do j1=1, Base%vnpao(b)
                 wj = vpaoat(j1)
                 if( wj == 0.d0 ) cycle

                 dV(:,j1,i1) = dV(:,j1,i1) + gwiV(:)*wj
              end do
           end do
        end do
     end do
  end do

  do i1=MPI%ispao(a), MPI%iepao(a)
     do j1=1, Base%vnpao(b)
        dV(:,j1,i1) = dV(:,j1,i1) * Param%Cell%dV
     end do
  end do

  if( associated(vgpaoVat) ) deallocate(vgpaoVat)
  if( associated(vpaoat)   ) deallocate(vpaoat)

  return 
end subroutine Base__bracketdV

subroutine Base__bracketVd( dV, a, b, l )
  use ac_misc_module
  use ac_mpi_module

  implicit none
  integer, intent(in) :: a, b, l
  real(8), intent(out) :: dV(3,Base%vnpao(b),Base%vnpao(a))
  real(8), pointer :: vpaoVat(:)
  real(8), pointer :: vgpaoat(:,:)

  integer :: na, nb, nc
  integer :: i, i1
  integer :: j, j1
  integer :: range(6)
  integer :: ia, ib, ic
  integer :: ja, jb, jc

  real(8) :: wiV
  real(8) :: gwj(3)

  na = Param%Cell%vLna(l)
  nb = Param%Cell%vLnb(l)
  nc = Param%Cell%vLnc(l)

  i=Base%vipao(a)
  j=Base%vipao(b)

  do i1=MPI%ispao(a), MPI%iepao(a)
     do j1=1, Base%vnpao(b)
        dV(:,j1,i1) = 0.d0
     end do
  end do

  if( .not. Param__Cell__mergeRange2( range, &
       Base%vpao(i+MPI%ispao(a)-1)%Ro, Base%vpao(i+MPI%ispao(a)-1)%Rc, &
       Base%vpao(j)%Ro, l, &
       Base%vpao(j)%Rc ) ) then
     return
  end if

  allocate( vpaoVat(Base%vnpao(a)) )
  allocate( vgpaoat(3,Base%vnpao(b)) )


  do ic = range(5), range(6)
     jc = ic-nc
     do ib = range(3), range(4)
        jb = ib-nb
        do ia = range(1), range(2)
           ja = ia-na

           do i1=MPI%ispao(a), MPI%iepao(a)
              vpaoVat(i1) = Base%vpao(i+i1-1)%waveV(ia,ib,ic)
           end do

           do j1=1, Base%vnpao(b)
              vgpaoat(:,j1) = Base%vpao(j+j1-1)%gwave(:,ja,jb,jc)
           end do

           do i1=MPI%ispao(a), MPI%iepao(a)
              wiV = vpaoVat(i1)
              if( wiV == 0.d0 ) cycle

              do j1=1, Base%vnpao(b)
                 gwj(:) = vgpaoat(:,j1)
                 if( dot_product( gwj,gwj ) == 0.0d0 ) cycle

                 dV(:,j1,i1) = dV(:,j1,i1) + wiV*gwj(:)
              end do
           end do
        end do
     end do
  end do

  do i1=MPI%ispao(a), MPI%iepao(a)
     do j1=1, Base%vnpao(b)
        dV(:,j1,i1) = dV(:,j1,i1) * Param%Cell%dV
     end do
  end do

  if( associated(vpaoVat) ) deallocate(vpaoVat)
  if( associated(vgpaoat) ) deallocate(vgpaoat)

  return 
end subroutine Base__bracketVd

subroutine Base__setup
  use ac_misc_module
  use ac_mpi_module

  implicit none
  integer :: a, b, l
  integer :: i, j, n, m
  logical :: overlap, allocgrid
  integer rangeAND(6), rangeOR(6)

  type(Element_type), pointer :: elem

  call Base__deallocate

  Base%npao=0
  allocate( Base%vnpao(Param%Data%natom) )
  allocate( Base%vipao(Param%Data%natom) )

  Base%vipao(:) = Param%Data%vipao(:)
  Base%vnpao(:) = Param%Data%vnpao(:)
  Base%npao     = Param%Data%npao

  allocate( Base%vpao(Param%Data%npao) )

  do a=1, Param%Data%natom
     if( MPI%isatom<=a .and. a<=MPI%ieatom ) then
        call Param__Cell__getRange( rangeOR, & 
                   Param%Data%vatom(a)%Ro, &
                   Param%Data%vatom(a)%Rc )
        allocgrid = .true.
     else
        overlap = .false.

        rangeOR(1) = +10000
        rangeOR(2) = -10000
        rangeOR(3) = +10000
        rangeOR(4) = -10000
        rangeOR(5) = +10000
        rangeOR(6) = -10000

        do b=MPI%isatom, MPI%ieatom
           do l=0, Param%Cell%nL-1
              if( Param__Cell__mergeRange2( &
                   rangeAND, &
                   Param%Data%vatom(a)%Ro, &
                   Param%Data%vatom(a)%Rc, &
                   Param%Data%vatom(b)%Ro, -l, &
                   Param%Data%vatom(b)%Rc ) ) then
                 call Param__Cell__mergeRange3( rangeOR, rangeOR, rangeAND )
                 overlap = .true.
              end if
           end do
        end do

        if( overlap ) then
           allocgrid = .true.
        else
           allocgrid = .false.
        end if
     end if

     elem => Param__Data__getElement( Param%Data%vatom(a)%name )

     i = Param%Data%vipao(a)
     do n=1, elem%npao
        do m=-elem%vpao(n)%l, +elem%vpao(n)%l
           call PAO__set( Base%vpao(i), Param%Data%vatom(a)%Ro, m, elem%vpao(n), rangeOR )
           i = i + 1
        end do
     end do
  end do

  return
end subroutine Base__setup


subroutine Base__calcWave( waver, wavei, c, k, n_npao )
  use ac_misc_module
  use ac_mpi_module

  implicit none
  integer, intent(in) :: n_npao
  real(8), intent(out) :: waver(Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)
  real(8), intent(out) :: wavei(Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)
  complex(8), intent(in) :: c(n_npao)
  real(8), intent(in) :: k(3)

  integer :: i, l
  integer :: na, nb, nc
  integer :: ia, ib, ic
  integer range(6), range0(6), rangei(6)
  complex(8) :: cc

  complex(8), allocatable :: temp_s(:,:,:),temp_r(:,:,:)

  real(8) :: rnorm,pnorm
  integer :: i_max
  integer :: i_mpi

  allocate( temp_s(n_npao,1,1) )
  allocate( temp_r(n_npao,1,1) )

  do i=1, n_npao
    temp_s(i,1,1)=c(i)
    temp_r(i,1,1)=dcmplx(0.d0,0.d0)
  end do
  i_mpi=n_npao

  call MPI_ALLREDUCE(temp_s,temp_r,i_mpi,MPI_DOUBLE_COMPLEX,MPI_SUM,MPI_COMM_WORLD,MPI%info)

  rnorm=0.d0
  do i=1, n_npao
    pnorm=dreal(temp_r(i,1,1))**2+dimag(temp_r(i,1,1))**2
    if( rnorm < pnorm ) then
      rnorm=pnorm
      i_max=i
    end if
  end do
  pnorm=datan2(dimag(temp_r(i_max,1,1)),dreal(temp_r(i_max,1,1)))

  waver = 0.d0
  wavei = 0.d0

  do i=MPI%smat,MPI%emat
     do l=1-Param%Cell%nL, Param%Cell%nL-1

        na = Param%Cell%vLna(l)
        nb = Param%Cell%vLnb(l)
        nc = Param%Cell%vLnc(l)

        range0(1) = 1; range0(2) = Param%Cell%Na
        range0(3) = 1; range0(4) = Param%Cell%Nb
        range0(5) = 1; range0(6) = Param%Cell%Nc

        call Param__Cell__getRange( rangei, &
             Base%vpao(i)%Ro+Param%Cell%vL(:,l), Base%vpao(i)%Rc )

        if( .not. Param__Cell__mergeRange1( range, range0, rangei ) ) cycle

        cc = temp_r(i,1,1) * polar( dot_product(k(:),Param%Cell%vL(:,l)) ) * dcmplx(dcos(pnorm),-dsin(pnorm))

        do ic=range(5), range(6)
           do ib=range(3), range(4)
              do ia=range(1), range(2)
                 waver(ia,ib,ic) = waver(ia,ib,ic) &
                      + Base%vpao(i)%wave(ia-na,ib-nb,ic-nc) * dreal(cc)
                 wavei(ia,ib,ic) = wavei(ia,ib,ic) &
                      + Base%vpao(i)%wave(ia-na,ib-nb,ic-nc) * dimag(cc)
              end do
           end do
        end do
     end do
  end do

  deallocate( temp_s,temp_r )
  allocate( temp_s(Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc) )
  allocate( temp_r(Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc) )
  do ic=1,Param%Cell%Nc
    do ib=1,Param%Cell%Nb
      do ia=1,Param%Cell%Na
        temp_s(ia,ib,ic)=dcmplx(waver(ia,ib,ic),wavei(ia,ib,ic))
        temp_r(ia,ib,ic)=dcmplx(0.d0,0.d0)
      end do
    end do
  end do
  i_mpi=Param%Cell%Na*Param%Cell%Nb*Param%Cell%Nc

  call MPI_ALLREDUCE(temp_s,temp_r,i_mpi,MPI_DOUBLE_COMPLEX,MPI_SUM,MPI_COMM_WORLD,MPI%info)

  do ic=1,Param%Cell%Nc
    do ib=1,Param%Cell%Nb
      do ia=1,Param%Cell%Na
        waver(ia,ib,ic)=dreal(temp_r(ia,ib,ic))
        wavei(ia,ib,ic)=dimag(temp_r(ia,ib,ic))
      end do
    end do
  end do
  deallocate( temp_s,temp_r )

  rnorm=0.d0
  do ic=1, Param%Cell%Nc
    do ib=1, Param%Cell%Nb
      do ia=1, Param%Cell%Na
        rnorm=rnorm+waver(ia,ib,ic)**2+wavei(ia,ib,ic)**2
      end do
    end do
  end do
  rnorm=1.d0/dsqrt(rnorm*Param%Cell%dV)
  do ic=1, Param%Cell%Nc
    do ib=1, Param%Cell%Nb
      do ia=1, Param%Cell%Na
        waver(ia,ib,ic)=waver(ia,ib,ic)*rnorm
        wavei(ia,ib,ic)=wavei(ia,ib,ic)*rnorm
      end do
    end do
  end do

  return
end subroutine Base__calcWave

subroutine Base__deallocate
  use ac_misc_module
  use ac_mpi_module

  implicit none
!!  integer :: i
  integer :: a, i, i1

  if( associated(Base%vpao)  ) then
!!     do i=1, Base%npao
!!        call PAO__deallocate( Base%vpao(i) )
!!     end do
     do a=1, Param%Data%natom
        if( a<MPI%isatom .or. MPI%ieatom<a ) cycle

        i=Base%vipao(a)
        do i1=MPI%ispao(a), MPI%iepao(a)
           call PAO__deallocate( Base%vpao(i+i1-1) )
        end do
     end do
     deallocate( Base%vpao )
  end if
  if( associated(Base%vipao) ) deallocate( Base%vipao )
  if( associated(Base%vnpao) ) deallocate( Base%vnpao )

  call SphericalHarmonic__deallocate

  return
end subroutine Base__deallocate
