Commit e89fd760 authored by Gregor Michalicek's avatar Gregor Michalicek

Introduce new genMTBasis subroutine

parent 0304c478
...@@ -46,8 +46,7 @@ CONTAINS ...@@ -46,8 +46,7 @@ CONTAINS
! !
USE m_constants USE m_constants
USE m_eig66_io,ONLY: write_dos USE m_eig66_io,ONLY: write_dos
USE m_radfun USE m_genMTBasis
USE m_radflo
USE m_rhomt USE m_rhomt
USE m_rhonmt USE m_rhonmt
USE m_rhomtlo USE m_rhomtlo
...@@ -124,19 +123,16 @@ CONTAINS ...@@ -124,19 +123,16 @@ CONTAINS
! .. Local Scalars .. ! .. Local Scalars ..
TYPE(t_lapw):: lapw TYPE(t_lapw):: lapw
INTEGER :: llpd INTEGER :: llpd
REAL wronk
INTEGER i,ie,iv,ivac,j,k,l,n,ilo,isp,& INTEGER i,ie,iv,ivac,j,k,l,n,ilo,isp,&
nbands,noded,nodeu,noccbd,nslibd,na,& nbands,noccbd,nslibd,na,&
ikpt,jsp_start,jsp_end,ispin ikpt,jsp_start,jsp_end,ispin
INTEGER skip_t,skip_tt INTEGER skip_t,skip_tt
INTEGER n_size,i_rec,n_rank ,ncored,n_start,n_end,noccbd_l,nbasfcn INTEGER n_size,i_rec,n_rank ,ncored,n_start,n_end,noccbd_l,nbasfcn
LOGICAL l_fmpl,l_evp,l_orbcomprot,l_real LOGICAL l_fmpl,l_evp,l_orbcomprot,l_real, l_write
! ...Local Arrays .. ! ...Local Arrays ..
INTEGER n_bands(0:dimension%neigd) INTEGER n_bands(0:dimension%neigd)
REAL eig(dimension%neigd) REAL eig(dimension%neigd)
REAL vz0(2) REAL vz0(2)
REAL uuilon(atoms%nlod,atoms%ntype),duilon(atoms%nlod,atoms%ntype)
REAL ulouilopn(atoms%nlod,atoms%nlod,atoms%ntype)
!orbcomp !orbcomp
REAL, ALLOCATABLE :: orbcomp(:,:,:),qmtp(:,:) REAL, ALLOCATABLE :: orbcomp(:,:,:),qmtp(:,:)
...@@ -251,22 +247,24 @@ CONTAINS ...@@ -251,22 +247,24 @@ CONTAINS
na = 1 na = 1
ncored = 0 ncored = 0
l_write = input%cdinf.AND.mpi%irank==0
ALLOCATE ( flo(atoms%jmtd,2,atoms%nlod,dimension%jspd) ) ALLOCATE ( flo(atoms%jmtd,2,atoms%nlod,dimension%jspd) )
DO n = 1,atoms%ntype DO n = 1,atoms%ntype
IF (input%cdinf.AND.mpi%irank==0) WRITE (6,FMT=8001) n
DO l = 0,atoms%lmax(n) DO ispin = jsp_start, jsp_end
DO ispin =jsp_start,jsp_end CALL genMTBasis(atoms,enpara,vTot,mpi,n,ispin,l_write,usdus,f(:,:,0:,ispin),g(:,:,0:,ispin),flo(:,:,:,ispin))
CALL radfun(l,n,ispin,enpara%el0(l,n,ispin),vTot%mt(1,0,n,ispin),atoms,&
f(1,1,l,ispin),g(1,1,l,ispin),usdus,nodeu,noded,wronk)
IF (input%cdinf.AND.mpi%irank==0) WRITE (6,FMT=8002) l,&
enpara%el0(l,n,ispin),usdus%us(l,n,ispin),usdus%dus(l,n,ispin),nodeu,&
usdus%uds(l,n,ispin),usdus%duds(l,n,ispin),noded,usdus%ddn(l,n,ispin),&
wronk
END DO
IF (noco%l_mperp) THEN
CALL int_21(f,g,atoms,n,l,denCoeffsOffdiag)
END IF
END DO END DO
IF (noco%l_mperp) THEN
DO l = 0,atoms%lmax(n)
CALL int_21(f,g,atoms,n,l,denCoeffsOffdiag)
END DO
DO ilo = 1, atoms%nlo(n)
CALL int_21lo(f,g,atoms,n,flo,ilo,denCoeffsOffdiag)
END DO
END IF
IF (banddos%l_mcd) THEN IF (banddos%l_mcd) THEN
CALL mcd_init(atoms,input,dimension,vTot%mt(:,0,:,:),g,f,mcd,n,jspin) CALL mcd_init(atoms,input,dimension,vTot%mt(:,0,:,:),g,f,mcd,n,jspin)
ncored = max(mcd%ncore(n),ncored) ncored = max(mcd%ncore(n),ncored)
...@@ -276,30 +274,9 @@ CONTAINS ...@@ -276,30 +274,9 @@ CONTAINS
input%jspins,jspin,results%ef,& input%jspins,jspin,results%ef,&
dimension%msh,vTot%mt(:,0,:,:),f,g) dimension%msh,vTot%mt(:,0,:,:),f,g)
!---> generate the extra wavefunctions for the local orbitals,
!---> if there are any.
IF ( atoms%nlo(n) > 0 ) THEN
DO ispin = jsp_start,jsp_end
CALL radflo(atoms,n,ispin, enpara%ello0(1,1,ispin),vTot%mt(:,0,n,ispin), f(1,1,0,ispin),&
g(1,1,0,ispin),mpi, usdus, uuilon,duilon,ulouilopn, flo(:,:,:,ispin))
END DO
END IF
DO ilo = 1, atoms%nlo(n)
IF (noco%l_mperp) THEN
CALL int_21lo(f,g,atoms,n,flo,ilo,denCoeffsOffdiag)
END IF
END DO
na = na + atoms%neq(n) na = na + atoms%neq(n)
END DO END DO
DEALLOCATE (flo) DEALLOCATE (flo)
8001 FORMAT (1x,/,/,' wavefunction parameters for atom type',i3,':',/,&
t32,'radial function',t79,'energy derivative',/,t3,'l',t8,&
'energy',t26,'value',t39,'derivative',t53,'nodes',t68,&
'value',t81,'derivative',t95,'nodes',t107,'norm',t119,&
'wronskian')
8002 FORMAT (i3,f10.5,2 (5x,1p,2e16.7,i5),1p,2e16.7)
IF (input%film) vz0(:) = vTot%vacz(vacuum%nmz,:,jspin) IF (input%film) vz0(:) = vTot%vacz(vacuum%nmz,:,jspin)
......
...@@ -12,8 +12,7 @@ MODULE m_tlmplm_cholesky ...@@ -12,8 +12,7 @@ MODULE m_tlmplm_cholesky
jspin,jsp,mpi,v,input,td,ud) jspin,jsp,mpi,v,input,td,ud)
USE m_intgr, ONLY : intgr3 USE m_intgr, ONLY : intgr3
USE m_radflo USE m_genMTBasis
USE m_radfun
USE m_tlo USE m_tlo
USE m_gaunt, ONLY: gaunt1,gaunt2 USE m_gaunt, ONLY: gaunt1,gaunt2
USE m_types USE m_types
...@@ -37,9 +36,9 @@ MODULE m_tlmplm_cholesky ...@@ -37,9 +36,9 @@ MODULE m_tlmplm_cholesky
! .. Local Scalars .. ! .. Local Scalars ..
COMPLEX cil COMPLEX cil
COMPLEX,PARAMETER::ci=cmplx(0.,1.) COMPLEX,PARAMETER::ci=cmplx(0.,1.)
REAL temp,wronk REAL temp
INTEGER i,l,l2,lamda,lh,lm,lmin,lmin0,lmp,lmpl,lmplm,lmx,lmxx,lp,info,in INTEGER i,l,l2,lamda,lh,lm,lmin,lmin0,lmp,lmpl,lmplm,lmx,lmxx,lp,info,in
INTEGER lp1,lpl ,mem,mems,mp,mu,n,nh,noded,nodeu ,na,m,nsym,s,i_u INTEGER lp1,lpl ,mem,mems,mp,mu,n,nh,na,m,nsym,s,i_u
LOGICAL l_write,OK LOGICAL l_write,OK
! .. ! ..
! .. Local Arrays .. ! .. Local Arrays ..
...@@ -50,8 +49,6 @@ MODULE m_tlmplm_cholesky ...@@ -50,8 +49,6 @@ MODULE m_tlmplm_cholesky
REAL uvu(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd ) REAL uvu(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd )
REAL f(atoms%jmtd,2,0:atoms%lmaxd),g(atoms%jmtd,2,0:atoms%lmaxd),x(atoms%jmtd) REAL f(atoms%jmtd,2,0:atoms%lmaxd),g(atoms%jmtd,2,0:atoms%lmaxd),x(atoms%jmtd)
REAL flo(atoms%jmtd,2,atoms%nlod) REAL flo(atoms%jmtd,2,atoms%nlod)
REAL uuilon(atoms%nlod,atoms%ntype),duilon(atoms%nlod,atoms%ntype)
REAL ulouilopn(atoms%nlod,atoms%nlod,atoms%ntype)
INTEGER:: indt(0:SIZE(td%tuu,1)-1) INTEGER:: indt(0:SIZE(td%tuu,1)-1)
!for constraint !for constraint
...@@ -83,10 +80,10 @@ MODULE m_tlmplm_cholesky ...@@ -83,10 +80,10 @@ MODULE m_tlmplm_cholesky
!$ l_write=.false. !$ l_write=.false.
!$ call gaunt2(atoms%lmaxd) !$ call gaunt2(atoms%lmaxd)
!$OMP PARALLEL DO DEFAULT(NONE)& !$OMP PARALLEL DO DEFAULT(NONE)&
!$OMP PRIVATE(indt,dvd,dvu,uvd,uvu,f,g,x,flo,uuilon,duilon,ulouilopn)& !$OMP PRIVATE(indt,dvd,dvu,uvd,uvu,f,g,x,flo)&
!$OMP PRIVATE(cil,temp,wronk,i,l,l2,lamda,lh,lm,lmin,lmin0,lmp,lmpl)& !$OMP PRIVATE(cil,temp,i,l,l2,lamda,lh,lm,lmin,lmin0,lmp,lmpl)&
!$OMP PRIVATE(lmplm,lmx,lmxx,lp,lp1,lpl,m,mem,mems,mp,mu,n,nh,noded)& !$OMP PRIVATE(lmplm,lmx,lmxx,lp,lp1,lpl,m,mem,mems,mp,mu,n,nh)&
!$OMP PRIVATE(nodeu,nsym,na,OK,s,in,info,c)& !$OMP PRIVATE(nsym,na,OK,s,in,info,c)&
!$OMP SHARED(atoms,jspin,jsp,sphhar,enpara,td,ud,l_write,v,mpi,input,vr0)& !$OMP SHARED(atoms,jspin,jsp,sphhar,enpara,td,ud,l_write,v,mpi,input,vr0)&
!$OMP SHARED(noco,uun21,udn21,dun21,ddn21) !$OMP SHARED(noco,uun21,udn21,dun21,ddn21)
DO n = 1,atoms%ntype DO n = 1,atoms%ntype
...@@ -99,27 +96,7 @@ MODULE m_tlmplm_cholesky ...@@ -99,27 +96,7 @@ MODULE m_tlmplm_cholesky
! !
!---> generate the wavefunctions for each l !---> generate the wavefunctions for each l
! !
IF (l_write) WRITE (6,FMT=8000) n CALL genMTBasis(atoms,enpara,v,mpi,n,jspin,l_write,ud,f,g,flo)
DO l = 0,atoms%lmax(n)
CALL radfun(l,n,jspin,enpara%el0(l,n,jspin),v%mt(:,0,n,jsp),atoms,&
f(1,1,l),g(1,1,l),ud,nodeu,noded,wronk)
IF (l_write) WRITE (6,FMT=8010) l,enpara%el0(l,n,jspin),ud%us(l,n,jspin),&
ud%dus(l,n,jspin),nodeu,ud%uds(l,n,jspin),ud%duds(l,n,jspin),noded,ud%ddn(l,n,jspin),wronk
END DO
8000 FORMAT (1x,/,/,' wavefunction parameters for atom type',i3,':',&
/,t32,'radial function',t79,'energy derivative',/,t3,&
'l',t8,'energy',t26,'value',t39,'derivative',t53,&
'nodes',t68,'value',t81,'derivative',t95,'nodes',t107,&
'norm',t119,'wronskian')
8010 FORMAT (i3,f10.5,2 (5x,1p,2e16.7,i5),1p,2e16.7)
!
!---> generate the extra wavefunctions for the local orbitals,
!---> if there are any.
!
IF (atoms%nlo(n).GE.1) THEN
CALL radflo(atoms,n,jspin,enpara%ello0(1,1,jspin), v%mt(:,0,n,jsp), f,g,mpi,&
ud, uuilon,duilon,ulouilopn,flo)
END IF
nsym = atoms%ntypsy(na) nsym = atoms%ntypsy(na)
nh = sphhar%nlh(nsym) nh = sphhar%nlh(nsym)
...@@ -332,7 +309,7 @@ MODULE m_tlmplm_cholesky ...@@ -332,7 +309,7 @@ MODULE m_tlmplm_cholesky
!---> if there are any !---> if there are any
IF (atoms%nlo(n).GE.1) THEN IF (atoms%nlo(n).GE.1) THEN
CALL tlo(atoms,sphhar,jspin,jsp,n,enpara,1,input,v%mt(1,0,n,jsp),& CALL tlo(atoms,sphhar,jspin,jsp,n,enpara,1,input,v%mt(1,0,n,jsp),&
na,flo,f,g,ud, uuilon,duilon,ulouilopn, td) na,flo,f,g,ud, ud%uuilon(:,:,jspin),ud%duilon(:,:,jspin),ud%ulouilopn(:,:,:,jspin), td)
ENDIF ENDIF
......
...@@ -21,6 +21,7 @@ set(fleur_F90 ${fleur_F90} ...@@ -21,6 +21,7 @@ set(fleur_F90 ${fleur_F90}
global/constants.f90 global/constants.f90
global/checkdop.F90 global/checkdop.F90
global/checkdopall.f90 global/checkdopall.f90
global/genMTBasis.f90
global/chkmt.f90 global/chkmt.f90
global/convn.f90 global/convn.f90
global/phasy1.f90 global/phasy1.f90
......
MODULE m_genMTBasis
CONTAINS
SUBROUTINE genMTBasis(atoms,enpara,vTot,mpi,iType,jspin,l_write,usdus,f,g,flo)
USE m_types
USE m_radfun
USE m_radflo
IMPLICIT NONE
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_enpara), INTENT(IN) :: enpara
TYPE(t_potden), INTENT(IN) :: vTot
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_usdus), INTENT(INOUT) :: usdus
INTEGER, INTENT(IN) :: iType
INTEGER, INTENT(IN) :: jspin
LOGICAL, INTENT(IN) :: l_write
REAL, INTENT(INOUT) :: f(atoms%jmtd,2,0:atoms%lmaxd)
REAL, INTENT(INOUT) :: g(atoms%jmtd,2,0:atoms%lmaxd)
REAL, INTENT(INOUT) :: flo(atoms%jmtd,2,atoms%nlod)
INTEGER :: l,nodeu,noded
REAL :: wronk
IF (l_write) WRITE (6,FMT=8000) iType
DO l = 0,atoms%lmax(iType)
CALL radfun(l,iType,jspin,enpara%el0(l,iType,jspin),vTot%mt(:,0,iType,jspin),atoms,&
f(1,1,l),g(1,1,l),usdus,nodeu,noded,wronk)
IF (l_write) THEN
WRITE (6,FMT=8010) l,enpara%el0(l,iType,jspin),usdus%us(l,iType,jspin),usdus%dus(l,iType,jspin),&
nodeu,usdus%uds(l,iType,jspin),usdus%duds(l,iType,jspin),noded,usdus%ddn(l,iType,jspin),wronk
END IF
END DO
! Generate the extra wavefunctions for the local orbitals, if there are any.
IF (atoms%nlo(iType).GE.1) THEN
CALL radflo(atoms,iType,jspin,enpara%ello0(1,1,jspin),vTot%mt(:,0,iType,jspin),f,g,mpi,&
usdus,usdus%uuilon(1,1,jspin),usdus%duilon(1,1,jspin),usdus%ulouilopn(1,1,1,jspin),flo)
END IF
8000 FORMAT (1x,/,/,' wavefunction parameters for atom type',i3,':',&
/,t32,'radial function',t79,'energy derivative',/,t3,&
'l',t8,'energy',t26,'value',t39,'derivative',t53,&
'nodes',t68,'value',t81,'derivative',t95,'nodes',t107,&
'norm',t119,'wronskian')
8010 FORMAT (i3,f10.5,2 (5x,1p,2e16.7,i5),1p,2e16.7)
END SUBROUTINE genMTBasis
END MODULE m_genMTBasis
...@@ -14,8 +14,11 @@ MODULE m_types_usdus ...@@ -14,8 +14,11 @@ MODULE m_types_usdus
REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ulos REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ulos
REAL,ALLOCATABLE,DIMENSION(:,:,:) :: dulos REAL,ALLOCATABLE,DIMENSION(:,:,:) :: dulos
REAL,ALLOCATABLE,DIMENSION(:,:,:) :: uulon REAL,ALLOCATABLE,DIMENSION(:,:,:) :: uulon
REAL,ALLOCATABLE,DIMENSION(:,:,:) :: dulon !(nlod,ntype,jspd) REAL,ALLOCATABLE,DIMENSION(:,:,:) :: dulon ! (nlod,ntype,jspd)
REAL,ALLOCATABLE,DIMENSION(:,:,:,:) :: uloulopn! (nlod,nlod,ntypd,jspd) REAL,ALLOCATABLE,DIMENSION(:,:,:,:) :: uloulopn ! (nlod,nlod,ntypd,jspd)
REAL,ALLOCATABLE,DIMENSION(:,:,:) :: uuilon
REAL,ALLOCATABLE,DIMENSION(:,:,:) :: duilon ! (nlod,ntype,jspd)
REAL,ALLOCATABLE,DIMENSION(:,:,:,:) :: ulouilopn ! (nlod,nlod,ntypd,jspd)
CONTAINS CONTAINS
PROCEDURE :: init => usdus_init PROCEDURE :: init => usdus_init
END TYPE t_usdus END TYPE t_usdus
...@@ -31,7 +34,7 @@ CONTAINS ...@@ -31,7 +34,7 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
INTEGER,INTENT(IN) :: jsp INTEGER,INTENT(IN) :: jsp
INTEGER :: err(10) INTEGER :: err(13)
ALLOCATE ( ud%uloulopn(atoms%nlod,atoms%nlod,atoms%ntype,jsp),stat=err(1) ) ALLOCATE ( ud%uloulopn(atoms%nlod,atoms%nlod,atoms%ntype,jsp),stat=err(1) )
ALLOCATE ( ud%ddn(0:atoms%lmaxd,atoms%ntype,jsp),stat=err(2) ) ALLOCATE ( ud%ddn(0:atoms%lmaxd,atoms%ntype,jsp),stat=err(2) )
ALLOCATE ( ud%us(0:atoms%lmaxd,atoms%ntype,jsp),stat=err(3)) ALLOCATE ( ud%us(0:atoms%lmaxd,atoms%ntype,jsp),stat=err(3))
...@@ -40,8 +43,11 @@ CONTAINS ...@@ -40,8 +43,11 @@ CONTAINS
ALLOCATE ( ud%duds(0:atoms%lmaxd,atoms%ntype,jsp),stat=err(6)) ALLOCATE ( ud%duds(0:atoms%lmaxd,atoms%ntype,jsp),stat=err(6))
ALLOCATE ( ud%ulos(atoms%nlod,atoms%ntype,jsp ),stat=err(7)) ALLOCATE ( ud%ulos(atoms%nlod,atoms%ntype,jsp ),stat=err(7))
ALLOCATE (ud%dulos(atoms%nlod,atoms%ntype,jsp ),stat=err(8) ) ALLOCATE (ud%dulos(atoms%nlod,atoms%ntype,jsp ),stat=err(8) )
ALLOCATE ( ud%uulon(atoms%nlod,atoms%ntype,jsp ),stat=err(9)) ALLOCATE (ud%uulon(atoms%nlod,atoms%ntype,jsp ),stat=err(9))
ALLOCATE (ud%dulon(atoms%nlod,atoms%ntype,jsp) ,stat=err(10)) ALLOCATE (ud%dulon(atoms%nlod,atoms%ntype,jsp) ,stat=err(10))
ALLOCATE (ud%uuilon(atoms%nlod,atoms%ntype,jsp),stat=err(11))
ALLOCATE (ud%duilon(atoms%nlod,atoms%ntype,jsp),stat=err(12))
ALLOCATE (ud%ulouilopn(atoms%nlod,atoms%nlod,atoms%ntype,jsp),stat=err(13))
IF (ANY(err>0)) CALL judft_error("Not enough memory allocating usdus datatype") IF (ANY(err>0)) CALL judft_error("Not enough memory allocating usdus datatype")
......
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