Commit ea759903 authored by Daniel Wortmann's avatar Daniel Wortmann

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

parent 758aca08
......@@ -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))
......
......@@ -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)
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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))
......
......@@ -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))
......
......@@ -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)
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......@@ -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