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,
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 :
42 : C ..
43 : C .. Local Scalars ..
44 : INTEGER itype,ineq,iatom,iop,ilo,i,l,m,lm,lmp,ifac
45 : C ..
46 : C .. Local Arrays ..
47 : c***** COMPLEX, ALLOCATABLE :: d_wgn(:,:,:,:) !put into module m_savewigner
48 : C
49 :
50 0 : IF ( .NOT.ALLOCATED(d_wgn) ) THEN !calculate d_wgn only once
51 0 : PRINT*,"calculate wigner-matrix"
52 0 : ALLOCATE (d_wgn(-lmaxd:lmaxd,-lmaxd:lmaxd,lmaxd,nop))
53 0 : d_wgn = CMPLX(0.0,0.0) ! Initialization is done to avoid complaints by Lord Valgrind
54 0 : CALL d_wigner(nop,mrot,bmat,lmaxd,d_wgn)
55 : ENDIF
56 :
57 0 : iatom=0
58 0 : DO itype=1,ntype
59 0 : DO ineq=1,neq(itype)
60 0 : iatom=iatom+1
61 0 : iop=ngopr(iatom)
62 :
63 : C l l l
64 : C inversion of spherical harmonics: Y (pi-theta,pi+phi) = (-1) * Y (theta,phi)
65 : C m m
66 0 : ifac = 1
67 0 : IF(invsat(iatom).EQ.2) THEN
68 0 : iop=ngopr(invsatnr(iatom))
69 0 : ifac = -1
70 : ENDIF
71 0 : DO l=1,lmax(itype)
72 : c replaced d_wgn by conjg(d_wgn),FF October 2006
73 0 : DO i=1,neig
74 0 : acof(i,l**2:l*(l+2),iatom) = ifac**l * matmul(
75 : & conjg(d_wgn(-l:l,-l:l,l,iop)),
76 0 : & acof(i,l**2:l*(l+2),iatom))
77 0 : bcof(i,l**2:l*(l+2),iatom) = ifac**l * matmul(
78 : & conjg(d_wgn(-l:l,-l:l,l,iop)),
79 0 : & bcof(i,l**2:l*(l+2),iatom))
80 : ENDDO
81 : ENDDO
82 0 : DO ilo=1,nlo(itype)
83 0 : l=llo(ilo,itype)
84 0 : IF(l.gt.0) THEN
85 0 : DO i=1,neig
86 0 : ccof(-l:l,i,ilo,iatom) = ifac**l * matmul(
87 : & conjg(d_wgn(-l:l,-l:l,l,iop)),
88 0 : & ccof(-l:l,i,ilo,iatom))
89 : ENDDO
90 : ENDIF
91 : ENDDO
92 : ENDDO
93 : ENDDO
94 :
95 0 : END SUBROUTINE abcrot
96 :
97 0 : END MODULE m_abcrot
|