LCOV - code coverage report
Current view: top level - eigen_soc - spnorb.f90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 70 73 95.9 %
Date: 2024-03-28 04:22:06 Functions: 2 2 100.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_spnorb
       8             :   !*********************************************************************
       9             :   !     calls soinit to calculate the radial spin-orbit matrix elements:
      10             :   !     rsopp,rsopdpd,rsoppd,rsopdp
      11             :   !     and sets up the so - angular matrix elements (soangl)
      12             :   !     using the functions anglso and sgml.
      13             :   !*********************************************************************
      14             : CONTAINS
      15         132 :   SUBROUTINE spnorb(atoms,noco,nococonv,input,fmpi, enpara, vr, usdus, rsoc,l_angles,hub1inp,hub1data)
      16             :     USE m_sorad
      17             :     USE m_constants
      18             :     USE m_types
      19             :     IMPLICIT NONE
      20             : 
      21             :     TYPE(t_mpi),INTENT(IN)      :: fmpi
      22             :     TYPE(t_enpara),INTENT(IN)   :: enpara
      23             :     TYPE(t_input),INTENT(IN)    :: input
      24             :     TYPE(t_noco),INTENT(IN)     :: noco
      25             :     TYPE(t_nococonv),INTENT(IN) :: nococonv
      26             :     TYPE(t_atoms),INTENT(IN)    :: atoms
      27             :     TYPE(t_usdus),INTENT(INOUT) :: usdus
      28             :     TYPE(t_rsoc),INTENT(OUT)    :: rsoc
      29             :     LOGICAL,INTENT(IN)          :: l_angles
      30             :     TYPE(t_hub1inp),OPTIONAL, INTENT(IN)  :: hub1inp
      31             :     TYPE(t_hub1data),OPTIONAL,INTENT(INOUT) :: hub1data
      32             :     !     ..
      33             :     !     ..
      34             :     !     .. Array Arguments ..
      35             :     REAL,    INTENT (IN) :: vr(:,0:,:,:) !(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
      36             :     !     ..
      37             :     !     .. Local Scalars ..
      38             :     INTEGER is1,is2,jspin1,jspin2,l,l1,l2,m1,m2,n,i_hia
      39             :     LOGICAL, SAVE :: first_k = .TRUE.
      40             :     !     ..
      41             : 
      42             :     !Allocate space for SOC matrix elements; set to zero at the same time
      43       13312 :     ALLOCATE(rsoc%rsopp  (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsopp =0.0
      44       12916 :     ALLOCATE(rsoc%rsoppd (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsoppd=0.0
      45       12916 :     ALLOCATE(rsoc%rsopdp (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsopdp=0.0
      46       12916 :     ALLOCATE(rsoc%rsopdpd(atoms%ntype,atoms%lmaxd,2,2));rsoc%rsopdpd=0.0
      47        2960 :     ALLOCATE(rsoc%rsoplop (atoms%ntype,atoms%nlod,2,2));rsoc%rsoplop=0.0
      48        2564 :     ALLOCATE(rsoc%rsoplopd(atoms%ntype,atoms%nlod,2,2));rsoc%rsoplopd=0.0
      49        2564 :     ALLOCATE(rsoc%rsopdplo(atoms%ntype,atoms%nlod,2,2));rsoc%rsopdplo=0.0
      50        2564 :     ALLOCATE(rsoc%rsopplo (atoms%ntype,atoms%nlod,2,2));rsoc%rsopplo=0.0
      51        4724 :     ALLOCATE(rsoc%rsoploplop(atoms%ntype,atoms%nlod,atoms%nlod,2,2));rsoc%rsoploplop=0.0
      52         132 :     IF (l_angles) ALLOCATE(rsoc%soangl(atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2,&
      53         544 :          atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2))
      54             : 
      55             :     !Calculate radial soc-matrix elements
      56         336 :     DO n = 1,atoms%ntype
      57         336 :        CALL sorad(atoms,input,n,vr(:,0,n,:),enpara,noco%l_spav,rsoc,usdus,hub1data)
      58             :     END DO
      59             : 
      60             : 
      61             :     !Read in SOC-parameter for shell with hubbard 1
      62         132 :     IF(PRESENT(hub1inp).AND.fmpi%irank.EQ.0) THEN
      63          66 :       DO i_hia = 1, atoms%n_hia
      64           0 :          IF(hub1inp%l_soc_given(i_hia)) CYCLE
      65           0 :          n = atoms%lda_u(atoms%n_u+i_hia)%atomType
      66           0 :          l = atoms%lda_u(atoms%n_u+i_hia)%l
      67          66 :          IF(PRESENT(hub1data)) hub1data%xi(i_hia) = 2.0*rsoc%rsopp(n,l,1,1)*hartree_to_ev_const
      68             :       ENDDO
      69             :     ENDIF
      70             : 
      71             :     !
      72             :     !Scale SOC
      73         336 :     DO n= 1,atoms%ntype
      74         336 :        IF (ABS(noco%socscale(n)-1)>1E-5) THEN
      75          16 :           IF (fmpi%irank==0) WRITE(oUnit,"(a,i0,a,f10.8)") "Scaled SOC for atom ",n," by ",noco%socscale(n)
      76         624 :           rsoc%rsopp(n,:,:,:)    = rsoc%rsopp(n,:,:,:)*noco%socscale(n)
      77         624 :           rsoc%rsopdp(n,:,:,:)   = rsoc%rsopdp(n,:,:,:)*noco%socscale(n)
      78         624 :           rsoc%rsoppd(n,:,:,:)   = rsoc%rsoppd(n,:,:,:)*noco%socscale(n)
      79         624 :           rsoc%rsopdpd(n,:,:,:)  = rsoc%rsopdpd(n,:,:,:)*noco%socscale(n)
      80         240 :           rsoc%rsoplop(n,:,:,:)  = rsoc%rsoplop(n,:,:,:)*noco%socscale(n)
      81         240 :           rsoc%rsoplopd(n,:,:,:) = rsoc%rsoplopd(n,:,:,:)*noco%socscale(n)
      82         240 :           rsoc%rsopdplo(n,:,:,:) = rsoc%rsopdplo(n,:,:,:)*noco%socscale(n)
      83         240 :           rsoc%rsopplo(n,:,:,:)  = rsoc%rsopplo(n,:,:,:)*noco%socscale(n)
      84         496 :           rsoc%rsoploplop(n,:,:,:,:) = rsoc%rsoploplop(n,:,:,:,:)*noco%socscale(n)
      85             :        ENDIF
      86             :     ENDDO
      87             : 
      88             :     !DO some IO into out file
      89         132 :       IF ((first_k).AND.(fmpi%irank.EQ.0)) THEN
      90          36 :        DO n = 1,atoms%ntype
      91          21 :           WRITE (oUnit,FMT=8000)
      92          21 :           WRITE (oUnit,FMT=9000)
      93          84 :           WRITE (oUnit,FMT=8001) (2*rsoc%rsopp(n,l,1,1),l=1,3)
      94          84 :           WRITE (oUnit,FMT=8001) (2*rsoc%rsopp(n,l,2,2),l=1,3)
      95          99 :           WRITE (oUnit,FMT=8001) (2*rsoc%rsopp(n,l,2,1),l=1,3)
      96             :        ENDDO
      97          15 :        IF (noco%l_spav) THEN
      98           4 :           WRITE(oUnit,fmt='(A)') 'SOC Hamiltonian is constructed by neglecting B_xc.'
      99             :        ENDIF
     100          15 :        first_k=.FALSE.
     101             :     ENDIF
     102             : 8000 FORMAT (' spin - orbit parameter HR  ')
     103             : 8001 FORMAT (8f8.4)
     104             : 9000 FORMAT (5x,' p ',5x,' d ', 5x, ' f ')
     105             :     !
     106             : 
     107             :     !Calculate angular matrix elements if requested
     108         132 :     IF (l_angles) &
     109          68 :          CALL spnorb_angles(atoms,fmpi,nococonv%theta,nococonv%phi,rsoc%soangl)
     110         132 :   END SUBROUTINE spnorb
     111             : 
     112          68 :   SUBROUTINE spnorb_angles(atoms,fmpi,theta,phi,soangl,compo)
     113             :     USE m_constants
     114             :     USE m_anglso
     115             :     USE m_sgml
     116             :     USE m_sorad
     117             :     USE m_types
     118             :     IMPLICIT NONE
     119             :     TYPE(t_atoms),INTENT(IN)    :: atoms
     120             :     TYPE(t_mpi),INTENT(IN)      :: fmpi
     121             :     REAL,INTENT(IN)             :: theta,phi
     122             :     COMPLEX,INTENT(INOUT)       :: soangl(:,-atoms%lmaxd:,:,:,-atoms%lmaxd:,:)
     123             :     INTEGER, INTENT(IN),OPTIONAL :: compo
     124             :     !     ..
     125             :     !     ..
     126             :     !     .. Local Scalars ..
     127             :     INTEGER is1,is2,jspin1,jspin2,l,l1,l2,m1,m2,n
     128             :     !     ..
     129             :     !     .. Local Arrays ..
     130             :     INTEGER ispjsp(2)
     131             :     !     ..
     132             :     !     ..
     133             :     DATA ispjsp/1,-1/
     134             : 
     135             : 
     136             :     IF ((ABS(theta).LT.0.00001).AND.(ABS(phi).LT.0.00001)&
     137          68 :                        .AND..NOT.PRESENT(compo)) THEN
     138             :        !
     139             :        !       TEST for real function sgml(l1,m1,is1,l2,m2,is2)
     140             :        !
     141         594 :        DO l1 = 1,atoms%lmaxd
     142        5618 :           DO l2 = 1,atoms%lmaxd
     143       15608 :              DO jspin1 = 1,2
     144       35168 :                 DO jspin2 = 1,2
     145       20096 :                    is1=ispjsp(jspin1)
     146       20096 :                    is2=ispjsp(jspin2)
     147      261312 :                    DO m1 = -l1,l1,1
     148     2934656 :                       DO m2 = -l2,l2,1
     149             :                          soangl(l1,m1,jspin1,l2,m2,jspin2) =&
     150     2914560 :                               CMPLX(sgml(l1,m1,is1,l2,m2,is2),0.0)
     151             :                       ENDDO
     152             :                    ENDDO
     153             :                 ENDDO
     154             :              ENDDO
     155             :           ENDDO
     156             :        ENDDO
     157             : 
     158             :     ELSE
     159             :        !
     160             :        !       TEST for complex function anglso(teta,phi,l1,m1,is1,l2,m2,is2)
     161             :        !
     162         110 :        DO l1 = 1,atoms%lmaxd
     163        1110 :           DO l2 = 1,atoms%lmaxd
     164        3100 :              DO jspin1 = 1,2
     165        7000 :                 DO jspin2 = 1,2
     166        4000 :                    is1=ispjsp(jspin1)
     167        4000 :                    is2=ispjsp(jspin2)
     168             :                    !
     169       54000 :                    DO m1 = -l1,l1,1
     170      628000 :                       DO m2 = -l2,l2,1
     171             :                          soangl(l1,m1,jspin1,l2,m2,jspin2) =&
     172      624000 :                            anglso(theta,phi,l1,m1,is1,l2,m2,is2,compo)
     173             :                       ENDDO
     174             :                    ENDDO
     175             :                    !
     176             :                 ENDDO
     177             :              ENDDO
     178             :           ENDDO
     179             :        ENDDO
     180             :        !
     181             :     ENDIF
     182             : 
     183          68 :     IF (fmpi%irank.EQ.0) THEN
     184          34 :        WRITE (oUnit,FMT=8002)
     185         102 :        DO jspin1 = 1,2
     186         238 :           DO jspin2 = 1,2
     187         136 :              WRITE (oUnit,FMT=*) 'd-states:is1=',jspin1,',is2=',jspin2
     188        1088 :              WRITE (oUnit,FMT='(7x,7i8)') (m1,m1=-3,3,1)
     189        7820 :              WRITE (oUnit,FMT=8003) (m2, (soangl(3,m1,jspin1,3,m2,jspin2),m1=-3,3,1),m2=-3,3,1)
     190             :           ENDDO
     191             :        ENDDO
     192             :     ENDIF
     193             : 8002 FORMAT (' so - angular matrix elements')
     194             : 8003 FORMAT (i8,14f8.4)
     195             : 
     196          68 :   END SUBROUTINE spnorb_angles
     197             : END MODULE m_spnorb

Generated by: LCOV version 1.14