Commit 43a6c2fa authored by Robin Hilgers's avatar Robin Hilgers

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

parents b0892a77 9a5a8edf
......@@ -13,13 +13,14 @@ MODULE m_types_fleurinput_base
!use ieee_module
#ifdef CPP_DEBUG
#ifdef CPP_IEEE_SUPPORT
REAL,PARAMETER :: REAL_NOT_INITALIZED=IEEE_VALUE(1.0,IEEE_SIGNALING_NAN)
REAL,PARAMETER :: REAL_NOT_INITALIZED=IEEE_VALUE(1.0,IEEE_SIGNALING_NAN)
#else
REAL,PARAMETER :: REAL_NOT_INITALIZED=TRANSFER(dsnan_pat, 1.0)
#endif
#else
REAL,PARAMETER :: REAL_NOT_INITALIZED=0.0
#endif
COMPLEX, PARAMETER :: CMPLX_NOT_INITALIZED=(REAL_NOT_INITALIZED,REAL_NOT_INITALIZED)
!This module defines an abstract datatype all fleurinput-datatypes should
!implement
......
......@@ -15,7 +15,7 @@ hybrid/hsfock.F90
hybrid/subvxc.F90
hybrid/add_Vnonlocal.F90
hybrid/hf_setup.F90
hybrid/kp_perturbation.F90
hybrid/kp_perturbation.f90
hybrid/symm_hf.F90
hybrid/trafo.F90
hybrid/exponential_integral.f90
......
......@@ -2048,7 +2048,7 @@ CONTAINS
USE m_juDFT
IMPLICIT NONE
LOGICAL, INTENT(IN) :: lwrite
INTEGER, INTENT(OUT) :: nptsh, nshell
INTEGER, INTENT(INOUT) :: nptsh, nshell
INTEGER, ALLOCATABLE :: ptsh(:, :)
REAL, ALLOCATABLE :: radsh(:)
REAL, INTENT(IN) :: rad, lat(:,:)
......@@ -2142,7 +2142,7 @@ CONTAINS
INTEGER, INTENT(IN) :: ngpt(:), gpt(:,:), pgpt(:, :)!(dim,kpts%nkpt)
REAL, ALLOCATABLE :: qnrm(:), help(:)
INTEGER, INTENT(OUT) :: nqnrm
INTEGER, INTENT(INOUT) :: nqnrm
INTEGER, ALLOCATABLE :: pqnrm(:, :)
INTEGER :: i, j, ikpt, igpt, igptp
REAL :: q(3), qnorm
......@@ -2187,7 +2187,7 @@ CONTAINS
INTEGER, INTENT(IN) :: itype, nqnrm, iqnrm1, iqnrm2, l
REAL, INTENT(IN) :: qnrm(nqnrm), sphbes0(-1:hybinp%lexp + 2, atoms%ntype, nqnrm)
LOGICAL, INTENT(IN), OPTIONAL :: l_warnin
LOGICAL, INTENT(OUT), OPTIONAL :: l_warnout
LOGICAL, INTENT(INOUT), OPTIONAL :: l_warnout
REAL :: sphbessel_integral
REAL :: q1, q2, dq, s, sb01, sb11, sb21, sb31, sb02, sb12
REAL :: sb22, sb32, a1, a2, da, b1, b2, db, c1, c2, dc, r1, r2
......
......@@ -453,7 +453,7 @@ CONTAINS
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_kpts), INTENT(IN) :: kpts
REAL, INTENT(OUT) :: divergence
REAL, INTENT(INOUT) :: divergence
INTEGER :: ix, iy, iz, sign, n
logical :: found
......
......@@ -25,7 +25,7 @@ contains
implicit none
real, intent(in) :: arg
real, intent(out) :: res
real, intent(inout) :: res
! For arguments smaller than 4 the series expansion is used
if (arg < series_laguerre) then
......
......@@ -39,7 +39,7 @@ CONTAINS
REAL, INTENT(IN) :: vr0(:, :, :)
LOGICAL, INTENT(IN) :: l_real
REAL, ALLOCATABLE, INTENT(OUT) :: eig_irr(:, :)
REAL, ALLOCATABLE, INTENT(INOUT) :: eig_irr(:, :)
! local type variables
TYPE(t_lapw) :: lapw
......
......@@ -312,7 +312,7 @@ CONTAINS
IMPLICIT NONE
REAL, INTENT(IN) :: bw_Hs2, bw_D_Hs2
REAL, INTENT(OUT) :: integral(0:12)
REAL, INTENT(INOUT) :: integral(0:12)
! Helper variables
REAL :: bw_Hs2_Sqr, bw_Hs2_Cub, sqrt_bw_Hs2, &
......@@ -326,6 +326,8 @@ CONTAINS
A = 1.0161144, A_2 = A/2.0, scale = 2.25/A, sqrtA = 1.008025, & !sqrt(A)
b = 1.455915450052607
integral = 0.0
! Calculate many helper variables
bw_Hs2_Sqr = bw_Hs2*bw_Hs2
bw_Hs2_Cub = bw_Hs2*bw_Hs2_Sqr
......
......@@ -141,7 +141,7 @@ CONTAINS
INTEGER, INTENT(OUT):: lmaxc(:)
! - arrays -
INTEGER, INTENT(OUT):: nindxcr(0:ncstd, atoms%ntype)
INTEGER, INTENT(INOUT):: nindxcr(0:ncstd, atoms%ntype)
REAL, INTENT(IN) :: vr(:, :, :)!(atoms%jmtd,atoms%ntypd,input%jspins)
REAL, ALLOCATABLE :: core1(:, :, :, :), core2(:, :, :, :)
REAL, ALLOCATABLE :: eig_c(:, :, :)
......
MODULE m_kp_perturbation
USE m_types_hybdat
USE m_types_hybdat
CONTAINS
SUBROUTINE ibs_correction( &
nk, atoms, &
input, jsp, &
hybdat, mpdata,hybinp, &
input, jsp, &
hybdat, mpdata, hybinp, &
lapw, kpts, nkpti, &
cell, mnobd, &
sym, &
......@@ -39,7 +39,7 @@ CONTAINS
! - arrays -
COMPLEX, INTENT(INOUT):: olap_ibsc(:,:,:,:)
COMPLEX, INTENT(INOUT):: olap_ibsc(:, :, :, :)
COMPLEX, INTENT(INOUT):: proj_ibsc(:, :, :)!(3,mnobd,hybdat%nbands(nk))
! - local scalars -
INTEGER :: i, itype, ieq, iatom, iatom1, iband, iband1
......@@ -104,7 +104,7 @@ CONTAINS
! read in z coefficient from direct access file z at k-point nk
call read_z(z, kpts%nkptf*(jsp - 1) + nk)
call read_z(z, kpts%nkptf*(jsp - 1) + nk)
! construct local orbital consisting of radial function times spherical harmonic
! where the radial function vanishes on the MT sphere boundary
......@@ -145,7 +145,7 @@ CONTAINS
END DO
! calculate lo wavefunction coefficients
allocate(cmt_lo(input%neig, -atoms%llod:atoms%llod, atoms%nlod, atoms%nat))
allocate (cmt_lo(input%neig, -atoms%llod:atoms%llod, atoms%nlod, atoms%nat))
cmt_lo = 0
iatom = 0
ic = 0
......@@ -222,7 +222,7 @@ CONTAINS
END DO
idum = maxval(lmp_start)
allocate(cmt_apw(input%neig, idum, atoms%nat))
allocate (cmt_apw(input%neig, idum, atoms%nat))
cmt_apw = 0
DO i = 1, lapw%nv(jsp)
kvec = kpts%bk(:, nk) + lapw%gvec(:, i, jsp)
......@@ -286,9 +286,9 @@ CONTAINS
! construct radial functions (complex) for the first order
! incomplete basis set correction
allocate(u1(atoms%jmtd, 3, mnobd, (atoms%lmaxd + 1)**2, atoms%nat), stat=ok)!hybdat%nbands
allocate (u1(atoms%jmtd, 3, mnobd, (atoms%lmaxd + 1)**2, atoms%nat), stat=ok)!hybdat%nbands
IF (ok /= 0) call judft_error('kp_perturbation: failure allocation u1')
allocate(u2(atoms%jmtd, 3, mnobd, (atoms%lmaxd + 1)**2, atoms%nat), stat=ok)!hybdat%nbands
allocate (u2(atoms%jmtd, 3, mnobd, (atoms%lmaxd + 1)**2, atoms%nat), stat=ok)!hybdat%nbands
IF (ok /= 0) call judft_error('kp_perturbation: failure allocation u2')
u1 = 0; u2 = 0
......@@ -706,18 +706,19 @@ CONTAINS
!
SUBROUTINE dwavefproducts( &
dcprod, nk, bandi1, bandf1, bandi2, bandf2, lwrite, &
input,atoms, mpdata, hybinp, &
input, atoms, mpdata, hybinp, &
cell, &
hybdat, kpts, nkpti, lapw, &
jsp, &
jsp, &
eig_irr)
USE m_wrapper
USE m_types
use m_constants, only: cmplx_0
IMPLICIT NONE
TYPE(t_hybdat), INTENT(IN) :: hybdat
TYPE(t_input),INTENT(IN) ::input
TYPE(t_input), INTENT(IN) ::input
TYPE(t_mpdata), intent(in) :: mpdata
TYPE(t_hybinp), INTENT(IN) :: hybinp
TYPE(t_cell), INTENT(IN) :: cell
......@@ -732,8 +733,8 @@ CONTAINS
! - arrays -
REAL, INTENT(IN) :: eig_irr(:,:)
COMPLEX, INTENT(OUT) :: dcprod(bandi2:bandf2, bandi1:bandf1, 3)
REAL, INTENT(IN) :: eig_irr(:, :)
COMPLEX, INTENT(INOUT) :: dcprod(bandi2:bandf2, bandi1:bandf1, 3)
! - local scalars -
INTEGER :: ikpt, ikpt1, iband1, iband2
......@@ -743,12 +744,13 @@ CONTAINS
! __
! Get momentum-matrix elements -i < uj | \/ | ui >
!
dcprod = cmplx_0
CALL momentum_matrix( &
dcprod, nk, bandi1, bandf1, bandi2, bandf2, &
input,atoms, mpdata, hybinp, &
input, atoms, mpdata, hybinp, &
cell, &
hybdat, kpts, lapw, &
jsp)
jsp)
! __
! Calculate expansion coefficients -i < uj | \/ | ui > / ( ei - ej ) for periodic function ui
......@@ -780,10 +782,10 @@ CONTAINS
!
SUBROUTINE momentum_matrix( &
momentum, nk, bandi1, bandf1, bandi2, bandf2, &
input,atoms, mpdata, hybinp, &
input, atoms, mpdata, hybinp, &
cell, &
hybdat, kpts, lapw, &
jsp)
jsp)
USE m_olap
USE m_wrapper
......@@ -793,8 +795,9 @@ CONTAINS
USE m_constants
USE m_types
USE m_io_hybinp
use m_constants, only: cmplx_0
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_input), INTENT(IN) :: input
TYPE(t_hybdat), INTENT(IN) :: hybdat
TYPE(t_mpdata), intent(in) :: mpdata
TYPE(t_hybinp), INTENT(IN) :: hybinp
......@@ -810,7 +813,7 @@ CONTAINS
! - arrays -
TYPE(t_mat):: z
COMPLEX, INTENT(OUT) :: momentum(bandi2:bandf2, bandi1:bandf1, 3)
COMPLEX, INTENT(INOUT) :: momentum(bandi2:bandf2, bandi1:bandf1, 3)
! - local scalars -
INTEGER :: itype, ieq, ic, i, j, l, lm, n1, n2, ikpt, iband1, iband2, ll, mm
......@@ -838,12 +841,12 @@ CONTAINS
COMPLEX :: vec1_c(lapw%nv(jsp)), vec2_c(lapw%nv(jsp)), vec3_c(lapw%nv(jsp))
! read in cmt coefficients from direct access file cmt at kpoint nk
momentum = cmplx_0
call read_cmt(cmt, nk)
! read in z coefficients from direct access file z at kpoint nk
call read_z(z, kpts%nkptf*(jsp - 1) + nk)
call read_z(z, kpts%nkptf*(jsp - 1) + nk)
!CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf)
gpt(:, 1:lapw%nv(jsp)) = lapw%gvec(:, 1:lapw%nv(jsp), jsp)
......
......@@ -170,7 +170,10 @@ CONTAINS
INTEGER, INTENT(IN) :: gpt(:, :)!(3,ngpt)
REAL, INTENT(IN) :: bas1(atoms%jmtd, maxval(mpdata%num_radfun_per_l), 0:atoms%lmaxd, atoms%ntype),&
bas2(atoms%jmtd, maxval(mpdata%num_radfun_per_l), 0:atoms%lmaxd, atoms%ntype)
REAL, INTENT(OUT) :: olapmt(maxval(mpdata%num_radfun_per_l), maxval(mpdata%num_radfun_per_l), 0:atoms%lmaxd, atoms%ntype)
REAL, INTENT(INOUT) :: olapmt(maxval(mpdata%num_radfun_per_l), &
maxval(mpdata%num_radfun_per_l), &
0:atoms%lmaxd, &
atoms%ntype)
TYPE(t_mat), INTENT(INOUT):: olappw
! - local -
......
......@@ -2,7 +2,7 @@
! read core radial wavefunctions from corebas
! corebas is written in cored.F
! (core basis functions can be read in once during an iteration)
! (core basis functions can be read in once during an iteration)
CONTAINS
......@@ -164,7 +164,7 @@
TYPE(t_atoms),INTENT(IN) :: atoms
! - scalars -
INTEGER,INTENT(IN) :: jsp
INTEGER,INTENT(IN) :: jsp
INTEGER,INTENT(IN) :: lmaxcd
INTEGER,INTENT(INOUT) :: maxindxc
......@@ -206,7 +206,7 @@
! average over core states that only differ in j
! core functions with l-qn equal 0 doesnot change during the average process
nindxc(0,:) = nindxcr(0,:)
DO itype=1,atoms%ntype
core1(:,:nindxc(0,itype),0,itype)&
......@@ -296,19 +296,19 @@
! - scalars -
INTEGER, INTENT (IN) :: ncstd
INTEGER, INTENT (IN) :: jspin
INTEGER, INTENT (IN) :: jspin
INTEGER, INTENT (OUT):: lmaxc(:)
! - arrays -
INTEGER, INTENT (OUT):: nindxcr(0:ncstd,atoms%ntype)
REAL , INTENT (IN) :: vr(:,:,:)!(atoms%jmtd,atoms%ntypd,input%jspins)
REAL , ALLOCATABLE :: core1(:,:,:,:),core2(:,:,:,:)
REAL , ALLOCATABLE :: eig_c(:,:,:)
! - arrays -
INTEGER, INTENT (INOUT) :: nindxcr(0:ncstd,atoms%ntype)
REAL , INTENT (IN) :: vr(:,:,:)!(atoms%jmtd,atoms%ntypd,input%jspins)
REAL , ALLOCATABLE :: core1(:,:,:,:),core2(:,:,:,:)
REAL , ALLOCATABLE :: eig_c(:,:,:)
! - local scalars -
INTEGER :: i,j,itype,korb,ncmsh,nst,ierr
REAL :: e,fj,fl,fn,t2,c,bmu,weight
REAL :: d,dxx,rn,rnot,z,t1,rr
REAL :: d,dxx,rn,rnot,z,t1,rr
LOGICAL, SAVE :: first = .true.
! - local arrays -
......@@ -348,11 +348,11 @@
! & nst,kappa,nprnc,occ_h)
call atoms%econf(itype)%get_core(nst,kappa,nprnc,occ_h)
IF ((bmu > 99.)) THEN
occ(1:nst) = input%jspins * occ_h(1:nst,jspin)
ELSE
occ(1:nst) = occ_h(1:nst,1)
occ(1:nst) = occ_h(1:nst,1)
END IF
rnot = atoms%rmsh(1,itype)
d = exp(atoms%dx(itype))
......@@ -395,7 +395,7 @@
IF ((bmu > 99.)) THEN
occ(1:nst) = input%jspins * occ_h(1:nst,jspin)
ELSE
occ(1:nst) = occ_h(1:nst,1)
occ(1:nst) = occ_h(1:nst,1)
END IF
rnot = atoms%rmsh(1,itype)
d = exp(atoms%dx(itype))
......@@ -486,15 +486,15 @@
TYPE(t_atoms),INTENT(IN) :: atoms
INTEGER,INTENT(OUT) :: maxindxc,lmaxcd
! - local scalars -
INTEGER :: i,j,itype,korb,ncmsh,nst,ierr
REAL :: e,fj,fl,fn,t,bmu,c
REAL :: d,dxx,rn,rnot,z,t1,rr
REAL :: d,dxx,rn,rnot,z,t1,rr
! - local arrays -
INTEGER :: kappa(29),nprnc(29)
INTEGER :: nindxcr(0:29,atoms%ntype)
INTEGER :: nindxcr(0:29,atoms%ntype)
REAL :: occ(29),occ_h(29,2),a(atoms%msh),b(atoms%msh)
INTEGER :: lmaxc(atoms%ntype)
......@@ -515,7 +515,7 @@
!CALL setcor(itype,input%jspins,atoms,input,bmu, nst,kappa,nprnc,occ_h)
call atoms%econf(itype)%get_core(nst,nprnc,kappa,occ_h)
occ(1:nst) = occ_h(1:nst,1)
occ(1:nst) = occ_h(1:nst,1)
rnot = atoms%rmsh(1,itype)
d = exp(atoms%dx(itype))
......
......@@ -102,10 +102,11 @@ CONTAINS
! - arrays -
INTEGER, INTENT(IN) :: rrot(:,:,:)
INTEGER, INTENT(IN) :: psym(:)
INTEGER, INTENT(OUT) :: parent(kpts%nkptf)
INTEGER, INTENT(OUT) :: nsest(hybdat%nbands(nk)), indx_sest(hybdat%nbands(nk), hybdat%nbands(nk))
INTEGER, ALLOCATABLE, INTENT(OUT) :: pointer_EIBZ(:)
INTEGER, ALLOCATABLE, INTENT(OUT) :: n_q(:)
INTEGER, INTENT(INOUT) :: parent(kpts%nkptf)
INTEGER, INTENT(INOUT) :: nsest(hybdat%nbands(nk))
INTEGER, INTENT(INOUT) :: indx_sest(hybdat%nbands(nk), hybdat%nbands(nk))
INTEGER, ALLOCATABLE, INTENT(INOUT) :: pointer_EIBZ(:)
INTEGER, ALLOCATABLE, INTENT(INOUT) :: n_q(:)
REAL, INTENT(IN) :: eig_irr(:,:)
......@@ -145,6 +146,8 @@ CONTAINS
COMPLEX, ALLOCATABLE :: rep_d(:, :, :)
LOGICAL, ALLOCATABLE :: symequivalent(:, :)
parent = 0; nsest = 0; indx_sest = 0;
WRITE (6, '(A)') new_line('n')//new_line('n')//'### subroutine: symm ###'
! determine extented irreducible BZ of k ( EIBZ(k) ), i.e.
......@@ -197,7 +200,7 @@ CONTAINS
END DO
nkpt_EIBZ = ic
allocate(pointer_EIBZ(nkpt_EIBZ))
allocate(pointer_EIBZ(nkpt_EIBZ), source=0)
ic = 0
DO ikpt = 1, kpts%nkptf
IF (parent(ikpt) == ikpt) THEN
......@@ -210,9 +213,8 @@ CONTAINS
! determine the factor n_q, that means the number of symmetrie operations of the little group of bk(:,nk)
! which keep q (in EIBZ) invariant
allocate(n_q(nkpt_EIBZ))
allocate(n_q(nkpt_EIBZ), source=0)
ic = 0
n_q = 0
DO ikpt = 1, kpts%nkptf
......
......@@ -35,8 +35,8 @@ CONTAINS
LOGICAL, INTENT(IN) :: l_real
REAL, INTENT(IN) :: z_r(:,:)
COMPLEX, INTENT(IN) :: z_c(:,:)
COMPLEX, INTENT(OUT) :: cmt_out(hybdat%maxlmindx, atoms%nat, ndb)
COMPLEX, INTENT(OUT) :: z_out(lapw%nv(jsp), ndb)
COMPLEX, INTENT(INOUT) :: cmt_out(hybdat%maxlmindx, atoms%nat, ndb)
COMPLEX, INTENT(INOUT) :: z_out(lapw%nv(jsp), ndb)
! - local -
......@@ -544,6 +544,7 @@ CONTAINS
USE m_constants
USE m_util
USE m_types
use m_types_fleurinput_base, only: REAL_NOT_INITALIZED,CMPLX_NOT_INITALIZED
IMPLICIT NONE
type(t_mpdata), intent(in) :: mpdata
TYPE(t_hybinp), INTENT(IN) :: hybinp
......@@ -560,9 +561,9 @@ CONTAINS
LOGICAL, INTENT(IN) :: l_real
REAL, INTENT(IN) :: vecin_r(:,:,:)
REAL, INTENT(OUT) :: vecout_r(:,:,:)
REAL, INTENT(INOUT) :: vecout_r(:,:,:)
COMPLEX, INTENT(IN) :: vecin_c(:,:,:)
COMPLEX, INTENT(OUT) :: vecout_c(:,:,:)
COMPLEX, INTENT(INOUT) :: vecout_c(:,:,:)
COMPLEX, INTENT(OUT) :: phase(:,:)
! - local -
......@@ -751,8 +752,10 @@ CONTAINS
if (l_real) THEN
vecout_r = real(vecout1)
vecout_c = CMPLX_NOT_INITALIZED
else
vecout_c = vecout1
vecout_r = REAL_NOT_INITALIZED
endif
deallocate(vecout1)
call timestop("bra trafo")
......
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