! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       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 Hamiltonian__setup
  use ac_misc_module
  use ac_mpi_module

  implicit none

  integer       :: l, a, i, b, j
  integer       :: li, c, k
  logical       :: overlap

  call Hamiltonian__deallocate

  allocate( Hamiltonian%vAtomMatrix(Param%Data%natom, Param%Data%natom,0:Param%Cell%nL-1) )

  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( Base__intersect( Base%vpao(i), Base%vpao(j), &
                Param%Cell%vL(:,l) ) ) then
              overlap = .true.

           else if( Param%Option%indirect_overlap ) then
              vpsloop: do li=1-Param%Cell%nL, Param%Cell%nL-1
                 do c=1, Param%Data%natom
                    k=Potential%viVpsnon(c)
                    if( .not. Potential__intersect( Base%vpao(i), &
                         Potential%vVpsnon(k,1),  Param%Cell%vL(:,li) ) ) then
                       cycle
                    end if

                    if(  Potential__intersect( Base%vpao(j), &
                         Potential%vVpsnon(k,1),  Param%Cell%vL(:,li) ) ) then
                       overlap = .true.
                       go to 100
                    end if
                 end do
              end do vpsloop
100           continue
           else
              overlap = .false.
           end if

           if( overlap ) then
              allocate( Hamiltonian%vAtomMatrix(b,a,l)%Ptr )
              call AtomMatrix__allocate( Hamiltonian%vAtomMatrix(b,a,l)%Ptr, Base%vnpao(b), Base%vnpao(a) )
           else
              Hamiltonian%vAtomMatrix(b,a,l)%Ptr => null()
           end if
        end do
     end do
  end do

  return
end subroutine Hamiltonian__setup

subroutine Hamiltonian__calcSCF
  use ac_misc_module
  use ac_mpi_module
  implicit none
  integer :: iter, iter_st
  integer :: k

  integer          :: nE
  real(8), pointer :: vE(:)

  real(8) :: Eorb, Elat, Eint
  real(8) :: Efer_prev, Eorb_prev, Etot_prev, dEden

  integer :: i,spin,j_con

  call Hamiltonian__setup

  allocate( Hamiltonian%vBandMatrix(Param%SCF%nK) )

  do k=1, Param%SCF%nK
     call BandMatrix__allocate( Hamiltonian%vBandMatrix(k) )
  end do

  if( .not. Param%Option%spin_polar ) then
     nE = Param%SCF%nK*Base%npao * 1
  else
     nE = Param%SCF%nK*Base%npao * 2
  end if
  allocate( vE(0:nE-1) )

  if( Param%Option%fname_matrices_in /= "" ) then
     call AtomMatrix__load
     call Density__calc()
     iter_st=1
     Param%Option%fname_matrices_in = ""
  else
     iter_st=0
  end if

  open(unit=16,file=Param%Option%file_ac_tempout,position='append')
  write(16,*) '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
  write(16,*) '++++++++++++ calculating overlap and kinetic matrices ...'
  close(16)
  call AtomMatrix__calcSK

  if( Param%Option%projection ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,*) '++++++++++++ calculating local pseudo potential matrices ...'
     close(16)
     call AtomMatrix__calcL
  end if

  open(unit=16,file=Param%Option%file_ac_tempout,position='append')
  write(16,*) '++++++++++++ calculating nonlocal psudo potential matrices ...'
  close(16)
  call AtomMatrix__calcN

  open(unit=16,file=Param%Option%file_ac_tempout,position='append')
  write(16,*) '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
  write(16,*)
  write(16,*) '**************************************************************'
  write(16,*) '************ start iteration: processe num =', MPI%size
  write(16,*) '**************************************************************'
  close(16)

  Efer_prev = 0.d0
  Eorb_prev = 0.d0
  Etot_prev = 0.d0

  if( Param%SCF%mix_target == 'density' ) then
     if(iter_st==1) then
        call Density__update( dEden, 0 )
     end if
  else if( Param%SCF%mix_target == 'density_matrix' ) then
     call DensityMatrix__update( dEden, iter_st-1 )
  end if

  j_con=100
  do iter=iter_st, Param%SCF%iter_max

     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,*)
     write(16,*) '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
     write(16,*) '++++++++++++ iterations:',iter
     write(16,*) '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
     close(16)

     call Potential__update

     call AtomMatrix__calcT

     do k=1, Param%SCF%nK
        if( Param%SCF%i_vK(k) < 0 ) then
           call BandMatrix__calc( Hamiltonian%vBandMatrix(k), Param%SCF%vK(:,k) )
           call BandMatrix__solve( Hamiltonian%vBandMatrix(k), iter )
        else
           if( .not. Param%Option%spin_orbit ) then
              do spin=1, Param%Option%nspin
                 do i=1, Base%npao
                    Hamiltonian%vBandMatrix(k)%E(i,spin) &
                         =Hamiltonian%vBandMatrix(Param%SCF%i_vK(k))%E(i,spin)
                 end do
              end do
           else
              do i=1, Base%npao*2
                 Hamiltonian%vBandMatrix(k)%E(i,1) &
                      =Hamiltonian%vBandMatrix(Param%SCF%i_vK(k))%E(i,1)
              end do
           end if
        end if
     end do

     call Energy__sort(nE,vE)
     call Energy__findFermi(Energy%Ef,nE,vE)

     do k=1, Param%SCF%nK
        if( Param%SCF%i_vK(k) >= 0 ) then
           cycle
        end if
        call BandMatrix__calcCDM( Hamiltonian%vBandMatrix(k) )
     end do

     call DensityMatrix__calc()

     if( Param%SCF%mix_target == 'density' ) then
        call Density__calc()

        call Density__update( dEden, iter )
     else if( Param%SCF%mix_target == 'density_matrix' ) then
        call DensityMatrix__update( dEden, iter )
        call Density__calc()
     end if

     call Energy__sort(nE,vE)
     call Energy__findFermi(Energy%Ef,nE,vE)
     call Energy__calcOrbital(Eorb,nE,vE)
     call Energy__calcLattice(Elat)
     call Energy__calcInternal(Eint)
     Energy%Etot = Eorb + Elat - Eint

     if( MPI%root ) then
        call Hamiltonian__level__out(Eorb,Elat,Eint)
     end if
     call Hamiltonian__showCharge

     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,*) '                     * Efermi =', Energy%Ef
     write(16,*) '                  * Eorb/Nele =', Eorb/Param%Data%Ne
     write(16,*) '                  * Etot/Natm =', Energy%Etot/Param%Data%natom
     close(16)

     if( Param%SCF%cri_type == 'fermi' ) then
        open(unit=16,file=Param%Option%file_ac_tempout,position='append')
        write(16,*)'   ###### Efermi ####################################################'
        write(16,976) Param%SCF%criterion
        write(16,977) iter,Energy%Ef-Efer_prev,Energy%Ef
        write(16,*)'   ##################################################################'
976     format('    ######  criterion:',f25.16,'                 ######')
977     format('    #d####       ',i5,f25.16,f15.6,'  ####d#')
        close(16)
     end if

     if( Param%SCF%cri_type == 'orbital' ) then
        open(unit=16,file=Param%Option%file_ac_tempout,position='append')
        write(16,*)'   ###### Eorb/Nele #################################################'
        write(16,974) Param%SCF%criterion
        write(16,975) iter,(Eorb-Eorb_prev)/Param%Data%Ne,Eorb/Param%Data%Ne
        write(16,*)'   ##################################################################'
974     format('    ######  criterion:',f25.16,'                 ######')
975     format('    #d####       ',i5,f25.16,f15.6,'  ####d#')
        close(16)
     end if

     if( Param%SCF%cri_type == 'total' ) then
        open(unit=16,file=Param%Option%file_ac_tempout,position='append')
        write(16,*)'   ###### Etot/Natom ################################################'
        write(16,972) Param%SCF%criterion
        write(16,973) iter,(Energy%Etot-Etot_prev)/Param%Data%natom,Energy%Etot/Param%Data%natom
        write(16,*)'   ##################################################################'
972     format('    ######  criterion:',f25.16,'                 ######')
973     format('    #d####       ',i5,f25.16,f15.6,'  ####d#')
        close(16)
     end if

     if( Param%SCF%cri_type == 'density' ) then
        open(unit=16,file=Param%Option%file_ac_tempout,position='append')
        write(16,*)'   ###### drho ######################################################'
        write(16,970) Param%SCF%criterion,(Eorb-Eorb_prev)/Param%Data%Ne
        write(16,971) iter,dEden,dabs(Energy%Etot-Etot_prev)/Param%Data%natom
        write(16,*)'   ##################################################################'
970     format('    ######            ',f21.12,f20.11,' ######')
971     format('    #d####       ',i5,f21.12,f20.11,' ####d#')
        close(16)
     end if

     if( iter /= 0 ) then
        select case( Param%SCF%cri_type )
        case('fermi')
           if( dabs(Energy%Ef-Efer_prev) < Param%SCF%criterion ) then
              j_con=0
              open(unit=16,file=Param%Option%file_ac_tempout,position='append')
              write(16,*)
              write(16,*) '**************************************************************'
              write(16,*) '************   end iterations:',iter
              write(16,*) '**************************************************************'
              close(16)
              exit
           end if
        case('orbital')
           if( dabs(Eorb-Eorb_prev)/Param%Data%Ne < Param%SCF%criterion )  then
              j_con=0
              open(unit=16,file=Param%Option%file_ac_tempout,position='append')
              write(16,*)
              write(16,*) '**************************************************************'
              write(16,*) '************   end iterations:',iter
              write(16,*) '**************************************************************'
              close(16)
              exit
           end if
        case('total')
           if( dabs(Energy%Etot-Etot_prev)/Param%Data%natom  < Param%SCF%criterion )  then
              j_con=0
              open(unit=16,file=Param%Option%file_ac_tempout,position='append')
              write(16,*)
              write(16,*) '**************************************************************'
              write(16,*) '************   end iterations:',iter
              write(16,*) '**************************************************************'
              close(16)
              exit
           end if
        case('density')
           if( dEden < Param%SCF%criterion )  then
              j_con=0
              open(unit=16,file=Param%Option%file_ac_tempout,position='append')
              write(16,*)
              write(16,*) '**************************************************************'
              write(16,*) '************   end iterations:',iter
              write(16,*) '**************************************************************'
              close(16)
              exit
           end if
        end select
     end if

     Efer_prev = Energy%Ef
     Eorb_prev = Eorb
     Etot_prev = Energy%Etot

     if( Param%Option%saveat == "everystep" ) then
        call Hamiltonian__save
     end if
  end do

  if( j_con/=0 ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,*)
     write(16,*) '**************************************************************'
     write(16,*) '************   end iterations: !!! NOT YET CONVERGED !!!'
     write(16,*) '**************************************************************'
     close(16)
  end if

  if( MPI%root ) then
     call Energy__sort(nE,vE)
     call Energy__findFermi(Energy%Ef,nE,vE)
     call Energy__calcOrbital(Eorb,nE,vE)
     call Energy__calcLattice(Elat)
     call Energy__calcInternal(Eint)
     Energy%Etot = Eorb + Elat - Eint
     call Hamiltonian__level__out(Eorb,Elat,Eint)

  end if

  call Hamiltonian__showCharge

  if( Param%Option%saveat == "finalstep" ) then
     call Hamiltonian__save
  end if
  if( Param%Option%saveat /= "never" ) then
     Param%Option%fname_matrices_in=Param%Option%fname_matrices
  end if

  if( Param%Option%ascot_negf ) then
     if( MPI%root ) then
        call Param__readdata_ASCOT
        call Hamiltonian__outdata2( vE,nE )
     end if
  end if
  if( Param%Option%fname_accel_c /= "" ) then
     call Hamiltonian__outdata3
  end if

  if(associated(vE)) deallocate(vE)

  do k=1, Param%SCF%nK
     call BandMatrix__deallocate(Hamiltonian%vBandMatrix(k))
  end do
  if(associated(Hamiltonian%vBandMatrix)) deallocate( Hamiltonian%vBandMatrix )

  return
end subroutine Hamiltonian__calcSCF

subroutine Hamiltonian__save
  use ac_misc_module
  use ac_mpi_module
  implicit none

  if( Param%Option%fname_matrices /= '' ) then
     call AtomMatrix__save
  end if

  if( .not. MPI%root ) return

  if( Param%Option%fname_rhoscf /= "" ) then
     if( Param%Option%spin_orbit ) then
        call vector3d__save4( Density%rhoLS, Param%Option%fname_rhoscf )
     else if( Param%Option%spin_polar ) then
        call vector3d__save2( Density%rho, Param%Option%fname_rhoscf )
     else
        call vector3d__save1( Density%rho, Param%Option%fname_rhoscf )
     end if
  end if

  if(Param%Option%na .and. Param%Option%fname_rhoval /= "" ) then
     call vector3d__save1( Density%rhoval, Param%Option%fname_rhoval )
  end if

  if( Param%Option%pcc .and. Param%Option%fname_rhopcc /= '' ) then
     call vector3d__save1( Density%rhopcc, Param%Option%fname_rhopcc )
  end if

  if( Param%Option%fname_vext /= '' ) then
     call vector3d__save1( Potential%Vext, Param%Option%fname_vext )
  end if

  if( (.not. Param%Option%nohar) .and. Param%Option%fname_vhar /= '' ) then
     call vector3d__save1( Potential%dVhar, Param%Option%fname_vhar )
  end if

  if( (.not. Param%Option%noexc) .and. Param%Option%fname_vexc /= '' ) then
     call vector3d__save2( Potential%Vexc, Param%Option%fname_vexc )
  end if

  if( Param%Option%fname_vtot /= '' ) then
     call vector3d__save2( Potential%Vtot, Param%Option%fname_vtot )
  end if

  return 
end subroutine Hamiltonian__save

subroutine Hamiltonian__calcBandMap
  use ac_misc_module
  use ac_mpi_module

  implicit none
  integer :: iunit,iunit1
  integer :: spin
  integer :: k, m
  type(BandMatrix_type) :: band

  open(unit=16,file=Param%Option%file_ac_tempout,position='append')
  write(16,*)
  write(16,*) '**************************************************************'
  write(16,*) '************ start calculation: band energies'
  write(16,*) '**************************************************************'
  close(16)

  call BandMatrix__allocate( band )

  iunit = 1
  iunit1 = 2
  open(iunit,file=Param%Band%fname)
  if( Param%Option%nspin == 2 ) then
     open(iunit1,file=Param%Band%fname1)
  end if

  if( MPI%root ) then
     write(iunit,*) '* cp= ',Energy%Ef*AU_TO_EV,' [eV]'
     write(iunit,*) '**************************************************'
     if( Param%Option%nspin == 2 ) then
        write(iunit,*) '  UP  spin +++++++++++++++++++++++++++++++++++++++'
        write(iunit1,*) '* cp= ',Energy%Ef*AU_TO_EV,' [eV]'
        write(iunit1,*) '**************************************************'
        write(iunit1,*) ' DOWN spin +++++++++++++++++++++++++++++++++++++++'
     end if
  end if

  do k=1, Param%Band%nK

     call BandMatrix__calc( band, Param%Band%vK(:,k) )
     call BandMatrix__solve( band, 0 )

     band%E(:,:) = band%E(:,:)

     if( MPI%root ) then
        if( Param%Option%nspin /= 2 ) then
           write(iunit,'(i3,$)') k
           do m=1, Param%Band%num_band
              write(iunit,'(f16.10,$)') band%E(m,1)*AU_TO_EV
           end do
        else 
           write(iunit,'(i3,$)') k
           do m=1, Param%Band%num_band
              write(iunit,'(f16.10,$)') band%E(m,1)*AU_TO_EV
           end do
           write(iunit1,'(i3,$)') k
           do m=1, Param%Band%num_band
              write(iunit1,'(f16.10,$)') band%E(m,2)*AU_TO_EV
           end do
        end if

        write(iunit,*)
        if( Param%Option%nspin == 2 ) then
           write(iunit1,*)
        end if
     end if
  end do

  close(iunit)
  if( Param%Option%nspin == 2 ) then
     close(iunit1)
  end if

  call BandMatrix__deallocate( band )

  return
end subroutine Hamiltonian__calcBandMap

subroutine Hamiltonian__calcDOS
  use ac_misc_module
  use ac_mpi_module

  implicit none
  integer :: iunit
  integer :: spin
  integer :: ika, ikb, ikc, b
  type(BandMatrix_type) :: band

  real(8), pointer :: vE(:,:,:,:,:)
  real(8), pointer :: vdos(:,:)

  integer :: n_npao,n_spin
  real(8) :: pdbe_t
  real(8) :: pdosk(3)

  open(unit=16,file=Param%Option%file_ac_tempout,position='append')
  write(16,*)
  write(16,*) '**************************************************************'
  write(16,*) '************ start calculation: density of states'
  write(16,*) '**************************************************************'
  close(16)

  call BandMatrix__allocate( band )

  if( Param%Option%nspin < 3 ) then
     n_npao=Base%npao
     n_spin=Param%Option%nspin
  else
     n_npao=Base%npao*2
     n_spin=1
  end if

  allocate( vE(Param%DOS%Nka, Param%DOS%Nkb, Param%DOS%Nkc, n_npao, n_spin ) )

  do ikc=1, Param%DOS%Nkc
     do ikb=1, Param%DOS%Nkb
        do ika=1, Param%DOS%Nka
           call Param__DOS__K(pdosk,ika,ikb,ikc)
           call BandMatrix__calc( band, pdosk )
           call BandMatrix__solve( band, 0 )
           vE(ika,ikb,ikc,:,:) = band%E(:,:)
        end do
     end do
  end do

  allocate( vdos(Param%DOS%Ne, n_spin ) )

  do spin=1, n_spin
     call DOS__calc( vdos(:,spin), vE(:,:,:,:,spin), n_npao )
  end do

  if( MPI%root ) then

     iunit = 1
     open(iunit,file=Param%DOS%fname)

     write(iunit,'(a,a)') ' + Density of States: ', Param%DOS%method
     write(iunit,'(a)') ' ++++++++++++++++++++++++++++++++++++++++++++++++++'

     write(iunit,*) '* cp= ',Energy%Ef*AU_TO_EV,' [eV]'
     write(iunit,*) '**************************************************'

     if( Param%Option%nspin == 1 ) then
        do b=1, Param%DOS%Ne
           call Param__DOS__binEnergy(pdbe_t,b)
           write(iunit,*) pdbe_t*AU_TO_EV, vdos(b,1)/AU_TO_EV, vdos(b,1)/AU_TO_EV
        end do
     else
        if( Param%Option%nspin == 2 ) then
           do b=1, Param%DOS%Ne
              call Param__DOS__binEnergy(pdbe_t,b)
              write(iunit,*) pdbe_t*AU_TO_EV, vdos(b,1)/AU_TO_EV, vdos(b,2)/AU_TO_EV
           end do
        else
           do b=1, Param%DOS%Ne
              call Param__DOS__binEnergy(pdbe_t,b)
              write(iunit,*) pdbe_t*AU_TO_EV, vdos(b,1)/AU_TO_EV
           end do
        end if
     end if

     close(iunit)

  end if

  close(iunit)

  deallocate( vE )
  deallocate( vdos )

  call BandMatrix__deallocate( band )

  return
end subroutine Hamiltonian__calcDOS

subroutine Hamiltonian__calcMO
  use ac_misc_module
  use ac_mpi_module

  implicit none
  type(BandMatrix_type) :: band

  integer :: n_npao,n_spin

  integer :: spin
  integer :: k, m, l
  integer :: i1,i2,i3

  character(len=4)   :: spinlabel
  character(len=8)   :: klabel, mlabel
  character(len=128) :: fnamer, fnamei

  complex(8), allocatable :: temp(:)
  real(8), pointer :: waver(:,:,:), wavei(:,:,:)

  if( Param%Option%nspin < 4 ) then
     n_npao=Base%npao
     n_spin=Param%Option%nspin
  else
     n_npao=Base%npao*2
     n_spin=1
  end if

  open(unit=16,file=Param%Option%file_ac_tempout,position='append')
  write(16,*)
  write(16,*) '**************************************************************'
  write(16,*) '************ start calculation: molecule orbital'
  write(16,*) '**************************************************************'
  close(16)

  call BandMatrix__allocate( band )

  allocate( waver(Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc) )
  allocate( wavei(Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc) )

  allocate( temp(0:Base%npao-1) )

  do k=1, Param%MO%nK
     call BandMatrix__calc( band, Param%MO%vK(:,k) )
     call BandMatrix__solve( band, 0 )

     do spin=1, n_spin
        do m=1, n_npao
           if( Param%MO%method == "band_num" ) then
              if( m-1 < Param%MO%band_min-1 ) cycle
              if( Param%MO%band_max-1 < m ) cycle
           else if( Param%MO%method == "ho_lumo" ) then
              if( m-1 - Param%MO%band_min < 0 ) cycle
              if( m-1 - Param%MO%band_min < n_npao .and. &
                   band%E(m - Param%MO%band_min,spin) < Energy%Ef ) cycle
              if( m-1 - Param%MO%band_max >= n_npao ) cycle
              if( m-1 - Param%MO%band_max >= 0 .and. &
                   band%E(m - Param%MO%band_max,spin) > Energy%Ef ) cycle
           end if

           open(unit=16,file=Param%Option%file_ac_tempout,position='append')
           write(16,999) m+1,k,spin
999        format('                 ++++++ level:',i8,' (k=',i5,', s=',i3,')')
           close(16)

           if( .not. Param%Option%spin_polar ) then
              spinlabel = ""
           else if( spin==1 ) then
              spinlabel = ".up"
           else if( spin==2 ) then
              spinlabel = ".dw"
           end if
           write(klabel,'(a2i3.3)') ".k", k
           write(mlabel,'(a2i3.3)') ".m", m+1

           fnamei = trim(Param%MO%fbase) &
                // trim(spinlabel) // trim(klabel) // trim(mlabel)

           fnamer = trim(fnamei) &
                // '.real' // trim(Param%Option%field_format)
           fnamei = trim(fnamei) &
                // '.imag' // trim(Param%Option%field_format)

           if( Param%Option%nspin < 4 ) then
              if( m >= MPI%smat .and. m <= MPI%emat ) then
                 do l=1, Base%npao
                    temp(l)=band%H(l,m,spin)
                 end do
              else
                 do l=1, Base%npao
                    temp(l)=0.d0
                 end do
              end if
           else
              if( MPI%root ) then
                 if( m-1 < Base%npao ) then
                    do l=1, Base%npao
                       temp(l)=band%H(l,m,1)+band%H(l,m,2)
                    end do
                 else
                    do l=1, Base%npao
                       temp(l)=band%H(l,m-Base%npao,3)+band%H(l,m-Base%npao,4)
                    end do
                 end if
              else
                 do l=1, Base%npao
                    temp(l)=0.d0
                 end do
              end if
           end if
           call Base__calcWave( waver, wavei, temp, Param%MO%vK(:,k), Base%npao )

           if( MPI%root ) then
              call vector3d__save_mo( waver, fnamer )
              call vector3d__save_mo( wavei, fnamei )
           end if
        end do
     end do
  end do

  deallocate( waver, wavei )
  deallocate( temp )

  call BandMatrix__deallocate( band )

  return
end subroutine Hamiltonian__calcMO

subroutine Hamiltonian__deallocate
  use ac_misc_module
  use ac_mpi_module
  implicit none
  integer :: l, a, b

  if( associated(Hamiltonian%vAtomMatrix) ) then

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

     deallocate( Hamiltonian%vAtomMatrix )
  end if

  return
end subroutine Hamiltonian__deallocate

subroutine Hamiltonian__level__out(Eorb,Elat,Eint)
  use ac_misc_module
  use ac_mpi_module

  implicit none
  real(8), intent(in) :: Eorb,Elat,Eint

  integer, allocatable :: i_temp(:,:)
  integer :: j_temp,k,n,n1,spin
  integer :: n_npao,n_spin

  open(unit=60,file='energy.dat')
  write(60,'(a)') 'Fermi energy'
  write(60,'(a,f25.16,a,f29.16,a)') '     Ef =', Energy%Ef,' [au];',Energy%Ef*AU_TO_EV,' [eV]'
  write(60,*)
  write(60,'(a)') 'Energy (Etot = Eorb + Elat - Eint)'
  write(60,'(a,f25.16,a,f29.16,a)') '   Etot =', Eorb + Elat - Eint,' [au]:',(Eorb + Elat - Eint)*AU_TO_EV,' [eV]'
  write(60,'(a,f25.16,a,f29.16,a)') '   Eorb =', Eorb,' [au];',Eorb*AU_TO_EV,' [eV]'
  write(60,'(a,f25.16,a,f29.16,a)') '   Elat =', Elat,' [au];',Elat*AU_TO_EV,' [eV]'
  write(60,'(a,f25.16,a,f29.16,a)') '   Eint =', Eint,' [au];',Eint*AU_TO_EV,' [eV]'
  write(60,*)
  close(60)

  if( .not. Param%Option%spin_orbit ) then
     n_npao=Base%npao
     n_spin=Param%Option%nspin
  else
     n_npao=Base%npao*2
     n_spin=1
  end if
  allocate( i_temp(n_npao,n_spin) )
  do n=1, n_npao
     do spin=1, n_spin
        i_temp(n,spin)=n
     end do
  end do

  open(unit=60,file='level_au.dat')
  open(unit=61,file='level_ev.dat')
  write(60,'(a)') '     *********************************'
  write(60,'(a,f25.16,a)') '     ** Ef =', Energy%Ef,'     [au]'
  write(60,'(a)') '     *********************************'
  write(60,*)
  write(61,'(a)') '     *********************************'
  write(61,'(a,f25.16,a)') '     ** Ef =', Energy%Ef*AU_TO_EV,'     [eV]'
  write(61,'(a)') '     *********************************'
  write(61,*)
  do k=1, Param%SCF%nK
     write(60,'(a)') '     *********************************'
     write(60,'(a,3f15.6)') '     ** K =', Param%SCF%vK(:,k)
     write(60,'(a)') '     *********************************'
     write(61,'(a)') '     *********************************'
     write(61,'(a,3f15.6)') '     ** K =', Param%SCF%vK(:,k)
     write(61,'(a)') '     *********************************'
     if( .not. Param%Option%spin_orbit ) then
        write(60,'(a)') '          [au]:          up spin                  down spin'
        write(61,'(a)') '          [eV]:          up spin                  down spin'
     else
        write(60,'(a)') '          [au]:'
        write(61,'(a)') '          [eV]:'
     end if
     do spin=1, n_spin
        do n=1, n_npao
           do n1=n+1, n_npao
              if( Hamiltonian%vBandMatrix(k)%E(i_temp(n,spin),spin)  &
                   > Hamiltonian%vBandMatrix(k)%E(i_temp(n1,spin),spin) ) then
                 j_temp=i_temp(n,spin)
                 i_temp(n,spin)=i_temp(n1,spin)
                 i_temp(n1,spin)=j_temp
              end if
           end do
        end do
     end do
     if( .not. Param%Option%spin_orbit ) then
        if( Param%Option%nspin == 1 ) then
           do n=1, n_npao
              write(60,999) n+1-1,Hamiltonian%vBandMatrix(k)%E(i_temp(n,1),1) &
                   ,Hamiltonian%vBandMatrix(k)%E(i_temp(n,1),1)
              write(61,999) n+1-1,Hamiltonian%vBandMatrix(k)%E(i_temp(n,1),1)*AU_TO_EV &
                   ,Hamiltonian%vBandMatrix(k)%E(i_temp(n,1),1)*AU_TO_EV
           end do
        else
           do n=1, n_npao
              write(60,999) n+1-1,Hamiltonian%vBandMatrix(k)%E(i_temp(n,1),1) &
                   ,Hamiltonian%vBandMatrix(k)%E(i_temp(n,2),2)
              write(61,999) n+1-1,Hamiltonian%vBandMatrix(k)%E(i_temp(n,1),1)*AU_TO_EV &
                   ,Hamiltonian%vBandMatrix(k)%E(i_temp(n,2),2)*AU_TO_EV
           end do
        end if
     else
        do n=1, n_npao
           write(60,998) n+1-1,Hamiltonian%vBandMatrix(k)%E(i_temp(n,1),1)
           write(61,998) n+1-1,Hamiltonian%vBandMatrix(k)%E(i_temp(n,1),1)*AU_TO_EV
        end do
     end if
     write(60,*)
     write(61,*)
  end do
  close(60)
  close(61)

  deallocate( i_temp )
999 format('              ',i5,2f25.15)
998 format('              ',i5,f25.15)

  return
end subroutine Hamiltonian__level__out

subroutine Hamiltonian__showCharge
  use ac_misc_module
  use ac_mpi_module
  implicit none
  real(8), pointer :: CA(:,:),CA_sen(:,:),CA_rec(:,:)
  real(8) :: sum_u,sum_d

  integer :: l
  integer :: a, i1
  integer :: b, j1
  integer :: i_temp, ispin
  real(8) :: const

  if( Param%Option%spin_orbit ) then
     call Hamiltonian__showCharge_ls
     return
  end if

  allocate( CA(2,Param%Data%natom) )
  do a=1,Param%Data%natom
     do ispin=1, 2
        CA(ispin,a)=0.d0
     end do
  end do

  do l=0, Param%Cell%nL-1
     do a=MPI%isatom, MPI%ieatom
        do b=1, Param%Data%natom
           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)
                 do ispin=1, Param%Option%nspin
                    CA(ispin,a)=CA(ispin,a) &
                         +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDM(j1,i1,ispin) &
                         *Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)
                    if( l > 0 ) then
                       CA(ispin,b)=CA(ispin,b) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDM(j1,i1,ispin) &
                            *Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)
                    end if
                 end do
              end do
           end do
        end do
     end do
  end do

  if( Param%Option%nspin == 1 ) then
     do a=MPI%isatom, MPI%ieatom
        CA(1,a)=CA(1,a)*.5d0
        CA(2,a)=CA(1,a)
     end do
  end if

  allocate(CA_sen(2,Param%Data%natom))
  allocate(CA_rec(2,Param%Data%natom))
  do a=1,Param%Data%natom
     CA_sen(1,a)=CA(1,a)
     CA_sen(2,a)=CA(2,a)
     CA_rec(1,a)=0.d0
     CA_rec(2,a)=0.d0
  end do
  i_temp=2*Param%Data%natom
  call MPI_ALLREDUCE(CA_sen,CA_rec,i_temp,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,MPI%info)
  do a=1,Param%Data%natom
     CA(1,a)=CA_rec(1,a)
     CA(2,a)=CA_rec(2,a)
  end do
  deallocate(CA_sen)
  deallocate(CA_rec)

  if( MPI%root ) then
     sum_u=0.d0
     sum_d=0.d0
     open(unit=37,file='charge_per.dat')
     write(37,*) '--------------------------------------------------------------'
     write(37,*) '------------   Charge:'
     write(37,*) '--------------------------------------------------------------'
     write(37,*) '   number    up             down           total          diff'
     do a=1,Param%Data%natom
        write(37,980) a,CA(1,a),CA(2,a),CA(1,a)+CA(2,a),CA(1,a)-CA(2,a)
980     format(5x,i5,4f15.6)
        sum_u=sum_u+CA(1,a)
        sum_d=sum_d+CA(2,a)
     end do
     write(37,*)
     write(37,*) '--------------------------------------------------------------'
     write(37,*)
     write(37,*) '   TOTAL:    up             down           total          diff'
     write(37,981) sum_u,sum_d,sum_u+sum_d,sum_u-sum_d
     write(37,*) '--------------------------------------------------------------'
981  format(10x,4f15.6)
     close(37)
  end if

  if(associated(CA)) deallocate(CA)

  return
end subroutine Hamiltonian__showCharge

subroutine Hamiltonian__showCharge_ls
  use ac_misc_module
  use ac_mpi_module
  implicit none
  complex(8), pointer :: CA(:,:),CA_sen(:,:),CA_rec(:,:)
  real(8) :: sum_u,sum_d,sum_x,sum_y

  integer :: l
  integer :: a, i1
  integer :: b, j1
  integer :: i_temp, ispin
  real(8) :: const

  allocate( CA(4,Param%Data%natom) )
  do a=1,Param%Data%natom
     do ispin=1, 4
        CA(ispin,a)=dcmplx(0.d0,0.d0)
     end do
  end do
  const=0.5d0

  do l=0, Param%Cell%nL-1
     do a=MPI%isatom, MPI%ieatom
        do b=1, Param%Data%natom
           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)
                 do ispin=1, Param%Option%nspin
                    CA(ispin,a)=CA(ispin,a) &
                         +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDMLS(j1,i1,ispin) &
                         *Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1) * const
                    if( l > 0 ) then
                       CA(ispin,b)=CA(ispin,b) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%CDMLS(j1,i1,ispin) &
                            *Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1) * const
                    end if
                 end do
              end do
           end do
        end do
     end do
  end do

  allocate(CA_sen(4,Param%Data%natom))
  allocate(CA_rec(4,Param%Data%natom))
  do a=1,Param%Data%natom
     do ispin=1, Param%Option%nspin
        CA_sen(ispin,a)=CA(ispin,a)
        CA_rec(ispin,a)=dcmplx(0.d0,0.d0)
     end do
  end do
  i_temp=4*Param%Data%natom
  call MPI_ALLREDUCE(CA_sen,CA_rec,i_temp,MPI_DOUBLE_COMPLEX,MPI_SUM,MPI_COMM_WORLD,MPI%info)
  do a=1,Param%Data%natom
     do ispin=1, Param%Option%nspin
        CA(ispin,a)=CA_rec(ispin,a)
     end do
  end do
  deallocate(CA_sen)
  deallocate(CA_rec)

  do a=1,Param%Data%natom
     CA(1,a)=CA(1,a)+dconjg(CA(1,a))
     CA(2,a)=CA(2,a)+dconjg(CA(3,a))
     CA(3,a)=dconjg(CA(2,a))
     CA(4,a)=CA(4,a)+dconjg(CA(4,a))
  end do

  if( MPI%root ) then
     sum_u=0.d0
     sum_d=0.d0
     sum_x=0.d0
     sum_y=0.d0
     open(unit=37,file='charge_per.dat')
     write(37,*) '--------------------------------------------------------------'
     write(37,*) '------------   Charge:'
     write(37,*) '--------------------------------------------------------------'
     write(37,*) '   number    total          Mz             Mx             My'
     do a=1,Param%Data%natom
        write(37,980) a,dreal(CA(1,a)+CA(4,a)),dreal(CA(1,a)-CA(4,a))            &
             ,dreal(CA(2,a)+CA(3,a)),dimag(CA(2,a)-CA(3,a))
980     format(5x,i5,4f15.6)
        sum_u=sum_u+dreal(CA(1,a))
        sum_d=sum_d+dreal(CA(4,a))
        sum_x=sum_x+dreal(CA(2,a))
        sum_y=sum_y+dimag(CA(2,a))
     end do
     write(37,*)
     write(37,*) '--------------------------------------------------------------'
     write(37,*)
     write(37,*) '   TOTAL:    total          Sz             Sx             Sy'
     write(37,981) sum_u+sum_d,sum_u-sum_d,sum_x,sum_y
     write(37,*) '--------------------------------------------------------------'
981  format(10x,4f15.6)
     close(37)
  end if

  if(associated(CA)) deallocate(CA)

  return
end subroutine Hamiltonian__showCharge_ls

subroutine Hamiltonian__outdata2(vE,nE)
  use ac_misc_module

  implicit none
  integer :: nE
  real(8) :: vE( nE )
  real(8) :: e_min_level
  integer :: i1_do,i2_do,i3_do

  e_min_level=100000.d0
  do i1_do=1,nE
     if( e_min_level > vE(i1_do) ) then
        e_min_level = vE(i1_do)
     end if
  end do

  open(unit=36,file=Param%Option%fname_ascot_vd)

  write(36,*) Param%Option%nspin-1,Param%SCF%Nka,Param%SCF%Nkb,Param%SCF%Nkc
  write(36,*)
  write(36,*) Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc
  write(36,*)
  write(36,*) Param%Cell%La
  write(36,*) Param%Cell%Lb
  write(36,*) Param%Cell%Lc

  write(36,*)
  write(36,*) Energy%Ef,'     = Chemical Potential'
  write(36,*) e_min_level,'     = minimum energy'
  write(36,*)
  do i1_do=1,Param%Cell%Na
     do i2_do=1,Param%Cell%Nb
        do i3_do=1,Param%Cell%Nc
           write(36,991) Potential%dVhar(i1_do,i2_do,i3_do)
        end do
     end do
  end do
  write(36,*)
  do i1_do=1,Param%Cell%Na
     do i2_do=1,Param%Cell%Nb
        do i3_do=1,Param%Cell%Nc
           if( Param%Option%nspin-1 == 0 ) then
              write(36,991) Potential%Vtot(1,i1_do,i2_do,i3_do)
           else
              if( Param%Option%nspin-1 == 1 ) then
                 write(36,992) Potential%Vtot(1,i1_do,i2_do,i3_do) &
                      ,Potential%Vtot(2,i1_do,i2_do,i3_do)
              else
                 write(36,994) Potential%Vtot(1,i1_do,i2_do,i3_do) &
                      ,Potential%Vtot(2,i1_do,i2_do,i3_do) &
                      ,Potential%Vtot(3,i1_do,i2_do,i3_do) &
                      ,Potential%Vtot(4,i1_do,i2_do,i3_do)
              end if
           end if
        end do
     end do
  end do
  write(36,*)
  do i1_do=1,Param%Cell%Na
     do i2_do=1,Param%Cell%Nb
        do i3_do=1,Param%Cell%Nc
           if( Param%Option%nspin-1 == 0 ) then
              write(36,991) Density%rho(1,i1_do,i2_do,i3_do)*.5d0
           else
              if( Param%Option%nspin-1 == 1 ) then
                 write(36,992) Density%rho(1,i1_do,i2_do,i3_do) &
                      ,Density%rho(2,i1_do,i2_do,i3_do)
              else
                 write(36,994) Density%rhoLS(1,i1_do,i2_do,i3_do) &
                      ,Density%rhoLS(2,i1_do,i2_do,i3_do)
                 write(36,994) Density%rhoLS(3,i1_do,i2_do,i3_do) &
                      ,Density%rhoLS(4,i1_do,i2_do,i3_do)
              end if
           end if
        end do
     end do
  end do

  close(36)

994 format(4d25.15)
993 format(3d25.15)
992 format(2d25.15)
991 format(1d25.15)

  return
end subroutine Hamiltonian__outdata2

subroutine Hamiltonian__outdata3
  use ac_misc_module
  use ac_mpi_module

  implicit none
  type(Element_type), pointer :: elem
  real(8), parameter :: ene_scale=27.211396212d0
  real(8), parameter :: eps=1.d-15

  integer :: n,i_do,j_do,i1_do,i2_do,i3_do,i7_do,i_c,itemp1
  integer :: a,b,l,i1,j1
  real(8) :: temp_dd,temp_r,const

  integer :: ispin

  integer :: mat_max_ll,mat_max_rr,mat_max_cc,ele_num_ll,ele_num_rr
  integer :: num_hcc1,num_hcl1,num_hcr1
  integer :: num_hcc2,num_hcl2,num_hcr2
  integer :: num_scc,num_scl,num_scr
  integer :: num_h00_l1,num_h01_l1,num_h10_l1
  integer :: num_h00_l2,num_h01_l2,num_h10_l2
  integer :: num_s00_l,num_s01_l,num_s10_l
  integer :: num_h00_r1,num_h01_r1,num_h10_r1
  integer :: num_h00_r2,num_h01_r2,num_h10_r2
  integer :: num_s00_r,num_s01_r,num_s10_r

  integer, allocatable :: i_orb(:)

  complex(8), allocatable :: h_cc(:,:,:)
  complex(8), allocatable :: s_cc(:,:)
  complex(8), allocatable :: h_cl(:,:,:)
  complex(8), allocatable :: s_cl(:,:)
  complex(8), allocatable :: h_cr(:,:,:)
  complex(8), allocatable :: s_cr(:,:)

  complex(8), allocatable :: h_00l(:,:,:)
  complex(8), allocatable :: s_00l(:,:)
  complex(8), allocatable :: h_01l(:,:,:)
  complex(8), allocatable :: s_01l(:,:)
  complex(8), allocatable :: h_10l(:,:,:)
  complex(8), allocatable :: s_10l(:,:)

  complex(8), allocatable :: h_00r(:,:,:)
  complex(8), allocatable :: s_00r(:,:)
  complex(8), allocatable :: h_01r(:,:,:)
  complex(8), allocatable :: s_01r(:,:)
  complex(8), allocatable :: h_10r(:,:,:)
  complex(8), allocatable :: s_10r(:,:)

  integer :: num_sum_mat,i_cou
  complex(8), allocatable :: temp_sen(:)
  complex(8), allocatable :: temp_rec(:)

  if( Param%Option%spin_orbit ) then
     return
  end if

  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
     ispin=Param%Option%nspin-1
     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
     ispin=0
     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-1+1
     elem => Param__Data__getElement( Param%Data%vatom(a)%name )
     ele_num_rr=ele_num_rr+Param%Data%vatom(a)%Q
  end do

  allocate( h_01l(ispin+1,mat_max_ll,mat_max_ll) )
  allocate( s_01l(mat_max_ll,mat_max_ll) )
  allocate( h_10l(ispin+1,mat_max_ll,mat_max_ll) )
  allocate( s_10l(mat_max_ll,mat_max_ll) )

  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        do i3_do=1,ispin+1
           h_01l(i3_do,i2_do,i1_do)=dcmplx(0.d0,0.d0)
           h_10l(i3_do,i2_do,i1_do)=dcmplx(0.d0,0.d0)
        end do
        s_01l(i2_do,i1_do)=dcmplx(0.d0,0.d0)
        s_10l(i2_do,i1_do)=dcmplx(0.d0,0.d0)
     end do
  end do

  i1_do=i_orb(Param%Data%natom-Param%Data%natom_left)
  do a=1, Param%Data%natom_left
     if( a>=MPI%isatom .and. a<=MPI%ieatom ) then
        do b=Param%Data%natom-Param%Data%natom_left+1, Param%Data%natom-1+1
           do l=0, Param%Cell%nL-1
              if( .not. associated(Hamiltonian%vAtomMatrix(b,a,l)%Ptr) ) then
                 cycle
              end if
              if( l == 0 ) then
                 const=dcmplx(.5d0,0.d0)
              else
                 const=dcmplx(1.d0,0.d0)
              end if
              do i1=1, Base%vnpao(a)
                 do j1=1, Base%vnpao(b)
                    if( .not. Param%Option%spin_orbit ) then
                       do i3_do=1, ispin+1
                          h_01l(i3_do,i_orb(b)+j1,i_orb(a)-i1_do+i1) &
                               =h_01l(i3_do,i_orb(b)+j1,i_orb(a)-i1_do+i1) &
                               +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H(j1,i1,i3_do)*const,0.d0)
                       end do
                       s_01l(i_orb(b)+j1,i_orb(a)-i1_do+i1) &
                            =s_01l(i_orb(b)+j1,i_orb(a)-i1_do+i1) &
                            +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)*const,0.d0)
                    else
                       h_01l(1,(i_orb(b)+j1)*2-1,(i_orb(a)-i1_do+i1)*2-1) &
                            =h_01l(1,(i_orb(b)+j1)*2-1,(i_orb(a)-i1_do+i1)*2-1) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,1)*const
                       h_01l(1,(i_orb(b)+j1)*2-1,(i_orb(a)-i1_do+i1)*2) &
                            =h_01l(1,(i_orb(b)+j1)*2-1,(i_orb(a)-i1_do+i1)*2) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,2)*const
                       h_01l(1,(i_orb(b)+j1)*2,(i_orb(a)-i1_do+i1)*2-1) &
                            =h_01l(1,(i_orb(b)+j1)*2,(i_orb(a)-i1_do+i1)*2-1) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,3)*const
                       h_01l(1,(i_orb(b)+j1)*2,(i_orb(a)-i1_do+i1)*2) &
                            =h_01l(1,(i_orb(b)+j1)*2,(i_orb(a)-i1_do+i1)*2) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,4)*const
                       s_01l((i_orb(b)+j1)*2-1,(i_orb(a)-i1_do+i1)*2-1) &
                            =s_01l((i_orb(b)+j1)*2-1,(i_orb(a)-i1_do+i1)*2-1) &
                            +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)*const,0.d0)
                       s_01l((i_orb(b)+j1)*2,(i_orb(a)-i1_do+i1)*2) &
                            =s_01l((i_orb(b)+j1)*2,(i_orb(a)-i1_do+i1)*2) &
                            +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)*const,0.d0)
                    end if
                 end do
              end do
           end do
        end do
     end if
  end do
  do i_do=1,mat_max_ll
     do j_do=1,mat_max_ll
        do i1=1,ispin+1
           h_01l(i1,i_do,j_do)=h_01l(i1,i_do,j_do)*ene_scale
        end do
     end do
  end do

  i1_do=i_orb(Param%Data%natom-Param%Data%natom_left)
  do a=Param%Data%natom-Param%Data%natom_left+1, Param%Data%natom-1+1
     if( a>=MPI%isatom .and. a<=MPI%ieatom ) then
        do b=1, Param%Data%natom_left
           do l=0, Param%Cell%nL-1
              if( .not. associated(Hamiltonian%vAtomMatrix(b,a,l)%Ptr) ) then
                 cycle
              end if
              if( l == 0 ) then
                 const=dcmplx(.5d0,0.d0)
              else
                 const=dcmplx(1.d0,0.d0)
              end if
              do i1=1, Base%vnpao(a)
                 do j1=1, Base%vnpao(b)
                    if( .not. Param%Option%spin_orbit ) then
                       do i3_do=1, ispin+1
                          h_10l(i3_do,i_orb(b)-i1_do+j1,i_orb(a)+i1) &
                               =h_10l(i3_do,i_orb(b)-i1_do+j1,i_orb(a)+i1) &
                               +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H(j1,i1,i3_do)*const,0.d0)
                       end do
                       s_10l(i_orb(b)-i1_do+j1,i_orb(a)+i1) &
                            =s_10l(i_orb(b)-i1_do+j1,i_orb(a)+i1) &
                            +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)*const,0.d0)
                    else
                       h_10l(1,(i_orb(b)-i1_do+j1)*2-1,(i_orb(a)+i1)*2-1) &
                            =h_10l(1,(i_orb(b)-i1_do+j1)*2-1,(i_orb(a)+i1)*2-1) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,1)*const
                       h_10l(1,(i_orb(b)-i1_do+j1)*2-1,(i_orb(a)+i1)*2) &
                            =h_10l(1,(i_orb(b)-i1_do+j1)*2-1,(i_orb(a)+i1)*2) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,2)*const
                       h_10l(1,(i_orb(b)-i1_do+j1)*2,(i_orb(a)+i1)*2-1) &
                            =h_10l(1,(i_orb(b)-i1_do+j1)*2,(i_orb(a)+i1+1)*2-1) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,3)*const
                       h_10l(1,(i_orb(b)-i1_do+j1)*2,(i_orb(a)+i1)*2) &
                            =h_10l(1,(i_orb(b)-i1_do+j1)*2,(i_orb(a)+i1)*2) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,4)*const
                       s_10l((i_orb(b)-i1_do+j1)*2-1,(i_orb(a)+i1)*2-1) &
                            =s_10l((i_orb(b)-i1_do+j1)*2-1,(i_orb(a)+i1)*2-1) &
                            +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)*const,0.d0)
                       s_10l((i_orb(b)-i1_do+j1)*2,(i_orb(a)+i1)*2) &
                            =s_10l((i_orb(b)-i1_do+j1)*2,(i_orb(a)+i1)*2) &
                            +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)*const,0.d0)
                    end if
                 end do
              end do
           end do
        end do
     end if
  end do
  do i_do=1,mat_max_ll
     do j_do=1,mat_max_ll
        do i1=1,ispin+1
           h_10l(i1,i_do,j_do)=h_10l(i1,i_do,j_do)*ene_scale
        end do
     end do
  end do


  allocate( h_01r(ispin+1,mat_max_rr,mat_max_rr) )
  allocate( s_01r(mat_max_rr,mat_max_rr) )
  allocate( h_10r(ispin+1,mat_max_rr,mat_max_rr) )
  allocate( s_10r(mat_max_rr,mat_max_rr) )

  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        do i3_do=1,ispin+1
           h_01r(i3_do,i2_do,i1_do)=dcmplx(0.d0,0.d0)
           h_10r(i3_do,i2_do,i1_do)=dcmplx(0.d0,0.d0)
        end do
        s_01r(i2_do,i1_do)=dcmplx(0.d0,0.d0)
        s_10r(i2_do,i1_do)=dcmplx(0.d0,0.d0)
     end do
  end do

  i1_do=i_orb(Param%Data%natom-Param%Data%natom_right)
  do a=Param%Data%natom-Param%Data%natom_right+1, Param%Data%natom-1+1
     if( a>=MPI%isatom .and. a<=MPI%ieatom ) then
        do b=1, Param%Data%natom_right
           do l=0, Param%Cell%nL-1
              if( .not. associated(Hamiltonian%vAtomMatrix(b,a,l)%Ptr) ) then
                 cycle
              end if
              if( l == 0 ) then
                 const=dcmplx(.5d0,0.d0)
              else
                 const=dcmplx(1.d0,0.d0)
              end if
              do i1=1, Base%vnpao(a)
                 do j1=1, Base%vnpao(b)
                    if( .not. Param%Option%spin_orbit ) then
                       do i3_do=1, ispin+1
                          h_01r(i3_do,i_orb(b)-i1_do+j1,i_orb(a)+i1) &
                               =h_01r(i3_do,i_orb(b)-i1_do+j1,i_orb(a)+i1) &
                               +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H(j1,i1,i3_do)*const,0.d0)
                       end do
                       s_01r(i_orb(b)-i1_do+j1,i_orb(a)+i1) &
                            =s_01r(i_orb(b)-i1_do+j1,i_orb(a)+i1) &
                            +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)*const,0.d0)
                    else
                       h_01r(1,(i_orb(b)-i1_do+j1)*2-1,(i_orb(a)+i1)*2-1) &
                            =h_01r(1,(i_orb(b)-i1_do+j1)*2-1,(i_orb(a)+i1)*2-1) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,1)*const
                       h_01r(1,(i_orb(b)-i1_do+j1)*2-1,(i_orb(a)+i1)*2) &
                            =h_01r(1,(i_orb(b)-i1_do+j1)*2-1,(i_orb(a)+i1)*2) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,2)*const
                       h_01r(1,(i_orb(b)-i1_do+j1)*2,(i_orb(a)+i1)*2-1) &
                            =h_01r(1,(i_orb(b)-i1_do+j1+1)*2,(i_orb(a)+i1+1)*2-1) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,3)*const
                       h_01r(1,(i_orb(b)-i1_do+j1)*2,(i_orb(a)+i1)*2) &
                            =h_01r(1,(i_orb(b)-i1_do+j1)*2,(i_orb(a)+i1)*2) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,4)*const
                       s_01r((i_orb(b)-i1_do+j1)*2-1,(i_orb(a)+i1)*2-1) &
                            =s_01r((i_orb(b)-i1_do+j1)*2-1,(i_orb(a)+i1)*2-1) &
                            +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)*const,0.d0)
                       s_01r((i_orb(b)-i1_do+j1)*2,(i_orb(a)+i1)*2) &
                            =s_01r((i_orb(b)-i1_do+j1)*2,(i_orb(a)+i1)*2) &
                            +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)*const,0.d0)
                    end if
                 end do
              end do
           end do
        end do
     end if
  end do
  do i_do=1,mat_max_rr
     do j_do=1,mat_max_rr
        do i1=1,ispin+1
           h_01r(i1,i_do,j_do)=h_01r(i1,i_do,j_do)*ene_scale
        end do
     end do
  end do

  i1_do=i_orb(Param%Data%natom-Param%Data%natom_right)
  do a=1, Param%Data%natom_right
     if( a>=MPI%isatom .and. a<=MPI%ieatom ) then
        do b=Param%Data%natom-Param%Data%natom_right+1, Param%Data%natom-1+1
           do l=0, Param%Cell%nL-1
              if( .not. associated(Hamiltonian%vAtomMatrix(b,a,l)%Ptr) ) then
                 cycle
              end if
              if( l == 0 ) then
                 const=dcmplx(.5d0,0.d0)
              else
                 const=dcmplx(1.d0,0.d0)
              end if
              do i1=1, Base%vnpao(a)
                 do j1=1, Base%vnpao(b)
                    if( .not. Param%Option%spin_orbit ) then
                       do i3_do=1, ispin+1
                          h_10r(i3_do,i_orb(b)+j1,i_orb(a)-i1_do+i1) &
                               =h_10r(i3_do,i_orb(b)+j1,i_orb(a)-i1_do+i1) &
                               +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H(j1,i1,i3_do)*const,0.d0)
                       end do
                       s_10r(i_orb(b)+j1,i_orb(a)-i1_do+i1) &
                            =s_10r(i_orb(b)+j1,i_orb(a)-i1_do+i1) &
                            +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)*const,0.d0)
                    else
                       h_10r(1,(i_orb(b)+j1)*2-1,(i_orb(a)-i1_do+i1)*2-1) &
                            =h_10r(1,(i_orb(b)+j1)*2-1,(i_orb(a)-i1_do+i1)*2-1) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,1)*const
                       h_10r(1,(i_orb(b)+j1)*2-1,(i_orb(a)-i1_do+i1)*2) &
                            =h_10r(1,(i_orb(b)+j1)*2-1,(i_orb(a)-i1_do+i1)*2) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,2)*const
                       h_10r(1,(i_orb(b)+j1)*2,(i_orb(a)-i1_do+i1)*2-1) &
                            =h_10r(1,(i_orb(b)+j1)*2,(i_orb(a)-i1_do+i1)*2-1) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,3)*const
                       h_10r(1,(i_orb(b)+j1)*2,(i_orb(a)-i1_do+i1)*2) &
                            =h_10r(1,(i_orb(b)+j1)*2,(i_orb(a)-i1_do+i1)*2) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,4)*const
                       s_10r((i_orb(b)+j1)*2-1,(i_orb(a)-i1_do+i1)*2-1) &
                            =s_10r((i_orb(b)+j1)*2-1,(i_orb(a)-i1_do+i1)*2-1) &
                            +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)*const,0.d0)
                       s_10r((i_orb(b)+j1)*2,(i_orb(a)-i1_do+i1)*2) &
                            =s_10r((i_orb(b)+j1)*2,(i_orb(a)-i1_do+i1)*2) &
                            +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)*const,0.d0)
                    end if
                 end do
              end do
           end do
        end do
     end if
  end do
  do i_do=1,mat_max_rr
     do j_do=1,mat_max_rr
        do i1=1,ispin+1
           h_10r(i1,i_do,j_do)=h_10r(i1,i_do,j_do)*ene_scale
        end do
     end do
  end do

  allocate( h_cc(ispin+1,mat_max_cc,mat_max_cc) )
  allocate( s_cc(mat_max_cc,mat_max_cc) )
  allocate( h_cl(ispin+1,mat_max_ll,mat_max_ll) )
  allocate( s_cl(mat_max_ll,mat_max_ll) )
  allocate( h_cr(ispin+1,mat_max_rr,mat_max_rr) )
  allocate( s_cr(mat_max_rr,mat_max_rr) )

  do i_do=1,mat_max_cc
     do j_do=1,mat_max_cc
        do i1=1,ispin+1
           h_cc(i1,i_do,j_do)=dcmplx(0.d0,0.d0)
        end do
        s_cc(i_do,j_do)=dcmplx(0.d0,0.d0)
     end do
  end do

  do a=1, Param%Data%natom
     if( a>=MPI%isatom .and. a<=MPI%ieatom ) then
        do b=1, Param%Data%natom
           if( a <= Param%Data%natom_left &
                .and. b > Param%Data%natom-Param%Data%natom_right ) then
              cycle
           end if
           if( b <= Param%Data%natom_left &
                .and. a > Param%Data%natom-Param%Data%natom_right ) then
              cycle
           end if
           do l=0, Param%Cell%nL-1
              if( .not. associated(Hamiltonian%vAtomMatrix(b,a,l)%Ptr) ) then
                 cycle
              end if
              if( l == 0 ) then
                 const=dcmplx(.5d0,0.d0)
              else
                 const=dcmplx(1.d0,0.d0)
              end if
              do i1=1, Base%vnpao(a)
                 do j1=1, Base%vnpao(b)
                    if( .not. Param%Option%spin_orbit ) then
                       do i3_do=1, ispin+1
                          h_cc(i3_do,i_orb(b)+j1,i_orb(a)+i1) &
                               =h_cc(i3_do,i_orb(b)+j1,i_orb(a)+i1) &
                               +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%H(j1,i1,i3_do)*const,0.d0)
                       end do
                       s_cc(i_orb(b)+j1,i_orb(a)+i1) &
                            =s_cc(i_orb(b)+j1,i_orb(a)+i1) &
                            +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)*const,0.d0)
                    else
                       h_cc(1,(i_orb(b)+j1)*2-1,(i_orb(a)+i1)*2-1) &
                            =h_cc(1,(i_orb(b)+j1)*2-1,(i_orb(a)+i1)*2-1) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,1)*const
                       h_cc(1,(i_orb(b)+j1)*2-1,(i_orb(a)+i1)*2) &
                            =h_cc(1,(i_orb(b)+j1)*2-1,(i_orb(a)+i1)*2) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,2)*const
                       h_cc(1,(i_orb(b)+j1)*2,(i_orb(a)+i1)*2-1) &
                            =h_cc(1,(i_orb(b)+j1)*2,(i_orb(a)+i1)*2-1) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,3)*const
                       h_cc(1,(i_orb(b)+j1)*2,(i_orb(a)+i1)*2) &
                            =h_cc(1,(i_orb(b)+j1)*2,(i_orb(a)+i1)*2) &
                            +Hamiltonian%vAtomMatrix(b,a,l)%Ptr%HLS(j1,i1,4)*const
                       s_cc((i_orb(b)+j1)*2-1,(i_orb(a)+i1)*2-1) &
                            =s_cc((i_orb(b)+j1)*2-1,(i_orb(a)+i1)*2-1) &
                            +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)*const,0.d0)
                       s_cc((i_orb(b)+j1)*2,(i_orb(a)+i1)*2) &
                            =s_cc((i_orb(b)+j1)*2,(i_orb(a)+i1)*2) &
                            +dcmplx(Hamiltonian%vAtomMatrix(b,a,l)%Ptr%S(j1,i1)*const,0.d0)
                    end if
                 end do
              end do
           end do
        end do
     end if
  end do
  do i_do=1,mat_max_cc
     do j_do=1,mat_max_cc
        do i1=1,ispin+1
           h_cc(i1,i_do,j_do)=h_cc(i1,i_do,j_do)*ene_scale
        end do
     end do
  end do

  num_sum_mat=1*(ispin+2)*mat_max_cc*mat_max_cc &
       +2*(ispin+2)*mat_max_ll*mat_max_ll &
       +2*(ispin+2)*mat_max_rr*mat_max_rr
  allocate( temp_sen(num_sum_mat) )
  allocate( temp_rec(num_sum_mat) )
  do i_do=1,num_sum_mat
     temp_sen(i_do)=dcmplx(0.d0,0.d0)
     temp_rec(i_do)=dcmplx(0.d0,0.d0)
  end do
  i_cou=0
  do i1_do=1,mat_max_cc
     do i2_do=1,mat_max_cc
        do i3_do=1,ispin+1
           i_cou=i_cou+1
           temp_sen(i_cou)=h_cc(i3_do,i2_do,i1_do)
        end do
     end do
  end do
  do i1_do=1,mat_max_cc
     do i2_do=1,mat_max_cc
        i_cou=i_cou+1
        temp_sen(i_cou)=s_cc(i2_do,i1_do)
     end do
  end do

  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        do i3_do=1,ispin+1
           i_cou=i_cou+1
           temp_sen(i_cou)=h_01l(i3_do,i2_do,i1_do)
        end do
     end do
  end do
  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        i_cou=i_cou+1
        temp_sen(i_cou)=s_01l(i2_do,i1_do)
     end do
  end do
  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        do i3_do=1,ispin+1
           i_cou=i_cou+1
           temp_sen(i_cou)=h_10l(i3_do,i2_do,i1_do)
        end do
     end do
  end do
  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        i_cou=i_cou+1
        temp_sen(i_cou)=s_10l(i2_do,i1_do)
     end do
  end do

  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        do i3_do=1,ispin+1
           i_cou=i_cou+1
           temp_sen(i_cou)=h_01r(i3_do,i2_do,i1_do)
        end do
     end do
  end do
  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        i_cou=i_cou+1
        temp_sen(i_cou)=s_01r(i2_do,i1_do)
     end do
  end do
  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        do i3_do=1,ispin+1
           i_cou=i_cou+1
           temp_sen(i_cou)=h_10r(i3_do,i2_do,i1_do)
        end do
     end do
  end do
  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        i_cou=i_cou+1
        temp_sen(i_cou)=s_10r(i2_do,i1_do)
     end do
  end do

  call MPI_ALLREDUCE(temp_sen,temp_rec,num_sum_mat,MPI_DOUBLE_COMPLEX,MPI_SUM,MPI_COMM_WORLD,MPI%info)

  i_cou=0
  do i1_do=1,mat_max_cc
     do i2_do=1,mat_max_cc
        do i3_do=1,ispin+1
           i_cou=i_cou+1
           h_cc(i3_do,i2_do,i1_do)=temp_rec(i_cou)
        end do
     end do
  end do
  do i1_do=1,mat_max_cc
     do i2_do=1,mat_max_cc
        i_cou=i_cou+1
        s_cc(i2_do,i1_do)=temp_rec(i_cou)
     end do
  end do
  do i3_do=1,mat_max_cc
     do i2_do=i3_do,mat_max_cc
        do i1_do=1,ispin+1
           h_cc(i1_do,i2_do,i3_do)=h_cc(i1_do,i2_do,i3_do)                          &
                +dconjg(h_cc(i1_do,i3_do,i2_do))
           h_cc(i1_do,i3_do,i2_do)=dconjg(h_cc(i1_do,i2_do,i3_do))
        end do
        s_cc(i2_do,i3_do)=s_cc(i2_do,i3_do)+dconjg(s_cc(i3_do,i2_do))
        s_cc(i3_do,i2_do)=dconjg(s_cc(i2_do,i3_do))
     end do
  end do

  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        do i3_do=1,ispin+1
           i_cou=i_cou+1
           h_01l(i3_do,i2_do,i1_do)=temp_rec(i_cou)
        end do
     end do
  end do
  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        i_cou=i_cou+1
        s_01l(i2_do,i1_do)=temp_rec(i_cou)
     end do
  end do

  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        do i3_do=1,ispin+1
           i_cou=i_cou+1
           h_10l(i3_do,i2_do,i1_do)=temp_rec(i_cou)
        end do
     end do
  end do
  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        i_cou=i_cou+1
        s_10l(i2_do,i1_do)=temp_rec(i_cou)
     end do
  end do
  do i3_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        do i1_do=1,ispin+1
           h_10l(i1_do,i2_do,i3_do)=h_10l(i1_do,i2_do,i3_do)                          &
                +dconjg(h_01l(i1_do,i3_do,i2_do))
           h_01l(i1_do,i3_do,i2_do)=dconjg(h_10l(i1_do,i2_do,i3_do))
        end do
        s_10l(i2_do,i3_do)=s_10l(i2_do,i3_do)+dconjg(s_01l(i3_do,i2_do))
        s_01l(i3_do,i2_do)=dconjg(s_10l(i2_do,i3_do))
     end do
  end do

  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        do i3_do=1,ispin+1
           i_cou=i_cou+1
           h_01r(i3_do,i2_do,i1_do)=temp_rec(i_cou)
        end do
     end do
  end do
  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        i_cou=i_cou+1
        s_01r(i2_do,i1_do)=temp_rec(i_cou)
     end do
  end do

  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        do i3_do=1,ispin+1
           i_cou=i_cou+1
           h_10r(i3_do,i2_do,i1_do)=temp_rec(i_cou)
        end do
     end do
  end do
  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        i_cou=i_cou+1
        s_10r(i2_do,i1_do)=temp_rec(i_cou)
     end do
  end do
  do i3_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        do i1_do=1,ispin+1
           h_10r(i1_do,i2_do,i3_do)=h_10r(i1_do,i2_do,i3_do)                          &
                +dconjg(h_01r(i1_do,i3_do,i2_do))
           h_01r(i1_do,i3_do,i2_do)=dconjg(h_10r(i1_do,i2_do,i3_do))
        end do
        s_10r(i2_do,i3_do)=s_10r(i2_do,i3_do)+dconjg(s_01r(i3_do,i2_do))
        s_01r(i3_do,i2_do)=dconjg(s_10r(i2_do,i3_do))
     end do
  end do

  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        do i3_do=1,ispin+1
           h_cl(i3_do,i2_do,i1_do)=h_01l(i3_do,i2_do,i1_do)
        end do
        s_cl(i2_do,i1_do)=s_01l(i2_do,i1_do)
     end do
  end do

  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        do i3_do=1,ispin+1
           h_cr(i3_do,i2_do,i1_do)=h_01r(i3_do,i2_do,i1_do)
        end do
        s_cr(i2_do,i1_do)=s_01r(i2_do,i1_do)
     end do
  end do

  deallocate( temp_sen )
  deallocate( temp_rec )

  if(MPI%root) then

     num_hcc1=0
     num_hcc2=0
     do i1_do=1,mat_max_cc
        do i2_do=1,mat_max_cc
           if( cdabs(h_cc(1,i1_do,i2_do)) > eps ) then
              num_hcc1=num_hcc1+1
           end if
           if( ispin == 1 ) then
              if( cdabs(h_cc(2,i1_do,i2_do)) > eps ) then
                 num_hcc2=num_hcc2+1
              end if
           end if
        end do
     end do
     num_scc=0
     do i1_do=1,mat_max_cc
        do i2_do=1,mat_max_cc
           if( cdabs(s_cc(i1_do,i2_do)) > eps ) then
              num_scc=num_scc+1
           end if
        end do
     end do

     num_hcl1=0
     num_hcl2=0
     do i1_do=1,mat_max_ll
        do i2_do=1,mat_max_ll
           if( cdabs(h_cl(1,i1_do,i2_do)) > eps ) then
              num_hcl1=num_hcl1+1
           end if
           if( ispin == 1 ) then
              if( cdabs(h_cl(2,i1_do,i2_do)) > eps ) then
                 num_hcl2=num_hcl2+1
              end if
           end if
        end do
     end do
     num_scl=0
     do i1_do=1,mat_max_ll
        do i2_do=1,mat_max_ll
           if( cdabs(s_cl(i1_do,i2_do)) > eps ) then
              num_scl=num_scl+1
           end if
        end do
     end do

     num_hcr1=0
     num_hcr2=0
     do i1_do=1,mat_max_rr
        do i2_do=1,mat_max_rr
           if( cdabs(h_cr(1,i1_do,i2_do)) > eps ) then
              num_hcr1=num_hcr1+1
           end if
           if( ispin == 1 ) then
              if( cdabs(h_cr(2,i1_do,i2_do)) > eps ) then
                 num_hcr2=num_hcr2+1
              end if
           end if
        end do
     end do
     num_scr=0
     do i1_do=1,mat_max_rr
        do i2_do=1,mat_max_rr
           if( cdabs(s_cr(i1_do,i2_do)) > eps ) then
              num_scr=num_scr+1
           end if
        end do
     end do

     open(unit=16,file=Param%Option%fname_accel_c)

     write(16,*) mat_max_ll,mat_max_cc,mat_max_rr
     write(16,*) ispin
     write(16,*) num_hcc1,num_hcc2,num_scc
     write(16,*) num_hcl1,num_hcl2,num_scl
     write(16,*) num_hcr1,num_hcr2,num_scr

     do i7_do=1,ispin+1
        write(16,*) '                      Hamiltonian',i7_do
        itemp1=0
        do i1_do=1,mat_max_cc
           do i2_do=1,mat_max_cc
              if( cdabs(h_cc(i7_do,i1_do,i2_do)) > eps ) then
                 itemp1=itemp1+1
                 write(16,999) itemp1,i1_do,i2_do,h_cc(i7_do,i1_do,i2_do)
              end if
           end do
        end do
     end do
     write(16,*) '                      Overlap'
     itemp1=0
     do i1_do=1,mat_max_cc
        do i2_do=1,mat_max_cc
           if( cdabs(s_cc(i1_do,i2_do)) > eps ) then
              itemp1=itemp1+1
              write(16,999) itemp1,i1_do,i2_do,s_cc(i1_do,i2_do)
           end if
        end do
     end do

     do i7_do=1,ispin+1
        write(16,*) '                      Hamiltonian',i7_do
        itemp1=0
        do i1_do=1,mat_max_ll
           do i2_do=1,mat_max_ll
              if( cdabs(h_cl(i7_do,i1_do,i2_do)) > eps ) then
                 itemp1=itemp1+1
                 write(16,999) itemp1,i1_do,i2_do,h_cl(i7_do,i1_do,i2_do)
              end if
           end do
        end do
     end do
     write(16,*) '                      Overlap'
     itemp1=0
     do i1_do=1,mat_max_ll
        do i2_do=1,mat_max_ll
           if( cdabs(s_cl(i1_do,i2_do)) > eps ) then
              itemp1=itemp1+1
              write(16,999) itemp1,i1_do,i2_do,s_cl(i1_do,i2_do)
           end if
        end do
     end do

     do i7_do=1,ispin+1
        write(16,*) '                      Hamiltonian',i7_do
        itemp1=0
        do i1_do=1,mat_max_rr
           do i2_do=1,mat_max_rr
              if( cdabs(h_cr(i7_do,i1_do,i2_do)) > eps ) then
                 itemp1=itemp1+1
                 write(16,999) itemp1,mat_max_cc-mat_max_rr+i1_do,i2_do &
                      ,h_cr(i7_do,i1_do,i2_do)
              end if
           end do
        end do
     end do
     write(16,*) '                      Overlap'
     itemp1=0
     do i1_do=1,mat_max_rr
        do i2_do=1,mat_max_rr
           if( cdabs(s_cr(i1_do,i2_do)) > eps ) then
              itemp1=itemp1+1
              write(16,999) itemp1,mat_max_cc-mat_max_rr+i1_do,i2_do &
                   ,s_cr(i1_do,i2_do)
           end if
        end do
     end do

     close(16)

  end if

  deallocate( h_cc )
  deallocate( s_cc )
  deallocate( h_cl )
  deallocate( s_cl )
  deallocate( h_cr )
  deallocate( s_cr )

  deallocate( h_01r )
  deallocate( s_01r )
  deallocate( h_10r )
  deallocate( s_10r )

  deallocate( h_01l )
  deallocate( s_01l )
  deallocate( h_10l )
  deallocate( s_10l )

  deallocate( i_orb )

999 format(i10,i10,i10,d28.19,d28.19)

  return
end subroutine Hamiltonian__outdata3
