hyb_abcrot.F90 3.59 KB
Newer Older
Daniel Wortmann's avatar
Daniel Wortmann committed
1

2
MODULE m_hyb_abcrot
Daniel Wortmann's avatar
Daniel Wortmann committed
3
  CONTAINS
4
      SUBROUTINE hyb_abcrot(hybrid,atoms,neig,sym,cell,oneD,&
5 6 7 8 9 10 11 12 13 14 15
     &                 acof,bcof,ccof)
!     ***************************************************************
!     * This routine transforms a/b/cof which are given wrt rotated *
!     * MT functions (according to invsat/ngopr) into a/b/cof wrt   *
!     * unrotated MT functions. Needed for GW calculations.         *
!     *                                                             *
!     * Christoph Friedrich Mar/2005                                *
!     ***************************************************************
      USE m_dwigner
      USE m_types
      IMPLICIT NONE
Daniel Wortmann's avatar
Daniel Wortmann committed
16
      TYPE(t_hybrid),INTENT(IN) :: hybrid
17
      TYPE(t_oneD),INTENT(IN)   :: oneD
Daniel Wortmann's avatar
Daniel Wortmann committed
18
      TYPE(t_sym),INTENT(IN)    :: sym
19
      TYPE(t_cell),INTENT(IN)   :: cell
Daniel Wortmann's avatar
Daniel Wortmann committed
20
      TYPE(t_atoms),INTENT(IN)  :: atoms  
21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
!     ..
!     .. Scalar Arguments ..
      INTEGER, INTENT (IN) :: neig
!     ..
!     .. Array Arguments ..

      COMPLEX, INTENT (INOUT) :: acof(:,0:,:) !(dimension%neigd,0:dimension%lmd,atoms%natd)
      COMPLEX, INTENT (INOUT) :: bcof(:,0:,:) !(dimension%neigd,0:dimension%lmd,atoms%natd)
      COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-llod:llod,dimension%neigd,atoms%nlod,atoms%natd)
!     ..
!     .. Local Scalars ..
      INTEGER itype,ineq,iatom,iop,ilo,i,l ,lm,lmp,ifac
!     ..
!     .. Local Arrays ..
!***** COMPLEX, ALLOCATABLE :: d_wgn(:,:,:,:) !put into module m_savewigner
!

Daniel Wortmann's avatar
Daniel Wortmann committed
38
      IF ( .NOT.ALLOCATED(hybrid%d_wgn2) ) THEN    !calculate sym%d_wgn only once
39 40 41
#ifndef CPP_MPI
        PRINT*,"calculate wigner-matrix"
#endif
Daniel Wortmann's avatar
Daniel Wortmann committed
42 43 44 45 46 47 48 49
        STOP "WIGNER MATRIX should be available in hybrid part"
        !IF (.NOT.oneD%odi%d1) THEN
        !  ALLOCATE (sym%d_wgn(-atoms%lmaxd:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,sym%nop))
        !  CALL d_wigner(sym%nop,sym%mrot,cell%bmat,atoms%lmaxd,sym%d_wgn)
        !ELSE
        !  ALLOCATE (sym%d_wgn(-atoms%lmaxd:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,oneD%ods%nop))
        !  CALL d_wigner(oneD%ods%nop,oneD%ods%mrot,cell%bmat,atoms%lmaxd,sym%d_wgn)
        !ENDIF
50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
      ENDIF

      iatom=0
      DO itype=1,atoms%ntype
        DO ineq=1,atoms%neq(itype)
          iatom=iatom+1
          IF (.NOT.oneD%odi%d1) THEN
             iop=atoms%ngopr(iatom)
          ELSE
             iop=oneD%ods%ngopr(iatom)
          ENDIF
!                                    l                        l    l
! inversion of spherical harmonics: Y (pi-theta,pi+phi) = (-1)  * Y (theta,phi)
!                                    m                             m
          ifac = 1
          IF(atoms%invsat(iatom).EQ.2) THEN
            IF (.NOT.oneD%odi%d1) THEN
               iop=atoms%ngopr(sym%invsatnr(iatom))
            ELSE
               iop=oneD%ods%ngopr(sym%invsatnr(iatom))
            ENDIF
            ifac = -1 
          ENDIF
          DO l=1,atoms%lmax(itype)
!  replaced d_wgn by conjg(d_wgn),FF October 2006
            DO i=1,neig
Daniel Wortmann's avatar
Daniel Wortmann committed
76 77
              acof(i,l**2:l*(l+2),iatom) = ifac**l * matmul(conjg(hybrid%d_wgn2(-l:l,-l:l,l,iop)), acof(i,l**2:l*(l+2),iatom))
              bcof(i,l**2:l*(l+2),iatom) = ifac**l * matmul(conjg(hybrid%d_wgn2(-l:l,-l:l,l,iop)), bcof(i,l**2:l*(l+2),iatom))
78 79 80 81 82 83
            ENDDO
          ENDDO
          DO ilo=1,atoms%nlo(itype)
            l=atoms%llo(ilo,itype)
            IF(l.gt.0) THEN
              DO i=1,neig
Daniel Wortmann's avatar
Daniel Wortmann committed
84
                ccof(-l:l,i,ilo,iatom) = ifac**l * matmul(conjg(hybrid%d_wgn2(-l:l,-l:l,l,iop)), ccof(-l:l,i,ilo,iatom))
85 86 87 88 89 90
              ENDDO
            ENDIF
          ENDDO
        ENDDO
      ENDDO

91 92
    END SUBROUTINE hyb_abcrot
  END MODULE m_hyb_abcrot