Commit 2f2b863a authored by Gregor Michalicek's avatar Gregor Michalicek

Introduce oUnit to files in hybrid directory

parent f5d75aec
......@@ -46,6 +46,8 @@ CONTAINS
input, kpts, jsp, results,&
xcpot, noco,nococonv, hmat)
USE m_types
USE m_constants
USE m_symm_hf, ONLY: symm_hf
USE m_intgrf, ONLY: intgrf, intgrf_init
USE m_exchange_valence_hf
......@@ -53,7 +55,6 @@ CONTAINS
USE m_symmetrizeh
USE m_wrapper
USE m_hsefunctional, ONLY: exchange_vccvHSE, exchange_ccccHSE
USE m_types
USE m_io_hybinp
IMPLICIT NONE
......@@ -104,9 +105,9 @@ CONTAINS
#ifdef CPP_EXPLICIT_HYB
! calculate HF energy
IF (hybdat%l_calhf) THEN
WRITE (6, '(A)') new_line('n')//new_line('n')//' ### '//' diagonal HF exchange elements (eV) ###'
WRITE (oUnit, '(A)') new_line('n')//new_line('n')//' ### '//' diagonal HF exchange elements (eV) ###'
WRITE (6, '(A)') new_line('n')//' k-point '//'band tail pole total(valence+core)'
WRITE (oUnit, '(A)') new_line('n')//' k-point '//'band tail pole total(valence+core)'
END IF
#endif
......@@ -132,9 +133,9 @@ CONTAINS
results%te_hfex%valence = results%te_hfex%valence - a_ex*results%w_iks(iband, nk, jsp)*exch(iband, iband)
END IF
IF (hybdat%l_calhf) THEN
WRITE (6, '( '' ('',F5.3,'','',F5.3,'','',F5.3,'')'',I4,4X,3F15.5)') &
kpts%bkf(:, nk), iband, (REAL(exch(iband, iband)) - hybdat%div_vv(iband, nk, jsp))*(-27.211608), &
hybdat%div_vv(iband, nk, jsp)*(-27.211608), REAL(exch(iband, iband))*(-27.211608)
WRITE (oUnit, '( '' ('',F5.3,'','',F5.3,'','',F5.3,'')'',I4,4X,3F15.5)') &
kpts%bkf(:, nk), iband, (REAL(exch(iband, iband)) - hybdat%div_vv(iband, nk, jsp))*(-hartree_to_ev_const), &
hybdat%div_vv(iband, nk, jsp)*(-hartree_to_ev_const), REAL(exch(iband, iband))*(-hartree_to_ev_const)
END IF
END DO
END SUBROUTINE add_vnonlocal
......
......@@ -2,12 +2,9 @@ MODULE m_checkolap
CONTAINS
SUBROUTINE checkolap(atoms, hybdat, &
mpdata, hybinp, &
nkpti, kpts, &
mpi, &
input, sym, noco, nococonv, oneD, &
cell, lapw, jsp)
SUBROUTINE checkolap(atoms, hybdat, mpdata, hybinp, nkpti, kpts, mpi, &
input, sym, noco, nococonv, oneD, cell, lapw, jsp)
USE m_util, ONLY: chr, sphbessel, harmonicsr
use m_intgrf, only: intgrf, intgrf_init
use m_calc_cmt
......@@ -80,7 +77,7 @@ CONTAINS
call z(ikpt)%alloc(sym%invs, nbasfcn, input%neig)
ENDDO
IF(mpi%irank == 0) WRITE(6, '(//A)') '### checkolap ###'
IF(mpi%irank == 0) WRITE(oUnit, '(//A)') '### checkolap ###'
cmt = 0
......@@ -100,26 +97,26 @@ CONTAINS
cmt(:hybdat%nbands(ikpt), :, :, ikpt))
END DO
IF(mpi%irank == 0) WRITE(6, '(/A)') ' Overlap <core|core>'
IF(mpi%irank == 0) WRITE(oUnit, '(/A)') ' Overlap <core|core>'
DO itype = 1, atoms%ntype
IF(atoms%ntype > 1 .AND. mpi%irank == 0) &
WRITE(6, '(A,I3)') ' Atom type', itype
WRITE(oUnit, '(A,I3)') ' Atom type', itype
DO l = 0, hybdat%lmaxc(itype)
DO i = 1, hybdat%nindxc(l, itype)
IF(mpi%irank == 0) &
WRITE(6, '(1x,I1,A,2X)', advance='no') i + l, lchar(l)
WRITE(oUnit, '(1x,I1,A,2X)', advance='no') i + l, lchar(l)
DO j = 1, i
integrand = hybdat%core1(:, i, l, itype)*hybdat%core1(:, j, l, itype) &
+ hybdat%core2(:, i, l, itype)*hybdat%core2(:, j, l, itype)
IF(mpi%irank == 0) WRITE(6, '(F10.6)', advance='no') &
IF(mpi%irank == 0) WRITE(oUnit, '(F10.6)', advance='no') &
intgrf(integrand, atoms, itype, hybdat%gridf)
END DO
IF(mpi%irank == 0) WRITE(6, *)
IF(mpi%irank == 0) WRITE(oUnit, *)
END DO
END DO
END DO
IF(mpi%irank == 0) WRITE(6, '(/A)') ' Overlap <core|basis>'
IF(mpi%irank == 0) WRITE(oUnit, '(/A)') ' Overlap <core|basis>'
allocate(olapcb(maxval(mpdata%num_radfun_per_l)), olapcv(maxval(hybdat%nbands), nkpti), &
olapcv_avg(-hybdat%lmaxcd:hybdat%lmaxcd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype), &
olapcv_max(-hybdat%lmaxcd:hybdat%lmaxcd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype), &
......@@ -127,15 +124,15 @@ CONTAINS
DO itype = 1, atoms%ntype
IF(atoms%ntype > 1 .AND. mpi%irank == 0) &
WRITE(6, '(A,I3)') ' Atom type', itype
WRITE(oUnit, '(A,I3)') ' Atom type', itype
DO l = 0, hybdat%lmaxc(itype)
IF(l > atoms%lmax(itype)) EXIT ! very improbable case
IF(mpi%irank == 0) &
WRITE(6, "(9X,'u(',A,')',4X,'udot(',A,')',:,3X,'ulo(',A,"// &
WRITE(oUnit, "(9X,'u(',A,')',4X,'udot(',A,')',:,3X,'ulo(',A,"// &
"') ...')")(lchar(l), i=1, min(3, mpdata%num_radfun_per_l(l, itype)))
DO i = 1, hybdat%nindxc(l, itype)
IF(mpi%irank == 0) &
WRITE(6, '(1x,I1,A,2X)', advance='no') i + l, lchar(l)
WRITE(oUnit, '(1x,I1,A,2X)', advance='no') i + l, lchar(l)
DO j = 1, mpdata%num_radfun_per_l(l, itype)
integrand = hybdat%core1(:, i, l, itype)*hybdat%bas1(:, j, l, itype) &
......@@ -145,7 +142,7 @@ CONTAINS
intgrf(integrand, atoms, itype, hybdat%gridf)
IF(mpi%irank == 0) &
WRITE(6, '(F10.6)', advance='no') olapcb(j)
WRITE(oUnit, '(F10.6)', advance='no') olapcb(j)
END DO
lm = sum([(mpdata%num_radfun_per_l(j, itype)*(2*j + 1), j=0, l - 1)])
......@@ -165,32 +162,32 @@ CONTAINS
olapcv_max(m, i, l, itype) = rdum1
olapcv_loc(:, m, i, l, itype) = iarr
END DO
IF(mpi%irank == 0) WRITE(6, *)
IF(mpi%irank == 0) WRITE(oUnit, *)
END DO
END DO
END DO
IF(mpi%irank == 0) THEN
WRITE(6, '(/A)') ' Average overlap <core|val>'
WRITE(oUnit, '(/A)') ' Average overlap <core|val>'
DO itype = 1, atoms%ntype
IF(atoms%ntype > 1) write(6, '(A,I3)') ' Atom type', itype
IF(atoms%ntype > 1) write(oUnit, '(A,I3)') ' Atom type', itype
DO l = 0, hybdat%lmaxc(itype)
DO i = 1, hybdat%nindxc(l, itype)
WRITE(6, '(1x,I1,A,2X)', advance='no') i + l, lchar(l)
WRITE(6, '('//chr(2*l + 1)//'F10.6)') &
WRITE(oUnit, '(1x,I1,A,2X)', advance='no') i + l, lchar(l)
WRITE(oUnit, '('//chr(2*l + 1)//'F10.6)') &
olapcv_avg(-l:l, i, l, itype)
END DO
END DO
END DO
WRITE(6, '(/A)') ' Maximum overlap <core|val> at (band/kpoint)'
WRITE(oUnit, '(/A)') ' Maximum overlap <core|val> at (band/kpoint)'
DO itype = 1, atoms%ntype
IF(atoms%ntype > 1) write(6, '(A,I3)') ' Atom type', itype
IF(atoms%ntype > 1) write(oUnit, '(A,I3)') ' Atom type', itype
DO l = 0, hybdat%lmaxc(itype)
DO i = 1, hybdat%nindxc(l, itype)
WRITE(6, '(1x,I1,A,2X)', advance='no') i + l, lchar(l)
WRITE(6, '('//chr(2*l + 1)// &
WRITE(oUnit, '(1x,I1,A,2X)', advance='no') i + l, lchar(l)
WRITE(oUnit, '('//chr(2*l + 1)// &
'(F10.6,'' ('',I3.3,''/'',I4.3,'')''))') &
(olapcv_max(m, i, l, itype), &
olapcv_loc(:, m, i, l, itype), m=-l, l)
......@@ -201,38 +198,38 @@ CONTAINS
deallocate(olapcb, olapcv, olapcv_avg, olapcv_max, olapcv_loc)
IF(mpi%irank == 0) WRITE(6, '(/A)') ' Overlap <basis|basis>'
IF(mpi%irank == 0) WRITE(oUnit, '(/A)') ' Overlap <basis|basis>'
DO itype = 1, atoms%ntype
IF(atoms%ntype > 1 .AND. mpi%irank == 0) &
WRITE(6, '(A,I3)') ' Atom type', itype
WRITE(oUnit, '(A,I3)') ' Atom type', itype
DO l = 0, atoms%lmax(itype)
DO i = 1, mpdata%num_radfun_per_l(l, itype)
IF(mpi%irank == 0) THEN
SELECT CASE(i)
CASE(1)
WRITE(6, '(1x,'' u('',A,'')'')', advance='no') lchar(l)
WRITE(oUnit, '(1x,'' u('',A,'')'')', advance='no') lchar(l)
CASE(2)
WRITE(6, '(1x,''udot('',A,'')'')', advance='no') lchar(l)
WRITE(oUnit, '(1x,''udot('',A,'')'')', advance='no') lchar(l)
CASE DEFAULT
WRITE(6, '(1x,'' ulo('',A,'')'')', advance='no') lchar(l)
WRITE(oUnit, '(1x,'' ulo('',A,'')'')', advance='no') lchar(l)
END SELECT
END IF
DO j = 1, i
integrand = hybdat%bas1(:, i, l, itype)*hybdat%bas1(:, j, l, itype) &
+ hybdat%bas2(:, i, l, itype)*hybdat%bas2(:, j, l, itype)
IF(mpi%irank == 0) WRITE(6, '(F10.6)', advance='no') &
IF(mpi%irank == 0) WRITE(oUnit, '(F10.6)', advance='no') &
intgrf(integrand, atoms, itype, hybdat%gridf)
END DO
IF(mpi%irank == 0) WRITE(6, *)
IF(mpi%irank == 0) WRITE(oUnit, *)
END DO
END DO
END DO
IF(.not. l_mism) RETURN
IF(mpi%irank == 0) WRITE(6, '(/A)') &
IF(mpi%irank == 0) WRITE(oUnit, '(/A)') &
'Mismatch of wave functions at the MT-sphere boundaries'
allocate(carr1(maxval(hybdat%nbands),(atoms%lmaxd + 1)**2))
allocate(carr2(maxval(hybdat%nbands),(atoms%lmaxd + 1)**2))
......@@ -243,8 +240,8 @@ CONTAINS
DO ineq = 1, atoms%neq(itype)
iatom = iatom + 1
IF(mpi%irank == 0) THEN
if(atoms%nat > 1) WRITE(6, '(2X,A,I3)') 'Atom', iatom
WRITE(6, '(2X,A)') 'k-point average ( maximum )'
if(atoms%nat > 1) WRITE(oUnit, '(2X,A,I3)') 'Atom', iatom
WRITE(oUnit, '(2X,A)') 'k-point average ( maximum )'
END IF
DO ikpt = 1, nkpti
......
......@@ -39,7 +39,7 @@ CONTAINS
USE m_types
USE m_types_hybdat
USE m_juDFT
USE m_constants, ONLY: tpi_const, fpi_const
USE m_constants
USE m_trafo, ONLY: symmetrize, bramat_trafo
USE m_intgrf, ONLY: intgrf, intgrf_init
use m_util, only: primitivef
......@@ -142,7 +142,7 @@ CONTAINS
! Calculate the structure constant
CALL structureconstant(structconst, fi%cell, fi%hybinp, fi%atoms, fi%kpts, mpi)
IF (mpi%irank == 0) WRITE (6, '(//A)') '### subroutine: coulombmatrix ###'
IF (mpi%irank == 0) WRITE (oUnit, '(//A)') '### subroutine: coulombmatrix ###'
!
! Matrix allocation
......@@ -159,7 +159,7 @@ CONTAINS
call timestop("coulomb allocation")
IF (mpi%irank == 0) then
write (6,*) "Size of coulomb matrix: " //&
write (oUnit,*) "Size of coulomb matrix: " //&
float2str(sum([(coulomb(i)%size_mb(), i=1,fi%kpts%nkpt)])) // " MB"
endif
......@@ -1238,10 +1238,10 @@ CONTAINS
SUBROUTINE structureconstant(structconst, cell, hybinp, atoms, kpts, mpi)
USE m_constants, ONLY: pi_const, tpi_const, fpi_const
USE m_rorder, ONLY: rorderp, rorderpf
USE m_types
USE m_juDFT
USE m_types
USE m_constants
USE m_rorder, ONLY: rorderp, rorderpf
use m_ylm
IMPLICIT NONE
......@@ -1304,8 +1304,8 @@ CONTAINS
END DO
IF (first) THEN
WRITE (6, '(//A)') '### subroutine: structureconstant ###'
WRITE (6, '(/A)') 'Real-space sum:'
WRITE (oUnit, '(//A)') '### subroutine: structureconstant ###'
WRITE (oUnit, '(/A)') 'Real-space sum:'
END IF
!
......@@ -1358,8 +1358,8 @@ CONTAINS
call timestop("fourier space")
IF (first) THEN
WRITE (6, '(/A,2F10.5)') 'Cutoff radii: ', rad, rrad
WRITE (6, '(/A)') 'Real-space sum'
WRITE (oUnit, '(/A,2F10.5)') 'Cutoff radii: ', rad, rrad
WRITE (oUnit, '(/A)') 'Real-space sum'
END IF
!
......@@ -1460,7 +1460,7 @@ CONTAINS
deallocate (ptsh, radsh)
IF (first) WRITE (6, '(/A)') 'Fourier-space sum'
IF (first) WRITE (oUnit, '(/A)') 'Fourier-space sum'
!
! Determine reciprocal shells
......@@ -1574,7 +1574,7 @@ CONTAINS
END DO
a = SQRT(a/atoms%nat**2)
aa = SQRT(SUM(ABS(structconst(1, :, :, ikpt))**2)/atoms%nat**2)
IF (first) WRITE (6, '(/A,F8.5,A,F8.5,A)') 'Accuracy of Gamma-decomposition (structureconstant):', a, ' (abs)', a/aa, ' (rel)'
IF (first) WRITE (oUnit, '(/A,F8.5,A,F8.5,A)') 'Accuracy of Gamma-decomposition (structureconstant):', a, ' (abs)', a/aa, ' (rel)'
ENDIF
deallocate (ptsh, radsh)
......@@ -1589,9 +1589,13 @@ CONTAINS
! The lattice points (number = nptsh) are stored in ptsh, their corresponding lengths (shell radii) in radsh.
SUBROUTINE getshells(ptsh, nptsh, radsh, nshell, rad, lat, lwrite)
USE m_rorder, ONLY: rorderpf
USE m_juDFT
USE m_constants
USE m_rorder, ONLY: rorderpf
IMPLICIT NONE
LOGICAL, INTENT(IN) :: lwrite
INTEGER, INTENT(INOUT) :: nptsh, nshell
INTEGER, ALLOCATABLE :: ptsh(:, :)
......@@ -1669,7 +1673,7 @@ CONTAINS
END DO
IF (lwrite) &
WRITE (6, '(A,F10.5,A,I7,A,I5,A)') &
WRITE (oUnit, '(A,F10.5,A,I7,A,I5,A)') &
' Sphere of radius', rad, ' contains', &
nptsh, ' lattice points and', nshell, ' shells.'
......@@ -1725,7 +1729,10 @@ CONTAINS
sphbes0, l_warnin, l_warnout)
USE m_types
USE m_constants
IMPLICIT NONE
TYPE(t_hybinp), INTENT(IN) :: hybinp
TYPE(t_atoms), INTENT(IN) :: atoms
......@@ -1791,17 +1798,17 @@ CONTAINS
! Ensure numerical stability. If both formulas are not sufficiently stable, the program stops.
IF (r1 > r2) THEN
IF (r1 < 1e-6 .AND. l_warn) THEN
WRITE (6, '(A,E12.5,A,E12.5,A)') 'sphbessel_integral: Warning! Formula One possibly unstable. Ratios:', &
WRITE (oUnit, '(A,E12.5,A,E12.5,A)') 'sphbessel_integral: Warning! Formula One possibly unstable. Ratios:', &
r1, '(', r2, ')'
WRITE (6, '(A,2F15.10,I4)') ' Current qnorms and atom type:', q1, q2, itype
WRITE (oUnit, '(A,2F15.10,I4)') ' Current qnorms and atom type:', q1, q2, itype
l_warned = .TRUE.
END IF
sphbessel_integral = s**3/dq*da
ELSE
IF (r2 < 1e-6 .AND. l_warn) THEN
WRITE (6, '(A,E13.5,A,E13.5,A)') 'sphbessel_integral: Warning! Formula Two possibly unstable. Ratios:', &
WRITE (oUnit, '(A,E13.5,A,E13.5,A)') 'sphbessel_integral: Warning! Formula Two possibly unstable. Ratios:', &
r2, '(', r1, ')'
WRITE (6, '(A,2F15.10,I4)') ' Current qnorms and atom type:', &
WRITE (oUnit, '(A,2F15.10,I4)') ' Current qnorms and atom type:', &
q1, q2, itype
l_warned = .TRUE.
END IF
......
......@@ -22,14 +22,16 @@ CONTAINS
SUBROUTINE exchange_vccv1(nk, input,atoms, cell, kpts, sym, noco, nococonv, oneD,&
mpdata, hybinp, hybdat, jsp, lapw, &
nsymop, nsest, indx_sest, mpi, a_ex, results, mat_ex)
use m_wavefproducts_aux
USE m_types
USE m_constants
use m_wavefproducts_aux
USE m_util
use m_intgrf
USE m_wrapper
USE m_types
USE m_io_hybinp
use m_calc_cmt
IMPLICIT NONE
TYPE(t_input),INTENT(IN):: input
TYPE(t_hybdat), INTENT(IN) :: hybdat
......@@ -184,7 +186,7 @@ CONTAINS
IF (mat_ex%l_real) THEN
IF (ANY(ABS(AIMAG(exchange)) > 1e-10)) THEN
IF (mpi%irank == 0) WRITE (6, '(A)') 'exchangeCore: Warning! Unusually large imaginary component.'
IF (mpi%irank == 0) WRITE (oUnit, '(A)') 'exchangeCore: Warning! Unusually large imaginary component.'
WRITE (*, *) MAXVAL(ABS(AIMAG(exchange)))
call judft_error('exchangeCore: Unusually large imaginary component.')
END IF
......@@ -209,15 +211,17 @@ CONTAINS
SUBROUTINE exchange_cccc(nk, atoms, hybdat, ncstd, sym, kpts, a_ex, results)
USE m_types
USE m_constants
USE m_util
use m_intgrf
USE m_wrapper
USE m_gaunt
USE m_trafo
USE m_types
USE m_io_hybinp
IMPLICIT NONE
TYPE(t_hybdat), INTENT(IN) :: hybdat
TYPE(t_results), INTENT(INOUT) :: results
TYPE(t_sym), INTENT(IN) :: sym
......@@ -244,8 +248,8 @@ CONTAINS
COMPLEX :: exch(ncstd, ncstd)
! IF ( irank == 0 ) THEN
! WRITE(6,'(//A)') '### core-core-core-core exchange ###'
! WRITE(6,'(/A)') ' k-point band exchange'
! WRITE(oUnit,'(//A)') '### core-core-core-core exchange ###'
! WRITE(oUnit,'(/A)') ' k-point band exchange'
! END IF
! set up point
......@@ -336,7 +340,7 @@ CONTAINS
ENDIF
! DO icst = 1,ncstd
! IF ( irank == 0 )
! WRITE(6,'( '' ('',F5.3,'','',F5.3,'','',F5.3,'')'',I4,1X,F12.5)')bkpt,icst,REAL(exch(icst,icst))*(-27.211608)
! WRITE(oUnit,'( '' ('',F5.3,'','',F5.3,'','',F5.3,'')'',I4,1X,F12.5)')bkpt,icst,REAL(exch(icst,icst))*(-hartree_to_ev_const)
! END DO
! add core exchange contributions to the te_hfex
......
......@@ -271,9 +271,9 @@ CONTAINS
IF ((.not. xcpot%is_name("hse")) .AND. (.not. xcpot%is_name("vhse"))) THEN ! no gamma point correction needed for HSE functional
IF (zero_order .and. .not. ibs_corr) THEN
WRITE (6, '(A)') ' Take zero order terms into account.'
WRITE (oUnit, '(A)') ' Take zero order terms into account.'
ELSE IF (zero_order .and. ibs_corr) THEN
WRITE (6, '(A)') ' Take zero order terms and ibs-correction into account.'
WRITE (oUnit, '(A)') ' Take zero order terms and ibs-correction into account.'
END IF
IF (zero_order) THEN
......
......@@ -19,12 +19,13 @@ CONTAINS
hybdat, noco,nococonv, oneD, mpi, input, jsp)
! nkpt :: number of all k-points
USE m_types
USE m_constants
USE m_radfun
USE m_radflo
USE m_abcof
USE m_trafo!, ONLY: waveftrafo_genwavf
USE m_olap
USE m_types
USE m_hyb_abcrot
USE m_io_hybinp
......@@ -111,12 +112,12 @@ CONTAINS
iarr = 2
DO itype = 1, atoms%ntype
IF (mpi%irank == 0) WRITE (6, FMT=8000) itype
IF (mpi%irank == 0) WRITE (oUnit, FMT=8000) itype
ng = atoms%jri(itype)
DO l = 0, atoms%lmax(itype)
CALL radfun(l, itype, jsp, el_eig(l, itype), vr(:, itype, jsp), &
atoms, u(:, :, l), du(:, :, l), hybdat%usdus, nodem, noded, wronk)
IF (mpi%irank == 0) WRITE (6, FMT=8010) l, el_eig(l, itype), &
IF (mpi%irank == 0) WRITE (oUnit, FMT=8010) l, el_eig(l, itype), &
hybdat%usdus%us(l, itype, jsp), hybdat%usdus%dus(l, itype, jsp),&
nodem, hybdat%usdus%uds(l, itype, jsp), hybdat%usdus%duds(l, itype, jsp),&
noded, hybdat%usdus%ddn(l, itype, jsp), wronk
......
......@@ -12,6 +12,7 @@ CONTAINS
cell, oneD, results, jsp, enpara, &
hybdat, l_real, vr0, eig_irr)
USE m_types
USE m_constants
USE m_eig66_io
USE m_util
USE m_intgrf
......@@ -94,8 +95,8 @@ CONTAINS
! degenerat(i) =0 band i is degenerat, but is not the lowest band
! of the group of degenerate states
IF (mpi%irank == 0) THEN
WRITE (6, *)
WRITE (6, '(A)') " k-point | number of occupied bands | maximal number of bands"
WRITE (oUnit, *)
WRITE (oUnit, '(A)') " k-point | number of occupied bands | maximal number of bands"
END IF
degenerat = 1
hybdat%nobd(:,jsp) = 0
......
......@@ -67,7 +67,7 @@ CONTAINS
! dFx_ds - derivative of this factor with respect to s
! d2Fx_ds2 - second derivative with respect to s
SUBROUTINE calculateEnhancementFactor(kF, s_inp, F_x, dFx_Ds, d2Fx_Ds2, dFx_dkF, d2Fx_dsdkF)
use m_constants, only: REAL_NOT_INITALIZED
use m_constants
IMPLICIT NONE
REAL, INTENT(IN) :: kF, s_inp
......@@ -1167,9 +1167,9 @@ CONTAINS
! Check if any of the integrations failed and abort if one did
IF (ANY(intgrMT%ierror == NEGATIVE_EXPONENT_ERROR)) THEN
IF (irank == 0) WRITE (6, *) 'intgrf: Warning! Negative exponent x in extrapolation a+c*r**x'
IF (irank == 0) WRITE (oUnit, *) 'intgrf: Warning! Negative exponent x in extrapolation a+c*r**x'
ELSEIF (ANY(intgrMT%ierror == NEGATIVE_EXPONENT_WARNING)) THEN
IF (irank == 0) WRITE (6, *) 'intgrf: Negative exponent x in extrapolation a+c*r**x'
IF (irank == 0) WRITE (oUnit, *) 'intgrf: Negative exponent x in extrapolation a+c*r**x'
call juDFT_error( 'intgrf: Negative exponent x in extrapolation a+c*r**x')
END IF
......@@ -1508,9 +1508,9 @@ CONTAINS
! Check if any of the integrations failed and abort if one did
IF (ANY(intgrMT%ierror == NEGATIVE_EXPONENT_ERROR)) THEN
IF (irank == 0) WRITE (6, *) 'intgrf: Warning! Negative exponent x in extrapolation a+c*r**x'
IF (irank == 0) WRITE (oUnit, *) 'intgrf: Warning! Negative exponent x in extrapolation a+c*r**x'
ELSEIF (ANY(intgrMT%ierror == NEGATIVE_EXPONENT_WARNING)) THEN
IF (irank == 0) WRITE (6, *) 'intgrf: Negative exponent x in extrapolation a+c*r**x'
IF (irank == 0) WRITE (oUnit, *) 'intgrf: Negative exponent x in extrapolation a+c*r**x'
call juDFT_error( 'intgrf: Negative exponent x in extrapolation a+c*r**x')
END IF
......@@ -2339,7 +2339,7 @@ CONTAINS
#ifdef CPP_INVERSION
IF (ANY(ABS(aimag(exchange)) > 10.0**-10)) THEN
IF (irank == 0) WRITE (6, '(A)') 'exchangeCore: Warning! Unusually large imaginary component.'
IF (irank == 0) WRITE (oUnit, '(A)') 'exchangeCore: Warning! Unusually large imaginary component.'
WRITE (*, *) MAXVAL(ABS(aimag(exchange)))
call juDFT_error( 'exchangeCore: Unusually large imaginary component.')
END IF
......@@ -2560,7 +2560,7 @@ CONTAINS
# endif
! DO icst = 1,ncstd
! IF ( irank == 0 ) &
! WRITE(6,'( '' ('',F5.3,'','',F5.3,'','',F5.3,'')'',I4,1X,F12.5)')bkpt,icst,REAL(exch(icst,icst))*(-27.211608)
! WRITE(oUnit,'( '' ('',F5.3,'','',F5.3,'','',F5.3,'')'',I4,1X,F12.5)')bkpt,icst,REAL(exch(icst,icst))*(-27.211608)
! END DO
! add core exchange contributions to the te_hfex
......
......@@ -7,8 +7,11 @@ MODULE m_hybrid_core
CONTAINS
SUBROUTINE corewf(atoms, jsp, input,&
vr, lmaxcd, maxindxc, mpi, lmaxc, nindxc, core1, core2, eig_c)
USE m_types
USE m_juDFT
USE m_types
USE m_constants
IMPLICIT NONE
TYPE(t_mpi), INTENT(IN) :: mpi
......@@ -126,7 +129,7 @@ CONTAINS
lmaxc, nindxcr, core1, core2, eig_c, mpi)
USE m_intgr, ONLY: intgr3, intgr0, intgr1
USE m_constants, ONLY: c_light
USE m_constants
USE m_differ
USE m_types
IMPLICIT NONE
......@@ -237,7 +240,7 @@ CONTAINS
ncmsh = min(ncmsh, atoms%msh)
rn = rnot*(d**(ncmsh - 1))
IF (mpi%irank == 0) THEN
WRITE (6, FMT=8000) z, rnot, dxx, atoms%jri(itype)
WRITE (oUnit, FMT=8000) z, rnot, dxx, atoms%jri(itype)
END IF
DO j = 1, atoms%jri(itype)
vrd(j) = vr0(j, itype, jspin)
......@@ -286,7 +289,7 @@ CONTAINS
eig_c(NINT(fl), nindxcr(NINT(fl), itype), itype) = e
IF (mpi%irank == 0) THEN
WRITE (6, FMT=8010) fn, fl, fj, e, weight
WRITE (oUnit, FMT=8010) fn, fl, fj, e, weight
END IF
IF (ierr /= 0) call judft_error('error in core-level routine')
ENDIF
......@@ -303,10 +306,10 @@ CONTAINS
SUBROUTINE core_init(input, atoms, lmaxcd, maxindxc)
USE m_types
USE m_constants
USE m_intgr, ONLY: intgr3, intgr0, intgr1
USE m_constants, ONLY: c_light
USE m_differ
USE m_types
IMPLICIT NONE
TYPE(t_input), INTENT(IN) :: input
......
......@@ -42,13 +42,14 @@ CONTAINS
enpara, mpi, v, iterHF)
USE m_judft
USE m_types
USE m_constants
USE m_loddop, ONLY: loddop
USE m_intgrf, ONLY: intgrf_init, intgrf
use m_rorder, only: rorderpf
USE m_hybrid_core
USE m_wrapper
USE m_eig66_io
USE m_types
IMPLICIT NONE
......@@ -91,7 +92,7 @@ CONTAINS
'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x'/)
IF (mpi%irank == 0) WRITE (6, '(//A,I2,A)') '### subroutine: mixedbasis ###'
IF (mpi%irank == 0) WRITE (oUnit, '(//A,I2,A)') '### subroutine: mixedbasis ###'
IF (xcpot%is_name("exx")) CALL judft_error("EXX is not implemented in this version", calledby='mixedbasis')
......@@ -131,8 +132,8 @@ CONTAINS
! - - - - - - - - Set up MT product basis for the non-local exchange potential - - - - - - - - - -
IF (mpi%irank == 0) THEN
WRITE (6, '(A)') 'MT product basis for non-local exchange potential:'
WRITE (6, '(A)') 'Reduction due to overlap (quality of orthonormality, should be < 1.0E-06)'
WRITE (oUnit, '(A)') 'MT product basis for non-local exchange potential:'
WRITE (oUnit, '(A)') 'Reduction due to overlap (quality of orthonormality, should be < 1.0E-06)'
END IF
allocate(mpdata%num_radbasfn(0:maxval(hybinp%lcutm1), atoms%ntype), source=0)
......@@ -184,7 +185,7 @@ CONTAINS
END DO
END DO
IF (n_radbasfn == 0 .AND. mpi%irank == 0) &
WRITE (6, '(A)') 'mixedbasis: Warning! No basis-function product of '//lchar(l)// &
WRITE (oUnit, '(A)') 'mixedbasis: Warning! No basis-function product of '//lchar(l)// &
'-angular momentum defined.'
mpdata%num_radbasfn(l, itype) = n_radbasfn*input%jspins
END DO
......@@ -216,7 +217,7 @@ CONTAINS
! allow for zero product-basis functions for