Commit bb7bf506 authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'develop' of fleur-git:fleur into develop

parents 440bdcb4 0f7d5032
......@@ -43,7 +43,7 @@ CONTAINS
COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 )
COMPLEX, INTENT (IN) :: ccchi(2)
INTEGER, INTENT (IN) :: kvec(2*(2*atoms%llod+1),atoms%nlod )
LOGICAL, INTENT (OUT) :: enough(atoms%nat)
LOGICAL, INTENT (OUT) :: enough ! enough(na)
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) :: ccof(-atoms%llod:,:,:,:)!(-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%nat)
......@@ -60,7 +60,7 @@ CONTAINS
LOGICAL :: l_real
l_real=zMat%l_real
! ..
enough(na) = .TRUE.
enough = .TRUE.
term1 = con1 * ((atoms%rmt(ntyp)**2)/2) * phase
!---> the whole program is in hartree units, therefore 1/wronskian is
!---> (rmt**2)/2. the factor i**l, which usually appears in the a, b
......@@ -72,7 +72,7 @@ CONTAINS
IF (atoms%invsat(na).EQ.0) THEN
IF ((nkvec(lo,na)).LT. (2*atoms%llo(lo,ntyp)+1)) THEN
enough(na) = .FALSE.
enough = .FALSE.
nkvec(lo,na) = nkvec(lo,na) + 1
nbasf = nbasf0(lo,na) + nkvec(lo,na)
l = atoms%llo(lo,ntyp)
......@@ -114,7 +114,7 @@ CONTAINS
ELSEIF (atoms%invsat(na).EQ.1) THEN
IF ((nkvec(lo,na)).LT. (2* (2*atoms%llo(lo,ntyp)+1))) THEN
enough(na) = .FALSE.
enough = .FALSE.
nkvec(lo,na) = nkvec(lo,na) + 1
nbasf = nbasf0(lo,na) + nkvec(lo,na)
l = atoms%llo(lo,ntyp)
......@@ -167,10 +167,10 @@ CONTAINS
CALL juDFT_error("invsat =/= 0 or 1",calledby ="abclocdn")
ENDIF
ELSE
enough(na) = .FALSE.
enough = .FALSE.
ENDIF ! s > eps & l >= 1
END DO
IF ((k.EQ.nv) .AND. (.NOT.enough(na))) THEN
IF ((k.EQ.nv) .AND. (.NOT.enough)) THEN
WRITE (6,FMT=*) 'abclocdn did not find enough linearly independent'
WRITE (6,FMT=*) 'ccof coefficient-vectors.'
CALL juDFT_error("did not find enough lin. ind. ccof-vectors" ,calledby ="abclocdn")
......
......@@ -51,8 +51,6 @@ CONTAINS
REAL alo1(atoms%nlod,atoms%ntype),blo1(atoms%nlod,atoms%ntype),clo1(atoms%nlod,atoms%ntype)
COMPLEX ylm( (atoms%lmaxd+1)**2 )
COMPLEX ccchi(2,2)
!$ COMPLEX, ALLOCATABLE :: acof_loc(:,:), bcof_loc(:,:)
!$ COMPLEX, ALLOCATABLE :: acof_inv(:,:), bcof_inv(:,:)
LOGICAL enough(atoms%nat),apw(0:atoms%lmaxd,atoms%ntype)
REAL, ALLOCATABLE :: work_r(:)
COMPLEX, ALLOCATABLE :: work_c(:)
......@@ -106,40 +104,30 @@ CONTAINS
ENDIF
!---> loop over atom types
natom = 0
!$OMP PARALLEL DO &
!$OMP& DEFAULT(none)&
!$OMP& PRIVATE(n,nn,natom,k,i,work_r,work_c,ccchi,kspin,fk,s,r1,fj,dfj,l,df,wronk,tmk,phase,&
!$OMP& inap,nap,j,fkr,fkp,ylm,ll1,m,c_0,c_1,c_2,jatom,lmp,inv_f,lm)&
!$OMP& SHARED(noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,ci,iintsp,&
!$OMP& jspin,bkpt,qss1,qss2,qss3,&
!$OMP& apw,const,nobd,&
!$OMP& alo1,blo1,clo1,kvec,nbasf0,nkvec,enough,&
!$OMP& acof,bcof,ccof)
DO n = 1,atoms%ntype
! ----> loop over equivalent atoms
DO nn = 1,atoms%neq(n)
natom = natom + 1
natom = 0
DO i = 1, n-1
natom = natom + atoms%neq(i)
ENDDO
natom = natom + nn
IF ((atoms%invsat(natom).EQ.0) .OR. (atoms%invsat(natom).EQ.1)) THEN
!---> loop over lapws
!$OMP PARALLEL IF(enough(natom)) &
!$OMP& DEFAULT(none)&
!$OMP& PRIVATE(k,i,work_r,work_c,ccchi,kspin,fk,s,r1,fj,dfj,l,df,wronk,tmk,phase,&
!$OMP& inap,nap,j,fkr,fkp,ylm,ll1,m,c_0,c_1,c_2,jatom,lmp,inv_f,lm,&
!$OMP& acof_loc,bcof_loc,acof_inv,bcof_inv)&
!$OMP& SHARED(noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,n,ci,iintsp,&
!$OMP& jspin,bkpt,qss1,qss2,qss3,&
!$OMP& apw,const,natom,&
!$OMP& nobd,&
!$OMP& alo1,blo1,clo1,kvec,nbasf0,nkvec,enough,acof,bcof)&
!$OMP& REDUCTION(+:ccof)
IF (zmat%l_real) THEN
ALLOCATE ( work_r(nobd) )
ELSE
ALLOCATE ( work_c(nobd) )
ENDIF
!$ ALLOCATE(acof_loc(nobd,0:size(acof,2)-1),bcof_loc(nobd,0:size(acof,2)-1))
!$ acof_loc(:,:) = cmplx(0.0,0.0)
!$ bcof_loc(:,:) = cmplx(0.0,0.0)
!$ if (noco%l_soc.and.sym%invs) THEN
!$ IF (atoms%invsat(natom).EQ.1) THEN
!$ ALLOCATE(acof_inv(nobd,0:size(acof,2)-1),bcof_inv(nobd,0:size(acof,2)-1))
!$ acof_inv(:,:) = cmplx(0.0,0.0)
!$ bcof_inv(:,:) = cmplx(0.0,0.0)
!$ ENDIF
!$ endif
!$OMP DO
DO k = 1,nvmax
IF (.NOT.noco%l_noco) THEN
IF (zmat%l_real) THEN
......@@ -232,7 +220,6 @@ CONTAINS
c_1 = c_0 * fj(l)
c_2 = c_0 * dfj(l)
! ----> loop over bands
!$ if (.false.) THEN
IF (zmat%l_real) THEN
acof(:ne,lm,natom) = acof(:ne,lm,natom) + c_1 * work_r(:ne)
bcof(:ne,lm,natom) = bcof(:ne,lm,natom) + c_2 * work_r(:ne)
......@@ -240,14 +227,6 @@ CONTAINS
acof(:ne,lm,natom) = acof(:ne,lm,natom) + c_1 * work_c(:ne)
bcof(:ne,lm,natom) = bcof(:ne,lm,natom) + c_2 * work_c(:ne)
END IF
!$ endif
!$ if (zmat%l_real) THEN
!$ acof_loc(:ne,lm) = acof_loc(:ne,lm) + c_1 * work_r(:ne)
!$ bcof_loc(:ne,lm) = bcof_loc(:ne,lm) + c_2 * work_r(:ne)
!$ else
!$ acof_loc(:ne,lm) = acof_loc(:ne,lm) + c_1 * work_c(:ne)
!$ bcof_loc(:ne,lm) = bcof_loc(:ne,lm) + c_2 * work_c(:ne)
!$ endif
IF (noco%l_soc.AND.sym%invs) THEN
IF (atoms%invsat(natom).EQ.1) THEN
......@@ -256,46 +235,26 @@ CONTAINS
inv_f = (-1)**(l-m)
c_1 = CONJG(c_1) * inv_f
c_2 = CONJG(c_2) * inv_f
!$ if (.false.) THEN
CALL CPP_BLAS_caxpy(ne,c_1,work_c,1, acof(1,lmp,jatom),1)
CALL CPP_BLAS_caxpy(ne,c_2,work_c,1, bcof(1,lmp,jatom),1)
!$ endif
!$ CALL CPP_BLAS_caxpy(ne,c_1,work_c,1,acof_inv(1,lmp),1)
!$ CALL CPP_BLAS_caxpy(ne,c_2,work_c,1,bcof_inv(1,lmp),1)
ENDIF
ENDIF
ENDDO ! loop over m
ENDDO ! loop over l
IF (.NOT.enough(natom)) THEN
CALL abclocdn(atoms,sym, noco,ccchi(1,jspin),kspin,iintsp,const,phase,ylm,n,natom,k,&
s,nvmax,ne,nbasf0,alo1,blo1,clo1,kvec(1,1,natom),nkvec,enough,acof,bcof,ccof,zMat)
s,nvmax,ne,nbasf0,alo1,blo1,clo1,kvec(1,1,natom),nkvec,enough(natom),acof,bcof,ccof,zMat)
ENDIF
ENDDO ! loop over LAPWs
!$OMP END DO
!$OMP CRITICAL
!$ acof(:,:,natom) = acof(:,:,natom) + acof_loc(:,:)
!$ bcof(:,:,natom) = bcof(:,:,natom) + bcof_loc(:,:)
!$ if (noco%l_soc.and.sym%invs) THEN
!$ IF (atoms%invsat(natom).EQ.1) THEN
!$ jatom = sym%invsatnr(natom)
!$ acof(:,:,jatom) = acof(:,:,jatom) + acof_inv(:,:)
!$ bcof(:,:,jatom) = bcof(:,:,jatom) + bcof_inv(:,:)
!$ ENDIF
!$ endif
!$OMP END CRITICAL
!$ DEALLOCATE(acof_loc,bcof_loc)
!$ if (noco%l_soc.and.sym%invs) THEN
!$ IF (atoms%invsat(natom).EQ.1) DEALLOCATE(acof_inv,bcof_inv)
!$ endif
IF (zmat%l_real) THEN
DEALLOCATE(work_r)
ELSE
DEALLOCATE(work_c)
ENDIF
!$OMP END PARALLEL
ENDIF ! invsatom == ( 0 v 1 )
ENDDO ! loop over equivalent atoms
ENDDO ! loop over atom types
!$OMP END PARALLEL DO
ENDDO ! loop over interstitial spin
IF (noco%l_soc.AND.sym%invs) THEN
......
......@@ -59,7 +59,7 @@ function configure_machine(){
echo "All required modules load loaded"
else
echo "You have to load the required modules"
echo "module load hdf5/1.8.15_BGQ scalapack/2.0.2_elpa_simd"
echo "'source $DIR/cmake/machines/JUQUEEN/xlfsource.sh' should help"
exit
fi
cp $DIR/cmake/machines/JUQUEEN/JUQUEEN.cmake config.cmake
......
module load hdf5/1.8.15_BGQ scalapack/2.0.2_elpa_simd
export XML2LIB=/bgsys/local/libxml2/lib
......@@ -3,19 +3,19 @@ try_compile(FLEUR_USE_ELPA ${CMAKE_BINARY_DIR} ${CMAKE_SOURCE_DIR}/cmake/tests/t
LINK_LIBRARIES ${FLEUR_LIBRARIES})
if (NOT FLEUR_USE_ELPA)
set(STORE_FLAGS "${CMAKE_Fortran_FLAGS}")
if (DEFINED ENV{ELPA_MODULES})
set(STORE_FLAGS ${CMAKE_Fortran_FLAGS})
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I$ENV{ELPA_MODULES}")
endif()
if (DEFINED ENV{ELPA_LIB})
set(TEST_LIBRARIES "-L${ELPA_LIB};-lelpa_openmp;${FLEUR_LIBRARIES}")
set(TEST_LIBRARIES "-L$ENV{ELPA_LIB};-lelpa_openmp;-lstdc++;${FLEUR_LIBRARIES}")
endif()
try_compile(FLEUR_USE_ELPA ${CMAKE_BINARY_DIR} ${CMAKE_SOURCE_DIR}/cmake/tests/test_ELPA.f90
LINK_LIBRARIES ${TEST_LIBRARIES})
if (FLEUR_USE_ELPA)
set(FLEUR_LIBRARIES "${TEST_LIBRARIES}")
else()
set(CMAKE_Fortran_FLAGS ${STORE_FLAGS})
set(CMAKE_Fortran_FLAGS "${STORE_FLAGS}")
endif()
endif()
......@@ -24,6 +24,7 @@ message("ELPA Library found:${FLEUR_USE_ELPA}")
#Now check for version of elpa
if (FLEUR_USE_ELPA)
set(FLEUR_USE_ELPA false)
try_compile(FLEUR_USE_ELPA_OLD ${CMAKE_BINARY_DIR} ${CMAKE_SOURCE_DIR}/cmake/tests/test_ELPA_OLD.f90
LINK_LIBRARIES ${FLEUR_LIBRARIES})
try_compile(FLEUR_USE_ELPA_NEW ${CMAKE_BINARY_DIR} ${CMAKE_SOURCE_DIR}/cmake/tests/test_ELPA_NEW.f90
......@@ -36,12 +37,15 @@ LINK_LIBRARIES ${FLEUR_LIBRARIES})
message("201605003 ELPA: ${FLEUR_USE_ELPA_201605003}")
#Set preprocessor switches
if (FLEUR_USE_ELPA_OLD)
set(FLEUR_USE_ELPA TRUE)
set(FLEUR_MPI_DEFINITIONS ${FLEUR_MPI_DEFINITIONS} "CPP_ELPA" "CPP_ELPA2")
endif()
if (FLEUR_USE_ELPA_NEW)
set(FLEUR_USE_ELPA TRUE)
set(FLEUR_MPI_DEFINITIONS ${FLEUR_MPI_DEFINITIONS} "CPP_ELPA" "CPP_ELPA2" "CPP_ELPA_NEW")
endif()
if (FLEUR_USE_ELPA_201605003)
set(FLEUR_USE_ELPA TRUE)
set(FLEUR_MPI_DEFINITIONS ${FLEUR_MPI_DEFINITIONS} "CPP_ELPA" "CPP_ELPA2" "CPP_ELPA_201605003")
endif()
endif()
program test
use elpa1
integer:: ierr,mpi_subcom, myrowblacs, mycolblacs
integer:: mpi_comm_rows,mpi_comm_cols,m,nb,mycolssca,ok
integer:: mpi_comm_rows,mpi_comm_cols,m,nb,mycolssca
logical :: ok
real :: bsca(10,10)
ok=CHOLESKY_real (m,bsca,SIZE(bsca,1),nb,mycolssca,mpi_comm_rows,mpi_comm_cols,.false.)
end
program test
use elpa1
integer:: ierr,mpi_subcom, myrowblacs, mycolblacs
integer:: mpi_comm_rows,mpi_comm_cols,m,nb,mycolssca,ok
integer:: mpi_comm_rows,mpi_comm_cols,m,nb,mycolssca
logical ::ok
real :: bsca(10,10)
CALL CHOLESKY_real (m,bsca,SIZE(bsca,1),nb,mycolssca,mpi_comm_rows,mpi_comm_cols,.false.,ok)
end
......@@ -47,6 +47,9 @@ CONTAINS
USE m_icorrkeys
USE m_eig66_io, ONLY : open_eig, write_eig, close_eig,read_eig
USE m_xmlOutput
#ifdef CPP_MPI
USE m_mpi_bc_pot
#endif
IMPLICIT NONE
TYPE(t_results),INTENT(INOUT):: results
......@@ -238,8 +241,16 @@ CONTAINS
& 'Info: and stored in "vxc", the values obtained from the',&
& 'Info: original implementation are saved to "vxc.old".'
ENDIF
CALL readPotential(stars,vacuum,atoms,sphhar,input,sym,POT_ARCHIVE_TYPE_TOT_const,&
iter,vr,vpw,vz,vzxy)
IF (mpi%irank.EQ.0) THEN
CALL readPotential(stars,vacuum,atoms,sphhar,input,sym,POT_ARCHIVE_TYPE_TOT_const,&
iter,vr,vpw,vz,vzxy)
END IF
#ifdef CPP_MPI
CALL mpi_bc_pot(mpi,stars,sphhar,atoms,input,vacuum,&
iter,vr,vpw,vz,vzxy)
#endif
999 CONTINUE
IF (mpi%irank.EQ.0) CALL openXMLElementFormPoly('iteration',(/'numberForCurrentRun','overallNumber '/),(/it,iter/),&
RESHAPE((/19,13,5,5/),(/2,2/)))
......@@ -569,6 +580,10 @@ CONTAINS
bkpt, kpts%wtkpt(nk),eig(:ne_found),enpara%el0(0:,:,2), enpara%ello0(:,:,2),enpara%evac0(:,2),&
atoms%nlotot,kveclo)
ENDIF
#if defined(CPP_MPI)
!RMA synchronization
CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
#endif
#if defined(CPP_MPI)&&defined(CPP_NEVER)
IF ( hybrid%l_calhf ) THEN
......@@ -659,8 +674,15 @@ ENDIF
ENDDO
CLOSE (16)
gwc=2
CALL readPotential(stars,vacuum,atoms,sphhar,input,sym,POT_ARCHIVE_TYPE_COUL_const,&
iter,vr,vpw,vz,vzxy)
IF (mpi%irank.EQ.0) THEN
CALL readPotential(stars,vacuum,atoms,sphhar,input,sym,POT_ARCHIVE_TYPE_COUL_const,&
iter,vr,vpw,vz,vzxy)
END IF
#ifdef CPP_MPI
CALL mpi_bc_pot(mpi,stars,sphhar,atoms,input,vacuum,&
iter,vr,vpw,vz,vzxy)
#endif
GOTO 999
ELSE IF ( input%gw.EQ.2.AND.(gwc==2) ) THEN
CLOSE (12)
......
......@@ -3,7 +3,7 @@ set(fleur_F77 ${fleur_F77}
set(fleur_F90 ${fleur_F90}
eigen_soc/alineso.F90
eigen_soc/anglso.f90
eigen_soc/eigenso.f90
eigen_soc/eigenso.F90
eigen_soc/hsoham.f90
eigen_soc/hsohelp.F90
eigen_soc/sgml.f90
......
MODULE m_eigenso
!
!*********************************************************************
! sets up and solves the spin-orbit eigenvalue problem in the
! sets ur and solves the spin-orbit eigenvalue problem in the
! second variation procedure.
!
! way: takes e.v. and e.f. from previous scalar-rel. calc.
......@@ -72,7 +72,8 @@ CONTAINS
COMPLEX, ALLOCATABLE :: vzxy(:,:,:,:),vpw(:,:)
TYPE(t_zmat)::zmat
INTEGER :: ierr
! ..
INQUIRE (4649,opened=l_socvec)
......@@ -119,6 +120,10 @@ CONTAINS
el=enpara%el0(:,:,jspin),&
ello=enpara%ello0(:,:,jspin),evac=enpara%evac0(:,jspin))
ENDDO
#if defined(CPP_MPI)
!RMA synchronization
CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
#endif
CALL timestart("eigenso: spnorb")
! ..
ALLOCATE( rsopdp(atoms%ntype,atoms%lmaxd,2,2),rsopdpd(atoms%ntype,atoms%lmaxd,2,2),&
......
......@@ -18,7 +18,7 @@ CONTAINS
USE m_types
USE m_dimen7
USE m_firstglance
USE m_constants
USE m_writeOutHeader
IMPLICIT NONE
TYPE(t_mpi),INTENT(INOUT) :: mpi
TYPE(t_input),INTENT(INOUT) :: input
......@@ -48,8 +48,6 @@ CONTAINS
oneD%odd%d1=.TRUE.
l_kpts=.TRUE.
IF (mpi%irank.EQ.0) call priv_hello(version_const)
WRITE (6,*) 'Your parameters: '
......@@ -239,48 +237,4 @@ CONTAINS
END SUBROUTINE dimens
SUBROUTINE priv_hello(ivers)
USE m_compile_descr
IMPLICIT NONE
CHARACTER(len=9), INTENT (IN) :: ivers
CHARACTER(len=9) :: cppflag(11)
CHARACTER(LEN=500):: infostring
INTEGER :: i,j
WRITE (6,*) 'This output is generated by ',ivers
WRITE (6,*) ' * * '
#if ( defined(CPP_AIX) )
WRITE (6,*) ' * \\:/ *'
#else
WRITE (6,*) ' * \:/ *'
#endif
WRITE (6,*) ' * | *'
WRITE (6,*) ' * * '
WRITE (6,*)
CALL get_compile_desc_string(infostring)
write(6,'(a500)') infostring
CALL getComputerArchitectures(cppflag,i) ! First determine the architecture
IF (i.GT.1) THEN
WRITE (6,*) 'You set compiler flags for more than one'
WRITE (6,*) 'architecture: ', (cppflag(j),j=1,i)
WRITE (6,*) 'Define only one system architecture! '
CALL juDFT_error("Define only one system architecture! "&
& ,calledby ="dimens")
ENDIF
IF (i == 0) THEN
WRITE (6,*) 'No system architecture specified in Makefile'
cppflag(1) = 'GEN'
ENDIF
!
! check for double precision etc.
!
CALL getAdditionalCompilationFlags(cppflag,i)
IF (i.GT.0) THEN
WRITE (6,*) 'Additional flags are: ', (cppflag(j),j=1,i)
ENDIF
END SUBROUTINE priv_hello
END MODULE m_dimens
END MODULE m_dimens
......@@ -39,6 +39,7 @@
USE m_dwigner
USE m_strgn
USE m_stepf
USE m_cdn_io
USE m_mapatom
USE m_writegw
USE m_convn
......@@ -136,6 +137,10 @@
CALL od_mapatom(oneD,atoms,sym,cell)
END IF
! Store structure data
CALL storeStructureIfNew(input, atoms, cell, vacuum, oneD, sym)
!+odim
IF (input%film.OR.(sym%namgrp.NE.'any ')) THEN
CALL strgn1(stars,sym,atoms, vacuum,sphhar, input,cell,xcpot)
......
......@@ -46,7 +46,7 @@
!
ifftd = 27*stars%mx1*stars%mx2*stars%mx3
CALL readStepfunction(stars,l_error)
CALL readStepfunction(stars, atoms, cell, vacuum, l_error)
IF(.NOT.l_error) THEN
RETURN
END IF
......
......@@ -162,9 +162,9 @@ PROGRAM inpgen
nops = sym%nop
symfn = 'sym.out'
IF (.not.input%film) sym%nop2=sym%nop
CALL rw_symfile(&
& 'W',symfh,symfn,nops,cell%bmat,&
& sym%mrot,sym%tau,sym%nop,sym%nop2,sym%symor)
IF ((juDFT_was_argument("-old")).OR.(.NOT.juDFT_was_argument("-explicit"))) THEN
CALL rw_symfile('W',symfh,symfn,nops,cell%bmat,sym%mrot,sym%tau,sym%nop,sym%nop2,sym%symor)
END IF
ALLOCATE (atomTypeSpecies(atoms%ntype))
ALLOCATE (speciesRepAtomType(atoms%nat))
......
......@@ -94,6 +94,10 @@
cr = gamma
ENDIF
scale(1) = a
scale(2) = b
scale(3) = c
latsys = ADJUSTL(latsys)
!===> 1: cubic-P (cP) sc
......@@ -103,9 +107,10 @@
noangles=.true.
i_c = 1
a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i_c)
a1 = lmat(:,1,i_c) * scale(:)
a2 = lmat(:,2,i_c) * scale(:)
a3 = lmat(:,3,i_c) * scale(:)
scale = 1.0
IF ( a.NE.b .OR. a.NE.c ) err = 11
IF ( ar.NE.br .OR. ar.NE.cr .OR. ar.NE.(pi_const/2.0) ) err = 12
......@@ -117,9 +122,10 @@
noangles=.true.
i_c = 2
a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i_c)
a1 = lmat(:,1,i_c) * scale(:)
a2 = lmat(:,2,i_c) * scale(:)
a3 = lmat(:,3,i_c) * scale(:)
scale = 1.0
IF ( a.NE.b .OR. a.NE.c ) err = 21
......@@ -130,9 +136,10 @@
noangles=.true.
i_c = 3
a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i_c)
a1 = lmat(:,1,i_c) * scale(:)
a2 = lmat(:,2,i_c) * scale(:)
a3 = lmat(:,3,i_c) * scale(:)
scale = 1.0
IF ( a.NE.b .OR. a.NE.c ) err = 31
......@@ -143,9 +150,10 @@
noangles=.true.
i_c = 4
a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i_c)
a1 = lmat(:,1,i_c) * scale(:)
a2 = lmat(:,2,i_c) * scale(:)
a3 = lmat(:,3,i_c) * scale(:)
scale = 1.0
IF ( a.NE.b ) err = 41
......@@ -155,9 +163,10 @@
noangles=.true.
i_c = 4
a1 = lmat((/2,1,3/),1,i_c)
a2 = -lmat((/2,1,3/),2,i_c)
a3 = lmat(:,3,i_c)
a1 = lmat((/2,1,3/),1,i_c) * scale(:)
a2 = -lmat((/2,1,3/),2,i_c) * scale(:)
a3 = lmat(:,3,i_c) * scale(:)
scale = 1.0
i_c = 9
IF ( a.NE.b ) err = 41
......@@ -173,7 +182,7 @@
a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i_c)
IF ( a.NE.b ) err = 51
IF ( b.NE.c ) err = 51
IF ( alpha.EQ.0.0 .OR.
......@@ -234,9 +243,10 @@
noangles=.true.
i_c = 1
a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i_c)
a1 = lmat(:,1,i_c) * scale(:)
a2 = lmat(:,2,i_c) * scale(:)
a3 = lmat(:,3,i_c) * scale(:)
scale = 1.0
IF ( a.NE.b ) err = 61
IF ( ar.NE.br .OR. ar.NE.cr .OR. ar.NE.(pi_const/2.0) ) err= 62
......@@ -248,9 +258,10 @@
noangles=.true.
i_c = 3
a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i_c)
a1 = lmat(:,1,i_c) * scale(:)
a2 = lmat(:,2,i_c) * scale(:)
a3 = lmat(:,3,i_c) * scale(:)
scale = 1.0
IF ( a.NE.b ) err = 61
......@@ -261,9 +272,10 @@
noangles=.true.
i_c = 1
a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i_c)
a1 = lmat(:,1,i_c) * scale(:)
a2 = lmat(:,2,i_c) * scale(:)
a3 = lmat(:,3,i_c) * scale(:)
scale = 1.0
!===> 9: orthorhombic-F (oF)
......@@ -273,9 +285,10 @@
noangles=.true.
i_c = 2
a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i_c)
a1 = lmat(:,1,i_c) * scale(:)
a2 = lmat(:,2,i_c) * scale(:)
a3 = lmat(:,3,i_c) * scale(:)
scale = 1.0
!===> 10: orthorhombic-I (oI)
......@@ -285,9 +298,10 @@
noangles=.true.
i_c = 3
a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i_c)
a1 = lmat(:,1,i_c) * scale(:)
a2 = lmat(:,2,i_c) * scale(:)
a3 = lmat(:,3,i_c) * scale(:)
scale = 1.0
!===> 11: orthorhombic-S (oS) (oC)
......@@ -297,9 +311,10 @@
noangles=.true.
i_c = 6
a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i_c)
a1 = lmat(:,1,i_c) * scale(:)
a2 = lmat(:,2,i_c) * scale(:)
a3 = lmat(:,3,i_c) * scale(:)
scale = 1.0
!===> 11a: orthorhombic-A (oA)
......@@ -309,9 +324,10 @@
noangles=.true.
i_c = 8
a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i_c)
a1 = lmat(:,1,i_c) * scale(:)
a2 = lmat(:,2,i_c) * scale(:)
a3 = lmat(:,3,i_c) * scale(:)
scale = 1.0
!===> 11b: orthorhombic-B (oB)
......@@ -321,9 +337,10 @@
noangles=.true.
i_c = 7
a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i_c)
a1 = lmat(:,1,i_c) * scale(:)
a2 = lmat(:,2,i_c) * scale(:)
a3 = lmat(:,3,i_c) * scale(:)
scale = 1.0
!===> 12: monoclinic-P (mP)
ELSEIF ( latsys =='monoclinic-P'.OR.latsys =='mP'.OR
......@@ -470,6 +487,8 @@
ENDIF
IF (abs(scale(1)) < eps) THEN
CALL juDFT_error("Illegal program section reached!"
+ ,calledby ="lattice2")
scale(1) = a
scale(2) = b
scale(3) = c
......
......@@ -358,12 +358,15 @@
IF (input%film) atoms%taual(3,:) = atoms%taual(3,:) * a3(3) / dtild
CLOSE (6)
inquire(file="inp",exist=l_exists)
INQUIRE(file="inp",exist=l_exists)
IF (l_exists) THEN
CALL juDFT_error("Cannot overwrite existing inp-file ",calledby&
& ="set_inp")
CALL juDFT_error("inp-file exists. Cannot write another input file in this directory.",calledby="set_inp")
ENDIF
INQUIRE(file="inp.xml",exist=l_exists)
IF (l_exists) THEN
CALL juDFT_error("inp.xml-file exists. Cannot write another input file in this directory.",calledby="set_inp")
ENDIF
nu = 8
input%gw = 0
......@@ -412,7 +415,7 @@
Jij%phnd=1
IF(.NOT.juDFT_was_argument("-noXML")) THEN
IF(.NOT.juDFT_was_argument("-old")) THEN
nkptOld = kpts%nkpt