Commit e49f068d authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop

parents 90e9869d b1cd73b0
stages:
- build
- test
- deploy
- coverage
- deploy
- build-pgi
- test-pgi
- build-intel
- test-intel
build-gfortran:
image: iffregistry.fz-juelich.de/fleur/fleur:latest
stage: build
......@@ -43,9 +44,11 @@ pages:
cache:
paths:
- build
- public
script:
- cd /builds/fleur/fleur/build ; make doc
- mv docs/html/ ../public/
- mv /builds/fleur/fleur/docs/Docu_main.html ../public/index.html
environment:
name: Doxygen
url: https://fleur.iffgit.fz-juelich.de/fleur
......@@ -119,6 +122,9 @@ test-intel:
gfortran-coverage:
image: iffregistry.fz-juelich.de/fleur/fleur:latest
stage: coverage
cache:
paths:
- build
script:
- cd /builds/fleur/fleur; ./configure.sh -l coverage -flags --coverage GITLAB; cd build.coverage; make
- lcov --capture --initial -d CMakeFiles -o baseline.info
......@@ -126,7 +132,7 @@ gfortran-coverage:
- lcov --capture -d CMakeFiles -o after.info
- lcov --add-tracefile baseline.info --add-tracefile after.info -o combined.info
- genhtml combined.info --output-directory html_out
- mv html_out ../public/coverage_html
- mkdir ../public;mv html_out ../public/coverage_html
artifacts:
paths:
- public
......@@ -135,3 +141,4 @@ gfortran-coverage:
url: https://fleur.iffgit.fz-juelich.de/fleur/coverage_html
only:
- web
- schedules
\ No newline at end of file
......@@ -9,7 +9,9 @@ CONTAINS
!***********************************************************************
!
SUBROUTINE q_mt_sl(jsp,atoms,nobd,ikpt,ne,skip_t,noccbd,eigVecCoeffs,usdus,slab)
USE m_types
USE m_types_setup
USE m_types_usdus
USE m_types_cdnval, ONLY: t_eigVecCoeffs, t_slab
IMPLICIT NONE
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_atoms),INTENT(IN) :: atoms
......
......@@ -7,8 +7,11 @@ MODULE m_qal21
CONTAINS
SUBROUTINE qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
USE m_types_setup
USE m_types_dos
USE m_types_cdnval, ONLY: t_eigVecCoeffs
USE m_types_denCoeffsOffdiag
USE m_rotdenmat
USE m_types
IMPLICIT NONE
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_input), INTENT(IN) :: input
......
......@@ -11,7 +11,8 @@ CONTAINS
SUBROUTINE calcDenCoeffs(atoms,sphhar,sym,we,noccbd,eigVecCoeffs,ispin,denCoeffs)
USE m_juDFT
USE m_types
USE m_types_setup
USE m_types_cdnval, ONLY: t_eigVecCoeffs,t_denCoeffs
USE m_rhomt
USE m_rhonmt
USE m_rhomtlo
......
......@@ -46,7 +46,7 @@ set(inpgen_F77 ${inpgen_F77}
inpgen/element.f inpgen/atom_input.f inpgen/crystal.f inpgen/lattice2.f inpgen/setab.f inpgen/super_check.f
inpgen/atom_sym.f inpgen/generator.f inpgen/read_record.f inpgen/soc_or_ssdw.f inpgen/symproperties.f
inpgen/bravais_symm.f inpgen/set_atom_core.f inpgen/spg_gen.f global/triang.f
inpgen/closure.f inpgen/lapw_input.f inpgen/struct_input.f inpgen/write_struct.f
inpgen/lapw_input.f inpgen/struct_input.f inpgen/write_struct.f
io/calculator.f global/ss_sym.f global/soc_sym.f math/inv3.f io/rw_symfile.f
global/sort.f init/kptgen_hybrid.f init/od_kptsgen.f init/bravais.f init/divi.f init/brzone.f
init/kptmop.f init/kpttet.f init/bandstr1.F init/ordstar.f init/fulstar.f init/kprep.f
......@@ -56,7 +56,7 @@ init/tetcon.f init/kvecon.f init/boxdim.f math/ylm4.f global/radsra.f math/intgr
set(inpgen_F90 ${inpgen_F90} global/constants.f90 io/xsf_io.f90
eigen/vec_for_lo.f90 eigen/orthoglo.F90 juDFT/usage_data.F90
global/enpara.f90 global/chkmt.f90 inpgen/inpgen.f90 inpgen/set_inp.f90 inpgen/inpgen_help.f90 io/rw_inp.f90 juDFT/juDFT.F90 global/find_enpara.f90
global/enpara.f90 global/chkmt.f90 inpgen/inpgen.f90 inpgen/set_inp.f90 inpgen/inpgen_help.f90 io/rw_inp.f90 juDFT/juDFT.F90 global/find_enpara.f90 inpgen/closure.f90
juDFT/info.F90 juDFT/stop.F90 juDFT/args.F90 juDFT/time.F90 juDFT/init.F90 juDFT/sysinfo.F90 io/w_inpXML.f90 init/julia.f90 global/utility.F90
init/compile_descr.F90 init/kpoints.f90 io/xmlOutput.F90 init/brzone2.f90 cdn/slab_dim.f90 cdn/slabgeom.f90 dos/nstm3.f90 cdn/int_21.f90
cdn/int_21lo.f90 cdn_mt/rhomt21.f90 cdn_mt/rhonmt21.f90 force/force_a21.F90 force/force_a21_lo.f90 force/force_a21_U.f90 force/force_a12.f90
......
......@@ -4,6 +4,8 @@ if (${CMAKE_Fortran_COMPILER_ID} MATCHES "Intel")
if (${CMAKE_Fortran_COMPILER_VERSION} VERSION_LESS "13.0.0.0")
set(FLEUR_WARN_MESSAGE "You are using an old version of the Intel Fortran Compiler. Most likely FLEUR will not be build sucessfully. Consider to upgrade your compiler.")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -mkl -r8 -openmp -assume byterecl")
set(FLEUR_MPI_DEFINITIONS ${FLEUR_MPI_DEFINITIONS} "CPP_OLDINTEL")
set(FLEUR_DEFINITIONS ${FLEUR_DEFINITIONS} "CPP_OLDINTEL")
elseif (${CMAKE_Fortran_COMPILER_VERSION} VERSION_LESS "14.1.0.0")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -mkl -r8 -openmp -assume byterecl")
else()
......
......@@ -298,7 +298,7 @@ IMPLICIT NONE
!Simple driver to solve Generalized Eigenvalue Problem using the ChASE library
IMPLICIT NONE
TYPE(t_mpimat), INTENT(INOUT) :: hmat,smat
TYPE(t_mpimat), INTENT(INOUT) :: hmat,smat
INTEGER, INTENT(IN) :: ikpt
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: iter
......@@ -310,7 +310,7 @@ IMPLICIT NONE
INTEGER :: info,myid,np
REAL :: scale !scaling of eigenvalues from scalapack
CLASS(t_mat), ALLOCATABLE :: zMatTemp
TYPE(t_mat) :: zMatTemp
TYPE(t_mpimat) :: chase_mat
REAL, ALLOCATABLE :: eigenvalues(:)
include 'mpif.h'
......@@ -356,9 +356,9 @@ IMPLICIT NONE
CALL chase_mat%generate_full_matrix()
ALLOCATE(eigenvalues(nev+nex))
eigenvalues = 0.0
ALLOCATE(t_mpimat::zmatTemp)
!ALLOCATE(t_mpimat::zmatTemp)
CALL zMatTemp%init(hmat%l_real,hmat%global_size1,nev+nex,MPI_COMM_SELF,.TRUE.) !Generate a pseudo-distributed matrix
IF (hmat%l_real) THEN
IF(iter.EQ.1) THEN
CALL mpi_chase_r(chase_mat%data_r, zMatTemp%data_r, eigenvalues, 25, 1e-10, 'R', 'S' )
......@@ -374,33 +374,26 @@ IMPLICIT NONE
CALL mpi_chase_c(chase_mat%data_c, zMatTemp%data_c, eigenvalues, 25, 1e-10, 'A', 'S' )
END IF
ENDIF
ne = nev
IF (myid==0) CALL write_eig(chase_eig_id,ikpt,jsp,nev+nex,nev+nex,&
eigenvalues(:(nev+nex)),zmat=zMatTemp)
!Back-Transform
CALL hmat%from_non_dist(zmattemp)
call zmatTemp%free()
! --> recover the generalized eigenvectors z by solving z' = l^t * z
IF (smat%l_real) THEN
CALL PDTRTRI('U','N',smat%global_size1,smat%data_r,1,1,smat%blacs_desc,info)
CALL PDGEMM('N','N',smat%global_size1,smat%global_size1,smat%global_size1,1.0,smat%data_r,1,1,smat%blacs_desc,zmatTemp%data_r,1,1,zmattemp%blacs_desc,0.0,hmat%data_r,1,1,hmat%blacs_desc)
CALL pdtrtrs('U','N','N',hmat%global_size1,hmat%global_size1,smat%data_r,1,1,smat%blacs_desc,&
hmat%data_r,1,1,smat%blacs_desc,info)
ELSE
STOP 'chase no complex'
CALL pztrtrs('U','N','N',hmat%global_size1,hmat%global_size1,smat%data_c,1,1,smat%blacs_desc,&
hmat%data_c,1,1,smat%blacs_desc,info)
END IF
IF (info.NE.0) THEN
WRITE (6,*) 'Error in p?trtrs: info =',info
CALL juDFT_error("Diagonalization failed",calledby="chase_diag")
ENDIF
!!$ CALL hmat%copy(zmatTemp,1,1) !Copy matrix into distributed form
!!$ call zmatTemp%free()
!!$
!!$ ! --> recover the generalized eigenvectors z by solving z' = l^t * z
!!$ IF (smat%l_real) THEN
!!$ CALL pdtrtrs('U','N','N',hmat%global_size1,hmat%global_size1,smat%data_r,1,1,smat%blacs_desc,&
!!$ hmat%data_r,1,1,smat%blacs_desc,info)
!!$ ELSE
!!$ CALL pztrtrs('U','N','N',hmat%global_size1,hmat%global_size1,smat%data_c,1,1,smat%blacs_desc,&
!!$ hmat%data_c,1,1,smat%blacs_desc,info)
!!$ END IF
!!$ IF (info.NE.0) THEN
!!$ WRITE (6,*) 'Error in p?trtrs: info =',info
!!$ CALL juDFT_error("Diagonalization failed",calledby="chase_diag")
!!$ ENDIF
! Redistribute eigvec from ScaLAPACK distribution to each process
! having all eigenvectors corresponding to his eigenvalues as above
......
......@@ -6,7 +6,7 @@
module m_corespec
USE m_types
USE m_types_setup, ONLY: t_coreSpecInput
implicit none
......
......@@ -6,9 +6,11 @@
MODULE m_corespec_eval
USE m_corespec
USE m_types
USE m_types_setup
USE m_types_usdus
USE m_types_cdnval, ONLY: t_eigVecCoeffs
USE m_constants
USE m_corespec
IMPLICIT NONE
......
......@@ -14,10 +14,12 @@ CONTAINS
!
!*********************************************************************
USE m_constants, ONLY : c_light
USE m_types_setup
USE m_types_mpi
USE m_types_enpara
USE m_xmlOutput
USE m_radsra
USE m_differ
USE m_types
USE m_xmlOutput
IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_enpara),INTENT(IN) :: enpara
......
......@@ -23,10 +23,10 @@ CONTAINS
SUBROUTINE eigenso(eig_id,mpi,DIMENSION,stars,vacuum,atoms,sphhar,&
obsolete,sym,cell,noco,input,kpts,oneD,vTot,enpara,results)
USE m_types
USE m_eig66_io, ONLY : read_eig,write_eig
USE m_spnorb
USE m_alineso
USE m_types
USE m_judft
#ifdef CPP_MPI
USE m_mpi_bc_pot
......
......@@ -5,9 +5,6 @@ CONTAINS
SUBROUTINE ssomat(seigvso,theta,phi,eig_id,DIMENSION,atoms,kpts,sym,&
cell,noco, input,mpi, oneD,enpara,v,results )
USE m_eig66_io
USE m_spnorb
USE m_abcof
USE m_types_mat
USE m_types_setup
USE m_types_mpi
......@@ -19,6 +16,9 @@ CONTAINS
USE m_types_usdus
USE m_types_lapw
USE m_constants
USE m_eig66_io
USE m_spnorb
USE m_abcof
IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi
......
......@@ -5,8 +5,10 @@
!--------------------------------------------------------------------------------
MODULE m_types_dmi
USE m_judft
USE m_types
USE m_types_forcetheo
USE m_judft
TYPE,EXTENDS(t_forcetheo) :: t_forcetheo_dmi
INTEGER :: q_done
REAL,ALLOCATABLE:: qvec(:,:)
......
......@@ -5,8 +5,10 @@
!--------------------------------------------------------------------------------
MODULE m_types_jij
USE m_judft
USE m_types
USE m_types_forcetheo
USE m_judft
TYPE,EXTENDS(t_forcetheo) :: t_forcetheo_jij
INTEGER :: loopindex,no_loops
INTEGER,ALLOCATABLE :: q_index(:),iatom(:),jatom(:)
......
......@@ -5,8 +5,9 @@
!--------------------------------------------------------------------------------
MODULE m_types_mae
USE m_judft
USE m_types
USE m_types_forcetheo
USE m_judft
TYPE,EXTENDS(t_forcetheo) :: t_forcetheo_mae
INTEGER :: directions_done
REAL,ALLOCATABLE:: theta(:)
......
......@@ -5,8 +5,10 @@
!--------------------------------------------------------------------------------
MODULE m_types_ssdisp
USE m_judft
USE m_types
USE m_types_forcetheo
USE m_judft
TYPE,EXTENDS(t_forcetheo) :: t_forcetheo_ssdisp
INTEGER :: q_done
REAL,ALLOCATABLE:: qvec(:,:)
......
......@@ -12,6 +12,8 @@ CONTAINS
cell,sphhar,stars,xcpot,mpi,oneD,hmat,vx)
USE m_types
USE m_judft
USE m_intgr, ONLY : intgr3
USE m_constants
USE m_gaunt, ONLY : gaunt1
......@@ -20,7 +22,6 @@ CONTAINS
USE m_radflo
USE m_radfun
USE m_abcof3
USE m_types
IMPLICIT NONE
......@@ -85,7 +86,9 @@ CONTAINS
COMPLEX :: carr(hybrid%maxlmindx,DIMENSION%nvd),carr1(DIMENSION%nvd,DIMENSION%nvd)
COMPLEX ,ALLOCATABLE :: ahlp(:,:,:),bhlp(:,:,:)
COMPLEX, ALLOCATABLE :: bascof(:,:,:)
#ifndef CPP_OLDINTEL
COMPLEX :: bascof_lo(3,-atoms%llod:atoms%llod,4*atoms%llod+2,atoms%nlod, atoms%nat)
#endif
CALL timestart("subvxc")
vxc=0
......@@ -132,9 +135,9 @@ CONTAINS
! Calculate bascof
ALLOCATE(ahlp(DIMENSION%nvd,0:DIMENSION%lmd,atoms%nat),bhlp(DIMENSION%nvd,0:DIMENSION%lmd,atoms%nat),stat=ok)
IF(ok.NE.0) STOP 'subvxc: error in allocation of ahlp/bhlp'
#ifndef CPP_OLDINTEL
CALL abcof3(input,atoms,sym,jsp,cell,bk,lapw,usdus,oneD,ahlp,bhlp,bascof_lo)
#endif
ALLOCATE(bascof(DIMENSION%nvd,2*(DIMENSION%lmd+1),atoms%nat), stat=ok)
IF(ok.NE.0) STOP 'subvxc: error in allocation of bascof'
......@@ -346,6 +349,9 @@ CONTAINS
IF(atoms%invsat(iatom).EQ.1) invsfct = 2
DO ilo = 1, atoms%nlo(itype)
#ifdef CPP_OLDINTEL
CALL judft_error ("no LOs & hybrid with old intel compiler!",calledby="subvxc.F90")
#else
l1 = atoms%llo(ilo,itype)
DO ikvec = 1, invsfct*(2*l1+1)
DO m1 = -l1, l1
......@@ -477,6 +483,7 @@ CONTAINS
icentry = ic
END DO !ikvec
ikvecat = ikvecat + invsfct*(2*l1+1)
#endif
END DO ! ilo
ikvecprevat = ikvecprevat + ikvecat
ikvecat = 0
......
......@@ -11,15 +11,17 @@ CONTAINS
input,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,&
sliceplot,banddos,obsolete,enpara,xcpot,kpts,hybrid,&
oneD,coreSpecInput,l_opti)
USE m_judft
USE m_types
USE m_judft
USE m_dimens
USE m_inped
USE m_setup
USE m_constants
USE m_winpXML
#ifdef CPP_MPI
#ifndef CPP_OLDINTEL
USE m_mpi_dist_forcetheorem
#endif
#endif
IMPLICIT NONE
......@@ -191,8 +193,9 @@ CONTAINS
CALL MPI_BCAST(namex,4,MPI_CHARACTER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(l_krla,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%ntype,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
#ifndef CPP_OLDINTEL
CALL mpi_dist_forcetheorem(mpi,forcetheo)
#endif
#endif
IF (mpi%irank.NE.0) THEN
CALL xcpot%init(namex,l_krla,atoms%ntype)
......
......@@ -2,7 +2,6 @@ set(fleur_F77 ${fleur_F77}
inpgen/atom_input.f
inpgen/atom_sym.f
inpgen/bravais_symm.f
inpgen/closure.f
inpgen/crystal.f
inpgen/element.f
inpgen/generator.f
......@@ -21,4 +20,5 @@ inpgen/write_struct.f
set(fleur_F90 ${fleur_F90}
inpgen/set_inp.f90
inpgen/inpgen_help.f90
inpgen/closure.f90
)
......@@ -27,7 +27,7 @@
INTEGER irot(3,3)
INTEGER lv1(3,neig12),lv2(3,neig12),lv3(3,neig12)
REAL, PARAMETER :: eps=1.0e-7
REAL, PARAMETER :: eps=1.0e-9
!---> set up metric for distances
amet = 0.0
......
MODULE m_closure
use m_juDFT
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Contains 3 subroutines that more or less check the closure:
! closure : checks whether the space group operations close
! close_pt: checks that the point group of the bravais
! lattice closes
! check_close: additionally calculate the multiplication table,
! inverse operations and also determines the type
! of every operation mw99,gs00
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
CONTAINS
SUBROUTINE closure(
> mops,mrot,tau,nops,index_op,
< lclose)
IMPLICIT NONE
INTEGER, INTENT (IN) :: mops ! number of operations of the bravais lattice
INTEGER, INTENT (IN) :: nops ! number of operations in space group
INTEGER, INTENT (IN) :: mrot(3,3,mops) ! refer to the operations of the
REAL, INTENT (IN) :: tau(3,mops) ! bravais lattice
INTEGER, INTENT (IN) :: index_op(nops) ! mapping function between space group
! op's and those of the bravais lattice
LOGICAL, INTENT (OUT) :: lclose
REAL ttau(3),eps7
INTEGER i,ii,j,jj,k,kk,mp(3,3),map(nops)
eps7 = 1.0e-7
!---> loop over all operations
DO jj=1,nops
j = index_op(jj)
map(1:nops) = 0
!---> multiply {R_j|t_j}{R_i|t_i}
DO ii=1,nops
i = index_op(ii)
mp = matmul( mrot(:,:,j) , mrot(:,:,i) )
ttau = tau(:,j) + matmul( mrot(:,:,j) , tau(:,i) )
ttau = ttau - anint( ttau - eps7 )
!---> determine which operation this is
DO kk=1,nops
k = index_op(kk)
IF ( all( mp(:,:) == mrot(:,:,k) ) .AND.
& all( abs( ttau(:)-tau(:,k) ) < eps7 ) ) THEN
IF ( map(ii) .eq. 0 ) THEN
map(ii) = kk
ELSE
write(6,*)'ERROR Closure: Multiplying ', jj,' with '
& ,kk, ' and with ',map(ii)
write(6,*) 'yields the same matrix'
lclose = .false.
RETURN
ENDIF
ENDIF
ENDDO
IF (map(ii).eq.0) THEN
write(6,*)'ERROR Closure:',ii,' times',jj,' leaves group'
lclose = .false.
RETURN
ENDIF
ENDDO
ENDDO
lclose = .true.
END SUBROUTINE closure
!*********************************************************************
SUBROUTINE close_pt(
> nops,mrot,
< mtable)
IMPLICIT NONE
INTEGER, INTENT (IN) :: nops,mrot(3,3,nops)
INTEGER, INTENT (OUT) :: mtable(nops,nops) ! table(i,j) = {R_i|0}{R_j|0}
INTEGER :: i,j,k,mp(3,3),map(nops)
!---> loop over all operations
DO j=1,nops
map(1:nops) = 0
!---> multiply {R_j|0}{R_i|0}
DO i=1,nops
mp = matmul( mrot(:,:,j) , mrot(:,:,i) )
!---> determine which operation this is
DO k = 1, nops
IF ( all( mp(:,:)==mrot(:,:,k) ) ) THEN
IF ( map(i) .eq. 0 ) THEN
map(i) = k
ELSE
WRITE (6,'(" Symmetry error : multiple ops")')
CALL juDFT_error("close_pt: Multiple ops (Bravais)"
+ ,calledby ="closure")
ENDIF
ENDIF
ENDDO
IF (map(i).eq.0) THEN
WRITE (6,'(" Group not closed (Bravais lattice)")')
WRITE (6,'(" operation j=",i2," map=",12i4,:/,
& (21x,12i4))') j, map(1:nops)
CALL juDFT_error("close_pt:Not closed",calledby="closure"
+ )
ENDIF
ENDDo
mtable(j,1:nops) = map(1:nops)
ENDDO
END SUBROUTINE close_pt
!*********************************************************************
SUBROUTINE check_close(
> nops,mrot,tau,
< multtab,inv_op,optype)
IMPLICIT NONE
!===> Arguments
INTEGER, INTENT (IN) :: nops
INTEGER, INTENT (IN) :: mrot(3,3,nops)
REAL, INTENT (IN) :: tau(3,nops)
INTEGER, INTENT (OUT) :: inv_op(nops)
INTEGER, INTENT (OUT) :: multtab(nops,nops)
INTEGER, INTENT (OUT) :: optype(nops)
!===> Local Variables
REAL ttau(3)
INTEGER i,j,n,k,mp(3,3),mdet,mtr
REAL, PARAMETER :: eps=1.0e-7
INTEGER, PARAMETER :: cops(-1:3)=(/ 2, 3, 4, 6, 1 /)
inv_op(1:nops) = 0
multtab = 0
!---> loop over all operations
DO j=1,nops
!---> multiply {R_j|t_j}{R_i|t_i}
DO i=1,nops
mp = matmul( mrot(:,:,j) , mrot(:,:,i) )
ttau = tau(:,j) + matmul( mrot(:,:,j) , tau(:,i) )
ttau = ttau - anint( ttau - eps )
!---> determine which operation this is
DO k=1,nops
IF ( all( mp(:,:) == mrot(:,:,k) ) .and.
& all( abs( ttau(:)-tau(:,k) ) < eps ) ) THEN
IF ( multtab(j,i) .eq. 0 ) THEN
multtab(j,i) = k
IF (k .eq. 1) inv_op(j)=i
ELSE
WRITE(6,'(" Symmetry error: multiple ops")')
CALL juDFT_error("check_close: Multiple ops",
+ calledby ="closure")
ENDIF
ENDIF
ENDDO
IF (multtab(j,i).eq.0) THEN
WRITE (6,'(" Group not closed")')
WRITE (6,'(" j , i =",2i4)') j,i
CALL juDFT_error("check_close: Not closed",calledby
+ ="closure")
ENDIF
ENDDO
ENDDO
!---> determine the type of each operation
DO n = 1, nops
mtr = mrot(1,1,n) + mrot(2,2,n) + mrot(3,3,n)
mdet =
& mrot(1,1,n)*(mrot(2,2,n)*mrot(3,3,n)-mrot(3,2,n)*mrot(2,3,n))
& +mrot(1,2,n)*(mrot(3,1,n)*mrot(2,3,n)-mrot(2,1,n)*mrot(3,3,n))
& +mrot(1,3,n)*(mrot(2,1,n)*mrot(3,2,n)-mrot(3,1,n)*mrot(2,2,n))
optype(n) = mdet*cops(mdet*mtr)
ENDDO
END SUBROUTINE check_close
END MODULE m_closure
MODULE m_closure
use m_juDFT
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -