module m_CD_Mag_Moment
! $Id: m_CD_Mag_Moment.f90 376 2014-06-17 07:48:31Z jkoga $
  use m_Control_Parameters,    only : noncol, ndim_magmom, kimg, iprimagmom, ON, OFF
  use m_Const_Parameters,     only : DP, PAI4, Bohr

  use m_Ionic_System,         only : ntyp, natm, ityp, pos, cps, &
       &                             magmom_local_now, iatomn
  use m_Crystal_Structure,    only : rltv, altv

  use m_PlaneWaveBasisSet,    only : ngabc, kgp
  use m_Parallelization,      only : ista_kngp, iend_kngp, ierr, npes, mype, &
       &                             mpi_comm_group
  use m_PseudoPotential,      only : dl2p, ilmt

  use m_Charge_Density,       only : chgq_l, hsr

  use m_Files,                only : nfout

  use m_Crystal_Structure,   only : sw_magnetic_constraint
  use m_Control_Parameters,  only : sw_modified_TFW_functional

  implicit none

  include 'mpif.h'
!  integer istatus(mpi_status_size)

  integer :: sw_monitor_atomcharge = OFF

  real(kind=DP), allocatable :: rad_cov(:)
  real(kind=DP), allocatable :: RhoMag_on_atom(:,:)

  real(kind=DP) :: rad_cov_default(120)
contains
  
  subroutine m_CD_set_sw_monitor_atomcharge
    if ( noncol ) then
       sw_monitor_atomcharge = ON
    else
       if ( sw_magnetic_constraint == ON ) then
          sw_monitor_atomcharge = ON
       endif
    endif

    if ( sw_modified_TFW_functional == ON ) then
       sw_monitor_atomcharge = ON
    endif

  end subroutine m_CD_set_sw_monitor_atomcharge

  subroutine m_CD_alloc_rad_cov
    if ( .not. allocated( rad_cov) ) allocate( rad_cov(natm) )
    rad_cov = 0.0d0
  end subroutine m_CD_alloc_rad_cov

  subroutine m_CD_set_rad_cov_default
    integer :: ia, it, inum

! -------------------
!  Ref. "Molecular Single-Bond Covalent Radii for Elements 1-118". 
!        Chemistry: A European Journal 15 (2009) 186.
! -------------------

    call set_table_rad_cov(   1,  32,  46, 133, 102,  85,  75,  71,  63,  64,  67 )
    call set_table_rad_cov(  11, 155, 139, 126, 116, 111, 103,  99,  96, 196, 171 )
    call set_table_rad_cov(  21, 148, 136, 134, 122, 119, 116, 111, 110, 112, 118 )
    call set_table_rad_cov(  31, 124, 124, 121, 116, 114, 117, 210, 185, 163, 154 )
    call set_table_rad_cov(  41, 147, 138, 128, 125, 125, 120, 128, 136, 142, 140 )
    call set_table_rad_cov(  51, 140, 136, 133, 131, 232, 196, 180, 163, 176, 174 )
    call set_table_rad_cov(  61, 173, 172, 168, 169, 168, 167, 166, 165, 164, 170 )
    call set_table_rad_cov(  71, 162, 152, 146, 137, 131, 129, 122, 123, 124, 133 )
    call set_table_rad_cov(  81, 144, 144, 151, 145, 147, 142, 223, 201, 186, 175 )
    call set_table_rad_cov(  91, 169, 170, 171, 172, 166, 166, 166, 168, 165, 167 )
    call set_table_rad_cov( 101, 173, 176, 161, 157, 149, 143, 141, 134, 129, 128 )
    call set_table_rad_cov( 111, 121, 122, 136, 143, 162, 175, 165, 157, 500, 500 )

    call convert_unit_to_bohr

  contains

    subroutine convert_unit_to_bohr
      rad_cov_default = rad_cov_default / 1.0D2 / Bohr  
                                 ! Note : original data is in the unit of pm.
    end subroutine convert_unit_to_bohr

    subroutine set_table_rad_cov( istart, d1, d2, d3, d4, d5, d6, d7, d8, d9, d10 )
      integer, intent(in) :: istart
      integer, intent(in) :: d1, d2, d3, d4, d5, d6, d7, d8, d9, d10

      rad_cov_default( istart    ) = dble(d1)
      rad_cov_default( istart +1 ) = dble(d2)
      rad_cov_default( istart +2 ) = dble(d3)
      rad_cov_default( istart +3 ) = dble(d4)
      rad_cov_default( istart +4 ) = dble(d5)
      rad_cov_default( istart +5 ) = dble(d6)
      rad_cov_default( istart +6 ) = dble(d7)
      rad_cov_default( istart +7 ) = dble(d8)
      rad_cov_default( istart +8 ) = dble(d9)
      rad_cov_default( istart +9 ) = dble(d10)
    end subroutine set_table_rad_cov

  end subroutine m_CD_set_rad_cov_default

  subroutine m_CD_alloc_RhoMag_on_atom
    if ( .not. allocated( RhoMag_on_atom) ) allocate( RhoMag_on_atom(natm,ndim_magmom) )
    RhoMag_on_atom = 0.0d0
  end subroutine m_CD_alloc_RhoMag_on_atom

  subroutine m_CD_set_rad_cov_now
    integer :: ia, ja, it1, it2, inum
    integer :: nx, ny, nz

    real(kind=DP) :: x1, y1, z1, dist
    real(kind=DP) :: c1, ctmp
    real(kind=DP), allocatable :: dist_min_among_atomtypes(:,:)

    logical, save :: First = .true.

    if ( First ) then
       Do ia=1, natm
          it1 = ityp(ia)
          inum = iatomn(it1)
          rad_cov(ia) = rad_cov_default(inum)
       End do
       First = .false.
    endif

    if ( .not. allocated(dist_min_among_atomtypes) ) then
       allocate( dist_min_among_atomtypes(ntyp,ntyp) )
    endif
    dist_min_among_atomtypes = 10.0d0

    Do ia=1, natm-1
       it1 = ityp(ia)
       Do ja =ia+1, natm
          it2 = ityp(ja)
!
          c1 = rad_cov(ia) + rad_cov(ja)

          Do nx=-1, 1
             Do ny=-1, 1
                Do nz=-1, 1
                   x1 = cps(ja,1) -cps(ia,1) +altv(1,1)*nx +altv(1,2)*ny +altv(1,3)*nz
                   y1 = cps(ja,2) -cps(ia,2) +altv(2,1)*nx +altv(2,2)*ny +altv(2,3)*nz
                   z1 = cps(ja,3) -cps(ia,3) +altv(3,1)*nx +altv(3,2)*ny +altv(3,3)*nz
!
                   dist = sqrt( x1**2 +y1**2 +z1**2 )
                   if ( dist < c1 ) then
                      ctmp = dist /c1
                      rad_cov(ia) = rad_cov(ia) *ctmp
                      rad_cov(ja) = rad_cov(ja) *ctmp
                   endif
                End do
             End do
          End do
       End do
    End Do

    if ( iprimagmom >= 3 ) then
       write(nfout,*) '! ------ info : Rad_cov ------ '
       write(nfout,*) '  atmo no.   rad_cov '
       Do ia=1, natm
          write(nfout,'(I7,F15.8)')   ia, rad_cov(ia)
       End do
       write(nfout,*) '! ---------------------------- '
    endif

  end subroutine m_CD_set_rad_cov_now

  subroutine m_CD_calc_ChgMagMom_in_sphere
    integer :: i, ia, is, it, ist
    real(kind=DP) :: rad1, fac1r, fac1i, fac2
    real(kind=DP) :: VecG(3), normG, normG3, gr, d1

    real(kind=DP), allocatable :: zfcos(:), zfsin(:)
    real(kind=DP), allocatable :: RhoMag_on_atom_mpi(:,:)

    RhoMag_on_atom = 0.0d0

    allocate(zfcos(ista_kngp:iend_kngp)); zfcos = 0.d0
    allocate(zfsin(ista_kngp:iend_kngp)); zfsin = 0.d0

    Do ia=1, natm
       it = ityp(ia)
       rad1 = rad_cov(ia)

       call calc_phase2( natm, pos, ia, kgp, ngabc, ista_kngp, iend_kngp, &
            &            zfcos, zfsin )

       if ( ista_kngp == 1 ) then
          ist = 2
       else
          ist = ista_kngp
       endif

       Do i=ist, iend_kngp

          VecG(1) = rltv(1,1)*ngabc(i,1) +rltv(1,2)*ngabc(i,2) +rltv(1,3)*ngabc(i,3)
          VecG(2) = rltv(2,1)*ngabc(i,1) +rltv(2,2)*ngabc(i,2) +rltv(2,3)*ngabc(i,3)
          VecG(3) = rltv(3,1)*ngabc(i,1) +rltv(3,2)*ngabc(i,2) +rltv(3,3)*ngabc(i,3)
          
          normG = sqrt( VecG(1)**2 +VecG(2)**2 +VecG(3)**2 )
          normG3 = normG**3

          fac1r = zfcos(i); fac1i = zfsin(i)
!
          gr = normG *rad1
          fac2 = -gr *cos(gr) + sin(gr)
          fac2 = fac2 *PAI4 /normG3
!
          Do is=1, ndim_magmom
             if ( kimg == 1 ) then
                d1 = chgq_l(i,1,is)*fac1r
             else
                d1 = chgq_l(i,1,is)*fac1r -chgq_l(i,kimg,is)*fac1i
             endif
             RhoMag_on_atom(ia,is) = RhoMag_on_atom(ia,is) + d1 *fac2
          End do

       End do

       if ( mype == 0 ) then
          fac2 = PAI4 /3.0d0 *rad1**3
             
          Do is=1, ndim_magmom
             d1 = chgq_l(1,1,is)
             RhoMag_on_atom(ia,is) = RhoMag_on_atom(ia,is) + d1 *fac2
          End do
       endif
       
    End Do
!
    deallocate( zfcos, zfsin )

    if ( npes > 1 ) then
       allocate( RhoMag_on_atom_mpi(natm,ndim_magmom) ); RhoMag_on_atom_mpi = 0.0d0
       call mpi_allreduce( RhoMag_on_atom, RhoMag_on_atom_mpi, natm*ndim_magmom, &
            &              mpi_double_precision, mpi_sum, mpi_comm_group, ierr )
       RhoMag_on_atom = RhoMag_on_atom_mpi
       deallocate( RhoMag_on_atom_mpi )
    endif
    
  end subroutine m_CD_calc_ChgMagMom_in_sphere

  subroutine m_CD_print_ChgMagmom_on_atom( nfout )
    integer, intent(in) :: nfout

    integer :: ia, it

    if ( iprimagmom < 2 ) return

    write(nfout,*) &
         & '! ------------ Local Magnetic Momemnt (soft+hard) at this scf step --- '

    if ( noncol ) then
       write(nfout,*) &
            & '!   id   atom no.        tot            mx             my             mz'
       Do ia=1, natm
          it = ityp(ia)
          write(nfout,'(I7,F10.4,4F15.8)') ia, iatomn(it), &
               &                          RhoMag_on_atom(ia,1), &
               &                          RhoMag_on_atom(ia,2), &
               &                          RhoMag_on_atom(ia,3), &
               &                          RhoMag_on_atom(ia,4)
       End Do

    else
       if ( ndim_magmom == 1 ) then
          write(nfout,*) &
               & '!   id   atom no.        tot'
          Do ia=1, natm
             it = ityp(ia)
             write(nfout,'(I7,F10.4,F15.8)') ia, iatomn(it), &
                  &                          RhoMag_on_atom(ia,1)
          End Do

       else if ( ndim_magmom == 2 ) then
          write(nfout,*) &
               & '!   id   atom no.        tot            mz'
          Do ia=1, natm
             it = ityp(ia)
             write(nfout,'(I7,F10.4,2F15.8)') ia, iatomn(it), &
                  &                          RhoMag_on_atom(ia,1)+RhoMag_on_atom(ia,2),&
                  &                          RhoMag_on_atom(ia,1)-RhoMag_on_atom(ia,2)
          End Do
       endif

    endif

    write(nfout,*) '! ---------------------------------------------'

  end subroutine m_CD_print_ChgMagmom_on_atom

! ------------------------------------------
  subroutine m_CD_estim_magmom_local( nfout )
    integer, intent(in) :: nfout

    integer :: ia, it, lmt1, lmt2, is
    real(kind=DP) :: sum, fac

!--
    Do ia=1, natm
       it = ityp(ia)

       Do is=2, ndim_magmom
          sum = 0.0d0
          Do lmt1=1, ilmt(it)
             Do lmt2=lmt1, ilmt(it)
                fac=2.d0;if(lmt1.eq.lmt2) fac=1.d0
                sum = sum + fac *hsr( ia, lmt1, lmt2, is )*dl2p(lmt1,lmt2,1,it)
             End do
          End do
!
          magmom_local_now(ia,is-1) = sum
       End do
    End Do

  end subroutine m_CD_estim_magmom_local

  subroutine m_CD_print_magmom_local( nfout )
    integer, intent(in) :: nfout

    integer :: ia, it

    if ( iprimagmom < 3 ) return

    write(nfout,*) &
         & '! ------------ Local Magnetic Momemnt ( hard part ) at this scf step --- '
    write(nfout,*) '!   id   atom no.        mx             my             mz  '
    Do ia=1, natm
       it = ityp(ia)
       write(nfout,'(I7,F10.4,3F15.8)') ia, iatomn(it), &
            &                         magmom_local_now(ia,1), &
            &                         magmom_local_now(ia,2), &
            &                         magmom_local_now(ia,3)
    End Do
    write(nfout,*) '! ---------------------------------------------'

  end subroutine m_CD_print_magmom_local

end module m_CD_Mag_Moment
