LCOV - code coverage report
Current view: top level - eigen_soc - spnorb.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 48 68 70.6 %
Date: 2019-09-08 04:53:50 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          94 :   SUBROUTINE spnorb(atoms,noco,input,mpi, enpara, vr, usdus, rsoc,l_angles)
      16             :     USE m_sorad 
      17             :     USE m_types
      18             :     IMPLICIT NONE
      19             : 
      20             :     TYPE(t_mpi),INTENT(IN)      :: mpi
      21             :     TYPE(t_enpara),INTENT(IN)   :: enpara
      22             :     TYPE(t_input),INTENT(IN)    :: input
      23             :     TYPE(t_noco),INTENT(IN)     :: noco
      24             :     TYPE(t_atoms),INTENT(IN)    :: atoms
      25             :     TYPE(t_usdus),INTENT(INOUT) :: usdus
      26             :     TYPE(t_rsoc),INTENT(OUT)    :: rsoc
      27             :     LOGICAL,INTENT(IN)          :: l_angles
      28             :     !     ..
      29             :     !     ..
      30             :     !     .. Array Arguments ..
      31             :     REAL,    INTENT (IN) :: vr(:,0:,:,:) !(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
      32             :     !     ..
      33             :     !     .. Local Scalars ..
      34             :     INTEGER is1,is2,jspin1,jspin2,l,l1,l2,m1,m2,n
      35             :     LOGICAL, SAVE :: first_k = .TRUE.
      36             :     !     ..
      37             :   
      38             :     !Allocate space for SOC matrix elements; set to zero at the same time
      39          94 :     ALLOCATE(rsoc%rsopp  (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsopp =0.0
      40          94 :     ALLOCATE(rsoc%rsoppd (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsoppd=0.0
      41          94 :     ALLOCATE(rsoc%rsopdp (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsopdp=0.0
      42          94 :     ALLOCATE(rsoc%rsopdpd(atoms%ntype,atoms%lmaxd,2,2));rsoc%rsopdpd=0.0
      43          94 :     ALLOCATE(rsoc%rsoplop (atoms%ntype,atoms%nlod,2,2));rsoc%rsoplop=0.0
      44          94 :     ALLOCATE(rsoc%rsoplopd(atoms%ntype,atoms%nlod,2,2));rsoc%rsoplopd=0.0
      45          94 :     ALLOCATE(rsoc%rsopdplo(atoms%ntype,atoms%nlod,2,2));rsoc%rsopdplo=0.0
      46          94 :     ALLOCATE(rsoc%rsopplo (atoms%ntype,atoms%nlod,2,2));rsoc%rsopplo=0.0
      47          94 :     ALLOCATE(rsoc%rsoploplop(atoms%ntype,atoms%nlod,atoms%nlod,2,2));rsoc%rsoploplop=0.0
      48          94 :     IF (l_angles) ALLOCATE(rsoc%soangl(atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2,&
      49          28 :          atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2))
      50             : 
      51             :     !Calculate radial soc-matrix elements
      52         286 :     DO n = 1,atoms%ntype
      53         286 :        CALL sorad(atoms,input,n,vr(:,0,n,:),enpara,noco%l_spav,rsoc,usdus)
      54             :     END DO
      55             :     
      56             :     !
      57             :     !Scale SOC 
      58         286 :     DO n= 1,atoms%ntype
      59         286 :        IF (ABS(noco%socscale(n)-1)>1E-5) THEN
      60           0 :           IF (mpi%irank==0) WRITE(6,"(a,i0,a,f10.8)") "Scaled SOC for atom ",n," by ",noco%socscale(n)
      61           0 :           rsoc%rsopp(n,:,:,:)    = rsoc%rsopp(n,:,:,:)*noco%socscale(n)
      62           0 :           rsoc%rsopdp(n,:,:,:)   = rsoc%rsopdp(n,:,:,:)*noco%socscale(n)
      63           0 :           rsoc%rsoppd(n,:,:,:)   = rsoc%rsoppd(n,:,:,:)*noco%socscale(n)
      64           0 :           rsoc%rsopdpd(n,:,:,:)  = rsoc%rsopdpd(n,:,:,:)*noco%socscale(n)
      65           0 :           rsoc%rsoplop(n,:,:,:)  = rsoc%rsoplop(n,:,:,:)*noco%socscale(n)
      66           0 :           rsoc%rsoplopd(n,:,:,:) = rsoc%rsoplopd(n,:,:,:)*noco%socscale(n)
      67           0 :           rsoc%rsopdplo(n,:,:,:) = rsoc%rsopdplo(n,:,:,:)*noco%socscale(n)
      68           0 :           rsoc%rsopplo(n,:,:,:)  = rsoc%rsopplo(n,:,:,:)*noco%socscale(n)
      69           0 :           rsoc%rsoploplop(n,:,:,:,:) = rsoc%rsoploplop(n,:,:,:,:)*noco%socscale(n)
      70             :        ENDIF
      71             :     ENDDO
      72             :     
      73             :     !DO some IO into out file
      74          94 :       IF ((first_k).AND.(mpi%irank.EQ.0)) THEN
      75          26 :        DO n = 1,atoms%ntype
      76          18 :           WRITE (6,FMT=8000)
      77          18 :           WRITE (6,FMT=9000)
      78          18 :           WRITE (6,FMT=8001) (2*rsoc%rsopp(n,l,1,1),l=1,3)
      79          18 :           WRITE (6,FMT=8001) (2*rsoc%rsopp(n,l,2,2),l=1,3)
      80          26 :           WRITE (6,FMT=8001) (2*rsoc%rsopp(n,l,2,1),l=1,3)
      81             :        ENDDO
      82           8 :        IF (noco%l_spav) THEN
      83           0 :           WRITE(6,fmt='(A)') 'SOC Hamiltonian is constructed by neglecting B_xc.'
      84             :        ENDIF
      85           8 :        first_k=.FALSE.
      86             :     ENDIF
      87             : 8000 FORMAT (' spin - orbit parameter HR  ')
      88             : 8001 FORMAT (8f8.4)
      89             : 9000 FORMAT (5x,' p ',5x,' d ', 5x, ' f ')
      90             :     !
      91             : 
      92             :     !Calculate angular matrix elements if requested
      93          94 :     IF (l_angles) &
      94          14 :          CALL spnorb_angles(atoms,mpi,noco%theta,noco%phi,rsoc%soangl)
      95          94 :   END SUBROUTINE spnorb
      96             : 
      97          14 :   SUBROUTINE spnorb_angles(atoms,mpi,theta,phi,soangl)
      98             :     USE m_anglso
      99             :     USE m_sgml
     100             :     USE m_sorad 
     101             :     USE m_types
     102             :     IMPLICIT NONE
     103             :     TYPE(t_atoms),INTENT(IN)    :: atoms
     104             :     TYPE(t_mpi),INTENT(IN)      :: mpi
     105             :     REAL,INTENT(IN)             :: theta,phi
     106             :     COMPLEX,INTENT(INOUT)       :: soangl(:,-atoms%lmaxd:,:,:,-atoms%lmaxd:,:)
     107             :     !     ..
     108             :     !     ..
     109             :     !     .. Local Scalars ..
     110             :     INTEGER is1,is2,jspin1,jspin2,l,l1,l2,m1,m2,n
     111             :     !     ..
     112             :     !     .. Local Arrays ..
     113             :     INTEGER ispjsp(2)
     114             :     !     ..
     115             :     !     ..
     116             :     DATA ispjsp/1,-1/
     117             : 
     118             :   
     119          14 :     IF ((ABS(theta).LT.0.00001).AND.(ABS(phi).LT.0.00001)) THEN
     120             :        !
     121             :        !       TEST for real function sgml(l1,m1,is1,l2,m2,is2)
     122             :        !
     123         292 :        DO l1 = 1,atoms%lmaxd
     124        1434 :           DO l2 = 1,atoms%lmaxd
     125        3996 :              DO jspin1 = 1,2
     126        9016 :                 DO jspin2 = 1,2
     127        5152 :                    is1=ispjsp(jspin1)
     128        5152 :                    is2=ispjsp(jspin2)
     129       70064 :                    DO m1 = -l1,l1,1
     130      839072 :                       DO m2 = -l2,l2,1
     131             :                          soangl(l1,m1,jspin1,l2,m2,jspin2) =&
     132      833920 :                               CMPLX(sgml(l1,m1,is1,l2,m2,is2),0.0)
     133             :                       ENDDO
     134             :                    ENDDO
     135             :                 ENDDO
     136             :              ENDDO
     137             :           ENDDO
     138             :        ENDDO
     139             :        
     140             :     ELSE
     141             :        !
     142             :        !       TEST for complex function anglso(teta,phi,l1,m1,is1,l2,m2,is2)
     143             :        ! 
     144           0 :        DO l1 = 1,atoms%lmaxd
     145           0 :           DO l2 = 1,atoms%lmaxd
     146           0 :              DO jspin1 = 1,2
     147           0 :                 DO jspin2 = 1,2
     148           0 :                    is1=ispjsp(jspin1)
     149           0 :                    is2=ispjsp(jspin2)
     150             :                    !
     151           0 :                    DO m1 = -l1,l1,1
     152           0 :                       DO m2 = -l2,l2,1
     153             :                          soangl(l1,m1,jspin1,l2,m2,jspin2) =&
     154           0 :                               anglso(theta,phi,l1,m1,is1,l2,m2,is2)
     155             :                       ENDDO
     156             :                    ENDDO
     157             :                    !
     158             :                 ENDDO
     159             :              ENDDO
     160             :           ENDDO
     161             :        ENDDO
     162             :        !
     163             :     ENDIF
     164             :     
     165          14 :     IF (mpi%irank.EQ.0) THEN
     166           7 :        WRITE (6,FMT=8002) 
     167          21 :        DO jspin1 = 1,2
     168          49 :           DO jspin2 = 1,2
     169          28 :              WRITE (6,FMT=*) 'd-states:is1=',jspin1,',is2=',jspin2
     170          28 :              WRITE (6,FMT='(7x,7i8)') (m1,m1=-3,3,1)
     171         392 :              WRITE (6,FMT=8003) (m2, (soangl(3,m1,jspin1,3,m2,jspin2),&
     172        1806 :                   m1=-3,3,1),m2=-3,3,1)
     173             :           ENDDO
     174             :        ENDDO
     175             :     ENDIF
     176             : 8002 FORMAT (' so - angular matrix elements')
     177             : 8003 FORMAT (i8,14f8.4)
     178             : 
     179          14 :   END SUBROUTINE spnorb_angles
     180             : END MODULE m_spnorb

Generated by: LCOV version 1.13