LCOV - code coverage report
Current view: top level - cdn - m_perp.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 51 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             : MODULE m_m_perp
       8             : CONTAINS 
       9           0 :   SUBROUTINE m_perp(atoms,itype,iRepAtom,noco,vr0, chmom,qa21)
      10             :     !***********************************************************************
      11             :     ! calculates the perpendicular part of the local moment.
      12             :     ! if l_relax is true the angle of the output local moment is calculated
      13             :     ! and mixed with the input angles using mix_b as the mixing parameter
      14             :     ! if l_constr is true the output constraint b-field is calculated and
      15             :     ! mixed with the input contraint field using mix_b
      16             :     ! Philipp Kurz 2000-02-09
      17             :     !***********************************************************************
      18             : 
      19             :     USE m_constants
      20             :     USE m_intgr, ONLY : intgr3
      21             :     USE m_polangle
      22             :     USE m_rotdenmat
      23             :     USE m_types
      24             :     IMPLICIT NONE
      25             :     TYPE(t_noco),INTENT(INOUT)   :: noco
      26             :     TYPE(t_atoms),INTENT(IN)     :: atoms
      27             : 
      28             :     !     .. Scalar Arguments ..
      29             :     INTEGER, INTENT (IN) :: itype, iRepAtom
      30             :     !     ..
      31             :     !     .. Array Arguments ..
      32             :     REAL, INTENT    (IN) :: chmom(:,:)!(atoms%ntype,input%jspins)
      33             :     REAL, INTENT    (IN) :: vr0(:,:,:)!(atoms%jmtd,atoms%ntype,jspd)
      34             :     COMPLEX, INTENT (IN) :: qa21(atoms%ntype)
      35             :     !     ..
      36             :     !     .. Local Scalars ..
      37             :     INTEGER iri
      38             :     REAL b_xavh,scale,b_con_outx,b_con_outy,mx,my,mz,&
      39             :          &     alphh,betah,mz_tmp,mx_mix,my_mix,mz_mix
      40             :     REAL    rho11,rho22, alphdiff
      41             :     COMPLEX rho21
      42             :     !     ..
      43             :     !     .. Local Arrays ..
      44           0 :     REAL b_xc_h(atoms%jmtd),b_xav(atoms%ntype)
      45             : 
      46             :     ! angles in nocoinp file are (alph-alphdiff)
      47           0 :     IF (noco%l_ss) THEN
      48             :        alphdiff = 2.0*pi_const*(noco%qss(1)*atoms%taual(1,iRepAtom) + &
      49             :                                 noco%qss(2)*atoms%taual(2,iRepAtom) + &
      50           0 :                                 noco%qss(3)*atoms%taual(3,iRepAtom) )
      51             :     ELSE
      52             :        alphdiff = 0.0
      53             :     END IF
      54             : 
      55             :     !---> calculated the comp. of the local moment vector
      56           0 :     mx = 2*REAL(qa21(itype))
      57           0 :     my = 2*AIMAG(qa21(itype))
      58           0 :     mz = chmom(itype,1) - chmom(itype,2)
      59           0 :     WRITE  (6,8025) mx,my
      60             :     !---> determine the polar angles of the moment vector in the local frame
      61           0 :     CALL pol_angle(mx,my,mz,betah,alphh)
      62           0 :     WRITE  (6,8026) betah,alphh
      63             : 8025 FORMAT(2x,'--> local frame: ','mx=',f9.5,' my=',f9.5)
      64             : 8026 FORMAT(2x,'-->',10x,' delta beta=',f9.5,&
      65             :          &                   '  delta alpha=',f9.5)
      66             : 
      67           0 :     IF (noco%l_relax(itype)) THEN
      68             :        !--->    rotate the (total (integrated) density matrix to obtain
      69             :        !--->    it in the global spin coordinate frame
      70           0 :        rho11 = chmom(itype,1)
      71           0 :        rho22 = chmom(itype,2)
      72           0 :        rho21 = qa21(itype)
      73           0 :        CALL rot_den_mat(noco%alph(itype),noco%beta(itype), rho11,rho22,rho21)
      74             :        !--->    determine the polar angles of the mom. vec. in the global frame
      75           0 :        mx = 2*REAL(rho21)
      76           0 :        my = 2*AIMAG(rho21)
      77           0 :        mz = rho11 - rho22
      78           0 :        CALL pol_angle(mx,my,mz,betah,alphh)
      79           0 :        WRITE  (6,8027) noco%beta(itype),noco%alph(itype)-alphdiff
      80           0 :        WRITE  (6,8028) betah,alphh-alphdiff
      81             : 8027   FORMAT(2x,'-->',10x,' input noco%beta=',f9.5, '  input noco%alpha=',f9.5)
      82             : 8028   FORMAT(2x,'-->',10x,'output noco%beta=',f9.5, ' output noco%alpha=',f9.5)
      83             : 
      84             :        !  ff    do the same for mixed density: rho21 = mix_b * rho21
      85           0 :        rho11 = chmom(itype,1)
      86           0 :        rho22 = chmom(itype,2)
      87             :        rho21 = qa21(itype)
      88           0 :        rho21 = noco%mix_b * rho21
      89           0 :        CALL rot_den_mat(noco%alph(itype),noco%beta(itype), rho11,rho22,rho21)
      90             :        !--->    determine the polar angles of the mom. vec. in the global frame
      91           0 :        mx_mix = 2*REAL(rho21)
      92           0 :        my_mix = 2*AIMAG(rho21)
      93           0 :        mz_mix = rho11 - rho22
      94           0 :        WRITE  (6,8031) mx_mix,my_mix
      95             : 8031   FORMAT(2x,'--> global frame: ','mixed mx=',f9.5,' mixed my=',f9.5)
      96             :        ! if magnetic moment (in local frame!) is negative, direction of quantization
      97             :        ! has to be antiparallel! 
      98           0 :        mz_tmp = chmom(itype,1) - chmom(itype,2) 
      99           0 :        IF ( mz_tmp .LT. 0.0 ) THEN
     100           0 :           mx_mix = (-1.0) * mx_mix
     101           0 :           my_mix = (-1.0) * my_mix
     102           0 :           mz_mix = (-1.0) * mz_mix
     103             :        ENDIF
     104             :        ! calculate angles alpha and beta in global frame
     105           0 :        CALL pol_angle(mx_mix,my_mix,mz_mix,betah,alphh)
     106           0 :        WRITE  (6,8029) betah,alphh-alphdiff
     107             : 8029   FORMAT(2x,'-->',10x,' new noco%beta  =',f9.5, '  new noco%alpha  =',f9.5)
     108           0 :        noco%alph(itype) = alphh
     109           0 :        noco%beta(itype) = betah
     110             :     ENDIF
     111             : 
     112           0 :     IF (noco%l_constr) THEN
     113             :        !--->    calculate the average value of B_xc (<B_xc>)
     114           0 :        DO iri = 1,atoms%jri(itype)
     115           0 :           b_xc_h(iri) = (  vr0(iri,itype,1) - vr0(iri,itype,2) )*atoms%rmsh(iri,itype)
     116             :        ENDDO
     117           0 :        CALL intgr3(b_xc_h,atoms%rmsh(1,itype),atoms%dx(itype),atoms%jri(itype),b_xavh)
     118           0 :        b_xav(itype) = fpi_const*b_xavh/atoms%volmts(itype)
     119             :        !--->    calculate the output constraint B-field (B_con)
     120             :        !        take negative of absolute value! gb`05
     121           0 :        scale = -ABS(b_xav(itype)/(chmom(itype,1)-chmom(itype,2)))
     122           0 :        b_con_outx = scale*mx
     123           0 :        b_con_outy = scale*my
     124             :        !--->    mix input and output constraint fields
     125           0 :        WRITE  (6,8100) noco%b_con(1,itype),noco%b_con(2,itype)
     126           0 :        WRITE  (6,8200) b_con_outx,b_con_outy
     127           0 :        noco%b_con(1,itype) = noco%b_con(1,itype) + noco%mix_b*b_con_outx
     128           0 :        noco%b_con(2,itype) = noco%b_con(2,itype) + noco%mix_b*b_con_outy
     129             :     ENDIF
     130             : 
     131             : 8100 FORMAT (2x,'-->',10x,' input B_con_x=',f12.6,&
     132             :          &                    '  input B_con_y=',f12.6,&
     133             :          &                    ' B_xc average=',f12.6)
     134             : 8200 FORMAT (2x,'-->',10x,' delta B_con_x=',f12.6,&
     135             :          &                    ' delta B_con_y=',f12.6)
     136             : 
     137           0 :   END SUBROUTINE m_perp
     138             : END MODULE m_m_perp

Generated by: LCOV version 1.13