Commit ebae25c6 authored by Henning Janssen's avatar Henning Janssen

Merge remote-tracking branch 'origin/develop' into develop

parents 248cdd03 9c2ee045
......@@ -13,6 +13,7 @@ MODULE m_alignSpinAxisMagn
USE m_magnMomFromDen
USE m_types
USE m_types_fleurinput
USE m_flipcdn
USE m_constants
USE m_polangle
......@@ -22,7 +23,7 @@ CONTAINS
SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars&
,sym,oneD,cell,noco,input,atoms,den)
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_noco), INTENT(INOUT) :: noco
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum
......@@ -33,21 +34,21 @@ SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars&
TYPE(t_potden), INTENT(INOUT) :: den
REAL :: moments(3,atoms%ntype)
REAL :: phiTemp(atoms%ntype),thetaTemp(atoms%ntype),pi
REAL :: phiTemp(atoms%ntype),thetaTemp(atoms%ntype)
INTEGER :: i
pi=pimach()
!!TEMP
! REAL :: x,y,z
phiTemp=noco%alph
thetaTemp=noco%beta
CALL magnMomFromDen(input,atoms,noco,den,moments,thetaTemp,phiTemp)
! DO i=1, atoms%ntype
! IF (abs(atoms%theta_mt_avg(i)).LE. 0.001) THEN
! atoms%phi_mt_avg(i)=0.0
! atoms%theta_mt_avg(i)=0.0
! END IF
! END DO
!DO i=1, atoms%ntype
! IF (abs(atoms%theta_mt_avg(i)).LE. 0.0001) THEN
! atoms%phi_mt_avg(i)=0.0
! atoms%theta_mt_avg(i)=0.0
! END IF
!END DO
!write(*,*) "mx1"
!write(*,*) moments(1,1)
!write(*,*) "mz1"
......@@ -63,24 +64,23 @@ SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars&
!CALL sphericaltocart(SQRT(moments(2,1)**2+moments(2,2)**2+moments(2,3)**2),thetaTemp(2),phiTemp(2),x,y,z)
!write(*,*) x,y,z
!write(*,*) "atoms%phi_mt_avg"
!!write(*,*) atoms%phi_mt_avg
!write(*,*) atoms%phi_mt_avg
!write(*,*) "atoms%theta_mt_avg"
!write(*,*) atoms%theta_mt_avg
noco%alph=mod(noco%alph+phiTemp,2*pimach())
noco%beta=mod(noco%alph+thetaTemp,2*pimach())
DO i=1, atoms%ntype
IF(noco%alph(i)<0) noco%alph(i)=noco%alph(i)+2*pi
IF(noco%beta(i)<0) THEN
noco%beta(i)=-noco%beta(i)
noco%alph=noco%alph+pi
END IF
IF(noco%beta(i)>pi) THEN
noco%beta(i)=pi-mod(noco%beta(i),pi)
noco%alph(i)=noco%alph(i)+pi
END IF
noco%alph=mod(noco%alph,2*pi)
End Do
noco%beta=mod(noco%beta+thetaTemp,pimach())
!DO i=1, atoms%ntype
! IF(noco%alph(i)<0) noco%alph(i)=noco%alph(i)+2*pi
! IF(noco%beta(i)<0) THEN
! noco%beta(i)=-noco%beta(i)
! noco%alph=noco%alph+pi
!END IF
! IF(noco%beta(i)>pi) THEN
! noco%beta(i)=pi-mod(noco%beta(i),pi)
! noco%alph(i)=noco%alph(i)+pi
! END IF
! noco%alph=mod(noco%alph,2*pi)
!End Do
write(*,*) "Noco Phi"
write(*,*) noco%alph
write(*,*) "Noco Theta"
......
......@@ -18,6 +18,7 @@ CONTAINS
SUBROUTINE magnMomFromDen(input,atoms,noco,den,moments,theta_mt_avg,phi_mt_avg)
USE m_constants
USE m_types
USE m_types_fleurinput
USE m_intgr
USE m_juDFT
USE m_polangle
......
......@@ -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, PUBLIC :: 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
......@@ -999,10 +1001,10 @@ CONTAINS
REAL, INTENT(IN) :: taual(:,:)
! array output
REAL, INTENT(OUT) :: potential(noGPts) ! Fourier transformed potential
COMPLEX, INTENT(OUT) :: muffintin(noGPts, maxindxm, & ! muffin-tin overlap integral
REAL, INTENT(INOUT) :: potential(noGPts) ! Fourier transformed potential
COMPLEX, INTENT(INOUT) :: muffintin(noGPts, maxindxm, & ! muffin-tin overlap integral
(maxlcutm + 1)**2, ntype, MAXVAL(neq))
COMPLEX, INTENT(OUT) :: interstitial(noGPts, gptmd) ! interstistial overlap intergral
COMPLEX, INTENT(INOUT) :: interstitial(noGPts, gptmd) ! interstistial overlap intergral
! private scalars
INTEGER :: cg, cg2, ci, cl, cn, cr ! counter variables
......@@ -1334,11 +1336,11 @@ CONTAINS
REAL, INTENT(IN) :: taual(:,:)
! array output
REAL, INTENT(OUT) :: potential(noGPts) ! Fourier transformed potential
REAL, INTENT(INOUT) :: potential(noGPts) ! Fourier transformed potential
#ifdef CPP_INVERSION
REAL, INTENT(OUT) :: fourier_trafo(nbasp, noGPts) !muffintin_out(nbasp,noGPts)
REAL, INTENT(INOUT) :: fourier_trafo(nbasp, noGPts) !muffintin_out(nbasp,noGPts)
#else
COMPLEX, INTENT(OUT) :: fourier_trafo(nbasp, noGPts) !muffintin_out(nbasp,noGPts)
COMPLEX, INTENT(INOUT) :: fourier_trafo(nbasp, noGPts) !muffintin_out(nbasp,noGPts)
#endif
! private scalars
......
......@@ -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
......@@ -794,7 +796,7 @@ CONTAINS
USE m_types
USE m_io_hybinp
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 +812,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 +840,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,10 +561,10 @@ 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(OUT) :: phase(:,:)
COMPLEX, INTENT(INOUT) :: vecout_c(:,:,:)
COMPLEX, INTENT(INOUT) :: phase(:,:)
! - local -
......@@ -582,6 +583,7 @@ CONTAINS
-maxval(hybinp%lcutm1):maxval(hybinp%lcutm1), 0:maxval(hybinp%lcutm1))
COMPLEX, ALLOCATABLE :: vecin1(:, :, :), vecout1(:, :, :)
phase = cmplx_0
call timestart("bra trafo")
allocate(vecin1(hybdat%nbasm(ikpt), nobd, nbands), &
......@@ -751,8 +753,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")
......
......@@ -38,7 +38,7 @@ CONTAINS
INTEGER, INTENT(OUT) :: nkqpt
! - arrays -
REAL, INTENT(OUT) :: cprod(hybdat%maxbasm1, bandoi:bandof, bandf - bandi + 1)
REAL, INTENT(INOUT) :: cprod(hybdat%maxbasm1, bandoi:bandof, bandf - bandi + 1)
! - local scalars -
INTEGER :: g_t(3)
......@@ -46,6 +46,7 @@ CONTAINS
CALL timestart("wavefproducts_inv5")
cprod = 0.0
kqpthlp = kpts%bkf(:, nk) + kpts%bkf(:, iq)
! kqpt can lie outside the first BZ, transfer it back
kqpt = kpts%to_first_bz(kqpthlp)
......@@ -92,7 +93,7 @@ CONTAINS
INTEGER, INTENT(IN) :: nkqpt
! - arrays -
REAL, INTENT(OUT) :: cprod(hybdat%maxbasm1, bandoi:bandof, bandf - bandi + 1)
REAL, INTENT(INOUT) :: cprod(hybdat%maxbasm1, bandoi:bandof, bandf - bandi + 1)
! - local scalars -
INTEGER :: ic, ig, ig2, ig1, ok, igptm, iigptm
......
......@@ -8,6 +8,7 @@ CONTAINS
nkqpt, cprod)
USE m_types
use m_juDFT
use m_constants, only: cmplx_0
IMPLICIT NONE
TYPE(t_input), INTENT(IN) :: input
......@@ -29,13 +30,14 @@ CONTAINS
! - arrays -
COMPLEX, INTENT(OUT) :: cprod(hybdat%maxbasm1, bandoi:bandof, bandf - bandi + 1)
COMPLEX, INTENT(INOUT) :: cprod(hybdat%maxbasm1, bandoi:bandof, bandf - bandi + 1)
INTEGER :: g_t(3)
REAL :: kqpt(3), kqpthlp(3)
call timestart("wavefproducts_noinv5")
cprod = cmplx_0
! calculate nkpqt
kqpthlp = kpts%bkf(:,nk) + kpts%bkf(:,iq)
......@@ -86,7 +88,7 @@ CONTAINS
! - arrays -
COMPLEX, INTENT(OUT) :: cprod(hybdat%maxbasm1, bandoi:bandof, bandf - bandi + 1)
COMPLEX, INTENT(INOUT) :: cprod(hybdat%maxbasm1, bandoi:bandof, bandf - bandi + 1)
! - local scalars -
INTEGER :: ic, n1, n2
......
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