! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       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 AtomMatrix__allocate( amat, sizej, sizei )
  use ac_misc_module
  implicit none
  type(AtomMatrix_type), target :: amat
  integer, intent(in) :: sizei, sizej
  integer :: i, j, n

  allocate( amat%S (sizej, sizei ) )
  amat%S  = 0.d0

  if( Param%Option%spin_orbit ) then
     allocate( amat%H0LS(sizej, sizei, Param%Option%nspin ) )
     allocate( amat%HLS (sizej, sizei, Param%Option%nspin ) )
     amat%H0LS = 0.d0
     amat%HLS  = 0.d0

     allocate( amat%CDMLS(sizej, sizei, Param%Option%nspin ) )
     amat%CDMLS = 0.d0

     if( Param%Option%optimize ) then
        allocate( amat%EDMLS(sizej, sizei ) )
        amat%EDMLS = 0.d0
     else
        nullify(amat%EDMLS)
     end if

     if( Param%SCF%mix_target == 'density_matrix' ) then
        allocate( amat%vpast(Param%SCF%mix_history) )
        do n=1, Param%SCF%mix_history
           allocate( amat%vpast(n)%CDMLS (sizej, sizei, Param%Option%nspin ) )
           allocate( amat%vpast(n)%dCDMLS(sizej, sizei, Param%Option%nspin ) )
        end do
     end if

  else
     allocate( amat%H0(sizej, sizei, Param%Option%nspin ) )
     allocate( amat%H (sizej, sizei, Param%Option%nspin ) )
     amat%H0 = 0.d0
     amat%H  = 0.d0

     allocate( amat%CDM(sizej, sizei, Param%Option%nspin ) )
     amat%CDM = 0.d0

     if( Param%Option%optimize ) then
        allocate( amat%EDM(sizej, sizei ) )
        amat%EDM = 0.d0
     else
        nullify(amat%EDM)
     end if

     if( Param%SCF%mix_target == 'density_matrix' ) then
        allocate( amat%vpast(Param%SCF%mix_history) )
        do n=1, Param%SCF%mix_history
           allocate( amat%vpast(n)%CDM (sizej, sizei, Param%Option%nspin ) )
           allocate( amat%vpast(n)%dCDM(sizej, sizei, Param%Option%nspin ) )
        end do
     end if
  end if

  return
end subroutine AtomMatrix__allocate

subroutine AtomMatrix__deallocate( amat )
  use ac_misc_module
  implicit none
  type(AtomMatrix_type), target :: amat
  integer :: n

  if( associated(amat%S ) ) deallocate(amat%S )

  if( Param%Option%spin_orbit ) then
     if( associated(amat%H0LS) ) deallocate(amat%H0LS)
     if( associated(amat%HLS ) ) deallocate(amat%HLS )
     if( associated(amat%CDMLS) ) deallocate(amat%CDMLS)

     if( Param%Option%optimize ) then
        if( associated(amat%EDMLS) ) deallocate(amat%EDMLS)
     end if

     if( Param%SCF%mix_target == 'density_matrix' ) then
        do n=1, Param%SCF%mix_history
           if( associated(amat%vpast(n)%CDMLS) )  deallocate(amat%vpast(n)%CDMLS)
           if( associated(amat%vpast(n)%dCDMLS) ) deallocate(amat%vpast(n)%dCDMLS)
        end do
        if( associated(amat%vpast) ) deallocate( amat%vpast )
     end if
  else
     if( associated(amat%H0) ) deallocate(amat%H0)
     if( associated(amat%H ) ) deallocate(amat%H )
     if( associated(amat%CDM) ) deallocate(amat%CDM)

     if( Param%Option%optimize ) then
        if( associated(amat%EDM) ) deallocate(amat%EDM)
     end if

     if( Param%SCF%mix_target == 'density_matrix' ) then
        do n=1, Param%SCF%mix_history
           if( associated(amat%vpast(n)%CDM) )  deallocate(amat%vpast(n)%CDM)
           if( associated(amat%vpast(n)%dCDM) ) deallocate(amat%vpast(n)%dCDM)
        end do
        if( associated(amat%vpast) ) deallocate( amat%vpast )
     end if
  end if


  return
end subroutine AtomMatrix__deallocate

subroutine AtomMatrix__calcSK
  use ac_misc_module
  use ac_mpi_module
  implicit none
  integer :: l
  integer :: a, i, i1
  integer :: b, j, j1
  real(8) :: S, K

  do l=0, Param%Cell%nL-1
     do a=MPI%isatom, MPI%ieatom
        i=Base%vipao(a)

        do b=1, Param%Data%natom
           j=Base%vipao(b)

           if( .not. associated(Hamiltonian%vAtomMatrix(b,a,l)%Ptr) ) then
              cycle
           end if

           do i1=MPI%ispao(a), MPI%iepao(a)
              do j1=1, Base%vnpao(b)

                 call Base__bracketSK( S, K, &
                      Base%vpao(i+i1-1), Base%vpao(j+j1-1), Param%Cell%vL(:,l) )

                 Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1) = S

                 if( Param%Option%spin_orbit ) then
                    Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,1) = K
                    Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,2) = 0.d0
                    Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,3) = 0.d0
                    Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,4) = K
                 else if( Param%Option%spin_polar ) then
                    Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,2) = K
                    Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,1) = K
                 else
                    Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,1) = K
                 end if

              end do
           end do
        end do
     end do
  end do

  return
end subroutine AtomMatrix__calcSK

subroutine AtomMatrix__calcL
  use ac_misc_module
  use ac_mpi_module
  implicit none
  integer :: l
  integer :: a, i, i1
  integer :: b, j, j1
  integer :: c, k, k1
  integer :: lc, lbc
  real(8) :: Vloc

  type UVMatrixL
     real(8), pointer :: uv(:,:)
     real(8), pointer ::  E(:)
  end type UVMatrixL
  type UVMatrixL_Ptr
     type(UVMatrixL), pointer :: Ptr
  end type UVMatrixL_Ptr
  type(UVMatrixL_Ptr), pointer :: vUV(:,:,:)

  if( .not. Param%Option%projection ) return

  allocate( vUV(Param%Data%natom, 1-Param%Cell%nL:Param%Cell%nL-1, Param%Data%natom ) )

  do a=1, Param%Data%natom
     do l=1-Param%Cell%nL, Param%Cell%nL-1
        do c=1, Param%Data%natom
           vUV(a,l,c)%Ptr => null()
        end do
     end do
  end do

  do l=0, Param%Cell%nL-1
     do a=MPI%isatom, MPI%ieatom
        i=Base%vipao(a)

        do b=1, Param%Data%natom
           j=Base%vipao(b)

           if( .not. associated(Hamiltonian%vAtomMatrix(b,a,l)%Ptr) ) then
              cycle
           end if

           do lc=1-Param%Cell%nL, Param%Cell%nL-1
              lbc = Param__Cell__relative( l, lc )
              if( lbc == -100 ) cycle

              do c=1, Param%Data%natom
                 if( Potential%vnVpsloc(c) == 0 ) cycle

                 k=Potential%viVpsloc(c)

                 if( .not. Potential__intersect( Base%vpao(i), &
                      Potential%vVpsloc(k),  Param%Cell%vL(:,lc) ) ) then
                    cycle
                 end if

                 if( .not. Potential__intersect( Base%vpao(j), &
                      Potential%vVpsloc(k),  Param%Cell%vL(:,lbc) ) ) then
                    cycle
                 end if

                 if( .not. associated( vUV(c,lc,a)%Ptr ) ) then
                    allocate( vUV(c,lc,a)%Ptr )
                    allocate( vUV(c,lc,a)%Ptr%uv( Potential%vnVpsloc(c), Base%vnpao(a) ) )
                    allocate( vUV(c,lc,a)%Ptr%E( Potential%vnVpsloc(c) ) )

                    do k1=1, Potential%vnVpsloc(c)
                       do i1=1, Base%vnpao(a)
                          call Potential__bracketS( vUV(c,lc,a)%Ptr%uv(k1,i1), &
                               Base%vpao(i+i1-1), Potential%vVpsloc(k+k1-1), Param%Cell%vL(:,lc) )
                       end do
                       vUV(c,lc,a)%Ptr%E(k1) = Potential%vVpsloc(k+k1-1)%E
                    end do
                 end if

                 if( .not. associated( vUV(c,lbc,b)%Ptr ) ) then
                    allocate( vUV(c,lbc,b)%Ptr )
                    allocate( vUV(c,lbc,b)%Ptr%uv( Potential%vnVpsloc(c), Base%vnpao(b) ) )
                    allocate( vUV(c,lbc,b)%Ptr%E( Potential%vnVpsloc(c) ) )

                    do k1=1, Potential%vnVpsloc(c)
                       do j1=1, Base%vnpao(b)
                          call Potential__bracketS( vUV(c,lbc,b)%Ptr%uv(k1,j1), &
                               Base%vpao(j+j1-1), Potential%vVpsloc(k+k1-1), Param%Cell%vL(:,lbc) )
                       end do
                       vUV(c,lbc,b)%Ptr%E(k1) = Potential%vVpsloc(k+k1-1)%E
                    end do
                 end if

                 do i1=MPI%ispao(a), MPI%iepao(a)
                    do j1=1, Base%vnpao(b)
                       do k1=1, Potential%vnVpsloc(c)
                          Vloc = &
                               + vUV(c,lc,a)%Ptr%uv(k1,i1) &
                               * vUV(c,lc,a)%Ptr%E(k1) &
                               * vUV(c,lbc,b)%Ptr%uv(k1,j1)

                          if( Param%Option%spin_orbit ) then
                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,1) = &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,1) + Vloc
                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,4) = &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,4) + Vloc

                          else if( Param%Option%spin_polar ) then
                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,1) = &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,1) + Vloc
                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,2) = &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,2) + Vloc
                          else
                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,1) = &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,1) + Vloc
                          end if

                       end do
                    end do
                 end do
              end do
           end do
        end do
     end do
  end do

  do a=1, Param%Data%natom
     do l=1-Param%Cell%nL, Param%Cell%nL-1
        do c=1, Param%Data%natom
           if( associated( vUV(c,l,a)%Ptr ) ) then
              deallocate( vUV(c,l,a)%Ptr%uv )
              deallocate( vUV(c,l,a)%Ptr%E  )
              deallocate( vUV(c,l,a)%Ptr )
           end if
        end do
     end do
  end do

  if( associated(vUV) ) deallocate(vUV)

  return
end subroutine AtomMatrix__calcL

subroutine AtomMatrix__calcN
  use ac_misc_module
  use ac_mpi_module
  implicit none
  integer :: spin
  integer :: l
  integer :: a, i, i1
  integer :: b, j, j1
  integer :: c, k, k1
  integer :: lc, lbc

  type UVMatrix
     real(8),    pointer :: uv(:,:)
     complex(8), pointer :: uvLS(:,:,:)
     real(8), pointer ::  E(:,:)
  end type UVMatrix

  type UVMatrix_Ptr
     type(UVMatrix), pointer :: Ptr
  end type UVMatrix_Ptr

  type(UVMatrix_Ptr), pointer :: vUV(:,:,:)

  real(8) :: uv0, uvm
  complex(8), parameter :: CI = ( 0.0d0, 1.0d0 )
  integer :: psl, psm
  real(8)    :: Vnon
  complex(8) :: VnonLS

  allocate( vUV(Param%Data%natom, 1-Param%Cell%nL:Param%Cell%nL-1, Param%Data%natom ) )

  do a=1, Param%Data%natom
     do l=1-Param%Cell%nL, Param%Cell%nL-1
        do c=1, Param%Data%natom
           vUV(a,l,c)%Ptr => null()
        end do
     end do
  end do

  do l=0, Param%Cell%nL-1
     do a=MPI%isatom, MPI%ieatom
        i=Base%vipao(a)

        do b=1, Param%Data%natom
           j=Base%vipao(b)

           if( .not. associated(Hamiltonian%vAtomMatrix(b,a,l)%Ptr) ) then
              cycle
           end if

           do lc=1-Param%Cell%nL, Param%Cell%nL-1
              lbc = Param__Cell__relative( l, lc )
              if( lbc == -100 ) cycle

              do c=1, Param%Data%natom
                 if( Potential%vnVpsnon(c) == 0 ) cycle

                 k=Potential%viVpsnon(c)

                 if( .not. Potential__intersect( Base%vpao(i), &
                      Potential%vVpsnon(k,1),  Param%Cell%vL(:,lc) ) ) then
                    cycle
                 end if

                 if( .not. Potential__intersect( Base%vpao(j), &
                      Potential%vVpsnon(k,1),  Param%Cell%vL(:,lbc) ) ) then
                    cycle
                 end if

                 if( .not. associated( vUV(c,lc,a)%Ptr ) ) then
                    if( Param%Option%spin_orbit ) then
                       allocate( vUV(c,lc,a)%Ptr )
                       allocate( vUV(c,lc,a)%Ptr%uvLS( Potential%vnVpsnon(c), Base%vnpao(a), 2 ) )
                       allocate( vUV(c,lc,a)%Ptr%E   ( Potential%vnVpsnon(c),2 ) )

                       do k1=1, Potential%vnVpsnon(c)
                          psm = Potential%vVpsnon(k+k1-1,1)%m
                          do i1=1, Base%vnpao(a)
                             do spin=1, 2
                                call Potential__bracketS( uvm, &
                                     Base%vpao(i+i1-1), Potential%vVpsnon(k+k1-1-2*psm,spin), Param%Cell%vL(:,lc) )
                                call Potential__bracketS( uv0, &
                                     Base%vpao(i+i1-1), Potential%vVpsnon(k+k1-1,spin), Param%Cell%vL(:,lc) )

                                if( psm > 0 ) then
                                   vUV(c,lc,a)%Ptr%uvLS(k1,i1,spin) = M_SQRT1_2*(-uv0 - CI*uvm)
                                else if( psm < 0 ) then
                                   vUV(c,lc,a)%Ptr%uvLS(k1,i1,spin) = M_SQRT1_2*(+uvm - CI*uv0)
                                else if( psm == 0 ) then
                                   vUV(c,lc,a)%Ptr%uvLS(k1,i1,spin) = uv0
                                end if
                             end do
                          end do
                          vUV(c,lc,a)%Ptr%E(k1,:) = Potential%vVpsnon(k+k1-1,:)%E
                       end do
                    else
                       allocate( vUV(c,lc,a)%Ptr )
                       allocate( vUV(c,lc,a)%Ptr%uv( Potential%vnVpsnon(c), Base%vnpao(a) ) )
                       allocate( vUV(c,lc,a)%Ptr%E ( Potential%vnVpsnon(c),1 ) )

                       do k1=1, Potential%vnVpsnon(c)
                          do i1=1, Base%vnpao(a)
                             call Potential__bracketS( uv0, &
                                  Base%vpao(i+i1-1), Potential%vVpsnon(k+k1-1,1), Param%Cell%vL(:,lc) )
                             vUV(c,lc,a)%Ptr%uv(k1,i1) = uv0
                          end do
                          vUV(c,lc,a)%Ptr%E(k1,1) = Potential%vVpsnon(k+k1-1,1)%E
                       end do
                    end if

                 end if

                 if( .not. associated( vUV(c,lbc,b)%Ptr ) ) then
                    if( Param%Option%spin_orbit ) then
                       allocate( vUV(c,lbc,b)%Ptr )
                       allocate( vUV(c,lbc,b)%Ptr%uvLS( Potential%vnVpsnon(c), Base%vnpao(b), 2 ) )
                       allocate( vUV(c,lbc,b)%Ptr%E   ( Potential%vnVpsnon(c),2 ) )

                       do k1=1, Potential%vnVpsnon(c)
                          psm = Potential%vVpsnon(k+k1-1,1)%m
                          do j1=1, Base%vnpao(b)
                             do spin=1, 2
                                call Potential__bracketS( uvm, &
                                     Base%vpao(j+j1-1), Potential%vVpsnon(k+k1-1-2*psm,spin), Param%Cell%vL(:,lbc) )
                                call Potential__bracketS( uv0, &
                                     Base%vpao(j+j1-1), Potential%vVpsnon(k+k1-1,spin), Param%Cell%vL(:,lbc) )

                                if( psm > 0 ) then
                                   vUV(c,lbc,b)%Ptr%uvLS(k1,j1,spin) = M_SQRT1_2*(-uv0 - CI*uvm)
                                else if( psm < 0 ) then
                                   vUV(c,lbc,b)%Ptr%uvLS(k1,j1,spin) = M_SQRT1_2*(+uvm - CI*uv0)
                                else if( psm == 0 ) then
                                   vUV(c,lbc,b)%Ptr%uvLS(k1,j1,spin) = uv0
                                end if
                             end do
                          end do
                          vUV(c,lbc,b)%Ptr%E(k1,:) = Potential%vVpsnon(k+k1-1,:)%E
                       end do
                    else
                       allocate( vUV(c,lbc,b)%Ptr )
                       allocate( vUV(c,lbc,b)%Ptr%uv( Potential%vnVpsnon(c), Base%vnpao(b) ) )
                       allocate( vUV(c,lbc,b)%Ptr%E ( Potential%vnVpsnon(c),1 ) )

                       do k1=1, Potential%vnVpsnon(c)
                          do j1=1, Base%vnpao(b)
                             call Potential__bracketS( uv0, &
                                  Base%vpao(j+j1-1), Potential%vVpsnon(k+k1-1,1), Param%Cell%vL(:,lbc) )
                             vUV(c,lbc,b)%Ptr%uv(k1,j1) = uv0
                          end do
                          vUV(c,lbc,b)%Ptr%E(k1,1) = Potential%vVpsnon(k+k1-1,1)%E
                       end do
                    end if
                 end if

                 do i1=MPI%ispao(a), MPI%iepao(a)
                    do j1=1, Base%vnpao(b)
                       do k1=1, Potential%vnVpsnon(c)

                          if( Param%Option%spin_orbit ) then
                             psl = Potential%vVpsnon(k+k1-1,1)%l
                             psm = Potential%vVpsnon(k+k1-1,1)%m

                             VnonLS = &
                                  + vUV(c,lc, a)%Ptr%E(k1,1) &
                                  * (dble(psl+psm+1)/dble(2*psl+1)) &
                                  * vUV(c,lc, a)%Ptr%uvLS(k1,i1,1) * dconjg(vUV(c,lbc,b)%Ptr%uvLS(k1,j1,1))

                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,1) = &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,1) + VnonLS

                             VnonLS = &
                                  + vUV(c,lc, a)%Ptr%E(k1,2) &
                                  * (dble(psl-psm)/dble(2*psl+1)) &
                                  * vUV(c,lc, a)%Ptr%uvLS(k1,i1,2) * dconjg(vUV(c,lbc,b)%Ptr%uvLS(k1,j1,2))

                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,1) = &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,1) + VnonLS

                             if( psl > psm ) then
                                VnonLS = &
                                     + vUV(c,lc, a)%Ptr%E(k1,1) &
                                     * sqrt(dble(psl+psm+1)/dble(2*psl+1)) * sqrt(dble(psl-psm)/dble(2*psl+1)) &
                                     * vUV(c,lc, a)%Ptr%uvLS(k1+1,i1,1) * dconjg(vUV(c,lbc,b)%Ptr%uvLS(k1,j1,1))

                                Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,2) = &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,2) + VnonLS

                                VnonLS = &
                                     + vUV(c,lc, a)%Ptr%E(k1,2) &
                                     * sqrt(dble(psl+psm+1)/dble(2*psl+1)) * sqrt(dble(psl-psm)/dble(2*psl+1)) &
                                     * vUV(c,lc, a)%Ptr%uvLS(k1+1,i1,2) * dconjg(vUV(c,lbc,b)%Ptr%uvLS(k1,j1,2))

                                Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,2) = &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,2) - VnonLS
                             end if

                             if( psl > psm ) then
                                VnonLS = &
                                     + vUV(c,lc, a)%Ptr%E(k1,1) &
                                     * sqrt(dble(psl+psm+1)/dble(2*psl+1)) * sqrt(dble(psl-psm)/dble(2*psl+1)) &
                                     * vUV(c,lc, a)%Ptr%uvLS(k1,i1,1) * dconjg(vUV(c,lbc,b)%Ptr%uvLS(k1+1,j1,1))

                                Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,3) = &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,3) + VnonLS

                                VnonLS = &
                                     + vUV(c,lc, a)%Ptr%E(k1,2) &
                                     * sqrt(dble(psl+psm+1)/dble(2*psl+1)) * sqrt(dble(psl-psm)/dble(2*psl+1)) &
                                     * vUV(c,lc, a)%Ptr%uvLS(k1,i1,2) * dconjg(vUV(c,lbc,b)%Ptr%uvLS(k1+1,j1,2))

                                Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,3) = &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,3) - VnonLS
                             end if

                             VnonLS = &
                                  + vUV(c,lc, a)%Ptr%E(k1,1) &
                                  * (dble(psl-psm+1)/dble(2*psl+1)) &
                                  * vUV(c,lc, a)%Ptr%uvLS(k1,i1,1) * dconjg(vUV(c,lbc,b)%Ptr%uvLS(k1,j1,1))

                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,4) = &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,4) + VnonLS

                             VnonLS = &
                                  + vUV(c,lc, a)%Ptr%E(k1,2) &
                                  * (dble(psl+psm)/dble(2*psl+1)) &
                                  * vUV(c,lc, a)%Ptr%uvLS(k1,i1,2) * dconjg(vUV(c,lbc,b)%Ptr%uvLS(k1,j1,2))

                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,4) = &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,4) + VnonLS

                          else if( Param%Option%spin_polar ) then
                             Vnon = &
                                  + vUV(c,lc, a)%Ptr%uv(k1,i1) &
                                  * vUV(c,lc, a)%Ptr%E (k1, 1) &
                                  * vUV(c,lbc,b)%Ptr%uv(k1,j1)

                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,1) = &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,1) + Vnon

                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,2) = &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,2) + Vnon
                          else
                             Vnon = &
                                  + vUV(c,lc, a)%Ptr%uv(k1,i1) &
                                  * vUV(c,lc, a)%Ptr%E (k1, 1) &
                                  * vUV(c,lbc,b)%Ptr%uv(k1,j1)

                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,1) = &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,1) + Vnon
                          end if

                       end do

                    end do
                 end do

              end do
           end do
        end do
     end do
  end do

  do a=1, Param%Data%natom
     do l=1-Param%Cell%nL, Param%Cell%nL-1
        do c=1, Param%Data%natom
           if( associated( vUV(c,l,a)%Ptr ) ) then
              if( Param%Option%spin_orbit ) then
                 deallocate( vUV(c,l,a)%Ptr%uvLS )
              else
                 deallocate( vUV(c,l,a)%Ptr%uv )
              end if
              deallocate( vUV(c,l,a)%Ptr%E  )
              deallocate( vUV(c,l,a)%Ptr )
           end if
        end do
     end do
  end do

  if( associated(vUV) ) deallocate(vUV)

  return
end subroutine AtomMatrix__calcN

subroutine AtomMatrix__calcT
  use ac_misc_module
  use ac_mpi_module
  implicit none
  integer :: spin
  integer :: a, i, i1
  integer :: l, b, j1
  real(8), pointer :: V(:,:)
  complex(8), parameter :: CI = ( 0.0d0, 1.0d0 )

  do spin=1, Param%Option%nspin
     do a=MPI%isatom, MPI%ieatom
        i=Base%vipao(a)

        do i1=MPI%ispao(a), MPI%iepao(a)
           call PAO__calcWaveV( Base%vpao(i+i1-1), spin )
        end do

        do l=0, Param%Cell%nL-1
           do b=1, Param%Data%natom
              if( .not. associated(Hamiltonian%vAtomMatrix(b,a,l)%Ptr) ) then
                 cycle
              end if

              allocate( V(Base%vnpao(b),Base%vnpao(a)) )

              call Base__bracketV( V, a, b, l )

              if( Param%Option%spin_orbit ) then
                 select case(spin)
                 case(1)
                    do i1=MPI%ispao(a), MPI%iepao(a)
                       do j1=1, Base%vnpao(b)
                          Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,1) = &
                               + Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,1) &
                               + V(j1,i1)
                       end do
                    end do
                 case(2)
                    do i1=MPI%ispao(a), MPI%iepao(a)
                       do j1=1, Base%vnpao(b)
                          Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,2) = &
                               + Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,2) &
                               + V(j1,i1)
                          Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,3) = &
                               + Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,3) &
                               + V(j1,i1)
                       end do
                    end do
                 case(3)
                    do i1=MPI%ispao(a), MPI%iepao(a)
                       do j1=1, Base%vnpao(b)
                          Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,2) = &
                               + Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,2) &
                               + V(j1,i1)*CI
                          Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,3) = &
                               + Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,3) &
                               - V(j1,i1)*CI
                       end do
                    end do
                 case(4)
                    do i1=MPI%ispao(a), MPI%iepao(a)
                       do j1=1, Base%vnpao(b)
                          Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,4) = &
                               + Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,4) &
                               + V(j1,i1)
                       end do
                    end do
                 end select

              else
                 do i1=MPI%ispao(a), MPI%iepao(a)
                    do j1=1, Base%vnpao(b)
                       Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H(j1,i1,spin) = &
                            + Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,spin) &
                            + V(j1,i1)
                    end do
                 end do
              end if

              if(associated(V)) deallocate(V)
           end do
        end do

        do i1=MPI%ispao(a), MPI%iepao(a)
           call PAO__freeWaveV( Base%vpao(i+i1-1) )
        end do

     end do

  end do

  return
end subroutine AtomMatrix__calcT

subroutine AtomMatrix__save
  use ac_misc_module
  use ac_mpi_module
  implicit none

  type(Element_type), pointer :: elem

  integer :: l
  integer :: a, i1
  integer :: b, j1
  integer :: iunit

  integer :: i2,i_temp1,i_temp2
  character(1) :: character_temp(4),a_c(10)
  character(55) :: fname

  integer, allocatable :: i_orb(:)
  integer :: i_c, n
  integer :: i_cyc
  integer :: mat_max_ll,mat_max_rr,mat_max_cc,ele_num_ll,ele_num_rr

  allocate( i_orb(0:Param%Data%natom) )

  i_orb(0)=0
  do a=1, Param%Data%natom
     elem => Param__Data__getElement( Param%Data%vatom(a)%name )
     i_c=0
     do n=1, elem%npao
        i_c = i_c + 2*(elem%vpao(n)%l) + 1
     end do
     i_orb(a)=i_orb(a-1)+i_c
  end do

  if( Param%Option%nspin < 4 ) then
     mat_max_cc=Base%npao
     mat_max_ll=i_orb(Param%Data%natom_left)
     mat_max_rr=Base%npao-i_orb(Param%Data%natom-Param%Data%natom_right)
  else
     mat_max_cc=Base%npao*2
     mat_max_ll=i_orb(Param%Data%natom_left)*2
     mat_max_rr=(Base%npao-i_orb(Param%Data%natom-Param%Data%natom_right))*2
  end if

  ele_num_ll=0
  do a=1, Param%Data%natom_left
     elem => Param__Data__getElement( Param%Data%vatom(a)%name )
     ele_num_ll=ele_num_ll+Param%Data%vatom(a)%Q
  end do
  ele_num_rr=0
  do a=Param%Data%natom-Param%Data%natom_right+1, Param%Data%natom
     elem => Param__Data__getElement( Param%Data%vatom(a)%name )
     ele_num_rr=ele_num_rr+Param%Data%vatom(a)%Q
  end do

  deallocate( i_orb )

  a_c(1)='0'
  a_c(2)='1'
  a_c(3)='2'
  a_c(4)='3'
  a_c(5)='4'
  a_c(6)='5'
  a_c(7)='6'
  a_c(8)='7'
  a_c(9)='8'
  a_c(10)='9'

  do a=1, Param%Data%natom

     i_temp1=a+1-1
     do i2=1,4
        i_temp2=i_temp1/(10**(4-i2))
        character_temp(i2)=a_c(i_temp2+1)
        i_temp1=i_temp1-(10**(4-i2))*i_temp2
     end do
     fname=trim(Param%Option%fname_matrices)               &
          //'_'//character_temp(1)//character_temp(2) &
          //character_temp(3)//character_temp(4)
     iunit=1
     if( MPI%root ) then
        open(iunit,file=fname)
        write(iunit,886) Param%Data%natom, Param%Data%natom_left, Param%Data%natom_right, &
             Param%Cell%nL, Param%Option%nspin-1, mat_max_ll, mat_max_cc, mat_max_rr, &
             ele_num_ll, ele_num_rr
886     format(10i6,'      = natom, nL, mat_max')
        write(iunit,*) Param%Cell%La(:)
        write(iunit,*) Param%Cell%Lb(:)
        write(iunit,*) Param%Cell%Lc(:)
        close(iunit)
     end if

     do l=0, Param%Cell%nL-1
        do b=1, Param%Data%natom

           do i_cyc=0,MPI%size-1
              if( i_cyc == MPI%rank ) then
                 if( a >= MPI%isatom .and. a <= MPI%ieatom ) then

                    if( .not. associated(Hamiltonian%vAtomMatrix(b,a,l)%Ptr) ) then
                       if( MPI%ispao(a) == 1 ) then
                          open(iunit,file=fname,position='append')
                          i_temp1=1
                          write(iunit,*)
                          write(iunit,887) a-1,l,b-1,i_temp1,Base%vnpao(a),Base%vnpao(b)
                          write(iunit,885) Param%Cell%vL(:,l)
                          close(iunit)
                       end if
                       go to 100
                    else
                       if( MPI%ispao(a) == 1 ) then
                          open(iunit,file=fname,position='append')
                          i_temp1=0
                          write(iunit,*)
                          write(iunit,887) a-1,l,b-1,i_temp1,Base%vnpao(a),Base%vnpao(b)
                          write(iunit,885) Param%Cell%vL(:,l)
                          close(iunit)
                       end if
                    end if
887                 format(6i6,'      *****************')
885                 format(3d25.16,'      =vL.x, vL.y, vL. z')

                    do i1=MPI%ispao(a), MPI%iepao(a)

                       open(iunit,file=fname,position='append')
                       do j1=1, Base%vnpao(b)
                          if( Param%Option%nspin-1 == 0 ) then
                             write(iunit,889) &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S  (j1,i1), &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0 (j1,i1,1), &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H  (j1,i1,1), &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDM(j1,i1,1)*.5d0
889                          format(4d25.16)
                          else
                             if( Param%Option%nspin-1 == 1 ) then
                                write(iunit,888) &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1),          &
                                     (Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,1)        &
                                     +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,2))*.5d0, &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H(j1,i1,1),        &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H(j1,i1,2),        &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDM(j1,i1,1),      &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDM(j1,i1,2)
888                             format(6d25.16)
                             else
                                write(iunit,876) &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)
                                write(iunit,877) &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,1),     &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,2)
                                write(iunit,877) &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,3),     &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,4)
                                write(iunit,877) &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,1),      &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,2)
                                write(iunit,877) &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,3),      &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,4)
                                write(iunit,877) &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDMLS(j1,i1,1),    &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDMLS(j1,i1,2)
                                write(iunit,877) &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDMLS(j1,i1,3),    &
                                     Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDMLS(j1,i1,4)
876                             format(1d25.16)
877                             format(4d25.16)
                             end if
                          end if
                       end do
                       close(iunit)
                    end do
                 end if
              end if
100           continue
              call MPI__Barrier
           end do

        end do
     end do

  end do

  return
end subroutine AtomMatrix__save

subroutine AtomMatrix__load
  use ac_misc_module
  use ac_mpi_module
  implicit none

  integer :: l
  integer :: a, i1
  integer :: b, j1
  integer :: iunit
  logical :: ex

  integer :: l_t,a_t,b_t
  integer :: i2,i_temp1,i_temp2,i_temp3,i_temp4,i_temp5
  character(1) :: character_temp(4),a_c(10)
  character(55) :: fname
  real(8) :: temp1,temp2,temp3,temp4

  real(8) :: t_L(3)

  open(unit=16,file=Param%Option%file_ac_tempout,position='append')
  write(16,*) '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
  write(16,*) '+++++++++++        loading hamiltonian matrices'
  write(16,999) trim(Param%Option%fname_matrices_in)
  write(16,*) '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
  write(16,*)
999 format(' +++++++++++        read file:: ',a)
  close(16)

  a_c(1)='0'
  a_c(2)='1'
  a_c(3)='2'
  a_c(4)='3'
  a_c(5)='4'
  a_c(6)='5'
  a_c(7)='6'
  a_c(8)='7'
  a_c(9)='8'
  a_c(10)='9'

  do a=MPI%isatom, MPI%ieatom

     i_temp1=a+1-1
     do i2=1,4
        i_temp2=i_temp1/(10**(4-i2))
        character_temp(i2)=a_c(i_temp2+1)
        i_temp1=i_temp1-(10**(4-i2))*i_temp2
     end do
     fname=trim(Param%Option%fname_matrices_in)               &
          //'_'//character_temp(1)//character_temp(2) &
          //character_temp(3)//character_temp(4)

     inquire(file=fname,exist=ex)
     if( .not. ex ) then
        open(unit=16,file=Param%Option%file_ac_tempout,position='append')
        write(16,'(a,a)') '      ++++++ Error!: can not open file ', fname
        close(16)
        stop
     end if

     iunit=1
     open(iunit,file=fname)
     read(iunit,*) i_temp1,i_temp2,i_temp3,i_temp4,i_temp5
     read(iunit,*)
     read(iunit,*)
     read(iunit,*)

     if(i_temp5/=Param%Option%nspin-1) then
        open(unit=16,file=Param%Option%file_ac_tempout,position='append')
        write(16,'(a,a)') '      ++++++ Error!: spin ', fname
        close(16)
        stop
     end if

     do
        read(iunit,*,end=1000)
        read(iunit,*) a_t,l,b_t,i_temp1,i_temp2,i_temp3
        read(iunit,*) t_L(:)
        b=b_t+1

        if(a/=a_t+1) then
           open(unit=16,file=Param%Option%file_ac_tempout,position='append')
           write(16,'(a,a)') '      ++++++ Error!: a ', fname
           close(16)
           stop
        end if
        if( Param%Data%natom < b ) then
           open(unit=16,file=Param%Option%file_ac_tempout,position='append')
           write(16,'(a,a)') '      ++++++ Error!: b ', fname
           close(16)
           stop
        end if
        if(Base%vnpao(a)/=i_temp2) then
           open(unit=16,file=Param%Option%file_ac_tempout,position='append')
           write(16,'(a,a)') '      ++++++ Error!: Base%vnpao(a) ', fname
           close(16)
           stop
        end if
        if(Base%vnpao(b)/=i_temp3) then
           open(unit=16,file=Param%Option%file_ac_tempout,position='append')
           write(16,'(a,a)') '      ++++++ Error!: Base%vnpao(b) ', fname
           close(16)
           stop
        end if

        if( i_temp1 /= 1 ) then
           l=Param%Cell%nL
           do l_t=0, Param%Cell%nL-1
              if( sqrt(dot_product(Param%Cell%vL(:,l_t)-t_L(:),Param%Cell%vL(:,l_t)-t_L(:))) < 1.d-8 ) then
                 l=l_t
                 exit
              end if
           end do
           if( Param%Cell%nL-1 < l ) then
              do i1=1, Base%vnpao(a)
                 do j1=1, Base%vnpao(b)
                    if( Param%Option%nspin-1 < 3 ) then
                       read(iunit,*)
                    else
                       read(iunit,*)
                       read(iunit,*)
                       read(iunit,*)
                       read(iunit,*)
                       read(iunit,*)
                       read(iunit,*)
                       read(iunit,*)
                    end if
                 end do
              end do
              cycle
           end if
           if( associated(Hamiltonian%vAtomMatrix(b,a,l)%Ptr) ) then
              do i1=1, Base%vnpao(a)
                 do j1=1, Base%vnpao(b)
                    if( i1 >= MPI%ispao(a) .and. i1 <= MPI%iepao(a) ) then
                       if( Param%Option%nspin-1 == 0 ) then
                          read(iunit,*) &
                               Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1), &
                               Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,1), &
                               Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H(j1,i1,1), &
                               Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDM(j1,i1,1)
                          Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDM(j1,i1,1) &
                               =2.d0*Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDM(j1,i1,1)
                       else
                          if( Param%Option%nspin-1 == 1 ) then
                             read(iunit,*) &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1),     &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,1),  &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H(j1,i1,1),   &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H(j1,i1,2),   &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDM(j1,i1,1), &
                                  Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDM(j1,i1,2)
                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,2) &
                                  =Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0(j1,i1,1)
                          else
                             read(iunit,*) Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)
                             read(iunit,*) temp1,temp2,temp3,temp4
                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,1)  &
                                  =dcmplx(temp1,temp2)
                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,2)  &
                                  =dcmplx(temp3,temp4)
                             read(iunit,*) temp1,temp2,temp3,temp4
                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,3)  &
                                  =dcmplx(temp1,temp2)
                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H0LS(j1,i1,4)  &
                                  =dcmplx(temp3,temp4)
                             read(iunit,*) temp1,temp2,temp3,temp4
                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,1)   &
                                  =dcmplx(temp1,temp2)
                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,2)   &
                                  =dcmplx(temp3,temp4)
                             read(iunit,*) temp1,temp2,temp3,temp4
                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,3)   &
                                  =dcmplx(temp1,temp2)
                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,4)   &
                                  =dcmplx(temp3,temp4)
                             read(iunit,*) temp1,temp2,temp3,temp4
                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDMLS(j1,i1,1) &
                                  =dcmplx(temp1,temp2)
                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDMLS(j1,i1,2) &
                                  =dcmplx(temp3,temp4)
                             read(iunit,*) temp1,temp2,temp3,temp4
                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDMLS(j1,i1,3) &
                                  =dcmplx(temp1,temp2)
                             Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDMLS(j1,i1,4) &
                                  =dcmplx(temp3,temp4)
                          end if
                       end if
                    else
                       if( Param%Option%nspin-1 < 3 ) then
                          read(iunit,*)
                       else
                          read(iunit,*)
                          read(iunit,*)
                          read(iunit,*)
                          read(iunit,*)
                          read(iunit,*)
                          read(iunit,*)
                          read(iunit,*)
                       end if
                    end if
                 end do
              end do
           else
              do i1=1, Base%vnpao(a)
                 do j1=1, Base%vnpao(b)
                    if( Param%Option%nspin-1 < 3 ) then
                       read(iunit,*)
                    else
                       read(iunit,*)
                       read(iunit,*)
                       read(iunit,*)
                       read(iunit,*)
                       read(iunit,*)
                       read(iunit,*)
                       read(iunit,*)
                    end if
                 end do
              end do
           end if
        end if

     end do

1000 continue

     close(iunit)
  end do

  return
end subroutine AtomMatrix__load
