Commit 6c236cdc authored by Matthias Redies's avatar Matthias Redies

Merge branch 'develop' into MetaGGA

parents 9c94dedf 3910a459
......@@ -227,7 +227,7 @@ CONTAINS
!$OMP& SHARED(lapw,gkrot,lmax,c_ph,iintsp,ab,fj,gj,abclo,cell,atoms) &
!$OMP& SHARED(alo1,blo1,clo1,ab_size,na,n) &
!$OMP& PRIVATE(k,vmult,ylm,l,ll1,m,lm,term,invsfct,lo,nkvec)
DO k = 1,lapw%nv(1)
DO k = 1,lapw%nv(iintsp)
!--> generate spherical harmonics
vmult(:) = gkrot(:,k)
CALL ylm4(lmax,vmult,ylm)
......
......@@ -69,7 +69,7 @@ CONTAINS
!---> loop over non-spherical components of the potential: must
!---> satisfy the triangular conditions and that l'+l+lamda even
!---> (conditions from the gaunt coefficient)
DO lh = 1, nh
DO lh = MERGE(1,0,jspin<3), nh
lamda = sphhar%llh(lh,nsym)
lmin = lp - l
lmx = lp + l
......@@ -117,7 +117,7 @@ CONTAINS
lmp = lp* (lp+1) + mp
lmpl = (lmp* (lmp+1))/2
!---> loop over lattice harmonics
DO lh = 1, nh
DO lh = MERGE(1,0,jspin<3), nh
lamda = sphhar%llh(lh,nsym)
lmin0 = abs(lp-lamda)
IF (lmin0.GT.lp) CYCLE
......
......@@ -506,6 +506,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts
! Generate stars
CALL timestart("strgn")
IF (input%film.OR.(sym%namgrp.NE.'any ')) THEN
CALL strgn1(stars,sym,atoms,vacuum,sphhar,input,cell,xcpot)
IF (oneD%odd%d1) THEN
......@@ -514,6 +515,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts
ELSE
CALL strgn2(stars,sym,atoms,vacuum,sphhar,input,cell,xcpot)
END IF
CALL timestop("strgn")
! Other small stuff
......@@ -546,7 +548,9 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts
CALL MPI_BCAST(sliceplot%iplot,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
#endif
CALL timestart("stepf")
CALL stepf(sym,stars,atoms,oneD,input,cell,vacuum,mpi)
CALL timestop("stepf")
IF (.NOT.sliceplot%iplot) THEN
IF (mpi%irank.EQ.0) THEN
CALL convn(DIMENSION,atoms,stars)
......
......@@ -8,6 +8,9 @@ MODULE m_strgn
! implementation of new box-dimension: to treat nonorthogonal
! lattice systems
! S. Bl"ugel, IFF, 17.Nov.97
!
! OpenMP paralleliation added
! U.Alekseeva Jan.2019
! *********************************************************
CONTAINS
SUBROUTINE strgn1(&
......@@ -752,6 +755,10 @@ CONTAINS
stars%rgphs(:,:,:) = cmplx(1.0,0.0)
ELSE
pon = 1.0 / sym%nop
!$OMP PARALLEL DO &
!$OMP DEFAULT(none) &
!$OMP SHARED(mxx1,mxx2,mxx3,stars,nfftx,nffty,nfftz,nfftxy,pon) &
!$OMP PRIVATE(k1,k2,k3,k,kfx,kfy,kfz,kfft,kidx,i)
DO k3 = -mxx3,mxx3
DO k2 = -mxx2,mxx2
DO k1 = -mxx1,mxx1
......@@ -772,6 +779,7 @@ CONTAINS
ENDDO
ENDDO
ENDDO
!OMP END PARALLLEL DO
ENDIF
if ( stars%mx1 < mxx1 .or. stars%mx2 < mxx2 .or. stars%mx3 < mxx3 ) call &
judft_error("BUG 1 in strgen")
......@@ -782,7 +790,9 @@ CONTAINS
ENDIF
!---> write /str0/ and /str1/ to file
CALL timestart("writeStars")
CALL writeStars(stars,l_xcExtended,.FALSE.)
CALL timestop("writeStars")
270 CONTINUE
......
......@@ -115,7 +115,7 @@ SUBROUTINE writeBasis(input,noco,kpts,atoms,sym,cell,enpara,vTot,vCoul,vx,mpi,DI
INTEGER :: lmn, na,lm,n,nn, m
complex,parameter :: img=(0.,1.)
LOGICAL l_zref,l_real
LOGICAL l_zref,l_real, link_exists
INTEGER jsp,nk,l,itype
INTEGER numbands, nbasfcn, ndbands !ndbands number of bands without highest (degenerate)
......@@ -316,17 +316,19 @@ SUBROUTINE writeBasis(input,noco,kpts,atoms,sym,cell,enpara,vTot,vCoul,vx,mpi,DI
CALL lapw%init(input,noco,kpts,atoms,sym,nk,cell,l_zref)
!write(kpt_name , '(2a,i0)') TRIM(ADJUSTL(jsp_name)),'/kpt_',nk
write(kpt_name , '(2a,f12.10,a,f12.10,a,f12.10)') TRIM(ADJUSTL(jsp_name)),'/kpt_',kpts%bk(1,nk),',',kpts%bk(2,nk),',',kpts%bk(3,nk)
CALL h5gcreate_f(fileID, TRIM(ADJUSTL(kpt_name)), kptGroupID, hdfError)
CALL h5lexists_f(fileID, TRIM(ADJUSTL(kpt_name)), link_exists, hdfError)
IF (link_exists) CYCLE
CALL h5gcreate_f(fileID, TRIM(ADJUSTL(kpt_name)), kptGroupID, hdfError)
!--------------------enter output gvec etc here--------------------
CALL io_write_attint0(kptGroupID,'nv',lapw%nv(jsp))
dims(:2)=(/3,lapw%nv(jsp)/)
dimsInt=dims
CALL h5screate_simple_f(2,dims(:2),gvecSpaceID,hdfError)
CALL h5dcreate_f(kptGroupID, "gvec", H5T_NATIVE_INTEGER, gvecSpaceID, gvecSetID, hdfError)
CALL h5sclose_f(gvecSpaceID,hdfError)
CALL io_write_integer2(gvecSetID,(/1,1/),dimsInt(:2),lapw%gvec(:,:lapw%nv(jsp),jsp))
CALL h5dclose_f(gvecSetID, hdfError)
dims(:2)=(/3,lapw%nv(jsp)/)
dimsInt=dims
CALL h5screate_simple_f(2,dims(:2),gvecSpaceID,hdfError)
CALL h5dcreate_f(kptGroupID, "gvec", H5T_NATIVE_INTEGER, gvecSpaceID, gvecSetID, hdfError)
CALL h5sclose_f(gvecSpaceID,hdfError)
CALL io_write_integer2(gvecSetID,(/1,1/),dimsInt(:2),lapw%gvec(:,:lapw%nv(jsp),jsp))
CALL h5dclose_f(gvecSetID, hdfError)
CALL h5gclose_f(kptGroupID, hdfError)
END DO
......@@ -447,6 +449,8 @@ SUBROUTINE writeBasis(input,noco,kpts,atoms,sym,cell,enpara,vTot,vCoul,vx,mpi,DI
CALL lapw%init(input,noco,kpts,atoms,sym,nk,cell,l_zref)
!write(kpt_name , '(2a,i0)') TRIM(ADJUSTL(jsp_name)),'/kpt_',nk
write(kpt_name , '(2a,f12.10,a,f12.10,a,f12.10)') TRIM(ADJUSTL(jsp_name)),'/kpt_',kpts%bk(1,nk),',',kpts%bk(2,nk),',',kpts%bk(3,nk)
CALL h5lexists_f(fileID, TRIM(ADJUSTL(kpt_name)), link_exists, hdfError)
IF (link_exists) CYCLE
CALL h5gcreate_f(fileID, TRIM(ADJUSTL(kpt_name)), kptGroupID, hdfError)
!--------------------abcoff, zmat, eig output here-------------------
!,results%neig(nk,jsp),results%eig(:,nk,jsp)
......
......@@ -102,8 +102,7 @@
INQUIRE(file='inp',exist=l_found)
IF (input%l_inpXML) THEN
!xml found, we will use it, check if we also have a inp-file
IF (l_found) &
CALL judft_warn("Both inp & inp.xml given.",calledby="fleur_init",hint="Please delete one of the input files")
IF (l_found) CALL judft_warn("Both inp & inp.xml given.", calledby="fleur_init",hint="Please delete one of the input files")
ELSE
IF (.NOT.l_found) CALL judft_error("No input file found",calledby='fleur_init',hint="To use FLEUR, you have to provide either an 'inp' or an 'inp.xml' file in the working directory")
END IF
......@@ -190,9 +189,11 @@
#endif
#endif
CALL timestart("postprocessInput")
CALL postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts,&
oneD,hybrid,cell,banddos,sliceplot,xcpot,forcetheo,&
noco,dimension,enpara,sphhar,l_opti,noel,l_kpts)
CALL timestop("postprocessInput")
IF (mpi%irank.EQ.0) THEN
filename = ''
......
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