Skip to content

fleur
fleur
Commit e89fd760 authored by Gregor Michalicek's avatar Gregor Michalicek
Browse files
Options

Introduce new genMTBasis subroutine

parent 0304c478
Hide whitespace changes
Inline Side-by-side
Showing with 95 additions and 77 deletions
cdn/cdnval.F90
View file @ e89fd760
......@@ -46,8 +46,7 @@ CONTAINS
!
USE m_constants
USE m_eig66_io,ONLY: write_dos
USE m_radfun
USE m_radflo
USE m_genMTBasis
USE m_rhomt
USE m_rhonmt
USE m_rhomtlo
......@@ -124,19 +123,16 @@ CONTAINS
! .. Local Scalars ..
TYPE(t_lapw):: lapw
INTEGER :: llpd
REAL wronk
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
INTEGER skip_t,skip_tt
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 ..
INTEGER n_bands(0:dimension%neigd)
REAL eig(dimension%neigd)
REAL vz0(2)
REAL uuilon(atoms%nlod,atoms%ntype),duilon(atoms%nlod,atoms%ntype)
REAL ulouilopn(atoms%nlod,atoms%nlod,atoms%ntype)
!orbcomp
REAL, ALLOCATABLE :: orbcomp(:,:,:),qmtp(:,:)
......@@ -251,22 +247,24 @@ CONTAINS
na = 1
ncored = 0
l_write = input%cdinf.AND.mpi%irank==0
ALLOCATE ( flo(atoms%jmtd,2,atoms%nlod,dimension%jspd) )
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
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
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))
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
CALL mcd_init(atoms,input,dimension,vTot%mt(:,0,:,:),g,f,mcd,n,jspin)
ncored = max(mcd%ncore(n),ncored)
......@@ -276,30 +274,9 @@ CONTAINS
input%jspins,jspin,results%ef,&
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)
END DO
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)
......
eigen/tlmplm_cholesky.F90
View file @ e89fd760
......@@ -12,8 +12,7 @@ MODULE m_tlmplm_cholesky
jspin,jsp,mpi,v,input,td,ud)
USE m_intgr, ONLY : intgr3
USE m_radflo
USE m_radfun
USE m_genMTBasis
USE m_tlo
USE m_gaunt, ONLY: gaunt1,gaunt2
USE m_types
......@@ -37,9 +36,9 @@ MODULE m_tlmplm_cholesky
! .. Local Scalars ..
COMPLEX cil
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 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
! ..
! .. Local Arrays ..
......@@ -50,8 +49,6 @@ MODULE m_tlmplm_cholesky
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 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)
!for constraint
......@@ -83,10 +80,10 @@ MODULE m_tlmplm_cholesky
!$ l_write=.false.
!$ call gaunt2(atoms%lmaxd)
!$OMP PARALLEL DO DEFAULT(NONE)&
!$OMP PRIVATE(indt,dvd,dvu,uvd,uvu,f,g,x,flo,uuilon,duilon,ulouilopn)&
!$OMP PRIVATE(cil,temp,wronk,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(nodeu,nsym,na,OK,s,in,info,c)&
!$OMP PRIVATE(indt,dvd,dvu,uvd,uvu,f,g,x,flo)&
!$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)&
!$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(noco,uun21,udn21,dun21,ddn21)
DO n = 1,atoms%ntype
......@@ -99,27 +96,7 @@ MODULE m_tlmplm_cholesky
!
!---> generate the wavefunctions for each l
!
IF (l_write) WRITE (6,FMT=8000) n
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
CALL genMTBasis(atoms,enpara,v,mpi,n,jspin,l_write,ud,f,g,flo)
nsym = atoms%ntypsy(na)
nh = sphhar%nlh(nsym)
......@@ -332,7 +309,7 @@ MODULE m_tlmplm_cholesky
!---> if there are any
IF (atoms%nlo(n).GE.1) THEN
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
......
global/CMakeLists.txt
View file @ e89fd760
......@@ -21,6 +21,7 @@ set(fleur_F90 ${fleur_F90}
global/constants.f90
global/checkdop.F90
global/checkdopall.f90
global/genMTBasis.f90
global/chkmt.f90
global/convn.f90
global/phasy1.f90
......
global/genMTBasis.f90 0 → 100644
View file @ e89fd760
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
types/types_usdus.F90
View file @ e89fd760
......@@ -14,8 +14,11 @@ MODULE m_types_usdus
REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ulos
REAL,ALLOCATABLE,DIMENSION(:,:,:) :: dulos
REAL,ALLOCATABLE,DIMENSION(:,:,:) :: uulon
REAL,ALLOCATABLE,DIMENSION(:,:,:) :: dulon !(nlod,ntype,jspd)
REAL,ALLOCATABLE,DIMENSION(:,:,:,:) :: uloulopn! (nlod,nlod,ntypd,jspd)
REAL,ALLOCATABLE,DIMENSION(:,:,:) :: dulon ! (nlod,ntype,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
PROCEDURE :: init => usdus_init
END TYPE t_usdus
......@@ -31,7 +34,7 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms
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%ddn(0:atoms%lmaxd,atoms%ntype,jsp),stat=err(2) )
ALLOCATE ( ud%us(0:atoms%lmaxd,atoms%ntype,jsp),stat=err(3))
......@@ -40,8 +43,11 @@ CONTAINS
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%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%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")
......
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