Commit d50adb78 authored by Henning Janssen's avatar Henning Janssen

More efficient index order in types_greensf

parent 59667049
......@@ -81,18 +81,18 @@ SUBROUTINE calc_onsite(atoms,input,sym,noco,angle,greensfCoeffs,g)
DO m= -l,l
DO mp= -lp,lp
CALL kkintgr(REAL(greensfCoeffs%projdos(1:kkcut,m,mp,0,i_gf,jspin)),greensfCoeffs%e_bot,greensfCoeffs%del,kkcut,&
g%gmmpMat(:,i_gf,m,mp,jspin,ipm),g%e,(ipm.EQ.2),g%mode,g%nz,int_method(g%mode))
g%gmmpMat(:,m,mp,jspin,ipm,i_gf),g%e,(ipm.EQ.2),g%mode,g%nz,int_method(g%mode))
IF(.NOT.input%l_gfsphavg) THEN
! In the case of radial dependence we perform the kramers-kronig-integration seperately for uu,dd,etc.
! We can do this because the radial functions are independent of E
CALL kkintgr(REAL(greensfCoeffs%uu(1:kkcut,m,mp,0,i_gf,jspin)),greensfCoeffs%e_bot,greensfCoeffs%del,kkcut,&
g%uu(:,i_gf,m,mp,jspin,ipm),g%e,(ipm.EQ.2),g%mode,g%nz,int_method(g%mode))
g%uu(:,m,mp,jspin,ipm,i_gf),g%e,(ipm.EQ.2),g%mode,g%nz,int_method(g%mode))
CALL kkintgr(REAL(greensfCoeffs%dd(1:kkcut,m,mp,0,i_gf,jspin)),greensfCoeffs%e_bot,greensfCoeffs%del,kkcut,&
g%dd(:,i_gf,m,mp,jspin,ipm),g%e,(ipm.EQ.2),g%mode,g%nz,int_method(g%mode))
g%dd(:,m,mp,jspin,ipm,i_gf),g%e,(ipm.EQ.2),g%mode,g%nz,int_method(g%mode))
CALL kkintgr(REAL(greensfCoeffs%du(1:kkcut,m,mp,0,i_gf,jspin)),greensfCoeffs%e_bot,greensfCoeffs%del,kkcut,&
g%du(:,i_gf,m,mp,jspin,ipm),g%e,(ipm.EQ.2),g%mode,g%nz,int_method(g%mode))
g%du(:,m,mp,jspin,ipm,i_gf),g%e,(ipm.EQ.2),g%mode,g%nz,int_method(g%mode))
CALL kkintgr(REAL(greensfCoeffs%ud(1:kkcut,m,mp,0,i_gf,jspin)),greensfCoeffs%e_bot,greensfCoeffs%del,kkcut,&
g%ud(:,i_gf,m,mp,jspin,ipm),g%e,(ipm.EQ.2),g%mode,g%nz,int_method(g%mode))
g%ud(:,m,mp,jspin,ipm,i_gf),g%e,(ipm.EQ.2),g%mode,g%nz,int_method(g%mode))
ENDIF
ENDDO
ENDDO
......@@ -127,8 +127,8 @@ SUBROUTINE calc_onsite(atoms,input,sym,noco,angle,greensfCoeffs,g)
phase = exp(ImagUnit*angle(isi))
DO m = -l,l
DO mp = -l,l
g%gmmpMat(ie,i_gf,m,mp,3,ipm) =&
g%gmmpMat(ie,i_gf,m,mp,3,ipm) + phase * fac * conjg(calc_mat(m,mp))
g%gmmpMat(ie,m,mp,3,ipm,i_gf) =&
g%gmmpMat(ie,m,mp,3,ipm,i_gf) + phase * fac * conjg(calc_mat(m,mp))
ENDDO
ENDDO
ENDDO!ie
......
......@@ -319,14 +319,14 @@ MODULE m_hubbard1_io
WRITE(io_unit,9020) gOnsite%e(iz)
WRITE(io_unit,"(A)") "Spin up"
WRITE(io_unit,"(A)") " Real part"
WRITE(io_unit,9010) REAL(gOnsite%gmmpMat(iz,i_gf,:,:,1,ipm))
WRITE(io_unit,9010) REAL(gOnsite%gmmpMat(iz,:,:,1,ipm,i_gf))
WRITE(io_unit,"(A)") " Imaginary part"
WRITE(io_unit,9010) AIMAG(gOnsite%gmmpMat(iz,i_gf,:,:,1,ipm))
WRITE(io_unit,9010) AIMAG(gOnsite%gmmpMat(iz,:,:,1,ipm,i_gf))
WRITE(io_unit,"(A)") "Spin down"
WRITE(io_unit,"(A)") " Real part"
WRITE(io_unit,9010) REAL(gOnsite%gmmpMat(iz,i_gf,:,:,2,ipm))
WRITE(io_unit,9010) REAL(gOnsite%gmmpMat(iz,:,:,2,ipm,i_gf))
WRITE(io_unit,"(A)") " Imaginary part"
WRITE(io_unit,9010) AIMAG(gOnsite%gmmpMat(iz,i_gf,:,:,2,ipm))
WRITE(io_unit,9010) AIMAG(gOnsite%gmmpMat(iz,:,:,2,ipm,i_gf))
ENDDO
CLOSE(unit=io_unit)
ENDDO
......
......@@ -118,13 +118,13 @@ MODULE m_types_greensf
IF(atoms%n_gf.GT.0) THEN !Are there Green's functions to be calculated?
spin_dim = MERGE(3,input%jspins,input%l_gfmperp)
ALLOCATE (thisGREENSF%gmmpMat(thisGREENSF%nz,MAX(1,atoms%n_gf),-lmax:lmax,-lmax:lmax,spin_dim,2))
ALLOCATE ( thisGREENSF%gmmpMat(thisGREENSF%nz,-lmax:lmax,-lmax:lmax,spin_dim,2,MAX(1,atoms%n_gf)) )
thisGREENSF%gmmpMat = 0.0
IF(.NOT.input%l_gfsphavg) THEN
ALLOCATE (thisGREENSF%uu(thisGREENSF%nz,MAX(1,atoms%n_gf),-lmax:lmax,-lmax:lmax,spin_dim,2))
ALLOCATE (thisGREENSF%dd(thisGREENSF%nz,MAX(1,atoms%n_gf),-lmax:lmax,-lmax:lmax,spin_dim,2))
ALLOCATE (thisGREENSF%du(thisGREENSF%nz,MAX(1,atoms%n_gf),-lmax:lmax,-lmax:lmax,spin_dim,2))
ALLOCATE (thisGREENSF%ud(thisGREENSF%nz,MAX(1,atoms%n_gf),-lmax:lmax,-lmax:lmax,spin_dim,2))
ALLOCATE ( thisGREENSF%uu(thisGREENSF%nz,-lmax:lmax,-lmax:lmax,spin_dim,2,MAX(1,atoms%n_gf)) )
ALLOCATE ( thisGREENSF%dd(thisGREENSF%nz,-lmax:lmax,-lmax:lmax,spin_dim,2,MAX(1,atoms%n_gf)) )
ALLOCATE ( thisGREENSF%du(thisGREENSF%nz,-lmax:lmax,-lmax:lmax,spin_dim,2,MAX(1,atoms%n_gf)) )
ALLOCATE ( thisGREENSF%ud(thisGREENSF%nz,-lmax:lmax,-lmax:lmax,spin_dim,2,MAX(1,atoms%n_gf)) )
thisGREENSF%uu = 0.0
thisGREENSF%dd = 0.0
thisGREENSF%du = 0.0
......@@ -427,11 +427,11 @@ MODULE m_types_greensf
ELSE
IF(ispin.EQ.2.AND.input%jspins.EQ.1) THEN
!In this case the ordering of m and mp has to be reversed
gmat%data_c(ind1,ind2) = this%gmmpMat(iz,i_gf,-m,-mp,spin_ind,ipm)
gmat%data_c(ind1,ind2) = this%gmmpMat(iz,-m,-mp,spin_ind,ipm,i_gf)
ELSE IF(ispin.EQ.4) THEN
gmat%data_c(ind1,ind2) = conjg(this%gmmpMat(iz,i_gf,mp,m,spin_ind,ipm))
gmat%data_c(ind1,ind2) = conjg(this%gmmpMat(iz,mp,m,spin_ind,ipm,i_gf))
ELSE
gmat%data_c(ind1,ind2) = this%gmmpMat(iz,i_gf,m,mp,spin_ind,ipm)
gmat%data_c(ind1,ind2) = this%gmmpMat(iz,m,mp,spin_ind,ipm,i_gf)
ENDIF
IF(l_full) gmat%data_c(ind1,ind2) = gmat%data_c(ind1,ind2)/(3-input%jspins)
ENDIF
......@@ -527,7 +527,7 @@ MODULE m_types_greensf
ind2 = ind2_start
DO mp = -lp_loop,lp_loop
ind2 = ind2 + 1
this%gmmpMat(iz,i_gf,m,mp,ispin,ipm) = gmat%data_c(ind1,ind2)*MERGE(1,2/input%jspins,PRESENT(spin))
this%gmmpMat(iz,m,mp,ispin,ipm,i_gf) = gmat%data_c(ind1,ind2)*MERGE(1,2/input%jspins,PRESENT(spin))
ENDDO
ENDDO
ENDDO
......@@ -570,12 +570,12 @@ MODULE m_types_greensf
ENDIF
DO i_gf = MERGE(1,i_reset,lFullreset), MERGE(atoms%n_gf,i_reset,lFullreset)
this%gmmpMat(:,i_gf,:,:,:,:) = 0.0
this%gmmpMat(:,:,:,:,:,i_gf) = 0.0
IF(.NOT.input%l_gfsphavg) THEN
this%uu(:,i_gf,:,:,:,:) = 0.0
this%ud(:,i_gf,:,:,:,:) = 0.0
this%du(:,i_gf,:,:,:,:) = 0.0
this%dd(:,i_gf,:,:,:,:) = 0.0
this%uu(:,:,:,:,:,i_gf) = 0.0
this%ud(:,:,:,:,:,i_gf) = 0.0
this%du(:,:,:,:,:,i_gf) = 0.0
this%dd(:,:,:,:,:,i_gf) = 0.0
ENDIF
ENDDO
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment