From 7c453ce5c8c5321b8208d716da39ba77b91bbaa5 Mon Sep 17 00:00:00 2001 From: Daniel Wortmann Date: Thu, 12 Dec 2019 11:09:36 +0100 Subject: [PATCH] Many fixes to be able to compile after merge --- cdn_mt/alignSpinAxisMagn.f90 | 51 ++++----- cdn_mt/magDiMom.f90 | 10 +- cdn_mt/magnMomFromDen.f90 | 34 +++--- cdn_mt/resMoms.f90 | 10 +- cdn_mt/rhosphnlo.f90 | 2 +- eigen/eigen.F90 | 4 +- fermi/fermie.F90 | 4 +- fleurinput/constants.f90 | 12 ++ fleurinput/types_atoms.F90 | 25 ++-- fleurinput/types_hybrid.f90 | 100 +++++++--------- fleurinput/types_input.f90 | 3 + fleurinput/types_kpts.f90 | 46 +++++++- hybrid/HF_init.F90 | 6 +- hybrid/checkolap.F90 | 5 +- hybrid/coulombmatrix.F90 | 4 +- hybrid/exchange_core.F90 | 5 +- hybrid/exchange_val_hf.F90 | 4 +- hybrid/gen_wavf.F90 | 2 +- hybrid/hf_setup.F90 | 2 +- hybrid/hsefunctional.F90 | 3 +- hybrid/hsfock.F90 | 4 +- hybrid/hyb_abcrot.F90 | 6 +- hybrid/hybrid.F90 | 5 +- hybrid/hybrid_core.f90 | 47 ++++---- hybrid/kp_perturbation.F90 | 18 +-- hybrid/olap.F90 | 1 + hybrid/symm_hf.F90 | 8 +- hybrid/wavefproducts_inv.f90 | 38 +++--- hybrid/wavefproducts_noinv.f90 | 23 ++-- init/postprocessInput.F90 | 4 +- inpgen2/CMakeLists.txt | 1 - inpgen2/make_atomic_defaults.f90 | 33 +++--- inpgen2/make_defaults.f90 | 36 +++--- inpgen2/old_inp/dimen7.F90 | 5 +- inpgen2/old_inp/fleur_init_old.F90 | 6 +- inpgen2/old_inp/inped.F90 | 1 - inpgen2/old_inp/rw_inp.f90 | 15 +-- io/io_hybrid.F90 | 2 +- io/w_inpXML.f90 | 24 ++-- kpoints/CMakeLists.txt | 2 +- kpoints/kptgen_hybrid.f90 | 2 +- main/cdngen.F90 | 4 +- main/fleur.F90 | 16 +-- main/fleur_init.F90 | 4 +- math/CMakeLists.txt | 2 - math/LattHarmsSphHarmsConv.f90 | 6 +- math/lh_tofrom_lm.f90 | 33 +++--- optional/flipcdn.f90 | 4 +- optional/plot.f90 | 178 ++++++++++++++--------------- rdmft/rdmft.F90 | 12 +- types/CMakeLists.txt | 3 +- types/types_dos.f90 | 25 ++-- types/types_forcetheo.F90 | 12 +- types/types_hybrid.f90 | 48 +------- types/types_misc.F90 | 1 - types/types_setup.F90 | 1 - vgen/divergence.f90 | 16 +-- vgen/sfTests.f90 | 49 ++++---- vgen/vgen_xcpot.F90 | 6 +- vgen/xcBfield.f90 | 79 +++++++------ wannier/wann_updown.F | 100 ++++++++-------- 61 files changed, 604 insertions(+), 608 deletions(-) diff --git a/cdn_mt/alignSpinAxisMagn.f90 b/cdn_mt/alignSpinAxisMagn.f90 index 59545c80..936981bc 100644 --- a/cdn_mt/alignSpinAxisMagn.f90 +++ b/cdn_mt/alignSpinAxisMagn.f90 @@ -3,9 +3,9 @@ ! This file is part of FLEUR and avhttps://gcc.gnu.org/onlinedocs/gfortran/SQRT.htmlailable as free software under the conditions ! of the MIT license as expressed in the LICENSE file in more detail. !------------------------------------------------------------------------------ -! This routine allows to rotate the cdn in a way that the direction of magnetization aligns with the direction of the spin quantization axis. -! This routine also allows to reverse the rotation by using the angles stored in atoms (phi_mt_avg,theta_mt_avg) which are generated by the -! routine magnMomFromDen. +! This routine allows to rotate the cdn in a way that the direction of magnetization aligns with the direction of the spin quantization axis. +! This routine also allows to reverse the rotation by using the angles stored in atoms (phi_mt_avg,theta_mt_avg) which are generated by the +! routine magnMomFromDen. ! ! Robin Hilgers, Nov '19 MODULE m_alignSpinAxisMagn @@ -19,8 +19,8 @@ USE m_polangle CONTAINS SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars& ,sym,oneD,cell,noco,input,atoms,den) - TYPE(t_input), INTENT(INOUT) :: input - TYPE(t_atoms), INTENT(INOUT) :: atoms + TYPE(t_input), INTENT(IN) :: input + TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_noco), INTENT(INOUT) :: noco TYPE(t_stars),INTENT(IN) :: stars TYPE(t_vacuum),INTENT(IN) :: vacuum @@ -28,20 +28,20 @@ SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars& TYPE(t_sym),INTENT(IN) :: sym TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_cell),INTENT(IN) :: cell - TYPE(t_potden), INTENT(INOUT) :: den + TYPE(t_potden), INTENT(INOUT) :: den - REAL :: moments(atoms%ntype,3) + REAL :: moments(3,atoms%ntype) REAL :: phiTemp(atoms%ntype),thetaTemp(atoms%ntype),pi INTEGER :: i - pi=pimach() + pi=pimach() !!TEMP ! REAL :: x,y,z - + phiTemp=noco%alph thetaTemp=noco%beta - CALL magnMomFromDen(input,atoms,noco,den,moments) + CALL magnMomFromDen(input,atoms,noco,den,moments,thetaTemp,phiTemp) ! DO i=1, atoms%ntype - ! IF (abs(atoms%theta_mt_avg(i)).LE. 0.001) THEN + ! IF (abs(atoms%theta_mt_avg(i)).LE. 0.001) THEN ! atoms%phi_mt_avg(i)=0.0 ! atoms%theta_mt_avg(i)=0.0 ! END IF @@ -54,7 +54,7 @@ SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars& !write(*,*) moments(2,1) !write(*,*) "mz2" !write(*,*) moments(2,3) - CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,-atoms%phi_mt_avg,-atoms%theta_mt_avg,den) + CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,-phiTemp,-thetaTemp,den) !write (*,*)"mx my mz" !CALL sphericaltocart(SQRT(moments(1,1)**2+moments(1,2)**2+moments(1,3)**2),thetaTemp(1),phiTemp(1),x,y,z) !write(*,*) x,y,z @@ -64,18 +64,16 @@ SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars& !!write(*,*) atoms%phi_mt_avg !write(*,*) "atoms%theta_mt_avg" !write(*,*) atoms%theta_mt_avg - noco%alph=mod(atoms%phi_mt_avg+phiTemp,2*pimach()) - noco%beta=mod(atoms%theta_mt_avg+thetaTemp,2*pimach()) - atoms%phi_mt_avg=noco%alph - atoms%theta_mt_avg=noco%beta - + noco%alph=mod(noco%alph+phiTemp,2*pimach()) + noco%beta=mod(noco%alph+thetaTemp,2*pimach()) + DO i=1, atoms%ntype IF(noco%alph(i)<0) noco%alph(i)=noco%alph(i)+2*pi IF(noco%beta(i)<0) THEN - noco%beta(i)=-noco%beta(i) - noco%alph=noco%alph+pi + noco%beta(i)=-noco%beta(i) + noco%alph=noco%alph+pi END IF - IF(noco%beta(i)>pi) THEN + IF(noco%beta(i)>pi) THEN noco%beta(i)=pi-mod(noco%beta(i),pi) noco%alph(i)=noco%alph(i)+pi END IF @@ -90,8 +88,8 @@ END SUBROUTINE rotateMagnetToSpinAxis SUBROUTINE rotateMagnetFromSpinAxis(noco,vacuum,sphhar,stars& ,sym,oneD,cell,input,atoms,den,inDen) - TYPE(t_input), INTENT(INOUT) :: input - TYPE(t_atoms), INTENT(INOUT) :: atoms + TYPE(t_input), INTENT(IN) :: input + TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_noco), INTENT(INOUT) :: noco TYPE(t_stars),INTENT(IN) :: stars TYPE(t_vacuum),INTENT(IN) :: vacuum @@ -102,11 +100,9 @@ SUBROUTINE rotateMagnetFromSpinAxis(noco,vacuum,sphhar,stars& TYPE(t_potden), INTENT(INOUT) :: den, inDen - CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,atoms%phi_mt_avg,atoms%theta_mt_avg,den) - CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,atoms%phi_mt_avg,atoms%theta_mt_avg,inDen) - - atoms%flipSpinPhi=0 - atoms%flipSpinTheta=0 + CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,noco%alph,noco%beta,den) + CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,noco%alph,noco%beta,inDen) + noco%alph=0 noco%beta=0 @@ -114,4 +110,3 @@ END SUBROUTINE rotateMagnetFromSpinAxis END MODULE m_alignSpinAxisMagn - diff --git a/cdn_mt/magDiMom.f90 b/cdn_mt/magDiMom.f90 index 8b7eb612..1bdf73a0 100644 --- a/cdn_mt/magDiMom.f90 +++ b/cdn_mt/magDiMom.f90 @@ -15,7 +15,7 @@ CONTAINS ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -SUBROUTINE magDiMom(input,atoms,sphhar,noco,l_fmpl2,rho,magDipoles,elecDipoles) +SUBROUTINE magDiMom(sym,input,atoms,sphhar,noco,l_fmpl2,rho,magDipoles,elecDipoles) USE m_constants USE m_types @@ -26,7 +26,7 @@ SUBROUTINE magDiMom(input,atoms,sphhar,noco,l_fmpl2,rho,magDipoles,elecDipoles) USE m_intgr IMPLICIT NONE - + TYPE(t_sym), INTENT(IN) :: sym TYPE(t_input), INTENT(IN) :: input TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_sphhar), INTENT(IN) :: sphhar @@ -64,9 +64,9 @@ SUBROUTINE magDiMom(input,atoms,sphhar,noco,l_fmpl2,rho,magDipoles,elecDipoles) inRho(:,:,iType,4) = inRho(:,:,iType,2) * COS(theta) inRho(:,:,iType,2) = inRho(:,:,iType,2) * COS(phi)*SIN(theta) ELSE - DO ilh = 0,sphhar%nlh(atoms%ntypsy(iType)) + DO ilh = 0,sphhar%nlh(sym%ntypsy(iType)) DO i = 1,atoms%jri(iType) - + cdn11 = rho(i,ilh,iType,1) cdn22 = rho(i,ilh,iType,2) cdn21 = CMPLX(rho(i,ilh,iType,3),rho(i,ilh,iType,4)) @@ -89,7 +89,7 @@ SUBROUTINE magDiMom(input,atoms,sphhar,noco,l_fmpl2,rho,magDipoles,elecDipoles) rhoSphHarms = CMPLX(0.0,0.0) DO i = 1, 4 DO iType = 1, atoms%ntype - CALL lattHarmsRepToSphHarms(atoms,sphhar,iType,inRho(:,0:,iType,i),rhoSphHarms(:,:,iType,i)) + CALL lattHarmsRepToSphHarms(sym,atoms,sphhar,iType,inRho(:,0:,iType,i),rhoSphHarms(:,:,iType,i)) END DO END DO diff --git a/cdn_mt/magnMomFromDen.f90 b/cdn_mt/magnMomFromDen.f90 index bfdf21d6..5c17824b 100644 --- a/cdn_mt/magnMomFromDen.f90 +++ b/cdn_mt/magnMomFromDen.f90 @@ -3,15 +3,15 @@ ! This file is part of FLEUR and avhttps://gcc.gnu.org/onlinedocs/gfortran/SQRT.htmlailable as free software under the conditions ! of the MIT license as expressed in the LICENSE file in more detail. !------------------------------------------------------------------------------ -! This routine calculates the magnetic moments and the corresponding directions -! (angles) according to the Atoms in the system. -! +! This routine calculates the magnetic moments and the corresponding directions +! (angles) according to the Atoms in the system. +! ! ! Robin Hilgers, Nov '19 MODULE m_magnMomFromDen CONTAINS -SUBROUTINE magnMomFromDen(input,atoms,noco,den,moments) +SUBROUTINE magnMomFromDen(input,atoms,noco,den,moments,theta_mt_avg,phi_mt_avg) USE m_constants USE m_types USE m_intgr @@ -21,10 +21,12 @@ SUBROUTINE magnMomFromDen(input,atoms,noco,den,moments) TYPE(t_input), INTENT(IN) :: input - TYPE(t_atoms), INTENT(INOUT) :: atoms + TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_noco), INTENT(IN) :: noco TYPE(t_potden),INTENT(IN) :: den - REAL, INTENT(OUT) :: moments(atoms%ntype,3) + REAL, INTENT(OUT) :: moments(3,atoms%ntype) + REAL,INTENT(OUT) :: theta_mt_avg(atoms%ntype) + REAL,INTENT(OUT) :: phi_mt_avg(atoms%ntype) INTEGER :: jsp,i,j REAL :: mx,my,mz @@ -35,34 +37,34 @@ SUBROUTINE magnMomFromDen(input,atoms,noco,den,moments) IF(noco%l_mtNocoPot) THEN jsp=4 - ELSE + ELSE jsp=input%jspins END IF !!Loop over Spins and Atoms - DO i=1, atoms%ntype + DO i=1, atoms%ntype DO j=1, jsp !!Integration over r CALL intgr3(den%mt(:,0,i,j), atoms%rmsh(:,i),atoms%dx(i),atoms%jri(i),dummyResults(i,j)) !!Considering Lattice harmonics integral (Only L=0 component does not vanish and has a factor of sqrt(4*Pi)) dummyResults(i,j)=dummyResults(i,j)*sfp_const END DO - END DO + END DO !!Assign results DO i=1 , atoms%ntype IF (noco%l_mtNocoPot) THEN - moments(i,1:2)=2*dummyResults(i,3:4) + moments(1:2,i)=2*dummyResults(i,3:4) END IF - moments(i,3)=dummyResults(i,1)-dummyResults(i,2) + moments(3,i)=dummyResults(i,1)-dummyResults(i,2) END DO DEALLOCATE(dummyResults) !!Calculation of Angles DO i=1 , atoms%ntype - mx=moments(i,1) - my=moments(i,2) - mz=moments(i,3) - CALL pol_angle(mx,my,mz,atoms%theta_mt_avg(i),atoms%phi_mt_avg(i)) - IF(mx<0) atoms%theta_mt_avg(i)=-atoms%theta_mt_avg(i) + mx=moments(1,i) + my=moments(2,i) + mz=moments(3,i) + CALL pol_angle(mx,my,mz,theta_mt_avg(i),phi_mt_avg(i)) + IF(mx<0) theta_mt_avg(i)=-theta_mt_avg(i) ENDDO END SUBROUTINE magnMomFromDen diff --git a/cdn_mt/resMoms.f90 b/cdn_mt/resMoms.f90 index a7e93340..71d6992e 100644 --- a/cdn_mt/resMoms.f90 +++ b/cdn_mt/resMoms.f90 @@ -9,14 +9,14 @@ CONTAINS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! -! This subroutine calculates and writes out intraatomic electric and magnetic dipole +! This subroutine calculates and writes out intraatomic electric and magnetic dipole ! moments resolved with respect to their orbital (angular momentum) origins. ! ! GM'2018 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -SUBROUTINE resMoms(input,atoms,sphhar,noco,den,rhoLRes) +SUBROUTINE resMoms(sym,input,atoms,sphhar,noco,den,rhoLRes) USE m_constants USE m_types @@ -24,7 +24,7 @@ SUBROUTINE resMoms(input,atoms,sphhar,noco,den,rhoLRes) USE m_magDiMom IMPLICIT NONE - + TYPE(t_sym), INTENT(IN) :: sym TYPE(t_input), INTENT(IN) :: input TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_sphhar), INTENT(IN) :: sphhar @@ -61,7 +61,7 @@ SUBROUTINE resMoms(input,atoms,sphhar,noco,den,rhoLRes) ! WRITE(5000,'(f15.8)') den%mt(:,:,:,4) END IF - CALL magDiMom(input,atoms,sphhar,noco,noco%l_mperp,rhoTemp,t_op,elecDip) + CALL magDiMom(sym,input,atoms,sphhar,noco,noco%l_mperp,rhoTemp,t_op,elecDip) DO l = 0, atoms%lmaxd DO lp = 0, l @@ -71,7 +71,7 @@ SUBROUTINE resMoms(input,atoms,sphhar,noco,den,rhoLRes) rhoTemp(:,:,:,2) = rhoLRes(:,:,llp,:,2) rhoTemp(:,:,:,3) = rhoLRes(:,:,llp,:,3) rhoTemp(:,:,:,4) = rhoLRes(:,:,llp,:,4) - CALL magDiMom(input,atoms,sphhar,noco,noco%l_mperp,rhoTemp,res_T_op(:,:,llp),resElecDip(:,:,llp)) + CALL magDiMom(sym,input,atoms,sphhar,noco,noco%l_mperp,rhoTemp,res_T_op(:,:,llp),resElecDip(:,:,llp)) END DO END DO diff --git a/cdn_mt/rhosphnlo.f90 b/cdn_mt/rhosphnlo.f90 index 139f2468..a525fb8f 100644 --- a/cdn_mt/rhosphnlo.f90 +++ b/cdn_mt/rhosphnlo.f90 @@ -13,7 +13,7 @@ MODULE m_rhosphnlo !*********************************************************************** CONTAINS SUBROUTINE rhosphnlo(itype,atoms,sphhar,sym, uloulopn,dulon,uulon,& - ello,vr, aclo,bclo,cclo,acnmt,bcnmt,ccnmt,f,g, rho,qmtllo) + ello,vr, aclo,bclo,cclo,acnmt,bcnmt,ccnmt,f,g, rho,rholres,qmtllo) USE m_constants, ONLY : c_light,sfp_const USE m_radsra diff --git a/eigen/eigen.F90 b/eigen/eigen.F90 index 94a1f0aa..d84ce3db 100644 --- a/eigen/eigen.F90 +++ b/eigen/eigen.F90 @@ -19,7 +19,7 @@ CONTAINS !> The matrices generated and diagonalized here are of type m_mat as defined in m_types_mat. !>@author D. Wortmann SUBROUTINE eigen(mpi,stars,sphhar,atoms,xcpot,sym,kpts,vacuum,input,& - cell,enpara,banddos,noco,oneD,hybrid,iter,eig_id,results,inden,v,vx) + cell,enpara,banddos,noco,oneD,mpbasis,hybrid,iter,eig_id,results,inden,v,vx) #include"cpp_double.h" USE m_types @@ -158,7 +158,7 @@ CONTAINS IF (hybrid%l_addhf) CALL add_Vnonlocal(nk,lapw,atoms,hybrid,input,kpts,jsp,results,xcpot,noco,hmat) IF(hybrid%l_subvxc) THEN - CALL subvxc(lapw,kpts%bk(:,nk),input,jsp,v%mt(:,0,:,:),atoms,ud,hybrid,enpara%el0,enpara%ello0,& + CALL subvxc(lapw,kpts%bk(:,nk),input,jsp,v%mt(:,0,:,:),atoms,ud,mpbasis,hybrid,enpara%el0,enpara%ello0,& sym,cell,sphhar,stars,xcpot,mpi,oneD,hmat,vx) END IF END IF ! hybrid%l_hybrid diff --git a/fermi/fermie.F90 b/fermi/fermie.F90 index d23f7b35..24055726 100644 --- a/fermi/fermie.F90 +++ b/fermi/fermie.F90 @@ -264,7 +264,7 @@ CONTAINS IF (mpi%irank.EQ.0) CALL writeXMLElement('FermiEnergy',(/'value','units'/),attributes(1:2)) ENDIF - IF(.not.input%eig66(1))THEN + !IF(.not.input%eig66(1))THEN !Put w_iks into eig-file DO jsp = 1,nspins DO k = 1,kpts%nkpt @@ -274,7 +274,7 @@ CONTAINS #endif ENDDO ENDDO - ENDIF + !ENDIF RETURN 8020 FORMAT (/,'FERMIE:',/,& diff --git a/fleurinput/constants.f90 b/fleurinput/constants.f90 index 1e9e5ad8..99077da8 100755 --- a/fleurinput/constants.f90 +++ b/fleurinput/constants.f90 @@ -19,6 +19,7 @@ MODULE m_constants INTEGER, PARAMETER :: coreState_const = 1 INTEGER, PARAMETER :: valenceState_const = 2 INTEGER, PARAMETER :: lmaxU_const = 3 + COMPLEX, PARAMETER :: cmplx_0=(0.0,0.0) REAL, PARAMETER :: pi_const=3.1415926535897932 REAL, PARAMETER :: tpi_const=2.*3.1415926535897932 REAL, PARAMETER :: fpi_const=4.*3.1415926535897932 @@ -38,6 +39,17 @@ MODULE m_constants INTEGER, PARAMETER :: POTDEN_TYPE_EnergyDen = 5 INTEGER, PARAMETER :: POTDEN_TYPE_DEN = 1001 ! 1000 < POTDEN_TYPE ==> density + INTEGER, PARAMETER :: PLOT_INPDEN=1 + INTEGER, PARAMETER :: PLOT_OUTDEN_Y_CORE=2 + INTEGER, PARAMETER :: PLOT_INPDEN_N_CORE=3 + INTEGER, PARAMETER :: PLOT_MIXDEN_Y_CORE=4 + INTEGER, PARAMETER :: PLOT_MIXDEN_N_CORE=5 + INTEGER, PARAMETER :: PLOT_POT_TOT=7 + INTEGER, PARAMETER :: PLOT_POT_EXT=8 + INTEGER, PARAMETER :: PLOT_POT_COU=9 + INTEGER, PARAMETER :: PLOT_POT_VXC=10 + + CHARACTER(2),DIMENSION(0:103),PARAMETER :: namat_const=(/& 'va',' H','He','Li','Be',' B',' C',' N',' O',' F','Ne',& 'Na','Mg','Al','Si',' P',' S','Cl','Ar',' K','Ca','Sc','Ti',& diff --git a/fleurinput/types_atoms.F90 b/fleurinput/types_atoms.F90 index e9bf6466..777de1f7 100644 --- a/fleurinput/types_atoms.F90 +++ b/fleurinput/types_atoms.F90 @@ -96,7 +96,14 @@ MODULE m_types_atoms !lda_u information(ntype) TYPE(t_utype), ALLOCATABLE::lda_u(:) INTEGER, ALLOCATABLE :: relax(:, :) !<(3,ntype) - INTEGER, ALLOCATABLE :: nflip(:) !init_atoms PROCEDURE :: nsp => calc_nsp_atom @@ -158,7 +165,9 @@ MODULE m_types_atoms call mpi_bc(this%krla,rank,mpi_comm) call mpi_bc(this%relcor,rank,mpi_comm) call mpi_bc(this%relax,rank,mpi_comm) - call mpi_bc(this%nflip,rank,mpi_comm) + call mpi_bc(this%flipSpinPhi,rank,mpi_comm) + call mpi_bc(this%flipSpinTheta,rank,mpi_comm) + call mpi_bc(this%flipSpinScale,rank,mpi_comm) #ifdef CPP_MPI CALL mpi_COMM_RANK(mpi_comm,myrank,ierr) @@ -236,7 +245,9 @@ MODULE m_types_atoms ALLOCATE(this%lmax(this%ntype)) ALLOCATE(this%nlo(this%ntype)) ALLOCATE(this%lnonsph(this%ntype)) - ALLOCATE(this%nflip(this%ntype)) + ALLOCATE(this%flipSpinPhi(this%ntype)) + ALLOCATE(this%flipSpinTheta(this%ntype)) + ALLOCATE(this%flipSpinScale(this%ntype)) ALLOCATE(this%l_geo(this%ntype)) ALLOCATE(this%lda_u(4*this%ntype)) ALLOCATE(this%bmu(this%ntype)) @@ -271,12 +282,10 @@ MODULE m_types_atoms this%zatom(n) = 1.0e-10 END IF this%zatom(n) = this%nz(n) + this%flipSpinPhi(n) = evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPaths))//'/@flipSpinPhi')) + this%flipSpinTheta(n) = evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xpaths))//'/@flipSpinTheta')) + this%flipSpinScale(n) = evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xpaths))//'/@flipSpinScale')) - IF (evaluateFirstBoolOnly(xml%getAttributeValue(TRIM(ADJUSTL(xPaths))//'/@flipSpin'))) THEN - this%nflip(n) = 1 - ELSE - this%nflip(n) = 0 - ENDIF this%bmu(n) = evaluateFirstOnly(xml%getAttributeValue(TRIM(ADJUSTL(xPaths))//'/@magMom')) !Now the xml elements !mtSphere diff --git a/fleurinput/types_hybrid.f90 b/fleurinput/types_hybrid.f90 index 686c430a..05a442c8 100644 --- a/fleurinput/types_hybrid.f90 +++ b/fleurinput/types_hybrid.f90 @@ -9,44 +9,31 @@ MODULE m_types_hybrid USE m_types_fleurinput_base IMPLICIT NONE PRIVATE - + TYPE,EXTENDS(t_fleurinput_base):: t_hybrid - LOGICAL :: l_hybrid = .false. - LOGICAL :: l_subvxc = .false. - LOGICAL :: l_calhf = .false. - LOGICAL :: l_addhf = .false. - INTEGER :: ewaldlambda =3 - INTEGER :: lexp =16 - INTEGER :: bands1 !Only read in - INTEGER :: nbasp - INTEGER :: maxlcutm1 - INTEGER :: maxindxm1 - INTEGER :: maxbasm1 - INTEGER :: maxindxp1 - INTEGER :: maxgptm - INTEGER :: maxgptm1 - INTEGER :: maxindx - INTEGER :: maxlmindx - INTEGER :: gptmd - INTEGER, ALLOCATABLE :: nindx(:, :) - INTEGER, ALLOCATABLE :: select1(:, :) + LOGICAL :: l_hybrid = .false. + LOGICAL :: l_subvxc = .false. + LOGICAL :: l_calhf = .false. + LOGICAL :: l_addhf = .false. + INTEGER :: ewaldlambda + INTEGER :: lexp = 0 + INTEGER :: bands1 !Only read in + INTEGER :: nbasp + INTEGER :: maxbasm1 + INTEGER :: max_indx_p_1 !new + INTEGER :: maxlmindx + INTEGER, ALLOCATABLE :: select1(:,:) INTEGER, ALLOCATABLE :: lcutm1(:) - INTEGER, ALLOCATABLE :: nindxm1(:, :) - INTEGER, ALLOCATABLE :: gptm(:, :) - INTEGER, ALLOCATABLE :: ngptm1(:) - INTEGER, ALLOCATABLE :: pgptm1(:, :) - INTEGER, ALLOCATABLE :: ngptm(:) - INTEGER, ALLOCATABLE :: pgptm(:, :) INTEGER, ALLOCATABLE :: lcutwf(:) - INTEGER, ALLOCATABLE :: map(:, :) - INTEGER, ALLOCATABLE :: tvec(:, :, :) - INTEGER, ALLOCATABLE :: nbasm(:) - REAL :: gcutm1 - REAL :: tolerance1 = 1e-4 !only read in - REAL, ALLOCATABLE :: basm1(:, :, :, :) - COMPLEX, ALLOCATABLE :: d_wgn2(:, :, :, :) - INTEGER, ALLOCATABLE :: ne_eig(:), nbands(:), nobd(:) !alloc in eigen_HF_init - REAL, ALLOCATABLE :: div_vv(:, :, :) + INTEGER, ALLOCATABLE :: map(:,:) + INTEGER, ALLOCATABLE :: tvec(:,:,:) + INTEGER, ALLOCATABLE :: nbasm(:) + !REAL, ALLOCATABLE :: radbasfn_mt(:,:,:,:) + COMPLEX, ALLOCATABLE :: d_wgn2(:,:,:,:) + INTEGER, ALLOCATABLE :: ne_eig(:) + INTEGER, ALLOCATABLE :: nbands(:) + INTEGER, ALLOCATABLE :: nobd(:,:) + REAL, ALLOCATABLE :: div_vv(:,:,:) CONTAINS PROCEDURE :: read_xml =>read_xml_hybrid PROCEDURE :: mpi_bc =>mpi_bc_hybrid @@ -74,31 +61,32 @@ MODULE m_types_hybrid CALL mpi_bc(this%lexp ,rank,mpi_comm) CALL mpi_bc(this%bands1,rank,mpi_comm) CALL mpi_bc(this%nbasp,rank,mpi_comm) - CALL mpi_bc(this%maxlcutm1,rank,mpi_comm) - CALL mpi_bc(this%maxindxm1,rank,mpi_comm) + !CALL mpi_bc(this%maxlcutm1,rank,mpi_comm) + !CALL mpi_bc(this%maxindxm1,rank,mpi_comm) CALL mpi_bc(this%maxbasm1,rank,mpi_comm) - CALL mpi_bc(this%maxindxp1,rank,mpi_comm) - CALL mpi_bc(this%maxgptm,rank,mpi_comm) - CALL mpi_bc(this%maxgptm1,rank,mpi_comm) - CALL mpi_bc(this%maxindx,rank,mpi_comm) + CALL mpi_bc(this%max_indx_p_1,rank,mpi_comm) + !CALL mpi_bc(this%maxindxp1,rank,mpi_comm) + !CALL mpi_bc(this%maxgptm,rank,mpi_comm) + !CALL mpi_bc(this%maxgptm1,rank,mpi_comm) + !CALL mpi_bc(this%maxindx,rank,mpi_comm) CALL mpi_bc(this%maxlmindx,rank,mpi_comm) - CALL mpi_bc(this%gptmd,rank,mpi_comm) - CALL mpi_bc(this%nindx,rank,mpi_comm) + !CALL mpi_bc(this%gptmd,rank,mpi_comm) + !CALL mpi_bc(this%nindx,rank,mpi_comm) CALL mpi_bc(this%select1,rank,mpi_comm) CALL mpi_bc(this%lcutm1,rank,mpi_comm) - CALL mpi_bc(this%nindxm1,rank,mpi_comm) - CALL mpi_bc(this%gptm,rank,mpi_comm) - CALL mpi_bc(this%ngptm1,rank,mpi_comm) - CALL mpi_bc(this%pgptm1,rank,mpi_comm) - CALL mpi_bc(this%ngptm,rank,mpi_comm) - CALL mpi_bc(this%pgptm,rank,mpi_comm) + !CALL mpi_bc(this%nindxm1,rank,mpi_comm) + !CALL mpi_bc(this%gptm,rank,mpi_comm) + !CALL mpi_bc(this%ngptm1,rank,mpi_comm) + !CALL mpi_bc(this%pgptm1,rank,mpi_comm) + !CALL mpi_bc(this%ngptm,rank,mpi_comm) + !CALL mpi_bc(this%pgptm,rank,mpi_comm) CALL mpi_bc(this%lcutwf,rank,mpi_comm) CALL mpi_bc(this%map,rank,mpi_comm) CALL mpi_bc(this%tvec,rank,mpi_comm) CALL mpi_bc(this%nbasm,rank,mpi_comm) - CALL mpi_bc(this%gcutm1,rank,mpi_comm) - CALL mpi_bc(this%tolerance1 ,rank,mpi_comm) - CALL mpi_bc(this%basm1,rank,mpi_comm) + !CALL mpi_bc(this%gcutm1,rank,mpi_comm) + !CALL mpi_bc(this%tolerance1 ,rank,mpi_comm) + !CALL mpi_bc(this%basm1,rank,mpi_comm) CALL mpi_bc(this%d_wgn2,rank,mpi_comm) CALL mpi_bc(this%ne_eig,rank,mpi_comm) CALL mpi_bc(this%nbands,rank,mpi_comm) @@ -111,8 +99,8 @@ MODULE m_types_hybrid USE m_types_xml CLASS(t_hybrid),INTENT(INout):: this TYPE(t_xml),INTENT(in) :: xml - - + + INTEGER::numberNodes,ntype,itype CHARACTER(len=100)::xPathA @@ -120,8 +108,8 @@ MODULE m_types_hybrid ALLOCATE(this%lcutm1(ntype),this%lcutwf(ntype),this%select1(4,ntype)) numberNodes = xml%GetNumberOfNodes('/fleurInput/calculationSetup/prodBasis') IF (numberNodes==1) THEN - this%gcutm1=evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/prodBasis/@gcutm')) - this%tolerance1=evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/prodBasis/@tolerance')) + !this%gcutm1=evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/prodBasis/@gcutm')) + !this%tolerance1=evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/prodBasis/@tolerance')) this%ewaldlambda=evaluateFirstIntOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/prodBasis/@ewaldlambda')) this%lexp=evaluateFirstIntOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/prodBasis/@lexp')) this%bands1=evaluateFirstIntOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/prodBasis/@bands')) diff --git a/fleurinput/types_input.f90 b/fleurinput/types_input.f90 index b09c9e36..d39e47c4 100644 --- a/fleurinput/types_input.f90 +++ b/fleurinput/types_input.f90 @@ -61,6 +61,7 @@ MODULE m_types_input REAL :: ellow=-1.8 REAL :: elup=1.0 REAL :: fixed_moment = 0.0 + LOGICAL :: l_removeMagnetisationFromInterstitial CHARACTER(LEN=100) :: comment="FLEUR calculation without a title" LOGICAL :: l_core_confpot=.TRUE. !Former CPP_CORE LOGICAL :: l_useapw=.FALSE. @@ -135,6 +136,7 @@ CONTAINS call mpi_bc(this%l_wann,rank,mpi_comm) call mpi_bc(this%secvar,rank,mpi_comm) call mpi_bc(this%evonly,rank,mpi_comm) + call mpi_bc(this%l_removeMagnetisationFromInterstitial,rank,mpi_comm) ! call mpi_bc(this%l_inpXML,rank,mpi_comm) call mpi_bc(this%ellow,rank,mpi_comm) call mpi_bc(this%elup,rank,mpi_comm) @@ -218,6 +220,7 @@ CONTAINS this%jspins = evaluateFirstIntOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/magnetism/@jspins')) this%swsp = evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/magnetism/@swsp')) this%lflip = evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/magnetism/@lflip')) + this%l_removeMagnetisationFromInterstitial=evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/magnetism/@l_removeMagnetisationFromInterstitial')) this%fixed_moment=evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/magnetism/@fixed_moment')) ! Read in optional expert modes switches xPathA = '/fleurInput/calculationSetup/expertModes' diff --git a/fleurinput/types_kpts.f90 b/fleurinput/types_kpts.f90 index 05769931..87341ad5 100644 --- a/fleurinput/types_kpts.f90 +++ b/fleurinput/types_kpts.f90 @@ -34,12 +34,48 @@ MODULE m_types_kpts PROCEDURE :: print_xml PROCEDURE :: read_xml=>read_xml_kpts PROCEDURE :: mpi_bc => mpi_bc_kpts + procedure :: get_nk => kpts_get_nk + procedure :: to_first_bz => kpts_to_first_bz + procedure :: is_kpt => kpts_is_kpt ENDTYPE t_kpts PUBLIC :: t_kpts CONTAINS + function kpts_get_nk(kpts, kpoint) result(ret_idx) + ! get the index of a kpoint + implicit NONE + class(t_kpts), intent(in) :: kpts + real, intent(in) :: kpoint(3) + integer :: idx, ret_idx + + DO idx = 1, kpts%nkptf + IF (all(abs(kpoint - kpts%bkf(:,idx)) < 1E-06)) THEN + ret_idx = idx + return + END IF + END DO + ret_idx = 0 + end function kpts_get_nk + + function kpts_to_first_bz(kpts, kpoint) result(out_point) + implicit NONE + class(t_kpts), intent(in) :: kpts + real, intent(in) :: kpoint(3) + real :: out_point(3) + + out_point = kpoint - floor(kpoint) + end function kpts_to_first_bz + + function kpts_is_kpt(kpts, kpoint) result(is_kpt) + implicit none + class(t_kpts), intent(in) :: kpts + real, intent(in) :: kpoint(3) + logical :: is_kpt + + is_kpt = kpts%get_nk(kpoint) > 0 + end function kpts_is_kpt SUBROUTINE mpi_bc_kpts(this,mpi_comm,irank) USE m_mpi_bc_tool CLASS(t_kpts),INTENT(INOUT)::this @@ -68,17 +104,17 @@ CONTAINS CALL mpi_bc(this%voltet,rank,mpi_comm) CALL mpi_bc(this%sc_list ,rank,mpi_comm) END SUBROUTINE mpi_bc_kpts - + SUBROUTINE read_xml_kpts(this,xml) USE m_types_xml USE m_calculator CLASS(t_kpts),INTENT(inout):: this TYPE(t_xml),INTENT(IN) :: xml - - + + INTEGER:: number_sets,n CHARACTER(len=200)::str,path,path2 - + number_sets = xml%GetNumberOfNodes('/fleurInput/calculationSetup/bzIntegration/kPointList') @@ -150,7 +186,7 @@ CONTAINS WRITE(fh,205) adjustl(trim(kpts%name)),kpts%nkpt IF (kpts%numSpecialPoints<2) THEN DO n=1,kpts%nkpt -206 FORMAT(' ',f12.6,' ',f12.6,' ',f12.6,'') +206 FORMAT(' ',f12.6,' ',f12.6,' ',f12.6,'') WRITE (fh,206) kpts%wtkpt(n), kpts%bk(:,n) END DO IF (kpts%ntet>0) THEN diff --git a/hybrid/HF_init.F90 b/hybrid/HF_init.F90 index cb05c3b4..0fcce07c 100644 --- a/hybrid/HF_init.F90 +++ b/hybrid/HF_init.F90 @@ -4,18 +4,18 @@ MODULE m_hf_init ! preparations for HF and hybrid functional calculation ! CONTAINS - SUBROUTINE hf_init(mpbasis, hybrid, atoms, input, DIMENSION, hybdat) + SUBROUTINE hf_init(mpbasis, hybrid, atoms, input, hybdat) USE m_types USE m_hybrid_core USE m_util use m_intgrf USE m_io_hybrid + USE m_types_hybdat IMPLICIT NONE TYPE(t_mpbasis), intent(inout) :: mpbasis TYPE(t_hybrid), INTENT(INOUT) :: hybrid TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_input), INTENT(IN) :: input - TYPE(t_dimension), INTENT(IN) :: DIMENSION TYPE(t_hybdat), INTENT(OUT) :: hybdat INTEGER:: l, m, i, l1, l2, m1, m2, ok @@ -31,7 +31,7 @@ CONTAINS allocate(hybdat%drbas1_MT(maxval(mpbasis%num_radfun_per_l), 0:atoms%lmaxd, atoms%ntype), source=0.0) ! preparations for core states - CALL core_init(dimension, input, atoms, hybdat%lmaxcd, hybdat%maxindxc) + CALL core_init( input, atoms, hybdat%lmaxcd, hybdat%maxindxc) allocate(hybdat%nindxc(0:hybdat%lmaxcd, atoms%ntype), stat=ok, source=0) IF (ok /= 0) call judft_error('eigen_hf: failure allocation hybdat%nindxc') allocate(hybdat%core1(atoms%jmtd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype), stat=ok, source=0.0) diff --git a/hybrid/checkolap.F90 b/hybrid/checkolap.F90 index 433f1739..3512755c 100644 --- a/hybrid/checkolap.F90 +++ b/hybrid/checkolap.F90 @@ -5,7 +5,7 @@ SUBROUTINE checkolap(atoms, hybdat,& mpbasis,hybrid,& nkpti, kpts,& - dimension, mpi, & + mpi, & input, sym, noco,& cell, lapw, jsp) USE m_util, ONLY: chr, sphbessel, harmonicsr @@ -13,12 +13,13 @@ USE m_constants USE m_types USE m_io_hybrid + USE m_types_hybdat + IMPLICIT NONE TYPE(t_hybdat), INTENT(IN) :: hybdat TYPE(t_mpi), INTENT(IN) :: mpi - TYPE(t_dimension), INTENT(IN) :: dimension TYPE(t_mpbasis), intent(in) :: mpbasis TYPE(t_hybrid), INTENT(IN) :: hybrid TYPE(t_input), INTENT(IN) :: input diff --git a/hybrid/coulombmatrix.F90 b/hybrid/coulombmatrix.F90 index 3e255ab4..70298842 100644 --- a/hybrid/coulombmatrix.F90 +++ b/hybrid/coulombmatrix.F90 @@ -36,12 +36,12 @@ MODULE m_coulombmatrix CONTAINS SUBROUTINE coulombmatrix(mpi, atoms, kpts, cell, sym, mpbasis, hybrid, xcpot) - + USE m_types_hybdat USE m_types USE m_juDFT USE m_constants, ONLY: pi_const USE m_olap, ONLY: olap_pw - use m_types_hybrid, only: gptnorm + use m_types_hybdat, only: gptnorm USE m_trafo, ONLY: symmetrize, bramat_trafo USE m_intgrf, ONLY: intgrf, intgrf_init use m_util, only: primitivef diff --git a/hybrid/exchange_core.F90 b/hybrid/exchange_core.F90 index f33b19a4..b79293b9 100644 --- a/hybrid/exchange_core.F90 +++ b/hybrid/exchange_core.F90 @@ -16,9 +16,10 @@ ! It is done directly without employing the mixed basis set. MODULE m_exchange_core + USE m_types_hybdat CONTAINS - SUBROUTINE exchange_vccv1(nk, atoms, mpbasis, hybrid, hybdat, jsp, lapw, & + SUBROUTINE exchange_vccv1(nk, input,atoms, mpbasis, hybrid, hybdat, jsp, lapw, & nsymop, nsest, indx_sest, mpi, a_ex, results, mat_ex) USE m_constants @@ -28,7 +29,7 @@ CONTAINS USE m_types USE m_io_hybrid IMPLICIT NONE - + TYPE(t_input),INTENT(IN):: input TYPE(t_hybdat), INTENT(IN) :: hybdat TYPE(t_results), INTENT(INOUT) :: results TYPE(t_mpi), INTENT(IN) :: mpi diff --git a/hybrid/exchange_val_hf.F90 b/hybrid/exchange_val_hf.F90 index cbd5fd34..1d9e5ef3 100644 --- a/hybrid/exchange_val_hf.F90 +++ b/hybrid/exchange_val_hf.F90 @@ -327,8 +327,8 @@ CONTAINS END IF IF (zero_order) THEN - CALL dwavefproducts(dcprod, nk, 1, hybrid%nbands(nk), 1, hybrid%nbands(nk), .false., atoms, hybrid, & - cell, hybdat, kpts, kpts%nkpt, lapw, input, jsp, eig_irr) + CALL dwavefproducts(dcprod, nk, 1, hybrid%nbands(nk), 1, hybrid%nbands(nk), .false., input,atoms, mpbasis,hybrid, & + cell, hybdat, kpts, kpts%nkpt, lapw, jsp, eig_irr) ! make dcprod hermitian DO n1 = 1, hybrid%nbands(nk) diff --git a/hybrid/gen_wavf.F90 b/hybrid/gen_wavf.F90 index 5dc15975..1a0b4c5c 100644 --- a/hybrid/gen_wavf.F90 +++ b/hybrid/gen_wavf.F90 @@ -261,7 +261,7 @@ CONTAINS IF ((kpts%bkp(ikpt) == ikpt0) .AND. (ikpt0 /= ikpt)) THEN iop = kpts%bksym(ikpt) CALL waveftrafo_genwavf(cmthlp, zhlp%data_r, zhlp%data_c, cmt(:, :, :), zmat(1)%l_real, zmat(ikpt0)%data_r(:, :), & - zmat(ikpt0)%data_c(:, :), ikpt0, iop, atoms, mpbasis, hybrid, kpts, sym, jsp, zmat(ikpt0)%matsize1, & + zmat(ikpt0)%data_c(:, :), ikpt0, iop, atoms, mpbasis, hybrid, kpts, sym, jsp, zmat(ikpt0)%matsize1,input, & hybrid%nbands(ikpt0), lapw(ikpt0), lapw(ikpt), .true.) CALL write_cmt(cmthlp, ikpt) diff --git a/hybrid/hf_setup.F90 b/hybrid/hf_setup.F90 index af99d1a5..7015686e 100644 --- a/hybrid/hf_setup.F90 +++ b/hybrid/hf_setup.F90 @@ -66,7 +66,7 @@ CONTAINS allocate(zmat(kpts%nkptf), stat=ok) IF (ok /= 0) call judft_error('eigen_hf: failure allocation z_c') - allocate(eig_irr(inputneigd, kpts%nkpt), stat=ok) + allocate(eig_irr(input%neig, kpts%nkpt), stat=ok) IF (ok /= 0) call judft_error('eigen_hf: failure allocation eig_irr') allocate(hybdat%kveclo_eig(atoms%nlotot, kpts%nkpt), stat=ok) IF (ok /= 0) call judft_error('eigen_hf: failure allocation hybdat%kveclo_eig') diff --git a/hybrid/hsefunctional.F90 b/hybrid/hsefunctional.F90 index ed59f31f..7f173cb7 100644 --- a/hybrid/hsefunctional.F90 +++ b/hybrid/hsefunctional.F90 @@ -9,6 +9,7 @@ ! Author: M. Schlipf 2009 MODULE m_hsefunctional USE m_judft + USE m_types_hybdat IMPLICIT NONE #ifdef __PGI @@ -971,7 +972,7 @@ CONTAINS potential, muffintin, interstitial) USE m_constants - USE m_types_hybrid, ONLY: gptnorm + USE m_types_hybdat, ONLY: gptnorm USE m_util, ONLY: sphbessel use m_intgrf, only: pure_intgrf, intgrf_init, intgrf_out,NEGATIVE_EXPONENT_WARNING, NEGATIVE_EXPONENT_ERROR IMPLICIT NONE diff --git a/hybrid/hsfock.F90 b/hybrid/hsfock.F90 index 305db5d7..6163add2 100644 --- a/hybrid/hsfock.F90 +++ b/hybrid/hsfock.F90 @@ -149,7 +149,7 @@ CONTAINS CALL timestart("symm_hf") CALL symm_hf_init(sym, kpts, nk, nsymop, rrot, psym) - CALL symm_hf(kpts, nk, sym, hybdat, eig_irr, atoms, mpbasis, hybrid, cell, lapw, jsp, & + CALL symm_hf(kpts, nk, sym, hybdat, eig_irr, input,atoms, mpbasis, hybrid, cell, lapw, jsp, & rrot, nsymop, psym, nkpt_EIBZ, n_q, parent, pointer_EIBZ, nsest, indx_sest) CALL timestop("symm_hf") @@ -174,7 +174,7 @@ CONTAINS IF (xcpot%is_name("hse") .OR. xcpot%is_name("vhse")) THEN call judft_error('HSE not implemented in hsfock') ELSE - CALL exchange_vccv1(nk, atoms, mpbasis, hybrid, hybdat, jsp, lapw, nsymop, nsest, indx_sest, mpi, a_ex, results, ex) + CALL exchange_vccv1(nk, input,atoms, mpbasis, hybrid, hybdat, jsp, lapw, nsymop, nsest, indx_sest, mpi, a_ex, results, ex) CALL exchange_cccc(nk, atoms, hybdat, ncstd, sym, kpts, a_ex, results) END IF diff --git a/hybrid/hyb_abcrot.F90 b/hybrid/hyb_abcrot.F90 index 2ee2456e..3518fcb2 100644 --- a/hybrid/hyb_abcrot.F90 +++ b/hybrid/hyb_abcrot.F90 @@ -50,13 +50,13 @@ CONTAINS DO itype = 1, atoms%ntype DO ineq = 1, atoms%neq(itype) iatom = iatom + 1 - iop = atoms%ngopr(iatom) + iop = sym%ngopr(iatom) ! l l l ! inversion of spherical harmonics: Y (pi-theta,pi+phi) = (-1) * Y (theta,phi) ! m m ifac = 1 - IF (atoms%invsat(iatom) == 2) THEN - iop = atoms%ngopr(sym%invsatnr(iatom)) + IF (sym%invsat(iatom) == 2) THEN + iop = sym%ngopr(sym%invsatnr(iatom)) ifac = -1 ENDIF diff --git a/hybrid/hybrid.F90 b/hybrid/hybrid.F90 index bad0df14..817b5372 100644 --- a/hybrid/hybrid.F90 +++ b/hybrid/hybrid.F90 @@ -12,6 +12,7 @@ CONTAINS SUBROUTINE calc_hybrid(eig_id, mpbasis, hybrid, kpts, atoms, input, mpi, noco, cell, oneD, & enpara, results, sym, xcpot, v, iterHF) + USE m_types_hybdat USE m_types USE m_mixedbasis USE m_coulombmatrix @@ -106,7 +107,7 @@ CONTAINS END IF hybrid%l_subvxc = (hybrid%l_subvxc .AND. hybrid%l_addhf) - IF (.NOT. ALLOCATED(results%w_iks)) allocate(results%w_iks(input%neigd, kpts%nkpt, input%jspins)) + IF (.NOT. ALLOCATED(results%w_iks)) allocate(results%w_iks(input%neig, kpts%nkpt, input%jspins)) IF (hybrid%l_calhf) THEN iterHF = iterHF + 1 @@ -127,7 +128,7 @@ CONTAINS CALL mixedbasis(atoms, kpts, input, cell, xcpot, mpbasis, hybrid, enpara, mpi, v, iterHF) CALL timestop("generation of mixed basis") - CALL open_hybrid_io2(mpbasis, hybrid, atoms, sym%invs) + CALL open_hybrid_io2(mpbasis, hybrid, input, atoms, sym%invs) CALL coulombmatrix(mpi, atoms, kpts, cell, sym, mpbasis, hybrid, xcpot) diff --git a/hybrid/hybrid_core.f90 b/hybrid/hybrid_core.f90 index 4b75bbde..7c8dc6a3 100644 --- a/hybrid/hybrid_core.f90 +++ b/hybrid/hybrid_core.f90 @@ -5,14 +5,13 @@ MODULE m_hybrid_core ! (core basis functions can be read in once during an iteration) CONTAINS - SUBROUTINE corewf(atoms, jsp, input, dimension,& + SUBROUTINE corewf(atoms, jsp, input,& vr, lmaxcd, maxindxc, mpi, lmaxc, nindxc, core1, core2, eig_c) USE m_types USE m_juDFT IMPLICIT NONE TYPE(t_mpi), INTENT(IN) :: mpi - TYPE(t_dimension), INTENT(IN) :: dimension TYPE(t_input), INTENT(IN) :: input TYPE(t_atoms), INTENT(IN) :: atoms @@ -42,11 +41,11 @@ CONTAINS REAL, ALLOCATABLE :: core1r(:, :, :, :), core2r(:, :, :, :) REAL, ALLOCATABLE :: eig_cr(:, :, :) - ncstd = maxval(atoms%ncst) + ncstd = maxval(atoms%econf%num_core_states) allocate(nindxcr(0:ncstd, atoms%ntype), stat=ok) ! generate relativistic core wave functions( ->core1r,core2r ) - CALL calcorewf(dimension, input, jsp, atoms,& + CALL calcorewf( input, jsp, atoms,& ncstd, vr,& lmaxc, nindxcr, core1r, core2r, eig_cr, mpi) @@ -122,19 +121,17 @@ CONTAINS END SUBROUTINE corewf - SUBROUTINE calcorewf(dimension, input, jspin, atoms,& + SUBROUTINE calcorewf( input, jspin, atoms,& ncstd, vr,& lmaxc, nindxcr, core1, core2, eig_c, mpi) USE m_intgr, ONLY: intgr3, intgr0, intgr1 USE m_constants, ONLY: c_light - USE m_setcor USE m_differ USE m_types IMPLICIT NONE TYPE(t_mpi), INTENT(IN) :: mpi - TYPE(t_dimension), INTENT(IN) :: dimension TYPE(t_input), INTENT(IN) :: input TYPE(t_atoms), INTENT(IN) :: atoms @@ -156,9 +153,9 @@ CONTAINS LOGICAL, SAVE :: first = .true. ! - local arrays - - INTEGER :: kappa(dimension%nstd), nprnc(dimension%nstd) - REAL :: vrd(dimension%msh) - REAL :: occ(dimension%nstd), occ_h(dimension%nstd, 2), a(dimension%msh), b(dimension%msh) + INTEGER :: kappa(29), nprnc(29) + REAL :: vrd(atoms%msh) + REAL :: occ(29), occ_h(29, 2), a(atoms%msh), b(atoms%msh) REAL, ALLOCATABLE, SAVE:: vr0(:, :, :) ! - intrinsic functions - @@ -187,8 +184,7 @@ CONTAINS z = atoms%zatom(itype) dxx = atoms%dx(itype) bmu = 0.0 - CALL setcor(itype, input%jspins, atoms, input, bmu,& - nst, kappa, nprnc, occ_h) + call atoms%econf(itype)%get_core(nst,kappa,nprnc,occ_h) IF ((bmu > 99.)) THEN occ(1:nst) = input%jspins*occ_h(1:nst, jspin) @@ -198,10 +194,10 @@ CONTAINS rnot = atoms%rmsh(1, itype) d = exp(atoms%dx(itype)) ncmsh = nint(log((atoms%rmt(itype) + 10.0)/rnot)/dxx + 1) - ncmsh = min(ncmsh, dimension%msh) + ncmsh = min(ncmsh, atoms%msh) rn = rnot*(d**(ncmsh - 1)) - nst = atoms%ncst(itype) + nst = atoms%econf(itype)%num_core_states DO korb = 1, nst IF (occ(korb) > 0) THEN @@ -229,8 +225,7 @@ CONTAINS z = atoms%zatom(itype) dxx = atoms%dx(itype) bmu = 0.0 - CALL setcor(itype, input%jspins, atoms, input, bmu, nst, kappa, nprnc, occ_h) - + call atoms%econf(itype)%get_core(nst,kappa,nprnc,occ_h) IF ((bmu > 99.)) THEN occ(1:nst) = input%jspins*occ_h(1:nst, jspin) ELSE @@ -239,7 +234,7 @@ CONTAINS rnot = atoms%rmsh(1, itype) d = exp(atoms%dx(itype)) ncmsh = nint(log((atoms%rmt(itype) + 10.0)/rnot)/dxx + 1) - ncmsh = min(ncmsh, dimension%msh) + ncmsh = min(ncmsh, atoms%msh) rn = rnot*(d**(ncmsh - 1)) IF (mpi%irank == 0) THEN WRITE (6, FMT=8000) z, rnot, dxx, atoms%jri(itype) @@ -269,7 +264,7 @@ CONTAINS END DO END IF - nst = atoms%ncst(itype) + nst = atoms%econf(itype)%num_core_states DO korb = 1, nst IF (occ(korb) > 0) THEN @@ -306,16 +301,14 @@ CONTAINS END SUBROUTINE calcorewf - SUBROUTINE core_init(dimension, input, atoms, lmaxcd, maxindxc) + SUBROUTINE core_init(input, atoms, lmaxcd, maxindxc) USE m_intgr, ONLY: intgr3, intgr0, intgr1 USE m_constants, ONLY: c_light - USE m_setcor USE m_differ USE m_types IMPLICIT NONE - TYPE(t_dimension), INTENT(IN) :: dimension TYPE(t_input), INTENT(IN) :: input TYPE(t_atoms), INTENT(IN) :: atoms INTEGER, INTENT(OUT) :: maxindxc, lmaxcd @@ -326,9 +319,9 @@ CONTAINS REAL :: d, dxx, rn, rnot, z ! - local arrays - - INTEGER :: kappa(dimension%nstd), nprnc(dimension%nstd) - INTEGER :: nindxcr(0:dimension%nstd, atoms%ntype) - REAL :: occ(dimension%nstd), occ_h(dimension%nstd, 2) + INTEGER :: kappa(29), nprnc(29) + INTEGER :: nindxcr(0:29, atoms%ntype) + REAL :: occ(29), occ_h(29, 2) INTEGER :: lmaxc(atoms%ntype) ! - intrinsic functions - @@ -343,17 +336,17 @@ CONTAINS z = atoms%zatom(itype) dxx = atoms%dx(itype) bmu = 0.0 - CALL setcor(itype, input%jspins, atoms, input, bmu, nst, kappa, nprnc, occ_h) + call atoms%econf(itype)%get_core(nst,kappa,nprnc,occ_h) occ(1:nst) = occ_h(1:nst, 1) rnot = atoms%rmsh(1, itype) d = exp(atoms%dx(itype)) ncmsh = nint(log((atoms%rmt(itype) + 10.0)/rnot)/dxx + 1) - ncmsh = min(ncmsh, dimension%msh) + ncmsh = min(ncmsh, atoms%msh) rn = rnot*(d**(ncmsh - 1)) - nst = atoms%ncst(itype) + nst = atoms%econf(itype)%num_core_states DO korb = 1, nst IF (occ(korb) > 0) THEN diff --git a/hybrid/kp_perturbation.F90 b/hybrid/kp_perturbation.F90 index eb1e6e5e..23960363 100644 --- a/hybrid/kp_perturbation.F90 +++ b/hybrid/kp_perturbation.F90 @@ -1,4 +1,5 @@ MODULE m_kp_perturbation + USE m_types_hybdat CONTAINS @@ -21,7 +22,6 @@ CONTAINS USE m_types USE m_io_hybrid IMPLICIT NONE - TYPE(t_hybdat), INTENT(IN) :: hybdat TYPE(t_mpbasis), intent(inout) :: mpbasis TYPE(t_hybrid), INTENT(INOUT) :: hybrid @@ -156,9 +156,9 @@ CONTAINS const = fpi_const*(atoms%rmt(itype)**2)/2/sqrt(cell%omtil) DO ieq = 1, atoms%neq(itype) iatom = iatom + 1 - IF ((atoms%invsat(iatom) == 0) .or. (atoms%invsat(iatom) == 1)) THEN - IF (atoms%invsat(iatom) == 0) invsfct = 1 - IF (atoms%invsat(iatom) == 1) THEN + IF ((sym%invsat(iatom) == 0) .or. (sym%invsat(iatom) == 1)) THEN + IF (sym%invsat(iatom) == 0) invsfct = 1 + IF (sym%invsat(iatom) == 1) THEN invsfct = 2 iatom1 = sym%invsatnr(iatom) END IF @@ -706,7 +706,7 @@ CONTAINS ! SUBROUTINE dwavefproducts( & dcprod, nk, bandi1, bandf1, bandi2, bandf2, lwrite, & - atoms, mpbasis, hybrid, & + input,atoms, mpbasis, hybrid, & cell, & hybdat, kpts, nkpti, lapw, & jsp, & @@ -717,7 +717,7 @@ CONTAINS IMPLICIT NONE TYPE(t_hybdat), INTENT(IN) :: hybdat - + TYPE(t_input),INTENT(IN) ::input TYPE(t_mpbasis), intent(in) :: mpbasis TYPE(t_hybrid), INTENT(IN) :: hybrid TYPE(t_cell), INTENT(IN) :: cell @@ -745,7 +745,7 @@ CONTAINS ! CALL momentum_matrix( & dcprod, nk, bandi1, bandf1, bandi2, bandf2, & - atoms, mpbasis, hybrid, & + input,atoms, mpbasis, hybrid, & cell, & hybdat, kpts, lapw, & jsp) @@ -780,7 +780,7 @@ CONTAINS ! SUBROUTINE momentum_matrix( & momentum, nk, bandi1, bandf1, bandi2, bandf2, & - atoms, mpbasis, hybrid, & + input,atoms, mpbasis, hybrid, & cell, & hybdat, kpts, lapw, & jsp) @@ -794,7 +794,7 @@ CONTAINS USE m_types USE m_io_hybrid IMPLICIT NONE - + TYPE(t_input),INTENT(IN) :: input TYPE(t_hybdat), INTENT(IN) :: hybdat TYPE(t_mpbasis), intent(in) :: mpbasis TYPE(t_hybrid), INTENT(IN) :: hybrid diff --git a/hybrid/olap.F90 b/hybrid/olap.F90 index 772fda8a..231cb3dc 100644 --- a/hybrid/olap.F90 +++ b/hybrid/olap.F90 @@ -1,4 +1,5 @@ MODULE m_olap + USE m_types_hybdat CONTAINS diff --git a/hybrid/symm_hf.F90 b/hybrid/symm_hf.F90 index 020690df..2bdc3ed7 100644 --- a/hybrid/symm_hf.F90 +++ b/hybrid/symm_hf.F90 @@ -10,7 +10,9 @@ ! M.Betzinger (09/07) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! MODULE m_symm_hf -use m_judft + use m_judft + USE m_types_hybdat + #define irreps .false. CONTAINS @@ -67,7 +69,7 @@ CONTAINS END SUBROUTINE symm_hf_init - SUBROUTINE symm_hf(kpts, nk, sym, hybdat, eig_irr, atoms, mpbasis, hybrid, cell, & + SUBROUTINE symm_hf(kpts, nk, sym, hybdat, eig_irr, input,atoms, mpbasis, hybrid, cell, & lapw, jsp, rrot, nsymop, psym, nkpt_EIBZ, n_q, parent, & pointer_EIBZ, nsest, indx_sest) @@ -304,7 +306,7 @@ CONTAINS cpwhlp = 0 CALL waveftrafo_symm(cmthlp(:, :, :ndb), cpwhlp(:, :ndb), cmt, z%l_real, z%data_r, z%data_c, & - i, ndb, nk, iop, atoms, mpbasis, hybrid, kpts, sym, jsp, lapw) + i, ndb, nk, iop, atoms,input, mpbasis, hybrid, kpts, sym, jsp, lapw) DO iband = 1, ndb carr1 = cmt(iband + i - 1, :, :) diff --git a/hybrid/wavefproducts_inv.f90 b/hybrid/wavefproducts_inv.f90 index 5657140b..3d10eb38 100644 --- a/hybrid/wavefproducts_inv.f90 +++ b/hybrid/wavefproducts_inv.f90 @@ -1,12 +1,13 @@ module m_wavefproducts_inv + USE m_types_hybdat CONTAINS - SUBROUTINE wavefproducts_inv5(bandi, bandf, bandoi, bandof, dimension, input,& + SUBROUTINE wavefproducts_inv5(bandi, bandf, bandoi, bandof, input,& jsp, atoms, lapw, kpts, nk, iq, hybdat, mpbasis, hybrid,& cell, nbasm_mt, sym, noco, nkqpt, cprod) USE m_util, ONLY: modulo1 - USE m_types_hybrid, ONLY: gptnorm + USE m_types_hybdat, ONLY: gptnorm USE m_wrapper USE m_constants USE m_types @@ -14,7 +15,6 @@ CONTAINS use m_wavefproducts_aux IMPLICIT NONE - TYPE(t_dimension), INTENT(IN) :: dimension TYPE(t_mpbasis), intent(in) :: mpbasis TYPE(t_hybrid), INTENT(IN) :: hybrid TYPE(t_input), INTENT(IN) :: input @@ -52,19 +52,19 @@ CONTAINS - call wavefproducts_inv_IS(bandi, bandf, bandoi, bandof, dimension, input,& + call wavefproducts_inv_IS(bandi, bandf, bandoi, bandof, input,& jsp, atoms, lapw, kpts, nk, iq, g_t, hybdat, mpbasis, hybrid,& cell, nbasm_mt, sym, noco, nkqpt, cprod) - call wavefproducts_inv5_MT(bandi, bandf, bandoi, bandof, dimension,& - atoms, kpts, nk, iq, hybdat, mpbasis, hybrid,& + call wavefproducts_inv5_MT(bandi, bandf, bandoi, bandof,& + input,atoms, kpts, nk, iq, hybdat, mpbasis, hybrid,& sym, nkqpt, cprod) CALL timestop("wavefproducts_inv5") END SUBROUTINE wavefproducts_inv5 - subroutine wavefproducts_inv_IS_using_noinv(bandi, bandf, bandoi, bandof, dimension, input,& + subroutine wavefproducts_inv_IS_using_noinv(bandi, bandf, bandoi, bandof, input,& jsp, atoms, lapw, kpts, nk, iq, g_t, hybdat, mpbasis, hybrid,& cell, nbasm_mt, sym, noco, nkqpt, rprod) use m_types @@ -72,7 +72,6 @@ CONTAINS use m_judft implicit NONE - TYPE(t_dimension), INTENT(IN) :: dimension TYPE(t_mpbasis), intent(in) :: mpbasis TYPE(t_hybrid), INTENT(IN) :: hybrid TYPE(t_input), INTENT(IN) :: input @@ -93,13 +92,13 @@ CONTAINS COMPLEX :: cprod(hybrid%maxbasm1, bandoi:bandof, bandf - bandi + 1) call wavefproducts_noinv5_IS(bandi, bandf, bandoi, bandof, nk, iq, g_t,& - dimension, input, jsp, cell, atoms, mpbasis, hybrid,& + input, jsp, cell, atoms, mpbasis, hybrid,& hybdat, kpts, lapw, sym, nbasm_mt, noco,& nkqpt, cprod) rprod = real(cprod) end subroutine wavefproducts_inv_IS_using_noinv - subroutine wavefproducts_inv_IS(bandi, bandf, bandoi, bandof, dimension, input,& + subroutine wavefproducts_inv_IS(bandi, bandf, bandoi, bandof, input,& jsp, atoms, lapw, kpts, nk, iq, g_t, hybdat, mpbasis, hybrid,& cell, nbasm_mt, sym, noco, nkqpt, cprod) use m_types @@ -108,7 +107,6 @@ CONTAINS use m_judft use m_io_hybrid implicit NONE - TYPE(t_dimension), INTENT(IN) :: dimension TYPE(t_mpbasis), intent(in) :: mpbasis TYPE(t_hybrid), INTENT(IN) :: hybrid TYPE(t_input), INTENT(IN) :: input @@ -153,9 +151,9 @@ CONTAINS ! CALL lapw_nkqpt%init(input, noco, kpts, atoms, sym, nkqpt, cell, sym%zrfs) nbasfcn = calc_number_of_basis_functions(lapw, atoms, noco) - call z_nk%alloc(.true., nbasfcn, dimension%neigd) + call z_nk%alloc(.true., nbasfcn, input%neig) nbasfcn = calc_number_of_basis_functions(lapw_nkqpt, atoms, noco) - call z_kqpt%alloc(.true., nbasfcn, dimension%neigd) + call z_kqpt%alloc(.true., nbasfcn, input%neig) ! read in z at k-point nk and nkqpt call timestart("read_z") @@ -224,15 +222,15 @@ CONTAINS end subroutine wavefproducts_inv_IS - subroutine wavefproducts_inv5_MT(bandi, bandf, bandoi, bandof, dimension,& - atoms, kpts, nk, iq, hybdat, mpbasis, hybrid,& + subroutine wavefproducts_inv5_MT(bandi, bandf, bandoi, bandof,& + input,atoms, kpts, nk, iq, hybdat, mpbasis, hybrid,& sym, nkqpt, cprod) use m_types use m_judft use m_io_hybrid use m_constants implicit NONE - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_input),INTENT(IN) :: input TYPE(t_mpbasis), INTENT(IN) :: mpbasis TYPE(t_hybrid), INTENT(IN) :: hybrid TYPE(t_sym), INTENT(IN) :: sym @@ -266,8 +264,8 @@ CONTAINS ! - local arrays - INTEGER :: lmstart(0:atoms%lmaxd, atoms%ntype) - REAL :: cmt_nk(dimension%neigd, hybrid%maxlmindx, atoms%nat) - REAL :: cmt(dimension%neigd, hybrid%maxlmindx, atoms%nat) + REAL :: cmt_nk(input%neig, hybrid%maxlmindx, atoms%nat) + REAL :: cmt(input%neig, hybrid%maxlmindx, atoms%nat) REAL :: rarr2(bandoi:bandof, bandf - bandi + 1) REAL :: rarr3(2, bandoi:bandof, bandf - bandi + 1) @@ -283,8 +281,8 @@ CONTAINS END DO ! read in cmt coefficient at k-point nk - allocate(ccmt_nk(dimension%neigd, hybrid%maxlmindx, atoms%nat), & - ccmt(dimension%neigd, hybrid%maxlmindx, atoms%nat), & + allocate(ccmt_nk(input%neig, hybrid%maxlmindx, atoms%nat), & + ccmt(input%neig, hybrid%maxlmindx, atoms%nat), & source=cmplx(0.0, 0.0), stat=ok) IF (ok /= 0) call juDFT_error('wavefproducts_inv5: error allocation ccmt_nk/ccmt') diff --git a/hybrid/wavefproducts_noinv.f90 b/hybrid/wavefproducts_noinv.f90 index afe4e9bb..b642da96 100644 --- a/hybrid/wavefproducts_noinv.f90 +++ b/hybrid/wavefproducts_noinv.f90 @@ -1,15 +1,15 @@ module m_wavefproducts_noinv + USE m_types_hybdat CONTAINS SUBROUTINE wavefproducts_noinv5(bandi, bandf, bandoi, bandof, nk, iq, & - dimension, input, jsp, cell, atoms, mpbasis, hybrid,& + input, jsp, cell, atoms, mpbasis, hybrid,& hybdat, kpts, lapw, sym, nbasm_mt, noco,& nkqpt, cprod) USE m_types use m_juDFT IMPLICIT NONE - TYPE(t_dimension), INTENT(IN) :: dimension TYPE(t_input), INTENT(IN) :: input TYPE(t_noco), INTENT(IN) :: noco TYPE(t_sym), INTENT(IN) :: sym @@ -46,19 +46,19 @@ CONTAINS IF (.not. kpts%is_kpt(kqpt)) call juDFT_error('wavefproducts: k-point not found') call wavefproducts_noinv5_IS(bandi, bandf, bandoi, bandof, nk, iq, g_t,& - dimension, input, jsp, cell, atoms, mpbasis, hybrid,& + input, jsp, cell, atoms, mpbasis, hybrid,& hybdat, kpts, lapw, sym, nbasm_mt, noco,& nkqpt, cprod) call wavefproducts_noinv_MT(bandi, bandf, bandoi, bandof, nk, iq, & - dimension, atoms, mpbasis, hybrid, hybdat, kpts, & + input,atoms, mpbasis, hybrid, hybdat, kpts, & nkqpt, cprod) call timestop("wavefproducts_noinv5") END SUBROUTINE wavefproducts_noinv5 subroutine wavefproducts_noinv5_IS(bandi, bandf, bandoi, bandof, nk, iq, g_t, & - dimension, input, jsp, cell, atoms, mpbasis, hybrid,& + input, jsp, cell, atoms, mpbasis, hybrid,& hybdat, kpts, lapw, sym, nbasm_mt, noco,& nkqpt, cprod) use m_types @@ -67,7 +67,6 @@ CONTAINS use m_judft use m_io_hybrid implicit NONE - TYPE(t_dimension), INTENT(IN) :: dimension TYPE(t_input), INTENT(IN) :: input TYPE(t_noco), INTENT(IN) :: noco TYPE(t_sym), INTENT(IN) :: sym @@ -119,9 +118,9 @@ CONTAINS ! CALL lapw_nkqpt%init(input, noco, kpts, atoms, sym, nkqpt, cell, sym%zrfs) nbasfcn = calc_number_of_basis_functions(lapw, atoms, noco) - call z_nk%alloc(.false., nbasfcn, dimension%neigd) + call z_nk%alloc(.false., nbasfcn, input%neig) nbasfcn = calc_number_of_basis_functions(lapw_nkqpt, atoms, noco) - call z_kqpt%alloc(.false., nbasfcn, dimension%neigd) + call z_kqpt%alloc(.false., nbasfcn, input%neig) ! read in z at k-point nk and nkqpt call timestart("read_z") @@ -199,7 +198,7 @@ CONTAINS subroutine wavefproducts_noinv_MT(bandi, bandf, bandoi, bandof, nk, iq, & - dimension, atoms, mpbasis, hybrid, hybdat, kpts, & + input,atoms, mpbasis, hybrid, hybdat, kpts, & nkqpt, cprod) use m_types USE m_constants @@ -207,7 +206,7 @@ CONTAINS use m_judft use m_wavefproducts_aux IMPLICIT NONE - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_input),INTENT(IN) :: input TYPE(t_kpts), INTENT(IN) :: kpts TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_mpbasis), INTENT(IN) :: mpbasis @@ -236,8 +235,8 @@ CONTAINS INTEGER :: lmstart(0:atoms%lmaxd, atoms%ntype) COMPLEX :: carr(bandoi:bandof, bandf - bandi + 1) - COMPLEX :: cmt(dimension%neigd, hybrid%maxlmindx, atoms%nat) - COMPLEX :: cmt_nk(dimension%neigd, hybrid%maxlmindx, atoms%nat) + COMPLEX :: cmt(input%neig, hybrid%maxlmindx, atoms%nat) + COMPLEX :: cmt_nk(input%neig, hybrid%maxlmindx, atoms%nat) call timestart("wavefproducts_noinv5 MT") ! lmstart = lm start index for each l-quantum number and atom type (for cmt-coefficients) diff --git a/init/postprocessInput.F90 b/init/postprocessInput.F90 index 04b0b6fe..2792ee5b 100644 --- a/init/postprocessInput.F90 +++ b/init/postprocessInput.F90 @@ -9,7 +9,7 @@ MODULE m_postprocessInput CONTAINS SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,& - oneD,hybrid,cell,banddos,sliceplot,xcpot,forcetheo,forcetheo_data,& + oneD,cell,banddos,sliceplot,xcpot,forcetheo,forcetheo_data,& noco,sphhar,l_kpts) USE m_juDFT @@ -44,8 +44,6 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,& TYPE(t_vacuum), INTENT(INOUT) :: vacuum TYPE(t_kpts), INTENT(INOUT) :: kpts TYPE(t_oneD), INTENT(INOUT) :: oneD - TYPE(t_mpbasis), intent(inout) :: mpbasis - TYPE(t_hybrid), INTENT(INOUT) :: hybrid TYPE(t_cell), INTENT(INOUT) :: cell TYPE(t_banddos), INTENT(INOUT) :: banddos TYPE(t_sliceplot),INTENT(INOUT) :: sliceplot diff --git a/inpgen2/CMakeLists.txt b/inpgen2/CMakeLists.txt index 7b6185b1..d824f8c2 100644 --- a/inpgen2/CMakeLists.txt +++ b/inpgen2/CMakeLists.txt @@ -85,7 +85,6 @@ ${FLEUR_SRC}/types/types_regionCharges.f90 ${FLEUR_SRC}/types/types_dos.f90 ${FLEUR_SRC}/types/types_denCoeffsOffdiag.f90 ${FLEUR_SRC}/types/types_gpumat.F90 -${FLEUR_SRC}/types/types_dimension.f90 ${FLEUR_SRC}/io/nocoInputCheck.F90 ${FLEUR_SRC}/eigen/orthoglo.F90 diff --git a/inpgen2/make_atomic_defaults.f90 b/inpgen2/make_atomic_defaults.f90 index fb7f4bbe..dad7921f 100644 --- a/inpgen2/make_atomic_defaults.f90 +++ b/inpgen2/make_atomic_defaults.f90 @@ -26,10 +26,10 @@ CONTAINS TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_cell),INTENT(IN) :: cell TYPE(t_oneD),INTENT(IN) :: oneD - + INTEGER :: i,l,id,n,nn INTEGER :: element_species(120) - + CHARACTER(len=1) :: lotype(0:3)=(/'s','p','d','f'/) TYPE(t_atompar):: ap(atoms%ntype) element_species=0 @@ -40,7 +40,9 @@ CONTAINS ALLOCATE(atoms%lmax(atoms%ntype)) ALLOCATE(atoms%nlo(atoms%ntype)) ALLOCATE(atoms%lnonsph(atoms%ntype)) - ALLOCATE(atoms%nflip(atoms%ntype)) + ALLOCATE(atoms%flipSpinPhi(atoms%ntype)) + ALLOCATE(atoms%flipspinTheta(atoms%ntype)) + ALLOCATE(atoms%flipSpinScale(atoms%ntype)) ALLOCATE(atoms%l_geo(atoms%ntype)) ALLOCATE(atoms%lda_u(atoms%ntype)) ALLOCATE(atoms%econf(atoms%ntype)) @@ -52,11 +54,15 @@ CONTAINS atoms%lapw_l=0 atoms%speciesname="" - + atoms%nz(:) = NINT(atoms%zatom(:)) atoms%rmt(:) = 999.9 atoms%ulo_der = 0 - atoms%l_geo(:) = .TRUE.; atoms%nflip(:) = 1 + atoms%l_geo(:) = .TRUE.; + atoms%flipSpinPhi=0.0 + atoms%flipSpinTheta=0.0 + atoms%flipSpinScale=.FALSE. + atoms%lda_u%l = -1 ; atoms%relax(1:2,:) = 1 ; atoms%relax(:,:) = 1 !Determine MT-radii @@ -84,20 +90,19 @@ CONTAINS atoms%nlo(n)=len_TRIM(ap(n)%lo)/2 DO i=1,atoms%nlo(n) DO l = 0, 3 - !Setting of llo will be redone below - IF (ap(n)%lo(2*i:2*i) == lotype(l)) atoms%llo(i,n) = l + !Setting of llo will be redone below + IF (ap(n)%lo(2*i:2*i) == lotype(l)) atoms%llo(i,n) = l ENDDO ENDDO CALL atoms%econf(n)%init(ap(n)%econfig) if (abs(ap(n)%bmu)>1E-8) call atoms%econf(n)%set_initial_moment(ap(n)%bmu) !atoms%ncst(n)=econfig_count_core(econfig) - - - atoms%nflip(n)=1 + + atoms%lda_u(n)%l=-1 atoms%l_geo(n)=.FALSE. atoms%relax(:,n)=1 - + ! rounding atoms%dx(:) = REAL(NINT(atoms%dx(:) * 1000) / 1000.) !Generate species-names @@ -116,17 +121,17 @@ CONTAINS ALLOCATE(atoms%llo(atoms%nlod,atoms%ntype));atoms%llo=-1 ALLOCATE(atoms%ulo_der(atoms%nlod,atoms%ntype)) atoms%ulo_der=0 - + CALL enpara%init(atoms%ntype,atoms%nlod,2,.TRUE.,atoms%nz) DO n=1,atoms%ntype DO i=1,atoms%nlo(n) DO l = 0, 3 - IF (ap(n)%lo(2*i:2*i) == lotype(l)) atoms%llo(i,n) = l + IF (ap(n)%lo(2*i:2*i) == lotype(l)) atoms%llo(i,n) = l ENDDO ENDDO CALL enpara%set_quantum_numbers(n,atoms,ap(n)%econfig,ap(n)%lo) END DO - + END SUBROUTINE make_atomic_defaults END MODULE m_make_atomic_defaults diff --git a/inpgen2/make_defaults.f90 b/inpgen2/make_defaults.f90 index 2d20c9f3..1491dca6 100644 --- a/inpgen2/make_defaults.f90 +++ b/inpgen2/make_defaults.f90 @@ -13,7 +13,7 @@ MODULE m_make_defaults ! help in the out-file. gb`02 !--------------------------------------------------------------------- CONTAINS - + SUBROUTINE make_defaults(atoms,sym,cell,vacuum,input,stars,& xcpot,noco,hybrid) USE m_types_atoms @@ -25,21 +25,21 @@ CONTAINS USE m_types_stars USE m_types_noco USE m_types_hybrid - - + + TYPE(t_atoms),INTENT(IN) ::atoms TYPE(t_sym),INTENT(IN) ::sym TYPE(t_cell),INTENT(IN) ::cell - - + + TYPE(t_vacuum),INTENT(INOUT)::vacuum TYPE(t_input),INTENT(INOUT) ::input TYPE(t_stars),INTENT(INOUT) ::stars TYPE(t_xcpot_inbuild_nf),INTENT(INOUT) ::xcpot TYPE(t_noco),INTENT(INOUT) ::noco TYPE(t_hybrid),INTENT(INOUT)::hybrid - - + + integer :: n ! !input @@ -48,22 +48,22 @@ CONTAINS IF (noco%l_ss) noco%l_noco=.TRUE. IF (noco%l_noco) input%jspins = 2 !check for magnetism - DO n=1,atoms%ntype + DO n=1,atoms%ntype IF (ANY(atoms%econf(n)%occupation(:,1).NE.atoms%econf(n)%occupation(:,2))) input%jspins=2 ENDDO - - + + IF ( ANY(atoms%nlo(:).NE.0) ) THEN input%ellow = -1.8 ELSE - input%ellow = -0.8 + input%ellow = -0.8 ENDIF IF (input%film) THEN input%elup = 0.5 ELSE input%elup = 1.0 - ENDIF + ENDIF IF (hybrid%l_hybrid) THEN input%ellow = input%ellow - 2.0 input%elup = input%elup + 10.0 @@ -95,7 +95,7 @@ CONTAINS xcpot%gmaxxc = merge(xcpot%gmaxxc,3.0*input%rkmax,xcpot%gmaxxc>0) xcpot%gmaxxc = real(NINT(xcpot%gmaxxc * 10 ) / 10.) xcpot%l_inbuild=.true. - if (xcpot%icorr==0) call xcpot%init(atoms%ntype) + if (xcpot%icorr==0) call xcpot%init(atoms%ntype) ! !vacuum @@ -108,7 +108,7 @@ CONTAINS vacuum%nvac = 2 IF (sym%zrfs.OR.sym%invs) vacuum%nvac = 1 !IF (oneD%odd%d1) vacuum%nvac = 1 - + ! !noco ! @@ -120,11 +120,11 @@ CONTAINS noco%alph(:) = 0.0 noco%beta(:) = 0.0 noco%b_con(:,:) = 0.0 - + ! !hybrid ! - hybrid%gcutm1 = input%rkmax - 0.5 + !hybrid%gcutm1 = input%rkmax - 0.5 ALLOCATE(hybrid%lcutwf(atoms%ntype)) ALLOCATE(hybrid%lcutm1(atoms%ntype)) ALLOCATE(hybrid%select1(4,atoms%ntype)) @@ -135,8 +135,8 @@ CONTAINS hybrid%select1(3,:) = 4 hybrid%select1(4,:) = 2 !hybrid%l_hybrid = l_hyb - hybrid%gcutm1 = real(NINT(hybrid%gcutm1 * 10 ) / 10.) - + !hybrid%gcutm1 = real(NINT(hybrid%gcutm1 * 10 ) / 10.) + END SUBROUTINE make_defaults END MODULE m_make_defaults diff --git a/inpgen2/old_inp/dimen7.F90 b/inpgen2/old_inp/dimen7.F90 index 568a7b29..0322f027 100644 --- a/inpgen2/old_inp/dimen7.F90 +++ b/inpgen2/old_inp/dimen7.F90 @@ -57,7 +57,6 @@ TYPE(t_vacuum),INTENT(INOUT) :: vacuum TYPE(t_kpts),INTENT(INOUT) :: kpts TYPE(t_oneD),INTENT(INOUT) :: oneD - TYPE(t_mpbasis), intent(inout) :: mpbasis TYPE(t_hybrid),INTENT(INOUT) :: hybrid TYPE(t_cell),INTENT(INOUT) :: cell @@ -115,7 +114,7 @@ ALLOCATE (& & atoms%lmax(atoms%ntype),sym%ntypsy(atoms%nat),atoms%neq(atoms%ntype),atoms%nlhtyp(atoms%ntype),& & atoms%rmt(atoms%ntype),atoms%zatom(atoms%ntype),atoms%jri(atoms%ntype),atoms%dx(atoms%ntype), & - & atoms%nlo(atoms%ntype),atoms%llo(atoms%nlod,atoms%ntype),atoms%nflip(atoms%ntype),atoms%bmu(atoms%ntype),& + & atoms%nlo(atoms%ntype),atoms%llo(atoms%nlod,atoms%ntype),atoms%bmu(atoms%ntype),& & noel(atoms%ntype),vacuum%izlay(vacuum%layerd,2),atoms%econf(atoms%ntype),atoms%lnonsph(atoms%ntype),& & atoms%taual(3,atoms%nat),atoms%pos(3,atoms%nat),& & atoms%nz(atoms%ntype),atoms%relax(3,atoms%ntype),& @@ -372,7 +371,7 @@ !CALL parawrite(sym,stars,atoms,sphhar,vacuum,kpts,oneD,input) DEALLOCATE( sym%mrot,sym%tau,& - & atoms%lmax,sym%ntypsy,atoms%neq,atoms%nlhtyp,atoms%rmt,atoms%zatom,atoms%jri,atoms%dx,atoms%nlo,atoms%llo,atoms%nflip,atoms%bmu,noel,& + & atoms%lmax,sym%ntypsy,atoms%neq,atoms%nlhtyp,atoms%rmt,atoms%zatom,atoms%jri,atoms%dx,atoms%nlo,atoms%llo,atoms%bmu,noel,& & vacuum%izlay,atoms%econf,atoms%lnonsph,atoms%taual,atoms%pos,atoms%nz,atoms%relax,& & atoms%l_geo,noco%alph,noco%beta,atoms%lda_u,noco%l_relax,noco%b_con,sphhar%clnu,sphhar%nlh,& & sphhar%llh,sphhar%nmem,sphhar%mlh,hybrid%select1,hybrid%lcutm1,& diff --git a/inpgen2/old_inp/fleur_init_old.F90 b/inpgen2/old_inp/fleur_init_old.F90 index 8fffdd43..b799067a 100644 --- a/inpgen2/old_inp/fleur_init_old.F90 +++ b/inpgen2/old_inp/fleur_init_old.F90 @@ -38,7 +38,7 @@ CONTAINS IMPLICIT NONE ! Types, these variables contain a lot of data! TYPE(t_input) ,INTENT(INOUT):: input - + TYPE(t_atoms) ,INTENT(OUT) :: atoms TYPE(t_sphhar) ,INTENT(OUT) :: sphhar TYPE(t_cell) ,INTENT(OUT) :: cell @@ -92,7 +92,7 @@ CONTAINS ALLOCATE ( atoms%ncv(atoms%ntype),atoms%neq(atoms%ntype),sym%ngopr(atoms%nat) ) ALLOCATE ( sphhar%nlh(sphhar%ntypsd),sphhar%nmem(0:sphhar%nlhd,sphhar%ntypsd) ) ALLOCATE ( stars%nstr2(stars%ng2),sym%ntypsy(atoms%nat),stars%nstr(stars%ng3) ) - ALLOCATE ( stars%igfft(0:stars%kimax,2),stars%igfft2(0:stars%kimax2,2),atoms%nflip(atoms%ntype) ) + ALLOCATE ( stars%igfft(0:stars%kimax,2),stars%igfft2(0:stars%kimax2,2) ) ALLOCATE ( atoms%econf(atoms%ntype) ) ALLOCATE ( vacuum%izlay(vacuum%layerd,2) ) ALLOCATE ( sym%invarop(atoms%nat,sym%nop),sym%invarind(atoms%nat) ) @@ -126,7 +126,7 @@ CONTAINS !-odim ! HF/hybrid functionals/EXX - ALLOCATE ( hybrid%nindx(0:atoms%lmaxd,atoms%ntype) ) + !ALLOCATE ( hybrid%nindx(0:atoms%lmaxd,atoms%ntype) ) input%l_coreSpec = .FALSE. diff --git a/inpgen2/old_inp/inped.F90 b/inpgen2/old_inp/inped.F90 index d39d8063..ddd16c33 100644 --- a/inpgen2/old_inp/inped.F90 +++ b/inpgen2/old_inp/inped.F90 @@ -61,7 +61,6 @@ TYPE(t_noco), INTENT(INOUT) :: noco TYPE(t_stars), INTENT(INOUT) :: stars TYPE(t_oneD), INTENT(INOUT) :: oneD - TYPE(t_mpbasis), intent(inout) :: mpbasis TYPE(t_hybrid), INTENT(INOUT) :: hybrid TYPE(t_kpts), INTENT(INOUT) :: kpts REAL, INTENT(OUT) :: a1(3) diff --git a/inpgen2/old_inp/rw_inp.f90 b/inpgen2/old_inp/rw_inp.f90 index dc87231e..5a277ff1 100644 --- a/inpgen2/old_inp/rw_inp.f90 +++ b/inpgen2/old_inp/rw_inp.f90 @@ -83,7 +83,7 @@ REAL ::scpos ,zc,dtild INTEGER ::nw,idsprs,ncst INTEGER ieq,i,k,na,n,ilo - REAL s3,ah,a,hs2,rest + REAL s3,ah,a,hs2,rest,rdum,rdum1 LOGICAL l_hyb,l_sym,ldum INTEGER :: ierr, intDummy ! .. @@ -331,9 +331,10 @@ GOTO 78 ELSEIF ( ch_test .eq. 'gcu' ) then ! HF BACKSPACE (5) - READ (UNIT=5,FMT=7999,END=99,ERR=99) hybrid%gcutm1,hybrid%tolerance1,& + call judft_warn("Hybrid parameters not supported in old input") + READ (UNIT=5,FMT=7999,END=99,ERR=99) rdum1,rdum,& & hybrid%ewaldlambda,hybrid%lexp,hybrid%bands1 - WRITE (6,9999) hybrid%gcutm1,hybrid%tolerance1,hybrid%ewaldlambda,hybrid%lexp,hybrid%bands1 + WRITE (6,9999) rdum1,rdum,hybrid%ewaldlambda,hybrid%lexp,hybrid%bands1 7999 FORMAT (6x,f8.5,6x,f10.8,8x,i2,6x,i2,7x,i4) 9999 FORMAT ('gcutm=',f8.5,',mtol=',f10.8,',lambda=',i2,& & ',lexp=',i2,',bands=',i4) @@ -594,14 +595,14 @@ chform = '(6x,l1,'//chntype//'i3 )' ! chform = '(6x,l1,23i3 )' READ (UNIT=5,FMT=chform,END=99,ERR=99)& - & input%lflip, (atoms%nflip(i),i=1,atoms%ntype) + & input%lflip !- chform = '("swsp=",l1,'//chntype//'f6.2)' ! chform = '("swsp=",l1,23f6.2)' WRITE (6,FMT=chform) input%swsp, (atoms%bmu(i),i=1,atoms%ntype) chform = '("lflip=",l1,'//chntype//'i3 )' ! chform = '("lflip=",l1,23i3 )' - WRITE (6,FMT=chform) input%lflip, (atoms%nflip(i),i=1,atoms%ntype) + WRITE (6,FMT=chform) input%lflip !-roa !+stm READ (UNIT=5,FMT=8075,END=99,ERR=99)& @@ -795,7 +796,7 @@ ! ENDIF IF( namex.EQ.'hf ' .OR. namex .EQ. 'exx ' .OR. namex .EQ. 'hse '& & .OR. namex.EQ.'vhse' ) THEN - WRITE (5,9999) hybrid%gcutm1,hybrid%tolerance1,hybrid%ewaldlambda,hybrid%lexp,hybrid%bands1 + WRITE (5,9999) 0.0,0.0,hybrid%ewaldlambda,hybrid%lexp,hybrid%bands1 l_hyb = .true. END IF @@ -921,7 +922,7 @@ chform = '("swsp=",l1,'//chntype//'f6.2)' WRITE (5,FMT=chform) input%swsp, (atoms%bmu(i),i=1,atoms%ntype) chform = '("lflip=",l1,'//chntype//'i3 )' - WRITE (5,FMT=chform) input%lflip, (atoms%nflip(i),i=1,atoms%ntype) + WRITE (5,FMT=chform) input%lflip, (.false.,i=1,atoms%ntype) !-roa !+stm WRITE (5,9210) banddos%vacdos,vacuum%layers,input%integ,vacuum%starcoeff,vacuum%nstars,& diff --git a/io/io_hybrid.F90 b/io/io_hybrid.F90 index e2268806..d3a82c6f 100644 --- a/io/io_hybrid.F90 +++ b/io/io_hybrid.F90 @@ -59,7 +59,7 @@ contains if (opened) return opened=.true. OPEN(unit=777,file='cmt',form='unformatted',access='direct',& - & recl=dimension%neigd*hybrid%maxlmindx*atoms%nat*16) + & recl=input%neig*hybrid%maxlmindx*atoms%nat*16) #ifdef CPP_NOSPMVEC irecl_coulomb = hybrid%maxbasm1 * (hybrid%maxbasm1+1) * 8 / 2 diff --git a/io/w_inpXML.f90 b/io/w_inpXML.f90 index 34cffc15..7938c8a9 100644 --- a/io/w_inpXML.f90 +++ b/io/w_inpXML.f90 @@ -179,10 +179,10 @@ SUBROUTINE w_inpXML(& 150 FORMAT(' ') WRITE (fileNum,150) noco%theta,noco%phi,noco%l_soc,noco%l_spav - IF (l_explicit.OR.hybrid%l_hybrid) THEN - 155 FORMAT(' ') - WRITE (fileNum,155) hybrid%gcutm1,hybrid%tolerance1,hybrid%ewaldlambda,hybrid%lexp,hybrid%bands1 - END IF +! IF (l_explicit.OR.hybrid%l_hybrid) THEN +! 155 FORMAT(' ') +! WRITE (fileNum,155) hybrid%gcutm1,hybrid%tolerance1,hybrid%ewaldlambda,hybrid%lexp,hybrid%bands1 +! END IF IF (l_nocoOpt.OR.l_explicit) THEN 160 FORMAT(' - 300 FORMAT(' ') + 300 FORMAT(' ') speciesName = TRIM(ADJUSTL(atoms%speciesName(iSpecies))) - WRITE (fileNum,300) TRIM(ADJUSTL(speciesName)),TRIM(ADJUSTL(namat_const(atoms%nz(iAtomType)))),atoms%nz(iAtomType),atoms%nflip(iAtomType) + WRITE (fileNum,300) TRIM(ADJUSTL(speciesName)),TRIM(ADJUSTL(namat_const(atoms%nz(iAtomType)))),atoms%nz(iAtomType),atoms%flipSpinPhi(iAtomType),atoms%flipSpinTheta(iAtomType),atoms%flipSpinScale(iAtomType) ! 310 FORMAT(' ') @@ -344,12 +344,12 @@ SUBROUTINE w_inpXML(& WRITE (fileNum,320) atoms%lmax(iAtomType),atoms%lnonsph(iAtomType) - IF(l_explicit.OR.hybrid%l_hybrid) THEN - 315 FORMAT(' ') - line = '' - WRITE(line,'(i0,1x,i0,1x,i0,1x,i0)') hybrid%select1(1:4,iAtomType) - WRITE (fileNum,315) hybrid%lcutm1(iAtomType), hybrid%lcutwf(iAtomType), TRIM(ADJUSTL(line)) - END IF +! IF(l_explicit.OR.hybrid%l_hybrid) THEN +! 315 FORMAT(' ') +! line = '' +! WRITE(line,'(i0,1x,i0,1x,i0,1x,i0)') hybrid%select1(1:4,iAtomType) +! WRITE (fileNum,315) hybrid%lcutm1(iAtomType), hybrid%lcutwf(iAtomType), TRIM(ADJUSTL(line)) +! END IF WRITE (fileNum,'(a)') ' ' diff --git a/kpoints/CMakeLists.txt b/kpoints/CMakeLists.txt index 91ee591c..0165ccea 100644 --- a/kpoints/CMakeLists.txt +++ b/kpoints/CMakeLists.txt @@ -10,11 +10,11 @@ kpoints/kvecon.f kpoints/od_kptsgen.f kpoints/ordstar.f kpoints/tetcon.f +kpoints/kptgen_hybrid.f ) set(fleur_F90 ${fleur_F90} kpoints/gkptwgt.f90 kpoints/unfoldBandKPTS.f90 kpoints/brzone2.f90 -kpoints/kptgen_hybrid.f90 ) diff --git a/kpoints/kptgen_hybrid.f90 b/kpoints/kptgen_hybrid.f90 index 395bd811..73f4acad 100644 --- a/kpoints/kptgen_hybrid.f90 +++ b/kpoints/kptgen_hybrid.f90 @@ -198,7 +198,7 @@ CONTAINS kpts%bk(:, ikpt) = bk(:, ikpt) kpts%wtkpt(ikpt) = neqkpt(ikpt) END DO - kpts%posScale = 1.0 + !kpts%posScale = 1.0 CONTAINS diff --git a/main/cdngen.F90 b/main/cdngen.F90 index 49c14515..158aca47 100644 --- a/main/cdngen.F90 +++ b/main/cdngen.F90 @@ -98,7 +98,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& LOGICAL :: l_error, perform_MetaGGA CALL regCharges%init(input,atoms) - CALL dos%init(input%neig,input,atoms,kpts,vacuum) + CALL dos%init(input,atoms,kpts,vacuum) CALL moments%init(mpi,input,sphhar,atoms) CALL mcd%init1(banddos,input,atoms,kpts) CALL slab%init(banddos,atoms,cell,input,kpts) @@ -181,7 +181,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& IF(.FALSE.) CALL denMultipoleExp(input, mpi, atoms, sphhar, stars, sym, cell, oneD, outDen) ! There should be a switch in the inp file for this IF(mpi%irank.EQ.0) THEN - IF(.FALSE.) CALL resMoms(input,atoms,sphhar,noco,outDen,moments%rhoLRes) ! There should be a switch in the inp file for this + IF(.FALSE.) CALL resMoms(sym,input,atoms,sphhar,noco,outDen,moments%rhoLRes) ! There should be a switch in the inp file for this END IF CALL enpara%calcOutParams(input,atoms,vacuum,regCharges) diff --git a/main/fleur.F90 b/main/fleur.F90 index f1957806..e3880081 100644 --- a/main/fleur.F90 +++ b/main/fleur.F90 @@ -127,7 +127,7 @@ CONTAINS CALL timestart("Initialization") CALL fleur_init(mpi,input,field,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,sliceplot,& - banddos,obsolete,enpara,xcpot,results,kpts,mpbasis,hybrid,oneD,coreSpecInput,wann,l_opti) + banddos,enpara,xcpot,results,kpts,hybrid,oneD,coreSpecInput,wann) CALL timestop("Initialization") IF ( ( input%preconditioning_param /= 0 ) .AND. oneD%odi%d1 ) THEN @@ -188,8 +188,8 @@ CONTAINS wannierspin = input%jspins endif - eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,DIMENSION%neigd,kpts%nkpt,wannierspin,& - noco%l_noco,.NOT.INPUT%eig66(1),l_real,noco%l_soc,INPUT%eig66(1),mpi%n_size) + eig_id=open_eig(mpi%mpi_comm,lapw_dim_nbasfcn,input%neig,kpts%nkpt,wannierspin,& + noco%l_noco,.true.,l_real,noco%l_soc,.false.,mpi%n_size) #ifdef CPP_CHASE CALL init_chase(mpi,input,atoms,kpts,noco,sym%invs.AND..NOT.noco%l_noco) @@ -243,9 +243,9 @@ CONTAINS CALL open_hybrid_io1(sym%invs) END IF - IF(.not.input%eig66(1))THEN + !IF(.not.input%eig66(1))THEN CALL reset_eig(eig_id,noco%l_soc) ! This has to be placed after the calc_hybrid call but before eigen - END IF + !END IF !#endif @@ -290,10 +290,10 @@ CONTAINS CALL timestart("Updating energy parameters") CALL enpara%update(mpi%mpi_comm,atoms,vacuum,input,vToT) CALL timestop("Updating energy parameters") - IF(.not.input%eig66(1))THEN - CALL eigen(mpi,stars,sphhar,atoms,xcpot,sym,kpts,DIMENSION,vacuum,input,& + !IF(.not.input%eig66(1))THEN + CALL eigen(mpi,stars,sphhar,atoms,xcpot,sym,kpts,vacuum,input,& cell,enpara,banddos,noco,oneD,mpbasis,hybrid,iter,eig_id,results,inDen,vTemp,vx) - ENDIF + !ENDIF vTot%mmpMat = vTemp%mmpMat !!$ eig_idList(pc) = eig_id CALL timestop("eigen") diff --git a/main/fleur_init.F90 b/main/fleur_init.F90 index 2a4bb4c7..938e476e 100644 --- a/main/fleur_init.F90 +++ b/main/fleur_init.F90 @@ -154,9 +154,7 @@ CONTAINS CALL convn(atoms,stars) if (mpi%irank==0) CALL e_field(atoms,stars,sym,vacuum,cell,input,field%efield) if (mpi%isize>1) call field%mpi_bc(mpi%mpi_comm,0) - ! Initialize missing hybrid functionals arrays - ALLOCATE (hybrid%nindx(0:atoms%lmaxd,atoms%ntype)) - + !At some point this should be enabled for noco as well IF (.not.noco%l_noco) & CALL transform_by_moving_atoms(mpi,stars,atoms,vacuum, cell, sym, sphhar,input,oned,noco) diff --git a/math/CMakeLists.txt b/math/CMakeLists.txt index 451c0289..9f204cc2 100644 --- a/math/CMakeLists.txt +++ b/math/CMakeLists.txt @@ -18,8 +18,6 @@ math/difcub.f set(fleur_F90 ${fleur_F90} math/d_wigner.F90 math/inv3.f90 -math/cfft.F90 -math/rfft.f90 math/qranf.f90 math/differentiate.f90 math/SphBessel.f90 diff --git a/math/LattHarmsSphHarmsConv.f90 b/math/LattHarmsSphHarmsConv.f90 index 3d253222..1c912e2b 100644 --- a/math/LattHarmsSphHarmsConv.f90 +++ b/math/LattHarmsSphHarmsConv.f90 @@ -2,12 +2,12 @@ MODULE m_lattHarmsSphHarmsConv CONTAINS -SUBROUTINE lattHarmsRepToSphHarms(atoms, lattHarms, iType, funcLattHarms, funcSphHarms) +SUBROUTINE lattHarmsRepToSphHarms(sym,atoms, lattHarms, iType, funcLattHarms, funcSphHarms) USE m_types IMPLICIT NONE - + TYPE(t_sym), INTENT(IN) :: sym TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_sphhar), INTENT(IN) :: lattHarms INTEGER, INTENT(IN) :: iType @@ -17,7 +17,7 @@ SUBROUTINE lattHarmsRepToSphHarms(atoms, lattHarms, iType, funcLattHarms, funcSp INTEGER :: iAtom, iLH, ns, l, iM, m, lm, iR iAtom = SUM(atoms%neq(:iType-1)) + 1 - ns = atoms%ntypsy(iAtom) + ns = sym%ntypsy(iAtom) funcSphHarms = CMPLX(0.0,0.0) diff --git a/math/lh_tofrom_lm.f90 b/math/lh_tofrom_lm.f90 index 4b7ada4b..a4d6c5e4 100644 --- a/math/lh_tofrom_lm.f90 +++ b/math/lh_tofrom_lm.f90 @@ -1,10 +1,11 @@ MODULE m_lh_tofrom_lm CONTAINS - SUBROUTINE lh_to_lm(atoms, lathar, iType, flh, flm) + SUBROUTINE lh_to_lm(sym,atoms, lathar, iType, flh, flm) USE m_types IMPLICIT NONE + TYPE(t_sym),INTENT(IN) :: sym TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_sphhar), INTENT(IN) :: lathar INTEGER, INTENT(IN) :: iType @@ -16,7 +17,7 @@ CONTAINS REAL, ALLOCATABLE :: fVec(:,:) iAtom = SUM(atoms%neq(:iType-1)) + 1 - ns = atoms%ntypsy(iAtom) + ns = sym%ntypsy(iAtom) flm = CMPLX(0.0,0.0) @@ -24,9 +25,9 @@ CONTAINS 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) @@ -34,24 +35,24 @@ CONTAINS 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,:) + 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) + SUBROUTINE lh_from_lm(sym,atoms, lathar, iType, flm, flh) USE m_types IMPLICIT NONE - + TYPE(t_sym),INTENT(IN) :: sym TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_sphhar), INTENT(IN) :: lathar INTEGER, INTENT(IN) :: iType @@ -66,17 +67,17 @@ CONTAINS EXTERNAL zgetrf, zgetrs iAtom = SUM(atoms%neq(:iType-1)) + 1 - ns = atoms%ntypsy(iAtom) + ns = sym%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) @@ -86,15 +87,15 @@ CONTAINS 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,:)) + flh(:,l*(l+1)+M)=REAL(fVec(M,:)) END DO - + DEALLOCATE (cMat,fVec,ipiv) END DO diff --git a/optional/flipcdn.f90 b/optional/flipcdn.f90 index 359dceb5..8e4b517c 100644 --- a/optional/flipcdn.f90 +++ b/optional/flipcdn.f90 @@ -36,9 +36,9 @@ SUBROUTINE flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,phi,theta, TYPE(t_stars),INTENT(IN) :: stars TYPE(t_vacuum),INTENT(IN) :: vacuum - TYPE(t_atoms),INTENT(IN) :: atoms + TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_sphhar),INTENT(IN) :: sphhar - TYPE(t_input),INTENT(INOUT) :: input + TYPE(t_input),INTENT(IN) :: input TYPE(t_sym),INTENT(IN) :: sym TYPE(t_noco),INTENT(IN) :: noco TYPE(t_oneD),INTENT(IN) :: oneD diff --git a/optional/plot.f90 b/optional/plot.f90 index f491bdd4..4850241e 100644 --- a/optional/plot.f90 +++ b/optional/plot.f90 @@ -10,16 +10,16 @@ MODULE m_plot !----------------------------------------------------------------------------- ! A general purpose plotting routine for FLEUR. - ! + ! ! Based on the older plotting routines pldngen.f90 and plotdop.f90 that were ! originally called by optional.F90 and are now used in the scf-loop instead. ! At the cost of reduced postprocess functionality, this allowed us to re- ! move I/O (using plot.hdf/text files) from the plotting routine completely. - ! + ! ! TODO: ! - plot_inp files are still in use and should be replaced by a plotting type. - ! - ! A. Neukirchen & R. Hilgers, September 2019 + ! + ! A. Neukirchen & R. Hilgers, September 2019 !------------------------------------------------ PUBLIC :: checkplotinp, vectorsplit, matrixsplit, savxsf, vectorplot, & @@ -31,16 +31,16 @@ CONTAINS !-------------------------------------------------------------------------- ! Checks for existing plot input. If an ancient plotin file is used, an - ! error is called. If no usable plot_inp exists, a new one is generated. + ! error is called. If no usable plot_inp exists, a new one is generated. !-------------------------------------------------------------------------- LOGICAL :: oldform,newform oldform=.FALSE. - INQUIRE(file="plotin",exist = oldform) + INQUIRE(file="plotin",exist = oldform) INQUIRE(file="plot_inp",exist = newform) - IF (oldform) THEN + IF (oldform) THEN CALL juDFT_error("Use of plotin file no longer supported", & calledby="plot") END IF @@ -58,19 +58,19 @@ CONTAINS WRITE(20,*) " grid(1)=30 grid(2)=30 grid(3)=30 " WRITE(20,*) " zero(1)=0.0 zero(2)=0.0 zero(3)=0.5 " WRITE(20,*) " filename ='plot2' /" - CLOSE(20) + CLOSE(20) END IF END SUBROUTINE checkplotinp - + SUBROUTINE vectorsplit(stars, atoms, sphhar, vacuum, input, factor, denmat, & cden,mden) !-------------------------------------------------------------------------- ! Takes a spin-polarized density vector and rearranges it into two plottable ! seperate ones, i.e. (rho_up, rho_down) ---> n, m. - ! - ! Can also be applied to a potential with an additional factor, i.e. while + ! + ! Can also be applied to a potential with an additional factor, i.e. while ! the densities n/m are defined as (rho_up+-rho_down), V_eff/B_eff are de- ! fined as (V_up+-V_down)/2. !-------------------------------------------------------------------------- @@ -85,7 +85,7 @@ CONTAINS REAL, INTENT(IN) :: factor TYPE(t_potden), INTENT(IN) :: denmat TYPE(t_potden), INTENT(OUT) :: cden, mden - + IF (factor==1.0) THEN CALL cden%init_potden_simple(stars%ng3,atoms%jmtd,sphhar%nlhd,& atoms%ntype,atoms%n_u,1,.FALSE.,.FALSE.,& @@ -105,7 +105,7 @@ CONTAINS POTDEN_TYPE_POTTOT,vacuum%nmzd,& vacuum%nmzxyd,stars%ng2) END IF - + cden%mt(:,0:,1:,1) = (denmat%mt(:,0:,1:,1)+denmat%mt(:,0:,1:,2))/factor cden%pw(1:,1) = (denmat%pw(1:,1)+denmat%pw(1:,2))/factor cden%vacz(1:,1:,1) = (denmat%vacz(1:,1:,1)+denmat%vacz(1:,1:,2))/factor @@ -118,29 +118,29 @@ CONTAINS END SUBROUTINE vectorsplit - SUBROUTINE matrixsplit(stars, atoms, sphhar, vacuum, input, noco, factor, & + SUBROUTINE matrixsplit(sym,stars, atoms, sphhar, vacuum, input, noco, factor, & denmat, cden, mxden, myden, mzden) USE m_fft2d USE m_fft3d - USE m_rotdenmat + USE m_rotdenmat !-------------------------------------------------------------------------- ! Takes a 2x2 density matrix and rearranges it into four plottable seperate ! ones, i.e. ((rho_11, rho_12),(rho_21, rho_22)) ---> n, mx, my, mz. - ! + ! ! This is an adaptation of the old pldngen.f90 by P. Kurz. - ! - ! Can also be applied to a potential with additional factors, i.e. while + ! + ! Can also be applied to a potential with additional factors, i.e. while ! the densities n/m are defined as (rho_up+-rho_down), V_eff/B_eff are de- ! fined as (V_up+-V_down)/2 and while rho_21 is of the form a-i*b, for the ! potential we have a+i*b. - ! + ! ! TODO: Find out, whether the latter form of rho is still valid. Having the ! additive rho_21=m_x+i*m_y would be nicer and more convenient/consistent. !-------------------------------------------------------------------------- IMPLICIT NONE - + TYPE(t_sym), INTENT(IN) :: sym TYPE(t_stars), INTENT(IN) :: stars TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_sphhar), INTENT(IN) :: sphhar @@ -150,7 +150,7 @@ CONTAINS REAL, INTENT(IN) :: factor TYPE(t_potden), INTENT(IN) :: denmat TYPE(t_potden), INTENT(OUT) :: cden, mxden, myden, mzden - + ! Local scalars: iteration indices, matrix elements etc. INTEGER iden, ivac, ifft2, ifft3, imz, ityp, iri, ilh, imesh REAL cdnup, cdndown, chden, mgden, theta, phi, rhotot, mx, my, mz @@ -175,7 +175,7 @@ CONTAINS cdom(stars%ng3), fftwork(0:27*stars%mx1*stars%mx2*stars%mx3-1), & ris(0:27*stars%mx1*stars%mx2*stars%mx3-1,4), & rvacxy(0:9*stars%mx1*stars%mx2-1,vacuum%nmzxyd,2,4)) - + rho(:,:,:,:) = zero; qpw(:,:) = czero; cdom(:) = czero IF (input%film) THEN @@ -193,14 +193,14 @@ CONTAINS cdomvz(:,:) = CMPLX(denmat%vacz(:,:,3),denmat%vacz(:,:,4)) cdomvxy = denmat%vacxy(:,:,:,3) END IF - + ! Calculate the charge and magnetization densities in the muffin tins. DO ityp = 1,atoms%ntype theta = noco%beta(ityp) phi = noco%alph(ityp) - DO ilh = 0,sphhar%nlh(atoms%ntypsy(ityp)) + DO ilh = 0,sphhar%nlh(sym%ntypsy(ityp)) DO iri = 1,atoms%jri(ityp) - IF (SIZE(denmat%mt,4).LE.2) THEN + IF (SIZE(denmat%mt,4).LE.2) THEN cdnup = rho(iri,ilh,ityp,1) cdndown = rho(iri,ilh,ityp,2) @@ -210,7 +210,7 @@ CONTAINS rho(iri,ilh,ityp,2) = mgden*COS(phi)*SIN(theta) rho(iri,ilh,ityp,3) = mgden*SIN(phi)*SIN(theta) rho(iri,ilh,ityp,4) = mgden*COS(theta) - ELSE + ELSE cdn11 = rho(iri,ilh,ityp,1) cdn22 = rho(iri,ilh,ityp,2) cdn21 = CMPLX(denmat%mt(iri,ilh,ityp,3), & @@ -221,10 +221,10 @@ CONTAINS rho(iri,ilh,ityp,1) = cdn11 + cdn22 rho(iri,ilh,ityp,2) = 2.0*REAL(cdn21) - !! Note: The minus sign in the following line is temporary to + !! Note: The minus sign in the following line is temporary to !! adjust for differences in the offdiagonal part of the !! density between this FLEUR version and ancient v0.26 . - !! + !! !! TODO: Should that still be here? It effectively amounts to a !! conjugation of the density matrix. rho(iri,ilh,ityp,3) = -2.0*AIMAG(cdn21) @@ -319,7 +319,7 @@ CONTAINS mx = 2*rho_21r my = -2*rho_21i mz = (rho_11-rho_22) - + rht(imz,ivac,1) = rhotot rht(imz,ivac,2) = mx rht(imz,ivac,3) = my @@ -338,7 +338,7 @@ CONTAINS END DO END DO END IF - + ! Initialize and save the four output densities. @@ -374,7 +374,7 @@ CONTAINS myden%pw(1:,1) = qpw(1:,3) myden%vacz(1:,1:,1) = rht(1:,1:,3) myden%vacxy(1:,1:,1:,1) = rhtxy(1:,1:,1:,3) - + mzden%mt(:,0:,1:,1) = rho(:,0:,1:,4) mzden%pw(1:,1) = qpw(1:,4) mzden%vacz(1:,1:,1) = rht(1:,1:,4) @@ -400,15 +400,15 @@ CONTAINS ! Correction for the case of plotting the total potential. ! Needed due to the different definitons of density/potential matrices in ! FLEUR: - ! + ! ! rhoMat = 0.5*((n +m_z,m_x+i*m_y),(m_x-i*m_y,n -m_z)) ! vMat = ((V_eff+B_z,B_x-i*B_y),(B_x+i*m_y,V_eff-B_z)) - + rho(:,0:,1:,:) = rho(:,0:,1:,:)/2.0 qpw(1:,:) = qpw(1:,:)/2.0 rht(1:,1:,:) = rht(1:,1:,:)/2.0 rhtxy(1:,1:,1:,:) = rhtxy(1:,1:,1:,:)/2.0 - + rho(:,0:,1:,3) = -rho(:,0:,1:,3) qpw(1:,3) = -qpw(1:,3) rht(1:,1:,3) = -rht(1:,1:,3) @@ -428,12 +428,12 @@ CONTAINS myden%pw(1:,1) = qpw(1:,3) myden%vacz(1:,1:,1) = rht(1:,1:,3) myden%vacxy(1:,1:,1:,1) = rhtxy(1:,1:,1:,3) - + mzden%mt(:,0:,1:,1) = rho(:,0:,1:,4) mzden%pw(1:,1) = qpw(1:,4) mzden%vacz(1:,1:,1) = rht(1:,1:,4) mzden%vacxy(1:,1:,1:,1) = rhtxy(1:,1:,1:,4) - + END IF DEALLOCATE (rho, qpw, rht, rhtxy, cdomvz, cdomvxy, & @@ -448,20 +448,20 @@ CONTAINS ! Takes one/several t_potden variable(s), i.e. scalar fields in MT-sphere/ ! plane wave representation and makes it/them into plottable .xsf file(s) - ! according to a scheme given in plot_inp. - ! + ! according to a scheme given in plot_inp. + ! ! This is an adaptation of the old plotdop.f90 by P. Kurz. - ! + ! ! Naming convention: ! The output .xsf files will have names composed of the plotted density ! (c.f. identifier) and an optional tag. For a scalar density, only said - ! density is plotted. For a spin-polarized density with an up and down + ! density is plotted. For a spin-polarized density with an up and down ! component, f denotes the sum of both densities and g denotes their ! difference u-d possibly with additional modifying factors as explained ! above in vector-/matrixsplit. f and g are to be understood as scalar - ! fields f(r_vec) and g(r_vec). For a density matrix, f is still the + ! fields f(r_vec) and g(r_vec). For a density matrix, f is still the ! scalar part. Aditionally, three vector components A_[1-3] arise. - ! + ! ! E.g.: scalar density rho (n(r_vec)) ! ---> rho.xsf (n(r_vec)) ! spin-polarized density rho (n_up(r_vec),n_down(r_vec)) @@ -532,7 +532,7 @@ CONTAINS END IF DO i = 1, numInDen - + ! TODO: Does this work as intended? IF ((numInDen.NE.4).AND.(score)) THEN OPEN (17,file='cdnc',form='unformatted',status='old') @@ -555,9 +555,9 @@ CONTAINS END IF END DO - IF (noco%l_ss) THEN - qssc = MATMUL(TRANSPOSE(cell%bmat),noco%qss) - END IF + IF (noco%l_ss) THEN + qssc = MATMUL(TRANSPOSE(cell%bmat),noco%qss) + END IF ! Open the plot_inp file for input OPEN (18,file='plot_inp') @@ -635,7 +635,7 @@ CONTAINS ELSE OPEN (nfile,file = TRIM(ADJUSTL(denName))//'_'//filename,form='formatted') END IF - + IF (twodim) THEN IF (numOutFiles.EQ.1) THEN WRITE(nfile,'(3a15)') 'x','y','f' @@ -643,7 +643,7 @@ CONTAINS WRITE(nfile,'(4a15)') 'x','y','f','g' ELSE IF (numOutFiles.EQ.4) THEN WRITE(nfile,'(6a15)') 'x','y','f','A1','A2','A3' - ELSE + ELSE WRITE(nfile,'(9a15)') 'x','y','f','A1','A2','A3','|A|','theta','phi' END IF ELSE @@ -653,7 +653,7 @@ CONTAINS WRITE(nfile,'(5a15)') 'x','y','z','f','g' ELSE IF (numOutFiles.EQ.4) THEN WRITE(nfile,'(7a15)') 'x','y','z','f','A1','A2','A3' - ELSE + ELSE WRITE(nfile,'(10a15)') 'x','y','z','f','A1','A2','A3','|A|','theta','phi' END IF END IF @@ -668,7 +668,7 @@ CONTAINS IF (.NOT.twodim) point = point + vec3*REAL(iz)/(grid(3)-1) ! Set region specific parameters for point - + ! Get MT sphere for point if point is in MT sphere CALL getMTSphere(input,cell,atoms,oneD,point,nt,na,pt) IF (na.NE.0) THEN @@ -693,20 +693,20 @@ CONTAINS END IF DO i = 1, numInDen - CALL outcdn(pt,nt,na,iv,iflag,1,potnorm,stars,& + CALL outcdn(pt,nt,na,iv,iflag,1,potnorm,stars,& vacuum,sphhar,atoms,sym,cell,oneD,& den(i),xdnout(i)) END DO IF (na.NE.0) THEN - IF (noco%l_ss) THEN + IF (noco%l_ss) THEN ! rotate magnetization "backward" angss = DOT_PRODUCT(qssc,pt-atoms%pos(:,na)) help(1) = xdnout(2) help(2) = xdnout(3) - xdnout(2) = +help(1)*COS(angss)+help(2)*SIN(angss) - xdnout(3) = -help(1)*SIN(angss)+help(2)*COS(angss) - ! xdnout(2)=0. ; xdnout(3)=0. ; xdnout(4)=0. + xdnout(2) = +help(1)*COS(angss)+help(2)*SIN(angss) + xdnout(3) = -help(1)*SIN(angss)+help(2)*COS(angss) + ! xdnout(2)=0. ; xdnout(3)=0. ; xdnout(4)=0. END IF END IF @@ -727,7 +727,7 @@ CONTAINS xdnout(7)= -tpi_const ELSE DO j = 1, 3 - help(j) = xdnout(1+j)/xdnout(5) + help(j) = xdnout(1+j)/xdnout(5) END DO IF (help(3)<0.5) THEN xdnout(6)= ACOS(help(3)) @@ -787,8 +787,8 @@ CONTAINS CLOSE(nfile) END IF - END DO !nplot - + END DO !nplot + CLOSE(18) IF (xsf) THEN DO i = 1, numOutFiles @@ -808,7 +808,7 @@ CONTAINS ! then passed on to the savxsf routine to get 2 .xsf files out. IMPLICIT NONE - + TYPE(t_stars), INTENT(IN) :: stars TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_sphhar), INTENT(IN) :: sphhar @@ -858,7 +858,7 @@ CONTAINS TYPE(t_potden) :: cden, mxden, myden, mzden - CALL matrixsplit(stars, atoms, sphhar, vacuum, input, noco, factor, & + CALL matrixsplit(sym,stars, atoms, sphhar, vacuum, input, noco, factor, & denmat, cden, mxden, myden, mzden) CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, & @@ -867,12 +867,12 @@ CONTAINS END SUBROUTINE matrixplot SUBROUTINE procplot(stars, atoms, sphhar, sliceplot,vacuum, input, oneD, sym, cell, & - noco, denmat, plot_const) - - ! According to iplot, we process which exact plots we make after we assured - ! that we do any. n-th digit (from the back) of iplot ==1 --> plot with - ! identifier n is done. - + noco, denmat, plot_const) + + ! According to iplot, we process which exact plots we make after we assured + ! that we do any. n-th digit (from the back) of iplot ==1 --> plot with + ! identifier n is done. + IMPLICIT NONE TYPE(t_stars), INTENT(IN) :: stars @@ -893,7 +893,7 @@ CONTAINS CHARACTER (len=20) :: denName LOGICAL :: score, potnorm - ! Plotting the input density matrix as n / n, m / n, mx, my, mz. + ! Plotting the input density matrix as n / n, m / n, mx, my, mz. ! Plot identifier: PLOT_INPDEN = 1 ! Additive term for iplot: 2 IF (plot_const.EQ.1) THEN @@ -918,7 +918,7 @@ CONTAINS END IF END IF - ! Plotting the output density matrix as n / n, m / n, mx, my, mz. + ! Plotting the output density matrix as n / n, m / n, mx, my, mz. ! Plot identifier: PLOT_OUTDEN_Y_CORE = 2 ! No core subtraction done! ! Additive term for iplot: 4 @@ -940,10 +940,10 @@ CONTAINS ELSE CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, & noco, score, potnorm, denName, denmat) - END IF + END IF END IF - ! Plotting the output density matrix as n / n, m / n, mx, my, mz. + ! Plotting the output density matrix as n / n, m / n, mx, my, mz. ! Plot identifier: PLOT_OUTDEN_N_CORE = 3 ! Core subtraction done! ! Additive term for iplot: 8 @@ -965,10 +965,10 @@ CONTAINS ELSE CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, & noco, score, potnorm, denName, denmat) - END IF + END IF END IF - ! Plotting the mixed density matrix as n / n, m / n, mx, my, mz. + ! Plotting the mixed density matrix as n / n, m / n, mx, my, mz. ! Plot identifier: PLOT_MIXDEN_Y_CORE = 4 ! No core subtraction done! ! Additive term for iplot: 16 @@ -990,10 +990,10 @@ CONTAINS ELSE CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, & noco, score, potnorm, denName, denmat) - END IF + END IF END IF - ! Plotting the mixed density matrix as n / n, m / n, mx, my, mz. + ! Plotting the mixed density matrix as n / n, m / n, mx, my, mz. ! Plot identifier: PLOT_MIXDEN_N_CORE = 5 ! Core subtraction done! ! Additive term for iplot: 32 @@ -1015,11 +1015,11 @@ CONTAINS ELSE CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, & noco, score, potnorm, denName, denmat) - END IF + END IF END IF - - ! Plotting the total potential as vTot / v_eff, B_eff / v_eff, + + ! Plotting the total potential as vTot / v_eff, B_eff / v_eff, ! B_xc_1, B_xc_2, B_xc_3. ! Plot identifier: PLOT_POT_TOT = 7 ! No core subtraction done! @@ -1042,16 +1042,16 @@ CONTAINS ELSE CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, & noco, score, potnorm, denName, denmat) - END IF + END IF END IF END SUBROUTINE procplot SUBROUTINE makeplots(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, & - noco, denmat, plot_const, sliceplot) - + noco, denmat, plot_const, sliceplot) + ! Checks, based on the iplot switch that is given in the input, whether or - ! not plots should be made. Before the plot command is processed, we check + ! not plots should be made. Before the plot command is processed, we check ! whether the plot_inp is there and no oldform is given. If that is not the ! case, we throw an error/create a plot_inp. @@ -1072,22 +1072,22 @@ CONTAINS TYPE(t_sliceplot), INTENT(IN) :: sliceplot LOGICAL :: allowplot - + ! The check is done via bitwise operations. If the i-th position of iplot ! in binary representation (2^n == n-th position) has a 1, the correspon- ! ding plot with number 2^n is plotted. - ! - ! E.g.: If the plots with identifying constants 1,2 and 4 are to be plotted + ! + ! E.g.: If the plots with identifying constants 1,2 and 4 are to be plotted ! and none else, iplot would need to be 2^1 + 2^2 + 2^3 = 2 + 4 + 8 = 14. ! iplot=1 or any odd number will *always* plot all possible options. - - CALL timestart("Plotting iplot plots") + + CALL timestart("Plotting iplot plots") allowplot=BTEST(sliceplot%iplot,plot_const).OR.(MODULO(sliceplot%iplot,2).EQ.1) - IF (allowplot) THEN + IF (allowplot) THEN CALL checkplotinp() CALL procplot(stars, atoms, sphhar,sliceplot, vacuum, input, oneD, sym, cell, & - noco, denmat, plot_const) + noco, denmat, plot_const) END IF CALL timestop("Plotting iplot plots") END SUBROUTINE makeplots @@ -1142,7 +1142,7 @@ CONTAINS iType = 0 iAtom = 0 pt(:) = point(:) - + END SUBROUTINE getMTSphere END MODULE m_plot diff --git a/rdmft/rdmft.F90 b/rdmft/rdmft.F90 index eaeaffc0..65dd8fa9 100644 --- a/rdmft/rdmft.F90 +++ b/rdmft/rdmft.F90 @@ -269,7 +269,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars vmdSSDen(:,:,:) = 0.0 CALL regCharges%init(input,atoms) - CALL dos%init(input%neig,input,atoms,kpts,vacuum) + CALL dos%init(input,atoms,kpts,vacuum) CALL moments%init(mpi,input,sphhar,atoms) CALL overallDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN) CALL overallVCoul%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_POTCOUL) @@ -385,7 +385,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars CALL mixedbasis(atoms,kpts,input,cell,xcpot,mpbasis,hybrid,enpara,mpi,vTot, iterHF) - CALL open_hybrid_io2(mpbasis, hybrid,atoms,sym%invs) + CALL open_hybrid_io2(mpbasis, hybrid,input,atoms,sym%invs) CALL coulombmatrix(mpi,atoms,kpts,cell,sym,mpbasis,hybrid,xcpot) @@ -510,7 +510,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars results%neig(:,:) = neigTemp(:,:) - CALL HF_setup(mpbasis,hybrid,input,sym,kpts,dimension,atoms,mpi,noco,& + CALL HF_setup(mpbasis,hybrid,input,sym,kpts,atoms,mpi,noco,& cell,oneD,results,jspin,enpara,eig_id,& hybdat,sym%invs,vTot%mt(:,0,:,:),eig_irr) @@ -524,14 +524,14 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars parent = 0 CALL symm_hf_init(sym,kpts,ikpt,nsymop,rrot,psym) - CALL symm_hf(kpts,ikpt,sym,hybdat,eig_irr,atoms,mpbasis,hybrid,cell,lapw,jspin,& + CALL symm_hf(kpts,ikpt,sym,hybdat,eig_irr,input,atoms,mpbasis,hybrid,cell,lapw,jspin,& rrot,nsymop,psym,nkpt_EIBZ,n_q,parent,pointer_EIBZ,nsest,indx_sest) exMat%l_real=sym%invs - CALL exchange_valence_hf(ikpt,kpts,nkpt_EIBZ, sym,atoms,mpbasis,hybrid,cell,dimension,input,jspin,hybdat,mnobd,lapw,& + CALL exchange_valence_hf(ikpt,kpts,nkpt_EIBZ, sym,atoms,mpbasis,hybrid,cell,input,jspin,hybdat,mnobd,lapw,& eig_irr,results,pointer_EIBZ,n_q,wl_iks,xcpot,noco,nsest,indx_sest,& mpi,exMat) - CALL exchange_vccv1(ikpt,atoms,mpbasis,hybrid,hybdat,dimension,jspin,lapw,nsymop,nsest,indx_sest,mpi,1.0,results,exMat) + CALL exchange_vccv1(ikpt,input,atoms,mpbasis,hybrid,hybdat,jspin,lapw,nsymop,nsest,indx_sest,mpi,1.0,results,exMat) !Start of workaround for increased functionality of symmetrizeh (call it)) diff --git a/types/CMakeLists.txt b/types/CMakeLists.txt index 1cd0787c..c4bb66fe 100644 --- a/types/CMakeLists.txt +++ b/types/CMakeLists.txt @@ -25,8 +25,8 @@ types/types_dos.f90 types/types_denCoeffsOffdiag.f90 types/types_force.f90 types/types_gpumat.F90 -types/types_hybrid.f90 types/types_mpbasis.f90 +types/types_hybdat.f90 ) set(inpgen_F90 ${inpgen_F90} @@ -52,6 +52,5 @@ types/types_regionCharges.f90 types/types_dos.f90 types/types_denCoeffsOffdiag.f90 types/types_force.f90 -types/types_hybrid.f90 types/types_mpbasis.f90 ) diff --git a/types/types_dos.f90 b/types/types_dos.f90 index dc3ed080..9f0edd92 100644 --- a/types/types_dos.f90 +++ b/types/types_dos.f90 @@ -19,30 +19,29 @@ MODULE m_types_dos CONTAINS PROCEDURE,PASS :: init => dos_init END TYPE t_dos - + CONTAINS -SUBROUTINE dos_init(thisDOS,neigd,input,atoms,kpts,vacuum) +SUBROUTINE dos_init(thisDOS,input,atoms,kpts,vacuum) USE m_types_input USE m_types_atoms USE m_types_vacuum USE m_types_kpts IMPLICIT NONE CLASS(t_dos), INTENT(INOUT) :: thisDOS - INTEGER , INTENT(IN) :: neigd TYPE(t_input), INTENT(IN) :: input TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_kpts), INTENT(IN) :: kpts TYPE(t_vacuum), INTENT(IN) :: vacuum - - ALLOCATE(thisDOS%jsym(neigd,kpts%nkpt,input%jspins)) - ALLOCATE(thisDOS%ksym(neigd,kpts%nkpt,input%jspins)) - ALLOCATE(thisDOS%qis(neigd,kpts%nkpt,input%jspins)) - ALLOCATE(thisDOS%qal(0:3,atoms%ntype,neigd,kpts%nkpt,input%jspins)) - ALLOCATE(thisDOS%qvac(neigd,2,kpts%nkpt,input%jspins)) - ALLOCATE(thisDOS%qvlay(neigd,vacuum%layerd,2,kpts%nkpt,input%jspins)) - ALLOCATE(thisDOS%qstars(vacuum%nstars,neigd,vacuum%layerd,2,kpts%nkpt,input%jspins)) - + + ALLOCATE(thisDOS%jsym(input%neig,kpts%nkpt,input%jspins)) + ALLOCATE(thisDOS%ksym(input%neig,kpts%nkpt,input%jspins)) + ALLOCATE(thisDOS%qis(input%neig,kpts%nkpt,input%jspins)) + ALLOCATE(thisDOS%qal(0:3,atoms%ntype,input%neig,kpts%nkpt,input%jspins)) + ALLOCATE(thisDOS%qvac(input%neig,2,kpts%nkpt,input%jspins)) + ALLOCATE(thisDOS%qvlay(input%neig,vacuum%layerd,2,kpts%nkpt,input%jspins)) + ALLOCATE(thisDOS%qstars(vacuum%nstars,input%neig,vacuum%layerd,2,kpts%nkpt,input%jspins)) + thisDOS%jsym = 0 thisDOS%ksym = 0 thisDOS%qis = 0.0 @@ -50,7 +49,7 @@ SUBROUTINE dos_init(thisDOS,neigd,input,atoms,kpts,vacuum) thisDOS%qvac = 0.0 thisDOS%qvlay = 0.0 thisDOS%qstars = CMPLX(0.0,0.0) - + END SUBROUTINE dos_init END MODULE m_types_dos diff --git a/types/types_forcetheo.F90 b/types/types_forcetheo.F90 index ad4f70c4..d8e1d995 100644 --- a/types/types_forcetheo.F90 +++ b/types/types_forcetheo.F90 @@ -30,7 +30,7 @@ MODULE m_types_forcetheo LOGICAL :: l_IO CONTAINS PROCEDURE :: start =>forcetheo_start - PROCEDURE :: next_job=>forcetheo_next_job + PROCEDURE :: next_job=>forcetheo_next_job PROCEDURE :: eval =>forcetheo_eval PROCEDURE :: postprocess => forcetheo_postprocess END TYPE t_forcetheo @@ -66,20 +66,19 @@ CONTAINS USE m_types_input USE m_types_noco USE m_types_sym - USE m_types_cell + USE m_types_cell USE m_types_mpi USE m_types_potden USE m_types_misc USE m_types_kpts USE m_types_enpara - use m_types_dimension - + IMPLICIT NONE CLASS(t_forcetheo),INTENT(INOUT):: this LOGICAL :: skip !Stuff that might be used... TYPE(t_mpi),INTENT(IN) :: mpi - + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco @@ -99,6 +98,5 @@ CONTAINS CLASS(t_forcetheo),INTENT(INOUT):: this END SUBROUTINE forcetheo_postprocess - -END MODULE m_types_forcetheo +END MODULE m_types_forcetheo diff --git a/types/types_hybrid.f90 b/types/types_hybrid.f90 index 6863516b..eba5286a 100644 --- a/types/types_hybrid.f90 +++ b/types/types_hybrid.f90 @@ -1,34 +1,7 @@ MODULE m_types_hybrid IMPLICIT NONE - TYPE t_hybrid - LOGICAL :: l_hybrid = .false. - LOGICAL :: l_subvxc = .false. - LOGICAL :: l_calhf = .false. - LOGICAL :: l_addhf = .false. - INTEGER :: ewaldlambda - INTEGER :: lexp = 0 - INTEGER :: bands1 !Only read in - INTEGER :: nbasp - INTEGER :: maxbasm1 - INTEGER :: max_indx_p_1 - INTEGER :: maxlmindx - INTEGER, ALLOCATABLE :: select1(:,:) - INTEGER, ALLOCATABLE :: lcutm1(:) - INTEGER, ALLOCATABLE :: lcutwf(:) - INTEGER, ALLOCATABLE :: map(:,:) - INTEGER, ALLOCATABLE :: tvec(:,:,:) - INTEGER, ALLOCATABLE :: nbasm(:) - !REAL, ALLOCATABLE :: radbasfn_mt(:,:,:,:) - COMPLEX, ALLOCATABLE :: d_wgn2(:,:,:,:) - INTEGER, ALLOCATABLE :: ne_eig(:) - INTEGER, ALLOCATABLE :: nbands(:) - INTEGER, ALLOCATABLE :: nobd(:,:) - REAL, ALLOCATABLE :: div_vv(:,:,:) - CONTAINS - procedure :: write_hybrid - generic :: write(unformatted) => write_hybrid - END TYPE t_hybrid + TYPE t_hybdat INTEGER :: lmaxcd, maxindxc @@ -54,7 +27,8 @@ MODULE m_types_hybrid contains subroutine set_stepfunction(hybdat, cell, atoms, g, svol) - use m_types_setup + use m_types_cell + use m_types_atoms use m_judft implicit none class(t_hybdat),INTENT(INOUT) :: hybdat @@ -85,7 +59,8 @@ contains !private subroutine FUNCTION stepfunction(cell, atoms, g) - USE m_types_setup + USE m_types_cell + USE m_types_atoms USE m_constants IMPLICIT NONE @@ -128,16 +103,5 @@ contains gptnorm = norm2(matmul(gpt(:), bmat(:,:))) END FUNCTION gptnorm - subroutine write_hybrid(hybrid, unit, iostat, iomsg) - implicit NONE - class(t_hybrid), intent(in) :: hybrid - integer, intent(in) :: unit ! Internal unit to write to. - integer, intent(out) :: iostat ! non zero on error, etc. - character(*), intent(inout) :: iomsg ! define if iostat non zero. - - write(unit, iostat=iostat, iomsg=iomsg) hybrid%maxbasm1, hybrid%maxlmindx - - write(unit, iostat=iostat, iomsg=iomsg) shape(hybrid%lcutm1) - write(unit, iostat=iostat, iomsg=iomsg) hybrid%lcutm1 - end subroutine write_hybrid + END MODULE m_types_hybrid diff --git a/types/types_misc.F90 b/types/types_misc.F90 index 12dc4e54..38d8d996 100644 --- a/types/types_misc.F90 +++ b/types/types_misc.F90 @@ -95,7 +95,6 @@ CONTAINS USE m_types_atoms USE m_types_input USE m_types_noco - USE m_types_dimension USE m_types_kpts USE m_types_lapw IMPLICIT NONE diff --git a/types/types_setup.F90 b/types/types_setup.F90 index f22cf6ce..190c614e 100644 --- a/types/types_setup.F90 +++ b/types/types_setup.F90 @@ -11,5 +11,4 @@ MODULE m_types_setup use m_types_fleurinput USE m_types_stars USE m_types_sphhar - USE m_types_dimension END MODULE m_types_setup diff --git a/vgen/divergence.f90 b/vgen/divergence.f90 index 2327404a..ef80d9c7 100644 --- a/vgen/divergence.f90 +++ b/vgen/divergence.f90 @@ -172,7 +172,7 @@ CONTAINS DO i=1,3 DO iType=1, atoms%ntype - CALL lh_to_lm(atoms, sphhar, iType, bxc(i)%mt(:,:,iType,1), flm(:,:,iType)) + CALL lh_to_lm(sym,atoms, sphhar, iType, bxc(i)%mt(:,:,iType,1), flm(:,:,iType)) END DO IF (i==1) THEN CALL gradYlm(atoms,flm,grsflm1) @@ -188,7 +188,7 @@ CONTAINS CALL divYlm(grsflm1(:,:,:,:),grsflm2(:,:,:,:),grsflm3(:,:,:,:), divflm) DO iType=1, atoms%ntype - CALL lh_from_lm(atoms, sphhar, iType, divflm(:,1:indmax,iType), div%mt(:,0:,iType,1)) + CALL lh_from_lm(sym,atoms, sphhar, iType, divflm(:,1:indmax,iType), div%mt(:,0:,iType,1)) END DO DEALLOCATE(divflm,grsflm1,grsflm2,grsflm3) @@ -231,7 +231,7 @@ CONTAINS INTEGER :: i, jr, k, nsp, kt, lh, lhmax nsp = atoms%nsp() - lhmax=sphhar%nlh(atoms%ntypsy(SUM(atoms%neq(:n - 1)) + 1)) + lhmax=sphhar%nlh(sym%ntypsy(SUM(atoms%neq(:n - 1)) + 1)) eps=1.e-10 ALLOCATE (grad%gr(3,atoms%jri(n)*nsp,1)) @@ -246,7 +246,7 @@ CONTAINS CALL init_mt_grid(1, atoms, sphhar, .TRUE., sym, thet, phi) - CALL mt_to_grid(.TRUE., 1, atoms, sphhar, denloc%mt(:,0:,n,:), n, noco, grad) + CALL mt_to_grid(.TRUE., 1, atoms, sym,sphhar, denloc%mt(:,0:,n,:), n, noco, grad) kt = 0 DO jr = 1, atoms%jri(n) @@ -262,7 +262,7 @@ CONTAINS ENDDO ! jr DO i=1,3 - CALL mt_from_grid(atoms, sphhar, n, 1, grad_temp(:,:,i), gradphi(i)%mt(:,0:,n,:)) + CALL mt_from_grid(atoms, sym,sphhar, n, 1, grad_temp(:,:,i), gradphi(i)%mt(:,0:,n,:)) DO lh=0, lhmax gradphi(i)%mt(:,lh,n,1) = gradphi(i)%mt(:,lh,n,1)*atoms%rmsh(:, n)**2 !IF ((sphhar%llh(lh,1)/=0).AND.(sphhar%llh(lh,1)/=2)) THEN @@ -388,11 +388,11 @@ CONTAINS denloc=pot DO iType=1,atoms%ntype - lhmax=sphhar%nlh(atoms%ntypsy(SUM(atoms%neq(:iType - 1)) + 1)) + lhmax=sphhar%nlh(sym%ntypsy(SUM(atoms%neq(:iType - 1)) + 1)) DO lh=0, lhmax denloc%mt(:,lh,iType,1) = denloc%mt(:,lh,iType,1)*atoms%rmsh(:, iType)**2 END DO ! lh - CALL lh_to_lm(atoms, sphhar, iType, denloc%mt(:,:,iType,1), flm(:,:,iType)) + CALL lh_to_lm(sym,atoms, sphhar, iType, denloc%mt(:,:,iType,1), flm(:,:,iType)) END DO CALL gradYlm(atoms,flm,grsflm) @@ -401,7 +401,7 @@ CONTAINS DO i=1,3 DO iType=1,atoms%ntype - CALL lh_from_lm(atoms, sphhar, iType, grsflm(:,1:indmax,iType,i)/(4.0*pi_const), grad(i)%mt(:,0:,iType,1)) + CALL lh_from_lm(sym,atoms, sphhar, iType, grsflm(:,1:indmax,iType,i)/(4.0*pi_const), grad(i)%mt(:,0:,iType,1)) END DO END DO diff --git a/vgen/sfTests.f90 b/vgen/sfTests.f90 index a4b4fc86..8ab8860c 100644 --- a/vgen/sfTests.f90 +++ b/vgen/sfTests.f90 @@ -1,7 +1,8 @@ MODULE m_sfTests + IMPLICIT NONE CONTAINS SUBROUTINE plotBtest(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, & - noco, xcB, div, phi, cvec, corrB, div2) + noco, xcB, div, phi, cvec, corrB, div2) USE m_plot IMPLICIT NONE @@ -21,7 +22,7 @@ CONTAINS LOGICAL :: xsf CALL checkplotinp() - + CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, & .FALSE., .FALSE., 'bInitial ', xcB(1), xcB(1), xcB(2), xcB(3)) @@ -41,7 +42,7 @@ CONTAINS .FALSE., .FALSE., 'divCorrected ', div2) INQUIRE(file="bInitial_f.xsf",exist=xsf) - + IF (xsf) THEN OPEN (120, FILE='bInitial_f.xsf', STATUS='OLD') CLOSE (120, STATUS="DELETE") @@ -49,8 +50,8 @@ CONTAINS CLOSE (120, STATUS="DELETE") OPEN (120, FILE='bCorrected_f.xsf', STATUS='OLD') CLOSE (120, STATUS="DELETE") - END IF - + END IF + END SUBROUTINE plotBtest SUBROUTINE buildAtest(stars,atoms,sphhar,vacuum,input,noco,sym,cell,itest,Avec,icut,denMat,factor) @@ -84,12 +85,12 @@ CONTAINS icut=1 - IF (itest.EQ.0) THEN + IF (itest.EQ.0) THEN RETURN END IF - - IF (PRESENT(denMat)) THEN - CALL makeVectorField(stars,atoms,sphhar,vacuum,input,noco,denMat,factor,Avec,icut) + + IF (PRESENT(denMat)) THEN + CALL makeVectorField(sym,stars,atoms,sphhar,vacuum,input,noco,denMat,factor,Avec,icut) RETURN END IF @@ -105,7 +106,7 @@ CONTAINS ! Temporary. Avec(i)%pw = 0 Avec(i)%pw_w = CMPLX(0.0,0.0) - Avec(i)%vacxy = 0 + Avec(i)%vacxy = 0 Avec(i)%vacz = 0 END DO @@ -142,9 +143,9 @@ CONTAINS kt = kt + nsp END DO ! ir - CALL mt_from_grid(atoms, sphhar, n, 1, A_temp(:,1,:), Avec(1)%mt(:,0:,n,:)) - CALL mt_from_grid(atoms, sphhar, n, 1, A_temp(:,2,:), Avec(2)%mt(:,0:,n,:)) - CALL mt_from_grid(atoms, sphhar, n, 1, A_temp(:,3,:), Avec(3)%mt(:,0:,n,:)) + CALL mt_from_grid(atoms,sym, sphhar, n, 1, A_temp(:,1,:), Avec(1)%mt(:,0:,n,:)) + CALL mt_from_grid(atoms,sym, sphhar, n, 1, A_temp(:,2,:), Avec(2)%mt(:,0:,n,:)) + CALL mt_from_grid(atoms,sym, sphhar, n, 1, A_temp(:,3,:), Avec(3)%mt(:,0:,n,:)) !print *, 'A_z*r^2 3rd entry before fromto grid' !print *, A_temp(3,3,1) @@ -159,7 +160,7 @@ CONTAINS ! ENDDO ! k ! kt = kt + nsp !END DO ! ir - + !print *, 'A_z*r^2 3rd entry after fromto grid' !print *, A_temp(3,3,1) DEALLOCATE (A_temp) @@ -184,7 +185,7 @@ CONTAINS point = zero + vec1*REAL(i)/(grid(1)-1) +& vec2*REAL(j)/(grid(2)-1) +& vec3*REAL(k)/(grid(3)-1) - + ind = k*grid(2)*grid(1) + j*grid(1) + i + 1 A_temp(ind,1,1)=SIN(i*2*pi_const/grid(1)) @@ -206,14 +207,12 @@ CONTAINS END SUBROUTINE buildAtest - SUBROUTINE sftest(mpi,dimension,field,stars,atoms,sphhar,vacuum,input,oneD,sym,cell,noco,itest,denMat,factor) + SUBROUTINE sftest(mpi,field,stars,atoms,sphhar,vacuum,input,oneD,sym,cell,noco,itest,denMat,factor) USE m_xcBfield USE m_divergence USE m_analysistests - - TYPE(t_mpi), INTENT(IN) :: mpi - TYPE(t_dimension), INTENT(IN) :: dimension TYPE(t_field), INTENT(INOUT) :: field + TYPE(t_mpi), INTENT(IN) :: mpi TYPE(t_stars), INTENT(IN) :: stars TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_sphhar), INTENT(IN) :: sphhar @@ -226,7 +225,7 @@ CONTAINS INTEGER, INTENT(IN) :: itest TYPE(t_potden), OPTIONAL, INTENT(IN) :: denMat REAL, OPTIONAL, INTENT(IN) :: factor - + TYPE(t_potden), DIMENSION(3) :: aVec, cvec, corrB TYPE(t_potden) :: div, phi, checkdiv INTEGER :: i, n, lh, l, icut(3,0:sphhar%nlhd,atoms%ntype) @@ -244,14 +243,14 @@ CONTAINS IF (PRESENT(denMat)) THEN CALL buildAtest(stars,atoms,sphhar,vacuum,input,noco,sym,cell,1,aVec,icut,denMat,factor) - CALL sourcefree(mpi,dimension,field,stars,atoms,sphhar,vacuum,input,oneD,sym,cell,noco,aVec,icut,div,phi,cvec,corrB,checkdiv) + CALL sourcefree(mpi,field,stars,atoms,sphhar,vacuum,input,oneD,sym,cell,noco,aVec,icut,div,phi,cvec,corrB,checkdiv) CALL plotBtest(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, aVec, div, phi, cvec, corrB, checkdiv) ELSE CALL buildAtest(stars,atoms,sphhar,vacuum,input,noco,sym,cell,0,aVec,icut) RETURN END IF - !testDen(3)%mt(:,1,:,1)=testDen(3)%mt(:,0,:,1)*atoms%rmsh + !testDen(3)%mt(:,1,:,1)=testDen(3)%mt(:,0,:,1)*atoms%rmsh !testDen(3)%mt(:,1:,:,:)=0.0 !testDen(3)%mt(:,2:,:,:)=0.0 !testDen(3)%mt(:,0,:,:)=0.0 @@ -272,7 +271,7 @@ CONTAINS REAL, INTENT(OUT) :: g(atoms%jri(n)) REAL :: dfr(atoms%jri(n)), d2fr2(atoms%jri(n)) - + CALL grdchlh(1, 1, atoms%jri(n), atoms%dx(n), atoms%rmsh(1, n), f, 5, dfr, d2fr2) g=(dfr-l*f/atoms%rmsh(:, n))!/(atoms%rmsh(1, n)**l) !must NOT be divergent towards the core @@ -290,8 +289,8 @@ CONTAINS ! 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 lh_to_lm(atoms, sphhar, 1, flh, flm) +! CALL lh_from_lm(atoms, sphhar, 1, flm, flh2) ! END SUBROUTINE lhlmtest diff --git a/vgen/vgen_xcpot.F90 b/vgen/vgen_xcpot.F90 index dc3cc3e1..bde3ebf8 100644 --- a/vgen/vgen_xcpot.F90 +++ b/vgen/vgen_xcpot.F90 @@ -40,7 +40,7 @@ CONTAINS CLASS(t_xcpot), INTENT(INOUT) :: xcpot TYPE(t_hybrid), INTENT(IN) :: hybrid TYPE(t_mpi), INTENT(IN) :: mpi - + TYPE(t_oneD), INTENT(IN) :: oneD TYPE(t_sliceplot), INTENT(IN) :: sliceplot TYPE(t_input), INTENT(IN) :: input @@ -126,7 +126,7 @@ CONTAINS IF (mpi%irank == 0) THEN CALL timestart("Vxc in MT") END IF - + CALL vmt_xc(mpi, sphhar, atoms, den, xcpot, input, sym, & EnergyDen, noco,vTot, vx, exc) @@ -176,7 +176,7 @@ CONTAINS ALLOCATE(rhoc(atoms%jmtd,atoms%ntype,input%jspins), rhoc_vx(atoms%jmtd)) ALLOCATE(tec(atoms%ntype,input%jspins),qintc(atoms%ntype,input%jspins)) - CALL readCoreDensity(input,atoms,dimension,rhoc,tec,qintc) + CALL readCoreDensity(input,atoms,rhoc,tec,qintc) DEALLOCATE(tec,qintc) DO ispin = 1, input%jspins diff --git a/vgen/xcBfield.f90 b/vgen/xcBfield.f90 index 9a067fbd..557e1ab8 100644 --- a/vgen/xcBfield.f90 +++ b/vgen/xcBfield.f90 @@ -1,4 +1,4 @@ -!-------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------- ! Copyright (c) 2019 Peter Grünberg Institut, Forschungszentrum Jülich, Germany ! This file is part of FLEUR and available as free software under the conditions ! of the MIT license as expressed in the LICENSE file in more detail. @@ -8,9 +8,9 @@ MODULE m_xcBfield USE m_constants USE m_plot USE m_divergence - + !----------------------------------------------------------------------------- - ! This module contains all the operations on exchange-correlation B-fields + ! This module contains all the operations on exchange-correlation B-fields ! that are necessary to project out source terms. This way, the whole modifi- ! cation towards source-free fields can be done by one call, either as a post- ! process test or in the scf-loop to achieve said fields self-consistently. @@ -19,22 +19,22 @@ MODULE m_xcBfield PUBLIC :: makeBxc, sourcefree CONTAINS - SUBROUTINE makeVectorField(stars,atoms,sphhar,vacuum,input,noco,denmat,factor,aVec,icut) - + SUBROUTINE makeVectorField(sym,stars,atoms,sphhar,vacuum,input,noco,denmat,factor,aVec,icut) + ! Contructs the exchange-correlation magnetic field from the total poten- ! tial matrix or the magnetic density for the density matrix. Only used for ! the implementation of source free fields and therefore only applicable in ! a (fully) non-collinear description of magnetism. - ! + ! ! Assumes the following form for the density/potential matrix: ! rho_mat = n*Id_(2x2) + conj(sigma_vec)*m_vec ! V_mat = V*Id_(2x2) + sigma_vec*B_vec - ! + ! ! A_vec is saved as a density type with an additional r^2-factor. - ! + ! ! TODO: How do we constuct B when not only it is saved to the density ! matrix (SOC, LDA+U etc.)? - + TYPE(t_sym), INTENT(IN) :: sym TYPE(t_stars), INTENT(IN) :: stars TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_sphhar), INTENT(IN) :: sphhar @@ -52,7 +52,7 @@ CONTAINS fcut=1.e-12 icut=1 - + ! Initialize and fill a dummy density array, that takes the initial result ! of matrixsplit. DO i=1, 4 @@ -62,11 +62,11 @@ CONTAINS ALLOCATE(dummyDen(i)%pw_w,mold=dummyDen(i)%pw) ENDDO - CALL matrixsplit(stars,atoms,sphhar,vacuum,input,noco,factor,denmat, & + CALL matrixsplit(sym,stars,atoms,sphhar,vacuum,input,noco,factor,denmat, & dummyDen(1),dummyDen(2),dummyDen(3),dummyDen(4)) r2=1.0 - + ! Initialize and fill the vector field. DO i=1,3 CALL aVec(i)%init_potden_simple(stars%ng3,atoms%jmtd,sphhar%nlhd, & @@ -75,10 +75,10 @@ CONTAINS ALLOCATE(aVec(i)%pw_w,mold=aVec(i)%pw) aVec(i)%mt(:,:,:,:) = dummyDen(i+1)%mt(:,:,:,:) DO itype=1,atoms%ntype - DO lh=0, sphhar%nlh(atoms%ntypsy(SUM(atoms%neq(:itype - 1)) + 1)) - IF (factor==2.0) THEN + DO lh=0, sphhar%nlh(sym%ntypsy(SUM(atoms%neq(:itype - 1)) + 1)) + IF (factor==2.0) THEN r2=atoms%rmsh(:,itype)**2 - END IF + END IF aVec(i)%mt(:,lh,itype,1) = aVec(i)%mt(:,lh,itype,1)*r2 !WHERE (ABS(aVec(i)%mt(ir,0:,itype,:)/r2) < fcut) aVec(i)%mt(ir,0:,itype,:) = 0.0 END DO !lh @@ -87,10 +87,10 @@ CONTAINS aVec(i)%vacz(1:,1:,:) = dummyDen(i+1)%vacz(1:,1:,:) aVec(i)%vacxy(1:,1:,1:,:) = dummyDen(i+1)%vacxy(1:,1:,1:,:) END DO !i - + END SUBROUTINE makeVectorField - SUBROUTINE sourcefree(mpi,dimension,field,stars,atoms,sphhar,vacuum,input,oneD,sym,cell,noco,aVec,icut,div,phi,cvec,corrB,checkdiv) + SUBROUTINE sourcefree(mpi,field,stars,atoms,sphhar,vacuum,input,oneD,sym,cell,noco,aVec,icut,div,phi,cvec,corrB,checkdiv) USE m_vgen_coulomb USE m_gradYlm USE m_grdchlh @@ -99,17 +99,16 @@ CONTAINS ! Takes a vectorial quantity, i.e. a t_potden variable of dimension 3, and ! makes it into a source free vector field as follows: - ! + ! ! a) Build the divergence d of the vector field A_vec as d=nabla_vec*A_vec. ! b) Solve the Poisson equation (nabla_vec*nabla_vec)phi=-4*pi*d for phi. ! c) Construct an auxiliary vector field C_vec=(nabla_vec phi)/(4*pi). ! d) Build A_vec_sf=A_vec+C_vec, which is source free by construction. - ! + ! ! Note: A_vec is assumed to be a density with an additional factor of r^2. - ! A field of the same form will also be calculated. + ! A field of the same form will also be calculated. TYPE(t_mpi), INTENT(IN) :: mpi - TYPE(t_dimension), INTENT(IN) :: dimension TYPE(t_field), INTENT(INOUT) :: field TYPE(t_stars), INTENT(IN) :: stars TYPE(t_atoms), INTENT(IN) :: atoms @@ -124,11 +123,11 @@ CONTAINS INTEGER, INTENT(IN) :: icut(3,0:sphhar%nlhd,atoms%ntype) TYPE(t_potden), INTENT(OUT) :: div, phi, checkdiv TYPE(t_potden), DIMENSION(3), INTENT(OUT) :: cvec, corrB - + TYPE(t_potden) :: divloc TYPE(t_atoms) :: atloc INTEGER :: n, jr, lh, lhmax, jcut, nat - REAL :: xp(3,dimension%nspd) + REAL :: xp(3,(atoms%lmaxd+1+mod(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)) !DO i=1,3 ! aVec(i)%mt(:,atoms%lmaxd**2:,:,:)=0.0 @@ -140,14 +139,14 @@ CONTAINS ALLOCATE(div%pw_w,mold=div%pw) CALL divergence2(stars,atoms,sphhar,vacuum,sym,cell,noco,aVec,div) - + atloc=atoms atloc%zatom=0.0 !Local atoms variable with no charges; needed for the potential generation. fcut=1.e-6 !div%mt(:300,25,:,1)=0.0 - !DO n=1,atoms%ntype + !DO n=1,atoms%ntype !lhmax=sphhar%nlh(atoms%ntypsy(SUM(atoms%neq(:n - 1)) + 1)) !DO lh=0, lhmax !div%mt(:,lh,n,1)=div%mt(:,lh,n,1)/(atoms%rmsh(:, n)**2) @@ -162,7 +161,7 @@ CONTAINS ALLOCATE(phi%pw_w(SIZE(phi%pw,1),size(phi%pw,2))) phi%pw_w = CMPLX(0.0,0.0) - CALL vgen_coulomb(1,mpi,dimension,oneD,input,field,vacuum,sym,stars,cell,sphhar,atloc,.TRUE.,div,phi) + CALL vgen_coulomb(1,mpi,oneD,input,field,vacuum,sym,stars,cell,sphhar,atloc,.TRUE.,div,phi) DO i=1,3 CALL cvec(i)%init_potden_simple(stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype,atoms%n_u,1,.FALSE.,.FALSE.,POTDEN_TYPE_DEN,vacuum%nmzd,vacuum%nmzxyd,stars%ng2) @@ -180,20 +179,20 @@ CONTAINS ALLOCATE(corrB(i)%pw_w,mold=corrB(i)%pw) CALL corrB(i)%addPotDen(aVec(i),cvec(i)) ENDDO - + CALL checkdiv%init_potden_simple(stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype, & atoms%n_u,1,.FALSE.,.FALSE.,POTDEN_TYPE_DEN, & vacuum%nmzd,vacuum%nmzxyd,stars%ng2) ALLOCATE(checkdiv%pw_w,mold=checkdiv%pw) - + CALL divergence2(stars,atoms,sphhar,vacuum,sym,cell,noco,corrB,checkdiv) nat=1 - DO n=1,atoms%ntype - lhmax=sphhar%nlh(atoms%ntypsy(SUM(atoms%neq(:n - 1)) + 1)) + DO n=1,atoms%ntype + lhmax=sphhar%nlh(sym%ntypsy(SUM(atoms%neq(:n - 1)) + 1)) DO lh=0, lhmax aVec(3)%mt(:,lh,n,1)=aVec(3)%mt(:,lh,n,1)/(atoms%rmsh(:, n)**2) - div%mt(:,lh,n,1)=div%mt(:,lh,n,1)/(atoms%rmsh(:, n)**2) + div%mt(:,lh,n,1)=div%mt(:,lh,n,1)/(atoms%rmsh(:, n)**2) checkdiv%mt(:,lh,n,1)=checkdiv%mt(:,lh,n,1)/(atoms%rmsh(:, n)**2) cvec(1)%mt(:,lh,n,1)=cvec(1)%mt(:,lh,n,1)/(atoms%rmsh(:, n)**2) cvec(2)%mt(:,lh,n,1)=cvec(2)%mt(:,lh,n,1)/(atoms%rmsh(:, n)**2) @@ -202,16 +201,16 @@ CONTAINS DO lh=0, lhmax aVec(3)%mt(:,lh,n,1)=aVec(3)%mt(:,lh,n,1)*(atoms%rmsh(:, n)**2) - div%mt(:,lh,n,1)=div%mt(:,lh,n,1)*(atoms%rmsh(:, n)**2) + div%mt(:,lh,n,1)=div%mt(:,lh,n,1)*(atoms%rmsh(:, n)**2) checkdiv%mt(:,lh,n,1)=checkdiv%mt(:,lh,n,1)*(atoms%rmsh(:, n)**2) cvec(1)%mt(:,lh,n,1)=cvec(1)%mt(:,lh,n,1)*(atoms%rmsh(:, n)**2) cvec(2)%mt(:,lh,n,1)=cvec(2)%mt(:,lh,n,1)*(atoms%rmsh(:, n)**2) cvec(3)%mt(:,lh,n,1)=cvec(3)%mt(:,lh,n,1)*(atoms%rmsh(:, n)**2) END DO - CALL sphpts(xp,dimension%nspd,atoms%rmt(n),atoms%pos(1,nat)) - CALL checkdop(xp,dimension%nspd,n,nat,0,-1,1,dimension,atoms,sphhar,stars,sym,vacuum,cell,oneD,div) - CALL checkdop(xp,dimension%nspd,n,nat,0,-1,1,dimension,atoms,sphhar,stars,sym,vacuum,cell,oneD,phi) + CALL sphpts(xp,size(xp,2),atoms%rmt(n),atoms%pos(1,nat)) + CALL checkdop(xp,size(xp,2),n,nat,0,-1,1,atoms,sphhar,stars,sym,vacuum,cell,oneD,div) + CALL checkdop(xp,size(xp,2),n,nat,0,-1,1,atoms,sphhar,stars,sym,vacuum,cell,oneD,phi) nat = nat + atoms%neq(n) END DO @@ -220,17 +219,17 @@ CONTAINS SUBROUTINE correctPot(vTot,c) USE m_types - + ! Takes a vectorial quantity c and saves its components into the appro - ! priate components of the potential matrix V. - ! + ! priate components of the potential matrix V. + ! ! An initial V_mat = V*Id_(2x2) + sigma_vec*B_vec will become ! V_mat = V*Id_(2x2) + sigma_vec*(B_vec+C_vec) - ! + ! ! TODO: Both quantities are assumed to be in the global frame of refe- ! rence. Make sure this is true. Also: consider SOC, LDA+U etc. - TYPE(t_potden), INTENT(INOUT) :: vTot + TYPE(t_potden), INTENT(INOUT) :: vTot TYPE(t_potden), DIMENSION(3), INTENT(IN) :: c vTot%mt(:,0:,:,1)=vTot%mt(:,0:,:,1)+c(3)%mt(:,0:,:,1) diff --git a/wannier/wann_updown.F b/wannier/wann_updown.F index f6938cac..08275a13 100644 --- a/wannier/wann_updown.F +++ b/wannier/wann_updown.F @@ -75,8 +75,8 @@ c**************************************************************************** #endif - - TYPE(t_wann), INTENT(INOUT) :: wann + + TYPE(t_wann), INTENT(INOUT) :: wann TYPE(t_mpi),INTENT(IN) :: mpi TYPE(t_input),INTENT(IN) :: input TYPE(t_kpts), INTENT(IN) :: kpts @@ -128,7 +128,7 @@ c**************************************************************************** type (od_inp), intent (in) :: odi type (od_sym), intent (in) :: ods real, intent(in) :: theta,phi - + cccccccccccccccccc local variables cccccccccccccccccccc ! type(t_wann) :: wann !now input variable integer :: lmd,nlotot,n,nmat,iter,ikpt @@ -253,15 +253,15 @@ c..wf-hamiltonian in real space (hopping in the same unit cell) real,parameter :: bohrtocm=0.529177e-8 real,parameter :: condquant=7.7480917e-5 real :: dirfacs(3) - complex,allocatable :: ubeffug(:,:,:) - complex,allocatable :: ubeffdg(:,:,:) - complex,allocatable :: dbeffug(:,:,:) - complex,allocatable :: dbeffdg(:,:,:) - complex,allocatable :: ubeffulog(:,:,:,:) - complex,allocatable :: dbeffulog(:,:,:,:) - complex,allocatable :: ulobeffug(:,:,:,:) - complex,allocatable :: ulobeffdg(:,:,:,:) - complex,allocatable :: ulobeffulog(:,:,:,:,:) + complex,allocatable :: ubeffug(:,:,:) + complex,allocatable :: ubeffdg(:,:,:) + complex,allocatable :: dbeffug(:,:,:) + complex,allocatable :: dbeffdg(:,:,:) + complex,allocatable :: ubeffulog(:,:,:,:) + complex,allocatable :: dbeffulog(:,:,:,:) + complex,allocatable :: ulobeffug(:,:,:,:) + complex,allocatable :: ulobeffdg(:,:,:,:) + complex,allocatable :: ulobeffulog(:,:,:,:,:) integer :: spinloop1,spinloop2,ilop integer :: alerr @@ -391,7 +391,7 @@ c********************************************************* enddo enddo enddo - + cccccccccccccccc end of the potential part ccccccccccc wannierspin=jspd if(l_soc) wannierspin=2 @@ -438,14 +438,14 @@ cccccccccccccccc end of the potential part ccccccccccc if (alerr /= 0) call juDFT_error('alerr: 17', & calledby='wann_updown') c**************************************************** -c jspin=1 +c jspin=1 c**************************************************** jspin=1 c...read number of bands and wannier functions from file proj c..reading the proj.1 / proj.2 / proj file - l_proj=.false. + l_proj=.false. do j=jspin,0,-1 inquire(file=trim('proj'//spin012(j)),exist=l_proj) if(l_proj)then @@ -463,7 +463,7 @@ c..reading the proj.1 / proj.2 / proj file else CALL juDFT_error("no proj/proj.1/proj.2", + calledby ="wann_updown") - endif + endif jspin2=jspin @@ -477,12 +477,12 @@ cccccccccccc read in the eigenvalues and vectors cccccc ! CALL judft_error("TODO:wann_updown") ! call cdn_read0(eig_id,irank,isize,jspin,jspd,l_noco, ! < ello,evac,epar,wk,n_bands,n_size) - + CALL cdn_read0(eig_id,mpi%irank,mpi%isize,jspin5, > input%jspins, !wannierspin instead of DIMENSION%jspd?& > noco%l_noco, n_bands,n_size) - - + + enddo jspin=1 @@ -782,10 +782,10 @@ c**************************************************************** & 1:nlod,-llod:llod,1:ntype),stat=alerr ) if (alerr /= 0) call juDFT_error('alerr: 43', & calledby='wann_updown') - - + + call wann_gabeffgagaunt( - > vTot, + > vTot, > wann%l_perpmagatlres,wann%perpmagl, > neq,mlh,nlhd,nlh,ntypsy,llh,lmax, > nmem,ntype,ntypd,bbmat,bmat, @@ -794,8 +794,8 @@ c**************************************************************** < ubeffug,ubeffdg,dbeffug,dbeffdg,ubeffulog, < dbeffulog, < ulobeffug,ulobeffdg,ulobeffulog) - endif - + endif + i_rec = 0 ; n_rank = 0 @@ -814,12 +814,12 @@ c**************************************************************** c**************************************************************** c Obtain eigenvectors for the two spin channels. c**************************************************************** - + allocate ( eigg(neigd,2),stat=alerr ) if (alerr /= 0) call juDFT_error('alerr: 44', & calledby='wann_updown') - - + + call cpu_time(delta) do jspin=1,wannierspin if(jspin.eq.1)nrec=0 @@ -875,7 +875,7 @@ c**************************************************************** call cpu_time(delta1) time_rw=time_rw+delta1-delta nslibd = 0 - + jspin=1 c...we work only within the energy window @@ -958,7 +958,7 @@ c*********************************************************** else nsfactor=cmplx(1.0,0.0) endif - enddo !jspin + enddo !jspin c print*,"bkpt1=",bkpt c****************************************************************** @@ -972,8 +972,8 @@ c...the overlap matrix Mmn which is computed for each k- and b-point & ccof(-llod:llod,noccbd,nlod,natd,wannierspin),stat=alerr ) if (alerr /= 0) call juDFT_error('alerr: 49', & calledby='wann_updown') - - + + acof(:,:,:,:) = cmplx(0.,0.) ; bcof(:,:,:,:) = cmplx(0.,0.) ccof(:,:,:,:,:) = cmplx(0.,0.) @@ -1052,7 +1052,7 @@ c...for the lapws and local orbitals, summed by the basis functions > ulobeffug,ulobeffdg,ulobeffulog, > acof,bcof,ccof, < perpmag(:,:,ikpt)) - endif + endif #ifdef CPP_TOPO @@ -1073,11 +1073,11 @@ c...for the lapws and local orbitals, summed by the basis functions > dirfacs,amat, > ntype,lmaxd,lmax,natd, > neq,noccbd,lmd,natd,llod,nlod, - > nlo,llo, + > nlo,llo, > acof,bcof,ccof, > us,dus,duds,uds, > ulos,dulos, - > rmt,pos, + > rmt,pos, & surfcurr(:,:,:,ikpt)) write(6,*)"dirfacs=",dirfacs endif @@ -1086,7 +1086,7 @@ c...for the lapws and local orbitals, summed by the basis functions call wann_nabla_updown( > jspin,ntype,lmaxd,lmax,natd, > jmtd,jri,rmsh,dx,neq, - > noccbd,lmd,natd,llod,nlod, + > noccbd,lmd,natd,llod,nlod, > ff(:,:,:,:,1),gg(:,:,:,:,1), > ff(:,:,:,:,2),gg(:,:,:,:,2), > acof(:,:,:,1),bcof(:,:,:,1), @@ -1132,13 +1132,13 @@ c--> determine index and phase factor value=phasust*zzConjgTemp nablamat(dir,m,n,ikpt) = nablamat(dir,m,n,ikpt) - + value*b2(dir) - enddo + enddo enddo enddo 42 continue 41 continue - endif + endif #endif c*************************************************** @@ -1167,25 +1167,25 @@ c$$$ do m = 1,nslibd c$$$ do n = 1,nslibd c$$$#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) ) c$$$ mmn(m,n,ikpt) = -c$$$ = mmn(m,n,ikpt) + +c$$$ = mmn(m,n,ikpt) + c$$$ + phasust*z(i,m,1)*conjg(z(j+addnoco,n,2)) c$$$#else c$$$ mmn(m,n,ikpt) = -c$$$ = mmn(m,n,ikpt) + +c$$$ = mmn(m,n,ikpt) + c$$$ + phasust*cmplx(z(i,m,1)*z(j+addnoco,n,2),0.0) c$$$#endif c$$$ enddo !n c$$$ enddo !m c$$$ c$$$ 22 continue -c$$$ enddo !i +c$$$ enddo !i addnoco2 = addnoco ! TODO: correct for addnoco2 call wann_mmkb_int( > cmplx(1.,0.),addnoco,addnoco2, - > DIMENSION%nvd,stars%mx1,stars%mx2,stars%mx3, + > nvd,stars%mx1,stars%mx2,stars%mx3, > stars%ng3,lapw%k1(:,jspin),lapw%k2(:,jspin),lapw%k3(:,jspin), - > lapw%nv(jspin),DIMENSION%neigd,DIMENSION%nbasfcn,zMat(1),nslibd, + > lapw%nv(jspin),neigd,nbasfcn,zMat(1),nslibd, > lapw%k1(:,jspin),lapw%k2(:,jspin),lapw%k3(:,jspin), > lapw%nv(jspin),zMat(2),nslibd, > nbnd, @@ -1271,17 +1271,17 @@ c****************************************************** ! > 2,2,nbnd,nbnd,fullnkpts, ! > irank,isize, ! < hsomtx) - + call wann_write_matrix5( > mpi_comm,l_p0,'WF1.hsomtx', > 'Matrix elements of spin-orbit coupling', > nbnd,nbnd,2,2,fullnkpts, > irank,isize,wann%l_unformatted, < hsomtx) - - + + endif - + if(wann%l_socmatvec)then call wann_write_matrix6( > mpi_comm,l_p0,'WF1.hsomtxvec', @@ -1298,7 +1298,7 @@ c****************************************************** > nbnd,fullnkpts,nbnd, > irank,isize,.false.,.true., < mmn,wann%l_unformatted) - endif !l_soc and l_mmn0 + endif !l_soc and l_mmn0 if(wann%l_perpmag)then call wann_write_amn( @@ -1307,7 +1307,7 @@ c****************************************************** > nbnd,fullnkpts,nbnd, > irank,isize,.true.,.true., < perpmag,wann%l_unformatted) - endif !l_soc and l_mmn0 + endif !l_soc and l_mmn0 if(wann%l_surfcurr)then surfcurr=conjg(surfcurr/cmplx(0.0,2.0)) @@ -1320,13 +1320,13 @@ c****************************************************** > nbnd,fullnkpts,nbnd, > irank,isize, < surfcurr) - endif + endif if( allocated (nablamat) ) deallocate( nablamat ) deallocate ( mmn ) deallocate(flo) - + deallocate ( vr,vz ) deallocate ( ff,gg ) if (wann%l_bzsym) deallocate(irreduc,mapkoper) -- GitLab