Built a short routine to switch between harmonics.

main/fleur.F90

@@ -67,6 +67,7 @@ CONTAINS
    USE m_metagga
    USE m_plot
    USE m_xcBfield
+   USE m_lh_tofrom_lm
 #ifdef CPP_MPI
    USE m_mpi_bc_potden
 #endif
@@ -115,6 +116,8 @@ CONTAINS
     INCLUDE 'mpif.h'
     INTEGER :: ierr(2),n
 #endif
+    REAL, ALLOCATABLE :: flh(:,:),flh2(:,:)
+    COMPLEX, ALLOCATABLE :: flm(:,:) 
 
     mpi%mpi_comm = mpi_comm
 
@@ -519,19 +522,32 @@ CONTAINS
 
     !CALL builddivtest(stars,atoms,sphhar,vacuum,sym,cell,1,testDen)
    !CALL makeVectorField(stars,atoms,sphhar,vacuum,input,noco,inDen,1.0,testDen)
-   CALL makeVectorField(stars,atoms,sphhar,vacuum,input,noco,vtot,2.0,testDen)
+   !CALL makeVectorField(stars,atoms,sphhar,vacuum,input,noco,vtot,2.0,testDen)
     !CALL checkplotinp()
-   CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, .FALSE., .FALSE., 'testDen             ', testDen(1), testDen(1), testDen(2), testDen(3))
+   !CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, .FALSE., .FALSE., 'testDen             ', testDen(1), testDen(1), testDen(2), testDen(3))
     !CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, .FALSE., .FALSE., 'testDeny            ', testDen(2))
     !CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, .FALSE., .FALSE., 'testDenz            ', testDen(3))
-   CALL sourcefree(mpi,dimension,field,stars,atoms,sphhar,vacuum,input,oneD,sym,cell,noco,testDen)
+   !CALL sourcefree(mpi,dimension,field,stars,atoms,sphhar,vacuum,input,oneD,sym,cell,noco,testDen)
     !DO i=1,3
        !CALL testGrad(i)%init_potden_simple(stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype,atoms%n_u,1,.FALSE.,.FALSE.,POTDEN_TYPE_POTTOT,vacuum%nmzd,vacuum%nmzxyd,stars%ng2)
        !ALLOCATE(testGrad(i)%pw_w,mold=testGrad(i)%pw)
     !ENDDO
     !CALL divpotgrad(stars,atoms,sphhar,vacuum,sym,cell,noco,testDen(3),testGrad)
     !CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, .FALSE., .FALSE., 'testGrad            ', testGrad(1), testGrad(1), testGrad(2), testGrad(3))
-
+   
+   ALLOCATE (flh(atoms%jri(1),0:sphhar%nlh(atoms%ntypsy(1))),flm(atoms%jri(1),sphhar%nlh(atoms%ntypsy(1))+1),flh2(atoms%jri(1),0:sphhar%nlh(atoms%ntypsy(1))))
+   flh=inDen%mt(:,:,1,1)
+   flh(:,1)=-flh(:,0)
+   flh(:,2)=0*flh(:,0)
+   flh(:,3)=flh(:,0)
+   flh(:,4)=flh(:,0)
+   flh(:,5)=2*flh(:,0)
+   flh(:,6)=3*flh(:,0)
+   flh(:,7)=4*flh(:,0)
+   flh(:,8)=5*flh(:,0)
+   CALL lh_to_lm(atoms, sphhar, 1, flh, flm) 
+   CALL lh_from_lm(atoms, sphhar, 1, flm, flh2) 
+    
     CALL add_usage_data("Iterations",iter)
 
     IF (mpi%irank.EQ.0) CALL closeXMLElement('scfLoop')

math/CMakeLists.txt

@@ -32,6 +32,7 @@ math/DoubleFactorial.f90
 math/ExpSave.f90
 math/intgr.F90
 math/ylm4.F90
+math/lh_tofrom_lm.f90
 )
 if (FLEUR_USE_FFTMKL)
    set(fleur_F90 ${fleur_F90} math/mkl_dfti.f90)

math/lh_tofrom_lm.f90

+MODULE m_lh_tofrom_lm
+
+CONTAINS
+   SUBROUTINE lh_to_lm(atoms, lathar, iType, flh, flm)
+      USE m_types
+      IMPLICIT NONE
+
+      TYPE(t_atoms),  INTENT(IN)    :: atoms
+      TYPE(t_sphhar), INTENT(IN)    :: lathar
+      INTEGER,        INTENT(IN)    :: iType
+      REAL,           INTENT(IN)    :: flh(:,0:) ! (iR,iLH)
+      COMPLEX,        INTENT(INOUT) :: flm(:,:) ! (iR,lm)
+
+      INTEGER :: iAtom, iLH, ns, l, iM, m, lm, iR, lh, imem
+      COMPLEX, ALLOCATABLE :: cMat(:,:), gVec(:,:)
+      REAL, ALLOCATABLE :: fVec(:,:)
+
+      iAtom = SUM(atoms%neq(:iType-1)) + 1
+      ns = atoms%ntypsy(iAtom)
+
+      flm = CMPLX(0.0,0.0)
+
+      DO l = 0, atoms%lmax(iType)
+         ALLOCATE (cMat(-l:l,-l:l))
+         ALLOCATE (fVec(-l:l,atoms%jri(iType)))
+         ALLOCATE (gVec(-l:l,atoms%jri(iType)))
+         
+         cMat=CMPLX(0.0,0.0)
+         
+         DO M = -l, l
+            lh = l*(l+1)+M
+            fVec(M,:)=flh(:,lh)
+            DO imem = 1, lathar%nmem(lh,ns)
+               cMat(M,lathar%mlh(imem,lh,ns))=lathar%clnu(imem,lh,ns)
+            END DO
+         END DO
+   
+         DO iR = 1, atoms%jri(iType)
+            gVec(:,iR)=MATMUL(fVec(:,iR),cMat)
+         END DO
+
+         DO m = -l, l
+            flm(:,l*(l+1)+1+m)=gVec(m,:) 
+         END DO
+         
+         DEALLOCATE (cMat,fVec,gVec)
+      END DO
+
+   END SUBROUTINE lh_to_lm
+
+   SUBROUTINE lh_from_lm(atoms, lathar, iType, flm, flh)
+      USE m_types
+      IMPLICIT NONE
+
+      TYPE(t_atoms),  INTENT(IN)    :: atoms
+      TYPE(t_sphhar), INTENT(IN)    :: lathar
+      INTEGER,        INTENT(IN)    :: iType
+      COMPLEX,        INTENT(IN)    :: flm(:,:) ! (iR,lm)
+      REAL,           INTENT(INOUT) :: flh(:,0:) ! (iR,iLH)
+
+
+      INTEGER :: iAtom, iLH, ns, l, iM, m, lm, iR, info, lh, imem, info2
+      INTEGER, ALLOCATABLE :: ipiv(:)
+      COMPLEX, ALLOCATABLE :: cMat(:,:),fVec(:,:)
+
+      EXTERNAL zgetrf, zgetrs
+
+      iAtom = SUM(atoms%neq(:iType-1)) + 1
+      ns = atoms%ntypsy(iAtom)
+
+      flh = 0.0
+ 
+      DO l = 0, atoms%lmax(iType)
+         ALLOCATE (cMat(-l:l,-l:l))
+         ALLOCATE (fVec(-l:l,atoms%jri(iType)))
+         ALLOCATE (ipiv(-l:l))
+         
+         cMat=CMPLX(0.0,0.0)
+         
+         DO M = -l, l
+            lh = l*(l+1)+M
+            fVec(M,:)=flm(:,lh+1)
+            DO imem = 1, lathar%nmem(lh,ns)
+               cMat(M,lathar%mlh(imem,lh,ns))=lathar%clnu(imem,lh,ns)
+            END DO
+         END DO
+
+         CALL zgetrf(2*l+1,2*l+1,cMat,2*l+1,ipiv,info)
+   
+         DO iR = 1, atoms%jri(iType)
+            CALL zgetrs('T',2*l+1,1,cMat,2*l+1,ipiv,fVec(:,iR),2*l+1,info2)
+         END DO
+
+         DO M = -l, l
+            flh(:,l*(l+1)+M)=REAL(fVec(M,:)) 
+         END DO
+         
+         DEALLOCATE (cMat,fVec,ipiv)
+      END DO
+
+   END SUBROUTINE lh_from_lm
+
+END MODULE m_lh_tofrom_lm

[Alexander Neukirchen]

@micha The routine seems to work just fine considering a to and from test. Thanks for the initial snippet I could start from! :)