Skip to content

GitLab

fleur
fleur
Commit ea759903 authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files
Options

Changes to Wannier part to make it compile (1. commit out of ??)

parent 758aca08
Hide whitespace changes
Inline Side-by-side
Showing with 72 additions and 72 deletions
wannier/wann_2dvacabcof.F
View file @ ea759903
......@@ -16,7 +16,6 @@ c********************************************************
>nvd,k1,k2,k3,evac,bbmat,delz,bmat,nbasfcn,neigd,z,
<ac,bc,u,ue)
use m_dotir
implicit none
integer,intent(in)::nv2d
integer,intent(in)::nslibd
......@@ -88,7 +87,7 @@ c********************************************************
v(1) = bkpt(1) + kvac1(ik)
v(2) = bkpt(2) + kvac2(ik)
v(3) = 0.
ev = evacp - 0.5*dotirp(v,v,bbmat)
ev = evacp - 0.5*dot_product(matmul(v,bbmat),v)
call vacuz(ev,vz(1,ivac),vz0(ivac),nmz,delz,t(ik),
+ dt(ik),
+ u(1,ik,ivac))
......
wannier/wann_dipole.f
View file @ ea759903
......@@ -139,7 +139,8 @@ c*************************************************
open (203,file=trim(filename),status='old')
rewind (203)
else
CALL juDFT_error("no proj/proj.1/proj.2",calledby ="wann_dipole")
CALL juDFT_error("no proj/proj.1/proj.2",
+ calledby ="wann_dipole")
endif
read(203,*)num_wann
close(203)
......
wannier/wann_get_kpts.f
View file @ ea759903
......@@ -36,7 +36,7 @@ c********************************************************
if(l_readkpts)then
IF(SIZE(kpoints,1)/=3) CALL juDFT_error("wann_get_kpts: 1"
+ ,calledby ="wann_get_kpts")
IF(SIZE(kpoints,2)/=nkpts) CALL juDFT_error("wann_get_kpts: 2"
IF(SIZE(kpoints,2)/=nkpts)CALL juDFT_error("wann_get_kpts:2"
+ ,calledby ="wann_get_kpts")
do iter=1,nkpts
read(987,*)kpoints(:,iter)
......@@ -52,7 +52,7 @@ c********************************************************
if(l_readkpts)then
IF(SIZE(kpoints,1)/=3) CALL juDFT_error("wann_get_kpts: 1"
+ ,calledby ="wann_get_kpts")
IF(SIZE(kpoints,2)/=nkpts) CALL juDFT_error("wann_get_kpts: 2"
IF(SIZE(kpoints,2)/=nkpts)CALL juDFT_error("wann_get_kpts:2"
+ ,calledby ="wann_get_kpts")
do iter=1,nkpts
read(987,*)kpoints(:,iter)
......
wannier/wann_kpointgen.f
View file @ ea759903
......@@ -40,7 +40,7 @@ c***********************************************************
elseif(dim==1)then
print*,"Create one-dimensional k-point set."
else
CALL juDFT_error("unknown dimension",calledby ="wann_kpointgen")
CALL juDFT_error("unknown dimension",calledby="wann_kpointgen")
endif
print*,"Specify the number of k-point steps"
print*,"for each direction."
......@@ -104,7 +104,7 @@ c***********************************************************
integer,intent(in)::nu
integer k,nnu
nnu=nu
IF(nnu==0) CALL juDFT_error("nnu.eq.0",calledby ="wann_kpointgen")
IF(nnu==0) CALL juDFT_error("nnu.eq.0",calledby="wann_kpointgen")
do k=1,3
if(nnu.eq.1)exit
if(mod(nnu,5).ne.0)exit
......
wannier/wann_lapw_int_plot.f
View file @ ea759903
......@@ -14,8 +14,7 @@ c***************************************************************
CONTAINS
SUBROUTINE wann_lapw_int_plot(point,bmat,unigrid,wannint,
< xdnout)
use m_cotra, only: cotra1
use m_constants, only: pimach
use m_constants
implicit none
real,intent(in)::point(3)
real,intent(in)::bmat(3,3)
......@@ -31,7 +30,7 @@ c***************************************************************
integer pw1,pw2,pw3
tpi=2*pimach()
call cotra1(point,xiiu,bmat)
xiiu=matmul(bmat,point)/tpi_const
......
wannier/wann_pauli_rs.f
View file @ ea759903
......@@ -118,7 +118,7 @@ c*****************************************************
open (203,file=trim(filename),status='old')
rewind (203)
else
CALL fleur_err("no proj/proj.1/proj.2",calledby
CALL judft_error("no proj/proj.1/proj.2",calledby
+ ="wann_pauli_rs")
endif
read (203,*) num_wann,num_bands
......
wannier/wann_plot_from_lapw.f
View file @ ea759903
......@@ -21,7 +21,7 @@ c****************************************************************
> lmax,mrot,tau,rmsh,invtab,amat,bmat,bbmat,nnne,kk,
> nlod,llod,lmd,omtil,nlo,llo)
USE m_od_types, ONLY : od_inp, od_sym
USE m_types, ONLY : od_inp, od_sym
USE m_xsf_io
USE m_wann_lapw_int_plot
USE m_wann_lapw_sph_plot
......@@ -227,26 +227,30 @@ c..loop by the wannierfunctions
write (name3,24) nbn,jspin
24 format (i3.3,'.absv.',i1,'.xsf')
OPEN(55,file=name1)
CALL xsf_WRITE_atoms(
> 55,film,odi%d1,amat,neq(:ntype),
> zatom(:ntype),pos)
OPEN(56,file=name2)
CALL xsf_WRITE_atoms(
> 56,film,odi%d1,amat,neq(:ntype),
> zatom(:ntype),pos)
OPEN(57,file=name3)
CALL xsf_WRITE_atoms(
> 57,film,odi%d1,amat,neq(:ntype),
> zatom(:ntype),pos)
CALL xsf_WRITE_header(55,twodim,filename,(vec1),
& (vec2),(vec3),zero
$ ,grid)
CALL xsf_WRITE_header(56,twodim,filename,(vec1),
& (vec2),(vec3),zero
$ ,grid)
CALL xsf_WRITE_header(57,twodim,filename,(vec1),
& (vec2),(vec3),zero
$ ,grid)
!#if 1==1
call judft_error("NOT INPLEMENTED")
c$$$#else
c$$$ CALL xsf_WRITE_atoms(
c$$$ > 55,film,odi%d1,amat,neq(:ntype),
c$$$ > zatom(:ntype),pos)
c$$$ OPEN(56,file=name2)
c$$$ CALL xsf_WRITE_atoms(
c$$$ > 56,film,odi%d1,amat,neq(:ntype),
c$$$ > zatom(:ntype),pos)
c$$$ OPEN(57,file=name3)
c$$$ CALL xsf_WRITE_atoms(
c$$$ > 57,film,odi%d1,amat,neq(:ntype),
c$$$ > zatom(:ntype),pos)
c$$$ CALL xsf_WRITE_header(55,twodim,filename,(vec1),
c$$$ & (vec2),(vec3),zero
c$$$ $ ,grid)
c$$$ CALL xsf_WRITE_header(56,twodim,filename,(vec1),
c$$$ & (vec2),(vec3),zero
c$$$ $ ,grid)
c$$$ CALL xsf_WRITE_header(57,twodim,filename,(vec1),
c$$$ & (vec2),(vec3),zero
c$$$ $ ,grid)
c$$$#endif
ELSE
WRITE (vandername,201) nbn,jspin
201 FORMAT (i5.5,'.',i1)
......
wannier/wann_plot_um_dat.F
View file @ ea759903
......@@ -30,16 +30,14 @@ c******************************************************************
use m_wann_rw_eig
use m_abcof
use m_wann_2dvacabcof
use m_dotir
use m_radfun
use m_radflo
use m_cdnread, only : cdn_read0
use m_od_types, only : od_inp, od_sym
use m_types, only : od_inp, od_sym
use m_loddop
use m_constants, only : pimach
use m_constants
use m_wann_real
use m_xsf_io
use m_cotra,only:cotra1
use m_wann_read_umatrix
use m_wann_kptsrotate
use m_wann_plot_vac
......@@ -194,8 +192,6 @@ c ..basis wavefunctions in the vacuum
real v(3),scale,ev
complex av,bv
real volume
c external dotirp !module now
c real dotirp
REAL :: s,const
COMPLEX :: xdnout,factor
INTEGER :: ii3,ix,iy,iz,nplo,nbn
......@@ -679,7 +675,7 @@ c**************************************************************************
point = zero+vec1*(ix+0.0)/(grid(1)-1)+vec2*(iy+0.0)
$ /(grid(2)-1)
IF (.NOT.twodim) point = point+vec3*(iz+0.0)/(grid(3)-1)
call cotra1(point,poinint,bmat)
poinint=matmul(bmat,point)/tpi_const
phas=tpi*(bkpt(1)*poinint(1)
+ +bkpt(2)*poinint(2)+bkpt(3)*poinint(3))
factor=cmplx(cos(phas),sin(phas))
......
wannier/wann_plot_vac.F
View file @ ea759903
......@@ -23,7 +23,6 @@ c***************************************************************
< value)
use m_constants, only : pimach
use m_dotir
implicit none
c .. scalar Arguments..
integer, intent (in) :: nmzd,nv2d,n3d,nslibd
......@@ -61,10 +60,6 @@ c ..local scalars..
c ..intrinsic functions..
intrinsic aimag,cmplx,conjg,real,sqrt
c.. external functions
external vacudz,vacuz
c real dotirp !module now
c external dotirp
allocate (kvac1(nv2d),kvac2(nv2d),map2(nvd))
......
wannier/wann_rad_twf.f
View file @ ea759903
......@@ -101,7 +101,7 @@ c**************************************
c..project onto local orbitals
c**************************************
elseif(rwf(nwf).eq.-6)then
IF(nlod<1) CALL juDFT_error("nlod.lt.1",calledby ="wann_rad_twf"
IF(nlod<1) CALL juDFT_error("nlod<1",calledby="wann_rad_twf"
+ )
do l=0,3
do j=1,jri(ntyp)
......@@ -109,7 +109,7 @@ c**************************************
enddo!j
enddo!l
elseif(rwf(nwf).eq.-7)then
IF(nlod<2) CALL juDFT_error("nlod.lt.2",calledby ="wann_rad_twf"
IF(nlod<2) CALL juDFT_error("nlod<2",calledby="wann_rad_twf"
+ )
do l=0,3
do j=1,jri(ntyp)
......@@ -117,7 +117,7 @@ c**************************************
enddo!j
enddo!l
elseif(rwf(nwf).eq.-8)then
IF(nlod<3) CALL juDFT_error("nlod.lt.3",calledby ="wann_rad_twf"
IF(nlod<3) CALL juDFT_error("nlod<3",calledby ="wann_rad_twf"
+ )
do l=0,3
do j=1,jri(ntyp)
......
wannier/wann_read_inp.f
View file @ ea759903
......@@ -5,6 +5,7 @@
!--------------------------------------------------------------------------------
module m_wann_read_inp
use m_judft
contains
subroutine wann_read_inp(
< l_p0,wann)
......@@ -289,7 +290,7 @@ c-----read the input file 'wann_inp'
backspace(916)
read(916,*,iostat=ios)task,version_real
if (ios /= 0)
& CALL fleur_err ("error reading wan90version",
& CALL judft_error("error reading wan90version",
& calledby="wann_read_inp")
if(abs(version_real-1.1).lt.1.e-9)then
wann%wan90version=1
......@@ -298,7 +299,7 @@ c-----read the input file 'wann_inp'
elseif(abs(version_real-2.0).lt.1.e-9)then
wann%wan90version=3
else
CALL fleur_err ("chosen w90 version unknown",
CALL judft_error ("chosen w90 version unknown",
& calledby="wann_read_inp")
endif
elseif(trim(task).eq.'atomlist')then
......@@ -306,14 +307,14 @@ c-----read the input file 'wann_inp'
backspace(916)
read(916,*,iostat=ios)task,wann%atomlist_num
if (ios /= 0)
& CALL fleur_err ("error reading atomlist_num",
& CALL judft_error ("error reading atomlist_num",
& calledby="wann_read_inp")
if(allocated(wann%atomlist))deallocate(wann%atomlist)
allocate(wann%atomlist(wann%atomlist_num))
backspace(916)
read(916,*,iostat=ios)task,wann%atomlist_num,wann%atomlist
if (ios /= 0)
& CALL fleur_err ("error reading atomlist",
& CALL judft_error ("error reading atomlist",
& calledby="wann_read_inp")
if(l_p0)write(6,*)"atomlist_num=",wann%atomlist_num
if(l_p0)write(6,*)"atomlist=",wann%atomlist
......@@ -322,7 +323,7 @@ c-----read the input file 'wann_inp'
backspace(916)
read(916,*,iostat=ios)task,wann%band_min(1),wann%band_max(1)
if (ios /= 0)
& CALL juDFT_error ("error reading byindex,band_min,band_max",
& CALL juDFT_error("error reading byindex,band_min,band_max",
& calledby="wann_read_inp")
if(l_p0)write(6,*)"band_min=",wann%band_min(1)
if(l_p0)write(6,*)"band_max=",wann%band_max(1)
......
wannier/wann_read_umatrix.F
View file @ ea759903
......@@ -172,7 +172,7 @@ c read in _um.dat (old version of wannier90)
c****************************************************************
l_umdat=.false.
inquire (file=spin12(jspin)//'_um.dat',exist=l_umdat)
IF(.NOT.l_umdat) CALL juDFT_error("where is your um_dat?",calledby
IF(.NOT.l_umdat) CALL juDFT_error("where is your um_dat?",calledby
+ ="wann_read_umatrix")
......@@ -181,7 +181,7 @@ c****************************************************************
read(111)header
read(111)tmp_omi
read(111) ntmp,num_kpts,num_nnmax
IF(ntmp/=num_wann) CALL fleur_err("mismatch in num_wann",calledby
IF(ntmp/=num_wann)CALL judft_error("mismatch in num_wann",calledby
+ ="wann_read_umatrix")
read(111)(((u_matrix_tmp(i,j,k),i=1,num_wann),j=1,num_wann),
......@@ -252,7 +252,7 @@ c*************************************************************
enddo
enddo
else
IF(num_bands/=num_wann) CALL juDFT_error("num_bands.ne.num_wann"
IF(num_bands/=num_wann) CALL juDFT_error("num_bands/=num_wann"
+ ,calledby ="wann_read_umatrix")
u_matrix(:,:,:)=u_matrix_tmp(:,:,:)
endif
......
wannier/wann_real.F
View file @ ea759903
......@@ -22,10 +22,9 @@ c ********************************************************
> nv,k1,k2,k3,lmd,nbasfcn,
< xdnout)
c
USE m_od_types, ONLY : od_inp, od_sym
USE m_cotra, ONLY : cotra0,cotra1
USE m_types, ONLY : od_inp, od_sym
USE m_ylm
USE m_constants, ONLY : pimach
USE m_constants
IMPLICIT NONE
c
C .. Scalar Arguments ..
......@@ -80,7 +79,7 @@ C ..
const = 1./(sqrt(omtil))
c..define the factor e^{-ikr}
CALL cotra1(p(1),rcc2,bmat)
rcc2=matmul(bmat,p)/tpi_const
arg = -tpi*( bkpt(1)*rcc2(1) + bkpt(2)*rcc2(2) + bkpt(3)*rcc2(3) )
arg1 = tpi*( bkpt(1)*rcc2(1) + bkpt(2)*rcc2(2) + bkpt(3)*rcc2(3) )
const2 = cmplx(cos(arg),sin(arg))
......@@ -92,7 +91,7 @@ c write (6,*) 'bkpt,const2,const3=',bkpt(:),const2,const3
IF (iflag.EQ.0) GO TO 20
IF (iflag.EQ.1) GO TO 40
c ---> interstitial part
CALL cotra1(p(1),rcc,bmat)
rcc=matmul(bmat,p)/tpi_const
xdnout = cmplx(0.,0.)
c write (6,*) 'nv,nvd=',nv,nvd
DO 10 k = 1,nv
......@@ -133,7 +132,7 @@ c ----> m.t. part
sx = sqrt(sx)
IF (nopa.NE.1) THEN
c... switch to internal units
CALL cotra1(x,rcc,bmat)
rcc=matmul(bmat,p)/tpi_const
c... rotate into representative
DO 70 i = 1,3
p(i) = 0.
......@@ -146,7 +145,7 @@ c... rotate into representative
60 CONTINUE
70 CONTINUE
c... switch back to cartesian units
CALL cotra0(p,x,amat)
x=matmul(amat,p)
END IF
DO 80 j = jri(n),2,-1
IF (sx.GE.rmsh(j,n)) GO TO 90
......
wannier/wann_rw_eig.F
View file @ ea759903
......@@ -25,7 +25,7 @@ c****************************************************************
< nbnd,kpoints)
use m_cdnread, only:cdn_read
use m_od_types,only:od_inp
use m_types,only:od_inp
IMPLICIT NONE
integer,intent(in) :: ntapwf
......@@ -242,17 +242,19 @@ c*********************************************************************
if(cpu_index.eq.irank)then
#if 1==1
call judft_error("NOT IMPLEMENTED")
#else
call cdn_read(
> lmaxd,ntypd,nlod,neigd,nvd,jspd,
> irank,isize,kptibz,jspin,nbasfcn,nlotot,
> l_ss,l_noco,nrec,kptibz,66,neigd,
> eig_id,nvd,jspd,
> irank,isize,kptibz,jspin,nbasfcn,
> l_noco,neigd,
> n_start,n_end,
< nmat,nv,ello,evdu,epar,kveclo,
< k1,k2,k3,bkpt,wk,nbands,eig,z,cp_time)
< k1,k2,k3,bkpt,wk,nbands,eig,zmat)
#endif
else !eigenvalues are stored in the file of another process
#if 1==2
d10=int((cpu_index+0.5)/10)
d1=mod(cpu_index,10)
aoff=iachar('1')-1
......@@ -273,6 +275,7 @@ c*********************************************************************
< k1,k2,k3,bkpt,wk,nbands,eig,z,cp_time)
close(666)
#endif
endif !cpu_index==irank
endif !find process
enddo !cpu_index
......@@ -346,6 +349,9 @@ c-----used and all processors use the same eig-file
#endif
#else
!MPI with HDF or no MPI
#if 1==1
call judft_error("NOT IMPLEMENTED")
#else
call cdn_read(
> lmaxd,ntypd,nlod,neigd,nvd,jspd,
> 0,isize,kptibz,jspin,nbasfcn,nlotot,
......@@ -353,7 +359,7 @@ c-----used and all processors use the same eig-file
> neigd,n_start,n_end,
< nmat,nv,ello,evdu,epar,kveclo,
< k1,k2,k3,bkpt,wk,nbands,eig,z,cp_time)
#endif
#endif
END SUBROUTINE wann_read_eig
END MODULE m_wann_rw_eig
wannier/wann_tlmw.f
View file @ ea759903
......@@ -232,7 +232,7 @@ c..sp3d2-5
endif
else
CALL juDFT_error("no tlmw for this lr",calledby ="wann_tlmw")
CALL juDFT_error("no tlmw for this lr",calledby="wann_tlmw")
endif
enddo
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment