module m_OP_Moment
! $Id: m_OP_Moment.F90 287 2013-01-01 15:21:08Z ktagami $

  use m_Control_Parameters,  only : proj_attribute, proj_group, num_proj_elems, &
       &                            max_projs, ndim_spinor, ndim_magmom, ndim_chgpot, &
       &                            iprimagmom

  use m_Const_Parameters,     only : DP, CMPLDP, zi
  use m_Ionic_System,         only : natm, iproj_group

  use m_SpinOrbit_Potential,  only :  MatU_ylm_RC_L0,  MatU_ylm_RC_L1, &
       &                              MatU_ylm_RC_L2,  MatU_ylm_RC_L3
  use m_Orbital_Population,   only :  om, om_aimag, ommix, ommix_aimag, i2lp
  use m_Parallelization,       only : mype

  use m_ES_NonCollinear,       only :  m_ES_MagMom_To_DensMat_porb, &
       &                               m_ES_set_Pauli_Matrix
  use m_Files,                 only : nfout

  implicit none
  include 'mpif.h'

  complex(kind=CMPLDP) :: Mat_L_with_cmplx_ylm_L0(  0:0, 0:0, 3 )
  complex(kind=CMPLDP) :: Mat_L_with_cmplx_ylm_L1( -1:1,-1:1, 3 )
  complex(kind=CMPLDP) :: Mat_L_with_cmplx_ylm_L2( -2:2,-2:2, 3 )
  complex(kind=CMPLDP) :: Mat_L_with_cmplx_ylm_L3( -3:3,-3:3, 3 )
!
  complex(kind=CMPLDP) :: Mat_L_with_real_ylm_L0( 1, 1, 3 )
  complex(kind=CMPLDP) :: Mat_L_with_real_ylm_L1( 3, 3, 3 )
  complex(kind=CMPLDP) :: Mat_L_with_real_ylm_L2( 5, 5, 3 )
  complex(kind=CMPLDP) :: Mat_L_with_real_ylm_L3( 7, 7, 3 )

contains

  subroutine m_OP_calc_orbmom_from_OCC           ! From occupation marix
    integer :: ia, it, i, ig, ie, ip, l, m1, m2
    integer :: is1, is2, istmp, size1
!
    real(kind=DP) :: orbmom(3), spinmom(3)
    complex(kind=CMPLDP) :: ztmp(3)
    complex(kind=CMPLDP) :: PauliMatrix( ndim_magmom, ndim_spinor, ndim_spinor )
!
    real(kind=DP), allocatable :: dmmat_r_magmom( :,:,: )
    real(kind=DP), allocatable :: dmmat_i_magmom( :,:,: )
    complex(kind=CMPLDP), allocatable :: dmmat_ssrep( :,:,: )

    logical :: FirstFlag = .true.
    logical :: print_header
! -----------
    if ( iprimagmom < 3 ) return

    if ( FirstFlag ) then
       call m_OP_calc_MatL_orb_s_to_f
       FirstFlag = .false.
    endif
    print_header = .true.

    call m_ES_set_Pauli_Matrix( PauliMatrix )

    do ia=1, natm
       ig = iproj_group(ia)
       if ( ig <1 ) cycle

       do i=1,num_proj_elems(ig)
          ip = proj_group(i,ig)
          it = proj_attribute(ip)%ityp
          ie = proj_attribute(ip)%ielem
          l  = proj_attribute(ip)%l

          size1 = i2lp(ip)
          allocate( dmmat_r_magmom(size1,size1,ndim_magmom) ); dmmat_r_magmom = 0.0d0
          allocate( dmmat_i_magmom(size1,size1,ndim_magmom) ); dmmat_i_magmom = 0.0d0
          allocate( dmmat_ssrep(size1,size1,ndim_chgpot) );  dmmat_ssrep = 0.0d0

!          dmmat_r_magmom(:,:,:) = om(:,:,ie,ia,:)
!          dmmat_i_magmom(:,:,:) = om_aimag(:,:,ie,ia,:)
          dmmat_r_magmom(:,:,:) = ommix(:,:,ie,ia,:)
          dmmat_i_magmom(:,:,:) = ommix_aimag(:,:,ie,ia,:)

          call m_ES_MagMom_To_DensMat_porb( size1**2, dmmat_r_magmom, dmmat_i_magmom, &
               &                            dmmat_ssrep )

          orbmom = 0.0d0; spinmom = 0.0d0

          Do is1=1, ndim_spinor
             Do is2=1, ndim_spinor
                if ( is1 /= is2 ) cycle

                istmp = ( is1 -1 )*ndim_spinor + is2

                Do m1=1, size1
                   Do m2=1, size1
                      ztmp = 0.0d0
                      if ( l == 1 ) then
                         ztmp(:) = Mat_L_with_real_ylm_L1( m2, m1, : )
                      else if ( l == 2 ) then
                         ztmp(:) = Mat_L_with_real_ylm_L2( m2, m1, : )
                      else if ( l == 3 ) then
                         ztmp(:) = Mat_L_with_real_ylm_L3( m2, m1, : )
                      endif

                      orbmom(1) = orbmom(1) +dmmat_ssrep(m1,m2,istmp) *ztmp(1)
                      orbmom(2) = orbmom(2) +dmmat_ssrep(m1,m2,istmp) *ztmp(2)
                      orbmom(3) = orbmom(3) +dmmat_ssrep(m1,m2,istmp) *ztmp(3)
                   End do
                End do
             End do
          End do

          Do is1=1, ndim_spinor
             Do is2=1, ndim_spinor
                istmp = ( is1 -1 )*ndim_spinor + is2
                Do m1=1, size1
                   Do m2=1, size1
                      spinmom(1) = spinmom(1) +dmmat_ssrep(m1,m2,istmp) &
                           &                  *PauliMatrix(2,is2,is1)
                      spinmom(2) = spinmom(2) +dmmat_ssrep(m1,m2,istmp) &
                           &                  *PauliMatrix(3,is2,is1)
                      spinmom(3) = spinmom(3) +dmmat_ssrep(m1,m2,istmp) &
                           &                  *PauliMatrix(4,is2,is1)
                   End do
                End do
             End do
          End do
!
          deallocate( dmmat_r_magmom ); deallocate( dmmat_i_magmom )
          deallocate( dmmat_ssrep )
! --
          call  print_spin_orb_mom_local( ia, l, spinmom, orbmom, print_header )
          print_header = .false.
       end do
    End do

  contains

    subroutine print_spin_orb_mom_local( ia, l, spinmom, orbmom, print_header )
      integer, intent(in) :: ia, l
      real(kind=DP), intent(in) :: spinmom(3), orbmom(3)
      logical, intent(in) :: print_header

      if (print_header) then
         write(nfout,*) '! ------------ Local Momemnt ( occmat )  --- '
      endif

      write(nfout,*) '!   ia   l   type          mx             my             mz  '
!
      write(nfout,'(I7,I4,3X,A5,3F15.8)') ia, l, "orb  ", orbmom(1), orbmom(2), orbmom(3)
      write(nfout,'(14X,     A5,3F15.8)')     "spin ", spinmom(1), spinmom(2), spinmom(3)
!
      write(nfout,*) '! ------ '

    end subroutine print_spin_orb_mom_local

  end subroutine m_OP_calc_orbmom_from_OCC


! ------------------
  subroutine m_OP_calc_MatL_orb_s_to_f
    real(kind=DP) :: theta, phi

    theta = 0.0; phi = 0.0d0
    call m_OP_calc_MatL_with_Cmplx_ylm( 0, theta, phi, &
         &                              Mat_L_with_cmplx_ylm_L0 )
    call m_OP_calc_MatL_with_Real_ylm( 0, MatU_ylm_RC_L0, &
         &                             Mat_L_with_cmplx_ylm_L0, &
         &                             Mat_L_with_real_ylm_L0 )
!
    call m_OP_calc_MatL_with_Cmplx_ylm( 1, theta, phi, &
         &                              Mat_L_with_cmplx_ylm_L1 )
    call m_OP_calc_MatL_with_Real_ylm( 1, MatU_ylm_RC_L1, &
         &                             Mat_L_with_cmplx_ylm_L1, &
         &                             Mat_L_with_real_ylm_L1 )
!
    call m_OP_calc_MatL_with_Cmplx_ylm( 2, theta, phi, &
         &                              Mat_L_with_cmplx_ylm_L2 )
    call m_OP_calc_MatL_with_Real_ylm( 2, MatU_ylm_RC_L2, &
         &                              Mat_L_with_cmplx_ylm_L2, &
         &                              Mat_L_with_real_ylm_L2 )
!
    call m_OP_calc_MatL_with_Cmplx_ylm( 3, theta, phi, &
         &                              Mat_L_with_cmplx_ylm_L3 )
    call m_OP_calc_MatL_with_Real_ylm( 3, MatU_ylm_RC_L3, &
         &                             Mat_L_with_cmplx_ylm_L3, &
         &                             Mat_L_with_real_ylm_L3 )
  end subroutine m_OP_calc_MatL_orb_s_to_f


  subroutine m_OP_calc_MatL_with_Real_ylm( l_in, MatU_ylm_RC, &
       &                                   Mat_L_with_cmplx_ylm, &
       &                                   Mat_L_with_real_ylm )
    integer, intent(in) :: l_in
    Complex(kind=CMPLDP), intent(in) :: MatU_ylm_RC( 2*l_in+1, -l_in:l_in )
    complex(kind=CMPLDP), intent(in) :: &
         &    Mat_L_with_cmplx_ylm( -l_in:l_in, -l_in:l_in, 3 )
    complex(kind=CMPLDP), intent(out) :: &
         &    Mat_L_with_real_ylm( 2*l_in+1, 2*l_in+1, 3 )

    integer :: m_min, m_max
    !
    integer :: ixyz
    integer :: m1, m2, ma, mb
!
    Complex(kind=CMPLDP) :: ztmp( 3 )
!
    m_min = -l_in;  m_max = l_in
!
    Do m1=1, 2 *l_in +1
       Do m2=1, 2 *l_in +1

          ztmp = 0.0d0

          Do ma = m_min, m_max
             Do mb = m_min, m_max
                Do ixyz=1, 3
#if 1
                   ztmp(ixyz) = ztmp(ixyz) + conjg(MatU_ylm_RC( m1,ma ))&
                        &                *Mat_L_with_cmplx_ylm( ma,mb,ixyz ) &
                        &                *( MatU_ylm_RC( m2,mb ) )
#else
!                   ztmp(is) = ztmp(is) + MatU_ylm_RC( m1,ma )&
!                        &                *Mat_LS_with_cmplx_ylm( ma,mb,is ) &
!                        &                *conjg( MatU_ylm_RC( m2,mb ) )
#endif

                End do
             End do
          End do
          Mat_L_with_real_ylm( m1,m2,: ) = ztmp(:)
       End do
    End do
  end subroutine m_OP_calc_MatL_with_Real_ylm

  subroutine m_OP_calc_MatL_with_Cmplx_ylm( l_in, theta, phi, Mat_L_term )
    integer, intent(in) :: l_in
    real(kind=DP), intent(in) :: theta, phi
    complex(kind=CMPLDP), intent(out) :: &
         &          Mat_L_term( -l_in:l_in, -l_in:l_in, 3 )

    real(kind=DP) :: cos_th, sin_th, cos2_th_h, sin2_th_h
    real(kind=DP) :: ctmp_m, ctmp_p, ctmp_0

    integer :: m1, m2

    Do m1=-l_in, l_in
       Do m2=-l_in, l_in

          if ( m2 == m1 +1 ) then
             ctmp_m = sqrt( (l_in +m1 +1.0d0) *( l_in -m1 ) )
          else
             ctmp_m = 0.0d0
          endif

          if ( m2 == m1 -1 ) then
             ctmp_p = sqrt( (l_in -m1 +1.0d0) *( l_in +m1 ) )
          else
            ctmp_p = 0.0d0
          endif
          !
          if ( m1 == m2 ) then
             ctmp_0 = dble(m1)
          else
             ctmp_0 = 0.0d0
          endif

          Mat_L_term( m1,m2,1 ) =  ( ctmp_p +ctmp_m ) /2.0d0
          Mat_L_term( m1,m2,2 ) =  ( ctmp_p -ctmp_m ) /2.0d0 /zi
          Mat_L_term( m1,m2,3 ) =  ctmp_0

       End do
    End Do

  end subroutine m_OP_calc_MatL_with_Cmplx_ylm

end module m_OP_Moment
