!=======================================================================
!
!  PROGRAM  PHASE/0 2014.01 (rev.375)
!
!  "First-principles Electronic Structure Calculation Program"
!
!  AUTHOR(S): K. Tagami
!  
!  Contact address :  Phase System Consortium
!                     E-mail: phase_system@nims.go.jp URL https://azuma.nims.go.jp
!  
!
!
!=======================================================================
!
!   The original version of this set of the computer programs "PHASE" was developed by 
!  the members of the Theory Group of Joint Research Center for Atom Technology 
!  (JRCAT), based in Tsukuba, in the period 1993-2001.  
!   Since 2002, this program set had been intensively developed as a part of the following 
!  national projects supported by the Ministry of Education, Culture, Sports, Science and 
!  Technology (MEXT) of Japan; "Frontier Simulation Software for Industrial Science 
!  (FSIS)" from 2002 to 2005, "Revolutionary Simulation Software (RSS21)" from 2006 to 
!  2008. "Research and Development of Innovative Simulation Software (RISS)" from 2008 
!  to 2013. These projects is lead by the Center for Research on Innovative Simulation 
!  Software (CISS), the Institute of Industrial Science (IIS), the University of Tokyo.
!   Since 2013, this program set has been further developed centering on PHASE System 
!  Consortium. 
!   The activity of development of this program set has been supervised by Takahisa Ohno.
!
module m_ES_Mag_Constraint
! $Id: m_ES_Mag_Constraint.f90 254 2012-11-16 07:15:25Z ktagami $
  use m_Parallelization,    only : mype, mpi_comm_group, npes, ierr
  
  use m_PseudoPotential,    only : ilmt, nlmt, dl2p

  use m_Control_Parameters,    only : neg, ndim_spinor, ndim_magmom
  use m_Const_Parameters,  only : DP, CMPLDP, yes

  use m_Charge_Density,        only : chgq_l, chgqo_l, hsr
  use m_Ionic_System,         only : natm, ityp,  mag_direction0_atomtyp, &
       &                             magmom_local_now

  use m_Crystal_Structure,  only : univol, &
       &                           mag_constraint_type, &
       &                           mag_moment_tag_global, &
       &                           mag_direc_tag_global, &
       &                           mag_constraint_lambda, &
       &                           duration_for_mag_constraint

  use m_IterationNumbers,  only : iteration_electronic
  use m_Electronic_Structure,  only : vlhxc_l, vlhxcQ

  implicit none

  include 'mpif.h'
  integer istatus(mpi_status_size)

  real(kind=DP) :: MagField_constrain_global(3)
  real(kind=DP), allocatable :: MagField_constrain_local(:,:,:,:)

contains

  subroutine m_ES_add_MagConstraintPot_globl
    select case ( mag_constraint_type )
    case (1)
       call case_constraint_moment_global
    case (2)
       call case_constraint_direc_global
    end select

  contains

    subroutine case_constraint_moment_global
      real(kind=DP) :: MagMom(3)
      integer :: is, ia, it, lmt1

      if ( mype == 0 ) then
         Do is=2, ndim_magmom
            MagMom(is-1) = chgq_l( 1,1,is ) *univol
         End do

         MagField_constrain_global(:) = &
              &  mag_constraint_lambda *( MagMom(:) -mag_moment_tag_global(:) )

         Do is=2, ndim_magmom
            vlhxc_l(1,1,is) = vlhxc_l(1,1,is) + MagField_constrain_global(is-1)
         End do
      endif

    end subroutine case_constraint_moment_global

    subroutine case_constraint_direc_global
      real(kind=DP) :: MagMom(3), MagDirec(3)
      real(kind=DP) :: c1, c2, cnorm, cnorm2
      integer :: is, ia, it, ixyz, lmt1

      real(kind=DP), parameter :: cnorm_lower_limit = 1.0D-10

      if ( mype == 0 ) then
         Do is=2, ndim_magmom
            MagMom(is-1) = chgq_l( 1,1,is ) *univol
         End do

         cnorm2 = 0.0d0
         Do ixyz=1, 3
            cnorm2 = cnorm2 + MagMom(ixyz)**2
         End do
         cnorm = sqrt( cnorm2 )

         if ( cnorm < cnorm_lower_limit ) then
            MagField_constrain_global = 0.0d0
            return
         endif

         MagDirec = MagMom / cnorm

         Do ixyz=1, 3
            c1 = cnorm2 - MagMom(ixyz)**2
            c2 = cnorm**3
            MagField_constrain_global(ixyz) = &
                 &  mag_constraint_lambda *c1 /c2 &
                 & *( MagDirec(ixyz) - mag_direc_tag_global(ixyz) )
         End do

         Do is=2, ndim_magmom
            vlhxc_l(1,1,is) = vlhxc_l(1,1,is) + MagField_constrain_global(is-1)
         End do
      endif

    end subroutine case_constraint_direc_global

  end subroutine m_ES_add_MagConstraintPot_globl

  subroutine m_ES_add_MagConstraintPot_local
    select case ( mag_constraint_type )
    case (4)
       !          stop "kt : constrain_type4 does not work properly....."
       call case_constraint_direc_local
    end select

  contains

    subroutine case_constraint_direc_local
      real(kind=DP) :: MagMom(3), MagDirec(3)
      real(kind=DP) :: c1, c2, cnorm, cnorm2
      integer :: ia, it, lmt1, lmt2, is, ixyz

      real(kind=DP), parameter :: cnorm_lower_limit = 1.0D-10
!
      if ( .not. allocated( MagField_constrain_local ) ) then
         allocate( MagField_constrain_local(nlmt,nlmt,natm,3 ) );
      endif
!
      MagField_constrain_local = 0.0d0
!
      Do ia=1, natm
         it = ityp(ia)
         Do ixyz=1, 3
            MagMom( ixyz ) = magmom_local_now( ia,ixyz )
         End do

         cnorm2 = 0.0d0
         Do ixyz=1, 3
            cnorm2 = cnorm2 + MagMom(ixyz)**2
         End do
         cnorm = sqrt( cnorm2 )

         if ( cnorm < cnorm_lower_limit ) then
            MagField_constrain_local(:,:,ia,:) = 0.0d0
            cycle
         endif

         MagDirec = MagMom / cnorm

         Do lmt1=1, ilmt(it)
            Do lmt2=1, ilmt(it)

               Do ixyz=1, 3
                  c1 = cnorm2 - MagMom(ixyz)**2
                  c2 = cnorm**3
                  MagField_constrain_local(lmt1,lmt2,ia,ixyz) = &
                       &  mag_constraint_lambda *c1 /c2 &
                       & *( MagDirec(ixyz) -mag_direction0_atomtyp(it,ixyz) ) &
                       & *dl2p(lmt1,lmt2,1,it)             ! approx
               End do
            End do
         End do

         Do lmt1=1, ilmt(it)
            Do lmt2=1, ilmt(it)
               Do is=2, ndim_magmom
                  vlhxcQ(lmt1,lmt2,ia,is) = vlhxcQ(lmt1,lmt2,ia,is) &
                       &       + MagField_constrain_local(lmt1,lmt2,ia,is-1)
               End do
            End do
         End Do

      end Do

    end subroutine case_constraint_direc_local

  end subroutine m_ES_add_MagConstraintPot_local


  subroutine m_ES_calc_MagConstraint_Energy( ene_double_counting, ene_mag_constraint )
    real(kind=DP), intent(out) :: ene_double_counting
    real(kind=DP), intent(out) :: ene_mag_constraint

    ene_double_counting = 0.0d0
    ene_mag_constraint = 0.0d0

    select case ( mag_constraint_type )
    case (1)
       call case_constraint_moment_global
    case (2)
       call case_constraint_direc_global
    case (4)
       call case_constraint_direc_local
    end select

  contains

    subroutine case_constraint_moment_global
      real(kind=DP) :: MagMom(3), c1, c2
      real(kind=DP) :: MagMomOld(3)
      integer :: is, ixyz

      if ( mype == 0 ) then
         Do is=2, ndim_magmom
            MagMom(is-1) = chgq_l(  1,1,is ) *univol
            MagMomOld(is-1) = chgqo_l(  1,1,is ) *univol
         End do

         c1 = 0.0d0;  c2 = 0.0d0
         Do ixyz=1, 3
            c1 = c1 + MagField_constrain_global(ixyz) *MagMom(ixyz)
            c2 = c2 + ( MagMom(ixyz) -mag_moment_tag_global(ixyz) )**2
         End do
         ene_double_counting = c1
         ene_mag_constraint = c2 *mag_constraint_lambda / 2.0d0
      endif

      if (npes > 1) then
         call mpi_allreduce( ene_double_counting, c1, 1, mpi_double_precision, &
              &              mpi_sum, mpi_comm_group, ierr )
         call mpi_allreduce( ene_mag_constraint, c2, 1, mpi_double_precision, &
              &              mpi_sum, mpi_comm_group, ierr )
         ene_double_counting = c1
         ene_mag_constraint = c2
      end if

    end subroutine case_constraint_moment_global

    subroutine case_constraint_direc_global
      real(kind=DP) :: MagMom(3), MagDirec(3), c1, c2
      integer :: is, ixyz

      real(kind=DP) :: cnorm, cnorm2
      real(kind=DP), parameter :: cnorm_lower_limit = 1.0D-10

      if ( mype == 0 ) then
         Do is=2, ndim_magmom
            MagMom(is-1) = chgq_l(  1,1,is ) *univol
         End do

         cnorm2 = 0.0d0
         Do ixyz=1, 3
            cnorm2 = cnorm2 + MagMom(ixyz)**2
         End do
         cnorm = sqrt( cnorm2 )

         if ( cnorm > cnorm_lower_limit ) then
            MagDirec = MagMom / cnorm

            c1 = 0.0d0;  c2 = 0.0d0
            Do ixyz=1, 3
               c1 = c1 + MagField_constrain_global(ixyz) *MagMom(ixyz)
               c2 = c2 + ( MagDirec(ixyz) -mag_direc_tag_global(ixyz) )**2
            End do

            ene_double_counting = c1
            ene_mag_constraint = c2 *mag_constraint_lambda /2.0d0
         endif
      endif

      if (npes > 1) then
         call mpi_allreduce( ene_double_counting, c1, 1, mpi_double_precision, &
              &              mpi_sum, mpi_comm_group, ierr )
         call mpi_allreduce( ene_mag_constraint, c2, 1, mpi_double_precision, &
              &              mpi_sum, mpi_comm_group, ierr )
         ene_double_counting = c1
         ene_mag_constraint = c2
      end if

    end subroutine case_constraint_direc_global

    subroutine case_constraint_direc_local
      real(kind=DP) :: MagMom(3), MagDirec(3), c1, c2
      integer :: ia, it, lmt1, lmt2, is, ixyz

      real(kind=DP) :: csum1, csum2
      real(kind=DP) :: cnorm, cnorm2
      real(kind=DP), parameter :: cnorm_lower_limit = 1.0D-10

      csum1 = 0.0d0; csum2 = 0.0d0

      Do ia=1, natm
         it = ityp(ia)
         Do ixyz=1, 3
            MagMom(ixyz) = magmom_local_now( ia,ixyz )
         End do

         cnorm2 = 0.0d0
         Do ixyz=1, 3
            cnorm2 = cnorm2 + MagMom(ixyz)**2
         End do
         cnorm = sqrt( cnorm2 )

         if ( cnorm > cnorm_lower_limit ) then
            MagDirec = MagMom / cnorm

            Do lmt1=1, ilmt(it)
               Do lmt2=1, ilmt(it)

                  Do ixyz=1, 3
                     csum1 = csum1 + MagField_constrain_local(lmt1,lmt2,ia,ixyz) &
                          &          *hsr(ia,lmt1,lmt2,ixyz +1)
                  End do
               End do
            End do

            Do ixyz=1, 3
               csum2 = csum2 + ( MagDirec(ixyz)-mag_direction0_atomtyp(it,ixyz) )**2
            End do
         endif

      End do

      ene_double_counting = csum1
      ene_mag_constraint = csum2 *mag_constraint_lambda/ 2.0d0

    end subroutine case_constraint_direc_local

  end subroutine m_ES_calc_MagConstraint_Energy

end module m_ES_Mag_Constraint
