LCOV - code coverage report
Current view: top level - global - soc_sym.f (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 29 30 96.7 %
Date: 2024-04-26 04:44:34 Functions: 1 2 50.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_socsym
       8             :       use m_juDFT
       9             : !-----------------------------------------------------------------------!
      10             : ! tests the compatibility of the symmetry elements with the SQA defined !
      11             : ! by theta and phi in case of spin-orbit coupling.                gb`02 !
      12             : !-----------------------------------------------------------------------!
      13             :       CONTAINS
      14          16 :       SUBROUTINE soc_sym(
      15          16 :      >                   nop,mrot,theta,phi,amat,
      16          16 :      <                   error)
      17             :       
      18             :       USE m_constants
      19             :       USE m_inv3
      20             :       IMPLICIT NONE
      21             : 
      22             :       INTEGER, INTENT (IN)  :: nop, mrot(3,3,nop)
      23             :       REAL,    INTENT (IN)  :: theta, phi, amat(3,3)
      24             :       LOGICAL, INTENT (OUT) :: error(nop)
      25             : 
      26             :       INTEGER iop
      27             :       REAL st,ct,sp,cp,stt,ctt,pih,test,nn1n,nn2n
      28             :       REAL sqa(3),n1(3),n2(3),nn1(3),nn2(3),ssqa(3)
      29             :       REAL ainv(3,3),rrot(3,3),rrot1(3,3)
      30             : 
      31          16 :       pih= 0.5*pimach()
      32          16 :       CALL inv3(amat,ainv,test)
      33          16 :       st = sin(theta) ; sp = sin(phi) ; stt = sin(theta + pih)
      34          16 :       ct = cos(theta) ; cp = cos(phi) ; ctt = cos(theta + pih)
      35             : !
      36             : ! --> find two vectors n1,n2 normal to the spin-quantizatiopn axis (sqa)
      37             : !
      38          16 :       sqa(1) = st*cp ; n1(1) = stt*cp
      39          16 :       sqa(2) = st*sp ; n1(2) = stt*sp
      40          16 :       sqa(3) = ct    ; n1(3) = ctt
      41             : 
      42             :       CALL cross(sqa,n1,
      43          16 :      <           n2)
      44             : !dbg      write(*,*) n1
      45             : !dbg      write(*,*) n2
      46             : !
      47             : ! --> loop over symmetry elements
      48             : !
      49          73 :       error(:) = .false.
      50          73 :       DO iop = 1, nop
      51             :        
      52             : !        CALL matmul3(mrot(1,1,iop),ainv,rrot1)
      53        2964 :         rrot1=matmul(mrot(:,:,iop),ainv)
      54             : !        CALL matmul2(amat,rrot1,rrot)
      55        2280 :         rrot=matmul(amat,rrot1)
      56             : !
      57             : ! ----> rotate n1 and n2 by symmetry element and form the cross-product
      58             : !       of the rotated vectors (nn1,nn2) --> ssqa
      59             : !
      60         741 :          nn1=matmul(rrot,n1)
      61         741 :          nn2=matmul(rrot,n2)
      62             : 
      63             :         CALL cross(nn1,nn2,
      64          57 :      <             ssqa)
      65             : !
      66             : ! ----> if ssqa is identical with sqa accept this symmetry element
      67             : !
      68          57 :         test = sqa(1)*ssqa(1) + sqa(2)*ssqa(2) + sqa(3)*ssqa(3) 
      69          16 :         IF (abs(test-1.0).GT.0.00001) THEN
      70          12 :           error(iop) = .true.
      71          12 :           WRITE (oUnit,100) iop,test
      72             :         ENDIF
      73             :       ENDDO
      74             :  100  FORMAT ('Symmetry element no.',i3,
      75             :      +        ' incompatible with SQA',f20.10)
      76             :       
      77          51 :       IF ( ANY(error(:)) ) THEN
      78             : !         CALL juDFT_warn
      79             : !     +        ("symmetry incompatible with SOC - Spin Quantization Axis"
      80             : !     +        ,calledby ="soc_sym")
      81             :          WRITE (oUnit,*) 
      82           2 :      +      'symmetry incompatible with SOC - Spin Quant Axis'
      83             :       ENDIF
      84          16 :       END SUBROUTINE soc_sym
      85             : !---------------------------------------------------------------
      86          73 :       SUBROUTINE cross(
      87             :      >                 a,b,
      88             :      <                 c)
      89             : 
      90             :       IMPLICIT NONE
      91             :       REAL, INTENT  (IN) :: a(3),b(3)
      92             :       REAL, INTENT (OUT) :: c(3)
      93             : 
      94          73 :       c(1) = a(2) * b(3) - a(3) * b(2)
      95          73 :       c(2) = a(3) * b(1) - a(1) * b(3)
      96          73 :       c(3) = a(1) * b(2) - a(2) * b(1)
      97             : 
      98           0 :       END SUBROUTINE cross
      99             : 
     100             :       END MODULE m_socsym
     101             : 

Generated by: LCOV version 1.14