LCOV - code coverage report
Current view: top level - global - abcrot.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 35 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2017 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_abcrot
       8             : 
       9             :       CONTAINS
      10             : 
      11           0 :       SUBROUTINE abcrot(
      12           0 :      >                 ntypd,natd,neigd,lmaxd,lmd,llod,nlod,ntype,neq,
      13           0 :      >                 neig,lmax,nlo,llo,nop,ngopr,mrot,invsat,invsatnr,
      14             :      >                 bmat,odi,ods,
      15           0 :      X                 acof,bcof,ccof)
      16             : C     ***************************************************************
      17             : C     * This routine transforms a/b/cof which are given wrt rotated *
      18             : C     * MT functions (according to invsat/ngopr) into a/b/cof wrt   *
      19             : C     * unrotated MT functions. Needed for GW calculations.         *
      20             : C     *                                                             *
      21             : C     * Christoph Friedrich Mar/2005                                *
      22             : C     ***************************************************************
      23             :       USE m_dwigner
      24             :       use m_savewigner
      25             :       USE m_types
      26             :       IMPLICIT NONE
      27             : C     ..
      28             : C     .. Scalar Arguments ..
      29             :       INTEGER, INTENT (IN) :: ntypd,natd,neigd,lmd,llod,nlod,ntype,nop
      30             :       INTEGER, INTENT (IN) :: lmaxd,neig
      31             : C     ..
      32             : C     .. Array Arguments ..
      33             :       INTEGER, INTENT (IN) :: neq(ntypd),lmax(ntypd),nlo(ntypd)
      34             :       INTEGER, INTENT (IN) :: llo(nlod,ntypd),ngopr(natd),mrot(3,3,nop)
      35             :       INTEGER, INTENT (IN) :: invsat(natd),invsatnr(natd)
      36             : 
      37             :       REAL,    INTENT (IN) :: bmat(3,3)
      38             :       COMPLEX, INTENT (INOUT) :: acof(neigd,0:lmd,natd)
      39             :       COMPLEX, INTENT (INOUT) :: bcof(neigd,0:lmd,natd)
      40             :       COMPLEX, INTENT (INOUT) :: ccof(-llod:llod,neigd,nlod,natd)
      41             : c-odim
      42             :       TYPE (od_inp), INTENT (IN) :: odi
      43             :       TYPE (od_sym), INTENT (IN) :: ods
      44             : c+odim
      45             : C     ..
      46             : C     .. Local Scalars ..
      47             :       INTEGER itype,ineq,iatom,iop,ilo,i,l,m,lm,lmp,ifac
      48             : C     ..
      49             : C     .. Local Arrays ..
      50             : c***** COMPLEX, ALLOCATABLE :: d_wgn(:,:,:,:) !put into module m_savewigner
      51             : C
      52             : 
      53           0 :       IF ( .NOT.ALLOCATED(d_wgn) ) THEN    !calculate d_wgn only once
      54           0 :         PRINT*,"calculate wigner-matrix"
      55           0 :         IF (.NOT.odi%d1) THEN
      56           0 :           ALLOCATE (d_wgn(-lmaxd:lmaxd,-lmaxd:lmaxd,lmaxd,nop))
      57           0 :           d_wgn = CMPLX(0.0,0.0) ! Initialization is done to avoid complaints by Lord Valgrind
      58           0 :           CALL d_wigner(nop,mrot,bmat,lmaxd,d_wgn)
      59             :         ELSE
      60           0 :           ALLOCATE (d_wgn(-lmaxd:lmaxd,-lmaxd:lmaxd,lmaxd,ods%nop))
      61           0 :           d_wgn = CMPLX(0.0,0.0) ! Initialization is done to avoid complaints by Lord Valgrind
      62           0 :           CALL d_wigner(ods%nop,ods%mrot,bmat,lmaxd,d_wgn)
      63             :         ENDIF
      64             :       ENDIF
      65             : 
      66           0 :       iatom=0
      67           0 :       DO itype=1,ntype
      68           0 :         DO ineq=1,neq(itype)
      69           0 :           iatom=iatom+1
      70           0 :           IF (.NOT.odi%d1) THEN
      71           0 :              iop=ngopr(iatom)
      72             :           ELSE
      73           0 :              iop=ods%ngopr(iatom)
      74             :           ENDIF
      75             : C                                    l                        l    l
      76             : C inversion of spherical harmonics: Y (pi-theta,pi+phi) = (-1)  * Y (theta,phi)
      77             : C                                    m                             m
      78           0 :           ifac = 1
      79           0 :           IF(invsat(iatom).EQ.2) THEN
      80           0 :             IF (.NOT.odi%d1) THEN
      81           0 :                iop=ngopr(invsatnr(iatom))
      82             :             ELSE
      83           0 :                iop=ods%ngopr(invsatnr(iatom))
      84             :             ENDIF
      85             :             ifac = -1 
      86             :           ENDIF
      87           0 :           DO l=1,lmax(itype)
      88             : c  replaced d_wgn by conjg(d_wgn),FF October 2006
      89           0 :             DO i=1,neig
      90             :               acof(i,l**2:l*(l+2),iatom) = ifac**l * matmul(
      91             :      &                                 conjg(d_wgn(-l:l,-l:l,l,iop)),
      92           0 :      &                                 acof(i,l**2:l*(l+2),iatom))
      93             :               bcof(i,l**2:l*(l+2),iatom) = ifac**l * matmul(
      94             :      &                                 conjg(d_wgn(-l:l,-l:l,l,iop)),
      95           0 :      &                                 bcof(i,l**2:l*(l+2),iatom))
      96             :             ENDDO
      97             :           ENDDO
      98           0 :           DO ilo=1,nlo(itype)
      99           0 :             l=llo(ilo,itype)
     100           0 :             IF(l.gt.0) THEN
     101           0 :               DO i=1,neig
     102             :                 ccof(-l:l,i,ilo,iatom) = ifac**l * matmul(
     103             :      &                               conjg(d_wgn(-l:l,-l:l,l,iop)),
     104           0 :      &                               ccof(-l:l,i,ilo,iatom))
     105             :               ENDDO
     106             :             ENDIF
     107             :           ENDDO
     108             :         ENDDO
     109             :       ENDDO
     110             : 
     111           0 :       END SUBROUTINE abcrot
     112             : 
     113             :       END MODULE m_abcrot

Generated by: LCOV version 1.13