LCOV - code coverage report
Current view: top level - cdn_mt - abcrot2.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 42 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 2 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_abcrot2
       8             :   PRIVATE
       9             :   PUBLIC :: abcrot2
      10             : CONTAINS
      11           0 :   SUBROUTINE abcrot2(atoms,banddos,neig,eigVecCoeffs,jsp)
      12             :     USE m_dwigner
      13             :     USE m_types
      14             :     IMPLICIT NONE
      15             : 
      16             :     TYPE(t_atoms),INTENT(IN)           :: atoms
      17             :     TYPE(t_banddos),INTENT(IN)         :: banddos
      18             :     TYPE(t_eigVecCoeffs),INTENT(INOUT) :: eigVecCoeffs
      19             :     !     ..
      20             :     !     .. Scalar Arguments ..
      21             :     INTEGER, INTENT (IN) :: neig,jsp
      22             :     !     ..
      23             :     !     .. Local Scalars ..
      24             :     INTEGER itype,ineq,iatom,iop,ilo,i,l ,lm,lmp,ifac
      25             :     REAL amx(3,3,1),imx(3,3)
      26           0 :     COMPLEX  d_wgn(-atoms%lmaxd:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,1:atoms%lmaxd,1)
      27             : 
      28             :     
      29           0 :     CALL euler(banddos%alpha,banddos%beta,banddos%gamma, amx)
      30             : 
      31           0 :     imx(:,:) = 0. ; imx(1,1) = 1. ; imx(2,2) = 1. ; imx(3,3) = 1.
      32             : 
      33           0 :     CALL d_wigner(1,amx,imx,atoms%lmaxd, d_wgn)
      34             : 
      35           0 :     iatom = 0
      36           0 :     iop = 1
      37           0 :     DO itype = 1, atoms%ntype
      38           0 :        DO ineq = 1, atoms%neq(itype)
      39           0 :           iatom = iatom + 1
      40           0 :           DO l = 1, atoms%lmax(itype)
      41             : 
      42           0 :              DO i = 1, neig
      43             :                 eigVecCoeffs%acof(i,l**2:l*(l+2),iatom,jsp) = MATMUL(CONJG(d_wgn(-l:l,-l:l,l,iop)),&
      44           0 :                                                                      eigVecCoeffs%acof(i,l**2:l*(l+2),iatom,jsp))
      45             :                 eigVecCoeffs%bcof(i,l**2:l*(l+2),iatom,jsp) = MATMUL(CONJG(d_wgn(-l:l,-l:l,l,iop)),&
      46           0 :                                                                      eigVecCoeffs%bcof(i,l**2:l*(l+2),iatom,jsp))
      47             :              ENDDO
      48             :           ENDDO
      49           0 :           DO ilo = 1, atoms%nlo(itype)
      50           0 :              l = atoms%llo(ilo,itype)
      51           0 :              IF (l.GT.0) THEN
      52           0 :                 DO i = 1 ,neig
      53             :                    eigVecCoeffs%ccof(-l:l,i,ilo,iatom,jsp) = MATMUL(CONJG(d_wgn(-l:l,-l:l,l,iop)),&
      54           0 :                                                                     eigVecCoeffs%ccof(-l:l,i,ilo,iatom,jsp))
      55             :                 ENDDO
      56             :              ENDIF
      57             :           ENDDO
      58             :        ENDDO
      59             :     ENDDO
      60           0 :   END SUBROUTINE abcrot2
      61             : 
      62             :   !********************************************************************
      63             :   !********************************************************************
      64           0 :   SUBROUTINE euler(alpha,beta,gamma,amx)
      65             :     IMPLICIT NONE
      66             : 
      67             :     REAL,    INTENT (IN)  :: alpha,beta,gamma 
      68             :     REAL,    INTENT (OUT) :: amx(3,3,1)
      69             : 
      70             :     REAL  alph,bet,gamm
      71             :     REAL bmx(3,3),cmx(3,3),dmx(3,3),hmx(3,3)
      72             :     INTEGER nwf,i,j,ii
      73             : 
      74             :     !..define the D,C,B-matrices
      75           0 :     amx(:,:,:)=0.
      76             : 
      77           0 :     alph = alpha ; bet = beta ; gamm = gamma
      78             : 
      79           0 :     dmx(1,1) = COS(alph) ; dmx(1,2) = SIN(alph) ; dmx(1,3) = 0. 
      80           0 :     dmx(2,1) =-SIN(alph) ; dmx(2,2) = COS(alph) ; dmx(2,3) = 0. 
      81           0 :     dmx(3,1) = 0.        ; dmx(3,2) = 0.        ; dmx(3,3) = 1. 
      82             : 
      83           0 :     cmx(1,1) = 1.  ; cmx(1,2) = 0.        ; cmx(1,3) = 0. 
      84           0 :     cmx(2,1) = 0.  ; cmx(2,2) = COS(bet)  ; cmx(2,3) = SIN(bet)
      85           0 :     cmx(3,1) = 0.  ; cmx(3,2) =-SIN(bet)  ; cmx(3,3) = COS(bet)
      86             : 
      87           0 :     bmx(1,1) = COS(gamm) ; bmx(1,2) = SIN(gamm) ; bmx(1,3) = 0. 
      88           0 :     bmx(2,1) =-SIN(gamm) ; bmx(2,2) = COS(gamm) ; bmx(2,3) = 0. 
      89           0 :     bmx(3,1) = 0.        ; bmx(3,2) = 0.        ; bmx(3,3) = 1. 
      90             : 
      91           0 :     hmx(:,:) = 0. 
      92           0 :     DO i = 1,3
      93           0 :        DO j = 1,3
      94           0 :           DO ii = 1,3
      95           0 :              hmx(i,j) = hmx(i,j) + cmx(i,ii)*dmx(ii,j)
      96             :           ENDDO
      97             :        ENDDO
      98             :     ENDDO
      99             : 
     100           0 :     DO i = 1,3
     101           0 :        DO j = 1,3
     102           0 :           DO ii = 1,3
     103           0 :              amx(i,j,1) = amx(i,j,1) + bmx(i,ii)*hmx(ii,j)
     104             :           ENDDO
     105             :        ENDDO
     106             :     ENDDO
     107             : 
     108           0 :   END SUBROUTINE euler
     109             : 
     110             : END MODULE m_abcrot2

Generated by: LCOV version 1.13