LCOV - code coverage report
Current view: top level - global - soc_sym.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 28 30 93.3 %
Date: 2019-09-08 04:53:50 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          12 :       SUBROUTINE soc_sym(
      15          12 :      >                   nop,mrot,theta,phi,amat,
      16          12 :      <                   error)
      17             :       
      18             :       USE m_constants, ONLY : pimach
      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          12 :       pih= 0.5*pimach()
      32          12 :       CALL inv3(amat,ainv,test)
      33          12 :       st = sin(theta) ; sp = sin(phi) ; stt = sin(theta + pih)
      34          12 :       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          12 :       sqa(1) = st*cp ; n1(1) = stt*cp
      39          12 :       sqa(2) = st*sp ; n1(2) = stt*sp
      40          12 :       sqa(3) = ct    ; n1(3) = ctt
      41             : 
      42             :       CALL cross(sqa,n1,
      43          12 :      <           n2)
      44             : !dbg      write(*,*) n1
      45             : !dbg      write(*,*) n2
      46             : !
      47             : ! --> loop over symmetry elements
      48             : !
      49         100 :       error(:) = .false.
      50         100 :       DO iop = 1, nop
      51             :        
      52             : !        CALL matmul3(mrot(1,1,iop),ainv,rrot1)
      53          88 :         rrot1=matmul(mrot(:,:,iop),ainv)
      54             : !        CALL matmul2(amat,rrot1,rrot)
      55          88 :         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             : !        CALL cotra0(n1,nn1,rrot)
      61          88 :          nn1=matmul(rrot,n1)
      62             : !        CALL cotra0(n2,nn2,rrot)
      63          88 :          nn2=matmul(rrot,n2)
      64             : 
      65             :         CALL cross(nn1,nn2,
      66          88 :      <             ssqa)
      67             : !
      68             : ! ----> if ssqa is identical with sqa accept this symmetry element
      69             : !
      70          88 :         test = sqa(1)*ssqa(1) + sqa(2)*ssqa(2) + sqa(3)*ssqa(3) 
      71         100 :         IF (abs(test-1.0).GT.0.00001) THEN
      72          36 :           error(iop) = .true.
      73          36 :           WRITE (6,100) iop,test
      74             :         ENDIF
      75             :       ENDDO
      76             :  100  FORMAT ('Symmetry element no.',i3,' incompatible with SQA',f20.10)
      77             :       
      78          35 :       IF ( ANY(error(:)) ) THEN
      79             : !         CALL juDFT_warn
      80             : !     +        ("symmetry incompatible with SOC - Spin Quantization Axis"
      81             : !     +        ,calledby ="soc_sym")
      82           7 :          WRITE (6,*) 'symmetry incompatible with SOC - Spin Quant Axis'
      83             :       ENDIF
      84          12 :       END SUBROUTINE soc_sym
      85             : !---------------------------------------------------------------
      86           0 :       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         100 :       c(1) = a(2) * b(3) - a(3) * b(2)
      95         100 :       c(2) = a(3) * b(1) - a(1) * b(3)
      96         100 :       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.13