From c160e87c159c9d8fb679b3331d8ea4adee94e322 Mon Sep 17 00:00:00 2001 From: Daniel Wortmann Date: Mon, 4 Nov 2019 11:34:15 +0100 Subject: [PATCH] Deleted t_dimension and corresponding variable --- cdn/cdnovlp.F90 | 10 +- cdn/cdnval.F90 | 22 +-- cdn/eparas.f90 | 2 +- cdn/n_mat.f90 | 2 +- cdn/od_abvac.f90 | 34 ++-- cdn/pwden.F90 | 2 +- cdn/qal_21.f90 | 8 +- cdn/vacden.F90 | 166 +++++++++--------- cdn_mt/abclocdn.F90 | 4 +- cdn_mt/abclocdn_pulay.F90 | 8 +- cdn_mt/abcof.F90 | 6 +- cdn_mt/abcof3.F90 | 4 +- cdn_mt/cdncore.F90 | 18 +- cdn_mt/magMoms.f90 | 4 +- core/cored.F90 | 4 +- core/coredr.F90 | 8 +- core/etabinit.F90 | 4 +- diagonalization/chase_diag.F90 | 10 +- docs/removed_files/old/hsmt_extra.F90 | 12 +- docs/removed_files/old/hsmt_nonsph.F90 | 12 +- docs/removed_files/old/hsmt_nonsph_GPU.F90 | 14 +- docs/removed_files/old/hsmt_simple.F90 | 12 +- docs/removed_files/old/hsmt_sph.F90 | 16 +- docs/removed_files/old/hsmt_sph_new.F90 | 10 +- dos/Ek_write_sl.f90 | 6 +- dos/cdninf.f90 | 12 +- dos/doswrite.f90 | 10 +- dos/evaldos.f90 | 30 ++-- dos/nstm3.f90 | 2 +- dos/sympsi.F90 | 18 +- eigen/eigen.F90 | 29 ++- eigen/eigen_hssetup.F90 | 6 +- eigen/hsvac.F90 | 22 +-- eigen/mt_setup.F90 | 8 +- eigen/od_hsvac.F90 | 32 ++-- eigen/od_vacfun.f90 | 39 ++--- eigen/vacfun.f90 | 12 +- eigen_secvar/aline.F90 | 24 +-- eigen_secvar/aline_muff.F90 | 18 +- eigen_secvar/h_nonmuff.F90 | 16 +- eigen_secvar/hssr_wu.F90 | 20 +-- eigen_soc/abcof_soc.F90 | 4 +- eigen_soc/alineso.F90 | 56 +++--- eigen_soc/eigenso.F90 | 18 +- eigen_soc/hsohelp.F90 | 38 ++-- eigen_soc/ssomat.F90 | 154 ++++++++-------- fermi/fergwt.f90 | 2 +- fermi/ferhis.f90 | 12 +- fermi/fermie.F90 | 2 +- force/force_a12.f90 | 6 +- force/force_a21.F90 | 14 +- force/force_a21_lo.f90 | 2 +- force/force_a4.f90 | 6 +- force/geo.f90 | 2 +- forcetheorem/dmi.F90 | 6 +- forcetheorem/jij.F90 | 4 +- forcetheorem/mae.F90 | 4 +- forcetheorem/ssdisp.F90 | 4 +- global/checkdop.F90 | 4 +- global/checkdopall.f90 | 10 +- init/checkInputParams.f90 | 4 +- init/initParallelProcesses.F90 | 10 +- init/lapw_dim.F90 | 25 ++- init/old_inp/fleur_init_old.F90 | 8 +- init/old_inp/setup.f90 | 8 +- init/postprocessInput.F90 | 4 +- inpgen2/old_inp/dimen7.F90 | 30 ++-- inpgen2/old_inp/dimens.F90 | 6 +- inpgen2/old_inp/fleur_init_old.F90 | 6 +- inpgen2/old_inp/inpeig_dim.f90 | 18 +- inpgen2/old_inp/parawrite.f90 | 8 +- inpgen2/read_old_inp.f90 | 4 +- io/cdn_io.F90 | 12 +- io/cdnpot_io_hdf.F90 | 8 +- io/io_hybrid.F90 | 52 +++--- io/writeBasis.F90 | 16 +- io/writeOutParameters.f90 | 10 +- ldau/u_ham.F90 | 4 +- main/cdngen.F90 | 26 +-- main/fleur.F90 | 44 ++--- main/fleur_init.F90 | 40 ++--- main/mix.F90 | 6 +- main/optional.F90 | 10 +- main/totale.f90 | 6 +- main/vgen.F90 | 10 +- mix/kerker.F90 | 6 +- mpi/mpi_bc_all.F90 | 8 +- mpi/mpi_bc_coreDen.F90 | 4 +- mpi/mpi_make_groups.F90 | 89 +++++----- optional/atom2.f90 | 4 +- optional/cdnsp.f90 | 10 +- optional/plotdop.f90 | 4 +- optional/stden.f90 | 10 +- orbdep/mcd_init.f90 | 4 +- rdmft/rdmft.F90 | 42 ++--- types/types_cdnval.f90 | 42 ++--- types/types_dimension.f90 | 7 +- types/types_force.f90 | 8 +- types/types_forcetheo.F90 | 4 +- types/types_lapw.F90 | 52 ++++-- types/types_misc.F90 | 12 +- vgen/fleur_vdW.F90 | 6 +- vgen/rotate_int_den_to_local.F90 | 4 +- vgen/vgen_coulomb.F90 | 6 +- vgen/vgen_xcpot.F90 | 8 +- vgen/write_xcstuff.f90 | 4 +- wannier/bs_comfort.F | 10 +- wannier/uhu/wann_uHu.F | 40 ++--- wannier/uhu/wann_uHu_dmi.F | 30 ++-- wannier/uhu/wann_uHu_od_vac.F | 57 +++--- wannier/wann_1dvacabcof.F | 17 +- wannier/wann_mmk0_od_vac.F | 28 +-- wannier/wann_mmkb_od_vac.F | 46 ++--- wannier/wann_plot.F | 6 +- wannier/wann_plot_um_dat.F | 6 +- wannier/wann_postproc.F90 | 62 +++---- wannier/wann_read_inp.f90 | 14 +- wannier/wann_updown.F | 10 +- wannier/wann_wan90prep.F | 34 ++-- wannier/wannier.F90 | 194 ++++++++++----------- xc-pot/metagga.F90 | 8 +- 121 files changed, 1167 insertions(+), 1148 deletions(-) diff --git a/cdn/cdnovlp.F90 b/cdn/cdnovlp.F90 index f22362b2..5681d266 100644 --- a/cdn/cdnovlp.F90 +++ b/cdn/cdnovlp.F90 @@ -12,7 +12,7 @@ CONTAINS SUBROUTINE cdnovlp(mpi,& & sphhar,stars,atoms,sym,& - & DIMENSION,vacuum,cell,& + & vacuum,cell,& & input,oneD,l_st,& & jspin,rh,& & qpw,rhtxy,rho,rht) @@ -96,7 +96,7 @@ TYPE(t_cell),INTENT(IN) :: cell TYPE(t_sym),INTENT(IN) :: sym TYPE(t_oneD),INTENT(IN) :: oneD - TYPE(t_dimension),INTENT(IN)::DIMENSION + TYPE(t_vacuum),INTENT(in):: vacuum TYPE(t_input),INTENT(in)::input @@ -241,7 +241,7 @@ ! !=====> calculate the fourier transform of the core-pseudocharge - CALL ft_of_CorePseudocharge(mpi,DIMENSION,atoms,mshc,alpha,tol_14,rh, & + CALL ft_of_CorePseudocharge(mpi,atoms,mshc,alpha,tol_14,rh, & acoff,stars,method2,rat,cell,oneD,sym,qpwc) DO k = 1 , stars%ng3 @@ -476,7 +476,7 @@ ! INTERNAL SUBROUTINES !*********************************************************************** - subroutine ft_of_CorePseudocharge(mpi,DIMENSION,atoms,mshc,alpha,& + subroutine ft_of_CorePseudocharge(mpi,atoms,mshc,alpha,& tol_14,rh,acoff,stars,method2,rat,cell,oneD,sym,qpwc) !=====> calculate the fourier transform of the core-pseudocharge @@ -489,7 +489,7 @@ USE m_types type(t_mpi) ,intent(in) :: mpi - type(t_dimension),intent(in) :: DIMENSION + type(t_atoms) ,intent(in) :: atoms integer ,intent(in) :: mshc(atoms%ntype) real ,intent(in) :: alpha(atoms%ntype), tol_14 diff --git a/cdn/cdnval.F90 b/cdn/cdnval.F90 index dad749a5..672fbd76 100644 --- a/cdn/cdnval.F90 +++ b/cdn/cdnval.F90 @@ -11,7 +11,7 @@ USE m_juDFT CONTAINS SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,& - vacuum,dimension,sphhar,sym,vTot,oneD,cdnvalJob,den,regCharges,dos,results,& + vacuum,sphhar,sym,vTot,oneD,cdnvalJob,den,regCharges,dos,results,& moments,coreSpecInput,mcd,slab,orbcomp) !************************************************************************************ @@ -56,7 +56,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st TYPE(t_results), INTENT(INOUT) :: results TYPE(t_mpi), INTENT(IN) :: mpi - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_oneD), INTENT(IN) :: oneD TYPE(t_enpara), INTENT(IN) :: enpara TYPE(t_banddos), INTENT(IN) :: banddos @@ -163,7 +163,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st CALL genMTBasis(atoms,enpara,vTot,mpi,iType,ispin,usdus,f(:,:,0:,ispin),g(:,:,0:,ispin),flo(:,:,:,ispin)) END DO IF (noco%l_mperp) CALL denCoeffsOffdiag%addRadFunScalarProducts(atoms,f,g,flo,iType) - IF (banddos%l_mcd) CALL mcd_init(atoms,input,dimension,vTot%mt(:,0,:,:),g,f,mcd,iType,jspin) + IF (banddos%l_mcd) CALL mcd_init(atoms,input,vTot%mt(:,0,:,:),g,f,mcd,iType,jspin) IF (l_coreSpec) CALL corespec_rme(atoms,input,iType,29,input%jspins,jspin,results%ef,& atoms%msh,vTot%mt(:,0,:,:),f,g) END DO @@ -199,7 +199,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st IF (noccbd.LE.0) CYCLE ! Note: This jump has to be after the MPI_BARRIER is called - CALL gVacMap%init(dimension,sym,atoms,vacuum,stars,lapw,input,cell,kpts,enpara,vTot,ikpt,jspin) + CALL gVacMap%init(sym,atoms,vacuum,stars,lapw,input,cell,kpts,enpara,vTot,ikpt,jspin) ! valence density in the interstitial and vacuum region has to be called only once (if jspin=1) in the non-collinear case IF (.NOT.((jspin.EQ.2).AND.noco%l_noco)) THEN @@ -210,14 +210,14 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st IF (l_dosNdir.AND.PRESENT(slab)) CALL q_int_sl(jspin,ikpt,stars,atoms,sym,cell,noccbd,ev_list,lapw,slab,oneD,zMat) ! valence density in the vacuum region IF (input%film) THEN - CALL vacden(vacuum,dimension,stars,oneD, kpts,input,sym,cell,atoms,noco,banddos,& + CALL vacden(vacuum,stars,oneD, kpts,input,sym,cell,atoms,noco,banddos,& gVacMap,we,ikpt,jspin,vTot%vacz(:,:,jspin),noccbd,ev_list,lapw,enpara%evac,eig,den,zMat,dos) END IF END IF IF (input%film) CALL regCharges%sumBandsVac(vacuum,dos,noccbd,ikpt,jsp_start,jsp_end,eig,we) ! valence density in the atomic spheres - CALL eigVecCoeffs%init(input,DIMENSION,atoms,noco,jspin,noccbd) + CALL eigVecCoeffs%init(input,atoms,noco,jspin,noccbd) DO ispin = jsp_start, jsp_end IF (input%l_f) CALL force%init2(noccbd,input,atoms) CALL abcof(input,atoms,sym,cell,lapw,noccbd,usdus,noco,ispin,oneD,& @@ -230,7 +230,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st CALL eparas(ispin,atoms,noccbd,ev_list,mpi,ikpt,noccbd,we,eig,& skip_t,cdnvalJob%l_evp,eigVecCoeffs,usdus,regCharges,dos,banddos%l_mcd,mcd) - IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(dimension,atoms,input,noccbd,ev_list,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos) + IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(atoms,input,noccbd,ev_list,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos) ! layer charge of each valence state in this k-point of the SBZ from the mt-sphere region of the film IF (l_dosNdir) THEN @@ -244,16 +244,16 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st CALL calcDenCoeffs(atoms,sphhar,sym,we,noccbd,eigVecCoeffs,ispin,denCoeffs) IF (noco%l_soc) CALL orbmom(atoms,noccbd,we,ispin,eigVecCoeffs,orb) - IF (input%l_f) CALL force%addContribsA21A12(input,atoms,dimension,sym,cell,oneD,enpara,& + IF (input%l_f) CALL force%addContribsA21A12(input,atoms,sym,cell,oneD,enpara,& usdus,eigVecCoeffs,noccbd,ispin,eig,we,results) - IF(l_coreSpec) CALL corespec_dos(atoms,usdus,ispin,dimension%lmd,kpts%nkpt,ikpt,dimension%neigd,& + IF(l_coreSpec) CALL corespec_dos(atoms,usdus,ispin,atoms%lmaxd*(atoms%lmaxd+2),kpts%nkpt,ikpt,input%neig,& noccbd,results%ef,banddos%sig_dos,eig,we,eigVecCoeffs) END DO ! end loop over ispin IF (noco%l_mperp) CALL denCoeffsOffdiag%calcCoefficients(atoms,sphhar,sym,eigVecCoeffs,we,noccbd) IF ((banddos%dos.OR.banddos%vacdos.OR.input%cdinf).AND.(banddos%ndir.GT.0)) THEN ! since z is no longer an argument of cdninf sympsi has to be called here! - CALL sympsi(lapw,jspin,sym,dimension,nbands,cell,eig,noco,dos%ksym(:,ikpt,jspin),dos%jsym(:,ikpt,jspin),zMat) + CALL sympsi(lapw,jspin,sym,nbands,cell,eig,noco,dos%ksym(:,ikpt,jspin),dos%jsym(:,ikpt,jspin),zMat) END IF END DO ! end of k-point loop @@ -272,7 +272,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st IF (input%cdinf) THEN WRITE (6,FMT=8210) ispin 8210 FORMAT (/,5x,'check continuity of cdn for spin=',i2) - CALL checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,cell,den,ispin) + CALL checkDOPAll(input,sphhar,stars,atoms,sym,vacuum,oneD,cell,den,ispin) END IF IF (input%l_f) CALL force_a8(input,atoms,sym,sphhar,ispin,vTot%mt(:,:,:,ispin),den%mt,force,results) END DO diff --git a/cdn/eparas.f90 b/cdn/eparas.f90 index 736d19d6..f9e3d911 100644 --- a/cdn/eparas.f90 +++ b/cdn/eparas.f90 @@ -42,7 +42,7 @@ CONTAINS INTEGER, INTENT (IN) :: ev_list(noccbd) ! .. ! .. Array Arguments .. - REAL, INTENT (IN) :: eig(:)!(dimension%neigd), + REAL, INTENT (IN) :: eig(:)!(input%neig), REAL, INTENT (IN) :: we(noccbd) ! .. diff --git a/cdn/n_mat.f90 b/cdn/n_mat.f90 index 2a303828..3b1d79b1 100644 --- a/cdn/n_mat.f90 +++ b/cdn/n_mat.f90 @@ -29,7 +29,7 @@ CONTAINS INTEGER, INTENT (IN) :: ne,jspin ! .. ! .. Array Arguments .. - REAL, INTENT (IN) :: we(:)!(dimension%neigd) + REAL, INTENT (IN) :: we(:)!(input%neig) COMPLEX, INTENT (INOUT) :: n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u) ! .. ! .. Local Scalars .. diff --git a/cdn/od_abvac.f90 b/cdn/od_abvac.f90 index a255e9fe..5a155550 100644 --- a/cdn/od_abvac.f90 +++ b/cdn/od_abvac.f90 @@ -7,23 +7,23 @@ MODULE m_od_abvac CONTAINS SUBROUTINE od_abvac(& - & cell,vacuum,DIMENSION,stars,& + & cell,vacuum,stars,& & oneD,qssbti,& & n2d_1,& & wronk,evac,bkpt,MM,vM,& & vz,kvac3,nv2,& & uz,duz,u,udz,dudz,ddnv,ud) !************************************************************** - ! determines the nesessary values and derivatives on the + ! determines the nesessary values and derivatives on the ! vacuum cylindrical boundary for finding a and b coefficients ! for the construcing vacuum charge density in vacden.F ! Y.Mokrousov, 7th of october 2002 - !*************************************************************** + !*************************************************************** USE m_vacuz USE m_vacudz USE m_types IMPLICIT NONE - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_stars),INTENT(IN) :: stars @@ -36,26 +36,26 @@ CONTAINS REAL, INTENT (in) :: evac ! ..array arguments.. - INTEGER, INTENT (in) :: kvac3(DIMENSION%nv2d) - REAL, INTENT (in) :: bkpt(3),qssbti - REAL, INTENT (in) :: vz(vacuum%nmzd) - REAL, INTENT (out):: udz(DIMENSION%nv2d,-vM:vM) - REAL, INTENT (out):: uz(DIMENSION%nv2d,-vM:vM) - REAL, INTENT (out):: dudz(DIMENSION%nv2d,-vM:vM) - REAL, INTENT (out):: duz(DIMENSION%nv2d,-vM:vM) - REAL, INTENT (out):: u(vacuum%nmzd,DIMENSION%nv2d,-vM:vM) - REAL, INTENT (out):: ud(vacuum%nmzd,DIMENSION%nv2d,-vM:vM) - REAL, INTENT (out):: ddnv(DIMENSION%nv2d,-vM:vM) + INTEGER, INTENT (in) :: kvac3(:) + REAL, INTENT (in) :: bkpt(3),qssbti + REAL, INTENT (in) :: vz(vacuum%nmzd) + REAL, INTENT (out):: udz(:,-vM:) + REAL, INTENT (out):: uz(:,-vM:) + REAL, INTENT (out):: dudz(:,-vM:) + REAL, INTENT (out):: duz(:,-vM:) + REAL, INTENT (out):: u(:,:,-vM:) + REAL, INTENT (out):: ud(:,:,-vM:) + REAL, INTENT (out):: ddnv(:,-vM:) ! ..local scalars.. REAL ev,scale,xv,yv,vzero,v1 INTEGER i,ik,jk,jspin,jsp1,jsp2 ,l,m INTEGER i1,i2,i3,ind1,ind3 ! .. local arrays.. - REAL wdz(DIMENSION%nv2d,-vM:vM),wz(DIMENSION%nv2d,-vM:vM) - REAL dwdz(DIMENSION%nv2d,-vM:vM),dwz(DIMENSION%nv2d,-vM:vM) + REAL wdz(lapw_dim_nv2d,-vM:vM),wz(lapw_dim_nv2d,-vM:vM) + REAL dwdz(lapw_dim_nv2d,-vM:vM),dwz(lapw_dim_nv2d,-vM:vM) REAL v(3),x(vacuum%nmzd) REAL vr0(vacuum%nmzd) - REAL w(vacuum%nmzd,DIMENSION%nv2d,-vM:vM),wd(vacuum%nmzd,DIMENSION%nv2d,-vM:vM) + REAL w(vacuum%nmzd,lapw_dim_nv2d,-vM:vM),wd(vacuum%nmzd,lapw_dim_nv2d,-vM:vM) ! wronksian for the schrodinger equation given by an identity diff --git a/cdn/pwden.F90 b/cdn/pwden.F90 index 155bbb1f..ec4840a7 100644 --- a/cdn/pwden.F90 +++ b/cdn/pwden.F90 @@ -97,7 +97,7 @@ CONTAINS TYPE(t_dos), INTENT(INOUT) :: dos REAL,INTENT(IN) :: we(:) !(nobd) - REAL,INTENT(IN) :: eig(:)!(dimension%neigd) + REAL,INTENT(IN) :: eig(:)!(input%neig) INTEGER, INTENT(IN) :: ev_list(ne) !-----> BASIS FUNCTION INFORMATION INTEGER,INTENT(IN):: ne diff --git a/cdn/qal_21.f90 b/cdn/qal_21.f90 index 74aefc9b..34e1aa12 100644 --- a/cdn/qal_21.f90 +++ b/cdn/qal_21.f90 @@ -5,7 +5,7 @@ MODULE m_qal21 !*********************************************************************** ! CONTAINS - SUBROUTINE qal_21(dimension,atoms,input,noccbd,ev_list,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos) + SUBROUTINE qal_21(atoms,input,noccbd,ev_list,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos) USE m_types_setup USE m_types_dos @@ -14,7 +14,7 @@ CONTAINS USE m_rotdenmat use m_constants IMPLICIT NONE - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_input), INTENT(IN) :: input TYPE(t_noco), INTENT(IN) :: noco TYPE(t_atoms), INTENT(IN) :: atoms @@ -37,9 +37,9 @@ CONTAINS COMPLEX qlo(noccbd,atoms%nlod,atoms%nlod,atoms%ntype) COMPLEX qaclo(noccbd,atoms%nlod,atoms%ntype),qbclo(noccbd,atoms%nlod,atoms%ntype) COMPLEX qcloa(noccbd,atoms%nlod,atoms%ntype),qclob(noccbd,atoms%nlod,atoms%ntype) - COMPLEX qal21(0:3,atoms%ntype,dimension%neigd) + COMPLEX qal21(0:3,atoms%ntype,input%neig) COMPLEX q_loc(2,2),q_hlp(2,2),chi(2,2) - REAL qmat(0:3,atoms%ntype,dimension%neigd,4) + REAL qmat(0:3,atoms%ntype,input%neig,4) ! .. Intrinsic Functions .. INTRINSIC conjg diff --git a/cdn/vacden.F90 b/cdn/vacden.F90 index 59b80af2..ae5525d7 100644 --- a/cdn/vacden.F90 +++ b/cdn/vacden.F90 @@ -5,7 +5,7 @@ MODULE m_vacden ! vacuum charge density. speed up by r. wu 1992 ! ************************************************************* CONTAINS - SUBROUTINE vacden(vacuum,DIMENSION,stars,oneD,kpts,input,sym,cell,atoms,noco,banddos,& + SUBROUTINE vacden(vacuum,stars,oneD,kpts,input,sym,cell,atoms,noco,banddos,& gVacMap,we,ikpt,jspin,vz,ne,ev_list,lapw,evac,eig,den,zMat,dos) !*********************************************************************** @@ -13,10 +13,10 @@ CONTAINS ! ****** change vacden(......,dos%qstars) for starcoefficients, shz. Jan.99 ! ****** changed for fleur dw ! In non-collinear calculations the density becomes a hermitian 2x2 - ! matrix. This subroutine generates this density matrix in the + ! matrix. This subroutine generates this density matrix in the ! vacuum region. The diagonal elements of this matrix (n_11 & n_22) ! are store in den%vacz and den%vacxy, while the real and imaginary part - ! of the off-diagonal element are stored in den%vacz(:,:,3:4) and den%vacxy(:,:,:,3). + ! of the off-diagonal element are stored in den%vacz(:,:,3:4) and den%vacxy(:,:,:,3). ! ! Philipp Kurz 99/07 !*********************************************************************** @@ -48,7 +48,7 @@ CONTAINS USE m_types IMPLICIT NONE TYPE(t_lapw),INTENT(INOUT) :: lapw !for some reason the second spin data is reset in noco case - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_banddos),INTENT(IN) :: banddos TYPE(t_input),INTENT(IN) :: input @@ -64,23 +64,23 @@ CONTAINS TYPE(t_potden),INTENT(INOUT) :: den TYPE(t_dos), INTENT(INOUT) :: dos ! .. Scalar Arguments .. - INTEGER, INTENT (IN) :: jspin - INTEGER, INTENT (IN) :: ne + INTEGER, INTENT (IN) :: jspin + INTEGER, INTENT (IN) :: ne INTEGER, INTENT (IN) :: ikpt INTEGER,PARAMETER :: n2max=13 REAL,PARAMETER :: emax=2.0/hartree_to_ev_const ! .. Array Arguments .. INTEGER, INTENT(IN) :: ev_list(ne) REAL, INTENT(IN) :: evac(2,input%jspins) - REAL, INTENT(IN) :: we(DIMENSION%neigd) + REAL, INTENT(IN) :: we(input%neig) REAL :: vz(vacuum%nmzd,2) ! Note this breaks the INTENT(IN) from cdnval. It may be read from a file in this subroutine. ! STM-Arguments - REAL, INTENT (IN) :: eig(DIMENSION%neigd) + REAL, INTENT (IN) :: eig(input%neig) ! local STM variables INTEGER nv2(input%jspins) - INTEGER kvac1(DIMENSION%nv2d,input%jspins),kvac2(DIMENSION%nv2d,input%jspins),map2(DIMENSION%nvd,input%jspins) - INTEGER kvac3(DIMENSION%nv2d,input%jspins),map1(DIMENSION%nvd,input%jspins) - INTEGER mapg2k(DIMENSION%nv2d) + INTEGER kvac1(lapw%dim_nv2d(),input%jspins),kvac2(lapw%dim_nv2d(),input%jspins),map2(lapw%dim_nvd(),input%jspins) + INTEGER kvac3(lapw%dim_nv2d(),input%jspins),map1(lapw%dim_nvd(),input%jspins) + INTEGER mapg2k(lapw%dim_nv2d()) ! .. Local Scalars .. COMPLEX aa,ab,av,ba,bb,bv,t1,aae,bbe,abe,bae,aaee,bbee,abee,baee,& & factorx,factory,c_1,aa_1,ab_1,ba_1,bb_1,ic,av_1,bv_1,d,tempCmplx @@ -120,12 +120,12 @@ CONTAINS ! izlay : defines vertical position of layers in delz (=0.1 a.u.) units from begining of vacuum region ! vacdos: =T: calculate vacuum dos in layers as given by the above ! integ : =T: integrate in vertical position between izlay(layer,1)..izlay(layer,2) - ! nstm : 0: s-Tip, 1: p_z-Tip, 2: d_z^2-Tip (following Chen's derivative rule) ->rhzgrd.f is used - ! to calculate derivatives + ! nstm : 0: s-Tip, 1: p_z-Tip, 2: d_z^2-Tip (following Chen's derivative rule) ->rhzgrd.f is used + ! to calculate derivatives ! tworkf: Workfunction of Tip (in hartree units) is needed for d_z^2-Orbital) - ! starcoeff: =T: star coefficients are calculated at values of izlay for 0th (=q) to nstars-1. star + ! starcoeff: =T: star coefficients are calculated at values of izlay for 0th (=q) to nstars-1. star ! (dos%qstars(1..nstars-1)) - ! nstars: number of star functions to be used (0th star is given by value of q=charge integrated in 2D) + ! nstars: number of star functions to be used (0th star is given by value of q=charge integrated in 2D) ! ! further possibility: (readin of locx, locy has to be implemented in flapw7.f or they have to be set explicitly) ! @@ -133,31 +133,31 @@ CONTAINS ! within a restricted area of the 2D unit cell, the corners of this area is given by locx and locy ! they are defined in internal coordinates, i.e. \vec{r}_1=locx(1)*\vec{a}_1+locy(1)*\vec{a}_2 ! \vec{r}_2=locx(2)*\vec{a}_1+locy(2)*\vec{a}_2 - ! \vec{a}_1,2 are the 2D lattice vectors - ! + ! \vec{a}_1,2 are the 2D lattice vectors + ! ! ************************************************************************************************** CALL timestart("vacden") - ALLOCATE ( ac(DIMENSION%nv2d,DIMENSION%neigd,input%jspins),bc(DIMENSION%nv2d,DIMENSION%neigd,input%jspins),dt(DIMENSION%nv2d),& - & dte(DIMENSION%nv2d),du(vacuum%nmzd),ddu(vacuum%nmzd,DIMENSION%nv2d),due(vacuum%nmzd),& - & ddue(vacuum%nmzd,DIMENSION%nv2d),t(DIMENSION%nv2d),te(DIMENSION%nv2d),& - & tei(DIMENSION%nv2d,input%jspins),u(vacuum%nmzd,DIMENSION%nv2d,input%jspins),ue(vacuum%nmzd,DIMENSION%nv2d,input%jspins),& + ALLOCATE ( ac(lapw%dim_nv2d(),input%neig,input%jspins),bc(lapw%dim_nv2d(),input%neig,input%jspins),dt(lapw%dim_nv2d()),& + & dte(lapw%dim_nv2d()),du(vacuum%nmzd),ddu(vacuum%nmzd,lapw%dim_nv2d()),due(vacuum%nmzd),& + & ddue(vacuum%nmzd,lapw%dim_nv2d()),t(lapw%dim_nv2d()),te(lapw%dim_nv2d()),& + & tei(lapw%dim_nv2d(),input%jspins),u(vacuum%nmzd,lapw%dim_nv2d(),input%jspins),ue(vacuum%nmzd,lapw%dim_nv2d(),input%jspins),& & v(3),yy(vacuum%nmzd)) IF (oneD%odi%d1) THEN - ALLOCATE ( ac_1(DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb,DIMENSION%neigd,input%jspins),& - & bc_1(DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb,DIMENSION%neigd,input%jspins),& - & dt_1(DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb),& - & dte_1(DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb),& + ALLOCATE ( ac_1(lapw%dim_nv2d(),-oneD%odi%mb:oneD%odi%mb,input%neig,input%jspins),& + & bc_1(lapw%dim_nv2d(),-oneD%odi%mb:oneD%odi%mb,input%neig,input%jspins),& + & dt_1(lapw%dim_nv2d(),-oneD%odi%mb:oneD%odi%mb),& + & dte_1(lapw%dim_nv2d(),-oneD%odi%mb:oneD%odi%mb),& & du_1(vacuum%nmzd,-oneD%odi%mb:oneD%odi%mb),& - & ddu_1(vacuum%nmzd,DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb),& + & ddu_1(vacuum%nmzd,lapw%dim_nv2d(),-oneD%odi%mb:oneD%odi%mb),& & due_1(vacuum%nmzd,-oneD%odi%mb:oneD%odi%mb),& - & ddue_1(vacuum%nmzd,DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb),& - & t_1(DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb),& - & te_1(DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb),& - & tei_1(DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb,input%jspins),& - & u_1(vacuum%nmzd,DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb,input%jspins),& - & ue_1(vacuum%nmzd,DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb,input%jspins) ) + & ddue_1(vacuum%nmzd,lapw%dim_nv2d(),-oneD%odi%mb:oneD%odi%mb),& + & t_1(lapw%dim_nv2d(),-oneD%odi%mb:oneD%odi%mb),& + & te_1(lapw%dim_nv2d(),-oneD%odi%mb:oneD%odi%mb),& + & tei_1(lapw%dim_nv2d(),-oneD%odi%mb:oneD%odi%mb,input%jspins),& + & u_1(vacuum%nmzd,lapw%dim_nv2d(),-oneD%odi%mb:oneD%odi%mb,input%jspins),& + & ue_1(vacuum%nmzd,lapw%dim_nv2d(),-oneD%odi%mb:oneD%odi%mb,input%jspins) ) END IF ! oneD%odi%d1 ! @@ -165,7 +165,7 @@ CONTAINS eps=0.01 ic = CMPLX(0.,1.) ! ------------------ - + ! -----> set up mapping arrays IF (noco%l_ss) THEN jsp_start = 1 @@ -185,7 +185,7 @@ CONTAINS END IF ENDDO n2 = n2 + 1 - IF (n2>DIMENSION%nv2d) CALL juDFT_error("vacden0",calledby ="vacden") + IF (n2>lapw%dim_nv2d()) CALL juDFT_error("vacden0",calledby ="vacden") kvac3(n2,ispin) = lapw%k3(k,ispin) map1(k,ispin) = n2 ENDDO k_loop @@ -201,7 +201,7 @@ CONTAINS END IF ENDDO n2 = n2 + 1 - IF (n2>DIMENSION%nv2d) CALL juDFT_error("vacden0","vacden") + IF (n2>lapw%dim_nv2d()) CALL juDFT_error("vacden0","vacden") kvac1(n2,ispin) = lapw%gvec(1,k,ispin) kvac2(n2,ispin) = lapw%gvec(2,k,ispin) map2(k,ispin) = n2 @@ -229,7 +229,7 @@ CONTAINS ENDIF !+dw - ! if tunneling current should be calculated we need to write out + ! if tunneling current should be calculated we need to write out ! info on electronic structure: --> mapping from kvac to gvac by mapg2k ! shz, Jan.99 IF (vacuum%nstm.EQ.3) THEN @@ -242,7 +242,7 @@ CONTAINS END IF ! !-dw - + wronk = 2.0 const = 1.0 / ( SQRT(cell%omtil)*wronk ) @@ -256,7 +256,7 @@ CONTAINS ac(:,:,:) = CMPLX(0.0,0.0) bc(:,:,:) = CMPLX(0.0,0.0) sign = 3. - 2.*ivac - + IF (noco%l_noco) THEN !---> In a non-collinear calculation vacden is only called once. !---> Thus, the vaccum wavefunctions and the A- and B-coeff. (ac bc) @@ -272,18 +272,18 @@ CONTAINS ! -----> set up vacuum wave functions IF (oneD%odi%d1) THEN CALL od_abvac(& - cell,vacuum,DIMENSION,stars,& + cell,vacuum,stars,& oneD,qssbti(3,ispin),& oneD%odi%n2d,& wronk,evacp,lapw%bkpt,oneD%odi%M,oneD%odi%mb,& - vz(1,ispin),kvac3(1,ispin),nv2(ispin),& - t_1(1,-oneD%odi%mb),dt_1(1,-oneD%odi%mb),u_1(1,1,-oneD%odi%mb,ispin),& - te_1(1,-oneD%odi%mb),dte_1(1,-oneD%odi%mb),& - tei_1(1,-oneD%odi%mb,ispin),& - ue_1(1,1,-oneD%odi%mb,ispin)) + vz(1,ispin),kvac3(:,ispin),nv2(ispin),& + t_1(:,-oneD%odi%mb:),dt_1(:,-oneD%odi%mb:),u_1(:,:,-oneD%odi%mb:,ispin),& + te_1(:,-oneD%odi%mb:),dte_1(:,-oneD%odi%mb:),& + tei_1(:,-oneD%odi%mb:,ispin),& + ue_1(:,:,-oneD%odi%mb:,ispin)) DO k = 1,lapw%nv(ispin) kspin = (lapw%nv(1)+atoms%nlotot)*(ispin-1) + k - l = map1(k,ispin) + l = map1(k,ispin) irec3 = stars%ig(lapw%gvec(1,k,ispin),lapw%gvec(2,k,ispin),lapw%gvec(3,k,ispin)) IF (irec3.NE.0) THEN irec2 = stars%ig2(irec3) @@ -342,8 +342,8 @@ CONTAINS zks = lapw%k3(k,ispin)*cell%bmat(3,3)*sign arg = zks*cell%z1 c_1 = CMPLX(COS(arg),SIN(arg)) * const - av = -c_1 * CMPLX( dte(l),zks*te(l) ) - bv = c_1 * CMPLX( dt(l),zks* t(l) ) + av = -c_1 * CMPLX( dte(l),zks*te(l) ) + bv = c_1 * CMPLX( dt(l),zks* t(l) ) ! -----> loop over basis functions IF (zmat%l_real) THEN ac(l,:ne,ispin) = ac(l,:ne,ispin) + zMat%data_r(kspin,:ne)*av @@ -374,15 +374,15 @@ CONTAINS qssbtii = 0. evacp = evac(ivac,jspin) CALL od_abvac(& - & cell,vacuum,DIMENSION,stars,& + & cell,vacuum,stars,& & oneD,qssbtii,& & oneD%odi%n2d,& & wronk,evacp,lapw%bkpt,oneD%odi%M,oneD%odi%mb,& - & vz(1,ivac),kvac3(1,jspin),nv2(jspin),& - & t_1(1,-oneD%odi%mb),dt_1(1,-oneD%odi%mb),u_1(1,1,-oneD%odi%mb,jspin),& - & te_1(1,-oneD%odi%mb),dte_1(1,-oneD%odi%mb),& - & tei_1(1,-oneD%odi%mb,jspin),& - & ue_1(1,1,-oneD%odi%mb,jspin)) + & vz(:,ivac),kvac3(:,jspin),nv2(jspin),& + & t_1(:,-oneD%odi%mb:),dt_1(:,-oneD%odi%mb:),u_1(:,:,-oneD%odi%mb:,jspin),& + & te_1(:,-oneD%odi%mb:),dte_1(:,-oneD%odi%mb:),& + & tei_1(:,-oneD%odi%mb:,jspin),& + & ue_1(:,:,-oneD%odi%mb:,jspin)) DO k = 1,lapw%nv(jspin) l = map1(k,jspin) irec3 = stars%ig(lapw%gvec(1,k,jspin),lapw%gvec(2,k,jspin),lapw%gvec(3,k,jspin)) @@ -437,8 +437,8 @@ CONTAINS zks = lapw%k3(k,jspin)*cell%bmat(3,3)*sign arg = zks*cell%z1 c_1 = CMPLX(COS(arg),SIN(arg)) * const - av = -c_1 * CMPLX( dte(l),zks*te(l) ) - bv = c_1 * CMPLX( dt(l),zks* t(l) ) + av = -c_1 * CMPLX( dte(l),zks*te(l) ) + bv = c_1 * CMPLX( dt(l),zks* t(l) ) ! -----> loop over basis functions IF (zmat%l_real) THEN ac(l,:ne,jspin) = ac(l,:ne,jspin) + zMat%data_r(k,:ne)*av @@ -451,13 +451,13 @@ CONTAINS END IF ! D1 ENDIF ! - ! ----> calculate first and second derivative of u,ue + ! ----> calculate first and second derivative of u,ue ! in order to simulate p_z or d_z^2 Tip in Chen's model , shz. 97 - ! + ! IF (vacuum%nstm.GT.0) THEN DO ik = 1,nv2(jspin) ! CALL rhzgrd(nmz,delz,u(1,ik,jspin),4,du,ddu(1,ik)) - ! CALL rhzgrd(nmz,delz,ue(1,ik,jspin),4,due,ddue(1,ik)) + ! CALL rhzgrd(nmz,delz,ue(1,ik,jspin),4,due,ddue(1,ik)) ALLOCATE ( dummy(vacuum%nmz) ) CALL grdchlh(& @@ -480,7 +480,7 @@ CONTAINS ! ! --> to calculate Tunneling Current between two systems ! within Bardeens Approach one needs ac(l,n), bc(l,n); - ! they are written to the file vacwave + ! they are written to the file vacwave ! IF nstm=3 ! tworkf is then the fermi energy (in hartree) ! @@ -540,11 +540,11 @@ CONTAINS aaee=aa*vacuum%tworkf*vacuum%tworkf*4/9 bbee=bb*vacuum%tworkf*vacuum%tworkf*4/9 abee=ab*vacuum%tworkf*vacuum%tworkf*4/9 - baee=ba*vacuum%tworkf*vacuum%tworkf*4/9 + baee=ba*vacuum%tworkf*vacuum%tworkf*4/9 DO jz = 1,vacuum%nmz ui = u(jz,l,jspin) uei = ue(jz,l,jspin) - ddui = ddu(jz,l) + ddui = ddu(jz,l) dduei = ddue(jz,l) den%vacz(jz,ivac,jspin) = den%vacz(jz,ivac,jspin) +& REAL(aaee*ui*ui+bbee*uei*uei+& @@ -556,7 +556,7 @@ CONTAINS ENDDO END DO ! - ! -----> s-Tip: |psi|^2 and p-Tip: |d(psi)/dz|^2 + ! -----> s-Tip: |psi|^2 and p-Tip: |d(psi)/dz|^2 ! ELSE IF (noco%l_noco) THEN @@ -588,7 +588,7 @@ CONTAINS END DO END DO END DO - ELSE + ELSE DO l = 1,nv2(ispin) aa = 0.0 bb = 0.0 @@ -660,7 +660,7 @@ CONTAINS ! ! ****************** change for vacuum density of states shz Jan.96 *** ! - IF (banddos%vacdos) THEN + IF (banddos%vacdos) THEN ! ! ----> d_z^2-Tip needs: |d^2(psi)/dz^2 - kappa^2/3 psi|^2 ! @@ -682,7 +682,7 @@ CONTAINS DO jj = 1,vacuum%layers ! ! ----> either integrated LDOS(z1,z2) or LDOS(z1) - ! + ! IF (input%integ) THEN ll = 1 DO ii = vacuum%izlay(jj,1),vacuum%izlay(jj,2) @@ -698,7 +698,7 @@ CONTAINS CALL qsf(vacuum%delz,yy,RESULT,ll-1,0) dos%qvlay(ev_list(n),jj,ivac,ikpt,jspin) = dos%qvlay(ev_list(n),jj,ivac,ikpt,jspin) + RESULT(1) ELSE - ui = u(vacuum%izlay(jj,1),l,jspin) + ui = u(vacuum%izlay(jj,1),l,jspin) uei = ue(vacuum%izlay(jj,1),l,jspin) ddui = ddu(vacuum%izlay(jj,1),l) dduei = ddue(vacuum%izlay(jj,1),l) @@ -712,12 +712,12 @@ CONTAINS END DO END DO END DO - ! + ! ! ----> s-Tip = calculate LDOS and(!) p_z-Tip (since u->du/dz, ue->due/dz) - ! - ELSE + ! + ELSE IF (ABS(vacuum%locx(1)-vacuum%locx(2)).LE.eps) THEN - ! + ! ! ----> integrated over 2D-unit cell ! IF (noco%l_noco) THEN @@ -733,11 +733,11 @@ CONTAINS aa = CONJG(ac(l,n,ispin))*ac(l,n,ispin) bb = CONJG(bc(l,n,ispin))*bc(l,n,ispin) ab = CONJG(ac(l,n,ispin))*bc(l,n,ispin) - ba = CONJG(bc(l,n,ispin))*ac(l,n,ispin) + ba = CONJG(bc(l,n,ispin))*ac(l,n,ispin) DO jj = 1,vacuum%layers - ! + ! ! ---> either integrated (z1,z2) or slice (z1) - ! + ! IF (input%integ) THEN ll = 1 DO ii = vacuum%izlay(jj,1),vacuum%izlay(jj,2) @@ -749,7 +749,7 @@ CONTAINS CALL qsf(vacuum%delz,yy,RESULT,ll-1,0) dos%qvlay(ev_list(n),jj,ivac,ikpt,ispin) = dos%qvlay(ev_list(n),jj,ivac,ikpt,ispin) + RESULT(1) ELSE - ui = u(vacuum%izlay(jj,1),l,ispin) + ui = u(vacuum%izlay(jj,1),l,ispin) uei = ue(vacuum%izlay(jj,1),l,ispin) dos%qvlay(ev_list(n),jj,ivac,ikpt,ispin) = dos%qvlay(ev_list(n),jj,ivac,ikpt,ispin) + REAL(& aa*ui*ui+bb*uei*uei+(ab+ba)*ui*uei) @@ -760,11 +760,11 @@ CONTAINS END DO ENDDO ELSE - ! + ! ! ----> if LDOS should be calculated over restricted area of the 2D-unit cell ! lower left corner: (locx(1), locy(1)) } in internal ! upper right corner: (locx(2), locy(2)) } coordinates - ! + ! DO l=1, nv2(jspin) DO l1=1, nv2(jspin) IF (kvac1(l,jspin).EQ.kvac1(l1,jspin)) THEN @@ -791,11 +791,11 @@ CONTAINS aa = CONJG(ac(l1,n,jspin))*ac(l,n,jspin) bb = CONJG(bc(l1,n,jspin))*bc(l,n,jspin) ab = CONJG(ac(l1,n,jspin))*bc(l,n,jspin) - ba = CONJG(bc(l1,n,jspin))*ac(l,n,jspin) + ba = CONJG(bc(l1,n,jspin))*ac(l,n,jspin) DO jj = 1,vacuum%layers - ! + ! ! ---> either integrated (z1,z2) or slice (z1) - ! + ! IF (input%integ) THEN ll = 1 DO ii = vacuum%izlay(jj,1), vacuum%izlay(jj,2) @@ -809,7 +809,7 @@ CONTAINS CALL qsf(vacuum%delz,yy,RESULT,ll-1,0) dos%qvlay(ev_list(n),jj,ivac,ikpt,jspin) = dos%qvlay(ev_list(n),jj,ivac,ikpt,jspin) + RESULT(1) ELSE - ui = u(vacuum%izlay(jj,1),l,jspin) + ui = u(vacuum%izlay(jj,1),l,jspin) uei = ue(vacuum%izlay(jj,1),l,jspin) uj = u(vacuum%izlay(jj,1),l1,jspin) uej = ue(vacuum%izlay(jj,1),l1,jspin) @@ -876,7 +876,7 @@ CONTAINS + aae*(ui*dduj+uj*ddui)+bbe*(uei*dduej+uej*dduei)& + abe*(ui*dduej+uj*dduei)+bae*(ddui*uej+dduj*uei)& + aa*ddui*dduj+bb*dduei*dduej+ba*ddui*dduej& - + ab*dduei*dduj + + ab*dduei*dduj den%vacxy(jz,ind2-1,ivac,jspin) = den%vacxy(jz,ind2-1,ivac,jspin) + t1*phs/stars%nstr2(ind2) den%vacxy(jz,ind2p-1,ivac,jspin)= den%vacxy(jz,ind2p-1,ivac,jspin) + CONJG(t1)*phsp/stars%nstr2(ind2p) ENDDO @@ -909,7 +909,7 @@ CONTAINS bb = CMPLX(0.,0.) ba = CMPLX(0.,0.) ab = CMPLX(0.,0.) - DO n = 1,ne + DO n = 1,ne aa=aa+we(n)*CONJG(ac_1(l1,m1,n,ispin))*ac_1(l,m,n,ispin) bb=bb+we(n)*CONJG(bc_1(l1,m1,n,ispin))*bc_1(l,m,n,ispin) ab=ab+we(n)*CONJG(ac_1(l1,m1,n,ispin))*bc_1(l,m,n,ispin) @@ -1174,7 +1174,7 @@ CONTAINS END IF !============================================================= ! - ! calculate 1. to nstars. starcoefficient for each k and energy eigenvalue + ! calculate 1. to nstars. starcoefficient for each k and energy eigenvalue ! to dos%qstars(ne,layer,ivac,ikpt) if starcoeff=T (the star coefficient values are written to vacdos) ! IF (vacuum%starcoeff .AND. banddos%vacdos) THEN diff --git a/cdn_mt/abclocdn.F90 b/cdn_mt/abclocdn.F90 index a9867e16..c73d58d8 100644 --- a/cdn_mt/abclocdn.F90 +++ b/cdn_mt/abclocdn.F90 @@ -46,8 +46,8 @@ CONTAINS REAL, INTENT (IN) :: alo1(:),blo1(:),clo1(:) COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 ) COMPLEX, INTENT (IN) :: ccchi(2) - COMPLEX, INTENT (INOUT) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat) - COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat) + COMPLEX, INTENT (INOUT) :: acof(:,0:,:)!(nobd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat) + COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)!(nobd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat) COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%nat) REAL, OPTIONAL, INTENT (IN) :: fgp(3) diff --git a/cdn_mt/abclocdn_pulay.F90 b/cdn_mt/abclocdn_pulay.F90 index 6d21291a..397f43ac 100644 --- a/cdn_mt/abclocdn_pulay.F90 +++ b/cdn_mt/abclocdn_pulay.F90 @@ -39,13 +39,13 @@ CONTAINS REAL, INTENT (IN) :: clo1(atoms%nlod,atoms%ntype) REAL, INTENT (IN) :: fgp(3) COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 ),ccchi(2) - COMPLEX, INTENT (INOUT) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat) - COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat) + COMPLEX, INTENT (INOUT) :: acof(:,0:,:)!(nobd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat) + COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)!(nobd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat) COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-llod:llod,nobd,atoms%nlod,atoms%nat) COMPLEX, INTENT (INOUT) :: acoflo(-atoms%llod:,:,:,:) COMPLEX, INTENT (INOUT) :: bcoflo(-atoms%llod:,:,:,:) - COMPLEX, INTENT (INOUT) :: aveccof(:,:,0:,:)!(3,nobd,0:dimension%lmd,atoms%nat) - COMPLEX, INTENT (INOUT) :: bveccof(:,:,0:,:)!(3,nobd,0:dimension%lmd,atoms%nat) + COMPLEX, INTENT (INOUT) :: aveccof(:,:,0:,:)!(3,nobd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat) + COMPLEX, INTENT (INOUT) :: bveccof(:,:,0:,:)!(3,nobd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat) COMPLEX, INTENT (INOUT) :: cveccof(:,-atoms%llod:,:,:,:)!(3,-atoms%llod:llod,nobd,atoms%nlod,atoms%nat) LOGICAL, INTENT (OUT) :: enough(atoms%nat) INTEGER :: nkvec(atoms%nlod,atoms%nat) diff --git a/cdn_mt/abcof.F90 b/cdn_mt/abcof.F90 index e01c6289..e703dc4b 100644 --- a/cdn_mt/abcof.F90 +++ b/cdn_mt/abcof.F90 @@ -33,10 +33,10 @@ CONTAINS INTEGER, INTENT (IN) :: jspin ! .. ! .. Array Arguments .. - COMPLEX, INTENT (OUT) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat) - COMPLEX, INTENT (OUT) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat) + COMPLEX, INTENT (OUT) :: acof(:,0:,:)!(nobd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat) + COMPLEX, INTENT (OUT) :: bcof(:,0:,:)!(nobd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat) COMPLEX, INTENT (OUT) :: ccof(-atoms%llod:,:,:,:)!(-llod:llod,nobd,atoms%nlod,atoms%nat) - REAL, OPTIONAL, INTENT (IN) :: eig(:)!(dimension%neigd) + REAL, OPTIONAL, INTENT (IN) :: eig(:)!(input%neig) ! .. ! .. Local Scalars .. COMPLEX cexp,phase,c_0,c_1,c_2 diff --git a/cdn_mt/abcof3.F90 b/cdn_mt/abcof3.F90 index 2bf084eb..79fdb091 100644 --- a/cdn_mt/abcof3.F90 +++ b/cdn_mt/abcof3.F90 @@ -29,8 +29,8 @@ CONTAINS ! .. Array Arguments .. REAL, INTENT (IN) :: bkpt(3) - COMPLEX, INTENT (OUT):: a(:,0:,:)!(dimension%nvd,0:dimension%lmd,atoms%nat) - COMPLEX, INTENT (OUT):: b(:,0:,:)!(dimension%nvd,0:dimension%lmd,atoms%nat) + COMPLEX, INTENT (OUT):: a(:,0:,:)!(lapw%dim_nvd(),0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat) + COMPLEX, INTENT (OUT):: b(:,0:,:)!(lapw%dim_nvd(),0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat) COMPLEX, INTENT (OUT):: bascof_lo(3,-atoms%llod:atoms%llod,4*atoms%llod+2,atoms%nlod,atoms%nat) ! .. Local Scalars .. COMPLEX phase,c_0,c_1,c_2 diff --git a/cdn_mt/cdncore.F90 b/cdn_mt/cdncore.F90 index b92c678b..6984536c 100644 --- a/cdn_mt/cdncore.F90 +++ b/cdn_mt/cdncore.F90 @@ -8,7 +8,7 @@ MODULE m_cdncore CONTAINS -SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,& +SUBROUTINE cdncore(mpi,oneD,input,vacuum,noco,sym,& stars,cell,sphhar,atoms,vTot,outDen,moments,results, EnergyDen) USE m_constants @@ -29,7 +29,7 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,& TYPE(t_mpi), INTENT(IN) :: mpi - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_oneD), INTENT(IN) :: oneD TYPE(t_input), INTENT(IN) :: input TYPE(t_vacuum), INTENT(IN) :: vacuum @@ -76,10 +76,10 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,& qint = 0.0 IF (input%frcor) THEN IF (mpi%irank==0) THEN - CALL readCoreDensity(input,atoms,dimension,rh,tec,qint) + CALL readCoreDensity(input,atoms,rh,tec,qint) END IF #ifdef CPP_MPI - CALL mpi_bc_coreDen(mpi,atoms,input,dimension,rh,tec,qint) + CALL mpi_bc_coreDen(mpi,atoms,input,rh,tec,qint) #endif END IF END IF @@ -89,9 +89,9 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,& IF (input%kcrel==0) THEN DO jspin = 1,input%jspins IF(PRESENT(EnergyDen)) THEN - CALL cored(input,jspin,atoms,outDen%mt,dimension,sphhar,vTot%mt(:,0,:,jspin), qint,rh ,tec,seig, EnergyDen%mt) + CALL cored(input,jspin,atoms,outDen%mt,sphhar,vTot%mt(:,0,:,jspin), qint,rh ,tec,seig, EnergyDen%mt) ELSE - CALL cored(input,jspin,atoms,outDen%mt,dimension,sphhar,vTot%mt(:,0,:,jspin), qint,rh ,tec,seig) + CALL cored(input,jspin,atoms,outDen%mt,sphhar,vTot%mt(:,0,:,jspin), qint,rh ,tec,seig) ENDIF rhTemp(:,:,jspin) = rh(:,:,jspin) @@ -99,7 +99,7 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,& END DO ELSE IF(PRESENT(EnergyDen)) call juDFT_error("Energyden not implemented for relativistic core calculations") - CALL coredr(input,atoms,seig, outDen%mt,dimension,sphhar,vTot%mt(:,0,:,:),qint,rh) + CALL coredr(input,atoms,seig, outDen%mt,sphhar,vTot%mt(:,0,:,:),qint,rh) results%seigc = results%seigc + seig END IF END IF @@ -135,7 +135,7 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,& IF (input%ctail) THEN IF(PRESENT(EnergyDen)) call juDFT_error("Energyden not implemented for ctail") !+gu hope this works as well - CALL cdnovlp(mpi,sphhar,stars,atoms,sym,dimension,vacuum,& + CALL cdnovlp(mpi,sphhar,stars,atoms,sym,vacuum,& cell,input,oneD,l_st,jspin,rh(:,:,jspin),& outDen%pw,outDen%vacxy,outDen%mt,outDen%vacz) ELSE IF (mpi%irank==0) THEN @@ -148,7 +148,7 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,& IF (input%kcrel==0) THEN IF (mpi%irank==0) THEN - CALL writeCoreDensity(input,atoms,dimension,rhTemp,tec,qint) + CALL writeCoreDensity(input,atoms,rhTemp,tec,qint) END IF IF ((input%gw==1 .or. input%gw==3).AND.(mpi%irank==0)) CLOSE(15) END IF diff --git a/cdn_mt/magMoms.f90 b/cdn_mt/magMoms.f90 index 9a1e2dd6..77fb0cab 100644 --- a/cdn_mt/magMoms.f90 +++ b/cdn_mt/magMoms.f90 @@ -8,7 +8,7 @@ MODULE m_magMoms CONTAINS -SUBROUTINE magMoms(dimension,input,atoms,noco,vTot,moments) +SUBROUTINE magMoms(input,atoms,noco,vTot,moments) USE m_types USE m_xmlOutput @@ -16,7 +16,7 @@ SUBROUTINE magMoms(dimension,input,atoms,noco,vTot,moments) IMPLICIT NONE - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_input), INTENT(IN) :: input TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_noco), INTENT(INOUT) :: noco diff --git a/core/cored.F90 b/core/cored.F90 index aafea310..91678436 100644 --- a/core/cored.F90 +++ b/core/cored.F90 @@ -1,6 +1,6 @@ MODULE m_cored CONTAINS - SUBROUTINE cored(input, jspin, atoms, rho, DIMENSION, sphhar, vr, qint, rhc, tec, seig, EnergyDen) + SUBROUTINE cored(input, jspin, atoms, rho, sphhar, vr, qint, rhc, tec, seig, EnergyDen) ! ******************************************************* ! ***** set up the core densities for compounds. ***** ! ***** d.d.koelling ***** @@ -13,7 +13,7 @@ CONTAINS USE m_types USE m_xmlOutput IMPLICIT NONE - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_input),INTENT(IN) :: input TYPE(t_sphhar),INTENT(IN) :: sphhar TYPE(t_atoms),INTENT(IN) :: atoms diff --git a/core/coredr.F90 b/core/coredr.F90 index 18c56236..34839093 100644 --- a/core/coredr.F90 +++ b/core/coredr.F90 @@ -1,6 +1,6 @@ MODULE m_coredr CONTAINS - SUBROUTINE coredr(input,atoms,seig, rho,DIMENSION,sphhar, vrs, qints,rhc) + SUBROUTINE coredr(input,atoms,seig, rho,sphhar, vrs, qints,rhc) ! ******************************************************* ! ***** set up the core densities for compounds ***** ! ***** for relativistic core ***** @@ -12,7 +12,7 @@ CONTAINS USE m_cdn_io USE m_types IMPLICIT NONE - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_input),INTENT(IN) :: input TYPE(t_sphhar),INTENT(IN) :: sphhar TYPE(t_atoms),INTENT(IN) :: atoms @@ -73,7 +73,7 @@ CONTAINS END DO ELSE OPEN (58,file='core.dat',form='formatted',status='new') - CALL etabinit(atoms,DIMENSION,input, vr, etab,ntab,ltab,nkmust) + CALL etabinit(atoms,input, vr, etab,ntab,ltab,nkmust) END IF ! ncmsh = atoms%msh @@ -166,6 +166,6 @@ CONTAINS END DO ! loop over atoms (jatom) ! !----> store core charge densities - CALL writeCoreDensity(input,atoms,dimension,rhcs,tecs,qints) + CALL writeCoreDensity(input,atoms,rhcs,tecs,qints) END SUBROUTINE coredr END MODULE m_coredr diff --git a/core/etabinit.F90 b/core/etabinit.F90 index 50482fc7..d0a0a6db 100644 --- a/core/etabinit.F90 +++ b/core/etabinit.F90 @@ -13,7 +13,7 @@ MODULE m_etabinit ! ntab & ltab transport this info to core.F gb`02 !------------------------------------------------------------ CONTAINS - SUBROUTINE etabinit(atoms,DIMENSION,input, vr,& + SUBROUTINE etabinit(atoms,input, vr,& etab,ntab,ltab,nkmust) USE m_constants, ONLY : c_light @@ -21,7 +21,7 @@ CONTAINS USE m_differ USE m_types IMPLICIT NONE - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_input),INTENT(IN) :: input ! diff --git a/diagonalization/chase_diag.F90 b/diagonalization/chase_diag.F90 index 3af02792..e74e4bb5 100644 --- a/diagonalization/chase_diag.F90 +++ b/diagonalization/chase_diag.F90 @@ -88,7 +88,7 @@ CONTAINS END SUBROUTINE chase_distance #ifdef CPP_CHASE - SUBROUTINE init_chase(mpi,DIMENSION,input,atoms,kpts,noco,l_real) + SUBROUTINE init_chase(mpi,input,atoms,kpts,noco,l_real) USE m_types_mpimat USE m_types_setup USE m_types_mpi @@ -98,7 +98,7 @@ CONTAINS 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 TYPE(t_kpts), INTENT(IN) :: kpts @@ -116,9 +116,9 @@ CONTAINS !ENDIF IF (TRIM(juDFT_string_for_argument("-diag"))=="chase") THEN - nevd = min(dimension%neigd,dimension%nvd+atoms%nlotot) - nexd = min(max(nevd/4, 45),dimension%nvd+atoms%nlotot-nevd) !dimensioning for workspace - chase_eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,nevd+nexd,kpts%nkpt,input%jspins,& + nevd = min(input%neig,lapw%dim_nvd()+atoms%nlotot) + nexd = min(max(nevd/4, 45),lapw%dim_nvd()+atoms%nlotot-nevd) !dimensioning for workspace + chase_eig_id=open_eig(mpi%mpi_comm,lapw%dim_nbasfcn(),nevd+nexd,kpts%nkpt,input%jspins,& noco%l_noco,.TRUE.,l_real,noco%l_soc,.FALSE.,mpi%n_size) END IF END SUBROUTINE init_chase diff --git a/docs/removed_files/old/hsmt_extra.F90 b/docs/removed_files/old/hsmt_extra.F90 index 45c48822..6f22eba7 100644 --- a/docs/removed_files/old/hsmt_extra.F90 +++ b/docs/removed_files/old/hsmt_extra.F90 @@ -8,7 +8,7 @@ MODULE m_hsmt_extra USE m_juDFT IMPLICIT NONE CONTAINS - SUBROUTINE hsmt_extra(DIMENSION,atoms,sym,isp,n_size,n_rank,input,nintsp,sub_comm,& + SUBROUTINE hsmt_extra(atoms,sym,isp,n_size,n_rank,input,nintsp,sub_comm,& hlpmsize,lmaxb,noco,l_socfirst, lapw,cell,el, fj,gj,gk,vk,tlmplm,usdus, vs_mmp,oneD,& !in kveclo,l_real,aa_r,bb_r,aa_c,bb_c) !out/inout USE m_constants, ONLY : tpi_const,fpi_const @@ -23,7 +23,7 @@ CONTAINS USE m_hsmt_hlptomat USE m_types IMPLICIT NONE - TYPE(t_dimension),INTENT(IN):: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco @@ -74,7 +74,7 @@ CONTAINS ! .. Local Arrays .. INTEGER kvec(2*(2*atoms%llod+1),atoms%nlod ) REAL alo1(atoms%nlod),blo1(atoms%nlod),clo1(atoms%nlod) - REAL bmrot(3,3),gkrot(DIMENSION%nvd,3),vmult(3),v(3) + REAL bmrot(3,3),gkrot(lapw%dim_nvd(),3),vmult(3),v(3) REAL qssbti(3) REAL, ALLOCATABLE :: ar(:,:,:),ai(:,:,:),br(:,:,:),bi(:,:,:) REAL, ALLOCATABLE :: rph(:,:),cph(:,:) @@ -93,12 +93,12 @@ CONTAINS ab_dim=1 IF ( noco%l_noco .AND. (.NOT. noco%l_ss) ) ALLOCATE ( aahlp(hlpmsize),bbhlp(hlpmsize) ) IF (noco%l_ss) ab_dim=2 - ALLOCATE(ar(DIMENSION%nvd,0:DIMENSION%lmd,ab_dim),ai(DIMENSION%nvd,0:DIMENSION%lmd,ab_dim)) - ALLOCATE(br(DIMENSION%nvd,0:DIMENSION%lmd,ab_dim),bi(DIMENSION%nvd,0:DIMENSION%lmd,ab_dim)) + ALLOCATE(ar(lapw%dim_nvd(),0:atoms%lmaxd*(atoms%lmaxd+2),ab_dim),ai(lapw%dim_nvd(),0:atoms%lmaxd*(atoms%lmaxd+2),ab_dim)) + ALLOCATE(br(lapw%dim_nvd(),0:atoms%lmaxd*(atoms%lmaxd+2),ab_dim),bi(lapw%dim_nvd(),0:atoms%lmaxd*(atoms%lmaxd+2),ab_dim)) ALLOCATE(alo(-atoms%llod:atoms%llod,2*(2*atoms%llod+1),atoms%nlod,ab_dim)) ALLOCATE(blo(-atoms%llod:atoms%llod,2*(2*atoms%llod+1),atoms%nlod,ab_dim)) ALLOCATE(clo(-atoms%llod:atoms%llod,2*(2*atoms%llod+1),atoms%nlod,ab_dim)) - ALLOCATE(rph(DIMENSION%nvd,ab_dim),cph(DIMENSION%nvd,ab_dim)) + ALLOCATE(rph(lapw%dim_nvd(),ab_dim),cph(lapw%dim_nvd(),ab_dim)) ALLOCATE(nkvec(atoms%nlod,ab_dim)) na = 0 nkvecprevats = 0 diff --git a/docs/removed_files/old/hsmt_nonsph.F90 b/docs/removed_files/old/hsmt_nonsph.F90 index 59d19581..5cdd933c 100644 --- a/docs/removed_files/old/hsmt_nonsph.F90 +++ b/docs/removed_files/old/hsmt_nonsph.F90 @@ -9,7 +9,7 @@ MODULE m_hsmt_nonsph IMPLICIT NONE CONTAINS - SUBROUTINE hsmt_nonsph(DIMENSION,atoms,sym,SUB_COMM, n_size,n_rank,input,isp,nintsp,& + SUBROUTINE hsmt_nonsph(atoms,sym,SUB_COMM, n_size,n_rank,input,isp,nintsp,& hlpmsize,noco,l_socfirst, lapw, cell,tlmplm, fj,gj,gk,vk,oneD,l_real,aa_r,aa_c) #include"cpp_double.h" @@ -19,7 +19,7 @@ CONTAINS USE m_hsmt_hlptomat USE m_types IMPLICIT NONE - TYPE(t_dimension),INTENT(IN):: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco @@ -59,7 +59,7 @@ CONTAINS ! .. Local Arrays .. COMPLEX,ALLOCATABLE :: aa_block(:,:) COMPLEX,ALLOCATABLE :: dtd(:,:),dtu(:,:),utd(:,:),utu(:,:) - REAL :: bmrot(3,3),gkrot(DIMENSION%nvd,3),vmult(3),v(3) + REAL :: bmrot(3,3),gkrot(lapw%dim_nvd(),3),vmult(3),v(3) COMPLEX:: ylm( (atoms%lmaxd+1)**2 ),chi(2,2) ! .. COMPLEX, ALLOCATABLE :: a(:,:,:),b(:,:,:),ax(:,:),bx(:,:) @@ -80,9 +80,9 @@ CONTAINS ab_dim=1 IF (noco%l_ss) ab_dim=2 - ALLOCATE(a(DIMENSION%nvd,0:DIMENSION%lmd,ab_dim),b(DIMENSION%nvd,0:DIMENSION%lmd,ab_dim)) - ALLOCATE(ax(DIMENSION%nvd,0:DIMENSION%lmd),bx(DIMENSION%nvd,0:DIMENSION%lmd)) - ALLOCATE(c_ph(DIMENSION%nvd,ab_dim)) + ALLOCATE(a(lapw%dim_nvd(),0:atoms%lmaxd*(atoms%lmaxd+2),ab_dim),b(lapw%dim_nvd(),0:atoms%lmaxd*(atoms%lmaxd+2),ab_dim)) + ALLOCATE(ax(lapw%dim_nvd(),0:atoms%lmaxd*(atoms%lmaxd+2)),bx(lapw%dim_nvd(),0:atoms%lmaxd*(atoms%lmaxd+2))) + ALLOCATE(c_ph(lapw%dim_nvd(),ab_dim)) print*,atoms%lnonsph ntyploop: DO n=1,atoms%ntype IF (noco%l_noco) THEN diff --git a/docs/removed_files/old/hsmt_nonsph_GPU.F90 b/docs/removed_files/old/hsmt_nonsph_GPU.F90 index e3299a3b..f40f7b9e 100644 --- a/docs/removed_files/old/hsmt_nonsph_GPU.F90 +++ b/docs/removed_files/old/hsmt_nonsph_GPU.F90 @@ -9,7 +9,7 @@ MODULE m_hsmt_nonsph_GPU IMPLICIT NONE CONTAINS - SUBROUTINE hsmt_nonsph_GPU(DIMENSION,atoms,sym,SUB_COMM, n_size,n_rank,input,isp,nintsp,& + SUBROUTINE hsmt_nonsph_GPU(atoms,sym,SUB_COMM, n_size,n_rank,input,isp,nintsp,& hlpmsize,noco,l_socfirst, lapw, cell,tlmplm, fj,gj,gk,vk,oneD,l_real,aa_r,aa_c) #include"cpp_double.h" @@ -23,7 +23,7 @@ CONTAINS USE cublas #endif IMPLICIT NONE - TYPE(t_dimension),INTENT(IN):: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco @@ -64,7 +64,7 @@ CONTAINS ! .. Local Arrays .. COMPLEX,ALLOCATABLE :: aa_block(:,:) COMPLEX,ALLOCATABLE :: dtd(:,:),dtu(:,:),utd(:,:),utu(:,:) - REAL :: bmrot(3,3),gkrot(DIMENSION%nvd,3),vmult(3),v(3) + REAL :: bmrot(3,3),gkrot(lapw%dim_nvd(),3),vmult(3),v(3) COMPLEX:: ylm( (atoms%lmaxd+1)**2 ),chi(2,2) ! .. #if defined(_OPENACC) @@ -96,9 +96,9 @@ CONTAINS ab_dim=1 IF (noco%l_ss) ab_dim=2 - ALLOCATE(a(DIMENSION%nvd,0:DIMENSION%lmd,ab_dim),b(DIMENSION%nvd,0:DIMENSION%lmd,ab_dim)) - ALLOCATE(ax(DIMENSION%nvd,0:DIMENSION%lmd),bx(DIMENSION%nvd,0:DIMENSION%lmd)) - ALLOCATE(c_ph(DIMENSION%nvd,ab_dim)) + ALLOCATE(a(lapw%dim_nvd(),0:atoms%lmaxd*(atoms%lmaxd+2),ab_dim),b(lapw%dim_nvd(),0:atoms%lmaxd*(atoms%lmaxd+2),ab_dim)) + ALLOCATE(ax(lapw%dim_nvd(),0:atoms%lmaxd*(atoms%lmaxd+2)),bx(lapw%dim_nvd(),0:atoms%lmaxd*(atoms%lmaxd+2))) + ALLOCATE(c_ph(lapw%dim_nvd(),ab_dim)) !$acc data copy(aa_r,aa_c) copyin(tlmplm, tlmplm%tdd, tlmplm%tdu, tlmplm%tud,tlmplm%tuu, tlmplm%ind, atoms,atoms%lnonsph,lapw,lapw%nv,noco ) create(utu,utd,dtu,dtd,ax,bx,a,b,aa_block,aahlp) @@ -289,7 +289,7 @@ CONTAINS !comments below must be reactivated !aahlp(ii+1:ii+ki) = aahlp(ii+1:ii+ki)+MATMUL(CONJG(ax(:ki,:lmp)),a(ki,:,iintsp))+MATMUL(CONJG(bx(:ki,:lmp)),b(ki,:lmp,iintsp)) ELSE ! components for <2||2> block unused - !aa_tmphlp(:ki) = MATMUL(CONJG(ax(:ki,:lmp)),a(ki,:lmp,iintsp))+MATMUL(CONJG(bx(:ki,:DIMENSION%lmd)),b(ki,:lmp,iintsp)) + !aa_tmphlp(:ki) = MATMUL(CONJG(ax(:ki,:lmp)),a(ki,:lmp,iintsp))+MATMUL(CONJG(bx(:ki,:atoms%lmaxd*(atoms%lmaxd+2))),b(ki,:lmp,iintsp)) !---> spin-down spin-down part ij = ii + lapw%nv(1) aa_c(ij+1:ij+ki)=aa_c(ij+1:ij+ki)+chi22*aa_tmphlp(:ki) diff --git a/docs/removed_files/old/hsmt_simple.F90 b/docs/removed_files/old/hsmt_simple.F90 index c2f8442d..1da2dc3b 100644 --- a/docs/removed_files/old/hsmt_simple.F90 +++ b/docs/removed_files/old/hsmt_simple.F90 @@ -1,5 +1,5 @@ !-------------------------------------------------------------------------------- -! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany +! Copyright (c) 2016 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. !-------------------------------------------------------------------------------- @@ -7,11 +7,11 @@ MODULE m_hsmt_simple use m_juDFT implicit none CONTAINS - SUBROUTINE hsmt_simple(jspin,bkpt,DIMENSION,input,sym,cell,atoms,lapw,td,noco,usdus,enpara,hmat,smat) + SUBROUTINE hsmt_simple(jspin,bkpt,input,sym,cell,atoms,lapw,td,noco,usdus,enpara,hmat,smat) use m_types use m_hsmt_fjgj USE m_hsmt_blas - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_input),INTENT(IN) :: input TYPE(t_sym),INTENT(IN) :: sym TYPE(t_cell),INTENT(IN) :: cell @@ -33,12 +33,12 @@ CONTAINS - ALLOCATE(fj(dimension%nbasfcn,0:atoms%lmaxd,atoms%ntype,input%jspins)) - ALLOCATE(gj(dimension%nbasfcn,0:atoms%lmaxd,atoms%ntype,input%jspins)) + ALLOCATE(fj(lapw%dim_nbasfcn(),0:atoms%lmaxd,atoms%ntype,input%jspins)) + ALLOCATE(gj(lapw%dim_nbasfcn(),0:atoms%lmaxd,atoms%ntype,input%jspins)) DO jsp=jspin,jspin !Set up the k+G+qss vectors - ALLOCATE(vk(dimension%nbasfcn,3,1),gk(dimension%nbasfcn,3,1)) + ALLOCATE(vk(lapw%dim_nbasfcn(),3,1),gk(lapw%dim_nbasfcn(),3,1)) DO k = 1,lapw%nv(jsp) v=bkpt+(/lapw%k1(k,jsp),lapw%k2(k,jsp),lapw%k3(k,jsp)/)!-noco%qss/2 diff --git a/docs/removed_files/old/hsmt_sph.F90 b/docs/removed_files/old/hsmt_sph.F90 index a6dd9d40..11a0835f 100644 --- a/docs/removed_files/old/hsmt_sph.F90 +++ b/docs/removed_files/old/hsmt_sph.F90 @@ -8,7 +8,7 @@ MODULE m_hsmt_sph USE m_juDFT IMPLICIT NONE CONTAINS - SUBROUTINE hsmt_sph(sym,DIMENSION,atoms,SUB_COMM,n_size,n_rank,sphhar,isp,ab_dim,& + SUBROUTINE hsmt_sph(sym,atoms,SUB_COMM,n_size,n_rank,sphhar,isp,ab_dim,& input,hlpmsize,noco,l_socfirst,cell,nintsp, lapw,el,usdus,vr,gk,rsoc,isigma,fj,gj,smat,hmat) #include"cpp_double.h" @@ -25,7 +25,7 @@ CONTAINS USE m_types IMPLICIT NONE TYPE(t_sym),INTENT(IN) :: sym - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco TYPE(t_cell),INTENT(IN) :: cell @@ -71,7 +71,7 @@ CONTAINS REAL, ALLOCATABLE :: uun21(:,:),udn21(:,:),dun21(:,:),ddn21(:,:) - COMPLEX chi(2,2),chj(2,2,2,atoms%ntype),aawa(DIMENSION%nvd),bbwa(DIMENSION%nvd) + COMPLEX chi(2,2),chj(2,2,2,atoms%ntype),aawa(lapw%dim_nvd()),bbwa(lapw%dim_nvd()) COMPLEX, ALLOCATABLE :: aahlp(:),bbhlp(:) LOGICAL apw(0:atoms%lmaxd) @@ -81,7 +81,7 @@ CONTAINS REAL, ALLOCATABLE :: cross_k(:,:) INTEGER :: j1,j2 COMPLEX :: isigma_x(2,2),isigma_y(2,2),isigma_z(2,2) - COMPLEX :: chi11so(2,2),chi21so(2,2),chi22so(2,2),angso(DIMENSION%nvd,2,2) + COMPLEX :: chi11so(2,2),chi21so(2,2),chi22so(2,2),angso(lapw%dim_nvd(),2,2) IF ( noco%l_noco .AND. (.NOT. noco%l_ss) ) ALLOCATE ( aahlp(hlpmsize),bbhlp(hlpmsize) ) @@ -121,11 +121,11 @@ CONTAINS !$OMP PRIVATE(aawa,bbwa,capw1,ii) IF (.not.l_socfirst) !$ IF (l_socfirst) WRITE(*,*) "WARNING: first variation SOC does not work with OPENMP in hsmt_sph" !$ IF (l_socfirst) WRITE(*,*) " switching off openmp parallelization" - ALLOCATE(rph(DIMENSION%nvd,ab_dim)) - ALLOCATE(cph(DIMENSION%nvd,ab_dim)) - ALLOCATE(plegend(DIMENSION%nvd,0:atoms%lmaxd)) + ALLOCATE(rph(lapw%dim_nvd(),ab_dim)) + ALLOCATE(cph(lapw%dim_nvd(),ab_dim)) + ALLOCATE(plegend(lapw%dim_nvd(),0:atoms%lmaxd)) IF (l_socfirst)THEN - ALLOCATE ( dplegend(DIMENSION%nvd,0:atoms%lmaxd),cross_k(DIMENSION%nvd,3)) + ALLOCATE ( dplegend(lapw%dim_nvd(),0:atoms%lmaxd),cross_k(lapw%dim_nvd(),3)) dplegend(:,0)=0.e0 dplegend(:,1)=1.e0 ENDIF diff --git a/docs/removed_files/old/hsmt_sph_new.F90 b/docs/removed_files/old/hsmt_sph_new.F90 index 3da1ae51..7187b03c 100644 --- a/docs/removed_files/old/hsmt_sph_new.F90 +++ b/docs/removed_files/old/hsmt_sph_new.F90 @@ -2,7 +2,7 @@ MODULE m_hsmt_sph use m_juDFT implicit none CONTAINS - SUBROUTINE hsmt_sph(dimension,atoms,SUB_COMM,n_size,n_rank,sphhar,isp,ab_dim,& + SUBROUTINE hsmt_sph(atoms,SUB_COMM,n_size,n_rank,sphhar,isp,ab_dim,& input,hlpmsize,noco,l_socfirst,cell,nintsp, lapw,el,usdus,vr,gk,rsoc,isigma, aa,bb,fj,gj) #include"cpp_double.h" @@ -18,7 +18,7 @@ CONTAINS #endif USE m_types IMPLICIT NONE - TYPE(t_dimension),INTENT(IN):: dimension + TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco TYPE(t_cell),INTENT(IN) :: cell @@ -102,9 +102,9 @@ CONTAINS ENDDO ! iintsp = 1,nintsp ! - ALLOCATE(rph(dimension%nvd)) - ALLOCATE(cph(dimension%nvd)) - ALLOCATE(plegend(dimension%nvd,0:atoms%lmaxd)) + ALLOCATE(rph(lapw%dim_nvd())) + ALLOCATE(cph(lapw%dim_nvd())) + ALLOCATE(plegend(lapw%dim_nvd(),0:atoms%lmaxd)) plegend=0.0 plegend(:,0)=1.0 diff --git a/dos/Ek_write_sl.f90 b/dos/Ek_write_sl.f90 index 06f02353..c330b150 100644 --- a/dos/Ek_write_sl.f90 +++ b/dos/Ek_write_sl.f90 @@ -1,14 +1,14 @@ MODULE m_Ekwritesl use m_juDFT CONTAINS - SUBROUTINE Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspin,sym,cell,dos,slab,orbcomp,results) + SUBROUTINE Ek_write_sl(eig_id,kpts,atoms,vacuum,input,jspin,sym,cell,dos,slab,orbcomp,results) !----------------------------------------------------------------- !-- now write E(k) for all kpts if on T3E !-- now read data from tmp_dos and write of E(k) in ek_orbcomp !----------------------------------------------------------------- USE m_types IMPLICIT NONE - TYPE(t_dimension),INTENT(IN) :: dimension + TYPE(t_input),INTENT(IN) :: input TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_sym),INTENT(IN) :: sym @@ -39,7 +39,7 @@ CONTAINS IF (slab%nsl.GT.slab%nsld) THEN CALL juDFT_error("nsl.GT.nsld",calledby="Ek_write_sl") ENDIF - ALLOCATE(eig(dimension%neigd)) + ALLOCATE(eig(input%neig)) ! ---> open files for a bandstucture with an orbital composition ! ---> in the case of the film geometry ! diff --git a/dos/cdninf.f90 b/dos/cdninf.f90 index 8a51e275..0a1a2c58 100644 --- a/dos/cdninf.f90 +++ b/dos/cdninf.f90 @@ -47,16 +47,16 @@ CONTAINS INTEGER,INTENT(IN):: ikpt,jspin ,nbands ! ! STM Arguments - COMPLEX, INTENT (IN) ::qstars(:,:,:,:) !(vacuum%nstars,DIMENSION%neigd,vacuum%layerd,2) + COMPLEX, INTENT (IN) ::qstars(:,:,:,:) !(vacuum%nstars,input%neig,vacuum%layerd,2) ! .. ! .. Array Arguments .. - REAL, INTENT (IN) :: qvlay(:,:,:) !DIMENSION%neigd,vacuum%layerd,2) - REAL, INTENT (IN) :: qis(:,:,:)!(DIMENSION%neigd,kpts%nkpt,DIMENSION%jspd) - REAL, INTENT (IN) :: qvac(:,:,:,:) !(DIMENSION%neigd,2,kpts%nkpt,DIMENSION%jspd) + REAL, INTENT (IN) :: qvlay(:,:,:) !input%neig,vacuum%layerd,2) + REAL, INTENT (IN) :: qis(:,:,:)!(input%neig,kpts%nkpt,DIMENSION%jspd) + REAL, INTENT (IN) :: qvac(:,:,:,:) !(input%neig,2,kpts%nkpt,DIMENSION%jspd) REAL, INTENT (IN) :: bkpt(3) - REAL, INTENT (IN) :: eig(:)!(DIMENSION%neigd) + REAL, INTENT (IN) :: eig(:)!(input%neig) REAL, INTENT (IN) :: qal(0:,:,:)!(0:3,atoms%ntype,neigd) - INTEGER, INTENT (IN) :: jsym(:)!(DIMENSION%neigd) + INTEGER, INTENT (IN) :: jsym(:)!(input%neig) INTEGER, INTENT (IN) :: ksym(:)!(neigd) ! .. ! .. Local Scalars .. diff --git a/dos/doswrite.f90 b/dos/doswrite.f90 index b1fb33f8..78d4e8b6 100644 --- a/dos/doswrite.f90 +++ b/dos/doswrite.f90 @@ -11,14 +11,14 @@ MODULE m_doswrite !-- now read data from tmp_dos and write to vacdos&dosinp .. dw ! CONTAINS - SUBROUTINE doswrite(eig_id,DIMENSION,kpts,atoms,vacuum,input,banddos,& + SUBROUTINE doswrite(eig_id,kpts,atoms,vacuum,input,banddos,& sliceplot,noco,sym,cell,dos,mcd,results,slab,orbcomp,oneD) USE m_evaldos USE m_cdninf USE m_types IMPLICIT NONE - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_banddos),INTENT(IN) :: banddos TYPE(t_sliceplot),INTENT(IN) :: sliceplot @@ -41,7 +41,7 @@ CONTAINS ! locals REAL :: wk,bkpt(3) - REAL :: eig(DIMENSION%neigd) + REAL :: eig(input%neig) INTEGER :: ne,ikpt,kspin,j,i,n COMPLEX, ALLOCATABLE :: ac(:,:),bc(:,:) @@ -105,7 +105,7 @@ CONTAINS ! write DOS/VACDOS IF (banddos%dos.AND.(banddos%ndir.LT.0)) THEN CALL evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,results,dos,& - DIMENSION,results%ef,results%bandgap,banddos%l_mcd,mcd,slab,orbcomp) + results%ef,results%bandgap,banddos%l_mcd,mcd,slab,orbcomp) END IF ! Now write to vacwave if nstm=3 @@ -113,7 +113,7 @@ CONTAINS IF (vacuum%nstm.EQ.3) THEN call juDFT_error("nstm=3 not implemented in doswrite") !OPEN (89,file='tmp_vacwave',status='old',access='direct')!, recl=reclength_vw) - ALLOCATE ( ac(n2max,DIMENSION%neigd),bc(n2max,DIMENSION%neigd) ) + ALLOCATE ( ac(n2max,input%neig),bc(n2max,input%neig) ) DO ikpt = 1,kpts%nkpt WRITE(*,*) 'Read rec',ikpt,'from vacwave' READ(89,rec=ikpt) wk,ne,bkpt(1),bkpt(2),eig,ac,bc diff --git a/dos/evaldos.f90 b/dos/evaldos.f90 index b2f79dcd..ab2eb50d 100644 --- a/dos/evaldos.f90 +++ b/dos/evaldos.f90 @@ -1,7 +1,7 @@ MODULE m_evaldos CONTAINS SUBROUTINE evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,results,dos,& - dimension,efermiarg,bandgap,l_mcd,mcd,slab,orbcomp) + efermiarg,bandgap,l_mcd,mcd,slab,orbcomp) !---------------------------------------------------------------------- ! ! vk: k-vectors @@ -30,7 +30,7 @@ USE m_cdn_io IMPLICIT NONE INTEGER,INTENT(IN) :: eig_id - TYPE(t_dimension),INTENT(IN) :: dimension + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_banddos),INTENT(IN) :: banddos TYPE(t_input),INTENT(IN) :: input @@ -59,8 +59,8 @@ INTEGER itria(3,2*kpts%nkpt),itetra(4,6*kpts%nkpt) REAL voltet(6*kpts%nkpt),kx(kpts%nkpt),vkr(3,kpts%nkpt) - REAL ev(dimension%neigd,kpts%nkpt),e(ned),gpart(ned,atoms%ntype),atr(2*kpts%nkpt) - REAL e_grid(ned+1),spect(ned,3*atoms%ntype),ferwe(dimension%neigd,kpts%nkpt) + REAL ev(input%neig,kpts%nkpt),e(ned),gpart(ned,atoms%ntype),atr(2*kpts%nkpt) + REAL e_grid(ned+1),spect(ned,3*atoms%ntype),ferwe(input%neig,kpts%nkpt) REAL, ALLOCATABLE :: qal(:,:,:),qval(:,:,:),qlay(:,:,:),g(:,:) REAL, ALLOCATABLE :: mcd_local(:,:,:) REAL, ALLOCATABLE :: qvac(:,:) @@ -81,11 +81,11 @@ qdim = 23 END IF ENDIF - ALLOCATE( qal(qdim,dimension%neigd,kpts%nkpt),& - & qval(vacuum%nstars*vacuum%layers*vacuum%nvac,dimension%neigd,kpts%nkpt),& - & qlay(dimension%neigd,vacuum%layerd,2)) + ALLOCATE( qal(qdim,input%neig,kpts%nkpt),& + & qval(vacuum%nstars*vacuum%layers*vacuum%nvac,input%neig,kpts%nkpt),& + & qlay(input%neig,vacuum%layerd,2)) IF (l_mcd) THEN - ALLOCATE(mcd_local(3*atoms%ntype*ncored,dimension%neigd,kpts%nkpt) ) + ALLOCATE(mcd_local(3*atoms%ntype*ncored,input%neig,kpts%nkpt) ) ELSE ALLOCATE(mcd_local(0,0,0)) ENDIF @@ -147,7 +147,7 @@ qval(:,:,k) = 0.0 ntb = max(ntb,results%neig(k,jspin)) - IF (l_mcd) mcd_local(:,:,k) = RESHAPE(mcd%mcd(:,1:ncored,:,k,jspin),(/3*atoms%ntype*ncored,dimension%neigd/)) + IF (l_mcd) mcd_local(:,:,k) = RESHAPE(mcd%mcd(:,1:ncored,:,k,jspin),(/3*atoms%ntype*ncored,input%neig/)) IF (.NOT.l_orbcomp) THEN qal(1:lmax*atoms%ntype,:,k)=reshape(dos%qal(0:,:,:,k,jspin),(/lmax*atoms%ntype,size(dos%qal,3)/)) qal(lmax*atoms%ntype+2,:,k)=dos%qvac(:,1,k,jspin) ! vacuum 1 @@ -162,7 +162,7 @@ DO l = 1, results%neig(k,jspin) qal(i,l,k) = orbcomp%comp(l,i,n_orb,k,jspin)*orbcomp%qmtp(l,n_orb,k,jspin)/10000. END DO - DO l = results%neig(k,jspin)+1, dimension%neigd + DO l = results%neig(k,jspin)+1, input%neig qal(i,l,k) = 0.0 END DO END DO @@ -173,7 +173,7 @@ ! otherwise, write vacuum charge in correct arrays ! IF ((.NOT.input%film).AND.(banddos%ndir.NE.-3)) THEN - DO n = 1,dimension%neigd + DO n = 1,input%neig qal(lmax*atoms%ntype+2,n,k) = 0.0 qal(lmax*atoms%ntype+3,n,k) = 0.0 ENDDO @@ -195,7 +195,7 @@ ! in the noco case, qis has been calculated in pwden and is read in from tmp_dos ! IF ((.NOT.noco%l_noco).AND.(banddos%ndir.NE.-3)) THEN - DO i = 1 , dimension%neigd + DO i = 1 , input%neig qal(lmax*atoms%ntype+1,i,k) = 1. DO nl = 1 , atoms%ntype l1 = lmax*(nl-1) + 1 @@ -216,7 +216,7 @@ DO i = 1 , results%neig(k,jspin) ev(i,k) = results%eig(i,k,jspin)*hartree_to_ev_const - efermi ENDDO - DO i = results%neig(k,jspin) + 1, dimension%neigd + DO i = results%neig(k,jspin) + 1, input%neig ev(i,k) = 9.9e+99 ENDDO ! @@ -293,7 +293,7 @@ qal(:,1:ntb,1:kpts%nkpt),e, g) ELSE write(*,*) efermi - CALL tetra_dos(lmax,atoms%ntype,dimension%neigd,ned,ntetra,kpts%nkpt,& + CALL tetra_dos(lmax,atoms%ntype,input%neig,ned,ntetra,kpts%nkpt,& itetra,efermi,voltet,e,results%neig(:,jspin), ev,qal, g) IF (input%jspins.EQ.1) g(:,:) = 2 * g(:,:) ENDIF @@ -302,7 +302,7 @@ ! DOS calculation: use histogram method ! IF ( .not.l_mcd ) THEN - CALL dos_bin(input%jspins,qdim,ned,emin,emax,dimension%neigd,kpts%nkpt,& + CALL dos_bin(input%jspins,qdim,ned,emin,emax,input%neig,kpts%nkpt,& results%neig(:,jspin),kpts%wtkpt(1:kpts%nkpt),ev,qal, g) ELSE CALL dos_bin(input%jspins,3*atoms%ntype*ncored,ned,emin,emax,ntb,kpts%nkpt,& diff --git a/dos/nstm3.f90 b/dos/nstm3.f90 index e8827f7a..dba34eb0 100644 --- a/dos/nstm3.f90 +++ b/dos/nstm3.f90 @@ -35,7 +35,7 @@ CONTAINS ! .. Array Arguments .. REAL, INTENT (IN) :: evac(2) REAL, INTENT (IN) :: vz(:,:)!(vacuum%nmzd,2) - INTEGER, INTENT (OUT) :: gvac1d(:),gvac2d(:) !(dimension%nv2d) + INTEGER, INTENT (OUT) :: gvac1d(:),gvac2d(:) !(lapw%dim_nv2d()) ! .. ! .. Local Scalars INTEGER n2,k,j,i,ivac diff --git a/dos/sympsi.F90 b/dos/sympsi.F90 index ab8c8b98..38ad5f7b 100644 --- a/dos/sympsi.F90 +++ b/dos/sympsi.F90 @@ -8,17 +8,17 @@ MODULE m_sympsi ! Calculates the irreducible represetantions of the wave functions. ! if k-point is in Brillouin zone boundary results are correct only for - ! non-symmorphic groups (factor groups would be needed for that...). + ! non-symmorphic groups (factor groups would be needed for that...). ! jsym contains the number of irreducible rep., corresponding character ! tables are given in the file syminfo. ! - ! Double groups work only with non-collinear calculations, for normal spin-orbit + ! Double groups work only with non-collinear calculations, for normal spin-orbit ! calculations both spin up and down components would be needed... ! Jussi Enkovaara, Juelich 2004 CONTAINS - SUBROUTINE sympsi(lapw,jspin,sym,DIMENSION,ne,cell,eig,noco, ksym,jsym,zMat) + SUBROUTINE sympsi(lapw,jspin,sym,ne,cell,eig,noco, ksym,jsym,zMat) USE m_grp_k USE m_inv3 @@ -27,7 +27,7 @@ CONTAINS IMPLICIT NONE TYPE(t_lapw),INTENT(IN) :: lapw - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_noco),INTENT(IN) :: noco TYPE(t_sym),INTENT(IN) :: sym TYPE(t_cell),INTENT(IN) :: cell @@ -37,9 +37,9 @@ CONTAINS INTEGER, INTENT (IN) :: ne,jspin ! .. ! .. Array Arguments .. - REAL, INTENT (IN) :: eig(DIMENSION%neigd) + REAL, INTENT (IN) :: eig(:) - INTEGER, INTENT (OUT):: jsym(DIMENSION%neigd),ksym(DIMENSION%neigd) + INTEGER, INTENT (OUT):: jsym(:),ksym(:) ! .. ! .. Local Scalars .. REAL degthre @@ -50,7 +50,7 @@ CONTAINS ! .. Local Arrays .. INTEGER mrot_k(3,3,2*sym%nop) INTEGER :: mtmpinv(3,3),d - INTEGER :: gmap(DIMENSION%nvd,sym%nop) + INTEGER :: gmap(lapw%dim_nvd(),sym%nop) REAL :: kv(3),kvtest(3) INTEGER :: deg(ne) @@ -170,7 +170,7 @@ CONTAINS zMat%data_r(gmap(k,c),deg(n2))/(norm(deg(n1))*norm(deg(n2))) END DO ELSE - IF (soc) THEN + IF (soc) THEN DO k=1,lapw%nv(jspin) csum(n1,n2,c)=csum(n1,n2,c)+(CONJG(zMat%data_c(k,deg(n1)))*& @@ -202,7 +202,7 @@ CONTAINS ! determine the irreducible presentation - irrloop: DO n1=1,ndeg + irrloop: DO n1=1,ndeg ! write(*,'(2i3,6(2f6.3,2x))') n1,i,chars(deg(n1),1:nclass) DO c=1,nirr IF (ALL(ABS(chars(deg(n1),1:nclass)-& diff --git a/eigen/eigen.F90 b/eigen/eigen.F90 index 16b6a54e..3d97ff2d 100644 --- a/eigen/eigen.F90 +++ b/eigen/eigen.F90 @@ -18,7 +18,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,DIMENSION,vacuum,input,& + SUBROUTINE eigen(mpi,stars,sphhar,atoms,xcpot,sym,kpts,vacuum,input,& cell,enpara,banddos,noco,oneD,hybrid,iter,eig_id,results,inden,v,vx) #include"cpp_double.h" @@ -46,7 +46,7 @@ CONTAINS TYPE(t_results),INTENT(INOUT):: results CLASS(t_xcpot),INTENT(IN) :: xcpot TYPE(t_mpi),INTENT(IN) :: mpi - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_hybrid),INTENT(INOUT) :: hybrid TYPE(t_enpara),INTENT(INOUT) :: enpara @@ -103,9 +103,9 @@ CONTAINS character(len=300) :: errmsg call ud%init(atoms,input%jspins) - ALLOCATE(eig(DIMENSION%neigd)) + ALLOCATE(eig(input%neig)) ALLOCATE(bkpt(3)) - ALLOCATE(eigBuffer(DIMENSION%neigd,kpts%nkpt,input%jspins)) + ALLOCATE(eigBuffer(input%neig,kpts%nkpt,input%jspins)) ALLOCATE(nvBuffer(kpts%nkpt,MERGE(1,input%jspins,noco%l_noco)),nvBufferTemp(kpts%nkpt,MERGE(1,input%jspins,noco%l_noco))) l_real=sym%invs.AND..NOT.noco%l_noco @@ -124,7 +124,7 @@ CONTAINS ! Set up and solve the eigenvalue problem ! loop over spins ! set up k-point independent t(l'm',lm) matrices - CALL mt_setup(atoms,sym,sphhar,input,noco,enpara,inden,v,mpi,results,DIMENSION,td,ud) + CALL mt_setup(atoms,sym,sphhar,input,noco,enpara,inden,v,mpi,results,td,ud) neigBuffer = 0 results%neig = 0 @@ -140,7 +140,7 @@ CONTAINS ! Set up lapw list CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,l_zref, mpi) call timestart("Setup of H&S matrices") - CALL eigen_hssetup(jsp,mpi,DIMENSION,hybrid,enpara,input,vacuum,noco,sym,& + CALL eigen_hssetup(jsp,mpi,hybrid,enpara,input,vacuum,noco,sym,& stars,cell,sphhar,atoms,ud,td,v,lapw,l_real,smat,hmat) CALL timestop("Setup of H&S matrices") @@ -171,16 +171,16 @@ CONTAINS PRINT *,"TODO" ! STOP "TODO" PRINT *,"BASIS:", lapw%nv(jsp), atoms%nlotot - IF (hybrid%l_addhf) CALL add_Vnonlocal(nk,lapw,atoms,hybrid,dimension,kpts,jsp,results,xcpot,noco,hmat) + 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),DIMENSION,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,hybrid,enpara%el0,enpara%ello0,& sym,cell,sphhar,stars,xcpot,mpi,oneD,hmat,vx) END IF END IF ! hybrid%l_hybrid l_wu=.FALSE. - ne_all=DIMENSION%neigd + ne_all=input%neig IF(ne_all < 0) ne_all = lapw%nmat IF(ne_all > lapw%nmat) ne_all = lapw%nmat @@ -211,7 +211,7 @@ CONTAINS ! eig ...... all eigenvalues, output ! zMat ..... local eigenvectors, output CALL eigen_diag(solver,hmat,smat,ne_all,eig,zMat,nk,jsp,iter) - + CALL smat%free() CALL hmat%free() DEALLOCATE(hmat,smat, stat=dealloc_stat, errmsg=errmsg) @@ -224,7 +224,7 @@ CONTAINS ! Collect number of all eigenvalues ne_found=ne_all CALL MPI_ALLREDUCE(ne_found,ne_all,1,MPI_INTEGER,MPI_SUM, mpi%sub_comm,ierr) - ne_all=MIN(DIMENSION%neigd,ne_all) + ne_all=MIN(input%neig,ne_all) #else ne_found=ne_all #endif @@ -233,7 +233,7 @@ CONTAINS END IF IF (mpi%n_rank == 0) THEN ! Only process 0 writes out the value of ne_all and the - ! eigenvalues. + ! eigenvalues. CALL write_eig(eig_id, nk,jsp,ne_found,ne_all,& eig(:ne_all),n_start=mpi%n_size,n_end=mpi%n_rank,zMat=zMat) eigBuffer(:ne_all,nk,jsp) = eig(:ne_all) @@ -249,7 +249,7 @@ CONTAINS CALL timestop("EV output") IF (banddos%unfoldband) THEN - IF(modulo (kpts%nkpt,mpi%n_size).NE.0) call juDFT_error("number kpts needs to be multiple of number mpi threads",& + IF(modulo (kpts%nkpt,mpi%n_size).NE.0) call juDFT_error("number kpts needs to be multiple of number mpi threads",& hint=errmsg, calledby="eigen.F90") CALL calculate_plot_w_n(banddos,cell,kpts,smat_unfold,zMat,lapw,nk,jsp,eig,results,input,atoms,unfoldingBuffer,mpi) CALL smat_unfold%free() @@ -263,7 +263,7 @@ CONTAINS END DO k_loop END DO ! spin loop ends - neigd2 = MIN(dimension%neigd,dimension%nbasfcn) + neigd2 = MIN(input%neig,lapw%dim_nbasfcn()) #ifdef CPP_MPI IF (banddos%unfoldband) THEN results%unfolding_weights = CMPLX(0.0,0.0) @@ -301,4 +301,3 @@ CONTAINS enpara%epara_min = MIN(MINVAL(enpara%ello0),enpara%epara_min) END SUBROUTINE eigen END MODULE m_eigen - diff --git a/eigen/eigen_hssetup.F90 b/eigen/eigen_hssetup.F90 index a43158fa..378785b1 100644 --- a/eigen/eigen_hssetup.F90 +++ b/eigen/eigen_hssetup.F90 @@ -15,7 +15,7 @@ CONTAINS !! 4. The vacuum part is added (in hsvac()) !! 5. The matrices are copied to the final matrix, in the noco-case the full matrix is constructed from the 4-parts. - SUBROUTINE eigen_hssetup(isp,mpi,DIMENSION,hybrid,enpara,input,vacuum,noco,sym,& + SUBROUTINE eigen_hssetup(isp,mpi,hybrid,enpara,input,vacuum,noco,sym,& stars,cell,sphhar,atoms,ud,td,v,lapw,l_real,smat_final,hmat_final) USE m_types USE m_types_mpimat @@ -28,7 +28,7 @@ CONTAINS IMPLICIT NONE INTEGER,INTENT(IN) :: isp TYPE(t_mpi),INTENT(IN) :: mpi - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_hybrid),INTENT(IN) :: hybrid TYPE(t_enpara),INTENT(IN) :: enpara TYPE(t_input),INTENT(IN) :: input @@ -85,7 +85,7 @@ CONTAINS !Vacuum contributions IF (input%film) THEN CALL timestart("Vacuum part") - CALL hsvac(vacuum,stars,DIMENSION,mpi,isp,input,v,enpara%evac,cell,& + CALL hsvac(vacuum,stars,mpi,isp,input,v,enpara%evac,cell,& lapw,sym, noco,hmat,smat) CALL timestop("Vacuum part") ENDIF diff --git a/eigen/hsvac.F90 b/eigen/hsvac.F90 index 25e8e38a..222bcc16 100644 --- a/eigen/hsvac.F90 +++ b/eigen/hsvac.F90 @@ -11,14 +11,14 @@ CONTAINS !Overlap matrix !----------------------------------------------------------- SUBROUTINE hsvac(& - vacuum,stars,DIMENSION, mpi,jsp,input,v,evac,cell,& + vacuum,stars, mpi,jsp,input,v,evac,cell,& lapw,sym, noco,hmat,smat) USE m_vacfun USE m_types IMPLICIT NONE - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_input),INTENT(IN) :: input TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_noco),INTENT(IN) :: noco @@ -46,15 +46,15 @@ CONTAINS ! .. ! .. Local Arrays .. INTEGER:: nv2(input%jspins) - INTEGER kvac(2,DIMENSION%nv2d,input%jspins) - INTEGER map2(DIMENSION%nvd,input%jspins) - COMPLEX tddv(DIMENSION%nv2d,DIMENSION%nv2d),tduv(DIMENSION%nv2d,DIMENSION%nv2d) - COMPLEX tudv(DIMENSION%nv2d,DIMENSION%nv2d),tuuv(DIMENSION%nv2d,DIMENSION%nv2d) + INTEGER kvac(2,lapw%dim_nv2d(),input%jspins) + INTEGER map2(lapw%dim_nvd(),input%jspins) + COMPLEX tddv(lapw%dim_nv2d(),lapw%dim_nv2d()),tduv(lapw%dim_nv2d(),lapw%dim_nv2d()) + COMPLEX tudv(lapw%dim_nv2d(),lapw%dim_nv2d()),tuuv(lapw%dim_nv2d(),lapw%dim_nv2d()) COMPLEX vxy_help(stars%ng2-1) - COMPLEX a(DIMENSION%nvd,input%jspins),b(DIMENSION%nvd,input%jspins) - REAL ddnv(DIMENSION%nv2d,input%jspins),dudz(DIMENSION%nv2d,input%jspins) - REAL duz(DIMENSION%nv2d,input%jspins), udz(DIMENSION%nv2d,input%jspins) - REAL uz(DIMENSION%nv2d,input%jspins) + COMPLEX a(lapw%dim_nvd(),input%jspins),b(lapw%dim_nvd(),input%jspins) + REAL ddnv(lapw%dim_nv2d(),input%jspins),dudz(lapw%dim_nv2d(),input%jspins) + REAL duz(lapw%dim_nv2d(),input%jspins), udz(lapw%dim_nv2d(),input%jspins) + REAL uz(lapw%dim_nv2d(),input%jspins) ! .. @@ -72,7 +72,7 @@ CONTAINS END IF ENDDO nv2(jspin) = nv2(jspin) + 1 - IF (nv2(jspin)>DIMENSION%nv2d) CALL juDFT_error("hsvac:dimension%nv2d",calledby ="hsvac") + IF (nv2(jspin)>lapw%dim_nv2d()) CALL juDFT_error("hsvac:lapw%dim_nv2d()",calledby ="hsvac") kvac(1:2,nv2(jspin),jspin) = lapw%gvec(1:2,k,jspin) map2(k,jspin) = nv2(jspin) ENDDO k_loop diff --git a/eigen/mt_setup.F90 b/eigen/mt_setup.F90 index 7671befc..3365915c 100644 --- a/eigen/mt_setup.F90 +++ b/eigen/mt_setup.F90 @@ -7,7 +7,7 @@ MODULE m_mt_setup CONTAINS - SUBROUTINE mt_setup(atoms,sym,sphhar,input,noco,enpara,inden,vTot,mpi,results,DIMENSION,td,ud) + SUBROUTINE mt_setup(atoms,sym,sphhar,input,noco,enpara,inden,vTot,mpi,results,td,ud) USE m_types USE m_usetup USE m_tlmplm_cholesky @@ -16,7 +16,7 @@ CONTAINS IMPLICIT NONE TYPE(t_results),INTENT(INOUT):: results TYPE(t_mpi),INTENT(IN) :: mpi - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_enpara),INTENT(INOUT) :: enpara TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco @@ -35,12 +35,12 @@ CONTAINS END IF CALL timestart("tlmplm") - CALL td%init(DIMENSION%lmd,atoms%ntype,atoms%lmaxd,atoms%llod,SUM(atoms%nlo),& + CALL td%init(atoms%lmaxd*(atoms%lmaxd+2),atoms%ntype,atoms%lmaxd,atoms%llod,SUM(atoms%nlo),& DOT_PRODUCT(atoms%nlo,atoms%nlo+1)/2,MERGE(4,input%jspins,noco%l_mtNocoPot),& (noco%l_noco.AND.noco%l_soc.AND..NOT.noco%l_ss).OR.noco%l_constr)!l_offdiag DO jsp=1,MERGE(4,input%jspins,noco%l_mtNocoPot) - !CALL tlmplm_cholesky(sphhar,atoms,DIMENSION,enpara, jsp,1,mpi,vTot%mt(:,0,1,jsp),input,vTot%mmpMat, td,ud) + !CALL tlmplm_cholesky(sphhar,atoms,enpara, jsp,1,mpi,vTot%mt(:,0,1,jsp),input,vTot%mmpMat, td,ud) CALL tlmplm_cholesky(sphhar,atoms,sym,noco,enpara,jsp,jsp,mpi,vTot,input,td,ud) IF (input%l_f) CALL write_tlmplm(td,vTot%mmpMat,atoms%n_u>0,jsp,jsp,input%jspins) END DO diff --git a/eigen/od_hsvac.F90 b/eigen/od_hsvac.F90 index 4b53c369..0bbad81a 100644 --- a/eigen/od_hsvac.F90 +++ b/eigen/od_hsvac.F90 @@ -8,7 +8,7 @@ MODULE m_od_hsvac USE m_juDFT CONTAINS SUBROUTINE od_hsvac(& - vacuum,stars,DIMENSION, oneD,atoms, jsp,input,vxy,vz,evac,cell,& + vacuum,stars, oneD,atoms, jsp,input,vxy,vz,evac,cell,& bkpt,lapw, MM,vM,m_cyl,n2d_1, n_size,n_rank,sym,noco,nv2,l_real,hamOvlp) ! subroutine for calculating the hamiltonian and overlap matrices in @@ -20,7 +20,7 @@ CONTAINS USE m_od_vacfun USE m_types IMPLICIT NONE - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_input),INTENT(IN) :: input TYPE(t_vacuum),INTENT(IN) :: vacuum @@ -75,18 +75,18 @@ CONTAINS ALLOCATE (& - ai(-vM:vM,DIMENSION%nv2d,DIMENSION%nvd),bi(-vM:vM,DIMENSION%nv2d,DIMENSION%nvd),& - nvp(DIMENSION%nv2d,input%jspins),ind(stars%ng2,DIMENSION%nv2d,input%jspins),& - kvac3(DIMENSION%nv2d,input%jspins),map1(DIMENSION%nvd,input%jspins),& - tddv(-vM:vM,-vM:vM,DIMENSION%nv2d,DIMENSION%nv2d),& - tduv(-vM:vM,-vM:vM,DIMENSION%nv2d,DIMENSION%nv2d),& - tudv(-vM:vM,-vM:vM,DIMENSION%nv2d,DIMENSION%nv2d),& - tuuv(-vM:vM,-vM:vM,DIMENSION%nv2d,DIMENSION%nv2d),& - a(-vM:vM,DIMENSION%nvd,input%jspins),b(-vM:vM,DIMENSION%nvd,input%jspins),& + ai(-vM:vM,lapw%dim_nv2d(),lapw%dim_nvd()),bi(-vM:vM,lapw%dim_nv2d(),lapw%dim_nvd()),& + nvp(lapw%dim_nv2d(),input%jspins),ind(stars%ng2,lapw%dim_nv2d(),input%jspins),& + kvac3(lapw%dim_nv2d(),input%jspins),map1(lapw%dim_nvd(),input%jspins),& + tddv(-vM:vM,-vM:vM,lapw%dim_nv2d(),lapw%dim_nv2d()),& + tduv(-vM:vM,-vM:vM,lapw%dim_nv2d(),lapw%dim_nv2d()),& + tudv(-vM:vM,-vM:vM,lapw%dim_nv2d(),lapw%dim_nv2d()),& + tuuv(-vM:vM,-vM:vM,lapw%dim_nv2d(),lapw%dim_nv2d()),& + a(-vM:vM,lapw%dim_nvd(),input%jspins),b(-vM:vM,lapw%dim_nvd(),input%jspins),& bess(-vM:vM),dbss(-vM:vM),bess1(-vM:vM),& - ddnv(-vM:vM,DIMENSION%nv2d,input%jspins),dudz(-vM:vM,DIMENSION%nv2d,input%jspins),& - duz(-vM:vM,DIMENSION%nv2d,input%jspins),& - udz(-vM:vM,DIMENSION%nv2d,input%jspins),uz(-vM:vM,DIMENSION%nv2d,input%jspins) ) + ddnv(-vM:vM,lapw%dim_nv2d(),input%jspins),dudz(-vM:vM,lapw%dim_nv2d(),input%jspins),& + duz(-vM:vM,lapw%dim_nv2d(),input%jspins),& + udz(-vM:vM,lapw%dim_nv2d(),input%jspins),uz(-vM:vM,lapw%dim_nv2d(),input%jspins) ) !---> set up mapping function from 3d-->1d lapws !---> creating arrays ind and nvp @@ -102,12 +102,12 @@ CONTAINS END IF ENDDO nv2(jspin) = nv2(jspin) + 1 - IF (nv2(jspin)>DIMENSION%nv2d) CALL juDFT_error("dimension%nv2d",calledby ="od_hsvac") + IF (nv2(jspin)>lapw%dim_nv2d()) CALL juDFT_error("lapw%dim_nv2d()",calledby ="od_hsvac") kvac3(nv2(jspin),jspin) = lapw%k3(k,jspin) map1(k,jspin) = nv2(jspin) END DO k_loop - DO ik = 1,DIMENSION%nv2d + DO ik = 1,lapw%dim_nv2d() nvp(ik,jspin) = 0 DO i = 1,stars%ng2 ind(i,ik,jspin) = 0 @@ -141,7 +141,7 @@ CONTAINS ! get the wavefunctions and set up the tuuv, etc matrices CALL od_vacfun(& - m_cyl,cell,vacuum,DIMENSION,stars,& + m_cyl,cell,vacuum,stars,& jsp,input,noco,ipot,oneD,n2d_1, ivac,evac(1,1),bkpt,MM,vM,& vxy(1,1,ivac),vz,kvac3,nv2, tuuv,tddv,tudv,tduv,uz,duz,udz,dudz,ddnv) diff --git a/eigen/od_vacfun.f90 b/eigen/od_vacfun.f90 index d4a1f1b0..d4e7b7dc 100644 --- a/eigen/od_vacfun.f90 +++ b/eigen/od_vacfun.f90 @@ -7,7 +7,7 @@ MODULE m_od_vacfun CONTAINS SUBROUTINE od_vacfun(& - m_cyl,cell,vacuum,DIMENSION,stars,& + m_cyl,cell,vacuum,stars,& jsp,input,noco,ipot,oneD, n2d_1, ivac,evac,bkpt,MM,vM,& vxy,vz,kvac3,nv2, tuuv,tddv,tudv,tduv,uz,duz,udz,dudz,ddnv) !********************************************************************* @@ -22,7 +22,7 @@ CONTAINS USE m_intgr, ONLY : intgz0 USE m_types IMPLICIT NONE - TYPE(t_dimension),INTENT(IN):: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_input),INTENT(IN) :: input TYPE(t_vacuum),INTENT(IN) :: vacuum @@ -37,18 +37,18 @@ CONTAINS ! .. ! .. Array Arguments .. INTEGER, INTENT (IN) :: nv2(input%jspins) - INTEGER, INTENT (IN) :: kvac3(DIMENSION%nv2d,input%jspins) + INTEGER, INTENT (IN) :: kvac3(lapw_dim_nv2d,input%jspins) COMPLEX, INTENT (IN) :: vxy(vacuum%nmzxyd,n2d_1-1) - COMPLEX, INTENT (OUT):: tddv(-vM:vM,-vM:vM,DIMENSION%nv2d,DIMENSION%nv2d) - COMPLEX, INTENT (OUT):: tduv(-vM:vM,-vM:vM,DIMENSION%nv2d,DIMENSION%nv2d) - COMPLEX, INTENT (OUT):: tudv(-vM:vM,-vM:vM,DIMENSION%nv2d,DIMENSION%nv2d) - COMPLEX, INTENT (OUT):: tuuv(-vM:vM,-vM:vM,DIMENSION%nv2d,DIMENSION%nv2d) + COMPLEX, INTENT (OUT):: tddv(-vM:vM,-vM:vM,lapw_dim_nv2d,lapw_dim_nv2d) + COMPLEX, INTENT (OUT):: tduv(-vM:vM,-vM:vM,lapw_dim_nv2d,lapw_dim_nv2d) + COMPLEX, INTENT (OUT):: tudv(-vM:vM,-vM:vM,lapw_dim_nv2d,lapw_dim_nv2d) + COMPLEX, INTENT (OUT):: tuuv(-vM:vM,-vM:vM,lapw_dim_nv2d,lapw_dim_nv2d) REAL, INTENT (IN) :: vz(vacuum%nmzd,2,4) ,evac(2,input%jspins) - REAL, INTENT (IN) :: bkpt(3) - REAL, INTENT (OUT):: udz(-vM:vM,DIMENSION%nv2d,input%jspins),uz(-vM:vM,DIMENSION%nv2d,input%jspins) - REAL, INTENT (OUT):: dudz(-vM:vM,DIMENSION%nv2d,input%jspins) - REAL, INTENT (OUT):: duz(-vM:vM,DIMENSION%nv2d,input%jspins) - REAL, INTENT (OUT):: ddnv(-vM:vM,DIMENSION%nv2d,input%jspins) + REAL, INTENT (IN) :: bkpt(3) + REAL, INTENT (OUT):: udz(-vM:vM,lapw_dim_nv2d,input%jspins),uz(-vM:vM,lapw_dim_nv2d,input%jspins) + REAL, INTENT (OUT):: dudz(-vM:vM,lapw_dim_nv2d,input%jspins) + REAL, INTENT (OUT):: duz(-vM:vM,lapw_dim_nv2d,input%jspins) + REAL, INTENT (OUT):: ddnv(-vM:vM,lapw_dim_nv2d,input%jspins) ! .. ! .. Local Scalars .. REAL ev,scale,xv,yv,vzero,v1,wronk @@ -57,12 +57,12 @@ CONTAINS LOGICAL tail ! .. ! .. Local Arrays .. - REAL wdz(-vM:vM,DIMENSION%nv2d,input%jspins),wz(-vM:vM,DIMENSION%nv2d,input%jspins) - REAL dwdz(-vM:vM,DIMENSION%nv2d,input%jspins),dwz(-vM:vM,DIMENSION%nv2d,input%jspins) - REAL u(vacuum%nmzd,-vM:vM,DIMENSION%nv2d,input%jspins),ud(vacuum%nmzd,-vM:vM,DIMENSION%nv2d,input%jspins) + REAL wdz(-vM:vM,lapw_dim_nv2d,input%jspins),wz(-vM:vM,lapw_dim_nv2d,input%jspins) + REAL dwdz(-vM:vM,lapw_dim_nv2d,input%jspins),dwz(-vM:vM,lapw_dim_nv2d,input%jspins) + REAL u(vacuum%nmzd,-vM:vM,lapw_dim_nv2d,input%jspins),ud(vacuum%nmzd,-vM:vM,lapw_dim_nv2d,input%jspins) REAL v(3),x(vacuum%nmzd) REAL vr0(vacuum%nmzd,2,4) - REAL w(vacuum%nmzd,-vM:vM,DIMENSION%nv2d,input%jspins),wd(vacuum%nmzd,-vM:vM,DIMENSION%nv2d,input%jspins) + REAL w(vacuum%nmzd,-vM:vM,lapw_dim_nv2d,input%jspins),wd(vacuum%nmzd,-vM:vM,lapw_dim_nv2d,input%jspins) REAL qssbti(2) ! .. @@ -137,7 +137,7 @@ CONTAINS wz(m,ik,jspin)/(2.0*((cell%z1)**(1.5))) uz(m,ik,jspin)=wz(m,ik,jspin)/SQRT(cell%z1) dudz(m,ik,jspin)=(-dwdz(m,ik,jspin))/SQRT(cell%z1)-& - wdz(m,ik,jspin)/(2.0*((cell%z1)**(1.5))) + wdz(m,ik,jspin)/(2.0*((cell%z1)**(1.5))) udz(m,ik,jspin)=wdz(m,ik,jspin)/SQRT(cell%z1) IF (m.GT.0) THEN duz(-m,ik,jspin) = duz(m,ik,jspin) @@ -287,8 +287,3 @@ CONTAINS RETURN END SUBROUTINE od_vacfun END MODULE m_od_vacfun - - - - - diff --git a/eigen/vacfun.f90 b/eigen/vacfun.f90 index caa5b2b9..e06bf7ad 100644 --- a/eigen/vacfun.f90 +++ b/eigen/vacfun.f90 @@ -32,16 +32,16 @@ CONTAINS ! .. ! .. Array Arguments .. INTEGER, INTENT (IN) :: nv2(:)!(input%jspins) - INTEGER, INTENT (IN) :: kvac(:,:,:)!(2,dimension%nv2d,input%jspins) + INTEGER, INTENT (IN) :: kvac(:,:,:)!(2,lapw%dim_nv2d(),input%jspins) COMPLEX, INTENT (IN) :: vxy(:,:,:,:) !(vacuum%nmzxyd,stars%ng2-1,nvac,:) - COMPLEX, INTENT (OUT):: tddv(:,:),tduv(:,:)!(dimension%nv2d,dimension%nv2d) - COMPLEX, INTENT (OUT):: tudv(:,:),tuuv(:,:)!(dimension%nv2d,dimension%nv2d) + COMPLEX, INTENT (OUT):: tddv(:,:),tduv(:,:)!(lapw%dim_nv2d(),lapw%dim_nv2d()) + COMPLEX, INTENT (OUT):: tudv(:,:),tuuv(:,:)!(lapw%dim_nv2d(),lapw%dim_nv2d()) REAL,ALLOCATABLE,INTENT (IN) :: vz(:,:,:) !(vacuum%nmzd,2,4) , REAL, INTENT (IN) :: evac(:,:)!(2,input%jspins) REAL, INTENT (IN) :: bkpt(3) - REAL, INTENT (OUT):: udz(:,:),uz(:,:)!(dimension%nv2d,input%jspins) - REAL, INTENT (OUT):: dudz(:,:),duz(:,:)!(dimension%nv2d,input%jspins) - REAL, INTENT (OUT):: ddnv(:,:)!(dimension%nv2d,input%jspins) + REAL, INTENT (OUT):: udz(:,:),uz(:,:)!(lapw%dim_nv2d(),input%jspins) + REAL, INTENT (OUT):: dudz(:,:),duz(:,:)!(lapw%dim_nv2d(),input%jspins) + REAL, INTENT (OUT):: ddnv(:,:)!(lapw%dim_nv2d(),input%jspins) ! .. ! .. Local Scalars .. REAL ev,scale,xv,yv,vzero,fac diff --git a/eigen_secvar/aline.F90 b/eigen_secvar/aline.F90 index d3f7043c..6ca813f6 100644 --- a/eigen_secvar/aline.F90 +++ b/eigen_secvar/aline.F90 @@ -7,7 +7,7 @@ MODULE m_aline USE m_juDFT CONTAINS - SUBROUTINE aline(eig_id, nk,atoms,DIMENSION,sym,& + SUBROUTINE aline(eig_id, nk,atoms,sym,& cell,input, jsp,el,usdus,lapw,tlmplm, noco, oneD,eig,ne,zMat,hmat,smat) !************************************************************************ !* * @@ -34,7 +34,7 @@ CONTAINS USE m_eig66_io USE m_types IMPLICIT NONE - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco @@ -54,7 +54,7 @@ CONTAINS ! .. ! .. Array Arguments .. REAL, INTENT (IN) :: el(0:atoms%lmaxd,atoms%ntype,input%jspins) - REAL, INTENT (OUT) :: eig(DIMENSION%neigd) + REAL, INTENT (OUT) :: eig(input%neig) TYPE(t_mat),INTENT(IN):: hmat,smat ! .. @@ -79,10 +79,10 @@ CONTAINS l_real=zMat%l_real - lhelp= MAX(lapw%nmat,(DIMENSION%neigd+2)*DIMENSION%neigd) + lhelp= MAX(lapw%nmat,(input%neig+2)*input%neig) CALL read_eig(eig_id,nk,jsp,neig=ne, eig=eig,zmat=zmat) IF (l_real) THEN - ALLOCATE ( h_r(DIMENSION%neigd,DIMENSION%neigd),s_r(DIMENSION%neigd,DIMENSION%neigd) ) + ALLOCATE ( h_r(input%neig,input%neig),s_r(input%neig,input%neig) ) h_r = 0.0 ; s_r=0.0 ALLOCATE ( help_r(lhelp) ) ELSE @@ -91,7 +91,7 @@ CONTAINS ! multiplication with a and b matrices. zmat%data_c=conjg(zmat%data_c) - ALLOCATE ( h_c(DIMENSION%neigd,DIMENSION%neigd),s_c(DIMENSION%neigd,DIMENSION%neigd) ) + ALLOCATE ( h_c(input%neig,input%neig),s_c(input%neig,input%neig) ) h_c = 0.0 ; s_c=0.0 ALLOCATE ( help_r(lhelp) ) ENDIF @@ -126,8 +126,8 @@ CONTAINS END DO END DO - ALLOCATE ( acof(DIMENSION%neigd,0:DIMENSION%lmd,atoms%nat),bcof(DIMENSION%neigd,0:DIMENSION%lmd,atoms%nat) ) - ALLOCATE ( ccof(-atoms%llod:atoms%llod,DIMENSION%neigd,atoms%nlod,atoms%nat) ) + ALLOCATE ( acof(input%neig,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat),bcof(input%neig,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat) ) + ALLOCATE ( ccof(-atoms%llod:atoms%llod,input%neig,atoms%nlod,atoms%nat) ) ! conjugate again for use with abcof; finally use cdotc to revert again IF (.NOT.l_real) zMat%data_c = CONJG(zMat%data_c) @@ -140,10 +140,10 @@ CONTAINS ! CALL timestart("aline: hssr_wu") IF (l_real) THEN - CALL hssr_wu(atoms,DIMENSION,sym, jsp,el,ne,usdus,lapw,input,& + CALL hssr_wu(atoms,sym, jsp,el,ne,usdus,lapw,input,& tlmplm, acof,bcof,ccof, h_r,s_r) ELSE - CALL hssr_wu(atoms,DIMENSION,sym, jsp,el,ne,usdus,lapw,input,& + CALL hssr_wu(atoms,sym, jsp,el,ne,usdus,lapw,input,& tlmplm, acof,bcof,ccof, h_c=h_c,s_c=s_c) ENDIF @@ -154,10 +154,10 @@ CONTAINS ! IF (l_real) THEN !---> LAPACK call - CALL CPP_LAPACK_ssygv(1,'V','L',ne,h_r,DIMENSION%neigd,s_r,DIMENSION%neigd,eig,help_r,lhelp,info) + CALL CPP_LAPACK_ssygv(1,'V','L',ne,h_r,input%neig,s_r,input%neig,eig,help_r,lhelp,info) ELSE ALLOCATE ( rwork(MAX(1,3*ne-2)) ) - CALL CPP_LAPACK_chegv(1,'V','L',ne,h_c,DIMENSION%neigd,s_c,DIMENSION%neigd,eig,help_c,lhelp,rwork,info) + CALL CPP_LAPACK_chegv(1,'V','L',ne,h_c,input%neig,s_c,input%neig,eig,help_c,lhelp,rwork,info) DEALLOCATE ( rwork ) ENDIF IF (info /= 0) THEN diff --git a/eigen_secvar/aline_muff.F90 b/eigen_secvar/aline_muff.F90 index 184d3009..c0f44258 100644 --- a/eigen_secvar/aline_muff.F90 +++ b/eigen_secvar/aline_muff.F90 @@ -22,14 +22,14 @@ MODULE m_alinemuff !* * !************************************************************************ CONTAINS - SUBROUTINE aline_muff(atoms,DIMENSION,sym, cell, jsp,ne, usdus,td, bkpt,lapw, eig,z_r,z_c,realdata) + SUBROUTINE aline_muff(atoms,input,sym, cell, jsp,ne, usdus,td, bkpt,lapw, eig,z_r,z_c,realdata) #include"cpp_double.h" USE m_hnonmuff USE m_types IMPLICIT NONE - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_input),INTENT(IN) :: input TYPE(t_sym),INTENT(IN) :: sym TYPE(t_cell),INTENT(IN) :: cell TYPE(t_atoms),INTENT(IN) :: atoms @@ -38,14 +38,14 @@ CONTAINS TYPE(t_tlmplm),INTENT(IN) :: td ! .. ! .. Scalar Arguments .. - INTEGER, INTENT (IN) :: jsp,ne + INTEGER, INTENT (IN) :: jsp,ne ! .. ! .. Array Arguments .. - REAL, INTENT (IN) :: bkpt(3) - REAL, INTENT (INOUT) :: eig(DIMENSION%neigd) + REAL, INTENT (IN) :: bkpt(3) + REAL, INTENT (INOUT) :: eig(input%neig) - REAL, OPTIONAL,INTENT (INOUT) :: z_r(DIMENSION%nbasfcn,ne) - COMPLEX, OPTIONAL,INTENT (INOUT) :: z_c(DIMENSION%nbasfcn,ne) + REAL, OPTIONAL,INTENT (INOUT) :: z_r(lapw%dim_nbasfcn(),ne) + COMPLEX, OPTIONAL,INTENT (INOUT) :: z_c(lapw%dim_nbasfcn(),ne) LOGICAL,OPTIONAL,INTENT(IN):: realdata ! .. ! .. Local Scalars .. @@ -73,9 +73,9 @@ CONTAINS ii = (i-1)*i/2 + i h(ii) = eig(i) END DO - + !---> add the off-diagonal (non-muffin-tin) terms - CALL h_nonmuff(atoms,DIMENSION,sym, cell, jsp,ne, usdus,td, bkpt,lapw, h,l_real,z_r,z_c) + CALL h_nonmuff(atoms,input,sym, cell, jsp,ne, usdus,td, bkpt,lapw, h,l_real,z_r,z_c) !---> DIAGONALIZE THE HAMILTONIAN USING LIBRARY-ROUTINES #ifdef CPP_ESSL diff --git a/eigen_secvar/h_nonmuff.F90 b/eigen_secvar/h_nonmuff.F90 index b1a361f0..55e019af 100644 --- a/eigen_secvar/h_nonmuff.F90 +++ b/eigen_secvar/h_nonmuff.F90 @@ -11,7 +11,7 @@ MODULE m_hnonmuff ! r. p 1995 !********************************************************************* CONTAINS - SUBROUTINE h_nonmuff(atoms,DIMENSION,sym,cell, jsp,ne,usdus,td, bkpt,lapw, h,l_real,z_r,z_c) + SUBROUTINE h_nonmuff(atoms,input,sym,cell, jsp,ne,usdus,td, bkpt,lapw, h,l_real,z_r,z_c) USE m_constants, ONLY : fpi_const,tpi_const USE m_types @@ -20,7 +20,7 @@ CONTAINS USE m_ylm IMPLICIT NONE - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_input),INTENT(IN) :: input TYPE(t_sym),INTENT(IN) :: sym TYPE(t_cell),INTENT(IN) :: cell TYPE(t_atoms),INTENT(IN) :: atoms @@ -29,15 +29,15 @@ CONTAINS ! .. ! .. Scalar Arguments .. LOGICAL,INTENT(IN) :: l_real - INTEGER, INTENT (IN) :: jsp,ne + INTEGER, INTENT (IN) :: jsp,ne ! .. TYPE(t_tlmplm),INTENT(IN)::td ! .. Array Arguments .. - REAL, INTENT (IN) :: bkpt(3) + REAL, INTENT (IN) :: bkpt(3) REAL, INTENT (INOUT) :: h(ne*(ne+1)/2) - REAL, OPTIONAL,INTENT (IN) :: z_r(DIMENSION%nbasfcn,ne) - COMPLEX, OPTIONAL,INTENT (IN) :: z_c(DIMENSION%nbasfcn,ne) + REAL, OPTIONAL,INTENT (IN) :: z_r(lapw%dim_nbasfcn(),ne) + COMPLEX, OPTIONAL,INTENT (IN) :: z_c(lapw%dim_nbasfcn(),ne) ! .. ! .. Local Scalars .. COMPLEX dtd,dtu,hij,phase,sij,utd,utu @@ -46,8 +46,8 @@ CONTAINS INTEGER i,im,in,j,k,ke ,m1,n,na,nn,np,ii,ij,m ! .. ! .. Local Arrays .. - COMPLEX a(DIMENSION%neigd,0:DIMENSION%lmd),ax(DIMENSION%neigd) - COMPLEX b(DIMENSION%neigd,0:DIMENSION%lmd),bx(DIMENSION%neigd), ylm( (atoms%lmaxd+1)**2 ) + COMPLEX a(input%neig,0:atoms%lmaxd*(atoms%lmaxd+2)),ax(input%neig) + COMPLEX b(input%neig,0:atoms%lmaxd*(atoms%lmaxd+2)),bx(input%neig), ylm( (atoms%lmaxd+1)**2 ) REAL vmult(3),vsmult(3),f(0:atoms%lmaxd,SIZE(lapw%k1,1)),g(0:atoms%lmaxd,SIZE(lapw%k1,1)) ! .. ! .. diff --git a/eigen_secvar/hssr_wu.F90 b/eigen_secvar/hssr_wu.F90 index 167171f9..b722ce77 100644 --- a/eigen_secvar/hssr_wu.F90 +++ b/eigen_secvar/hssr_wu.F90 @@ -8,13 +8,13 @@ MODULE m_hssrwu ! r. wu 1992 !********************************************************************* CONTAINS - SUBROUTINE hssr_wu(atoms,DIMENSION,sym, jsp,el,ne,usdus,lapw,input,& + SUBROUTINE hssr_wu(atoms,sym, jsp,el,ne,usdus,lapw,input,& tlmplm,acof,bcof,ccof, h_r,s_r,h_c,s_c) ! USE m_types IMPLICIT NONE - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_sym),INTENT(IN) :: sym TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_usdus),INTENT(IN) :: usdus @@ -27,12 +27,12 @@ CONTAINS ! .. ! .. Array Arguments .. REAL, INTENT (IN) :: el(0:atoms%lmaxd,atoms%ntype,input%jspins) - COMPLEX, INTENT (IN) :: acof(DIMENSION%neigd,0:DIMENSION%lmd,atoms%nat) - COMPLEX, INTENT (IN) :: bcof(DIMENSION%neigd,0:DIMENSION%lmd,atoms%nat) - COMPLEX, INTENT (IN) :: ccof(-atoms%llod:atoms%llod,DIMENSION%neigd,atoms%nlod,atoms%nat) + COMPLEX, INTENT (IN) :: acof(input%neig,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat) + COMPLEX, INTENT (IN) :: bcof(input%neig,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat) + COMPLEX, INTENT (IN) :: ccof(-atoms%llod:atoms%llod,input%neig,atoms%nlod,atoms%nat) - REAL, OPTIONAL,INTENT (INOUT) :: h_r(DIMENSION%neigd,DIMENSION%neigd),s_r(DIMENSION%neigd,DIMENSION%neigd) - COMPLEX, OPTIONAL,INTENT (INOUT) :: h_c(DIMENSION%neigd,DIMENSION%neigd),s_c(DIMENSION%neigd,DIMENSION%neigd) + REAL, OPTIONAL,INTENT (INOUT) :: h_r(input%neig,input%neig),s_r(input%neig,input%neig) + COMPLEX, OPTIONAL,INTENT (INOUT) :: h_c(input%neig,input%neig),s_c(input%neig,input%neig) ! .. ! .. Local Scalars .. @@ -50,8 +50,8 @@ CONTAINS l_real=PRESENT(h_r) - ALLOCATE ( a(DIMENSION%neigd,0:DIMENSION%lmd),ax(DIMENSION%neigd) ) - ALLOCATE ( b(DIMENSION%neigd,0:DIMENSION%lmd),bx(DIMENSION%neigd) ) + ALLOCATE ( a(input%neig,0:atoms%lmaxd*(atoms%lmaxd+2)),ax(input%neig) ) + ALLOCATE ( b(input%neig,0:atoms%lmaxd*(atoms%lmaxd+2)),bx(input%neig) ) na = 0 DO n = 1,atoms%ntype ! loop over atom-types lwn = atoms%lmax(n) @@ -62,7 +62,7 @@ CONTAINS CALL timestart("hssr_wu: spherical") IF (sym%invsat(na).EQ.0) invsfct = 1.0 IF (sym%invsat(na).EQ.1) invsfct = SQRT(2.0) - DO lm = 0, DIMENSION%lmd + DO lm = 0, atoms%lmaxd*(atoms%lmaxd+2) DO ke = 1, ne a(ke,lm) = invsfct*acof(ke,lm,na) b(ke,lm) = invsfct*bcof(ke,lm,na) diff --git a/eigen_soc/abcof_soc.F90 b/eigen_soc/abcof_soc.F90 index 637cccc1..29cd9523 100644 --- a/eigen_soc/abcof_soc.F90 +++ b/eigen_soc/abcof_soc.F90 @@ -32,8 +32,8 @@ CONTAINS INTEGER, INTENT (IN) :: jspin ! .. ! .. Array Arguments .. - COMPLEX, INTENT (OUT) :: acof(:,0:,:)!(nobd,0:dimension%lmd,nat_l) - COMPLEX, INTENT (OUT) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,nat_l) + COMPLEX, INTENT (OUT) :: acof(:,0:,:)!(nobd,0:atoms%lmaxd*(atoms%lmaxd+2),nat_l) + COMPLEX, INTENT (OUT) :: bcof(:,0:,:)!(nobd,0:atoms%lmaxd*(atoms%lmaxd+2),nat_l) COMPLEX, INTENT (OUT) :: ccof(-atoms%llod:,:,:,:)!(-llod:llod,nobd,atoms%nlod,nat_l) ! .. ! .. Local Scalars .. diff --git a/eigen_soc/alineso.F90 b/eigen_soc/alineso.F90 index 0cbcd454..f8d9639e 100644 --- a/eigen_soc/alineso.F90 +++ b/eigen_soc/alineso.F90 @@ -6,7 +6,7 @@ MODULE m_alineso ! Eigenvalues and vectors (eig_so and zso) are returned !---------------------------------------------------------------------- CONTAINS - SUBROUTINE alineso(eig_id,lapw,mpi,DIMENSION,atoms,sym,kpts,input,noco,& + SUBROUTINE alineso(eig_id,lapw,mpi,atoms,sym,kpts,input,noco,& cell,oneD, nk, usdus,rsoc,nsize,nmat, eig_so,zso) #include"cpp_double.h" @@ -17,7 +17,7 @@ CONTAINS IMPLICIT NONE TYPE(t_mpi),INTENT(IN) :: mpi TYPE(t_lapw),INTENT(IN) :: lapw - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco @@ -34,8 +34,8 @@ CONTAINS INTEGER, INTENT (OUT):: nsize,nmat ! .. ! .. Array Arguments .. - COMPLEX, INTENT (OUT) :: zso(:,:,:)!(dimension%nbasfcn,2*dimension%neigd,wannierspin) - REAL, INTENT (OUT) :: eig_so(2*DIMENSION%neigd) + COMPLEX, INTENT (OUT) :: zso(:,:,:)!(lapw%dim_nbasfcn(),2*input%neig,wannierspin) + REAL, INTENT (OUT) :: eig_so(2*input%neig) !-odim !+odim ! .. @@ -51,7 +51,7 @@ CONTAINS ! .. ! .. Local Arrays .. INTEGER :: nsz(2) - REAL :: eig(DIMENSION%neigd,input%jspins),s(3) + REAL :: eig(input%neig,input%jspins),s(3) REAL, ALLOCATABLE :: rwork(:) COMPLEX,ALLOCATABLE :: cwork(:),chelp(:,:,:,:,:) COMPLEX,ALLOCATABLE :: ahelp(:,:,:,:),bhelp(:,:,:,:) @@ -70,22 +70,22 @@ CONTAINS l_real=sym%invs.and..not.noco%l_noco.and..not.(noco%l_soc.and.atoms%n_u>0) zmat%l_real=l_real zMat(1:input%jspins)%matsize1=lapw%nv(1:input%jspins)+atoms%nlotot - zmat%matsize2=dimension%neigd + zmat%matsize2=input%neig INQUIRE (4649,opened=l_socvec) INQUIRE (file='fleur.qsgw',exist=l_qsgw) if (l_real) THEN - ALLOCATE (zmat(1)%data_r(zmat(1)%matsize1,DIMENSION%neigd) ) + ALLOCATE (zmat(1)%data_r(zmat(1)%matsize1,input%neig) ) zmat(1)%data_r(:,:)= 0. if (size(zmat)==2)THEN - ALLOCATE(zmat(2)%data_r(zmat(2)%matsize1,DIMENSION%neigd) ) + ALLOCATE(zmat(2)%data_r(zmat(2)%matsize1,input%neig) ) zmat(2)%data_r=0.0 ENDIF else - ALLOCATE (zmat(1)%data_c(zmat(1)%matsize1,DIMENSION%neigd) ) + ALLOCATE (zmat(1)%data_c(zmat(1)%matsize1,input%neig) ) zmat(1)%data_c(:,:)= 0. if (size(zmat)==2)THEN - ALLOCATE(zmat(2)%data_c(zmat(2)%matsize1,DIMENSION%neigd) ) + ALLOCATE(zmat(2)%data_c(zmat(2)%matsize1,input%neig) ) zmat(2)%data_c=0.0 ENDIF endif @@ -107,8 +107,8 @@ CONTAINS !!$ lapw%rk(i,1) = SQRT(r2) !!$ ENDDO - IF (ne.GT.DIMENSION%neigd) THEN - WRITE (6,'(a13,i4,a8,i4)') 'alineso: ne=',ne,' > dimension%neigd=',DIMENSION%neigd + IF (ne.GT.input%neig) THEN + WRITE (6,'(a13,i4,a8,i4)') 'alineso: ne=',ne,' > input%neig=',input%neig CALL juDFT_error("alineso: ne > neigd",calledby="alineso") ENDIF nsz(jsp) = ne @@ -147,11 +147,11 @@ CONTAINS nat_l = nat_stop - nat_start + 1 ! set up A and B coefficients - ALLOCATE (ahelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,DIMENSION%neigd,input%jspins)) - ALLOCATE (bhelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,DIMENSION%neigd,input%jspins)) - ALLOCATE (chelp(-atoms%llod :atoms%llod, DIMENSION%neigd,atoms%nlod,nat_l,input%jspins)) + ALLOCATE (ahelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,input%neig,input%jspins)) + ALLOCATE (bhelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,input%neig,input%jspins)) + ALLOCATE (chelp(-atoms%llod :atoms%llod, input%neig,atoms%nlod,nat_l,input%jspins)) CALL timestart("alineso SOC: -help") - CALL hsohelp(DIMENSION,atoms,sym,input,lapw,nsz,cell,zmat,usdus,& + CALL hsohelp(atoms,sym,input,lapw,nsz,cell,zmat,usdus,& zso,noco,oneD,nat_start,nat_stop,nat_l,ahelp,bhelp,chelp) CALL timestop("alineso SOC: -help") @@ -160,8 +160,8 @@ CONTAINS #ifdef CPP_MPI CALL MPI_BARRIER(mpi%MPI_COMM,ierr) #endif - ALLOCATE (hsomtx(DIMENSION%neigd,DIMENSION%neigd,2,2)) - CALL hsoham(atoms,noco,input,nsz,dimension%neigd,chelp,rsoc,ahelp,bhelp,& + ALLOCATE (hsomtx(input%neig,input%neig,2,2)) + CALL hsoham(atoms,noco,input,nsz,input%neig,chelp,rsoc,ahelp,bhelp,& nat_start,nat_stop,mpi%n_rank,mpi%n_size,mpi%SUB_COMM,hsomtx) DEALLOCATE (ahelp,bhelp,chelp) CALL timestop("alineso SOC: -ham") @@ -182,7 +182,7 @@ CONTAINS ! ! resort H-matrix ! - ALLOCATE (hso(2*DIMENSION%neigd,2*DIMENSION%neigd)) + ALLOCATE (hso(2*input%neig,2*input%neig)) DO jsp = 1,2 DO jsp1 = 1,2 IF (jsp.EQ.1) nn = 0 @@ -254,8 +254,8 @@ else ! ! diagonalize the hamiltonian using library-routines ! - idim_c = 4*DIMENSION%neigd - idim_r = 6*DIMENSION%neigd + idim_c = 4*input%neig + idim_r = 6*input%neig CALL timestart("alineso SOC: -diag") @@ -266,7 +266,7 @@ else ELSE vectors= 'V' ENDIF - CALL CPP_LAPACK_cheev(vectors,'U',nsize,hso,2*DIMENSION%neigd,eig_so,& + CALL CPP_LAPACK_cheev(vectors,'U',nsize,hso,2*input%neig,eig_so,& cwork, idim_c, rwork, info) IF (info.NE.0) WRITE (6,FMT=8000) info 8000 FORMAT (' AFTER CPP_LAPACK_cheev: info=',i4) @@ -277,7 +277,7 @@ else IF (input%eonly) THEN IF(l_socvec) CALL juDFT_error("EONLY set. Vectors not calculated.",calledby ="alineso") ELSE - ALLOCATE (zhelp2(DIMENSION%neigd,2*DIMENSION%neigd)) + ALLOCATE (zhelp2(input%neig,2*input%neig)) ! ! proj. back to G - space: old eigenvector 'z' to new one 'Z' ! + @@ -305,18 +305,18 @@ else ENDDO ! j if (l_real) THEN - CALL CPP_BLAS_cgemm("N","N",zmat(1)%matsize1,2*dimension%neigd,dimension%neigd,CMPLX(1.0,0.0),CMPLX(zmat(jsp)%data_r(:,:)),& - zmat(1)%matsize1, zhelp2,DIMENSION%neigd,CMPLX(0.0,0.0), zso(1,1,jsp2),zmat(1)%matsize1) + CALL CPP_BLAS_cgemm("N","N",zmat(1)%matsize1,2*input%neig,input%neig,CMPLX(1.0,0.0),CMPLX(zmat(jsp)%data_r(:,:)),& + zmat(1)%matsize1, zhelp2,input%neig,CMPLX(0.0,0.0), zso(1,1,jsp2),zmat(1)%matsize1) else - CALL CPP_BLAS_cgemm("N","N",zmat(1)%matsize1,2*dimension%neigd,dimension%neigd, CMPLX(1.0,0.0),zmat(jsp)%data_c(:,:),& - zmat(1)%matsize1, zhelp2,DIMENSION%neigd,CMPLX(0.0,0.0), zso(:,:,jsp2),zmat(1)%matsize1) + CALL CPP_BLAS_cgemm("N","N",zmat(1)%matsize1,2*input%neig,input%neig, CMPLX(1.0,0.0),zmat(jsp)%data_c(:,:),& + zmat(1)%matsize1, zhelp2,input%neig,CMPLX(0.0,0.0), zso(:,:,jsp2),zmat(1)%matsize1) endif ENDDO !isp IF(l_socvec) THEN !RS: write SOC vectors to SOCVEC - WRITE(4649) lapw%nmat,nsize,input%jspins,nsz,2*DIMENSION%neigd,CONJG(hso) + WRITE(4649) lapw%nmat,nsize,input%jspins,nsz,2*input%neig,CONJG(hso) !CF: write qsgw IF(l_qsgw) THEN nn = 2*nsz(1) diff --git a/eigen_soc/eigenso.F90 b/eigen_soc/eigenso.F90 index 0bcffd6a..ff0ce226 100644 --- a/eigen_soc/eigenso.F90 +++ b/eigen_soc/eigenso.F90 @@ -20,7 +20,7 @@ MODULE m_eigenso !********************************************************************** ! CONTAINS - SUBROUTINE eigenso(eig_id,mpi,DIMENSION,stars,vacuum,atoms,sphhar,& + SUBROUTINE eigenso(eig_id,mpi,stars,vacuum,atoms,sphhar,& sym,cell,noco,input,kpts,oneD,vTot,enpara,results) USE m_types @@ -34,7 +34,7 @@ CONTAINS IMPLICIT NONE TYPE(t_mpi),INTENT(IN) :: mpi - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_input),INTENT(IN) :: input TYPE(t_vacuum),INTENT(IN) :: vacuum @@ -117,8 +117,8 @@ CONTAINS ! - ALLOCATE (eig_so(2*DIMENSION%neigd)) - ALLOCATE (eigBuffer(2*DIMENSION%neigd,kpts%nkpt,wannierspin)) + ALLOCATE (eig_so(2*input%neig)) + ALLOCATE (eigBuffer(2*input%neig,kpts%nkpt,wannierspin)) ALLOCATE (neigBuffer(kpts%nkpt,wannierspin)) results%eig = 1.0e300 eigBuffer = 1.0e300 @@ -132,10 +132,10 @@ CONTAINS nk=mpi%k_list(nk_i) !DO nk = mpi%n_start,n_end,n_stride CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,.FALSE., mpi) - ALLOCATE( zso(lapw%nv(1)+atoms%nlotot,2*DIMENSION%neigd,wannierspin)) + ALLOCATE( zso(lapw%nv(1)+atoms%nlotot,2*input%neig,wannierspin)) zso(:,:,:) = CMPLX(0.0,0.0) CALL timestart("eigenso: alineso") - CALL alineso(eig_id,lapw, mpi,DIMENSION,atoms,sym,kpts,& + CALL alineso(eig_id,lapw, mpi,atoms,sym,kpts,& input,noco,cell,oneD,nk,usdus,rsoc,nsz,nmat, eig_so,zso) CALL timestop("eigenso: alineso") IF (mpi%irank.EQ.0) THEN @@ -169,12 +169,12 @@ CONTAINS #ifdef CPP_MPI CALL MPI_ALLREDUCE(neigBuffer,results%neig,kpts%nkpt*wannierspin,MPI_INTEGER,MPI_SUM,mpi%mpi_comm,ierr) - CALL MPI_ALLREDUCE(eigBuffer(:2*dimension%neigd,:,:),results%eig(:2*dimension%neigd,:,:),& - 2*dimension%neigd*kpts%nkpt*wannierspin,MPI_DOUBLE_PRECISION,MPI_MIN,mpi%mpi_comm,ierr) + CALL MPI_ALLREDUCE(eigBuffer(:2*input%neig,:,:),results%eig(:2*input%neig,:,:),& + 2*input%neig*kpts%nkpt*wannierspin,MPI_DOUBLE_PRECISION,MPI_MIN,mpi%mpi_comm,ierr) CALL MPI_BARRIER(mpi%MPI_COMM,ierr) #else results%neig(:,:) = neigBuffer(:,:) - results%eig(:2*dimension%neigd,:,:) = eigBuffer(:2*dimension%neigd,:,:) + results%eig(:2*input%neig,:,:) = eigBuffer(:2*input%neig,:,:) #endif RETURN diff --git a/eigen_soc/hsohelp.F90 b/eigen_soc/hsohelp.F90 index b67685f0..7767e94f 100644 --- a/eigen_soc/hsohelp.F90 +++ b/eigen_soc/hsohelp.F90 @@ -16,7 +16,7 @@ MODULE m_hsohelp !********************************************************************* ! CONTAINS - SUBROUTINE hsohelp(DIMENSION,atoms,sym,input,lapw,nsz, cell,& + SUBROUTINE hsohelp(atoms,sym,input,lapw,nsz, cell,& zmat,usdus, zso,noco,oneD,& nat_start,nat_stop,nat_l,ahelp,bhelp,chelp) ! @@ -27,7 +27,7 @@ CONTAINS INCLUDE 'mpif.h' INTEGER ierr(3) #endif - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco @@ -42,11 +42,11 @@ CONTAINS INTEGER, INTENT (IN) :: nat_start,nat_stop,nat_l ! .. Array Arguments .. INTEGER, INTENT (IN) :: nsz(input%jspins) - COMPLEX, INTENT (INOUT) :: zso(:,:,:)!DIMENSION%nbasfcn,2*DIMENSION%neigd,input%jspins) - COMPLEX, INTENT (OUT):: ahelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,DIMENSION%neigd,input%jspins) - COMPLEX, INTENT (OUT):: bhelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,DIMENSION%neigd,input%jspins) - COMPLEX, INTENT (OUT):: chelp(-atoms%llod :atoms%llod, DIMENSION%neigd,atoms%nlod,nat_l,input%jspins) - TYPE(t_mat),INTENT(IN) :: zmat(:) ! (DIMENSION%nbasfcn,DIMENSION%neigd,input%jspins) + COMPLEX, INTENT (INOUT) :: zso(:,:,:)!lapw%dim_nbasfcn(),2*input%neig,input%jspins) + COMPLEX, INTENT (OUT):: ahelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,input%neig,input%jspins) + COMPLEX, INTENT (OUT):: bhelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,input%neig,input%jspins) + COMPLEX, INTENT (OUT):: chelp(-atoms%llod :atoms%llod, input%neig,atoms%nlod,nat_l,input%jspins) + TYPE(t_mat),INTENT(IN) :: zmat(:) ! (lapw%dim_nbasfcn(),input%neig,input%jspins) !-odim !+odim ! .. @@ -63,9 +63,9 @@ CONTAINS ! some praparations to match array sizes ! nv1(1) = lapw%nv(1) ; nv1(input%jspins) = lapw%nv(1) - ALLOCATE (g1(DIMENSION%nvd,input%jspins)) - ALLOCATE (g2(DIMENSION%nvd,input%jspins)) - ALLOCATE (g3(DIMENSION%nvd,input%jspins)) + ALLOCATE (g1(lapw%dim_nvd(),input%jspins)) + ALLOCATE (g2(lapw%dim_nvd(),input%jspins)) + ALLOCATE (g3(lapw%dim_nvd(),input%jspins)) g1 = 0 ; g2 = 0 ; g3 = 0 g1(:SIZE(lapw%k1,1),1) = lapw%k1(:SIZE(lapw%k1,1),1) ; g1(:SIZE(lapw%k1,1),input%jspins) = lapw%k1(:SIZE(lapw%k1,1),1) g2(:SIZE(lapw%k1,1),1) = lapw%k2(:SIZE(lapw%k1,1),1) ; g2(:SIZE(lapw%k1,1),input%jspins) = lapw%k2(:SIZE(lapw%k1,1),1) @@ -73,15 +73,15 @@ CONTAINS chelp(:,:,:,:,input%jspins) = CMPLX(0.0,0.0) - ALLOCATE ( acof(DIMENSION%neigd,0:lmd,nat_l),bcof(DIMENSION%neigd,0:lmd,nat_l) ) + ALLOCATE ( acof(input%neig,0:lmd,nat_l),bcof(input%neig,0:lmd,nat_l) ) DO ispin = 1, input%jspins IF (zmat(1)%l_real.AND.noco%l_soc) THEN - zso(:,1:DIMENSION%neigd,ispin) = CMPLX(zmat(ispin)%data_r(:,1:DIMENSION%neigd),0.0) + zso(:,1:input%neig,ispin) = CMPLX(zmat(ispin)%data_r(:,1:input%neig),0.0) zMat_local%l_real = .FALSE. zMat_local%matsize1 = zmat(1)%matsize1 - zMat_local%matsize2 = DIMENSION%neigd - ALLOCATE(zMat_local%data_c(zmat(1)%matsize1,DIMENSION%neigd)) - zMat_local%data_c(:,:) = zso(:,1:DIMENSION%neigd,ispin) + zMat_local%matsize2 = input%neig + ALLOCATE(zMat_local%data_c(zmat(1)%matsize1,input%neig)) + zMat_local%data_c(:,:) = zso(:,1:input%neig,ispin) CALL abcof_soc(input,atoms,sym,cell,lapw,nsz(ispin),& usdus, noco,ispin,oneD,nat_start,nat_stop,nat_l,& acof,bcof,chelp(-atoms%llod:,:,:,:,ispin),zMat_local) @@ -90,7 +90,7 @@ CONTAINS ! ! transfer (a,b)cofs to (a,b)helps used in hsoham ! - DO ie = 1, DIMENSION%neigd + DO ie = 1, input%neig DO na = 1, nat_l DO l = 1, atoms%lmaxd ll1 = l*(l+1) @@ -105,8 +105,8 @@ CONTAINS ELSE zMat_local%l_real = zmat(1)%l_real zMat_local%matsize1 = zmat(1)%matsize1 - zMat_local%matsize2 = DIMENSION%neigd - ALLOCATE(zMat_local%data_c(zmat(1)%matsize1,DIMENSION%neigd)) + zMat_local%matsize2 = input%neig + ALLOCATE(zMat_local%data_c(zmat(1)%matsize1,input%neig)) zMat_local%data_c(:,:) = zmat(ispin)%data_c(:,:) CALL abcof_soc(input,atoms,sym,cell,lapw,nsz(ispin),& usdus,noco,ispin,oneD,nat_start,nat_stop,nat_l,& @@ -115,7 +115,7 @@ CONTAINS ! ! transfer (a,b)cofs to (a,b)helps used in hsoham ! - DO ie = 1, DIMENSION%neigd + DO ie = 1, input%neig DO na = 1, nat_l DO l = 1, atoms%lmaxd ll1 = l*(l+1) diff --git a/eigen_soc/ssomat.F90 b/eigen_soc/ssomat.F90 index 2206dc59..4a98cac1 100644 --- a/eigen_soc/ssomat.F90 +++ b/eigen_soc/ssomat.F90 @@ -2,9 +2,9 @@ MODULE m_ssomat USE m_judft IMPLICIT NONE CONTAINS - SUBROUTINE ssomat(seigvso,theta,phi,eig_id,DIMENSION,atoms,kpts,sym,& + SUBROUTINE ssomat(seigvso,theta,phi,eig_id,atoms,kpts,sym,& cell,noco, input,mpi, oneD,enpara,v,results ) - + USE m_types_mat USE m_types_setup USE m_types_mpi @@ -17,12 +17,12 @@ CONTAINS USE m_types_lapw USE m_constants USE m_eig66_io - USE m_spnorb - USE m_abcof + USE m_spnorb + USE m_abcof IMPLICIT NONE TYPE(t_mpi),INTENT(IN) :: mpi - TYPE(t_dimension),INTENT(IN) :: dimension + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco @@ -44,17 +44,17 @@ CONTAINS #endif INTEGER :: neigf=1 !not full-matrix INTEGER :: ilo,js,jsloc,nk,n,l ,lm,band,nr,ne,nat,m - INTEGER :: na - REAL :: r1,r2 - COMPLEX :: c1,c2 + INTEGER :: na + REAL :: r1,r2 + COMPLEX :: c1,c2 - COMPLEX, ALLOCATABLE :: matel(:,:,:) - REAL, ALLOCATABLE :: eig_shift(:,:,:) + COMPLEX, ALLOCATABLE :: matel(:,:,:) + REAL, ALLOCATABLE :: eig_shift(:,:,:) COMPLEX, ALLOCATABLE :: acof(:,:,:,:,:), bcof(:,:,:,:,:) COMPLEX, ALLOCATABLE :: ccof(:,:,:,:,:,:) COMPLEX,ALLOCATABLE :: soangl(:,:,:,:,:,:,:) - + TYPE(t_rsoc) :: rsoc TYPE(t_mat) :: zmat TYPE(t_usdus):: usdus @@ -64,17 +64,17 @@ CONTAINS ' properly for more than one atom per type!',calledby="ssomat") - - ! needed directly for calculating matrix elements + + ! needed directly for calculating matrix elements seigvso=0.0 - ALLOCATE(eig_shift(DIMENSION%neigd,kpts%nkpt,SIZE(theta)));eig_shift=0.0 - ALLOCATE( acof(dimension%neigd,0:dimension%lmd,atoms%nat,2,2),& - bcof(dimension%neigd,0:dimension%lmd,atoms%nat,2,2) ) - ALLOCATE( ccof(-atoms%llod:atoms%llod,dimension%neigd,atoms%nlod,atoms%nat,2,2) ) + ALLOCATE(eig_shift(input%neig,kpts%nkpt,SIZE(theta)));eig_shift=0.0 + ALLOCATE( acof(input%neig,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat,2,2),& + bcof(input%neig,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat,2,2) ) + ALLOCATE( ccof(-atoms%llod:atoms%llod,input%neig,atoms%nlod,atoms%nat,2,2) ) + + ALLOCATE( matel(neigf,input%neig,0:atoms%ntype) ) - ALLOCATE( matel(neigf,DIMENSION%neigd,0:atoms%ntype) ) - CALL usdus%init(atoms,2) @@ -89,30 +89,30 @@ CONTAINS DO nr=1,SIZE(theta) CALL spnorb_angles(atoms,mpi,theta(nr),phi(nr),soangl(:,:,:,:,:,:,nr)) ENDDO - + DO nk=mpi%irank+1,kpts%nkpt,mpi%isize CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,.false.) zMat%matsize1=lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot - zmat%matsize2=DIMENSION%neigd + zmat%matsize2=input%neig zmat%l_real=.FALSE. IF (ALLOCATED(zmat%data_c)) DEALLOCATE(zmat%data_c) ALLOCATE(zmat%data_c(zMat%matsize1,zmat%matsize2)) CALL read_eig(eig_id,nk,1,neig=ne,eig=eig_shift(:,nk,1),zmat=zmat) - DO jsloc= 1,2 + DO jsloc= 1,2 eig_shift(:,nk,1)=0.0 !not needed CALL abcof(input,atoms,sym, cell,lapw,ne,usdus,noco,jsloc,oneD, & acof(:,:,:,jsloc,1),bcof(:,:,:,jsloc,1),ccof(:,:,:,:,jsloc,1),zMat) ENDDO - ! rotate abcof into global spin coordinate frame - nat= 0 - DO n= 1,atoms%ntype + ! rotate abcof into global spin coordinate frame + nat= 0 + DO n= 1,atoms%ntype DO na= 1,atoms%neq(n) - nat= nat+1 - r1= noco%alph(n) - r2= noco%beta(n) - DO lm= 0,DIMENSION%lmd - DO band= 1,DIMENSION%neigd + nat= nat+1 + r1= noco%alph(n) + r2= noco%beta(n) + DO lm= 0,atoms%lmaxd*(atoms%lmaxd+2) + DO band= 1,input%neig c1= acof(band,lm,nat,1,1) c2= acof(band,lm,nat,2,1) acof(band,lm,nat,1,1)= CMPLX(COS(r1/2.),-SIN(r1/2.)) *CMPLX( COS(r2/2.),0.) *c1 @@ -129,7 +129,7 @@ CONTAINS ENDDO ! lm DO ilo = 1,atoms%nlo(n) l = atoms%llo(ilo,n) - DO band= 1,DIMENSION%neigd + DO band= 1,input%neig DO m = -l, l c1= ccof(m,band,ilo,nat,1,1) c2= ccof(m,band,ilo,nat,2,1) @@ -144,7 +144,7 @@ CONTAINS ENDDO DO nr=1,size(theta) !loop over angles ! matrix elements within k - CALL ssomatel(neigf,dimension,atoms, noco, & + CALL ssomatel(neigf,input,atoms, noco, & soangl(:,:,:,:,:,:,nr),rsoc%rsopp(:,:,:,:),rsoc%rsoppd(:,:,:,:),& rsoc%rsopdp(:,:,:,:),rsoc%rsopdpd(:,:,:,:),rsoc%rsoplop(:,:,:,:), & rsoc%rsoplopd(:,:,:,:),rsoc%rsopdplo(:,:,:,:),rsoc%rsopplo(:,:,:,:),& @@ -177,9 +177,9 @@ CONTAINS ENDIF END SUBROUTINE ssomat - ! ==================================================================== ! + ! ==================================================================== ! - SUBROUTINE ssomatel(neigf,dimension,atoms, noco,& + SUBROUTINE ssomatel(neigf,input,atoms, noco,& soangl,rsopp,rsoppd,rsopdp,rsopdpd,rsoplop,& rsoplopd,rsopdplo,rsopplo,rsoploplop,& diag, & @@ -187,12 +187,12 @@ CONTAINS matel ) USE m_types IMPLICIT NONE - TYPE(t_dimension),INTENT(IN) :: dimension + TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco TYPE(t_atoms),INTENT(IN) :: atoms - LOGICAL, INTENT(IN) :: diag - INTEGER, INTENT(IN) :: neigf + LOGICAL, INTENT(IN) :: diag + INTEGER, INTENT(IN) :: neigf REAL, INTENT(IN) :: & rsopp(:,:,:,:), rsoppd(:,:,:,:),& rsopdp(:,:,:,:), rsopdpd(:,:,:,:), & @@ -207,43 +207,43 @@ CONTAINS acof2(:,0:,:,:,:), & bcof2(:,0:,:,:,:),& ccof2(-atoms%llod:,:,:,:,:,:) - - Complex, INTENT(OUT) :: matel(neigf,dimension%neigd,0:atoms%ntype) + + Complex, INTENT(OUT) :: matel(neigf,input%neig,0:atoms%ntype) INTEGER :: band1,band2,bandf, n ,na, l,m1,m2,lm1,lm2,& jsloc1,jsloc2, js1,js2,jsnumber,ilo,ilop,nat COMPLEX, ALLOCATABLE :: sa(:,:),sb(:,:),sc(:,:,:),ral(:,:,:) COMPLEX, ALLOCATABLE :: ra(:,:),rb(:,:),rc(:,:,:),rbl(:,:,:) - ! with the following nesting of loops the calculation of the + ! with the following nesting of loops the calculation of the ! matrix-elements is of order ! natall*lmd*neigd*(lmd+neigd) ; note that lmd+neigd << lmd*neigd - matel(:,:,:)= CMPLX(0.,0.) - ALLOCATE ( sa(2,0:dimension%lmd),sb(2,0:dimension%lmd),ra(2,0:dimension%lmd),rb(2,0:dimension%lmd) ) + matel(:,:,:)= CMPLX(0.,0.) + ALLOCATE ( sa(2,0:atoms%lmaxd*(atoms%lmaxd+2)),sb(2,0:atoms%lmaxd*(atoms%lmaxd+2)),ra(2,0:atoms%lmaxd*(atoms%lmaxd+2)),rb(2,0:atoms%lmaxd*(atoms%lmaxd+2)) ) ALLOCATE ( sc(2,-atoms%llod:atoms%llod,atoms%nlod),rc(2,-atoms%llod:atoms%llod,atoms%nlod) ) ALLOCATE ( ral(2,-atoms%llod:atoms%llod,atoms%nlod),rbl(2,-atoms%llod:atoms%llod,atoms%nlod) ) - ! within one k-point loop over global spin - IF (diag) THEN + ! within one k-point loop over global spin + IF (diag) THEN jsnumber= 2 - ELSE + ELSE jsnumber= 1 ENDIF - DO js2= 1,jsnumber + DO js2= 1,jsnumber IF (diag) THEN js1= js2 ELSE js1= 2 ENDIF - ! loop over MT - na= 0 - DO n= 1,atoms%ntype - DO nat= 1,atoms%neq(n) - na= na+1 + ! loop over MT + na= 0 + DO n= 1,atoms%ntype + DO nat= 1,atoms%neq(n) + na= na+1 - DO band2= 1,dimension%neigd ! loop over eigenstates 2 + DO band2= 1,input%neig ! loop over eigenstates 2 DO l= 1,atoms%lmax(n) ! loop over l DO m1= -l,l ! loop over m1 @@ -262,7 +262,7 @@ CONTAINS CONJG(bcof2(band2,lm2,na,jsloc2,js2))& * soangl(l,m2,js2,l,m1,js1) - ENDDO ! m2 + ENDDO ! m2 ENDDO ! jsloc2 ENDDO ! m1 @@ -288,17 +288,17 @@ CONTAINS lm1= l*(l+1) + m1 DO jsloc1= 1,2 - ra(jsloc1,lm1)= CMPLX(0.,0.) - rb(jsloc1,lm1)= CMPLX(0.,0.) + ra(jsloc1,lm1)= CMPLX(0.,0.) + rb(jsloc1,lm1)= CMPLX(0.,0.) DO jsloc2= 1,2 ra(jsloc1,lm1)= ra(jsloc1,lm1) + & sa(jsloc2,lm1) * rsopp(n,l,jsloc1,jsloc2) & - + sb(jsloc2,lm1) * rsoppd(n,l,jsloc1,jsloc2) + + sb(jsloc2,lm1) * rsoppd(n,l,jsloc1,jsloc2) rb(jsloc1,lm1)= rb(jsloc1,lm1) +& sa(jsloc2,lm1) * rsopdp(n,l,jsloc1,jsloc2)& + sb(jsloc2,lm1) * rsopdpd(n,l,jsloc1,jsloc2) ENDDO ! jsloc2 - ENDDO ! jsloc1 + ENDDO ! jsloc1 ENDDO ! m1 ENDDO ! l @@ -330,18 +330,18 @@ CONTAINS DO jsloc1= 1,2 DO bandf= 1,neigf - IF (neigf==dimension%neigd) THEN + IF (neigf==input%neig) THEN band1= bandf ELSE band1= band2 ENDIF matel(bandf,band2,n)= matel(bandf,band2,n) +& acof1(band1,lm1,na,jsloc1,js1)*ra(jsloc1,lm1) & - + bcof1(band1,lm1,na,jsloc1,js1)*rb(jsloc1,lm1) + + bcof1(band1,lm1,na,jsloc1,js1)*rb(jsloc1,lm1) ENDDO ! band1 - ENDDO ! jsloc1 + ENDDO ! jsloc1 - ENDDO ! m1,lm1 + ENDDO ! m1,lm1 ENDDO ! l DO ilo = 1, atoms%nlo(n) ! LO-part @@ -352,7 +352,7 @@ CONTAINS DO jsloc1= 1,2 DO bandf= 1,neigf - IF (neigf==dimension%neigd) THEN + IF (neigf==input%neig) THEN band1= bandf ELSE band1= band2 @@ -362,18 +362,18 @@ CONTAINS + acof1(band1,lm1,na,jsloc1,js1)*ral(jsloc1,m1,ilo)& + bcof1(band1,lm1,na,jsloc1,js1)*rbl(jsloc1,m1,ilo) ENDDO ! band1 - ENDDO ! jsloc1 + ENDDO ! jsloc1 DO ilop = 1,atoms%nlo(n) IF (atoms%llo(ilop,n).EQ.l) THEN DO jsloc1= 1,2 DO bandf= 1,neigf - IF (neigf==dimension%neigd) THEN + IF (neigf==input%neig) THEN band1= bandf ELSE band1= band2 ENDIF - DO jsloc2= 1,2 + DO jsloc2= 1,2 matel(bandf,band2,n)= matel(bandf,band2,n) +& ccof1(m1,band1,ilo,na,jsloc1,js1)*& rsoploplop(n,ilo,ilop,jsloc1,jsloc2)*& @@ -384,29 +384,29 @@ CONTAINS ENDIF ENDDO ! ilop - ENDDO ! m1 + ENDDO ! m1 ENDDO ! ilo ENDDO ! band2 - ENDDO ! nat,na - ENDDO ! n + ENDDO ! nat,na + ENDDO ! n ENDDO ! js2,js1 - DO n= 1,atoms%ntype - DO band2= 1,dimension%neigd - DO bandf= 1,neigf - matel(bandf,band2,0)= matel(bandf,band2,0) + matel(bandf,band2,n) + DO n= 1,atoms%ntype + DO band2= 1,input%neig + DO bandf= 1,neigf + matel(bandf,band2,0)= matel(bandf,band2,0) + matel(bandf,band2,n) ENDDO ENDDO ENDDO - IF (diag) THEN + IF (diag) THEN DO n= 1,atoms%ntype - DO band2= 1,dimension%neigd - IF (neigf==dimension%neigd) THEN - bandf= band2 + DO band2= 1,input%neig + IF (neigf==input%neig) THEN + bandf= band2 ELSE - bandf= 1 + bandf= 1 ENDIF IF (ABS(AIMAG(matel(bandf,band2,n)))>1.e-12) THEN PRINT *,bandf,band2,n,AIMAG(matel(bandf,band2,n)) diff --git a/fermi/fergwt.f90 b/fermi/fergwt.f90 index 1844be62..2244ca27 100644 --- a/fermi/fergwt.f90 +++ b/fermi/fergwt.f90 @@ -21,7 +21,7 @@ CONTAINS ! .. ! .. Array Arguments .. INTEGER, INTENT (IN) :: ne(:,:) !(kpts%nkpt,dimension%jspd) - REAL, INTENT (IN) :: eig(:,:,:) !dimension%neigd,kpts%nkpt,dimension%jspd) + REAL, INTENT (IN) :: eig(:,:,:) !input%neig,kpts%nkpt,dimension%jspd) ! .. ! .. Local Scalars .. REAL chmom,de,ef0,ef1,elow,en,eps,eup,fac,fact1,s,s0,s1,s2,& diff --git a/fermi/ferhis.f90 b/fermi/ferhis.f90 index 648dd634..b9f5ecc4 100644 --- a/fermi/ferhis.f90 +++ b/fermi/ferhis.f90 @@ -69,13 +69,13 @@ CONTAINS REAL,INTENT(OUT) :: w_iks(:,:,:) ! .. ! .. Array Arguments .. - INTEGER, INTENT (IN) :: idxeig(:)!(dimension%neigd*kpts%nkpt*dimension%jspd) - INTEGER, INTENT (IN) :: idxjsp(:)!(dimension%neigd*kpts%nkpt*dimension%jspd) - INTEGER, INTENT (IN) :: idxkpt(:)!(dimension%neigd*kpts%nkpt*dimension%jspd) - INTEGER, INTENT (IN) :: INDEX(:)!(dimension%neigd*kpts%nkpt*dimension%jspd) + INTEGER, INTENT (IN) :: idxeig(:)!(input%neig*kpts%nkpt*dimension%jspd) + INTEGER, INTENT (IN) :: idxjsp(:)!(input%neig*kpts%nkpt*dimension%jspd) + INTEGER, INTENT (IN) :: idxkpt(:)!(input%neig*kpts%nkpt*dimension%jspd) + INTEGER, INTENT (IN) :: INDEX(:)!(input%neig*kpts%nkpt*dimension%jspd) INTEGER, INTENT (IN) :: ne(:,:)!(kpts%nkpt,dimension%jspd) - REAL, INTENT (IN) :: e(:)!(kpts%nkpt*dimension%neigd*dimension%jspd) - REAL, INTENT (INOUT) :: we(:)!(kpts%nkpt*dimension%neigd*dimension%jspd) + REAL, INTENT (IN) :: e(:)!(kpts%nkpt*input%neig*dimension%jspd) + REAL, INTENT (INOUT) :: we(:)!(kpts%nkpt*input%neig*dimension%jspd) !--- J constants !--- J constants diff --git a/fermi/fermie.F90 b/fermi/fermie.F90 index 49842870..0971e4d0 100644 --- a/fermi/fermie.F90 +++ b/fermi/fermie.F90 @@ -50,7 +50,7 @@ CONTAINS REAL,INTENT(IN) :: e_min ! .. ! .. Array Arguments .. - !REAL, INTENT (OUT):: w(:,:,:) !(dimension%neigd,kpts%nkpt,dimension%jspd) + !REAL, INTENT (OUT):: w(:,:,:) !(input%neig,kpts%nkpt,dimension%jspd) ! .. ! .. Local Scalars .. REAL del ,spindg,ssc ,ws,zc,weight,efermi,seigv diff --git a/force/force_a12.f90 b/force/force_a12.f90 index ce77fa45..28683a9f 100644 --- a/force/force_a12.f90 +++ b/force/force_a12.f90 @@ -5,7 +5,7 @@ MODULE m_forcea12 ! ************************************************************ ! CONTAINS - SUBROUTINE force_a12(atoms,nobd,sym, DIMENSION, cell,oneD,& + SUBROUTINE force_a12(atoms,nobd,sym, cell,oneD,& we,jsp,ne,usdus,eigVecCoeffs,acoflo,bcoflo,e1cof,e2cof,f_a12,results) USE m_types_setup USE m_types_misc @@ -16,7 +16,7 @@ CONTAINS IMPLICIT NONE TYPE(t_results),INTENT(INOUT) :: results - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_sym),INTENT(IN) :: sym TYPE(t_cell),INTENT(IN) :: cell @@ -44,7 +44,7 @@ CONTAINS ! .. ! .. Local Arrays .. COMPLEX forc_a12(3),gv(3) - COMPLEX acof_flapw(nobd,0:DIMENSION%lmd),bcof_flapw(nobd,0:DIMENSION%lmd) + COMPLEX acof_flapw(nobd,0:atoms%lmaxd*(atoms%lmaxd+2)),bcof_flapw(nobd,0:atoms%lmaxd*(atoms%lmaxd+2)) REAL aaa(2),bbb(2),ccc(2),ddd(2),eee(2),fff(2),gvint(3),starsum(3),vec(3),vecsum(3) ! .. ! .. Statement Functions .. diff --git a/force/force_a21.F90 b/force/force_a21.F90 index 708913ba..44c47c5d 100644 --- a/force/force_a21.F90 +++ b/force/force_a21.F90 @@ -1,6 +1,6 @@ MODULE m_forcea21 CONTAINS - SUBROUTINE force_a21(input,atoms,DIMENSION,sym,oneD,cell,& + SUBROUTINE force_a21(input,atoms,sym,oneD,cell,& we,jsp,epar,ne,eig,usdus,eigVecCoeffs,aveccof,bveccof,cveccof,f_a21,f_b4,results) ! ************************************************************ @@ -34,7 +34,7 @@ CONTAINS IMPLICIT NONE TYPE(t_input),INTENT(IN) :: input TYPE(t_results),INTENT(INOUT) :: results - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_sym),INTENT(IN) :: sym TYPE(t_cell),INTENT(IN) :: cell @@ -47,7 +47,7 @@ CONTAINS ! .. ! .. Array Arguments .. REAL, INTENT(IN) :: we(ne),epar(0:atoms%lmaxd,atoms%ntype) - REAL, INTENT(IN) :: eig(DIMENSION%neigd) + REAL, INTENT(IN) :: eig(input%neig) COMPLEX, INTENT(IN) :: aveccof(3,ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat) COMPLEX, INTENT(IN) :: bveccof(3,ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat) COMPLEX, INTENT(IN) :: cveccof(3,-atoms%llod:atoms%llod,ne,atoms%nlod,atoms%nat) @@ -73,7 +73,7 @@ CONTAINS CALL timestart("force_a21") - lmplmd = (dimension%lmd* (dimension%lmd+3))/2 + lmplmd = (atoms%lmaxd*(atoms%lmaxd+2)* (atoms%lmaxd*(atoms%lmaxd+2)+3))/2 mlotot = 0 ; mlolotot = 0 DO n = 1, atoms%ntype mlotot = mlotot + atoms%nlo(n) @@ -83,10 +83,10 @@ CONTAINS mlolot_d = MAX(mlolotot,1) ALLOCATE ( tlmplm%tdd(0:lmplmd,atoms%ntype,1),tlmplm%tuu(0:lmplmd,atoms%ntype,1),& tlmplm%tdu(0:lmplmd,atoms%ntype,1),tlmplm%tud(0:lmplmd,atoms%ntype,1),& - tlmplm%tuulo(0:DIMENSION%lmd,-atoms%llod:atoms%llod,mlot_d,1),& - tlmplm%tdulo(0:DIMENSION%lmd,-atoms%llod:atoms%llod,mlot_d,1),& + tlmplm%tuulo(0:atoms%lmaxd*(atoms%lmaxd+2),-atoms%llod:atoms%llod,mlot_d,1),& + tlmplm%tdulo(0:atoms%lmaxd*(atoms%lmaxd+2),-atoms%llod:atoms%llod,mlot_d,1),& tlmplm%tuloulo(-atoms%llod:atoms%llod,-atoms%llod:atoms%llod,mlolot_d,1),& - a21(3,atoms%nat),b4(3,atoms%nat),tlmplm%ind(0:DIMENSION%lmd,0:DIMENSION%lmd,atoms%ntype,1) ) + a21(3,atoms%nat),b4(3,atoms%nat),tlmplm%ind(0:atoms%lmaxd*(atoms%lmaxd+2),0:atoms%lmaxd*(atoms%lmaxd+2),atoms%ntype,1) ) ! IF(atoms%n_u.GT.0) THEN ALLOCATE(v_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)) diff --git a/force/force_a21_lo.f90 b/force/force_a21_lo.f90 index ef9c63c7..c4d2ec03 100644 --- a/force/force_a21_lo.f90 +++ b/force/force_a21_lo.f90 @@ -30,7 +30,7 @@ CONTAINS INTEGER, INTENT (IN) :: itype,ne,isp ! .. ! .. Array Arguments .. - REAL, INTENT(IN) :: we(ne),eig(:)!(dimension%neigd) + REAL, INTENT(IN) :: we(ne),eig(:)!(input%neig) REAL, INTENT(INOUT) :: a21(3,atoms%nat) COMPLEX, INTENT(IN) :: aveccof(3,ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat) COMPLEX, INTENT(IN) :: bveccof(3,ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat) diff --git a/force/force_a4.f90 b/force/force_a4.f90 index 8c376d76..93cb6691 100644 --- a/force/force_a4.f90 +++ b/force/force_a4.f90 @@ -1,6 +1,6 @@ MODULE m_force_a4 CONTAINS - SUBROUTINE force_a4(atoms,sym,sphhar,input,DIMENSION,& + SUBROUTINE force_a4(atoms,sym,sphhar,input,& & vr,& & force) ! @@ -19,7 +19,7 @@ CONTAINS TYPE(t_sphhar),INTENT(IN) :: sphhar TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_sym),INTENT(IN) :: sym - TYPE(t_dimension),INTENT(IN) :: dimension + ! .. ! .. Array Arguments .. REAL, INTENT (IN) :: vr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins) @@ -52,7 +52,7 @@ CONTAINS ycomp1(2,1) = CMPLX(0.0,-s23) ycomp1(3,1) = czero ! ---> read in core density - CALL readCoreDensity(input,atoms,dimension,rhoc,tec,qintc) + CALL readCoreDensity(input,atoms,rhoc,tec,qintc) DO jsp = 1,input%jspins na = 1 diff --git a/force/geo.f90 b/force/geo.f90 index eea5b097..2d731f9b 100644 --- a/force/geo.f90 +++ b/force/geo.f90 @@ -70,7 +70,7 @@ CONTAINS ! temporary variables for XML IO TYPE(t_input) :: input_temp - TYPE(t_dimension) :: dimension_temp + TYPE(t_atoms) :: atoms_temp TYPE(t_cell) :: cell_temp TYPE(t_stars) :: stars_temp diff --git a/forcetheorem/dmi.F90 b/forcetheorem/dmi.F90 index 7f5209ec..cf54e627 100644 --- a/forcetheorem/dmi.F90 +++ b/forcetheorem/dmi.F90 @@ -149,7 +149,7 @@ CONTAINS #endif END SUBROUTINE dmi_dist - FUNCTION dmi_eval(this,eig_id,DIMENSION,atoms,kpts,sym,& + FUNCTION dmi_eval(this,eig_id,atoms,kpts,sym,& cell,noco, input,mpi, oneD,enpara,v,results)RESULT(skip) USE m_types USE m_ssomat @@ -158,7 +158,7 @@ CONTAINS LOGICAL :: skip !Stuff that might be used... TYPE(t_mpi),INTENT(IN) :: mpi - TYPE(t_dimension),INTENT(IN) :: dimension + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco @@ -174,7 +174,7 @@ CONTAINS IF (this%q_done==0) RETURN this%evsum(0,this%q_done)=results%seigv - CALL ssomat(this%evsum(1:,this%q_done),this%theta,this%phi,eig_id,DIMENSION,atoms,kpts,sym,& + CALL ssomat(this%evsum(1:,this%q_done),this%theta,this%phi,eig_id,atoms,kpts,sym,& cell,noco, input,mpi, oneD,enpara,v,results) skip=.TRUE. END FUNCTION dmi_eval diff --git a/forcetheorem/jij.F90 b/forcetheorem/jij.F90 index 4188712c..55af6e51 100644 --- a/forcetheorem/jij.F90 +++ b/forcetheorem/jij.F90 @@ -178,7 +178,7 @@ CONTAINS END SUBROUTINE jij_postprocess - FUNCTION jij_eval(this,eig_id,DIMENSION,atoms,kpts,sym,& + FUNCTION jij_eval(this,eig_id,atoms,kpts,sym,& cell,noco, input,mpi, oneD,enpara,v,results)RESULT(skip) USE m_types USE m_ssomat @@ -187,7 +187,7 @@ CONTAINS LOGICAL :: skip !Stuff that might be used... TYPE(t_mpi),INTENT(IN) :: mpi - TYPE(t_dimension),INTENT(IN) :: dimension + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco diff --git a/forcetheorem/mae.F90 b/forcetheorem/mae.F90 index cfa81132..3c511be0 100644 --- a/forcetheorem/mae.F90 +++ b/forcetheorem/mae.F90 @@ -91,7 +91,7 @@ CONTAINS IF (this%l_io) CALL openXMLElementPoly('Forcetheorem_Loop_MAE',(/'No'/),(/this%directions_done/)) END FUNCTION mae_next_job - FUNCTION mae_eval(this,eig_id,DIMENSION,atoms,kpts,sym,& + FUNCTION mae_eval(this,eig_id,atoms,kpts,sym,& cell,noco, input,mpi, oneD,enpara,v,results)RESULT(skip) USE m_types IMPLICIT NONE @@ -99,7 +99,7 @@ CONTAINS LOGICAL :: skip !Stuff that might be used... TYPE(t_mpi),INTENT(IN) :: mpi - TYPE(t_dimension),INTENT(IN) :: dimension + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco diff --git a/forcetheorem/ssdisp.F90 b/forcetheorem/ssdisp.F90 index c9841dc7..ec0850e0 100644 --- a/forcetheorem/ssdisp.F90 +++ b/forcetheorem/ssdisp.F90 @@ -138,7 +138,7 @@ CONTAINS #endif END SUBROUTINE ssdisp_dist - FUNCTION ssdisp_eval(this,eig_id,DIMENSION,atoms,kpts,sym,& + FUNCTION ssdisp_eval(this,eig_id,atoms,kpts,sym,& cell,noco, input,mpi, oneD,enpara,v,results)RESULT(skip) USE m_types USE m_ssomat @@ -147,7 +147,7 @@ CONTAINS LOGICAL :: skip !Stuff that might be used... TYPE(t_mpi),INTENT(IN) :: mpi - TYPE(t_dimension),INTENT(IN) :: dimension + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco diff --git a/global/checkdop.F90 b/global/checkdop.F90 index 2e5e4b7a..b5d82b56 100644 --- a/global/checkdop.F90 +++ b/global/checkdop.F90 @@ -2,7 +2,7 @@ CONTAINS SUBROUTINE checkdop(& & p,np,n,na,ivac,iflag,jsp,& - & DIMENSION,atoms,sphhar,stars,sym,& + & atoms,sphhar,stars,sym,& & vacuum,cell,oneD,potden) ! ************************************************************ ! subroutines checks the continuity of coulomb * @@ -23,7 +23,7 @@ IMPLICIT NONE ! .. ! .. Scalar Arguments .. - TYPE(t_dimension),INTENT(IN) :: dimension + type(t_sphhar),intent(in) :: sphhar TYPE(t_stars),INTENT(IN) :: stars TYPE(t_atoms),INTENT(IN) :: atoms diff --git a/global/checkdopall.f90 b/global/checkdopall.f90 index 57436d05..6bcb74ee 100644 --- a/global/checkdopall.f90 +++ b/global/checkdopall.f90 @@ -8,7 +8,7 @@ MODULE m_checkdopall CONTAINS -SUBROUTINE checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,& +SUBROUTINE checkDOPAll(input,sphhar,stars,atoms,sym,vacuum,oneD,& cell,potden,ispin) USE m_sphpts @@ -21,7 +21,7 @@ SUBROUTINE checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,& IMPLICIT NONE TYPE(t_input),INTENT(IN) :: input - TYPE(t_dimension),INTENT(IN) :: dimension + TYPE(t_sphhar),intent(in) :: sphhar TYPE(t_stars),INTENT(IN) :: stars TYPE(t_atoms),INTENT(IN) :: atoms @@ -47,13 +47,13 @@ SUBROUTINE checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,& DO ivac = 1,vacuum%nvac signum = 3.0 - 2.0*ivac xp(3,:npd) = signum*cell%z1/cell%amat(3,3) - CALL checkdop(xp,npd,0,0,ivac,1,ispin,dimension,atoms,& + CALL checkdop(xp,npd,0,0,ivac,1,ispin,atoms,& sphhar,stars,sym,vacuum,cell,oneD,potden) END DO ELSE IF (oneD%odi%d1) THEN npd = min(SIZE(xp,2),25) CALL cylpts(xp,npd,cell%z1) - CALL checkdop(xp,npd,0,0,ivac,1,ispin,dimension,atoms,& + CALL checkdop(xp,npd,0,0,ivac,1,ispin,atoms,& sphhar,stars,sym,vacuum,cell,oneD,potden) END IF @@ -62,7 +62,7 @@ SUBROUTINE checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,& DO n = 1, atoms%ntype CALL sphpts(xp,SIZE(xp,2),atoms%rmt(n),atoms%pos(1,nat)) CALL checkdop(xp,SIZE(xp,2),n,nat,0,-1,ispin,& - dimension,atoms,sphhar,stars,sym,vacuum,cell,oneD,potden) + atoms,sphhar,stars,sym,vacuum,cell,oneD,potden) nat = nat + atoms%neq(n) END DO diff --git a/init/checkInputParams.f90 b/init/checkInputParams.f90 index 06ec319d..1db111d8 100644 --- a/init/checkInputParams.f90 +++ b/init/checkInputParams.f90 @@ -8,14 +8,14 @@ MODULE m_checkInputParams CONTAINS -SUBROUTINE checkInputParams(mpi,input,dimension,atoms,noco,xcpot,oneD) +SUBROUTINE checkInputParams(mpi,input,atoms,noco,xcpot,oneD) USE m_juDFT USE m_types TYPE(t_mpi), INTENT(IN) :: mpi TYPE(t_input), INTENT(IN) :: input - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_noco), INTENT(IN) :: noco CLASS(t_xcpot), INTENT(IN) :: xcpot diff --git a/init/initParallelProcesses.F90 b/init/initParallelProcesses.F90 index e8122e72..d9573b82 100644 --- a/init/initParallelProcesses.F90 +++ b/init/initParallelProcesses.F90 @@ -17,7 +17,7 @@ CONTAINS ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE initParallelProcesses(atoms,vacuum,input,stars,sliceplot,banddos,& - dimension,cell,sym,xcpot,noco,oneD,hybrid,& + cell,sym,xcpot,noco,oneD,hybrid,& kpts,enpara,sphhar,mpi) USE m_types @@ -38,7 +38,7 @@ SUBROUTINE initParallelProcesses(atoms,vacuum,input,stars,sliceplot,banddos,& TYPE(t_sliceplot),INTENT(INOUT) :: sliceplot CLASS(t_xcpot), INTENT(INOUT) :: xcpot TYPE(t_noco), INTENT(INOUT) :: noco - TYPE(t_dimension),INTENT(INOUT) :: dimension + TYPE(t_enpara), INTENT(INOUT) :: enpara TYPE(t_sphhar), INTENT(INOUT) :: sphhar #ifdef CPP_MPI @@ -72,9 +72,9 @@ SUBROUTINE initParallelProcesses(atoms,vacuum,input,stars,sliceplot,banddos,& CALL MPI_BCAST(29,1,MPI_INTEGER,0,mpi%mpi_comm,ierr) CALL MPI_BCAST(stars%kimax,1,MPI_INTEGER,0,mpi%mpi_comm,ierr) CALL MPI_BCAST(stars%kimax2,1,MPI_INTEGER,0,mpi%mpi_comm,ierr) - CALL MPI_BCAST(dimension%nvd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr) - CALL MPI_BCAST(dimension%neigd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr) - CALL MPI_BCAST(dimension%nv2d,1,MPI_INTEGER,0,mpi%mpi_comm,ierr) + CALL MPI_BCAST(lapw%dim_nvd(),1,MPI_INTEGER,0,mpi%mpi_comm,ierr) + CALL MPI_BCAST(input%neig,1,MPI_INTEGER,0,mpi%mpi_comm,ierr) + CALL MPI_BCAST(lapw%dim_nv2d(),1,MPI_INTEGER,0,mpi%mpi_comm,ierr) CALL MPI_BCAST(atoms%msh,1,MPI_INTEGER,0,mpi%mpi_comm,ierr) CALL MPI_BCAST(dimension%nspd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr) CALL MPI_BCAST(kpts%numSpecialPoints,1,MPI_INTEGER,0,mpi%mpi_comm,ierr) diff --git a/init/lapw_dim.F90 b/init/lapw_dim.F90 index 6603f4db..d49b3cee 100644 --- a/init/lapw_dim.F90 +++ b/init/lapw_dim.F90 @@ -6,7 +6,7 @@ MODULE m_lapwdim CONTAINS - SUBROUTINE lapw_dim(kpts,cell,input,noco,oneD,forcetheo,DIMENSION) + SUBROUTINE lapw_dim(kpts,cell,input,noco,oneD,forcetheo,atoms) ! !********************************************************************* ! determines dimensions of the lapw basis set with |k+G|1E-4)) CALL judft_warn("q-vector for self-consistency should be first in list for force-theorem") - noco%qss=q_vectors(:,1) ! Usually does not do anything, but ensures that in - !force theorem CASE noco%qss is first q-vector in list - DIMENSION%nvd = 0 ; DIMENSION%nv2d = 0 + nvd = 0 ; nv2d = 0 DO q=1,SIZE(q_vectors,2) qss=q_vectors(:,q) DO nk=1,kpts%nkpt @@ -126,11 +128,16 @@ CONTAINS nvh(ispin) = nv nv2h(ispin) = nv2 END DO - DIMENSION%nvd=MAX(DIMENSION%nvd,MAX(nvh(1),nvh(2))) - DIMENSION%nv2d=MAX(DIMENSION%nv2d,MAX(nv2h(1),nv2h(2))) + nvd=MAX(nvd,MAX(nvh(1),nvh(2))) + nv2d=MAX(nv2d,MAX(nv2h(1),nv2h(2))) ENDDO !k-loop ENDDO !q-loop + + nbasfcn = nvd + atoms%nat*atoms%nlod*(2*atoms%llod+1) + IF (noco%l_noco) nbasfcn = 2*nbasfcn + call lapw%init_dim(nvd,nv2d,nbasfcn) + END SUBROUTINE lapw_dim SUBROUTINE lapw_fft_dim(cell,input,noco,stars) diff --git a/init/old_inp/fleur_init_old.F90 b/init/old_inp/fleur_init_old.F90 index 2c7f0a2b..9a054226 100644 --- a/init/old_inp/fleur_init_old.F90 +++ b/init/old_inp/fleur_init_old.F90 @@ -8,7 +8,7 @@ MODULE m_fleur_init_old CONTAINS !> Collection of code for old-style inp-file treatment SUBROUTINE fleur_init_old(mpi,& - input,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,& + input,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,& sliceplot,banddos,obsolete,enpara,xcpot,kpts,hybrid,& oneD,coreSpecInput,l_opti) USE m_types @@ -28,7 +28,7 @@ CONTAINS ! Types, these variables contain a lot of data! TYPE(t_mpi) ,INTENT(INOUT) :: mpi TYPE(t_input) ,INTENT(INOUT):: input - TYPE(t_dimension),INTENT(OUT) :: DIMENSION + TYPE(t_atoms) ,INTENT(OUT) :: atoms TYPE(t_sphhar) ,INTENT(OUT) :: sphhar TYPE(t_cell) ,INTENT(OUT) :: cell @@ -77,7 +77,7 @@ CONTAINS namex = ' ' relcor = ' ' - CALL dimens(mpi,input,sym,stars,atoms,sphhar,DIMENSION,vacuum,& + CALL dimens(mpi,input,sym,stars,atoms,sphhar,vacuum,& obsolete,kpts,oneD,hybrid) stars%kimax2= (2*stars%mx1+1)* (2*stars%mx2+1)-1 stars%kimax = (2*stars%mx1+1)* (2*stars%mx2+1)* (2*stars%mx3+1)-1 @@ -205,7 +205,7 @@ CONTAINS CALL xcpot%init(namex,l_krla,atoms%ntype) END IF - CALL setup(mpi,atoms,kpts,DIMENSION,sphhar,& + CALL setup(mpi,atoms,kpts,sphhar,& obsolete,sym,stars,oneD,input,noco,& vacuum,cell,xcpot,& sliceplot,enpara,l_opti) diff --git a/init/old_inp/setup.f90 b/init/old_inp/setup.f90 index e0421d34..724b36a1 100644 --- a/init/old_inp/setup.f90 +++ b/init/old_inp/setup.f90 @@ -1,7 +1,7 @@ MODULE m_setup USE m_juDFT CONTAINS - SUBROUTINE setup(mpi,atoms,kpts,DIMENSION,sphhar,& + SUBROUTINE setup(mpi,atoms,kpts,sphhar,& obsolete,sym,stars,oneD, input,noco,vacuum,cell,xcpot, sliceplot,enpara,l_opti) ! !---------------------------------------- @@ -58,7 +58,7 @@ TYPE(t_mpi),INTENT(IN) :: mpi TYPE(t_atoms),INTENT(INOUT) :: atoms TYPE(t_kpts),INTENT(INOUT) :: kpts - TYPE(t_dimension),INTENT(INOUT):: DIMENSION + TYPE(t_sphhar),INTENT(INOUT) :: sphhar TYPE(t_obsolete),INTENT(INOUT) :: obsolete TYPE(t_sym),INTENT(INOUT) :: sym @@ -175,10 +175,10 @@ CALL stepf(sym,stars,atoms,oneD, input,cell, vacuum,mpi) IF (sliceplot%iplot.EQ.0) THEN IF ( mpi%irank == 0 ) THEN - CALL convn(DIMENSION,atoms,stars) + CALL convn(atoms,stars) !---> set up electric field parameters (if needed) - ! CALL e_field(atoms, DIMENSION, stars, sym, vacuum, cell, input,field) + ! CALL e_field(atoms, stars, sym, vacuum, cell, input,field) ENDIF ENDIF diff --git a/init/postprocessInput.F90 b/init/postprocessInput.F90 index fbcf4f4f..b242b86f 100644 --- a/init/postprocessInput.F90 +++ b/init/postprocessInput.F90 @@ -10,7 +10,7 @@ CONTAINS SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,& oneD,hybrid,cell,banddos,sliceplot,xcpot,forcetheo,forcetheo_data,& - noco,DIMENSION,sphhar,l_kpts) + noco,sphhar,l_kpts) USE m_juDFT USE m_types @@ -50,7 +50,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,& TYPE(t_sliceplot),INTENT(INOUT) :: sliceplot CLASS(t_xcpot),ALLOCATABLE,INTENT(INOUT) :: xcpot TYPE(t_noco), INTENT(INOUT) :: noco - TYPE(t_dimension),INTENT(INOUT) :: dimension + TYPE(t_sphhar) ,INTENT (OUT) :: sphhar TYPE(t_field), INTENT(INOUT) :: field LOGICAL, INTENT (IN) :: l_kpts diff --git a/inpgen2/old_inp/dimen7.F90 b/inpgen2/old_inp/dimen7.F90 index 7716854b..1fa443df 100644 --- a/inpgen2/old_inp/dimen7.F90 +++ b/inpgen2/old_inp/dimen7.F90 @@ -3,7 +3,7 @@ CONTAINS SUBROUTINE dimen7(& & input,sym,stars,& - & atoms,sphhar,dimension,vacuum,& + & atoms,sphhar,vacuum,& & kpts,oneD,hybrid,cell) ! @@ -53,7 +53,7 @@ TYPE(t_stars),INTENT(INOUT) :: stars TYPE(t_atoms),INTENT(INOUT) :: atoms TYPE(t_sphhar),INTENT(INOUT) :: sphhar - TYPE(t_dimension),INTENT(INOUT) :: dimension + TYPE(t_vacuum),INTENT(INOUT) :: vacuum TYPE(t_kpts),INTENT(INOUT) :: kpts TYPE(t_oneD),INTENT(INOUT) :: oneD @@ -146,7 +146,7 @@ atoms%lmaxd = 0 atoms%jmtd = 0 rmtmax = 0.0 - dimension%neigd = 0 + input%neig = 0 atoms%lmaxd = maxval(atoms%lmax) atoms%jmtd = maxval(atoms%jri) rmtmax = maxval(atoms%rmt) @@ -156,7 +156,7 @@ IF (atoms%llo(ilo,n).LT.0) THEN atoms%llo(ilo,n) = -atoms%llo(ilo,n) - 1 ELSE - dimension%neigd = dimension%neigd + atoms%neq(n)*(2*abs(atoms%llo(ilo,n)) +1) + input%neig = input%neig + atoms%neq(n)*(2*abs(atoms%llo(ilo,n)) +1) ENDIF !-apw atoms%llod = max(abs(atoms%llo(ilo,n)),atoms%llod) @@ -167,18 +167,18 @@ & (atoms%nz(n).GE.57.AND.atoms%nz(n).LE.79)) nstate = 9 IF ((atoms%nz(n).GE.58.AND.atoms%nz(n).LE.71) .OR.& & (atoms%nz(n).GE.90.AND.atoms%nz(n).LE.103)) nstate = 16 - dimension%neigd = dimension%neigd + nstate*atoms%neq(n) + input%neig = input%neig + nstate*atoms%neq(n) ! ENDDO CALL ylmnorm_init(atoms%lmaxd) ! IF (mod(lmaxd,2).NE.0) lmaxd = lmaxd + 1 - IF (2*DIMENSION%neigd.LT.MAX(5.0,input%zelec)) THEN - WRITE(6,*) dimension%neigd,' states estimated in dimen7 ...' - DIMENSION%neigd = MAX(5,NINT(0.75*input%zelec)) - WRITE(6,*) 'changed dimension%neigd to ',dimension%neigd + IF (2*input%neig.LT.MAX(5.0,input%zelec)) THEN + WRITE(6,*) input%neig,' states estimated in dimen7 ...' + input%neig = MAX(5,NINT(0.75*input%zelec)) + WRITE(6,*) 'changed input%neig to ',input%neig ENDIF - IF (noco%l_soc .and. (.not. noco%l_noco)) dimension%neigd=2*dimension%neigd - IF (noco%l_soc .and. noco%l_ss) dimension%neigd=(3*dimension%neigd)/2 + IF (noco%l_soc .and. (.not. noco%l_noco)) input%neig=2*input%neig + IF (noco%l_soc .and. noco%l_ss) input%neig=(3*input%neig)/2 ! not as accurate, but saves much time rmtmax = rmtmax*stars%gmax @@ -344,7 +344,7 @@ ENDIF ENDIF - dimension%neigd = max(dimension%neigd,input%gw_neigd) + input%neig = max(input%neig,input%gw_neigd) ! ! Using the k-point generator also for creation of q-points for the @@ -361,14 +361,14 @@ ! ! now proceed as usual ! - CALL inpeig_dim(input,cell,noco,oneD,kpts,dimension,stars,latnam) + CALL inpeig_dim(input,cell,noco,oneD,kpts,stars,latnam) vacuum%layerd = max(vacuum%layerd,1) atoms%ntype = atoms%ntype - IF (noco%l_noco) dimension%neigd = 2*dimension%neigd + IF (noco%l_noco) input%neig = 2*input%neig atoms%nlod = max(atoms%nlod,2) ! for chkmt input%jspins=input%jspins - !CALL parawrite(sym,stars,atoms,sphhar,DIMENSION,vacuum,kpts,oneD,input) + !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,& diff --git a/inpgen2/old_inp/dimens.F90 b/inpgen2/old_inp/dimens.F90 index 6a72e5b6..6f147d80 100644 --- a/inpgen2/old_inp/dimens.F90 +++ b/inpgen2/old_inp/dimens.F90 @@ -11,7 +11,7 @@ MODULE m_dimens CONTAINS SUBROUTINE dimens(& & input,sym,stars,& - & atoms,sphhar,dimension,vacuum,& + & atoms,sphhar,vacuum,& & kpts,oneD,hybrid) USE m_types_input @@ -33,7 +33,7 @@ CONTAINS TYPE(t_stars),INTENT(INOUT) :: stars TYPE(t_atoms),INTENT(INOUT) :: atoms TYPE(t_sphhar),INTENT(INOUT) :: sphhar - TYPE(t_dimension),INTENT(INOUT) :: dimension + TYPE(t_vacuum),INTENT(INOUT) :: vacuum TYPE(t_kpts),INTENT(INOUT) :: kpts TYPE(t_oneD),INTENT(INOUT) :: oneD @@ -54,7 +54,7 @@ CONTAINS !call first_glance to generate k-points CALL first_glance(n1,n2,n3,n5,n6,input%itmax,l_kpts,l_qpts,ldum,n7,n8,n10) - CALL dimen7(input,sym,stars,atoms,sphhar,dimension,vacuum,kpts,& + CALL dimen7(input,sym,stars,atoms,sphhar,vacuum,kpts,& oneD,hybrid,cell) ! in case of a parallel calculation we have to broadcast vacuum%nmzd = 250 diff --git a/inpgen2/old_inp/fleur_init_old.F90 b/inpgen2/old_inp/fleur_init_old.F90 index a0eb7d1b..8fffdd43 100644 --- a/inpgen2/old_inp/fleur_init_old.F90 +++ b/inpgen2/old_inp/fleur_init_old.F90 @@ -8,7 +8,7 @@ MODULE m_fleur_init_old CONTAINS !> Collection of code for old-style inp-file treatment SUBROUTINE fleur_init_old(& - input,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,& + input,atoms,sphhar,cell,stars,sym,noco,vacuum,& sliceplot,banddos,enpara,xcpot,kpts,hybrid,& oneD,grid) USE m_types_input @@ -38,7 +38,7 @@ CONTAINS IMPLICIT NONE ! Types, these variables contain a lot of data! TYPE(t_input) ,INTENT(INOUT):: input - TYPE(t_dimension),INTENT(OUT) :: DIMENSION + TYPE(t_atoms) ,INTENT(OUT) :: atoms TYPE(t_sphhar) ,INTENT(OUT) :: sphhar TYPE(t_cell) ,INTENT(OUT) :: cell @@ -70,7 +70,7 @@ CONTAINS namex = ' ' relcor = ' ' - CALL dimens(input,sym,stars,atoms,sphhar,DIMENSION,vacuum,& + CALL dimens(input,sym,stars,atoms,sphhar,vacuum,& kpts,oneD,hybrid) stars%kimax2= (2*stars%mx1+1)* (2*stars%mx2+1)-1 stars%kimax = (2*stars%mx1+1)* (2*stars%mx2+1)* (2*stars%mx3+1)-1 diff --git a/inpgen2/old_inp/inpeig_dim.f90 b/inpgen2/old_inp/inpeig_dim.f90 index f6c635ca..ebd02ec0 100644 --- a/inpgen2/old_inp/inpeig_dim.f90 +++ b/inpgen2/old_inp/inpeig_dim.f90 @@ -5,7 +5,7 @@ ! m. weinert jan. 1987 !********************************************************************* CONTAINS - SUBROUTINE inpeig_dim(input,cell,noco, oneD,kpts,dimension,stars,latnam) + SUBROUTINE inpeig_dim(input,cell,noco, oneD,kpts,stars,latnam) USE m_constants, ONLY : pi_const,tpi_const USE m_types_input @@ -21,7 +21,7 @@ TYPE(t_cell),INTENT(INOUT) :: cell TYPE(t_noco),INTENT(INOUT) :: noco TYPE(t_stars),INTENT(INOUT) :: stars - TYPE(t_dimension),INTENT(INOUT) :: dimension + TYPE(t_kpts),INTENT(INOUT) :: kpts TYPE(t_oneD),INTENT(INOUT) :: oneD CHARACTER(len=*),INTENT(IN) :: latnam @@ -30,7 +30,7 @@ REAL s1,s2,scale,bk(3) LOGICAL xyu,l_k ! .. - kpts%nkpt = 0 ; dimension%nvd = 0 ; dimension%nv2d = 0 + kpts%nkpt = 0 stars%kq1_fft = 0 ; stars%kq2_fft = 0 ; stars%kq3_fft = 0 !cell%aamat=matmul(transpose(cell%amat),cell%amat) cell%bbmat=matmul(cell%bmat,transpose(cell%bmat)) @@ -54,11 +54,11 @@ 8030 FORMAT (4f10.5) 8040 FORMAT (i5,f20.10) 8050 FORMAT (i5,f20.10,3x,l1) - + kpts%nkpt = MAX(kpts%nkpt,kpts%nkpt) 8060 FORMAT (i5,f20.10) IF (scale.EQ.0.0) scale = 1.0 - + DO nk = 1,kpts%nkpt IF(input%film.AND..NOT.oneD%odd%d1) THEN READ (41,fmt=8080) (bk(i),i=1,2) @@ -100,14 +100,12 @@ stars%kq1_fft = MAX(kq1,stars%kq1_fft) stars%kq2_fft = MAX(kq2,stars%kq2_fft) stars%kq3_fft = MAX(kq3,stars%kq3_fft) - - DIMENSION%nvd = MAX(DIMENSION%nvd,nv) - DIMENSION%nv2d = MAX(DIMENSION%nv2d,nv2) - + + ENDDO ! k=pts REWIND(41) READ (41,*) - + CLOSE (41) ELSE kpts%nkpt=0 diff --git a/inpgen2/old_inp/parawrite.f90 b/inpgen2/old_inp/parawrite.f90 index 79d288c8..f3f4604f 100644 --- a/inpgen2/old_inp/parawrite.f90 +++ b/inpgen2/old_inp/parawrite.f90 @@ -1,5 +1,5 @@ SUBROUTINE parawrite(& - & sym,stars,atoms,sphhar,dimension,vacuum,& + & sym,stars,atoms,sphhar,vacuum,& & kpts,oneD,input) USE m_types @@ -8,7 +8,7 @@ TYPE(t_stars),INTENT(IN) :: stars TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_sphhar),INTENT(IN) :: sphhar - TYPE(t_dimension),INTENT(IN) :: dimension + TYPE(t_vacuum),INTENT(INOUT) :: vacuum TYPE(t_kpts),INTENT(IN) :: kpts TYPE(t_oneD),INTENT(IN) :: oneD @@ -65,12 +65,12 @@ !+gu WRITE (6,'(6x,''3 & 2D planewaves, windows, k-points'')') - WRITE (6,8180) dimension%nvd,dimension%nv2d,kpts%nkpt + WRITE (6,8180) lapw%dim_nvd(),lapw%dim_nv2d(),kpts%nkpt 8180 FORMAT (6x,'parameter (nvd=',i5,',nv2d=',i4,',nwdd=1', ',nkptd=',i5,')') WRITE (6,'(6x,''Number of (occupied) bands'')') - WRITE (6,8190) dimension%neigd,dimension%neigd + WRITE (6,8190) input%neig,input%neig 8190 FORMAT (6x,'parameter (nobd=',i4,',neigd=',i4,')') !-gu diff --git a/inpgen2/read_old_inp.f90 b/inpgen2/read_old_inp.f90 index 0756f9b4..93bfd93c 100644 --- a/inpgen2/read_old_inp.f90 +++ b/inpgen2/read_old_inp.f90 @@ -43,14 +43,14 @@ CONTAINS TYPE(t_kpts) ,INTENT(OUT):: kpts !local only - TYPE(t_dimension) ::dimension + TYPE(t_sphhar) ::sphhar TYPE(t_atompar) :: ap INTEGER :: n,grid(3) LOGICAL :: l_enparaok CALL fleur_init_old(& - input,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,& + input,atoms,sphhar,cell,stars,sym,noco,vacuum,& sliceplot,banddos,enpara,xcpot,kpts,hybrid,& oneD,grid) !kpt grid not used... diff --git a/io/cdn_io.F90 b/io/cdn_io.F90 index 26e44758..dccc9cbe 100644 --- a/io/cdn_io.F90 +++ b/io/cdn_io.F90 @@ -722,11 +722,11 @@ MODULE m_cdn_io END SUBROUTINE - SUBROUTINE readCoreDensity(input,atoms,dimension,rhcs,tecs,qints) + SUBROUTINE readCoreDensity(input,atoms,rhcs,tecs,qints) TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_input),INTENT(IN) :: input - TYPE(t_dimension),INTENT(IN) :: DIMENSION + REAL, INTENT(OUT) :: rhcs(:,:,:)!(atoms%jmtd,atoms%ntype,input%jspins) REAL, INTENT(OUT) :: tecs(:,:)!(atoms%ntype,input%jspins) @@ -751,7 +751,7 @@ MODULE m_cdn_io IF (l_exist) THEN CALL openCDN_HDF(fileID,currentStarsIndex,currentLatharmsIndex,currentStructureIndex,& currentStepfunctionIndex,readDensityIndex,lastDensityIndex) - CALL readCoreDensityHDF(fileID,input,atoms,dimension,rhcs,tecs,qints) + CALL readCoreDensityHDF(fileID,input,atoms,rhcs,tecs,qints) CALL closeCDNPOT_HDF(fileID) RETURN ELSE @@ -795,11 +795,11 @@ MODULE m_cdn_io END SUBROUTINE readCoreDensity - SUBROUTINE writeCoreDensity(input,atoms,dimension,rhcs,tecs,qints) + SUBROUTINE writeCoreDensity(input,atoms,rhcs,tecs,qints) TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_input),INTENT(IN) :: input - TYPE(t_dimension),INTENT(IN) :: DIMENSION + REAL, INTENT(IN) :: rhcs(:,:,:)!(atoms%jmtd,atoms%ntype,input%jspins) REAL, INTENT(IN) :: tecs(:,:)!(atoms%ntype,input%jspins) @@ -820,7 +820,7 @@ MODULE m_cdn_io #ifdef CPP_HDF CALL openCDN_HDF(fileID,currentStarsIndex,currentLatharmsIndex,currentStructureIndex,& currentStepfunctionIndex,readDensityIndex,lastDensityIndex) - CALL writeCoreDensityHDF(fileID,input,atoms,dimension,rhcs,tecs,qints) + CALL writeCoreDensityHDF(fileID,input,atoms,rhcs,tecs,qints) CALL closeCDNPOT_HDF(fileID) #endif ELSE IF(mode.EQ.CDN_STREAM_MODE) THEN diff --git a/io/cdnpot_io_hdf.F90 b/io/cdnpot_io_hdf.F90 index 940fd8b9..3145750d 100644 --- a/io/cdnpot_io_hdf.F90 +++ b/io/cdnpot_io_hdf.F90 @@ -2721,11 +2721,11 @@ MODULE m_cdnpot_io_hdf END SUBROUTINE peekDensityEntryHDF - SUBROUTINE writeCoreDensityHDF(fileID,input,atoms,dimension,rhcs,tecs,qints) + SUBROUTINE writeCoreDensityHDF(fileID,input,atoms,rhcs,tecs,qints) TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_input), INTENT(IN) :: input - TYPE(t_dimension),INTENT(IN) :: DIMENSION + INTEGER(HID_T), INTENT(IN) :: fileID REAL, INTENT(IN) :: rhcs(:,:,:)!(atoms%msh,atoms%ntype,input%jspins) @@ -2800,11 +2800,11 @@ MODULE m_cdnpot_io_hdf END SUBROUTINE writeCoreDensityHDF - SUBROUTINE readCoreDensityHDF(fileID,input,atoms,dimension,rhcs,tecs,qints) + SUBROUTINE readCoreDensityHDF(fileID,input,atoms,rhcs,tecs,qints) TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_input), INTENT(IN) :: input - TYPE(t_dimension),INTENT(IN) :: DIMENSION + INTEGER(HID_T), INTENT(IN) :: fileID REAL, INTENT(OUT) :: rhcs(atoms%jmtd,atoms%ntype,input%jspins) diff --git a/io/io_hybrid.F90 b/io/io_hybrid.F90 index e5695ba4..7cdc81c7 100644 --- a/io/io_hybrid.F90 +++ b/io/io_hybrid.F90 @@ -14,9 +14,9 @@ module m_io_hybrid !public:: open_hybrid_io,read_cmt,write_cmt contains - SUBROUTINE open_hybrid_io1(DIMENSION,l_real) + SUBROUTINE open_hybrid_io1(l_real) implicit none - TYPE(t_dimension),INTENT(IN):: dimension + LOGICAL,INTENT(IN) :: l_real LOGICAL :: opened=.false. @@ -24,15 +24,15 @@ contains opened=.true. !print *,"Open olap.mat" - id_olap=OPEN_MATRIX(l_real,DIMENSION%nbasfcn,1,1,"olap.mat") + id_olap=OPEN_MATRIX(l_real,lapw_dim_nbasfcn,1,1,"olap.mat") !print *,"Open z.mat" - id_z=OPEN_MATRIX(l_real,DIMENSION%nbasfcn,1,1,"z.mat") + id_z=OPEN_MATRIX(l_real,lapw_dim_nbasfcn,1,1,"z.mat") END SUBROUTINE open_hybrid_io1 - SUBROUTINE open_hybrid_io1b(DIMENSION,l_real) + SUBROUTINE open_hybrid_io1b(l_real) implicit none - TYPE(t_dimension),INTENT(IN):: dimension + LOGICAL,INTENT(IN) :: l_real LOGICAL :: opened=.false. @@ -40,26 +40,26 @@ contains opened=.true. !print *,"Open v_x.mat" - id_v_x=OPEN_MATRIX(l_real,DIMENSION%nbasfcn,1,1,"v_x.mat") + id_v_x=OPEN_MATRIX(l_real,lapw_dim_nbasfcn,1,1,"v_x.mat") END SUBROUTINE open_hybrid_io1b - SUBROUTINE open_hybrid_io2(hybrid,DIMENSION,atoms,l_real) + SUBROUTINE open_hybrid_io2(hybrid,input,atoms,l_real) IMPLICIT NONE TYPE(t_hybrid),INTENT(IN) :: hybrid - TYPE(t_dimension),INTENT(IN):: dimension + TYPE(t_input),INTENT(IN):: input TYPE(t_atoms),INTENT(IN) :: atoms LOGICAL,INTENT(IN) :: l_real INTEGER:: irecl_coulomb LOGICAL :: opened=.FALSE. - + 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 if (.not.l_real) irecl_coulomb =irecl_coulomb *2 @@ -78,7 +78,7 @@ contains id_coulomb_spm=778 #endif END SUBROUTINE open_hybrid_io2 - + subroutine write_cmt(cmt,nk) implicit none complex,INTENT(IN):: cmt(:,:,:) @@ -114,7 +114,7 @@ contains real,intent(in) :: coulomb_mt2(:,:,:,:), coulomb_mt3(:,:,:) real,intent(in) :: coulomb_mtir(:) integer,intent(in) :: nk - + !print *, "write coulomb",nk,size(coulomb_mt1),size(coulomb_mt2),size(coulomb_mt3),size(coulomb_mtir) write(id_coulomb_spm,rec=nk) coulomb_mt1,coulomb_mt2,coulomb_mt3,coulomb_mtir end subroutine write_coulomb_spm_r @@ -125,7 +125,7 @@ contains complex,intent(in) :: coulomb_mt2(:,:,:,:), coulomb_mt3(:,:,:) complex,intent(in) :: coulomb_mtir(:) integer,intent(in) :: nk - + write(id_coulomb_spm,rec=nk) coulomb_mt1,coulomb_mt2,coulomb_mt3,coulomb_mtir end subroutine write_coulomb_spm_c @@ -135,7 +135,7 @@ contains real,intent(out) :: coulomb_mt2(:,:,:,:), coulomb_mt3(:,:,:) real,intent(out) :: coulomb_mtir(:) integer,intent(in) :: nk - + !print *, "read coulomb",nk,size(coulomb_mt1),size(coulomb_mt2),size(coulomb_mt3),size(coulomb_mtir) read(id_coulomb_spm,rec=nk) coulomb_mt1,coulomb_mt2,coulomb_mt3,coulomb_mtir end subroutine read_coulomb_spm_r @@ -156,22 +156,22 @@ contains read(id_coulomb,rec=nk) coulomb end subroutine read_coulomb_r - + subroutine read_coulomb_c(nk,coulomb) implicit none complex,intent(out) :: coulomb(:) integer,intent(in) :: nk - + read(id_coulomb,rec=nk) coulomb end subroutine read_coulomb_c - + subroutine read_olap(mat,rec) implicit none TYPE(t_mat),INTENT(INOUT):: mat INTEGER,INTENT(IN) :: rec - + CALL read_matrix(mat,rec,id_olap) END subroutine read_olap @@ -179,7 +179,7 @@ contains implicit none TYPE(t_mat),INTENT(IN) :: mat INTEGER,INTENT(IN) :: rec - + CALL write_matrix(mat,rec,id_olap) END subroutine write_olap @@ -188,7 +188,7 @@ contains TYPE(t_mat),INTENT(INOUT):: mat INTEGER,INTENT(IN) :: rec !print *,"read z:",rec - + CALL read_matrix(mat,rec,id_z) END subroutine read_z @@ -204,7 +204,7 @@ contains implicit none TYPE(t_mat),INTENT(INOUT):: mat INTEGER,INTENT(IN) :: rec - + CALL read_matrix(mat,rec,id_v_x) END subroutine read_v_x @@ -212,11 +212,11 @@ contains implicit none TYPE(t_mat),INTENT(IN) :: mat INTEGER,INTENT(IN) :: rec - + CALL write_matrix(mat,rec,id_v_x) END subroutine write_v_x - - + + end module m_io_hybrid diff --git a/io/writeBasis.F90 b/io/writeBasis.F90 index 44f174fe..b215eb7b 100644 --- a/io/writeBasis.F90 +++ b/io/writeBasis.F90 @@ -8,7 +8,7 @@ MODULE m_writeBasis CONTAINS -SUBROUTINE writeBasis(input,noco,kpts,atoms,sym,cell,enpara,vTot,vCoul,vx,mpi,DIMENSION,results,eig_id,oneD,sphhar,stars,vacuum) +SUBROUTINE writeBasis(input,noco,kpts,atoms,sym,cell,enpara,vTot,vCoul,vx,mpi,results,eig_id,oneD,sphhar,stars,vacuum) USE m_types USE m_juDFT @@ -24,7 +24,7 @@ SUBROUTINE writeBasis(input,noco,kpts,atoms,sym,cell,enpara,vTot,vCoul,vx,mpi,DI IMPLICIT NONE ! TYPE(t_results),INTENT(IN) :: results - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_enpara),INTENT(IN) :: enpara ! TYPE(t_banddos),INTENT(IN) :: banddos @@ -476,7 +476,7 @@ SUBROUTINE writeBasis(input,noco,kpts,atoms,sym,cell,enpara,vTot,vCoul,vx,mpi,DI nbasfcn = MERGE(lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot,lapw%nv(1)+atoms%nlotot,noco%l_noco) CALL zMat%init(l_real,nbasfcn,numbands) CALL read_eig(eig_id,nk,jsp,zmat=zMat) - CALL eigVecCoeffs%init(input,DIMENSION,atoms,noco,jsp,numbands) + CALL eigVecCoeffs%init(input,atoms,noco,jsp,numbands) IF (input%l_f) CALL force%init2(numbands,input,atoms) ! DO i=1,atoms%nat ! ngopr_temp(i)=sym%ngopr(i) @@ -488,7 +488,7 @@ SUBROUTINE writeBasis(input,noco,kpts,atoms,sym,cell,enpara,vTot,vCoul,vx,mpi,DI ! DO i=1,atoms%nat ! sym%ngopr(i)=ngopr_temp(i) ! END DO - CALL abcrot(atoms%ntype,atoms%nat,numbands,atoms%lmaxd,dimension%lmd,atoms%llod,atoms%nlod,atoms%ntype,atoms%neq,& + CALL abcrot(atoms%ntype,atoms%nat,numbands,atoms%lmaxd,atoms%lmaxd*(atoms%lmaxd+2),atoms%llod,atoms%nlod,atoms%ntype,atoms%neq,& numbands,atoms%lmax,atoms%nlo,atoms%llo,sym%nop,sym%ngopr,sym%mrot,sym%invsat,sym%invsatnr,cell%bmat,& oneD%odi,oneD%ods,& eigVecCoeffs%acof(:,0:,:,jsp),eigVecCoeffs%bcof(:,0:,:,jsp),eigVecCoeffs%ccof(-atoms%llod:,:,:,:,jsp)) @@ -537,10 +537,10 @@ SUBROUTINE writeBasis(input,noco,kpts,atoms,sym,cell,enpara,vTot,vCoul,vx,mpi,DI CALL h5dclose_f(zmatSetID, hdfError) DEAllOCATE(output3) END IF - !AllOCATE(output(2,numbands,dimension%lmd+1,atoms%nat)) + !AllOCATE(output(2,numbands,atoms%lmaxd*(atoms%lmaxd+2)+1,atoms%nat)) !output(1,:,:,:)=REAL(eigVecCoeffs%acof(:,0:,:,jsp)) !output(2,:,:,:)=AIMAG(eigVecCoeffs%acof(:,0:,:,jsp)) - !dims(:4)=(/2,numbands,dimension%lmd+1,atoms%nat/) + !dims(:4)=(/2,numbands,atoms%lmaxd*(atoms%lmaxd+2)+1,atoms%nat/) !dimsInt = dims !CALL h5screate_simple_f(4,dims(:4),itypeSpaceID,hdfError) !CALL h5dcreate_f(kptGroupID, "acof", H5T_NATIVE_DOUBLE, itypeSpaceID, itypeSetID, hdfError) @@ -549,10 +549,10 @@ SUBROUTINE writeBasis(input,noco,kpts,atoms,sym,cell,enpara,vTot,vCoul,vx,mpi,DI !CALL h5dclose_f(itypeSetID, hdfError) !DEAllOCATE(output) - !AllOCATE(output(2,numbands,dimension%lmd+1,atoms%nat)) + !AllOCATE(output(2,numbands,atoms%lmaxd*(atoms%lmaxd+2)+1,atoms%nat)) !output(1,:,:,:)=REAL(eigVecCoeffs%bcof(:,0:,:,jsp)) !output(2,:,:,:)=AIMAG(eigVecCoeffs%bcof(:,0:,:,jsp)) - !dims(:4)=(/2,numbands,dimension%lmd+1,atoms%nat/) + !dims(:4)=(/2,numbands,atoms%lmaxd*(atoms%lmaxd+2)+1,atoms%nat/) !dimsInt = dims !CALL h5screate_simple_f(4,dims(:4),itypeSpaceID,hdfError) !CALL h5dcreate_f(kptGroupID, "bcof", H5T_NATIVE_DOUBLE, itypeSpaceID, itypeSetID, hdfError) diff --git a/io/writeOutParameters.f90 b/io/writeOutParameters.f90 index 48473604..e3d42de2 100644 --- a/io/writeOutParameters.f90 +++ b/io/writeOutParameters.f90 @@ -6,7 +6,7 @@ CONTAINS SUBROUTINE writeOutParameters(mpi,input,sym,stars,atoms,vacuum,kpts,& oneD,hybrid,cell,banddos,sliceplot,xcpot,& - noco,dimension,enpara,sphhar) + noco,enpara,sphhar) USE m_types USE m_xmlOutput @@ -14,7 +14,7 @@ SUBROUTINE writeOutParameters(mpi,input,sym,stars,atoms,vacuum,kpts,& TYPE(t_mpi), INTENT(IN) :: mpi TYPE(t_input), INTENT(IN) :: input TYPE(t_sym), INTENT(IN) :: sym - TYPE(t_stars), INTENT(IN) :: stars + TYPE(t_stars), INTENT(IN) :: stars TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_vacuum), INTENT(IN) :: vacuum TYPE(t_kpts), INTENT(IN) :: kpts @@ -25,7 +25,7 @@ SUBROUTINE writeOutParameters(mpi,input,sym,stars,atoms,vacuum,kpts,& TYPE(t_sliceplot), INTENT(IN) :: sliceplot CLASS(t_xcpot), INTENT(IN) :: xcpot TYPE(t_noco), INTENT(IN) :: noco - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_enpara), INTENT(IN) :: enpara TYPE(t_sphhar), INTENT(IN) :: sphhar @@ -42,7 +42,7 @@ SUBROUTINE writeOutParameters(mpi,input,sym,stars,atoms,vacuum,kpts,& CALL writeXMLElementFormPoly('atomsInCell',(/'nat ','ntype','jmtd ','n_u '/),& attributes(:4),reshape((/3,6,6,6,8,8,8,8/),(/4,2/))) - WRITE(attributes(1),'(i0)') dimension%nvd + WRITE(attributes(1),'(i0)') lapw_dim_nvd WRITE(attributes(2),'(i0)') atoms%lmaxd WRITE(attributes(3),'(i0)') atoms%nlotot CALL writeXMLElementFormPoly('basis',(/'nvd ','lmaxd ','nlotot'/),& @@ -53,7 +53,7 @@ SUBROUTINE writeOutParameters(mpi,input,sym,stars,atoms,vacuum,kpts,& CALL writeXMLElementFormPoly('density',(/'ng3','ng2'/),& attributes(:2),reshape((/7,6,8,8/),(/2,2/))) - WRITE(attributes(1),'(i0)') dimension%neigd + WRITE(attributes(1),'(i0)') input%neig CALL writeXMLElementFormPoly('bands',(/'numbands'/),& attributes(:1),reshape((/9,8/),(/1,2/))) diff --git a/ldau/u_ham.F90 b/ldau/u_ham.F90 index 6539381b..392f9fec 100644 --- a/ldau/u_ham.F90 +++ b/ldau/u_ham.F90 @@ -45,8 +45,8 @@ CONTAINS ! .. ! .. Array Arguments .. TYPE(t_usdus),INTENT(IN) :: ud - REAL, INTENT (IN) :: ar(:,0:,:),ai(:,0:,:) !(dimension%nvd,0:dimension%lmd,ab_dim) - REAL, INTENT (IN) :: br(:,0:,:),bi(:,0:,:) !(dimension%nvd,0:dimension%lmd,ab_dim) + REAL, INTENT (IN) :: ar(:,0:,:),ai(:,0:,:) !(lapw%dim_nvd(),0:atoms%lmaxd*(atoms%lmaxd+2),ab_dim) + REAL, INTENT (IN) :: br(:,0:,:),bi(:,0:,:) !(lapw%dim_nvd(),0:atoms%lmaxd*(atoms%lmaxd+2),ab_dim) COMPLEX, INTENT (IN) :: alo(-atoms%llod:,:,:,:)!(-llod:llod,2*(2*llod+1),nlod,ab_dim) COMPLEX, INTENT (IN) :: blo(-atoms%llod:,:,:,:)!(-llod:llod,2*(2*llod+1),nlod,ab_dim) COMPLEX, INTENT (IN) :: clo(-atoms%llod:,:,:,:)!(-llod:llod,2*(2*llod+1),nlod,ab_dim) diff --git a/main/cdngen.F90 b/main/cdngen.F90 index 5d783592..9b7c5d61 100644 --- a/main/cdngen.F90 +++ b/main/cdngen.F90 @@ -7,7 +7,7 @@ MODULE m_cdngen CONTAINS SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& - dimension,kpts,atoms,sphhar,stars,sym,& + kpts,atoms,sphhar,stars,sym,& enpara,cell,noco,vTot,results,oneD,coreSpecInput,& archiveType, xcpot,outDen,EnergyDen) @@ -49,7 +49,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& ! Type instance arguments TYPE(t_results),INTENT(INOUT) :: results TYPE(t_mpi),INTENT(IN) :: mpi - TYPE(t_dimension),INTENT(IN) :: dimension + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_enpara),INTENT(INOUT) :: enpara TYPE(t_banddos),INTENT(IN) :: banddos @@ -95,11 +95,11 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& LOGICAL :: l_error, perform_MetaGGA CALL regCharges%init(input,atoms) - CALL dos%init(dimension%neigd,input,atoms,kpts,vacuum) + CALL dos%init(input%neig,input,atoms,kpts,vacuum) CALL moments%init(input,atoms) - CALL mcd%init1(banddos,dimension,input,atoms,kpts) - CALL slab%init(banddos,dimension,atoms,cell,input,kpts) - CALL orbcomp%init(input,banddos,dimension,atoms,kpts) + CALL mcd%init1(banddos,input,atoms,kpts) + CALL slab%init(banddos,atoms,cell,input,kpts) + CALL orbcomp%init(input,banddos,atoms,kpts) CALL outDen%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN) CALL EnergyDen%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_EnergyDen) @@ -116,7 +116,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& DO jspin = 1,jspmax CALL cdnvalJob%init(mpi,input,kpts,noco,results,jspin) IF (sliceplot%slice) CALL cdnvalJob%select_slice(sliceplot,results,input,kpts,noco,jspin) - CALL cdnval(eig_id,mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,& + CALL cdnval(eig_id,mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,vacuum,& sphhar,sym,vTot,oneD,cdnvalJob,outDen,regCharges,dos,results,moments,coreSpecInput,mcd,slab,orbcomp) END DO call val_den%copyPotDen(outDen) @@ -124,7 +124,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& ! calculate kinetic energy density for MetaGGAs if(xcpot%exc_is_metagga()) then CALL calc_EnergyDen(eig_id, mpi, kpts, noco, input, banddos, cell, atoms, enpara, stars,& - vacuum, DIMENSION, sphhar, sym, vTot, oneD, results, EnergyDen) + vacuum, sphhar, sym, vTot, oneD, results, EnergyDen) endif IF (mpi%irank == 0) THEN @@ -140,9 +140,9 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& CALL closeBandDOSFile(banddosFile_id) #endif CALL timestart("cdngen: dos") - CALL doswrite(eig_id,dimension,kpts,atoms,vacuum,input,banddos,sliceplot,noco,sym,cell,dos,mcd,results,slab,orbcomp,oneD) + CALL doswrite(eig_id,kpts,atoms,vacuum,input,banddos,sliceplot,noco,sym,cell,dos,mcd,results,slab,orbcomp,oneD) IF (banddos%dos.AND.(banddos%ndir == -3)) THEN - CALL Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspmax,sym,cell,dos,slab,orbcomp,results) + CALL Ek_write_sl(eig_id,kpts,atoms,vacuum,input,jspmax,sym,cell,dos,slab,orbcomp,results) END IF CALL timestop("cdngen: dos") END IF @@ -166,10 +166,10 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& CALL timestart("cdngen: cdncore") if(xcpot%exc_is_MetaGGA()) then - CALL cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,& + CALL cdncore(mpi,oneD,input,vacuum,noco,sym,& stars,cell,sphhar,atoms,vTot,outDen,moments,results, EnergyDen) else - CALL cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,& + CALL cdncore(mpi,oneD,input,vacuum,noco,sym,& stars,cell,sphhar,atoms,vTot,outDen,moments,results) endif call core_den%subPotDen(outDen, val_den) @@ -186,7 +186,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& noco_new = noco !Calculate and write out spin densities at the nucleus and magnetic moments in the spheres - CALL magMoms(dimension,input,atoms,noco_new,vTot,moments) + CALL magMoms(input,atoms,noco_new,vTot,moments) noco = noco_new diff --git a/main/fleur.F90 b/main/fleur.F90 index 73c77ca5..2c2ecb83 100644 --- a/main/fleur.F90 +++ b/main/fleur.F90 @@ -77,7 +77,7 @@ CONTAINS TYPE(t_input) :: input TYPE(t_field) :: field, field2 - TYPE(t_dimension) :: DIMENSION + TYPE(t_atoms) ,TARGET :: atoms TYPE(t_sphhar),TARGET :: sphhar TYPE(t_cell) ,TARGET :: cell @@ -113,7 +113,7 @@ CONTAINS mpi%mpi_comm = mpi_comm CALL timestart("Initialization") - CALL fleur_init(mpi,input,field,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,sliceplot,& + CALL fleur_init(mpi,input,field,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,sliceplot,& banddos,enpara,xcpot,results,kpts,hybrid,oneD,coreSpecInput,wann) CALL timestop("Initialization") @@ -121,7 +121,7 @@ CONTAINS CALL juDFT_error('Currently no preconditioner for 1D calculations', calledby = 'fleur') END IF - CALL optional(mpi,atoms,sphhar,vacuum,dimension,& + CALL optional(mpi,atoms,sphhar,vacuum,& stars,input,sym,cell,sliceplot,xcpot,noco,oneD) IF (input%l_wann.AND.(mpi%irank==0).AND.(.NOT.wann%l_bs_comf)) THEN @@ -160,11 +160,11 @@ CONTAINS ! Open/allocate eigenvector storage (start) l_real=sym%invs.AND..NOT.noco%l_noco - eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,DIMENSION%neigd,kpts%nkpt,input%jspins,& + eig_id=open_eig(mpi%mpi_comm,lapw_dim_nbasfcn,input%neig,kpts%nkpt,input%jspins,& noco%l_noco,.true.,l_real,noco%l_soc,.false.,mpi%n_size) #ifdef CPP_CHASE - CALL init_chase(mpi,dimension,input,atoms,kpts,noco,sym%invs.AND..NOT.noco%l_noco) + CALL init_chase(mpi,input,atoms,kpts,noco,sym%invs.AND..NOT.noco%l_noco) #endif ! Open/allocate eigenvector storage (end) @@ -204,7 +204,7 @@ CONTAINS IF (hybrid%l_hybrid) THEN SELECT TYPE(xcpot) TYPE IS(t_xcpot_inbuild) - CALL calc_hybrid(eig_id,hybrid,kpts,atoms,input,DIMENSION,mpi,noco,& + CALL calc_hybrid(eig_id,hybrid,kpts,atoms,input,mpi,noco,& cell,oneD,enpara,results,sym,xcpot,vTot,iter,iterHF) END SELECT IF(hybrid%l_calhf) THEN @@ -214,7 +214,7 @@ CONTAINS ENDIF !RDMFT IF(input%l_rdmft) THEN - CALL open_hybrid_io1(DIMENSION,sym%invs) + CALL open_hybrid_io1(sym%invs) END IF !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 @@ -235,7 +235,7 @@ CONTAINS !---< gwf CALL timestart("generation of potential") - CALL vgen(hybrid,field,input,xcpot,DIMENSION,atoms,sphhar,stars,vacuum,sym,& + CALL vgen(hybrid,field,input,xcpot,atoms,sphhar,stars,vacuum,sym,& cell,oneD,sliceplot,mpi,results,noco,EnergyDen,inDen,vTot,vx,vCoul) CALL timestop("generation of potential") @@ -253,7 +253,7 @@ CONTAINS 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,& + CALL eigen(mpi,stars,sphhar,atoms,xcpot,sym,kpts,vacuum,input,& cell,enpara,banddos,noco,oneD,hybrid,iter,eig_id,results,inDen,vTemp,vx) !ENDIF vTot%mmpMat = vTemp%mmpMat @@ -279,7 +279,7 @@ CONTAINS ! WRITE(6,fmt='(A)') 'Starting 2nd variation ...' IF (noco%l_soc.AND..NOT.noco%l_noco) & - CALL eigenso(eig_id,mpi,DIMENSION,stars,vacuum,atoms,sphhar,& + CALL eigenso(eig_id,mpi,stars,vacuum,atoms,sphhar,& sym,cell,noco,input,kpts, oneD,vTot,enpara,results) CALL timestop("gen. of hamil. and diag. (total)") @@ -288,11 +288,11 @@ CONTAINS #endif ! fermi level and occupancies - IF (noco%l_soc.AND.(.NOT.noco%l_noco)) DIMENSION%neigd = 2*DIMENSION%neigd + IF (noco%l_soc.AND.(.NOT.noco%l_noco)) input%neig = 2*input%neig IF (input%gw.GT.0) THEN IF (mpi%irank.EQ.0) THEN - CALL writeBasis(input,noco,kpts,atoms,sym,cell,enpara,vTot,vCoul,vx,mpi,DIMENSION,& + CALL writeBasis(input,noco,kpts,atoms,sym,cell,enpara,vTot,vCoul,vx,mpi,& results,eig_id,oneD,sphhar,stars,vacuum) END IF IF (input%gw.EQ.2) THEN @@ -323,7 +323,7 @@ CONTAINS !!$ OPEN(780,file='out_eig.2_diag') !!$ END IF !!$ -!!$ CALL bs_comfort(eig_id,DIMENSION,input,noco,kpts%nkpt,pc) +!!$ CALL bs_comfort(eig_id,input,noco,kpts%nkpt,pc) !!$ !!$ IF(pc.EQ.wann%nparampts)THEN !!$ CLOSE(777) @@ -340,15 +340,15 @@ CONTAINS CALL MPI_BCAST(results%w_iks,SIZE(results%w_iks),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr) #endif - IF (forcetheo%eval(eig_id,DIMENSION,atoms,kpts,sym,cell,noco,input,mpi,oneD,enpara,vToT,results)) THEN - IF (noco%l_soc.AND.(.NOT.noco%l_noco)) DIMENSION%neigd=DIMENSION%neigd/2 + IF (forcetheo%eval(eig_id,atoms,kpts,sym,cell,noco,input,mpi,oneD,enpara,vToT,results)) THEN + IF (noco%l_soc.AND.(.NOT.noco%l_noco)) input%neig=input%neig/2 CYCLE forcetheoloop ENDIF !+Wannier functions IF ((input%l_wann).AND.(.NOT.wann%l_bs_comf)) THEN - CALL wannier(DIMENSION,mpi,input,kpts,sym,atoms,stars,vacuum,sphhar,oneD,& + CALL wannier(mpi,input,kpts,sym,atoms,stars,vacuum,sphhar,oneD,& wann,noco,cell,enpara,banddos,sliceplot,vTot,results,& (/eig_id/),(sym%invs).AND.(.NOT.noco%l_soc).AND.(.NOT.noco%l_noco),kpts%nkpt) END IF @@ -359,19 +359,19 @@ CONTAINS CALL outDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN) outDen%iter = inDen%iter CALL cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum, & - dimension,kpts,atoms,sphhar,stars,sym,& + kpts,atoms,sphhar,stars,sym,& enpara,cell,noco,vTot,results,oneD,coreSpecInput,& archiveType,xcpot,outDen,EnergyDen) IF (input%l_rdmft) THEN SELECT TYPE(xcpot) TYPE IS(t_xcpot_inbuild) - CALL rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars,vacuum,dimension,& + CALL rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars,vacuum,& sphhar,sym,field,vTot,vCoul,oneD,noco,xcpot,hybrid,results,coreSpecInput,archiveType,outDen) END SELECT END IF - IF (noco%l_soc.AND.(.NOT.noco%l_noco)) DIMENSION%neigd=DIMENSION%neigd/2 + IF (noco%l_soc.AND.(.NOT.noco%l_noco)) input%neig=input%neig/2 #ifdef CPP_MPI CALL MPI_BCAST(enpara%evac,SIZE(enpara%evac),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr) @@ -399,7 +399,7 @@ CONTAINS !!$ reap = .FALSE. !!$ input%total = .FALSE. !!$ CALL timestart("generation of potential (total)") -!!$ CALL vgen(hybrid,reap,input,xcpot,DIMENSION, atoms,sphhar,stars,vacuum,sym,& +!!$ CALL vgen(hybrid,reap,input,xcpot, atoms,sphhar,stars,vacuum,sym,& !!$ cell,oneD,sliceplot,mpi, results,noco,outDen,inDenRot,vTot,vx,vCoul) !!$ CALL timestop("generation of potential (total)") !!$ @@ -408,7 +408,7 @@ CONTAINS ! total energy CALL timestart('determination of total energy') - CALL totale(mpi,atoms,sphhar,stars,vacuum,DIMENSION,sym,input,noco,cell,oneD,& + CALL totale(mpi,atoms,sphhar,stars,vacuum,sym,input,noco,cell,oneD,& xcpot,hybrid,vTot,vCoul,iter,inDen,results) CALL timestop('determination of total energy') IF (hybrid%l_hybrid) CALL close_eig(eig_id) @@ -421,7 +421,7 @@ CONTAINS field2 = field ! mix input and output densities - CALL mix_charge(field2,DIMENSION,mpi,(iter==input%itmax.OR.judft_was_argument("-mix_io")),& + CALL mix_charge(field2,mpi,(iter==input%itmax.OR.judft_was_argument("-mix_io")),& stars,atoms,sphhar,vacuum,input,& sym,cell,noco,oneD,archiveType,xcpot,iter,inDen,outDen,results) diff --git a/main/fleur_init.F90 b/main/fleur_init.F90 index 58d8f319..a80548b9 100644 --- a/main/fleur_init.F90 +++ b/main/fleur_init.F90 @@ -7,7 +7,7 @@ MODULE m_fleur_init IMPLICIT NONE CONTAINS SUBROUTINE fleur_init(mpi,& - input,field,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,& + input,field,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,& sliceplot,banddos,enpara,xcpot,results,kpts,hybrid,& oneD,coreSpecInput,wann) USE m_types @@ -58,7 +58,7 @@ CONTAINS TYPE(t_mpi) ,INTENT(INOUT):: mpi TYPE(t_input) ,INTENT(OUT):: input TYPE(t_field), INTENT(OUT) :: field - TYPE(t_dimension),INTENT(OUT):: DIMENSION + TYPE(t_atoms) ,INTENT(OUT):: atoms TYPE(t_sphhar) ,INTENT(OUT):: sphhar TYPE(t_cell) ,INTENT(OUT):: cell @@ -145,7 +145,7 @@ CONTAINS CALL make_sphhar(atoms,sphhar,sym,cell,oneD) CALL make_stars(stars,sym,atoms,vacuum,sphhar,input,cell,xcpot,oneD,noco,mpi) call make_forcetheo(forcetheo_data,cell,sym,atoms,forcetheo) - CALL lapw_dim(kpts,cell,input,noco,oneD,forcetheo,DIMENSION) + call lapw_dim(kpts,cell,input,noco,oneD,forcetheo,atoms) call oned%init(atoms) !call again, because make_stars modified it :-) ! Store structure data CALL storeStructureIfNew(input,stars, atoms, cell, vacuum, oneD, sym, mpi,sphhar,noco) @@ -170,43 +170,35 @@ CONTAINS ! !--> determine more dimensions ! - DIMENSION%nbasfcn = DIMENSION%nvd + atoms%nat*atoms%nlod*(2*atoms%llod+1) - DIMENSION%lmd = atoms%lmaxd* (atoms%lmaxd+2) - IF (noco%l_noco) DIMENSION%nbasfcn = 2*DIMENSION%nbasfcn - ! Generate missing general parameters + ! Generate missing general parameters minNeigd = MAX(5,NINT(0.75*input%zelec) + 1) IF (noco%l_soc.and.(.not.noco%l_noco)) minNeigd = 2 * minNeigd IF (noco%l_soc.and.noco%l_ss) minNeigd=(3*minNeigd)/2 - IF ((dimension%neigd.NE.-1).AND.(dimension%neigd.LT.minNeigd)) THEN - IF (dimension%neigd>0) THEN + IF ((input%neig.NE.-1).AND.(input%neig.LT.minNeigd)) THEN + IF (input%neig>0) THEN WRITE(*,*) 'numbands is too small. Setting parameter to default value.' - WRITE(*,*) 'changed numbands (dimension%neigd) to ',minNeigd + WRITE(*,*) 'changed numbands (input%neig) to ',minNeigd ENDIF - dimension%neigd = minNeigd + input%neig = minNeigd END IF - IF(dimension%neigd.EQ.-1) THEN - dimension%neigd = dimension%nvd + atoms%nlotot + IF(input%neig.EQ.-1) THEN + input%neig = lapw_dim_nvd + atoms%nlotot END IF - IF (noco%l_noco) dimension%neigd = 2*dimension%neigd -#ifdef CPP_MPI - CALL MPI_BCAST(dimension%neigd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr) - CALL MPI_BCAST(dimension%nbasfcn,1,MPI_INTEGER,0,mpi%mpi_comm,ierr) - CALL MPI_BCAST(dimension%nv2d,1,MPI_INTEGER,0,mpi%mpi_comm,ierr) - CALL MPI_BCAST(dimension%nvd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr) -#endif + IF (noco%l_noco) input%neig = 2*input%neig + IF (mpi%irank.EQ.0) THEN CALL writeOutParameters(mpi,input,sym,stars,atoms,vacuum,kpts,& oneD,hybrid,cell,banddos,sliceplot,xcpot,& - noco,DIMENSION,enpara,sphhar) + noco,enpara,sphhar) CALL fleur_info(kpts) CALL deleteDensities() END IF !Finalize the MPI setup - CALL setupMPI(kpts%nkpt,dimension%neigd,mpi) + CALL setupMPI(kpts%nkpt,input%neig,mpi) !Collect some usage info CALL add_usage_data("A-Types",atoms%ntype) @@ -216,7 +208,7 @@ CONTAINS CALL add_usage_data("Noco",noco%l_noco) CALL add_usage_data("SOC",noco%l_soc) CALL add_usage_data("SpinSpiral",noco%l_ss) - CALL add_usage_data("PlaneWaves",DIMENSION%nvd) + CALL add_usage_data("PlaneWaves",lapw_dim_nvd) CALL add_usage_data("LOs",atoms%nlotot) CALL add_usage_data("nkpt", kpts%nkpt) @@ -226,7 +218,7 @@ CONTAINS CALL add_usage_data("gpu_per_node",0) #endif - CALL results%init(DIMENSION,input,atoms,kpts,noco) + CALL results%init(input,atoms,kpts,noco) IF (mpi%irank.EQ.0) THEN IF(input%gw.NE.0) CALL mixing_history_reset(mpi) diff --git a/main/mix.F90 b/main/mix.F90 index 268fefd2..0d27ae78 100644 --- a/main/mix.F90 +++ b/main/mix.F90 @@ -15,7 +15,7 @@ MODULE m_mix contains - SUBROUTINE mix_charge( field, DIMENSION, mpi, l_writehistory,& + SUBROUTINE mix_charge( field, mpi, l_writehistory,& stars, atoms, sphhar, vacuum, input, sym, cell, noco, & oneD, archiveType, xcpot, iteration, inDen, outDen, results ) @@ -44,7 +44,7 @@ contains TYPE(t_cell),TARGET,INTENT(in) :: cell TYPE(t_sphhar),TARGET,INTENT(in) :: sphhar type(t_field), intent(inout) :: field - type(t_dimension), intent(in) :: dimension + type(t_mpi), intent(in) :: mpi TYPE(t_atoms),TARGET,INTENT(in) :: atoms class(t_xcpot), intent(in) :: xcpot @@ -88,7 +88,7 @@ contains ! KERKER PRECONDITIONER IF( input%preconditioning_param /= 0 ) THEN CALL timestart("Preconditioner") - CALL kerker( field, DIMENSION, mpi, & + CALL kerker( field, mpi, & stars, atoms, sphhar, vacuum, input, sym, cell, noco, & oneD, inDen, outDen, fsm(it) ) !Store modified density in history diff --git a/main/optional.F90 b/main/optional.F90 index e980d015..44dcf75a 100644 --- a/main/optional.F90 +++ b/main/optional.F90 @@ -6,7 +6,7 @@ MODULE m_optional USE m_juDFT CONTAINS - SUBROUTINE OPTIONAL(mpi, atoms,sphhar,vacuum,DIMENSION,& + SUBROUTINE OPTIONAL(mpi, atoms,sphhar,vacuum,& stars,input,sym, cell, sliceplot, xcpot, noco, oneD) ! !---------------------------------------- @@ -70,7 +70,7 @@ CONTAINS TYPE(t_mpi),INTENT(IN) :: mpi TYPE(t_atoms),INTENT(IN) :: atoms - TYPE(t_dimension),INTENT(IN):: DIMENSION + TYPE(t_sphhar),INTENT(IN) :: sphhar TYPE(t_sym),INTENT(IN) :: sym TYPE(t_stars),INTENT(IN) :: stars @@ -106,7 +106,7 @@ CONTAINS IF (sliceplot%iplot.NE.0) THEN CALL timestart("Plotting") IF (input%strho) CALL juDFT_error("strho = T and iplot=/=0",calledby = "optional") - CALL plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,& + CALL plotdop(oneD,stars,vacuum,sphhar,atoms,& input,sym,cell,sliceplot,noco) CALL timestop("Plotting") END IF @@ -132,7 +132,7 @@ CONTAINS input%total = .FALSE. ! CALL timestart("generation of start-density") - CALL stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,& + CALL stden(mpi,sphhar,stars,atoms,sym,vacuum,& input,cell,xcpot,noco,oneD) ! input%total=strho @@ -144,7 +144,7 @@ CONTAINS ! IF (input%swsp) THEN CALL timestart("optional: spin polarized density") - CALL cdnsp(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,dimension) + CALL cdnsp(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell) ! CALL timestop("optional: spin polarized density") END IF diff --git a/main/totale.f90 b/main/totale.f90 index 49148427..c5f0407f 100644 --- a/main/totale.f90 +++ b/main/totale.f90 @@ -5,7 +5,7 @@ !-------------------------------------------------------------------------------- MODULE m_totale CONTAINS - SUBROUTINE totale(mpi,atoms,sphhar,stars,vacuum,DIMENSION, & + SUBROUTINE totale(mpi,atoms,sphhar,stars,vacuum, & sym,input,noco,cell,oneD, xcpot,hybrid,vTot,vCoul,it,den,results) ! ! *************************************************** @@ -62,7 +62,7 @@ CONTAINS TYPE(t_cell),INTENT(IN) :: cell TYPE(t_sphhar),INTENT(IN) :: sphhar TYPE(t_atoms),INTENT(IN) :: atoms - TYPE(t_dimension),INTENT(IN) :: dimension + TYPE(t_potden),INTENT(IN) :: vTot,vCoul TYPE(t_potden),INTENT(IN) :: den ! .. @@ -141,7 +141,7 @@ CONTAINS IF (input%l_f) THEN ! core contribution to force: needs TOTAL POTENTIAL and core charge - CALL force_a4(atoms,sym,sphhar,input,DIMENSION, vTot%mt, results%force) + CALL force_a4(atoms,sym,sphhar,input, vTot%mt, results%force) ENDIF diff --git a/main/vgen.F90 b/main/vgen.F90 index bf9d29e2..3d6e2f81 100644 --- a/main/vgen.F90 +++ b/main/vgen.F90 @@ -19,7 +19,7 @@ CONTAINS !! TE_VEFF: charge density-effective potential integral !! TE_EXC : charge density-ex-corr.energy density integral - SUBROUTINE vgen(hybrid,field,input,xcpot,DIMENSION,atoms,sphhar,stars,vacuum,sym,& + SUBROUTINE vgen(hybrid,field,input,xcpot,atoms,sphhar,stars,vacuum,sym,& cell,oneD,sliceplot,mpi,results,noco,EnergyDen,den,vTot,vx,vCoul) USE m_types @@ -38,7 +38,7 @@ CONTAINS CLASS(t_xcpot), INTENT(INOUT) :: xcpot TYPE(t_hybrid), INTENT(IN) :: hybrid TYPE(t_mpi), INTENT(IN) :: mpi - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_oneD), INTENT(IN) :: oneD TYPE(t_sliceplot), INTENT(IN) :: sliceplot TYPE(t_input), INTENT(IN) :: input @@ -79,7 +79,7 @@ CONTAINS !sum up both spins in den into workden CALL den%sum_both_spin(workden) - CALL vgen_coulomb(1,mpi,dimension,oneD,input,field,vacuum,sym,stars,cell,sphhar,atoms,workden,vCoul,results) + CALL vgen_coulomb(1,mpi,oneD,input,field,vacuum,sym,stars,cell,sphhar,atoms,workden,vCoul,results) CALL vCoul%copy_both_spin(vTot) vCoul%mt(:,:,:,input%jspins)=vCoul%mt(:,:,:,1) @@ -87,11 +87,11 @@ CONTAINS IF (noco%l_noco) THEN CALL denRot%init(stars,atoms,sphhar,vacuum,noco,input%jspins,0) denRot=den - CALL rotate_int_den_to_local(DIMENSION,sym,stars,atoms,sphhar,vacuum,cell,input,noco,oneD,denRot) + CALL rotate_int_den_to_local(sym,stars,atoms,sphhar,vacuum,cell,input,noco,oneD,denRot) IF (noco%l_mtnocoPot) CALL rotate_mt_den_to_local(atoms,sphhar,sym,denrot) ENDIF - CALL vgen_xcpot(hybrid,input,xcpot,dimension,atoms,sphhar,stars,vacuum,sym,& + CALL vgen_xcpot(hybrid,input,xcpot,atoms,sphhar,stars,vacuum,sym,& cell,oneD,sliceplot,mpi,noco,den,denRot,EnergyDen,vTot,vx,results) !ToDo, check if this is needed for more potentials as well... diff --git a/mix/kerker.F90 b/mix/kerker.F90 index 2cf971b6..44dd5147 100644 --- a/mix/kerker.F90 +++ b/mix/kerker.F90 @@ -7,7 +7,7 @@ MODULE m_kerker CONTAINS - SUBROUTINE kerker( field, DIMENSION, mpi, & + SUBROUTINE kerker( field, mpi, & stars, atoms, sphhar, vacuum, input, sym, cell, noco, & oneD, inDen, outDen, precon_v ) @@ -35,7 +35,7 @@ CONTAINS TYPE(t_cell), INTENT(in) :: cell TYPE(t_sphhar), INTENT(in) :: sphhar TYPE(t_field), INTENT(inout) :: field - TYPE(t_dimension), INTENT(in) :: DIMENSION + TYPE(t_mpi), INTENT(in) :: mpi TYPE(t_atoms), INTENT(in) :: atoms TYPE(t_potden), INTENT(inout) :: outDen @@ -57,7 +57,7 @@ CONTAINS CALL mpi_bc_potden( mpi, stars, sphhar, atoms, input, vacuum, oneD, noco, resDen ) #endif IF ( .NOT. input%film ) THEN - CALL vgen_coulomb( 1, mpi, DIMENSION, oneD, input, field, vacuum, sym, stars, cell, & + CALL vgen_coulomb( 1, mpi, oneD, input, field, vacuum, sym, stars, cell, & sphhar, atoms, resDen, vYukawa ) ELSE if( mpi%irank == 0 ) then diff --git a/mpi/mpi_bc_all.F90 b/mpi/mpi_bc_all.F90 index 4c445910..166dc853 100644 --- a/mpi/mpi_bc_all.F90 +++ b/mpi/mpi_bc_all.F90 @@ -8,7 +8,7 @@ MODULE m_mpi_bc_all CONTAINS SUBROUTINE mpi_bc_all(& mpi,stars,sphhar,atoms,sym,& - kpts,DIMENSION,input,field,banddos,sliceplot,& + kpts,input,field,banddos,sliceplot,& vacuum,cell,enpara,noco,oneD,& hybrid) ! @@ -17,7 +17,7 @@ CONTAINS IMPLICIT NONE INCLUDE 'mpif.h' TYPE(t_mpi),INTENT(INOUT) :: mpi - TYPE(t_dimension),INTENT(INOUT) :: dimension + TYPE(t_oneD),INTENT(INOUT) :: oneD TYPE(t_hybrid),INTENT(INOUT) :: hybrid TYPE(t_enpara),INTENT(INOUT) :: enpara @@ -57,7 +57,7 @@ CONTAINS i(31)=input%gw ; i(32)=input%gw_neigd ; i(33)=hybrid%ewaldlambda ; i(34)=hybrid%lexp i(35)=hybrid%bands1 ; i(36)=input%maxiter ; i(37)=input%imix ; i(38)=banddos%orbCompAtom i(39)=input%kcrel;i(40)=banddos%s_cell_x;i(41)=banddos%s_cell_y;i(42)=banddos%s_cell_z; i(43)=sliceplot%iplot - i(44)=atoms%nlotot;i(45)=dimension%nbasfcn + i(44)=atoms%nlotot;i(45)=lapw%dim_nbasfcn() r(1)=cell%omtil ; r(2)=cell%area ; r(3)=vacuum%delz ; r(4)=cell%z1 ; r(5)=input%alpha r(6)=sliceplot%e1s ; r(7)=sliceplot%e2s ; r(8)=noco%theta; r(9)=noco%phi; r(10)=vacuum%tworkf @@ -94,7 +94,7 @@ CONTAINS atoms%ntype=i(3) ; banddos%orbCompAtom=i(38);banddos%s_cell_x=i(40);banddos%s_cell_y=i(41);banddos%s_cell_z=i(42) input%coretail_lmax=i(2) ; input%kcrel=i(39) stars%kimax=i(25);stars%kimax2=i(26) - atoms%nlotot=i(44);dimension%nbasfcn=i(45) + atoms%nlotot=i(44);lapw%dim_nbasfcn()=i(45) ! CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr) input%minDistance=r(29) diff --git a/mpi/mpi_bc_coreDen.F90 b/mpi/mpi_bc_coreDen.F90 index 0f2ceeb4..893cf54c 100644 --- a/mpi/mpi_bc_coreDen.F90 +++ b/mpi/mpi_bc_coreDen.F90 @@ -6,7 +6,7 @@ MODULE m_mpi_bc_coreden CONTAINS - SUBROUTINE mpi_bc_coreden(mpi,atoms,input,dimension,& + SUBROUTINE mpi_bc_coreden(mpi,atoms,input,& rhcs,tecs,qints) USE m_types @@ -16,7 +16,7 @@ CONTAINS TYPE(t_mpi),INTENT(IN) :: mpi TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_input),INTENT(IN) :: input - TYPE(t_dimension),INTENT(IN) :: DIMENSION + REAL, INTENT(INOUT) :: rhcs(atoms%jmtd,atoms%ntype,input%jspins) REAL, INTENT(INOUT) :: tecs(atoms%ntype,input%jspins) diff --git a/mpi/mpi_make_groups.F90 b/mpi/mpi_make_groups.F90 index abfa385b..0ca19782 100644 --- a/mpi/mpi_make_groups.F90 +++ b/mpi/mpi_make_groups.F90 @@ -8,19 +8,19 @@ MODULE m_mpimakegroups use m_juDFT CONTAINS SUBROUTINE mpi_make_groups(& - mpi,dimension,kpts, input,atoms,noco,& + mpi,kpts, input,atoms,noco,& mlotot,mlolotot,& n_start,n_groups,n,matsize,ne, n_rank,n_size,SUB_COMM) !------------------------------------------------------------------------ ! ! Distribute the k-point / eigenvector parallelisation so, that -! all pe's have aproximately equal load. Maximize for k-point +! all pe's have aproximately equal load. Maximize for k-point ! parallelisation. The naming conventions are as follows: ! -! groups 1 2 (n_groups = 2) +! groups 1 2 (n_groups = 2) ! / \ / \ ! k-points: 1 2 3 4 (nkpts = 4) -! /|\ /|\ /|\ /|\ +! /|\ /|\ /|\ /|\ ! irank 01 2 34 5 01 2 34 5 (isize = 6) ! ! n_rank 01 2 01 2 01 2 01 2 (n_size = 3) @@ -37,32 +37,33 @@ CONTAINS ! The results (containing a subset of ew & ev's) are written as separate ! records on the file 'eig' with the vacuum energy parameter of the ! marked (*) records set to 999.9 to indicate that this is only one part -! of a k-point's results. This marker is needed in routines fermie and +! of a k-point's results. This marker is needed in routines fermie and ! cdnval. ! G.B. `99 ! !------------------------------------------------------------------------ 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_noco),INTENT(IN) :: noco TYPE(t_kpts),INTENT(IN) :: kpts TYPE(t_atoms),INTENT(IN) :: atoms INTEGER, INTENT (IN) :: mlotot - INTEGER, INTENT (IN) :: mlolotot + INTEGER, INTENT (IN) :: mlolotot INTEGER, INTENT (OUT) :: n_start,n_groups,n,SUB_COMM INTEGER, INTENT (OUT) :: matsize,n_rank,n_size,ne - INTEGER i,n_members - INTEGER, ALLOCATABLE :: i_mygroup(:) + INTEGER i,n_members + INTEGER, ALLOCATABLE :: i_mygroup(:) + + INCLUDE 'mpif.h' + INTEGER WORLD_GROUP,SUB_GROUP + INTEGER ierr(3) + LOGICAL l_cm - INCLUDE 'mpif.h' - INTEGER WORLD_GROUP,SUB_GROUP - INTEGER ierr(3) - LOGICAL l_cm ! ! first determine the number of groups of k-points to process ! @@ -86,7 +87,7 @@ CONTAINS ELSEIF (kpts%nkpt.LT.mpi%isize) THEN ! if there are more PEs than k-points - IF (mod(mpi%isize,kpts%nkpt).EQ.0) THEN ! maybe mpi%isize is a multiple of kpts%nkpt + IF (mod(mpi%isize,kpts%nkpt).EQ.0) THEN ! maybe mpi%isize is a multiple of kpts%nkpt n_groups = 1 n_size = mpi%isize/kpts%nkpt ELSE ! or an integer fraction of kpts%nkpt fits @@ -113,18 +114,18 @@ CONTAINS 990 IF (n_groups==0) CALL juDFT_error("mpi_make_groups:1",calledby ="mpi_make_groups") - n_members = kpts%nkpt/n_groups + n_members = kpts%nkpt/n_groups ! ! check different algorithm ! - CALL check_memory(DIMENSION,input,atoms, mlotot,mlolotot,noco,kpts,mpi, n_size) + CALL check_memory(input,atoms, mlotot,mlolotot,noco,kpts,mpi, n_size) write(*,*) n_size n_members = MIN(kpts%nkpt,mpi%isize) n_members = MIN(n_members , CEILING(REAL(mpi%isize)/n_size) ) + 1 - + l_cm = .false. - DO WHILE (.not.l_cm) + DO WHILE (.not.l_cm) n_members = n_members - 1 IF ((mod(mpi%isize,n_members) == 0).AND.& & (mod(kpts%nkpt,n_members) == 0) ) THEN @@ -162,16 +163,16 @@ CONTAINS ! determine number of columns per group ! n=0 - DO i=1+n_rank, dimension%nbasfcn, n_size + DO i=1+n_rank, lapw_dim_nbasfcn, n_size n=n+1 ENDDO IF (n_size.GT.1) THEN - matsize = dimension%nbasfcn * n + matsize = lapw_dim_nbasfcn * n ELSE - matsize = (dimension%nbasfcn+1)*dimension%nbasfcn/2 + matsize = (lapw_dim_nbasfcn+1)*lapw_dim_nbasfcn/2 ENDIF ! - ne = dimension%neigd + ne = input%neig ne = max(ne,5) DEALLOCATE (i_mygroup) @@ -179,7 +180,7 @@ CONTAINS END SUBROUTINE mpi_make_groups !---------------------------------------------------------------------- - SUBROUTINE check_memory(DIMENSION,input,atoms, mlotot,mlolotot, noco,kpts,mpi, n_size) + SUBROUTINE check_memory(input,atoms, mlotot,mlolotot, noco,kpts,mpi, n_size) ! ! check the free and the (approximate) required memory ; @@ -188,13 +189,13 @@ CONTAINS USE m_types IMPLICIT NONE type(t_mpi),INTENT(IN) :: mpi - TYPE(t_dimension),INTENT(IN) :: dimension + TYPE(t_kpts),INTENT(IN) :: kpts TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_noco),INTENT(IN) :: noco TYPE(t_input),INTENT(IN) :: input - INTEGER, INTENT (IN) :: mlotot,mlolotot + INTEGER, INTENT (IN) :: mlotot,mlolotot INTEGER, INTENT (OUT) :: n_size INTEGER err, mb @@ -202,20 +203,20 @@ CONTAINS REAL, ALLOCATABLE :: test(:) n_size = CEILING( real(mpi%isize)/min(kpts%nkpt,mpi%isize) ) - + 10 CONTINUE ! ! some basic arrays allocated in eigen() ! - - mem = ((dimension%lmd* (dimension%lmd+3))/2+1)*atoms%ntype*4 ! tlmplm%tuu,tlmplm%tdd etc. - mem = mem + (dimension%lmd+1)*(2*atoms%llod+1)*max(mlotot,1)*2 ! tlmplm%tuulo ... + + mem = ((atoms%lmaxd*(atoms%lmaxd+2)* (atoms%lmaxd*(atoms%lmaxd+2)+3))/2+1)*atoms%ntype*4 ! tlmplm%tuu,tlmplm%tdd etc. + mem = mem + (atoms%lmaxd*(atoms%lmaxd+2)+1)*(2*atoms%llod+1)*max(mlotot,1)*2 ! tlmplm%tuulo ... mem = mem + (2*atoms%llod+1)**2 * max(mlolotot,1) ! tlmplm%tuloulo IF (noco%l_noco) mem = mem * 2 ! both spins mem = mem + 49*atoms%n_u*input%jspins*2 ! lda+U, *2 for complex - mem = mem+INT((dimension%nbasfcn*2+(dimension%lmd+1)*atoms%ntype)*0.5)+1 ! tlmplm%ind, *0.5 for integer + mem = mem+INT((lapw_dim_nbasfcn*2+(atoms%lmaxd*(atoms%lmaxd+2)+1)*atoms%ntype)*0.5)+1 ! tlmplm%ind, *0.5 for integer - matsz = dimension%nbasfcn * CEILING(REAL(dimension%nbasfcn)/n_size) ! size of a, b + matsz = lapw_dim_nbasfcn * CEILING(REAL(lapw_dim_nbasfcn)/n_size) ! size of a, b #ifdef CPP_INVERSION mem = mem + 2 * matsz ! real case #else @@ -224,23 +225,23 @@ CONTAINS ! ! now the arrays in hssphn() ! - m_h = dimension%nvd*(dimension%lmd+1)*4 + dimension%nvd*8 + atoms%nlod ! ar, ai ..., cph, rph, vk, gk + m_h = lapw_dim_nvd*(atoms%lmaxd*(atoms%lmaxd+2)+1)*4 + lapw_dim_nvd*8 + atoms%nlod ! ar, ai ..., cph, rph, vk, gk m_h = m_h + 2 * (2*atoms%llod+1)**2 * atoms%nlod * 3 * 2 ! alo,blo,clo IF (noco%l_ss) m_h = m_h * 2 - m_h = m_h + dimension%nvd*(5+atoms%lmaxd) ! axr, ... plegend + m_h = m_h + lapw_dim_nvd*(5+atoms%lmaxd) ! axr, ... plegend IF (noco%l_ss.OR.noco%l_constr.OR.(noco%l_noco.AND.noco%l_soc)) THEN - m_h = m_h + dimension%nvd*(atoms%lmaxd+1)*atoms%ntype*2*2 ! fj,gj - ELSE - m_h = m_h + dimension%nvd*(atoms%lmaxd+1)*atoms%ntype*2 ! fj,gj + m_h = m_h + lapw_dim_nvd*(atoms%lmaxd+1)*atoms%ntype*2*2 ! fj,gj + ELSE + m_h = m_h + lapw_dim_nvd*(atoms%lmaxd+1)*atoms%ntype*2 ! fj,gj ENDIF IF (noco%l_noco.AND.noco%l_soc) THEN - m_h = m_h + dimension%nvd*(atoms%lmaxd+4) + m_h = m_h + lapw_dim_nvd*(atoms%lmaxd+4) ENDIF IF (noco%l_constr) THEN m_h = m_h + (atoms%lmaxd+1)*atoms%ntype ENDIF IF (noco%l_noco.AND.(.NOT.noco%l_ss)) THEN - matsz = (dimension%nvd+mlotot) * CEILING(REAL(dimension%nvd+mlotot)/n_size) + matsz = (lapw_dim_nvd+mlotot) * CEILING(REAL(lapw_dim_nvd+mlotot)/n_size) m_h = m_h + matsz * 2 * 2 ! aahlp,bbhlp ENDIF ! @@ -255,21 +256,21 @@ CONTAINS mb = (mem+m_h)*8/(1024)**2 WRITE(*,*) mb,'Mbytes needed in hssphn!' CALL juDFT_error("mpi_make_groups: memory too small!",calledby ="mpi_make_groups") - ENDIF + ENDIF GOTO 10 ENDIF DEALLOCATE (test) ! ! now, allocate z and jump into chani -! - matsz = dimension%nbasfcn * CEILING(REAL(dimension%nbasfcn)/n_size) ! size of z +! + matsz = lapw_dim_nbasfcn * CEILING(REAL(lapw_dim_nbasfcn)/n_size) ! size of z #ifdef CPP_INVERSION mem = mem + matsz ! real case #else mem = mem + matsz * 2 ! complex case #endif mem = mem + matsz * 2 * 3 ! asca,bsca,eigvec - mem = mem + dimension%nbasfcn + mem = mem + lapw_dim_nbasfcn #ifdef CPP_INVERSION mem = mem + matsz ! work #else @@ -292,7 +293,7 @@ CONTAINS GOTO 10 ENDIF DEALLOCATE (test) - + END SUBROUTINE check_memory !---------------------------------------------------------------------- diff --git a/optional/atom2.f90 b/optional/atom2.f90 index 7be76cb1..08434639 100644 --- a/optional/atom2.f90 +++ b/optional/atom2.f90 @@ -9,7 +9,7 @@ MODULE m_atom2 ! ************************************************************* CONTAINS SUBROUTINE atom2(& - & dimension, atoms, xcpot, input, ntyp, jrc, rnot1,& + & atoms, xcpot, input, ntyp, jrc, rnot1,& & qdel,& & rhoss, nst, lnum, eig, vbar,l_valence) @@ -23,7 +23,7 @@ CONTAINS IMPLICIT NONE ! .. ! .. Scalar Arguments .. - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_atoms), INTENT(IN) :: atoms CLASS(t_xcpot), INTENT(IN) :: xcpot TYPE(t_input), INTENT(IN) :: input diff --git a/optional/cdnsp.f90 b/optional/cdnsp.f90 index 2357c186..948750c0 100644 --- a/optional/cdnsp.f90 +++ b/optional/cdnsp.f90 @@ -15,7 +15,7 @@ CONTAINS SUBROUTINE cdnsp(& & atoms,input,vacuum,sphhar,& - & stars,sym,noco,oneD,cell,DIMENSION) + & stars,sym,noco,oneD,cell) USE m_intgr, ONLY : intgr3 USE m_constants @@ -32,7 +32,7 @@ TYPE(t_noco),INTENT(IN) :: noco TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_cell),INTENT(IN) :: cell - TYPE(t_dimension),INTENT(IN) :: DIMENSION + ! local type instances TYPE(t_potden) :: den @@ -40,7 +40,7 @@ ! .. Local Scalars .. REAL dummy,p,pp,qtot1,qtot2,spmtot,qval,sfp,fermiEnergyTemp INTEGER i,ivac,j,k,lh,n,na,jsp_new - INTEGER ios + INTEGER ios LOGICAL n_exist,l_qfix ! .. ! .. Local Arrays .. @@ -57,7 +57,7 @@ CALL den%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN) input%jspins=1 - CALL readCoreDensity(input,atoms,dimension,rhoc,tec,qintc) + CALL readCoreDensity(input,atoms,rhoc,tec,qintc) CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN1_const,& CDN_INPUT_DEN_const,0,fermiEnergyTemp,l_qfix,den) input%jspins=2 @@ -109,7 +109,7 @@ CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN1_const,& CDN_INPUT_DEN_const,0,-1.0,0.0,.FALSE.,den) ! - ! -----> This part is only used for testing th e magnetic moment in + ! -----> This part is only used for testing th e magnetic moment in ! -----> each sphere ! DO n = 1,atoms%ntype diff --git a/optional/plotdop.f90 b/optional/plotdop.f90 index d75c1d8e..627f2dd3 100644 --- a/optional/plotdop.f90 +++ b/optional/plotdop.f90 @@ -26,7 +26,7 @@ use m_types CONTAINS -SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,& +SUBROUTINE plotdop(oneD,stars,vacuum,sphhar,atoms,& input,sym,cell,sliceplot,noco,cdnfname) USE m_outcdn @@ -38,7 +38,7 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,& IMPLICIT NONE TYPE(t_oneD), INTENT(IN) :: oneD - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_stars), INTENT(IN) :: stars TYPE(t_vacuum), INTENT(IN) :: vacuum TYPE(t_sphhar), INTENT(IN) :: sphhar diff --git a/optional/stden.f90 b/optional/stden.f90 index 49291f5e..d7123dea 100644 --- a/optional/stden.f90 +++ b/optional/stden.f90 @@ -12,7 +12,7 @@ USE m_juDFT CONTAINS -SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,& +SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,vacuum,& input,cell,xcpot,noco,oneD) USE m_constants @@ -30,7 +30,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,& TYPE(t_mpi),INTENT(IN) :: mpi TYPE(t_atoms),INTENT(IN) :: atoms - TYPE(t_dimension),INTENT(IN):: DIMENSION + TYPE(t_sphhar),INTENT(IN) :: sphhar TYPE(t_sym),INTENT(IN) :: sym TYPE(t_stars),INTENT(IN) :: stars @@ -148,7 +148,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,& END DO END DO ELSE - CALL atom2(DIMENSION,atoms,xcpot,input,n,jrc(n),rnot,qdel,& + CALL atom2(atoms,xcpot,input,n,jrc(n),rnot,qdel,& rhoss,nst(n),lnum(1,n),eig(1,1,n),vbar(1,n),.true.) DO ispin = 1, input%jspins DO i = 1, jrc(n) ! atoms%msh @@ -189,7 +189,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,& END IF ! mpi%irank == 0 DO ispin = 1, input%jspins - CALL cdnovlp(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,& + CALL cdnovlp(mpi,sphhar,stars,atoms,sym,vacuum,& cell,input,oneD,l_st,ispin,rh1(:,:,ispin),& den%pw,den%vacxy,den%mt,den%vacz) !roa- @@ -214,7 +214,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,& IF (input%vchk) THEN DO ispin = 1, input%jspins WRITE (6,'(a8,i2)') 'spin No.',ispin - CALL checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,& + CALL checkDOPAll(input,sphhar,stars,atoms,sym,vacuum,oneD,& cell,den,ispin) END DO ! ispin = 1, input%jspins END IF ! input%vchk diff --git a/orbdep/mcd_init.f90 b/orbdep/mcd_init.f90 index e5b8a133..79255852 100644 --- a/orbdep/mcd_init.f90 +++ b/orbdep/mcd_init.f90 @@ -1,6 +1,6 @@ MODULE m_mcdinit CONTAINS - SUBROUTINE mcd_init(atoms,input,DIMENSION,vr,g,f,mcd,itype,jspin) + SUBROUTINE mcd_init(atoms,input,vr,g,f,mcd,itype,jspin) !----------------------------------------------------------------------- ! @@ -18,7 +18,7 @@ CONTAINS USE m_types IMPLICIT NONE - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_input),INTENT(IN) :: input TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_mcd),INTENT(INOUT) :: mcd diff --git a/rdmft/rdmft.F90 b/rdmft/rdmft.F90 index d0719498..b98cd897 100644 --- a/rdmft/rdmft.F90 +++ b/rdmft/rdmft.F90 @@ -8,7 +8,7 @@ MODULE m_rdmft CONTAINS -SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars,vacuum,dimension,& +SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars,vacuum,& sphhar,sym,field,vTot,vCoul,oneD,noco,xcpot,hybrid,results,coreSpecInput,archiveType,outDen) USE m_types @@ -53,7 +53,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars TYPE(t_enpara), INTENT(INOUT) :: enpara TYPE(t_stars), INTENT(IN) :: stars TYPE(t_vacuum), INTENT(IN) :: vacuum - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_dimension) :: dimension !!to be deleted TYPE(t_sphhar), INTENT(IN) :: sphhar TYPE(t_sym), INTENT(IN) :: sym TYPE(t_field), INTENT(INOUT) :: field @@ -95,15 +95,15 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars LOGICAL :: converged, l_qfix, l_restart, l_zref CHARACTER(LEN=20) :: filename - INTEGER :: nsest(dimension%neigd) ! probably too large - INTEGER :: indx_sest(dimension%neigd,dimension%neigd) ! probably too large + INTEGER :: nsest(input%neig) ! probably too large + INTEGER :: indx_sest(input%neig,input%neig) ! probably too large INTEGER :: rrot(3,3,sym%nsym) INTEGER :: psym(sym%nsym) ! Note: psym is only filled up to index nsymop INTEGER :: lowestState(kpts%nkpt,input%jspins) INTEGER :: highestState(kpts%nkpt,input%jspins) INTEGER :: neigTemp(kpts%nkpt,input%jspins) - REAL :: wl_iks(dimension%neigd,kpts%nkptf) + REAL :: wl_iks(input%neig,kpts%nkptf) REAL, ALLOCATABLE :: overallVCoulSSDen(:,:,:) REAL, ALLOCATABLE :: vTotSSDen(:,:,:) @@ -252,7 +252,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars ALLOCATE(dEdOcc(MAXVAL(results%neig(1:kpts%nkpt,1:input%jspins)),kpts%nkpt,input%jspins)) CALL regCharges%init(input,atoms) - CALL dos%init(dimension%neigd,input,atoms,kpts,vacuum) + CALL dos%init(input%neig,input,atoms,kpts,vacuum) CALL moments%init(input,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) @@ -295,12 +295,12 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars cdnvalJob%k_list=[ikpt] cdnvalJob%ev_list=[iband] cdnvalJob%weights(iBand,ikpt) = spinDegenFac - + ! Call cdnval to construct density WRITE(*,*) 'Note: some optional flags may have to be reset in rdmft before the cdnval call' WRITE(*,*) 'This is not yet implemented!' CALL singleStateDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN) - CALL cdnval(eig_id,mpi,kpts,jsp,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,& + CALL cdnval(eig_id,mpi,kpts,jsp,noco,input,banddos,cell,atoms,enpara,stars,vacuum,& sphhar,sym,vTot,oneD,cdnvalJob,singleStateDen,regCharges,dos,results,moments) ! Store the density on disc (These are probably way too many densities to keep them in memory) @@ -332,26 +332,26 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars IF(ALLOCATED(hybrid%div_vv)) DEALLOCATE(hybrid%div_vv) ALLOCATE(hybrid%ne_eig(kpts%nkpt),hybrid%nbands(kpts%nkpt),hybrid%nobd(kpts%nkptf)) ALLOCATE(hybrid%nbasm(kpts%nkptf)) - ALLOCATE(hybrid%div_vv(DIMENSION%neigd,kpts%nkpt,input%jspins)) + ALLOCATE(hybrid%div_vv(input%neig,kpts%nkpt,input%jspins)) l_restart = .FALSE. l_zref = (sym%zrfs.AND.(SUM(ABS(kpts%bk(3,:kpts%nkpt))).LT.1e-9).AND..NOT.noco%l_noco) iterHF = 0 hybrid%l_calhf = .TRUE. -! CALL open_hybrid_io1(DIMENSION,sym%invs) +! CALL open_hybrid_io1(sym%invs) CALL mixedbasis(atoms,kpts,dimension,input,cell,sym,xcpot,hybrid,enpara,mpi,vTot,l_restart) - CALL open_hybrid_io2(hybrid,DIMENSION,atoms,sym%invs) + CALL open_hybrid_io2(hybrid,input,atoms,sym%invs) CALL coulombmatrix(mpi,atoms,kpts,cell,sym,hybrid,xcpot,l_restart) - CALL hf_init(hybrid,kpts,atoms,input,DIMENSION,hybdat,sym%invs) + CALL hf_init(hybrid,kpts,atoms,input,dimension,hybdat,sym%invs) WRITE(*,*) 'RDMFT: HF initializations end' ALLOCATE(parent(kpts%nkptf)) - ALLOCATE(exDiag(dimension%neigd,ikpt,input%jspins)) + ALLOCATE(exDiag(input%neig,ikpt,input%jspins)) ALLOCATE(lastGradient(numStates+1)) ALLOCATE(lastParameters(numStates+1)) lastGradient = 0.0 @@ -383,11 +383,11 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars IF (noco%l_mperp) jspmax = 1 DO jspin = 1,jspmax CALL cdnvalJob%init(mpi,input,kpts,noco,results,jspin) - CALL cdnval(eig_id,mpi,kpts,jsp,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,& + CALL cdnval(eig_id,mpi,kpts,jsp,noco,input,banddos,cell,atoms,enpara,stars,vacuum,& sphhar,sym,vTot,oneD,cdnvalJob,overallDen,regCharges,dos,results,moments) END DO - CALL cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,& + CALL cdncore(mpi,oneD,input,vacuum,noco,sym,& stars,cell,sphhar,atoms,vTot,overallDen,moments,results) IF (mpi%irank.EQ.0) THEN CALL qfix(mpi,stars,atoms,sym,vacuum,sphhar,input,cell,oneD,overallDen,noco%l_noco,.TRUE.,.true.,fix) @@ -401,7 +401,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars CALL overallVCoul%resetPotDen() ALLOCATE(overallVCoul%pw_w(size(overallVCoul%pw,1),size(overallVCoul%pw,2))) overallVCoul%pw_w(:,:) = 0.0 - CALL vgen_coulomb(1,mpi,DIMENSION,oneD,input,field,vacuum,sym,stars,cell,sphhar,atoms,overallDen,overallVCoul) + CALL vgen_coulomb(1,mpi,oneD,input,field,vacuum,sym,stars,cell,sphhar,atoms,overallDen,overallVCoul) CALL convol(stars,overallVCoul%pw_w(:,1),overallVCoul%pw(:,1),stars%ufft) ! Is there a problem with a second spin?! #ifdef CPP_MPI CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,overallVCoul) @@ -471,14 +471,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,dimension,hybdat,eig_irr,atoms,hybrid,cell,lapw,jspin,mpi,& + CALL symm_hf(kpts,ikpt,sym,input,hybdat,eig_irr,atoms,hybrid,cell,lapw,jspin,mpi,& 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,hybrid,cell,dimension,input,jspin,hybdat,mnobd,lapw,& eig_irr,results,parent,pointer_EIBZ,n_q,wl_iks,iterHF,xcpot,noco,nsest,indx_sest,& mpi,exMat) - CALL exchange_vccv1(ikpt,atoms,hybrid,hybdat,dimension,jspin,lapw,nsymop,nsest,indx_sest,mpi,1.0,results,exMat) + CALL exchange_vccv1(ikpt,atoms,hybrid,hybdat,input,jspin,lapw,nsymop,nsest,indx_sest,mpi,1.0,results,exMat) !Start of workaround for increased functionality of symmetrizeh (call it)) @@ -501,7 +501,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars olap%data_c = conjg(olap%data_c) END IF - CALL zMat%init(olap%l_real,nbasfcn,dimension%neigd) + CALL zMat%init(olap%l_real,nbasfcn,input%neig) CALL read_eig(eig_id,ikpt,jspin,list=[(i,i=1,hybrid%nbands(ikpt))],neig=nbands,zmat=zMat) @@ -529,7 +529,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars CALL symmetrizeh(atoms,kpts%bkf(:,ikpt),dimension,jspin,lapw,sym,hybdat%kveclo_eig,cell,nsymop,psym,exMatLAPW) - IF (.NOT.exMatLAPW%l_real) exMatLAPW%data_c=conjg(exMatLAPW%data_c) + IF (.NOT.exMatLAPW%l_real) exMatLAPW%data_c=conjg(exMatLAPW%data_c) zMat%matsize1=MIN(zMat%matsize1,exMatLAPW%matsize2) CALL exMatLAPW%multiply(zMat,tmpMat) @@ -657,7 +657,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars !I think we need most of cdngen at this place so I just use cdngen CALL outDen%resetPotDen() - CALL cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,DIMENSION,kpts,atoms,sphhar,stars,sym,& + CALL cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,kpts,atoms,sphhar,stars,sym,& enpara,cell,noco,vTot,results,oneD,coreSpecInput,archiveType,xcpot,outDen, EnergyDen) ! Calculate RDMFT energy diff --git a/types/types_cdnval.f90 b/types/types_cdnval.f90 index 9eaddef9..94dd168e 100644 --- a/types/types_cdnval.f90 +++ b/types/types_cdnval.f90 @@ -277,7 +277,7 @@ SUBROUTINE denCoeffs_init(thisDenCoeffs, atoms, sphhar, jsp_start, jsp_end) END SUBROUTINE denCoeffs_init -SUBROUTINE slab_init(thisSlab,banddos,dimension,atoms,cell,input,kpts) +SUBROUTINE slab_init(thisSlab,banddos,atoms,cell,input,kpts) USE m_types_setup USE m_types_kpts @@ -288,7 +288,7 @@ SUBROUTINE slab_init(thisSlab,banddos,dimension,atoms,cell,input,kpts) CLASS(t_slab), INTENT(INOUT) :: thisSlab TYPE(t_banddos), INTENT(IN) :: banddos - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_cell), INTENT(IN) :: cell TYPE(t_input), INTENT(IN) :: input @@ -305,8 +305,8 @@ SUBROUTINE slab_init(thisSlab,banddos,dimension,atoms,cell,input,kpts) ALLOCATE (thisSlab%zsl(2,nsld)) ALLOCATE (thisSlab%volsl(nsld)) ALLOCATE (thisSlab%volintsl(nsld)) - ALLOCATE (thisSlab%qintsl(nsld,dimension%neigd,kpts%nkpt,input%jspins)) - ALLOCATE (thisSlab%qmtsl(nsld,dimension%neigd,kpts%nkpt,input%jspins)) + ALLOCATE (thisSlab%qintsl(nsld,input%neig,kpts%nkpt,input%jspins)) + ALLOCATE (thisSlab%qmtsl(nsld,input%neig,kpts%nkpt,input%jspins)) CALL slabgeom(atoms,cell,nsld,thisSlab%nsl,thisSlab%zsl,thisSlab%nmtsl,& thisSlab%nslat,thisSlab%volsl,thisSlab%volintsl) ELSE @@ -331,14 +331,14 @@ SUBROUTINE slab_init(thisSlab,banddos,dimension,atoms,cell,input,kpts) END SUBROUTINE slab_init -SUBROUTINE eigVecCoeffs_init(thisEigVecCoeffs,input,DIMENSION,atoms,noco,jspin,noccbd) +SUBROUTINE eigVecCoeffs_init(thisEigVecCoeffs,input,atoms,noco,jspin,noccbd) USE m_types_setup IMPLICIT NONE CLASS(t_eigVecCoeffs), INTENT(INOUT) :: thisEigVecCoeffs - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_noco), INTENT(IN) :: noco TYPE(t_input), INTENT(IN) :: input @@ -350,12 +350,12 @@ SUBROUTINE eigVecCoeffs_init(thisEigVecCoeffs,input,DIMENSION,atoms,noco,jspin,n IF(ALLOCATED(thisEigVecCoeffs%ccof)) DEALLOCATE(thisEigVecCoeffs%ccof) IF (noco%l_mperp) THEN - ALLOCATE (thisEigVecCoeffs%acof(noccbd,0:dimension%lmd,atoms%nat,input%jspins)) - ALLOCATE (thisEigVecCoeffs%bcof(noccbd,0:dimension%lmd,atoms%nat,input%jspins)) + ALLOCATE (thisEigVecCoeffs%acof(noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat,input%jspins)) + ALLOCATE (thisEigVecCoeffs%bcof(noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat,input%jspins)) ALLOCATE (thisEigVecCoeffs%ccof(-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat,input%jspins)) ELSE - ALLOCATE (thisEigVecCoeffs%acof(noccbd,0:dimension%lmd,atoms%nat,jspin:jspin)) - ALLOCATE (thisEigVecCoeffs%bcof(noccbd,0:dimension%lmd,atoms%nat,jspin:jspin)) + ALLOCATE (thisEigVecCoeffs%acof(noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat,jspin:jspin)) + ALLOCATE (thisEigVecCoeffs%bcof(noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat,jspin:jspin)) ALLOCATE (thisEigVecCoeffs%ccof(-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat,jspin:jspin)) END IF @@ -365,7 +365,7 @@ SUBROUTINE eigVecCoeffs_init(thisEigVecCoeffs,input,DIMENSION,atoms,noco,jspin,n END SUBROUTINE eigVecCoeffs_init -SUBROUTINE mcd_init1(thisMCD,banddos,dimension,input,atoms,kpts) +SUBROUTINE mcd_init1(thisMCD,banddos,input,atoms,kpts) USE m_types_setup USE m_types_kpts @@ -374,7 +374,7 @@ SUBROUTINE mcd_init1(thisMCD,banddos,dimension,input,atoms,kpts) CLASS(t_mcd), INTENT(INOUT) :: thisMCD TYPE(t_banddos), INTENT(IN) :: banddos - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_input), INTENT(IN) :: input TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_kpts), INTENT(IN) :: kpts @@ -385,7 +385,7 @@ SUBROUTINE mcd_init1(thisMCD,banddos,dimension,input,atoms,kpts) thisMCD%emcd_lo = banddos%e_mcd_lo thisMCD%emcd_up = banddos%e_mcd_up ALLOCATE (thisMCD%m_mcd(29,(3+1)**2,3*atoms%ntype,2)) - ALLOCATE (thisMCD%mcd(3*atoms%ntype,29,dimension%neigd,kpts%nkpt,input%jspins) ) + ALLOCATE (thisMCD%mcd(3*atoms%ntype,29,input%neig,kpts%nkpt,input%jspins) ) IF (.NOT.banddos%dos) WRITE (*,*) 'For mcd-spectra set banddos%dos=T!' ELSE ALLOCATE (thisMCD%m_mcd(1,1,1,1)) @@ -425,7 +425,7 @@ SUBROUTINE moments_init(thisMoments,input,atoms) END SUBROUTINE moments_init -SUBROUTINE orbcomp_init(thisOrbcomp,input,banddos,dimension,atoms,kpts) +SUBROUTINE orbcomp_init(thisOrbcomp,input,banddos,atoms,kpts) USE m_types_setup USE m_types_kpts @@ -435,13 +435,13 @@ SUBROUTINE orbcomp_init(thisOrbcomp,input,banddos,dimension,atoms,kpts) CLASS(t_orbcomp), INTENT(INOUT) :: thisOrbcomp TYPE(t_input), INTENT(IN) :: input TYPE(t_banddos), INTENT(IN) :: banddos - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_kpts), INTENT(IN) :: kpts IF ((banddos%ndir.EQ.-3).AND.banddos%dos) THEN - ALLOCATE(thisOrbcomp%comp(dimension%neigd,23,atoms%nat,kpts%nkpt,input%jspins)) - ALLOCATE(thisOrbcomp%qmtp(dimension%neigd,atoms%nat,kpts%nkpt,input%jspins)) + ALLOCATE(thisOrbcomp%comp(input%neig,23,atoms%nat,kpts%nkpt,input%jspins)) + ALLOCATE(thisOrbcomp%qmtp(input%neig,atoms%nat,kpts%nkpt,input%jspins)) ELSE ALLOCATE(thisOrbcomp%comp(1,1,1,1,input%jspins)) ALLOCATE(thisOrbcomp%qmtp(1,1,1,input%jspins)) @@ -559,7 +559,7 @@ SUBROUTINE cdnvalJob_init(thisCdnvalJob,mpi,input,kpts,noco,results,jspin) END FUNCTION compact_ev_list -SUBROUTINE gVacMap_init(thisGVacMap,dimension,sym,atoms,vacuum,stars,lapw,input,cell,kpts,enpara,vTot,ikpt,jspin) +SUBROUTINE gVacMap_init(thisGVacMap,sym,atoms,vacuum,stars,lapw,input,cell,kpts,enpara,vTot,ikpt,jspin) USE m_types_setup USE m_types_lapw @@ -571,7 +571,7 @@ SUBROUTINE gVacMap_init(thisGVacMap,dimension,sym,atoms,vacuum,stars,lapw,input, IMPLICIT NONE CLASS(t_gVacMap), INTENT(INOUT) :: thisGVacMap - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_sym), INTENT(IN) :: sym TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_vacuum), INTENT(IN) :: vacuum @@ -589,8 +589,8 @@ SUBROUTINE gVacMap_init(thisGVacMap,dimension,sym,atoms,vacuum,stars,lapw,input, IF (ALLOCATED(thisGVacMap%gvac1d)) DEALLOCATE(thisGVacMap%gvac1d) IF (ALLOCATED(thisGVacMap%gvac2d)) DEALLOCATE(thisGVacMap%gvac2d) - ALLOCATE(thisGVacMap%gvac1d(dimension%nv2d)) - ALLOCATE(thisGVacMap%gvac2d(dimension%nv2d)) + ALLOCATE(thisGVacMap%gvac1d(lapw%dim_nv2d())) + ALLOCATE(thisGVacMap%gvac2d(lapw%dim_nv2d())) thisGVacMap%gvac1d = 0 thisGVacMap%gvac2d = 0 diff --git a/types/types_dimension.f90 b/types/types_dimension.f90 index 274ec25a..fb56a455 100644 --- a/types/types_dimension.f90 +++ b/types/types_dimension.f90 @@ -6,10 +6,7 @@ MODULE m_types_dimension TYPE t_dimension - INTEGER :: nvd - INTEGER :: nv2d - INTEGER :: neigd !to be removed!!! - INTEGER :: lmd - INTEGER :: nbasfcn + !INTEGER :: neigd !to be removed!!! + !INTEGER :: lmd END TYPE t_dimension END MODULE m_types_dimension diff --git a/types/types_force.f90 b/types/types_force.f90 index 3d943ff6..8f2f3098 100644 --- a/types/types_force.f90 +++ b/types/types_force.f90 @@ -111,7 +111,7 @@ SUBROUTINE force_init2(thisForce,noccbd,input,atoms) END SUBROUTINE force_init2 -SUBROUTINE addContribsA21A12(thisForce,input,atoms,dimension,sym,cell,oneD,enpara,& +SUBROUTINE addContribsA21A12(thisForce,input,atoms,sym,cell,oneD,enpara,& usdus,eigVecCoeffs,noccbd,ispin,eig,we,results) USE m_types_setup @@ -127,7 +127,7 @@ SUBROUTINE addContribsA21A12(thisForce,input,atoms,dimension,sym,cell,oneD,enpar CLASS(t_force), INTENT(INOUT) :: thisForce TYPE(t_input), INTENT(IN) :: input TYPE(t_atoms), INTENT(IN) :: atoms - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_sym), INTENT(IN) :: sym TYPE(t_cell), INTENT(IN) :: cell TYPE(t_oneD), INTENT(IN) :: oneD @@ -143,11 +143,11 @@ SUBROUTINE addContribsA21A12(thisForce,input,atoms,dimension,sym,cell,oneD,enpar REAL, INTENT(IN) :: we(noccbd) IF (.NOT.input%l_useapw) THEN - CALL force_a12(atoms,noccbd,sym,dimension,cell,oneD,& + CALL force_a12(atoms,noccbd,sym,cell,oneD,& we,ispin,noccbd,usdus,eigVecCoeffs,thisForce%acoflo,thisForce%bcoflo,& thisForce%e1cof,thisForce%e2cof,thisForce%f_a12,results) END IF - CALL force_a21(input,atoms,dimension,sym,oneD,cell,we,ispin,& + CALL force_a21(input,atoms,sym,oneD,cell,we,ispin,& enpara%el0(0:,:,ispin),noccbd,eig,usdus,eigVecCoeffs,& thisForce%aveccof,thisForce%bveccof,thisForce%cveccof,& thisForce%f_a21,thisForce%f_b4,results) diff --git a/types/types_forcetheo.F90 b/types/types_forcetheo.F90 index 3ad8b6e5..ad4f70c4 100644 --- a/types/types_forcetheo.F90 +++ b/types/types_forcetheo.F90 @@ -59,7 +59,7 @@ CONTAINS this%firstloop=.FALSE. END FUNCTION forcetheo_next_job - FUNCTION forcetheo_eval(this,eig_id,DIMENSION,atoms,kpts,sym,& + FUNCTION forcetheo_eval(this,eig_id,atoms,kpts,sym,& cell,noco, input,mpi, oneD,enpara,v,results)RESULT(skip) USE m_types_atoms USE m_types_oneD @@ -79,7 +79,7 @@ CONTAINS LOGICAL :: skip !Stuff that might be used... TYPE(t_mpi),INTENT(IN) :: mpi - TYPE(t_dimension),INTENT(IN) :: dimension + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco diff --git a/types/types_lapw.F90 b/types/types_lapw.F90 index eed9706e..3e21d188 100644 --- a/types/types_lapw.F90 +++ b/types/types_lapw.F90 @@ -7,6 +7,13 @@ MODULE m_types_lapw USE m_judft PRIVATE + !These dimensions should be set once per call of FLEUR + !They can be queried by the functions lapw%dim_nvd,... + !You probably should avoid using the variables directly + integer :: lapw_dim_nvd + integer :: lapw_dim_nv2d + integer :: lapw_dim_nbasfcn + TYPE t_lapw INTEGER :: nv(2) INTEGER :: num_local_cols(2) @@ -30,11 +37,34 @@ MODULE m_types_lapw PROCEDURE,PASS :: init =>lapw_init PROCEDURE,PASS :: alloc =>lapw_alloc PROCEDURE,PASS :: phase_factors =>lapw_phase_factors + PROCEDURE,NOPASS:: dim_nvd + PROCEDURE,NOPASS:: dim_nv2d + PROCEDURE,NOPASS:: dim_nbasfcn + PROCEDURE,NOPASS:: init_dim=>lapw_init_dim END TYPE t_lapw - PUBLIC :: t_lapw + PUBLIC :: t_lapw,lapw_dim_nbasfcn,lapw_dim_nvd,lapw_dim_nv2d CONTAINS + + subroutine lapw_init_dim(nvd_in,nv2d_in,nbasfcn_in) + IMPLICIT NONE + INTEGER,INTENT(IN) :: nvd_in,nv2d_in,nbasfcn_in + lapw_dim_nvd=nvd_in + lapw_dim_nv2d=nv2d_in + lapw_dim_nbasfcn=nbasfcn_in + end subroutine + + INTEGER function dim_nvd() + dim_nvd=nvd + end function + INTEGER function dim_nv2d() + dim_nv2d=nv2d + end function + INTEGER function dim_nbasfcn() + dim_basfcn=nbasfcn + end function + SUBROUTINE lapw_alloc(lapw,cell,input,noco) ! !********************************************************************* @@ -137,7 +167,7 @@ CONTAINS TYPE(t_kpts),INTENT(IN) :: kpts TYPE(t_mpi),INTENT(IN),OPTIONAL:: mpi CLASS(t_lapw),INTENT(INOUT) :: lapw - ! .. + ! .. ! .. Scalar Arguments .. INTEGER, INTENT (IN) :: nk LOGICAL, INTENT (IN) :: l_zref @@ -220,7 +250,7 @@ CONTAINS lapw%gvec(:,n,ispin) = gvec(:,index3(n)) lapw%rk(n,ispin) = rk(index3(n)) ENDDO - !---> determine pairs of K-vectors, where K_z = K'_-z to use + !---> determine pairs of K-vectors, where K_z = K'_-z to use !---> z-reflection IF (l_zref) THEN n=0 @@ -228,7 +258,7 @@ CONTAINS DO j=1,i IF (ALL(lapw%gvec(1:2,i,ispin).EQ.lapw%gvec(1:2,j,ispin)).AND.& (lapw%gvec(3,i,ispin).EQ.-lapw%gvec(3,j,ispin))) THEN - n=n+1 + n=n+1 lapw%matind(n,1)=i lapw%matind(n,2)=j ENDIF @@ -252,7 +282,7 @@ CONTAINS i = 1 j = 1 - DO n = 1, nred + DO n = 1, nred IF (lapw%matind(n,1).EQ.lapw%matind(n,2)) THEN index3(lapw%matind(n,1)) = n_inner + i i = i + 1 @@ -377,7 +407,7 @@ CONTAINS END DO END SUBROUTINE lapw_phase_factors - + SUBROUTINE priv_vec_for_lo(atoms,sym,na,& n,np,noco, lapw,cell) USE m_constants,ONLY: tpi_const,fpi_const @@ -392,12 +422,12 @@ CONTAINS TYPE(t_lapw),INTENT(INOUT):: lapw ! .. ! .. Scalar Arguments .. - INTEGER, INTENT (IN) :: na,n,np + INTEGER, INTENT (IN) :: na,n,np ! .. ! .. Array Arguments .. ! .. ! .. Local Scalars .. - COMPLEX term1 + COMPLEX term1 REAL th,con1 INTEGER l,lo ,mind,ll1,lm,iintsp,k,nkmin,ntyp,lmp,m,nintsp LOGICAL linind,enough,l_lo1 @@ -511,10 +541,10 @@ CONTAINS WRITE (6,FMT=*) 'clo coefficient-vectors. the linear independence' WRITE (6,FMT=*) 'quality, linindq, is set: ',linindq WRITE (6,FMT=*) 'this value might be to large.' - WRITE(*,*) na,k,lapw%nv + WRITE(*,*) na,k,lapw%nv CALL juDFT_error("not enough lin. indep. clo-vectors" ,calledby ="vec_for_lo") END IF - ! -- > end of abccoflo-part + ! -- > end of abccoflo-part ENDDO ENDIF @@ -523,7 +553,7 @@ CONTAINS DO lo = 1,atoms%nlo(ntyp) IF (nkvec(lo,1).EQ.nkvec(lo,nintsp)) THEN ! k-vec accepted by both spin channels IF (sym%invsat(na).EQ.0) THEN - IF ( nkvec(lo,1).LT.(2*atoms%llo(lo,ntyp)+1) ) THEN + IF ( nkvec(lo,1).LT.(2*atoms%llo(lo,ntyp)+1) ) THEN enough=.FALSE. ENDIF ELSE diff --git a/types/types_misc.F90 b/types/types_misc.F90 index 32505a48..cc4871b4 100644 --- a/types/types_misc.F90 +++ b/types/types_misc.F90 @@ -115,18 +115,18 @@ CONTAINS END SUBROUTINE zMat_init - SUBROUTINE results_init(thisResults,dimension,input,atoms,kpts,noco) + SUBROUTINE results_init(thisResults,input,atoms,kpts,noco) USE m_types_atoms USE m_types_input USE m_types_noco USE m_types_dimension - USE m_types_kpts - + USE m_types_kpts + USE m_types_lapw IMPLICIT NONE CLASS(t_results), INTENT(INOUT) :: thisResults - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_input), INTENT(IN) :: input TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_kpts), INTENT(IN) :: kpts @@ -153,8 +153,8 @@ CONTAINS thisResults%bandgap = 0.0 thisResults%ef = 0.0 - neigd2 = MIN(dimension%neigd,dimension%nbasfcn) -! neigd2 = dimension%neigd + neigd2 = MIN(input%neig,lapw_dim_nbasfcn) +! neigd2 = input%neig IF (noco%l_soc.AND.(.NOT.noco%l_noco)) neigd2 = 2*neigd2 ALLOCATE (thisResults%force(3,atoms%ntype,input%jspins));thisResults%force=0.0 diff --git a/vgen/fleur_vdW.F90 b/vgen/fleur_vdW.F90 index beb7ff2d..e6ff0370 100644 --- a/vgen/fleur_vdW.F90 +++ b/vgen/fleur_vdW.F90 @@ -8,7 +8,7 @@ MODULE m_fleur_vdW IMPLICIT NONE PUBLIC fleur_vdW,priv_fleur_vdW CONTAINS - SUBROUTINE fleur_vdW(mpi,atoms,sphhar,stars,input,DIMENSION, & + SUBROUTINE fleur_vdW(mpi,atoms,sphhar,stars,input, & cell,sym,oneD,vacuum, & qpw,rho,vpw_total,vr_total) !Interface to Juelich vdW-code @@ -24,7 +24,7 @@ CONTAINS TYPE(t_sphhar),INTENT(IN) :: sphhar TYPE(t_stars),INTENT(IN) :: stars TYPE(t_vacuum),INTENT(IN) :: vacuum - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_cell),INTENT(IN) :: cell TYPE(t_input),INTENT(IN) :: input TYPE(t_sym),INTENT(IN) :: sym @@ -55,7 +55,7 @@ CONTAINS IF (l_core) THEN WRITE(6,*) "VdW contribution without core charge" ! read the core charge - CALL readCoreDensity(input,atoms,dimension,rhc,tec,qintc) + CALL readCoreDensity(input,atoms,rhc,tec,qintc) DO j=1,input%jspins DO n=1,atoms%ntype ncmsh = NINT( LOG( (atoms%rmt(n)+10.0)/atoms%rmsh(1,n) ) / atoms%dx(n) + 1 ) diff --git a/vgen/rotate_int_den_to_local.F90 b/vgen/rotate_int_den_to_local.F90 index ca391840..39dd4aaf 100644 --- a/vgen/rotate_int_den_to_local.F90 +++ b/vgen/rotate_int_den_to_local.F90 @@ -20,7 +20,7 @@ MODULE m_rotate_int_den_to_local ! Philipp Kurz 99/11/01 !********************************************************************** CONTAINS - SUBROUTINE rotate_int_den_to_local(DIMENSION,sym,stars,atoms,sphhar,vacuum,& + SUBROUTINE rotate_int_den_to_local(sym,stars,atoms,sphhar,vacuum,& cell,input,noco,oneD,den) !******** ABBREVIATIONS *********************************************** ! ifft3 : size of the 3d real space mesh @@ -41,7 +41,7 @@ CONTAINS USE m_types IMPLICIT NONE - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_noco),INTENT(IN) :: noco TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_input),INTENT(IN) :: input diff --git a/vgen/vgen_coulomb.F90 b/vgen/vgen_coulomb.F90 index 85d385a6..088800f3 100644 --- a/vgen/vgen_coulomb.F90 +++ b/vgen/vgen_coulomb.F90 @@ -10,7 +10,7 @@ module m_vgen_coulomb contains - subroutine vgen_coulomb( ispin, mpi, dimension, oneD, input, field, vacuum, sym, stars, & + subroutine vgen_coulomb( ispin, mpi, oneD, input, field, vacuum, sym, stars, & cell, sphhar, atoms, den, vCoul, results ) !---------------------------------------------------------------------------- ! FLAPW potential generator @@ -40,7 +40,7 @@ contains integer, intent(in) :: ispin type(t_mpi), intent(in) :: mpi - type(t_dimension), intent(in) :: dimension + type(t_oneD), intent(in) :: oneD type(t_input), intent(in) :: input type(t_field), intent(inout) :: field @@ -196,7 +196,7 @@ contains if ( mpi%irank == 0 ) then CHECK_CONTINUITY: if ( input%vchk ) then call timestart( "checking" ) - call checkDOPAll( input, dimension, sphhar, stars, atoms, sym, vacuum, oneD, & + call checkDOPAll( input, sphhar, stars, atoms, sym, vacuum, oneD, & cell, vCoul, ispin ) call timestop( "checking" ) end if CHECK_CONTINUITY diff --git a/vgen/vgen_xcpot.F90 b/vgen/vgen_xcpot.F90 index 12c5e488..d5aaabf3 100644 --- a/vgen/vgen_xcpot.F90 +++ b/vgen/vgen_xcpot.F90 @@ -9,7 +9,7 @@ MODULE m_vgen_xcpot CONTAINS - SUBROUTINE vgen_xcpot(hybrid, input, xcpot, dimension, atoms, sphhar, stars, vacuum, sym, & + SUBROUTINE vgen_xcpot(hybrid, input, xcpot, atoms, sphhar, stars, vacuum, sym, & cell, oneD, sliceplot, mpi, noco, den, denRot, EnergyDen, vTot, vx, results) ! *********************************************************** @@ -39,7 +39,7 @@ CONTAINS CLASS(t_xcpot), INTENT(INOUT) :: xcpot TYPE(t_hybrid), INTENT(IN) :: hybrid TYPE(t_mpi), INTENT(IN) :: mpi - TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_oneD), INTENT(IN) :: oneD TYPE(t_sliceplot), INTENT(IN) :: sliceplot TYPE(t_input), INTENT(IN) :: input @@ -91,7 +91,7 @@ CONTAINS CALL vvacxc(ifftd2, stars, vacuum, xcpot, input, noco, Den, vTot, exc) ELSE CALL judft_error("OneD broken") - ! CALL vvacxc(stars,oneD%M,vacuum,odi%n2d,dimension,ifftd2,& + ! CALL vvacxc(stars,oneD%M,vacuum,odi%n2d,ifftd2,& ! xcpot,input,odi%nq2,odi%nst2,den,noco,odi%kimax2%igf,& ! odl%pgf,vTot%vacxy,vTot%vacz,excxy,excz) END IF @@ -131,7 +131,7 @@ CONTAINS CALL timestop("Vxc in MT") ! check continuity of total potential - IF (input%vchk) CALL checkDOPAll(input, dimension, sphhar, stars, atoms, sym, vacuum, oneD, cell, vTot, 1) + IF (input%vchk) CALL checkDOPAll(input, sphhar, stars, atoms, sym, vacuum, oneD, cell, vTot, 1) ! TOTAL IF (PRESENT(results)) THEN diff --git a/vgen/write_xcstuff.f90 b/vgen/write_xcstuff.f90 index acf3aca8..8fe4bfef 100644 --- a/vgen/write_xcstuff.f90 +++ b/vgen/write_xcstuff.f90 @@ -10,12 +10,12 @@ MODULE m_writexcstuff ! CONTAINS SUBROUTINE write_xcstuff(& - & sphhar,atoms,dimension,sym,& + & sphhar,atoms,sym,& & stars,vacuum,input) USE m_types IMPLICIT NONE - TYPE(t_dimension),INTENT(IN) :: dimension + TYPE(t_input),INTENT(IN) :: input TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_sym),INTENT(IN) :: sym diff --git a/wannier/bs_comfort.F b/wannier/bs_comfort.F index 32c074f8..35fe7b73 100644 --- a/wannier/bs_comfort.F +++ b/wannier/bs_comfort.F @@ -8,14 +8,14 @@ CONTAINS - SUBROUTINE bs_comfort(eig_id,DIMENSION,input,noco,nkpt,param) + SUBROUTINE bs_comfort(eig_id,input,noco,nkpt,param) USE m_types USE m_eig66_io, ONLY : read_eig IMPLICIT NONE - TYPE(t_dimension), INTENT(IN) :: DIMENSION + TYPE(t_input), INTENT(IN) :: input TYPE(t_noco), INTENT(IN) :: noco @@ -39,7 +39,7 @@ c---> pk non-collinear ENDIF c---> pk non-collinear - ALLOCATE (eig(DIMENSION%neigd,nkpt,nspins)) + ALLOCATE (eig(input%neig,nkpt,nspins)) ALLOCATE (ne(nkpt,nspins)) DO jsp = 1, nspins @@ -47,14 +47,14 @@ c---> pk non-collinear CALL read_eig(eig_id,k,jsp,neig=ne(k,jsp),eig=eig(:,k,jsp)) END DO ! k = 1,nkpt - DO i = 1, DIMENSION%neigd + DO i = 1, input%neig DO k = 1, nkpt WRITE(776+jsp,*) param,k,eig(i,k,jsp) END DO WRITE(776+jsp,*) END DO - DO i = 1, DIMENSION%neigd + DO i = 1, input%neig DO k = 1, nkpt IF (k.eq.param) WRITE(778+jsp,*) param,k,eig(i,k,jsp) END DO diff --git a/wannier/uhu/wann_uHu.F b/wannier/uhu/wann_uHu.F index db109a9a..12ebbdd8 100644 --- a/wannier/uhu/wann_uHu.F +++ b/wannier/uhu/wann_uHu.F @@ -19,7 +19,7 @@ c*******************************************c USE m_juDFT CONTAINS SUBROUTINE wann_uHu( - > DIMENSION,stars,vacuum,atoms,sphhar,input,kpts,sym,mpi, + > stars,vacuum,atoms,sphhar,input,kpts,sym,mpi, > banddos,oneD,noco,cell,vTot,wann,enpara, > eig_idList,l_real,l_dulo,l_noco,l_ss,lmaxd,ntypd, > neigd,natd,nop,nvd,jspd,nbasfcn,llod,nlod,ntype, @@ -70,7 +70,7 @@ c*******************************************c integer stt(MPI_STATUS_SIZE) #endif - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_stars),INTENT(IN) :: stars TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_atoms),INTENT(IN) :: atoms @@ -670,7 +670,7 @@ c*****************************************************************c ! WRITE(fending,'("_",i4.4)')bpt_q(iqpt_b,iqpt) ! innerEig_idList(iqpt_b)=open_eig(mpi%mpi_comm, -! + DIMENSION%nbasfcn,DIMENSION%neigd, +! + lapw%dim_nbasfcn(),input%neig, ! + nkpts,wannierspin,atoms%lmaxd, ! + atoms%nlod,atoms%ntype,atoms%nlotot, ! + l_noco,.FALSE.,l_real,l_soc,.FALSE., @@ -685,7 +685,7 @@ c*****************************************************************c eig_id = eig_idList(qptibz) ! WRITE(fending,'("_",i4.4)')qptibz -! eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,DIMENSION%neigd, +! eig_id=open_eig(mpi%mpi_comm,lapw%dim_nbasfcn(),input%neig, ! + nkpts,wannierspin,atoms%lmaxd, ! + atoms%nlod,atoms%ntype,atoms%nlotot, ! + l_noco,.FALSE.,l_real,l_soc,.FALSE., @@ -702,7 +702,7 @@ c*****************************************************************c eig_id = eig_idList(qptibz) ! WRITE(fending,'("_",i4.4)')qptibz -! eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,DIMENSION%neigd, +! eig_id=open_eig(mpi%mpi_comm,lapw%dim_nbasfcn(),input%neig, ! + nkpts,wannierspin,atoms%lmaxd, ! + atoms%nlod,atoms%ntype,atoms%nlotot, ! + l_noco,.FALSE.,l_real,l_soc,.FALSE., @@ -948,14 +948,14 @@ c if (mod(i_rec-1,isize).eq.irank) then allocate ( eigg(neigd) ) n_start=1 - n_end=DIMENSION%neigd + n_end=input%neig call cpu_time(t0) ! get current bkpt vector zzMat%l_real = l_real - zzMat%matsize1 = DIMENSION%nbasfcn - zzMat%matsize2 = DIMENSION%neigd + zzMat%matsize1 = lapw%dim_nbasfcn() + zzMat%matsize2 = input%neig IF(l_real) THEN IF(.NOT.ALLOCATED(zzMat%data_r)) & ALLOCATE (zzMat%data_r(zzMat%matsize1,zzMat%matsize2)) @@ -1025,9 +1025,9 @@ c if (mod(i_rec-1,isize).eq.irank) then CALL cdn_read( & eig_id, - & DIMENSION%nvd,input%jspins,mpi%irank,mpi%isize, !wannierspin instead of DIMENSION%jspd?& - & kptibz,jspin,DIMENSION%nbasfcn, - & noco%l_ss,noco%l_noco,DIMENSION%neigd, + & lapw%dim_nvd(),input%jspins,mpi%irank,mpi%isize, !wannierspin instead of DIMENSION%jspd?& + & kptibz,jspin,lapw%dim_nbasfcn(), + & noco%l_ss,noco%l_noco,input%neig, & n_start,n_end, & nbands,eigg,zzMat) @@ -1081,7 +1081,7 @@ c$$$ nslibd=0 if (wann%l_bzsym) kptibz_b=irreduc(kptibz_b) n_start=1 - n_end=DIMENSION%neigd + n_end=input%neig eigg = 0. call cpu_time(t0) @@ -1100,9 +1100,9 @@ c$$$ nslibd=0 & .AND..NOT.noco%l_noco.and.mpi%n_size==1),mpi) CALL cdn_read( & eig_id, - & DIMENSION%nvd,input%jspins,mpi%irank,mpi%isize, !wannierspin instead of DIMENSION%jspd? - & kptibz_b,jspin,DIMENSION%nbasfcn, - & noco%l_ss,noco%l_noco,DIMENSION%neigd,n_start,n_end, + & lapw%dim_nvd(),input%jspins,mpi%irank,mpi%isize, !wannierspin instead of DIMENSION%jspd? + & kptibz_b,jspin,lapw%dim_nbasfcn(), + & noco%l_ss,noco%l_noco,input%neig,n_start,n_end, & nbands_b,eigg,zzMat) @@ -1217,7 +1217,7 @@ c*********************************************************** if (wann%l_bzsym) kptibz_b2=irreduc(kptibz_b2) n_start=1 - n_end=DIMENSION%neigd + n_end=input%neig eigg = 0. call cpu_time(t0) @@ -1239,9 +1239,9 @@ c*********************************************************** CALL cdn_read( & eig_id, - & DIMENSION%nvd,input%jspins,mpi%irank,mpi%isize, !wannierspin instead of DIMENSION%jspd?& - & kptibz_b2,jspin,DIMENSION%nbasfcn, - & noco%l_ss,noco%l_noco,DIMENSION%neigd,n_start,n_end, + & lapw%dim_nvd(),input%jspins,mpi%irank,mpi%isize, !wannierspin instead of DIMENSION%jspd?& + & kptibz_b2,jspin,lapw%dim_nbasfcn(), + & noco%l_ss,noco%l_noco,input%neig,n_start,n_end, & nbands_b2,eigg,zzMat) @@ -1490,7 +1490,7 @@ c endif call cpu_time(t0) call wann_uHu_od_vac( - > DIMENSION,oneD,vacuum,stars,cell, + > oneD,vacuum,stars,cell, > cmplx(1.,0.),l_noco,l_soc,jspins,nlotot,nbnd,z1, > nmzxyd,nmzd,nv2d,k1d,k2d,k3d,n2d,n3d,ig,nmzxy,nmz, > delz,ig2,bbmat,evac(1,jspin4),evac(1,jspin4_b),lapw_b%bkpt, diff --git a/wannier/uhu/wann_uHu_dmi.F b/wannier/uhu/wann_uHu_dmi.F index 80893970..e6c31c66 100644 --- a/wannier/uhu/wann_uHu_dmi.F +++ b/wannier/uhu/wann_uHu_dmi.F @@ -19,7 +19,7 @@ c*******************************************c USE m_juDFT CONTAINS SUBROUTINE wann_uHu_dmi( - > DIMENSION,stars,vacuum,atoms,sphhar,input,kpts,sym,mpi, + > stars,vacuum,atoms,sphhar,input,kpts,sym,mpi, > banddos,oneD,noco,cell,vTot,wann,enpara, > eig_idList,l_real,l_dulo,l_noco,l_ss,lmaxd,ntypd, > neigd,natd,nop,nvd,jspd,nbasfcn,llod,nlod,ntype, @@ -71,7 +71,7 @@ c*******************************************c integer stt(MPI_STATUS_SIZE) #endif - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_stars),INTENT(IN) :: stars TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_atoms),INTENT(IN) :: atoms @@ -675,7 +675,7 @@ c*****************************************************************c ! WRITE(fending,'("_",i4.4)')bpt_q(iqpt_b,iqpt) ! innerEig_idList(iqpt_b)=open_eig(mpi%mpi_comm, -! + DIMENSION%nbasfcn,DIMENSION%neigd, +! + lapw%dim_nbasfcn(),input%neig, ! + nkpts,wannierspin,atoms%lmaxd, ! + atoms%nlod,atoms%ntype,atoms%nlotot, ! + l_noco,.FALSE.,l_real,l_soc,.FALSE., @@ -689,7 +689,7 @@ c*****************************************************************c eig_id = eig_idList(qptibz) ! WRITE(fending,'("_",i4.4)')qptibz -! eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,DIMENSION%neigd, +! eig_id=open_eig(mpi%mpi_comm,lapw%dim_nbasfcn(),input%neig, ! + nkpts,wannierspin,atoms%lmaxd, ! + atoms%nlod,atoms%ntype,atoms%nlotot, ! + l_noco,.FALSE.,l_real,l_soc,.FALSE., @@ -703,7 +703,7 @@ c*****************************************************************c eig_id = eig_idList(qptibz) ! WRITE(fending,'("_",i4.4)')qptibz -! eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,DIMENSION%neigd, +! eig_id=open_eig(mpi%mpi_comm,lapw%dim_nbasfcn(),input%neig, ! + nkpts,wannierspin,atoms%lmaxd, ! + atoms%nlod,atoms%ntype,atoms%nlotot, ! + l_noco,.FALSE.,l_real,l_soc,.FALSE., @@ -950,9 +950,9 @@ c if (mod(i_rec-1,isize).eq.irank) then zzMat%l_real = l_real ! zzMat%nbasfcn = nbasfcn - zzMat%matsize1 = DIMENSION%nbasfcn + zzMat%matsize1 = lapw%dim_nbasfcn() ! zzMat%nbands = neigd - zzMat%matsize2 = DIMENSION%neigd + zzMat%matsize2 = input%neig IF(l_real) THEN ! ALLOCATE (zzMat%z_r(zzMat%nbasfcn,zzMat%nbands)) @@ -1015,7 +1015,7 @@ c if (mod(i_rec-1,isize).eq.irank) then if (wann%l_bzsym) kptibz_b=irreduc(kptibz_b) n_start=1 - n_end=DIMENSION%neigd + n_end=input%neig eigg = 0. call cpu_time(t0) @@ -1033,9 +1033,9 @@ c if (mod(i_rec-1,isize).eq.irank) then & .AND..NOT.noco%l_noco.and.mpi%n_size==1),mpi) CALL cdn_read( & eig_id, - & DIMENSION%nvd,input%jspins,mpi%irank,mpi%isize, !wannierspin instead of DIMENSION%jspd? - & kptibz_b,jspin,DIMENSION%nbasfcn, - & noco%l_ss,noco%l_noco,DIMENSION%neigd,n_start,n_end, + & lapw%dim_nvd(),input%jspins,mpi%irank,mpi%isize, !wannierspin instead of DIMENSION%jspd? + & kptibz_b,jspin,lapw%dim_nbasfcn(), + & noco%l_ss,noco%l_noco,input%neig,n_start,n_end, & nbands_b,eigg,zzMat) @@ -1199,9 +1199,9 @@ c*********************************************************** CALL cdn_read( & eig_id, - & DIMENSION%nvd,input%jspins,mpi%irank,mpi%isize, !wannierspin instead of DIMENSION%jspd?& - & qptibz_b,jspin,DIMENSION%nbasfcn, - & noco%l_ss,noco%l_noco,DIMENSION%neigd,n_start,n_end, + & lapw%dim_nvd(),input%jspins,mpi%irank,mpi%isize, !wannierspin instead of DIMENSION%jspd?& + & qptibz_b,jspin,lapw%dim_nbasfcn(), + & noco%l_ss,noco%l_noco,input%neig,n_start,n_end, & nbands_b2,eigg,zzMat) @@ -1446,7 +1446,7 @@ c**************************************c call cpu_time(t0) call wann_uHu_od_vac( - > DIMENSION,oneD,vacuum,stars,cell, + > oneD,vacuum,stars,cell, > chi,l_noco,l_soc,jspins,nlotot,nbnd,z1,nmzxyd,nmzd, > nv2d,k1d,k2d,k3d,n2d,n3d,ig,nmzxy,nmz,delz,ig2, > bbmat,evac(1,jspin),evac(1,jspin_b), diff --git a/wannier/uhu/wann_uHu_od_vac.F b/wannier/uhu/wann_uHu_od_vac.F index 50574e95..d062dd50 100644 --- a/wannier/uhu/wann_uHu_od_vac.F +++ b/wannier/uhu/wann_uHu_od_vac.F @@ -9,7 +9,7 @@ c***************************************c MODULE m_wann_uHu_od_vac CONTAINS SUBROUTINE wann_uHu_od_vac( - > DIMENSION,oneD,vacuum,stars,cell, + > oneD,vacuum,stars,cell, > chi,l_noco,l_soc,jspins,nlotot, > nbnd,z1,nmzxyd,nmzd,nv2d,k1d,k2d,k3d,n2d,n3d, > ig,nmzxy,nmz,delz,ig2, @@ -30,7 +30,7 @@ c***************************************c implicit none - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_stars),INTENT(IN) :: stars @@ -127,7 +127,7 @@ c ..local scalars.. + bcof(nv2d,-odi%mb:odi%mb,nslibd), + acof_b(nv2d,-odi%mb:odi%mb,nslibd_b), + bcof_b(nv2d,-odi%mb:odi%mb,nslibd_b), - + kvac3(nv2d),map1(nvd), + + kvac3(nv2d),map1(nvd), + kvac3_b(nv2d),map1_b(nvd), + zmsh(nmz),xx(nmz),xximag(nmz),v1(nmzd), + gdu(nmzd),gdud(nmzd),gdu_b(nmzd),gdud_b(nmzd) ) @@ -187,20 +187,22 @@ c ..local scalars.. c...for the k-point - qssbti(1,1) = - qss(1)/2. - qssbti(2,1) = - qss(2)/2. - qssbti(1,2) = + qss(1)/2. + qssbti(1,1) = - qss(1)/2. + qssbti(2,1) = - qss(2)/2. + qssbti(1,2) = + qss(1)/2. qssbti(2,2) = + qss(2)/2. qssbti(3,1) = - qss(3)/2. qssbti(3,2) = + qss(3)/2. DO ispin = 1,1 ! jspins CALL od_abvac( - > cell,vacuum,DIMENSION,stars,oneD, + > cell,vacuum,stars,oneD, > qssbti(3,jspin),odi%n2d, > wronk,evac,bkpt,odi%M,odi%mb, > vz(1,ivac,jspin2),kvac3,nv2, - < uz(1,-odi%mb),duz(1,-odi%mb),u(1,1,-odi%mb),udz(1,-odi%mb), - < dudz(1,-odi%mb),ddnv(1,-odi%mb),ud(1,1,-odi%mb)) + < uz(:,-odi%mb:),duz(:,-odi%mb:), + < u(:,:,-odi%mb:),udz(1:,-odi%mb:), + < dudz(:,-odi%mb:),ddnv(:,-odi%mb:), + < ud(:,:,-odi%mb:)) ENDDO do k = 1,nv(jspin) @@ -250,13 +252,14 @@ c...for the b-point DO ispin = 1,1 ! jspins call od_abvac( - > cell,vacuum,DIMENSION,stars,oneD, + > cell,vacuum,stars,oneD, > qssbti(3,jspin_b),odi%n2d, > wronk,evac_b,bkpt_b,odi%M,odi%mb, > vz(1,ivac,jspin2_b),kvac3_b,nv2_b, - < uz_b(1,-odi%mb),duz_b(1,-odi%mb),u_b(1,1,-odi%mb), - < udz_b(1,-odi%mb), - < dudz_b(1,-odi%mb),ddnv_b(1,-odi%mb),ud_b(1,1,-odi%mb)) + < uz_b(:,-odi%mb:),duz_b(:,-odi%mb:),u_b(:,:,-odi%mb:), + < udz_b(:,-odi%mb:), + < dudz_b(:,-odi%mb:),ddnv_b(:,-odi%mb:), + < ud_b(:,:,-odi%mb:)) ENDDO do k = 1,nv_b(jspin_b) @@ -300,7 +303,7 @@ c + conjg(zMat_b%z_c(k,n))*bvac enddo END IF enddo ! -mb:mb - endif + endif enddo ! k = 1,nv c now actually computing the uHu matrix @@ -327,7 +330,7 @@ c now actually computing the uHu matrix ! transformation u --> v = sqrt(z)*u ! thus we can use simplified 'pseudopotential' ! and skip r in integration dx dy = r dr dphi - u(i,:,:) = zz*u(i,:,:) + u(i,:,:) = zz*u(i,:,:) ud(i,:,:) = zz*ud(i,:,:) u_b(i,:,:) = zz*u_b(i,:,:) ud_b(i,:,:) = zz*ud_b(i,:,:) @@ -349,7 +352,7 @@ c now actually computing the uHu matrix enddo enddo - + ! calculate uHu matrix elements do l = 1,nv2 @@ -387,7 +390,7 @@ c now actually computing the uHu matrix ENDDO call intgz0(xx,delz,nmzxy,xv,tail) call intgz0(xximag,delz,nmzxy,yv,tail) - tuu = cmplx(xv,-yv) + tuu = cmplx(xv,-yv) ! tud DO i=1,nmzxy @@ -398,7 +401,7 @@ c now actually computing the uHu matrix ENDDO call intgz0(xx,delz,nmzxy,xv,tail) call intgz0(xximag,delz,nmzxy,yv,tail) - tud = cmplx(xv,-yv) + tud = cmplx(xv,-yv) ! tdu DO i=1,nmzxy @@ -409,7 +412,7 @@ c now actually computing the uHu matrix ENDDO call intgz0(xx,delz,nmzxy,xv,tail) call intgz0(xximag,delz,nmzxy,yv,tail) - tdu = cmplx(xv,-yv) + tdu = cmplx(xv,-yv) ! tdd DO i=1,nmzxy @@ -420,8 +423,8 @@ c now actually computing the uHu matrix ENDDO call intgz0(xx,delz,nmzxy,xv,tail) call intgz0(xximag,delz,nmzxy,yv,tail) - tdd = cmplx(xv,-yv) - + tdd = cmplx(xv,-yv) + ELSE ! non-warping components Gz==0, m==0 ! need integral with XXXXXX @@ -453,7 +456,7 @@ c now actually computing the uHu matrix ! construct symmetrized 'pseudopotential' ! TODO: valid to simply symmetrize? DO i=1,nmzd - v1(i) = vz(i,ivac,jspin2H) + v1(i) = vz(i,ivac,jspin2H) > + (m*m+mp*mp)/(4.*zmsh(i)*zmsh(i)) > - 1./(8.*zmsh(i)*zmsh(i)) ENDDO @@ -549,11 +552,11 @@ c now actually computing the uHu matrix tdd = cmplx(xv,-yv) ENDIF ! ((ico.EQ.1) .OR. (ico.EQ.2)) - + ENDIF ! (ind1.NE.0) - + ! determine phase factor - phasfc = chi*exp(-cmplx(0.0,m2*arg_b-m1*arg)) + phasfc = chi*exp(-cmplx(0.0,m2*arg_b-m1*arg)) ! contraction of integrals with a,b coefficients ! yields contribution to uHu matrix @@ -563,8 +566,8 @@ c now actually computing the uHu matrix * acof(l,m,i)*conjg(acof_b(lp,mp,j))*tuu + + acof(l,m,i)*conjg(bcof_b(lp,mp,j))*tud + + bcof(l,m,i)*conjg(acof_b(lp,mp,j))*tdu + - + bcof(l,m,i)*conjg(bcof_b(lp,mp,j))*tdd ) - enddo + + bcof(l,m,i)*conjg(bcof_b(lp,mp,j))*tdd ) + enddo enddo ENDDO ! m2 diff --git a/wannier/wann_1dvacabcof.F b/wannier/wann_1dvacabcof.F index 03a7fc01..3d74a2d0 100644 --- a/wannier/wann_1dvacabcof.F +++ b/wannier/wann_1dvacabcof.F @@ -5,7 +5,7 @@ c******************************************************** module m_wann_1dvacabcof contains subroutine wann_1dvacabcof( - > DIMENSION,oneD,vacuum,stars,cell, + > oneD,vacuum,stars,cell, > nv2d,nslibd,nmzd,nmz,omtil,vz, > nv,bkpt,z1,odi,ods, > nvd,k1,k2,k3,evac, @@ -21,7 +21,7 @@ c******************************************************** use m_dcylbs implicit none - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_stars),INTENT(IN) :: stars @@ -110,12 +110,12 @@ c******************************************************** endif ispin=1 call od_abvac( - > cell,vacuum,DIMENSION,stars,oneD, + > cell,vacuum,stars,oneD, > qssbti(3,jspin),odi%n2d,wronk,evacp,bkpt, - > odi%M,odi%mb,vz(1,nvac),kvac3(1),nv2, - > t(1,-odi%mb),dt(1,-odi%mb),u(1,1,-odi%mb), - < te(1,-odi%mb),dte(1,-odi%mb),tei(1,-odi%mb), - < ue(1,1,-odi%mb)) + > odi%M,odi%mb,vz(1,nvac),kvac3,nv2, + > t(1:,-odi%mb:),dt(1:,-odi%mb:),u(1:,1:,-odi%mb:), + < te(1:,-odi%mb:),dte(1:,-odi%mb:),tei(1:,-odi%mb:), + < ue(1:,1:,-odi%mb:)) do k = 1,nv l = map1(k) @@ -155,6 +155,3 @@ c******************************************************** end subroutine end module m_wann_1dvacabcof - - - diff --git a/wannier/wann_mmk0_od_vac.F b/wannier/wann_mmk0_od_vac.F index 686357b1..a03d6fe7 100644 --- a/wannier/wann_mmk0_od_vac.F +++ b/wannier/wann_mmk0_od_vac.F @@ -9,15 +9,15 @@ c************************************************************** c Determines the overlap matrix Mmn(k) in the vacuum c for the wannier functions. -c For more details see routine wannier.F +c For more details see routine wannier.F c -c Y. Mokrousov, F. Freimuth -c*************************************************************** +c Y. Mokrousov, F. Freimuth +c*************************************************************** CONTAINS SUBROUTINE wann_mmk0_od_vac( - > DIMENSION, oneD, vacuum, stars, cell, + > oneD, vacuum, stars, cell, > l_noco,nlotot, > z1,nmzxyd,nmzd,nv2d,k1d,k2d,k3d,n2d,n3d, > ig,nmzxy,nmz,delz,ig2,n2d_1, @@ -37,7 +37,7 @@ c*************************************************************** TYPE(t_mat), INTENT(IN) :: zMat - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_stars),INTENT(IN) :: stars @@ -124,12 +124,12 @@ c ..intrinsic functions.. qssbti(3,2) = + qss(3)/2. DO ispin = 1,1 ! jspins CALL od_abvac( - > cell,vacuum,DIMENSION,stars,oneD, + > cell,vacuum,stars,oneD, > qssbti(3,jspin),odi%n2d, > wronk,evac,bkpt,odi%M,odi%mb, - > vz,kvac3(1),nv2, - < uz(1,-vM),duz(1,-vM),u(1,1,-vM),udz(1,-vM), - < dudz(1,-vM),ddnv(1,-vM),ud(1,1,-vM)) + > vz,kvac3(:),nv2, + < uz(:,-vM:),duz(:,-vM:),u(:,:,-vM:),udz(:,-vM:), + < dudz(:,-vM:),ddnv(:,-vM:),ud(:,:,-vM:)) ENDDO addnoco=0 @@ -176,7 +176,7 @@ c + conjg(zMat%data_c(k,n))*bvac enddo END IF enddo ! -mb:mb - endif + endif enddo ! k = 1,nv c now actually computing the Mmn matrix @@ -184,11 +184,11 @@ c now actually computing the Mmn matrix do l = 1,nv2 do m = -odi%mb,odi%mb do i = 1,nslibd - do j = 1,nslibd - mmn(i,j) = mmn(i,j) + + do j = 1,nslibd + mmn(i,j) = mmn(i,j) + + area*(acof(l,m,i)*conjg(acof(l,m,j)) - + + ddnv(l,m)*bcof(l,m,i)*conjg(bcof(l,m,j))) - enddo + + + ddnv(l,m)*bcof(l,m,i)*conjg(bcof(l,m,j))) + enddo enddo enddo enddo diff --git a/wannier/wann_mmkb_od_vac.F b/wannier/wann_mmkb_od_vac.F index 321e2680..82bd9a0f 100644 --- a/wannier/wann_mmkb_od_vac.F +++ b/wannier/wann_mmkb_od_vac.F @@ -7,14 +7,14 @@ MODULE m_wann_mmkb_od_vac c************************************************************** c Determines the overlap matrix Mmn(k,k+b) in the vacuum -c for the wannier functions. +c for the wannier functions. c For more details see routine wannier.F and wann_mmk0_od_vac.F c c Y. Mokrousov, F. Freimuth -c*************************************************************** +c*************************************************************** CONTAINS SUBROUTINE wann_mmkb_od_vac( - > DIMENSION,oneD,vacuum,stars,cell, + > oneD,vacuum,stars,cell, > vacchi,l_noco,nlotot, > nbnd,z1,nmzxyd,nmzd,nv2d,k1d,k2d,k3d,n2d,n3d, > ig,nmzxy,nmz,delz,ig2,n2d_1, @@ -33,7 +33,7 @@ c*************************************************************** implicit none - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_stars),INTENT(IN) :: stars @@ -121,7 +121,7 @@ c ..local scalars.. + bcof(nv2d,-odi%mb:odi%mb,nslibd), + acof_b(nv2d,-odi%mb:odi%mb,nslibd_b), + bcof_b(nv2d,-odi%mb:odi%mb,nslibd_b), - + kvac3(nv2d),map1(nvd), + + kvac3(nv2d),map1(nvd), + kvac3_b(nv2d),map1_b(nvd) ) tpi = 2 * pimach() ; ic = cmplx(0.,1.) @@ -164,20 +164,20 @@ c ..local scalars.. c...for the k-point - qssbti(1,1) = - qss(1)/2. - qssbti(2,1) = - qss(2)/2. - qssbti(1,2) = + qss(1)/2. + qssbti(1,1) = - qss(1)/2. + qssbti(2,1) = - qss(2)/2. + qssbti(1,2) = + qss(1)/2. qssbti(2,2) = + qss(2)/2. qssbti(3,1) = - qss(3)/2. qssbti(3,2) = + qss(3)/2. DO ispin = 1,1 ! jspins CALL od_abvac( - > cell,vacuum,DIMENSION,stars,oneD, + > cell,vacuum,stars,oneD, > qssbti(3,jspin),odi%n2d, > wronk,evac,bkpt,odi%M,odi%mb, > vz,kvac3,nv2, - < uz(1,-vM),duz(1,-vM),u(1,1,-vM),udz(1,-vM), - < dudz(1,-vM),ddnv(1,-vM),ud(1,1,-vM)) + < uz(:,-vM:),duz(:,-vM:),u(:,:,-vM:),udz(:,-vM:), + < dudz(:,-vM:),ddnv(:,-vM:),ud(:,:,-vM:)) ENDDO do k = 1,nv(jspin) @@ -227,12 +227,12 @@ c...for the b-point DO ispin = 1,1 ! jspins call od_abvac( - > cell,vacuum,DIMENSION,stars,oneD, + > cell,vacuum,stars,oneD, > qssbti(3,jspin_b),odi%n2d, > wronk,evac_b,bkpt_b,odi%M,odi%mb, > vz_b,kvac3_b,nv2_b, - < uz_b(1,-vM),duz_b(1,-vM),u_b(1,1,-vM),udz_b(1,-vM), - < dudz_b(1,-vM),ddnv_b(1,-vM),ud_b(1,1,-vM)) + < uz_b(1:,-vM:),duz_b(1:,-vM:),u_b(1:,1:,-vM:),udz_b(1:,-vM:), + < dudz_b(1:,-vM:),ddnv_b(1:,-vM:),ud_b(1:,1:,-vM:)) ENDDO do k = 1,nv_b(jspin_b) @@ -275,7 +275,7 @@ c + conjg(zMat_b%data_c(k,n))*bvac enddo END IF enddo ! -mb:mb - endif + endif enddo ! k = 1,nv c now actually computing the Mmn matrix @@ -287,7 +287,7 @@ c now actually computing the Mmn matrix arg = phi2(irec2) !write(*,*)'mmkb_od_vac zks0',zks0 - + gbess(:,:) = 0. do i = 1,nmz zz = z1+(i-1)*delz @@ -303,7 +303,7 @@ c gbess(i) = 1. do l = 1,nv2 do lprime = 1,nv2_b - if (kvac3(l).eq.(kvac3_b(lprime)-gb(3))) then + if (kvac3(l).eq.(kvac3_b(lprime)-gb(3))) then do m = -odi%mb,odi%mb do mp = -odi%mb,odi%mb @@ -314,25 +314,25 @@ c gbess(i) = 1. do i = 1,nmz zz = z1+(i-1)*delz xx(np1-i) = zz*u(i,l,m)*u_b(i,lprime,mp)*gbess(mp-m,i) - enddo + enddo call intgz0(xx,delz,nmz,uuo,tail) do i = 1,nmz zz = z1+(i-1)*delz xx(np1-i) = zz*u(i,l,m)*ud_b(i,lprime,mp)*gbess(mp-m,i) - enddo + enddo call intgz0(xx,delz,nmz,udo,tail) do i = 1,nmz zz = z1+(i-1)*delz xx(np1-i) = zz*ud(i,l,m)*u_b(i,lprime,mp)*gbess(mp-m,i) - enddo + enddo call intgz0(xx,delz,nmz,duo,tail) do i = 1,nmz zz = z1+(i-1)*delz xx(np1-i) = zz*ud(i,l,m)*ud_b(i,lprime,mp)*gbess(mp-m,i) - enddo + enddo call intgz0(xx,delz,nmz,ddo,tail) do i = 1,nslibd @@ -341,8 +341,8 @@ c gbess(i) = 1. * acof(l,m,i)*conjg(acof_b(lprime,mp,j))*uuo + + acof(l,m,i)*conjg(bcof_b(lprime,mp,j))*udo + + bcof(l,m,i)*conjg(acof_b(lprime,mp,j))*duo + - + bcof(l,m,i)*conjg(bcof_b(lprime,mp,j))*ddo )*vacchi - enddo + + bcof(l,m,i)*conjg(bcof_b(lprime,mp,j))*ddo )*vacchi + enddo enddo enddo !mp diff --git a/wannier/wann_plot.F b/wannier/wann_plot.F index 1e508d61..cc83f0fb 100644 --- a/wannier/wann_plot.F +++ b/wannier/wann_plot.F @@ -38,7 +38,7 @@ ! +++++++++++++++++++++++++++++++++++++++++++++++++ CONTAINS SUBROUTINE wann_plot( - > DIMENSION,oneD,vacuum,stars,cell,atoms, + > oneD,vacuum,stars,cell,atoms, > nv2d,jspin,odi,ods,n3d,nmzxyd,n2d,ntypsd, > ntype,lmaxd,jmtd,ntypd,natd,nmzd,neq,nq3,nvac, > nmz,nmzxy,nq2,nop,nop2,volint,film,slice,symor, @@ -60,7 +60,7 @@ IMPLICIT NONE - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_stars),INTENT(IN) :: stars @@ -189,7 +189,7 @@ c make preparations for plotting in vacuum & u_1(nmzd,nv2d,-odi%mb:odi%mb), & ue_1(nmzd,nv2d,-odi%mb:odi%mb) ) call wann_1dvacabcof( - > DIMENSION,oneD,vacuum,stars,cell, + > oneD,vacuum,stars,cell, > nv2d,nslibd,nmzd,nmz,omtil,vz(:,:), > nv,bkpt,z1,odi,ods, > nvd,k1,k2,k3,evac, diff --git a/wannier/wann_plot_um_dat.F b/wannier/wann_plot_um_dat.F index 50f0f038..bba504da 100644 --- a/wannier/wann_plot_um_dat.F +++ b/wannier/wann_plot_um_dat.F @@ -13,7 +13,7 @@ c FF, September 2006 c****************************************************************** CONTAINS SUBROUTINE wann_plot_um_dat( - > DIMENSION,stars,vacuum,atoms,sphhar,input,sym,mpi, + > stars,vacuum,atoms,sphhar,input,sym,mpi, > lapw,oneD,noco,cell,vTot,enpara,eig_id,l_real, > mpi_comm,sortrule,band_min,band_max,l_soc, > l_dulo,l_noco,l_ss,lmaxd, @@ -57,7 +57,7 @@ c****************************************************************** integer stt(MPI_STATUS_SIZE) #endif - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_stars),INTENT(IN) :: stars TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_atoms),INTENT(IN) :: atoms @@ -639,7 +639,7 @@ c*********************************************************************** & u_1(nmzd,nv2d,-odi%mb:odi%mb), & ue_1(nmzd,nv2d,-odi%mb:odi%mb) ) call wann_1dvacabcof( - > DIMENSION,oneD,vacuum,stars,cell, + > oneD,vacuum,stars,cell, > nv2d,nslibd,nmzd,nmz,omtil,vz(:,:,jspin2), > nv(jspin),bkpt,z1,odi,ods, > nvd,k1(:,jspin),k2(:,jspin),k3(:,jspin),enpara%evac0(:,jspin), diff --git a/wannier/wann_postproc.F90 b/wannier/wann_postproc.F90 index a1198730..5ba4e93a 100644 --- a/wannier/wann_postproc.F90 +++ b/wannier/wann_postproc.F90 @@ -7,7 +7,7 @@ MODULE m_wann_postproc CONTAINS SUBROUTINE wann_postproc(& - DIMENSION,stars,vacuum,atoms,sphhar,input,kpts,sym,mpi,& + stars,vacuum,atoms,sphhar,input,kpts,sym,mpi,& lapw,oneD,noco,cell,vTot,enpara,sliceplot,eig_id,l_real,& wann, fullnkpts, l_proj,ef,l_sgwf,fullnqpts) ! < fermi_weights) @@ -53,7 +53,7 @@ CONTAINS #endif IMPLICIT NONE - TYPE(t_dimension),INTENT(IN) :: DIMENSION + TYPE(t_stars),INTENT(IN) :: stars TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_atoms),INTENT(IN) :: atoms @@ -77,7 +77,7 @@ CONTAINS LOGICAL, INTENT(in) :: l_proj REAL, INTENT (in) :: ef LOGICAL, INTENT (in) :: l_sgwf - ! real,intent(inout) :: fermi_weights(:,:,:) !(dimension%neigd,nkptd,jspd) + ! real,intent(inout) :: fermi_weights(:,:,:) !(input%neig,nkptd,jspd) CHARACTER(len=12) :: fending INTEGER :: i,nkpts,ikpt,nkqpts,iqpt @@ -162,14 +162,14 @@ CONTAINS ! call wann_plotw90(i,wann%band_min,wann%band_max,numbands,nwfs, ! > atoms%l_dulo,noco%l_noco,noco%l_ss,atoms%lmaxd,atoms%ntype, - ! > dimension%neigd,atoms%nat,sym%nop,dimension%nvd,jspd,dimension%nbasfcn,atoms%llod,atoms%nlod,atoms%ntype, + ! > input%neig,atoms%nat,sym%nop,lapw%dim_nvd(),jspd,lapw%dim_nbasfcn(),atoms%llod,atoms%nlod,atoms%ntype, ! > nwdd,cell%omtil,atoms%nlo,atoms%llo,atoms%lapw_l,sym%invtab,sym%mrot,sym%ngopr,atoms%neq,atoms%lmax, ! > sym%invsat,sym%invsatnr,kpts%nkpt,atoms%taual,atoms%rmt,cell%amat,cell%bmat,cell%bbmat,noco%alph, ! > noco%beta,noco%qss,stars%sk2,stars%phi2,oneD%odi,oneD%ods,mpi%irank,mpi%isize,stars%ng3,vacuum%nmzxyd,vacuum%nmzd, ! > size(atoms%rmsh,1),sphhar%nlhd,stars%ng3,vacuum%nvac,sym%invs,sym%invs2,input%film,sphhar%nlh,atoms%jri,sphhar%ntypsd, ! > sym%ntypsy,input%jspins,kpts%nkpt,atoms%dx,stars%ng2,atoms%rmsh,sliceplot%e1s,sliceplot%e2s,atoms%ulo_der, ! > stars%ustep,stars%ig,stars%mx1,stars%mx2,stars%mx3,stars%rgphs,sliceplot%slice,sliceplot%kk,sliceplot%nnne, - ! > cell%z1,dimension%nv2d,vacuum%nmzxy,vacuum%nmz,vacuum%delz,stars%ig2,cell%area,sym%tau,atoms%zatom,stars%ng2,sym%nop2, + ! > cell%z1,lapw%dim_nv2d(),vacuum%nmzxy,vacuum%nmz,vacuum%delz,stars%ig2,cell%area,sym%tau,atoms%zatom,stars%ng2,sym%nop2, ! > cell%volint,sym%symor,atoms%pos,ef,wann%l_bzsym,irecl) ENDIF @@ -244,7 +244,7 @@ CONTAINS rvecnum,rvec,kpoints,& input%jspins,fullnkpts,wann%l_bzsym,input%film,oneD%odi%d1,& l_nocosoc,wann%band_min,wann%band_max,& - DIMENSION%neigd,wann%l_socmmn0,wann%l_ndegen,ndegen,& + input%neig,wann%l_socmmn0,wann%l_ndegen,ndegen,& wann%wan90version,wann%l_unformatted) ENDIF @@ -253,7 +253,7 @@ CONTAINS rvecnum,rvec,kpoints,& input%jspins,fullnkpts,wann%l_bzsym,input%film,oneD%odi%d1,& noco%l_soc,wann%band_min,wann%band_max,& - DIMENSION%neigd,.FALSE.,& + input%neig,.FALSE.,& wann%wan90version) ENDIF @@ -266,7 +266,7 @@ CONTAINS 'WF1.orbcomp','orbcomp.1',& rvecnum,rvec,kpoints,& 1,fullnkpts,input%film,& - noco%l_soc,wann%band_min,wann%band_max,DIMENSION%neigd,& + noco%l_soc,wann%band_min,wann%band_max,input%neig,& wann%wan90version) IF( input%jspins.EQ.2 )THEN spinspin=2 @@ -277,7 +277,7 @@ CONTAINS 'WF2.orbcomp','orbcomp.2',& rvecnum,rvec,kpoints,& spinspin,fullnkpts,input%film,& - noco%l_soc,wann%band_min,wann%band_max,DIMENSION%neigd,& + noco%l_soc,wann%band_min,wann%band_max,input%neig,& wann%wan90version) ENDIF ENDIF @@ -288,7 +288,7 @@ CONTAINS rvecnum,rvec,kpoints,& input%jspins,fullnkpts,wann%l_bzsym,input%film,oneD%odi%d1,& l_nocosoc,wann%band_min,wann%band_max,& - DIMENSION%neigd,.FALSE.,wann%wan90version) + input%neig,.FALSE.,wann%wan90version) ENDIF @@ -298,7 +298,7 @@ CONTAINS 'anglmomrs.1',.FALSE.,& rvecnum,rvec,kpoints,& input%jspins,fullnkpts,wann%l_bzsym,input%film,oneD%odi%d1,& - noco%l_soc,wann%band_min,wann%band_max,DIMENSION%neigd,& + noco%l_soc,wann%band_min,wann%band_max,input%neig,& .FALSE.,wann%wan90version) ENDIF @@ -307,7 +307,7 @@ CONTAINS CALL wann_offdiposop_rs(& rvecnum,rvec,kpoints,& input%jspins,fullnkpts,wann%l_bzsym,input%film,oneD%odi%d1,& - noco%l_soc,wann%band_min,wann%band_max,DIMENSION%neigd,& + noco%l_soc,wann%band_min,wann%band_max,input%neig,& .FALSE.) ENDIF @@ -315,7 +315,7 @@ CONTAINS CALL wann_fft5(& rvecnum,rvec,kpoints,& input%jspins,fullnkpts,wann%l_bzsym,input%film,oneD%odi%d1,& - noco%l_soc,wann%band_min,wann%band_max,DIMENSION%neigd,& + noco%l_soc,wann%band_min,wann%band_max,input%neig,& .FALSE.) ENDIF @@ -324,7 +324,7 @@ CONTAINS 'WF1.perturb' ,'perturbrs.1' ,.FALSE.,& rvecnum,rvec,kpoints,& input%jspins,fullnkpts,wann%l_bzsym,input%film,oneD%odi%d1,& - noco%l_soc,wann%band_min,wann%band_max,DIMENSION%neigd,& + noco%l_soc,wann%band_min,wann%band_max,input%neig,& .FALSE.) ENDIF @@ -334,13 +334,13 @@ CONTAINS 'WF1.socspicom','socspicomrs.1',.TRUE.,& rvecnum,rvec,kpoints,& input%jspins,fullnkpts,wann%l_bzsym,input%film,oneD%odi%d1,& - noco%l_soc,wann%band_min,wann%band_max,DIMENSION%neigd,& + noco%l_soc,wann%band_min,wann%band_max,input%neig,& .FALSE.) ELSE CALL wann_fft6(& rvecnum,rvec,kpoints,& input%jspins,fullnkpts,wann%l_bzsym,input%film,oneD%odi%d1,& - noco%l_soc,wann%band_min,wann%band_max,DIMENSION%neigd,& + noco%l_soc,wann%band_min,wann%band_max,input%neig,& .FALSE.) ENDIF ENDIF @@ -352,7 +352,7 @@ CONTAINS atoms%ntype,atoms%neq,rvecnum,rvec,kpoints,& input%jspins,fullnkpts,wann%l_bzsym,input%film,oneD%odi%d1,& noco%l_soc,wann%band_min,wann%band_max,& - DIMENSION%neigd,.FALSE.) + input%neig,.FALSE.) ENDIF #endif IF (wann%l_nablapaulirs.AND.mpi%irank==0)THEN @@ -360,7 +360,7 @@ CONTAINS rvecnum,rvec,kpoints,& input%jspins,fullnkpts,wann%l_bzsym,input%film,oneD%odi%d1,& noco%l_soc,wann%band_min,wann%band_max,& - DIMENSION%neigd,.FALSE.,wann%wan90version) + input%neig,.FALSE.,wann%wan90version) ENDIF IF (wann%l_pauli.AND.mpi%irank==0)THEN @@ -368,7 +368,7 @@ CONTAINS rvecnum,rvec,kpoints,& input%jspins,fullnkpts,wann%l_bzsym,input%film,oneD%odi%d1,& l_nocosoc,wann%band_min,wann%band_max,& - DIMENSION%neigd,.FALSE.,wann%l_ndegen,ndegen,& + input%neig,.FALSE.,wann%l_ndegen,ndegen,& wann%wan90version,wann%l_unformatted) ENDIF @@ -377,7 +377,7 @@ CONTAINS rvecnum,rvec,kpoints,& input%jspins,fullnkpts,wann%l_bzsym,input%film,oneD%odi%d1,& noco%l_soc,wann%band_min,wann%band_max,& - DIMENSION%neigd,.FALSE.,wann%l_ndegen,ndegen,wann%wan90version,& + input%neig,.FALSE.,wann%l_ndegen,ndegen,wann%wan90version,& wann%l_unformatted) ENDIF @@ -386,23 +386,23 @@ CONTAINS rvecnum,rvec,kpoints,& input%jspins,fullnkpts,wann%l_bzsym,input%film,oneD%odi%d1,& noco%l_soc,wann%band_min,wann%band_max,& - DIMENSION%neigd,.FALSE.,wann%wan90version) + input%neig,.FALSE.,wann%wan90version) ENDIF IF(wann%l_plot_umdat)THEN CALL wann_plot_um_dat(& - DIMENSION,stars,vacuum,atoms,sphhar,input,sym,mpi,& + stars,vacuum,atoms,sphhar,input,sym,mpi,& lapw,oneD,noco,cell,vTot,enpara,eig_id,l_real,& mpi%mpi_comm,i,wann%band_min,wann%band_max,noco%l_soc,& atoms%l_dulo,noco%l_noco,noco%l_ss,atoms%lmaxd,atoms%ntype,& - DIMENSION%neigd,atoms%nat,sym%nop,DIMENSION%nvd,input%jspins,DIMENSION%nbasfcn,atoms%llod,atoms%nlod,atoms%ntype,& + input%neig,atoms%nat,sym%nop,lapw%dim_nvd(),input%jspins,lapw%dim_nbasfcn(),atoms%llod,atoms%nlod,atoms%ntype,& cell%omtil,atoms%nlo,atoms%llo,atoms%lapw_l,sym%invtab,sym%mrot,sym%ngopr,atoms%neq,atoms%lmax,& sym%invsat,sym%invsatnr,kpts%nkpt,atoms%taual,atoms%rmt,cell%amat,cell%bmat,cell%bbmat,noco%alph,& noco%beta,noco%qss,stars%sk2,stars%phi2,oneD%odi,oneD%ods,mpi%irank,mpi%isize,stars%ng3,vacuum%nmzxyd,vacuum%nmzd,& SIZE(atoms%rmsh,1),sphhar%nlhd,stars%ng3,vacuum%nvac,sym%invs,sym%invs2,input%film,sphhar%nlh,atoms%jri,sphhar%ntypsd,& sym%ntypsy,input%jspins,kpts%nkpt,atoms%dx,stars%ng2,atoms%rmsh,sliceplot%e1s,sliceplot%e2s,atoms%ulo_der,& stars%ustep,stars%ig,stars%mx1,stars%mx2,stars%mx3,stars%rgphs,sliceplot%slice,sliceplot%kk,sliceplot%nnne,& - cell%z1,DIMENSION%nv2d,vacuum%nmzxy,vacuum%nmz,vacuum%delz,stars%ig2,cell%area,sym%tau,atoms%zatom,stars%ng2,sym%nop2,& + cell%z1,lapw%dim_nv2d(),vacuum%nmzxy,vacuum%nmz,vacuum%delz,stars%ig2,cell%area,sym%tau,atoms%zatom,stars%ng2,sym%nop2,& cell%volint,sym%symor,atoms%pos,ef,wann%l_bzsym,wann%l_proj_plot,& wann%wan90version) ENDIF @@ -416,14 +416,14 @@ CONTAINS vTot,& noco%l_soc,wann%unigrid,i,wann%band_min,wann%band_max,& atoms%l_dulo,noco%l_noco,noco%l_ss,atoms%lmaxd,atoms%ntype,& - DIMENSION%neigd,atoms%nat,sym%nop,DIMENSION%nvd,input%jspins,DIMENSION%nbasfcn,atoms%llod,atoms%nlod,atoms%ntype,& + input%neig,atoms%nat,sym%nop,lapw%dim_nvd(),input%jspins,lapw%dim_nbasfcn(),atoms%llod,atoms%nlod,atoms%ntype,& cell%omtil,atoms%nlo,atoms%llo,atoms%lapw_l,sym%invtab,sym%mrot,sym%ngopr,atoms%neq,atoms%lmax,& sym%invsat,sym%invsatnr,kpts%nkpt,atoms%taual,atoms%rmt,cell%amat,cell%bmat,cell%bbmat,noco%alph,& noco%beta,noco%qss,stars%sk2,stars%phi2,oneD%odi,oneD%ods,mpi%irank,mpi%isize,stars%ng3,vacuum%nmzxyd,vacuum%nmzd,& SIZE(atoms%rmsh,1),sphhar%nlhd,stars%ng3,vacuum%nvac,sym%invs,sym%invs2,input%film,sphhar%nlh,atoms%jri,sphhar%ntypsd,& sym%ntypsy,input%jspins,kpts%nkpt,atoms%dx,stars%ng2,atoms%rmsh,sliceplot%e1s,sliceplot%e2s,atoms%ulo_der,& stars%ustep,stars%ig,stars%mx1,stars%mx2,stars%mx3,stars%rgphs,sliceplot%slice,sliceplot%kk,sliceplot%nnne,& - cell%z1,DIMENSION%nv2d,vacuum%nmzxy,vacuum%nmz,vacuum%delz,stars%ig2,cell%area,sym%tau,atoms%zatom,stars%ng2,sym%nop2,& + cell%z1,lapw%dim_nv2d(),vacuum%nmzxy,vacuum%nmz,vacuum%delz,stars%ig2,cell%area,sym%tau,atoms%zatom,stars%ng2,sym%nop2,& cell%volint,sym%symor,atoms%pos,ef,wann%l_bzsym,wann%l_proj_plot,& wann%wan90version) ENDIF @@ -433,14 +433,14 @@ CONTAINS CALL wannier_to_lapw_kpts(& unigrid,i,wann%band_min,wann%band_max,& atoms%l_dulo,noco%l_noco,noco%l_ss,atoms%lmaxd,atoms%ntype,& - DIMENSION%neigd,atoms%nat,sym%nop,DIMENSION%nvd,input%jspins,DIMENSION%nbasfcn,atoms%llod,atoms%nlod,atoms%ntype,& + input%neig,atoms%nat,sym%nop,lapw%dim_nvd(),input%jspins,lapw%dim_nbasfcn(),atoms%llod,atoms%nlod,atoms%ntype,& nwdd,cell%omtil,atoms%nlo,atoms%llo,atoms%lapw_l,sym%invtab,sym%mrot,sym%ngopr,atoms%neq,atoms%lmax,& sym%invsat,sym%invsatnr,kpts%nkpt,atoms%taual,atoms%rmt,cell%amat,cell%bmat,cell%bbmat,noco%alph,& noco%beta,noco%qss,stars%sk2,stars%phi2,oneD%odi,oneD%ods,mpi%irank,mpi%isize,stars%ng3,vacuum%nmzxyd,vacuum%nmzd,& SIZE(atoms%rmsh,1),sphhar%nlhd,stars%ng3,vacuum%nvac,sym%invs,sym%invs2,input%film,sphhar%nlh,atoms%jri,sphhar%ntypsd,& sym%ntypsy,input%jspins,kpts%nkpt,atoms%dx,stars%ng2,atoms%rmsh,sliceplot%e1s,sliceplot%e2s,atoms%ulo_der,& stars%ustep,stars%ig,stars%mx1,stars%mx2,stars%mx3,stars%rgphs,sliceplot%slice,sliceplot%kk,sliceplot%nnne,& - cell%z1,DIMENSION%nv2d,vacuum%nmzxy,vacuum%nmz,vacuum%delz,stars%ig2,cell%area,sym%tau,atoms%zatom,stars%ng2,sym%nop2,& + cell%z1,lapw%dim_nv2d(),vacuum%nmzxy,vacuum%nmz,vacuum%delz,stars%ig2,cell%area,sym%tau,atoms%zatom,stars%ng2,sym%nop2,& cell%volint,sym%symor,atoms%pos,ef,wann%l_bzsym,wann%l_proj_plot,irecl) #else CALL juDFT_error("not yet tested in this release",calledby& @@ -452,14 +452,14 @@ CONTAINS CALL wannier_lapw_gfleur(& gfthick,gfcut,i,wann%band_min,wann%band_max,& atoms%l_dulo,noco%l_noco,noco%l_ss,atoms%lmaxd,atoms%ntype,& - DIMENSION%neigd,atoms%nat,sym%nop,DIMENSION%nvd,input%jspins,DIMENSION%nbasfcn,atoms%llod,atoms%nlod,atoms%ntype,& + input%neig,atoms%nat,sym%nop,lapw%dim_nvd(),input%jspins,lapw%dim_nbasfcn(),atoms%llod,atoms%nlod,atoms%ntype,& nwdd,cell%omtil,atoms%nlo,atoms%llo,atoms%lapw_l,sym%invtab,sym%mrot,sym%ngopr,atoms%neq,atoms%lmax,& sym%invsat,sym%invsatnr,kpts%nkpt,atoms%taual,atoms%rmt,cell%amat,cell%bmat,cell%bbmat,noco%alph,& noco%beta,noco%qss,stars%sk2,stars%phi2,oneD%odi,oneD%ods,mpi%irank,mpi%isize,stars%ng3,vacuum%nmzxyd,vacuum%nmzd,& SIZE(atoms%rmsh,1),sphhar%nlhd,stars%ng3,vacuum%nvac,sym%invs,sym%invs2,input%film,sphhar%nlh,atoms%jri,sphhar%ntypsd,& sym%ntypsy,input%jspins,kpts%nkpt,atoms%dx,stars%ng2,atoms%rmsh,sliceplot%e1s,sliceplot%e2s,atoms%ulo_der,& stars%ustep,stars%ig,stars%mx1,stars%mx2,stars%mx3,stars%rgphs,sliceplot%slice,sliceplot%kk,sliceplot%nnne,& - cell%z1,DIMENSION%nv2d,vacuum%nmzxy,vacuum%nmz,vacuum%delz,stars%ig2,cell%area,sym%tau,atoms%zatom,stars%ng2,sym%nop2,& + cell%z1,lapw%dim_nv2d(),vacuum%nmzxy,vacuum%nmz,vacuum%delz,stars%ig2,cell%area,sym%tau,atoms%zatom,stars%ng2,sym%nop2,& cell%volint,sym%symor,atoms%pos,ef,wann%l_bzsym,wann%l_proj_plot,irecl) #else CALL juDFT_error("not yet tested in this release",calledby& @@ -475,7 +475,7 @@ CONTAINS CALL juDFT_error("not yet tested in this release",calledby& ="wann_postproc") ! call wann_plot_from_lapw( - ! > dimension%nv2d,input%jspins,oneD%odi,oneD%ods,stars%ng3,vacuum%nmzxyd,stars%ng2, + ! > lapw%dim_nv2d(),input%jspins,oneD%odi,oneD%ods,stars%ng3,vacuum%nmzxyd,stars%ng2, ! > sphhar%ntypsd, ! > atoms%ntype,atoms%lmaxd,size(atoms%rmsh,1),atoms%nat,vacuum%nmzd,atoms%neq,stars%ng3,vacuum%nvac, ! > vacuum%nmz,vacuum%nmzxy,stars%ng2,sym%nop,sym%nop2,cell%volint,input%film,sliceplot%slice,sym%symor, diff --git a/wannier/wann_read_inp.f90 b/wannier/wann_read_inp.f90 index 177745c9..0ee6b6dd 100644 --- a/wannier/wann_read_inp.f90 +++ b/wannier/wann_read_inp.f90 @@ -7,7 +7,7 @@ module m_wann_read_inp contains -subroutine wann_read_inp(DIMENSION,input,noco,l_p0,wann) +subroutine wann_read_inp(input,noco,l_p0,wann) !******************************************** ! Read the Wannier input file 'wann_inp'. ! Frank Freimuth @@ -17,7 +17,7 @@ subroutine wann_read_inp(DIMENSION,input,noco,l_p0,wann) implicit none - TYPE(t_dimension), INTENT(INOUT) :: DIMENSION + TYPE(t_input),intent(inout) :: input TYPE(t_noco), INTENT(INOUT) :: noco TYPE(t_wann), intent(inout) :: wann @@ -742,19 +742,19 @@ subroutine wann_read_inp(DIMENSION,input,noco,l_p0,wann) neigd_min=max(wann%band_max(1),wann%band_max(2)) endif !noco,soc? if(l_p0)then - write(*,*)"In wann_read_inp: input-neigd=",DIMENSION%neigd + write(*,*)"In wann_read_inp: input-neigd=",input%neig write(*,*)"In wann_read_inp: we require at least neigd_min=",neigd_min - if(neigd_min>DIMENSION%neigd)then + if(neigd_min>input%neig)then write(*,*)"we increase neigd..." else write(*,*)"we leave neigd unchanged" endif endif !l_p0? - if(neigd_min>DIMENSION%neigd)then - DIMENSION%neigd=neigd_min + if(neigd_min>input%neig)then + input%neig=neigd_min endif if(l_p0)then - write(*,*)"In wann_read_inp: output-neigd=",DIMENSION%neigd + write(*,*)"In wann_read_inp: output-neigd=",input%neig endif endif !l_byindex? diff --git a/wannier/wann_updown.F b/wannier/wann_updown.F index 7628c4ac..ce3ac38d 100644 --- a/wannier/wann_updown.F +++ b/wannier/wann_updown.F @@ -8,7 +8,7 @@ use m_juDFT CONTAINS SUBROUTINE wann_updown( - > DIMENSION,wann,mpi,input,kpts,sym,atoms,stars,vacuum, + > wann,mpi,input,kpts,sym,atoms,stars,vacuum, > sphhar,oneD,noco,cell,vTot, > enpara, > eig_id,l_real,mpi_comm,l_dulo,l_noco,l_ss,lmaxd,ntypd, @@ -75,7 +75,7 @@ c**************************************************************************** #endif - TYPE(t_dimension), INTENT(IN) :: DIMENSION + TYPE(t_wann), INTENT(INOUT) :: wann TYPE(t_mpi),INTENT(IN) :: mpi TYPE(t_input),INTENT(IN) :: input @@ -852,9 +852,9 @@ c**************************************************************** CALL cdn_read( & eig_id, - & DIMENSION%nvd,input%jspins,mpi%irank,mpi%isize, !wannierspin instead of DIMENSION%jspd? - & kptibz,jspin,DIMENSION%nbasfcn, - & noco%l_ss,noco%l_noco,DIMENSION%neigd,n_start,n_end, + & lapw%dim_nvd(),input%jspins,mpi%irank,mpi%isize, !wannierspin instead of DIMENSION%jspd? + & kptibz,jspin,lapw%dim_nbasfcn(), + & noco%l_ss,noco%l_noco,input%neig,n_start,n_end, & nbands,eigg(:,jspin),zzMat(jspin)) diff --git a/wannier/wann_wan90prep.F b/wannier/wann_wan90prep.F index db2bc697..fa14f23f 100644 --- a/wannier/wann_wan90prep.F +++ b/wannier/wann_wan90prep.F @@ -8,7 +8,7 @@ use m_juDFT USE m_types c********************************************************** -c prepares WF//spin12(jspin)//.win for +c prepares WF//spin12(jspin)//.win for c input to wannier90 and creates bkpts file c FF, September 2006 c********************************************************** @@ -25,7 +25,7 @@ c********************************************************** use m_wann_get_mp use m_wann_get_kpts use m_wann_get_qpts - use m_wann_gwf_tools, only : get_index_kq,get_dimension,get_shift + use m_wann_gwf_tools, only : get_index_kq,get_shift,get_dimension use m_wann_gwf_auxbrav IMPLICIT NONE @@ -152,7 +152,7 @@ c********************************************************* endif c********************************************************* -c Find out the structure of q-point set. +c Find out the structure of q-point set. c********************************************************* IF(l_sgwf.or.l_socgwf)THEN call wann_get_mp( @@ -166,7 +166,7 @@ c******************************************************* c Write information to WF//spin12(jspin)//.win c******************************************************* if(l_ms) nqptd = nqpts - + do jspin=1,jspins c proj file provides num_wann and num_bands l_file=.false. @@ -188,7 +188,7 @@ c proj file provides num_wann and num_bands close(712) do iqpt=1,nqptd - win_filename = 'WF'//spin12(jspin) + win_filename = 'WF'//spin12(jspin) if(l_ms) then write(win_filename,'("WF",a1,"_",i4.4)')spin12(jspin),iqpt endif @@ -197,7 +197,7 @@ c proj file provides num_wann and num_bands > num_iter,jspin,ntype,ntypd,natd,nkpts,neq,num,amat, > kpoints,zatom,taual,namat,3) enddo - + enddo!jspin amat_ang=amat*bohr @@ -271,7 +271,7 @@ c****************************************************** allocate(kqpoints(arr_len,nkqpts)) kqpoints = 0. do iqpt=1,nqpts - do ikpt=1,nkpts + do ikpt=1,nkpts ikqpt = get_index_kq(ikpt,iqpt,nkpts) kqpoints(1,ikqpt) = kpoints(1,ikpt) kqpoints(2,ikqpt) = kpoints(2,ikpt) @@ -424,9 +424,9 @@ c****************************************************** write(911,*)"! optional parameters for plotting" if(jspin.eq.1)then write(911,*)"spin=up" - else + else write(911,*)"spin=down" - endif + endif write(911,*)"!restart=plot" write(911,*)"!wannier_plot=true" write(911,*)"!wannier_plot_supercell=3" @@ -450,19 +450,19 @@ c****************************************************** if(rdim.eq.3) then do dim=1,3 write(911,*)amat(:,dim) - enddo + enddo elseif(rdim.eq.4)then do dim=1,4 write(911,'(4f14.8)')amat(:,dim) - enddo + enddo elseif(rdim.eq.5)then do dim=1,5 write(911,'(5f14.8)')amat(:,dim) - enddo + enddo elseif(rdim.eq.6)then do dim=1,6 write(911,'(6f13.7)')amat(:,dim) - enddo + enddo endif write(911,*)"end unit_cell_cart" write(911,*) @@ -477,15 +477,15 @@ c****************************************************** at=nint(zatom(iter)) do i=1,neq(iter) nn=nn+1 - if(rdim.eq.3) write(911,*)namat(at),taual(:,nn) + if(rdim.eq.3) write(911,*)namat(at),taual(:,nn) if(rdim.eq.4) write(911,'(1x,a2,2x,4f12.6)') > namat(at),taual(:,nn) if(rdim.eq.5) write(911,'(1x,a2,2x,5f12.6)') > namat(at),taual(:,nn) if(rdim.eq.6) write(911,'(1x,a2,2x,6f12.6)') > namat(at),taual(:,nn) - enddo - enddo + enddo + enddo write(911,*)"end atoms_frac" write(911,*) @@ -543,7 +543,7 @@ c****************************************************** write(911,*) write(911,*)"wvfn_formatted=.true." - + close(911) diff --git a/wannier/wannier.F90 b/wannier/wannier.F90 index 650276e9..7a0beeaa 100644 --- a/wannier/wannier.F90 +++ b/wannier/wannier.F90 @@ -8,7 +8,7 @@ MODULE m_wannier USE m_juDFT CONTAINS SUBROUTINE wannier(& - DIMENSION,mpi,input,kpts,sym,atoms,stars,vacuum,sphhar,oneD,& + mpi,input,kpts,sym,atoms,stars,vacuum,sphhar,oneD,& wann,noco,cell,enpara,banddos,sliceplot,vTot,results,& eig_idList,l_real,nkpt) !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc @@ -114,7 +114,7 @@ CONTAINS INTEGER stt(MPI_STATUS_SIZE) #endif - TYPE(t_dimension), INTENT(IN) :: DIMENSION + TYPE(t_mpi), INTENT(IN) :: mpi TYPE(t_input), INTENT(IN) :: input TYPE(t_kpts), INTENT(IN) :: kpts @@ -144,11 +144,11 @@ CONTAINS INTEGER :: jsp_start,jsp_end,nrec,nrec1,nrec_b,nbands,nbands_b INTEGER :: nodeu,noded,n_size,na,n_rank,nbnd,numbands INTEGER :: i1,i2,i3,in,lda - INTEGER :: n_bands(0:DIMENSION%neigd),nslibd,nslibd_b + INTEGER :: n_bands(0:input%neig),nslibd,nslibd_b CHARACTER(len=8) :: dop,iop,name(10) REAL :: wronk,phase COMPLEX :: c_phase - REAL :: eig(DIMENSION%neigd),eig_b(DIMENSION%neigd) + REAL :: eig(input%neig),eig_b(input%neig) REAL :: efermi LOGICAL :: l_p0,l_bkpts,l_proj,l_amn,l_mmn !!! energy window boundaries @@ -243,7 +243,7 @@ CONTAINS REAL :: theta_i, thetab_i, phi_i, phib_i REAL :: dalph,db1,db2,coph,siph REAL :: zero_taual(3,atoms%nat),bqpt(3) - REAL :: eig_qb(DIMENSION%neigd) + REAL :: eig_qb(input%neig) REAL,ALLOCATABLE :: qdiff(:,:), we_qb(:) REAL,ALLOCATABLE :: energies(:,:,:) @@ -299,7 +299,7 @@ CONTAINS !---- noco%l_noco,noco%l_soc, ! > atoms%ntype,atoms%neq,atoms%nlotot, ! > kveclo,jspin, - ! > oper,sym%nop,sym%mrot,DIMENSION%nvd,nv, + ! > oper,sym%nop,sym%mrot,lapw%dim_nvd(),nv, ! > shiftkpt(:,ikpt), ! > sym%tau, ! x lapw%bkpt,k1(:,:),k2(:,:),k3(:,:), @@ -1280,19 +1280,19 @@ CONTAINS #ifdef CPP_TOPO IF(wann%l_surfcurr)THEN ! call wann_surfcurr_int( - ! > DIMENSION%nv2d,jspin,oneD%odi,oneD%ods,stars%ng3,vacuum%nmzxyd,stars%ng2,sphhar%ntypsd, + ! > lapw%dim_nv2d(),jspin,oneD%odi,oneD%ods,stars%ng3,vacuum%nmzxyd,stars%ng2,sphhar%ntypsd, ! > atoms%ntype,atoms%lmaxd,atoms%jmtd,atoms%ntype,atoms%nat,vacuum%nmzd,atoms%neq,stars%ng3,vacuum%nvac, ! > vacuum%nmz,vacuum%nmzxy,stars%ng2,sym%nop,sym%nop2,cell%volint,input%film,sliceplot%slice,sym%symor, ! > sym%invs,sym%invs2,cell%z1,vacuum%delz,sym%ngopr,sym%ntypsy,atoms%jri,atoms%pos,atoms%zatom, ! > atoms%lmax,sym%mrot,sym%tau,atoms%rmsh,sym%invtab,cell%amat,cell%bmat,cell%bbmat,ikpt,sliceplot%nnne,sliceplot%kk, - ! > DIMENSION%nvd,atoms%nlod,atoms%llod,nv(jspin),lmd,lapw%bkpt,cell%omtil,atoms%nlo,atoms%llo, + ! > lapw%dim_nvd(),atoms%nlod,atoms%llod,nv(jspin),lmd,lapw%bkpt,cell%omtil,atoms%nlo,atoms%llo, ! > k1(:,jspin),k2(:,jspin),k3(:,jspin),evac(:,jspin), ! > vz(:,:,jspin2), - ! > nslibd,DIMENSION%nbasfcn,DIMENSION%neigd,ff,gg,flo,acof,bcof,ccof,z, + ! > nslibd,lapw%dim_nbasfcn(),input%neig,ff,gg,flo,acof,bcof,ccof,z, ! > surfcurr(:,:,:,ikpt)) CALL wann_surfcurr_int2(& - DIMENSION%nv2d,jspin,oneD%odi,oneD%ods,stars%ng3,& + lapw%dim_nv2d(),jspin,oneD%odi,oneD%ods,stars%ng3,& vacuum%nmzxyd,& stars%ng2,sphhar%ntypsd,atoms%ntype,atoms%lmaxd,& atoms%jmtd,atoms%ntype,atoms%nat,vacuum%nmzd,& @@ -1303,9 +1303,9 @@ CONTAINS sym%ntypsy,atoms%jri,atoms%pos,atoms%taual,& atoms%zatom,atoms%rmt,atoms%lmax,sym%mrot,sym%tau,& atoms%rmsh,sym%invtab,cell%amat,cell%bmat,cell%bbmat,& - ikpt,DIMENSION%nvd,lapw%nv(jspin),lapw%bkpt,cell%omtil,& + ikpt,lapw%dim_nvd(),lapw%nv(jspin),lapw%bkpt,cell%omtil,& lapw%k1(:,jspin),lapw%k2(:,jspin),lapw%k3(:,jspin),& - nslibd,DIMENSION%nbasfcn,DIMENSION%neigd,z,& + nslibd,lapw%dim_nbasfcn(),input%neig,z,& dirfacs,& surfcurr(:,:,:,ikpt)) @@ -1345,12 +1345,12 @@ CONTAINS nablamat(:,:,:,ikpt)) IF(input%film.AND..NOT.oneD%odi%d1)THEN CALL wann_nabla_vac(& - cell%z1,vacuum%nmzd,DIMENSION%nv2d,& + cell%z1,vacuum%nmzd,lapw%dim_nv2d(),& stars%mx1,stars%mx2,stars%mx3,& stars%ng3,vacuum%nvac,stars%ig,vacuum%nmz,vacuum%delz,& stars%ig2,cell%area,cell%bmat,cell%bbmat,enpara%evac0(:,jspin),& lapw%bkpt,vz(:,:,jspin2),nslibd,jspin,lapw%k1,lapw%k2,lapw%k3,& - wannierspin,DIMENSION%nvd,DIMENSION%nbasfcn,DIMENSION%neigd,z,nv,& + wannierspin,lapw%dim_nvd(),lapw%dim_nbasfcn(),input%neig,z,nv,& cell%omtil,& nablamat(:,:,:,ikpt)) ENDIF @@ -1414,9 +1414,9 @@ CONTAINS CALL wann_mmkb_int(& cmplx_1,addnoco,addnoco,& - DIMENSION%nvd,stars%mx1,stars%mx2,stars%mx3,& + lapw%dim_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,nslibd,& + lapw%nv(jspin),input%neig,lapw%dim_nbasfcn(),zMat,nslibd,& lapw%k1(:,jspin),lapw%k2(:,jspin),lapw%k3(:,jspin),& lapw%nv(jspin),zMat,nslibd,& nbnd,& @@ -1439,26 +1439,26 @@ CONTAINS CALL wann_mmk0_vac(& noco%l_noco,atoms%nlotot,qpt_i,& - cell%z1,vacuum%nmzd,DIMENSION%nv2d,& + cell%z1,vacuum%nmzd,lapw%dim_nv2d(),& stars%mx1,stars%mx2,stars%mx3,& stars%ng3,vacuum%nvac,stars%ig,vacuum%nmz,vacuum%delz,& stars%ig2,cell%area,cell%bmat,& cell%bbmat,enpara%evac0(:,jspin),lapw%bkpt,vz(:,:,jspin2),& - nslibd,jspin,lapw%k1,lapw%k2,lapw%k3,wannierspin,DIMENSION%nvd,& - DIMENSION%nbasfcn,DIMENSION%neigd,zMat,lapw%nv,cell%omtil,& + nslibd,jspin,lapw%k1,lapw%k2,lapw%k3,wannierspin,lapw%dim_nvd(),& + lapw%dim_nbasfcn(),input%neig,zMat,lapw%nv,cell%omtil,& mmn(:,:,ikpt)) ELSEIF (oneD%odi%d1) THEN CALL wann_mmk0_od_vac(& - DIMENSION, oneD, vacuum, stars, cell,& + oneD, vacuum, stars, cell,& noco%l_noco,atoms%nlotot,& - cell%z1,vacuum%nmzxyd,vacuum%nmzd,DIMENSION%nv2d,& + cell%z1,vacuum%nmzxyd,vacuum%nmzd,lapw%dim_nv2d(),& stars%mx1,stars%mx2,stars%mx3,stars%ng2,stars%ng3,& stars%ig,vacuum%nmzxy,vacuum%nmz,vacuum%delz,stars%ig2,& oneD%odi%n2d,cell%bbmat,enpara%evac0(1,jspin),lapw%bkpt,oneD%odi%M,& oneD%odi%mb,vz(:,1,jspin2),oneD%odi,& - nslibd,jspin,lapw%k1,lapw%k2,lapw%k3,wannierspin,DIMENSION%nvd,& - cell%area,DIMENSION%nbasfcn,DIMENSION%neigd,zMat,lapw%nv,& + nslibd,jspin,lapw%k1,lapw%k2,lapw%k3,wannierspin,lapw%dim_nvd(),& + cell%area,lapw%dim_nbasfcn(),input%neig,zMat,lapw%nv,& stars%sk2,stars%phi2,cell%omtil,qpt_i,& mmn(:,:,ikpt)) @@ -1505,7 +1505,7 @@ CONTAINS !*************************************************************** IF (wann%l_matrixmmn .AND.& (.NOT.wann%l_skipkov)) THEN ! vanderbilt procedure Mmn matrix - ALLOCATE ( we_b(DIMENSION%neigd) ) + ALLOCATE ( we_b(input%neig) ) !!! the cycle by the nearest neighbors (nntot) for each kpoint @@ -1524,13 +1524,13 @@ CONTAINS n_start=1 - n_end=DIMENSION%neigd + n_end=input%neig call lapw_b%init(input,noco,kpts,atoms,sym,kptibz_b,cell,(sym%zrfs.AND.(SUM(ABS(kpts%bk(3,:kpts%nkpt))).LT.1e-9).AND..NOT.noco%l_noco.and.mpi%n_size==1),mpi) CALL cdn_read(& eig_id,& - DIMENSION%nvd,input%jspins,mpi%irank,mpi%isize, &!wannierspin instead of DIMENSION%jspd?& - kptibz_b,jspin,DIMENSION%nbasfcn,& - noco%l_ss,noco%l_noco,DIMENSION%neigd,n_start,n_end,& + lapw%dim_nvd(),input%jspins,mpi%irank,mpi%isize, &!wannierspin instead of DIMENSION%jspd?& + kptibz_b,jspin,lapw%dim_nbasfcn(),& + noco%l_ss,noco%l_noco,input%neig,n_start,n_end,& nbands_b,eigg,zzMat) @@ -1566,7 +1566,7 @@ CONTAINS ! > noco%l_noco,noco%l_soc, ! > atoms%ntype,atoms%neq,atoms%nlotot, ! > kveclo_b,jspin, - ! > oper_b,sym%nop,sym%mrot,DIMENSION%nvd, + ! > oper_b,sym%nop,sym%mrot,lapw%dim_nvd(), ! > nv_b, ! > shiftkpt(:,bpt(ikpt_b,ikpt)), ! > sym%tau, @@ -1622,9 +1622,9 @@ CONTAINS CALL wann_mmkb_int(& cmplx_1,addnoco,addnoco2,& - DIMENSION%nvd,stars%mx1,stars%mx2,stars%mx3,& + lapw%dim_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,nslibd,& + lapw%nv(jspin),input%neig,lapw%dim_nbasfcn(),zMat,nslibd,& lapw_b%k1(:,jspin),lapw_b%k2(:,jspin),lapw_b%k3(:,jspin),& lapw_b%nv(jspin),zMat_b,nslibd_b,& nbnd,& @@ -1654,7 +1654,7 @@ CONTAINS CALL wann_mmkb_vac(& cmplx_1,noco%l_noco,atoms%nlotot,qpt_i,& - nbnd,cell%z1,vacuum%nmzd,DIMENSION%nv2d,& + nbnd,cell%z1,vacuum%nmzd,lapw%dim_nv2d(),& stars%mx1,stars%mx2,stars%mx3,& stars%ng3,vacuum%nvac,stars%ig,vacuum%nmz,& vacuum%delz,stars%ig2,cell%area,cell%bmat,& @@ -1663,17 +1663,17 @@ CONTAINS lapw%bkpt,lapw_b%bkpt,vz(:,:,jspin2),vz(:,:,jspin2_b),& nslibd,nslibd_b,jspin,jspin_b,& lapw%k1,lapw%k2,lapw%k3,lapw_b%k1,lapw_b%k2,lapw_b%k3,& - wannierspin,DIMENSION%nvd,& - DIMENSION%nbasfcn,DIMENSION%neigd,zMat,zMat_b,& + wannierspin,lapw%dim_nvd(),& + lapw%dim_nbasfcn(),input%neig,zMat,zMat_b,& lapw%nv,lapw_b%nv,cell%omtil,& gb(:,ikpt_b,ikpt),& mmnk(:,:,ikpt_b,ikpt)) ELSEIF (oneD%odi%d1) THEN CALL wann_mmkb_od_vac(& - DIMENSION,oneD,vacuum,stars,cell,& + oneD,vacuum,stars,cell,& cmplx_1,noco%l_noco,atoms%nlotot,& - nbnd,cell%z1,vacuum%nmzxyd,vacuum%nmzd,DIMENSION%nv2d,& + nbnd,cell%z1,vacuum%nmzxyd,vacuum%nmzd,lapw%dim_nv2d(),& stars%mx1,stars%mx2,stars%mx3,stars%ng2,stars%ng3,& stars%ig,vacuum%nmzxy,& vacuum%nmz,vacuum%delz,stars%ig2,oneD%odi%n2d,& @@ -1681,8 +1681,8 @@ CONTAINS lapw%bkpt,lapw_b%bkpt,oneD%odi%M,oneD%odi%mb,& vz(:,1,jspin2),vz(:,1,jspin2_b),oneD%odi,& nslibd,nslibd_b,jspin,jspin_b,lapw%k1,lapw%k2,lapw%k3,lapw_b%k1,lapw_b%k2,lapw_b%k3,& - wannierspin,DIMENSION%nvd,cell%area,DIMENSION%nbasfcn,& - DIMENSION%neigd,& + wannierspin,lapw%dim_nvd(),cell%area,lapw%dim_nbasfcn(),& + input%neig,& zMat,zMat_b,lapw%nv,lapw_b%nv,stars%sk2,stars%phi2,cell%omtil,& gb(:,ikpt_b,ikpt),qpt_i,& .FALSE.,1,& @@ -1709,7 +1709,7 @@ CONTAINS !*******************************************c ! START Q-NEIGHBOR LOOP c !*******************************************c - ALLOCATE ( we_qb(DIMENSION%neigd) ) + ALLOCATE ( we_qb(input%neig) ) DO iqpt_b=1,nntot_q IF(.NOT.l_gwf) EXIT ! old functionality @@ -1736,7 +1736,7 @@ CONTAINS IF (wann%l_bzsym) qptibz_b=irreduc_q(qptibz_b) n_start=1 - n_end=DIMENSION%neigd + n_end=input%neig ! read in diagonalization information from corresponding ! eig file to q-point iqpt_b at a given k-point ikpt. @@ -1747,9 +1747,9 @@ CONTAINS CALL lapw_qb%init(input,noco,kpts,atoms,sym,kptibz,cell,(sym%zrfs.AND.(SUM(ABS(kpts%bk(3,:kpts%nkpt))).LT.1e-9).AND..NOT.noco%l_noco.and.mpi%n_size==1),mpi) CALL cdn_read(& innerEig_idList(iqpt_b),& - DIMENSION%nvd,input%jspins,mpi%irank,mpi%isize, &!wannierspin instead of DIMENSION%jspd? !kptibz_b2?& - kptibz,jspin_b,DIMENSION%nbasfcn,& - noco%l_ss,noco%l_noco,DIMENSION%neigd,n_start,& + lapw%dim_nvd(),input%jspins,mpi%irank,mpi%isize, &!wannierspin instead of DIMENSION%jspd? !kptibz_b2?& + kptibz,jspin_b,lapw%dim_nbasfcn(),& + noco%l_ss,noco%l_noco,input%neig,n_start,& n_end,& nbands_qb,eigg, & zzMat) @@ -1952,9 +1952,9 @@ CONTAINS ! and lattice vectors G(k,q) (k1...) and G(k,q+b) (k1_qb...) IF(wann%l_sgwf) CALL wann_mmkb_int(& interchi,addnoco,addnoco2,& - DIMENSION%nvd,stars%mx1,stars%mx2,stars%mx3,& + lapw%dim_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,nslibd,& + lapw%nv(jspin),input%neig,lapw%dim_nbasfcn(),zMat,nslibd,& lapw_qb%k1(:,jspin_b),lapw_qb%k2(:,jspin_b),lapw_qb%k3(:,jspin_b),& lapw_qb%nv(jspin_b),zMat_qb,nslibd_qb,& nbnd,& @@ -1963,9 +1963,9 @@ CONTAINS mmnk_q(:,:,iqpt_b,ikpt)) IF(wann%l_socgwf) CALL wann_mmkb_int(& interchi,addnoco,addnoco2,& - DIMENSION%nvd,stars%mx1,stars%mx2,stars%mx3,& + lapw%dim_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,nslibd,& + lapw%nv(jspin),input%neig,lapw%dim_nbasfcn(),zMat,nslibd,& lapw_qb%k1(:,jspin_b),lapw_qb%k2(:,jspin_b),lapw_qb%k3(:,jspin_b),& lapw_qb%nv(jspin_b),zMat_qb,nslibd_qb,& nbnd,& @@ -1977,7 +1977,7 @@ CONTAINS IF (input%film .AND. .NOT.oneD%odi%d1) THEN IF(wann%l_sgwf) CALL wann_mmkb_vac(& vacchi,noco%l_noco,atoms%nlotot,sign_q*2.*lapw%bkpt,& - nbnd,cell%z1,vacuum%nmzd,DIMENSION%nv2d,& + nbnd,cell%z1,vacuum%nmzd,lapw%dim_nv2d(),& stars%mx1,stars%mx2,stars%mx3,& stars%ng3,vacuum%nvac,stars%ig,vacuum%nmz,& vacuum%delz,stars%ig2,cell%area,cell%bmat,& @@ -1987,14 +1987,14 @@ CONTAINS vz(:,:,jspin2),vz(:,:,jspin2_b),& nslibd,nslibd_qb,jspin,jspin_b,& lapw%k1,lapw%k2,lapw%k3,lapw_qb%k1,lapw_qb%k2,lapw_qb%k3,& - wannierspin,DIMENSION%nvd,& - DIMENSION%nbasfcn,DIMENSION%neigd,zMat,zMat_qb,lapw%nv,& + wannierspin,lapw%dim_nvd(),& + lapw%dim_nbasfcn(),input%neig,zMat,zMat_qb,lapw%nv,& lapw_qb%nv,cell%omtil,& sign_q*gb_q(:,iqpt_b,iqpt)/2,& mmnk_q(:,:,iqpt_b,ikpt)) IF(wann%l_socgwf) CALL wann_mmkb_vac(& vacchi,noco%l_noco,atoms%nlotot,qpt_i,& - nbnd,cell%z1,vacuum%nmzd,DIMENSION%nv2d,& + nbnd,cell%z1,vacuum%nmzd,lapw%dim_nv2d(),& stars%mx1,stars%mx2,stars%mx3,& stars%ng3,vacuum%nvac,stars%ig,vacuum%nmz,& vacuum%delz,stars%ig2,cell%area,cell%bmat,& @@ -2003,8 +2003,8 @@ CONTAINS vz(:,:,jspin2),vz(:,:,jspin2_b),& nslibd,nslibd_qb,jspin,jspin_b,& lapw%k1,lapw%k2,lapw%k3,lapw_qb%k1,lapw_qb%k2,lapw_qb%k3,& - wannierspin,DIMENSION%nvd,& - DIMENSION%nbasfcn,DIMENSION%neigd,zMat,zMat_qb,lapw%nv,& + wannierspin,lapw%dim_nvd(),& + lapw%dim_nbasfcn(),input%neig,zMat,zMat_qb,lapw%nv,& lapw_qb%nv,cell%omtil,& (/ 0, 0, 0 /),& mmnk_q(:,:,iqpt_b,ikpt)) @@ -2017,9 +2017,9 @@ CONTAINS ! be provided. ELSEIF (oneD%odi%d1) THEN IF(wann%l_sgwf) CALL wann_mmkb_od_vac(& - DIMENSION,oneD,vacuum,stars,cell,& + oneD,vacuum,stars,cell,& vacchi,noco%l_noco,atoms%nlotot, & - nbnd,cell%z1,vacuum%nmzxyd,vacuum%nmzd,DIMENSION%nv2d,& + nbnd,cell%z1,vacuum%nmzxyd,vacuum%nmzd,lapw%dim_nv2d(),& stars%mx1,stars%mx2,stars%mx3,stars%ng2,stars%ng3,& stars%ig,vacuum%nmzxy,& vacuum%nmz,vacuum%delz,stars%ig2,oneD%odi%n2d,& @@ -2029,16 +2029,16 @@ CONTAINS vz(:,1,jspin2),vz(:,1,jspin2_b),oneD%odi,& nslibd,nslibd_qb,jspin,jspin_b,& lapw%k1,lapw%k2,lapw%k3,lapw_qb%k1,lapw_qb%k2,lapw_qb%k3,& - wannierspin,DIMENSION%nvd,cell%area,DIMENSION%nbasfcn,& - DIMENSION%neigd,zMat,zMat_qb,lapw%nv,lapw_qb%nv,stars%sk2,& + wannierspin,lapw%dim_nvd(),cell%area,lapw%dim_nbasfcn(),& + input%neig,zMat,zMat_qb,lapw%nv,lapw_qb%nv,stars%sk2,& stars%phi2,cell%omtil,& sign_q*gb_q(:,iqpt_b,iqpt)/2,sign_q*2.*lapw%bkpt, & .TRUE.,sign_q,& mmnk_q(:,:,iqpt_b,ikpt)) IF(wann%l_socgwf) CALL wann_mmkb_od_vac( & - DIMENSION,oneD,vacuum,stars,cell,& + oneD,vacuum,stars,cell,& vacchi,noco%l_noco,atoms%nlotot,& - nbnd,cell%z1,vacuum%nmzxyd,vacuum%nmzd,DIMENSION%nv2d,& + nbnd,cell%z1,vacuum%nmzxyd,vacuum%nmzd,lapw%dim_nv2d(),& stars%mx1,stars%mx2,stars%mx3,stars%ng2,stars%ng3,& stars%ig,vacuum%nmzxy,& vacuum%nmz,vacuum%delz,stars%ig2,oneD%odi%n2d,& @@ -2048,8 +2048,8 @@ CONTAINS vz(:,1,jspin2),vz(:,1,jspin2_b),oneD%odi,& nslibd,nslibd_qb,jspin,jspin_b,& lapw%k1,lapw%k2,lapw%k3,lapw_qb%k1,lapw_qb%k2,lapw_qb%k3,& - wannierspin,DIMENSION%nvd,cell%area,DIMENSION%nbasfcn,& - DIMENSION%neigd,zMat,zMat_qb,lapw%nv,lapw_qb%nv,stars%sk2,& + wannierspin,lapw%dim_nvd(),cell%area,lapw%dim_nbasfcn(),& + input%neig,zMat,zMat_qb,lapw%nv,lapw_qb%nv,stars%sk2,& stars%phi2,cell%omtil,& (/ 0, 0, 0 /),qpt_i, & .FALSE.,1,& @@ -2089,8 +2089,8 @@ CONTAINS WRITE (6,*) 'we(nnne)=',we(sliceplot%nnne) CALL wann_plot(& - DIMENSION,oneD,vacuum,stars,cell,atoms,& - DIMENSION%nv2d,jspin,oneD%odi,oneD%ods,stars%ng3,& + oneD,vacuum,stars,cell,atoms,& + lapw%dim_nv2d(),jspin,oneD%odi,oneD%ods,stars%ng3,& vacuum%nmzxyd,& stars%ng2,sphhar%ntypsd,atoms%ntype,atoms%lmaxd,& atoms%jmtd,atoms%ntype,atoms%nat,vacuum%nmzd,atoms%neq,& @@ -2100,11 +2100,11 @@ CONTAINS sym%ngopr,sym%ntypsy,atoms%jri,atoms%pos,atoms%zatom,& atoms%lmax,sym%mrot,sym%tau,atoms%rmsh,sym%invtab,& cell%amat,cell%bmat,cell%bbmat,ikpt,sliceplot%nnne,& - sliceplot%kk,DIMENSION%nvd,atoms%nlod,atoms%llod,& + sliceplot%kk,lapw%dim_nvd(),atoms%nlod,atoms%llod,& lapw%nv(jspin),lmd,lapw%bkpt,cell%omtil,atoms%nlo,atoms%llo,& lapw%k1(:,jspin),lapw%k2(:,jspin),lapw%k3(:,jspin),enpara%evac0(:,jspin),& vz(:,:,jspin2),& - nslibd,DIMENSION%nbasfcn,DIMENSION%neigd,& + nslibd,lapw%dim_nbasfcn(),input%neig,& ff(:,:,:,:,jspin),& gg(:,:,:,:,jspin),flo,acof,bcof,ccof,zMat,& stars%mx1,stars%mx2,stars%mx3,stars%ig,stars%ig2,& @@ -2116,8 +2116,8 @@ CONTAINS ELSE ! not sliceplot%slice CALL wann_plot(& - DIMENSION,oneD,vacuum,stars,cell,atoms,& - DIMENSION%nv2d,jspin,oneD%odi,oneD%ods,stars%ng3,& + oneD,vacuum,stars,cell,atoms,& + lapw%dim_nv2d(),jspin,oneD%odi,oneD%ods,stars%ng3,& vacuum%nmzxyd,& stars%ng2,sphhar%ntypsd,atoms%ntype,atoms%lmaxd,& atoms%jmtd,atoms%ntype,atoms%nat,vacuum%nmzd,atoms%neq,& @@ -2127,11 +2127,11 @@ CONTAINS sym%ngopr,sym%ntypsy,atoms%jri,atoms%pos,atoms%zatom,& atoms%lmax,sym%mrot,sym%tau,atoms%rmsh,sym%invtab,& cell%amat,cell%bmat,cell%bbmat,ikpt,sliceplot%nnne,& - sliceplot%kk,DIMENSION%nvd,atoms%nlod,atoms%llod,& + sliceplot%kk,lapw%dim_nvd(),atoms%nlod,atoms%llod,& lapw%nv(jspin),lmd,lapw%bkpt,cell%omtil,atoms%nlo,atoms%llo,& lapw%k1(:,jspin),lapw%k2(:,jspin),lapw%k3(:,jspin),enpara%evac0(:,jspin),& vz(:,:,jspin2),& - nslibd,DIMENSION%nbasfcn,DIMENSION%neigd,& + nslibd,lapw%dim_nbasfcn(),input%neig,& ff(:,:,:,:,jspin),& gg(:,:,:,:,jspin),flo,acof,bcof,ccof,zMat,& stars%mx1,stars%mx2,stars%mx3,stars%ig,stars%ig2,& @@ -2501,7 +2501,7 @@ CONTAINS CALL timeStop("Wannier total") CALL wann_postproc(& - DIMENSION,stars,vacuum,atoms,sphhar,input,kpts,sym,mpi,& + stars,vacuum,atoms,sphhar,input,kpts,sym,mpi,& lapw,oneD,noco,cell,vTot,enpara,sliceplot,eig_id,l_real,& !eig_id is used here after closing the files?!& wann,fullnkpts,l_proj,results%ef,wann%l_sgwf,fullnqpts) diff --git a/xc-pot/metagga.F90 b/xc-pot/metagga.F90 index a9a73e93..40af0123 100644 --- a/xc-pot/metagga.F90 +++ b/xc-pot/metagga.F90 @@ -46,7 +46,7 @@ CONTAINS SUBROUTINE calc_EnergyDen(eig_id, mpi, kpts, noco, input, banddos, cell, atoms, enpara, stars, & - vacuum, DIMENSION, sphhar, sym, vTot, oneD, results, EnergyDen) + vacuum, sphhar, sym, vTot, oneD, results, EnergyDen) ! calculates the energy density ! EnergyDen = \sum_i n_i(r) \varepsilon_i ! where n_i(r) is the one-particle density @@ -76,7 +76,7 @@ CONTAINS TYPE(t_enpara), INTENT(in) :: enpara TYPE(t_stars), INTENT(in) :: stars TYPE(t_vacuum), INTENT(in) :: vacuum - TYPE(t_dimension), INTENT(in) :: DIMENSION + TYPE(t_sphhar), INTENT(in) :: sphhar TYPE(t_sym), INTENT(in) :: sym TYPE(t_potden), INTENT(in) :: vTot @@ -96,7 +96,7 @@ CONTAINS CALL regCharges%init(input, atoms) - CALL dos%init(DIMENSION%neigd,input,atoms,kpts, vacuum) + CALL dos%init(input%neig,input,atoms,kpts, vacuum) CALL moments%init(input, atoms) tmp_results = results @@ -108,7 +108,7 @@ CONTAINS CALL calc_EnergyDen_auxillary_weights(eig_id, kpts, jspin, cdnvalJob%weights) CALL cdnval(eig_id, mpi, kpts, jspin, noco, input, banddos, cell, atoms, & - enpara, stars, vacuum, DIMENSION, sphhar, sym, vTot, oneD, cdnvalJob, & + enpara, stars, vacuum, sphhar, sym, vTot, oneD, cdnvalJob, & EnergyDen, regCharges, dos, tmp_results, moments) ENDDO -- GitLab