Commit 765db73a authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files

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

parents db89db77 ec22ca6c
init/compileinfo.h
io/xml/inputSchema.h
Testing/*
*~
\#*
build
......
......@@ -55,17 +55,17 @@ io/calculator.f global/ss_sym.f global/soc_sym.f math/inv3.f io/rw_symfile.f
kpoints/kptgen_hybrid.f kpoints/od_kptsgen.f kpoints/bravais.f kpoints/divi.f kpoints/brzone.f
kpoints/kptmop.f kpoints/kpttet.f init/bandstr1.F kpoints/ordstar.f kpoints/fulstar.f kpoints/kprep.f
kpoints/tetcon.f kpoints/kvecon.f init/boxdim.f global/radsra.f math/intgr.F global/differ.f math/inwint.f
math/outint.f xc-pot/gaunt.f math/grule.f
math/outint.f math/grule.f
)
set(inpgen_F90 ${inpgen_F90} global/constants.f90 io/xsf_io.f90
eigen/orthoglo.F90 juDFT/usage_data.F90 math/ylm4.F90
global/sort.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 inpgen/inpgen_arguments.F90
juDFT/info.F90 juDFT/stop.F90 juDFT/args.F90 juDFT/time.F90 juDFT/init.F90 juDFT/sysinfo.F90 io/w_inpXML.f90 kpoints/julia.f90 global/utility.F90
juDFT/info.F90 juDFT/stop.F90 juDFT/args.F90 juDFT/time.F90 juDFT/init.F90 juDFT/sysinfo.F90 juDFT/string.f90 io/w_inpXML.f90 kpoints/julia.f90 global/utility.F90
init/compile_descr.F90 kpoints/kpoints.f90 io/xmlOutput.F90 kpoints/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
eigen/tlmplm_store.F90 kpoints/unfoldBandKPTS.f90)
eigen/tlmplm_store.F90 xc-pot/gaunt.f90 kpoints/unfoldBandKPTS.f90)
set(fleur_SRC ${fleur_F90} ${fleur_F77})
......
......@@ -12,7 +12,7 @@ if (${CMAKE_Fortran_COMPILER_ID} MATCHES "Intel")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -mkl -r8 -qopenmp -assume byterecl")
endif()
set(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE} -xHost -O2 -g")
set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -C -traceback -O0 -g -ftrapuv -check uninit -check pointers -CB ")
set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -C -traceback -O0 -g -ftrapuv -check uninit -check pointers -CB -DCPP_DEBUG")
elseif(${CMAKE_Fortran_COMPILER_ID} MATCHES "PGI")
message("PGI Fortran detected")
set(CMAKE_SHARED_LIBRARY_LINK_Fortran_FLAGS "") #fix problem in cmake
......@@ -24,12 +24,12 @@ elseif(${CMAKE_Fortran_COMPILER_ID} MATCHES "PGI")
#set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -mp -Mr8 -Mr8intrinsics -Mcuda:cuda9.0,cc70 -DUSE_STREAMS -DNUM_STREAMS=${N_STREAMS} -Minfo=accel -acc")
#set(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE} -fast -O3")
set(CMAKE_Fortran_FLAGS_RELEASE "-O1 ") # to prevent cmake from putting -fast which auses problems with PGI18.4
set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -C -traceback -O0 -g -Mchkstk -Mchkptr -Ktrap=fp")
set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -C -traceback -O0 -g -Mchkstk -Mchkptr -Ktrap=fp -DCPP_DEBUG")
elseif(${CMAKE_Fortran_COMPILER_ID} MATCHES "XL")
message("IBM/BG Fortran detected")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -qsmp=omp -qnosave -qarch=qp -qtune=qp -qrealsize=8 -qfixed -qsuppress=1520-022 -qessl")
set(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE} -O4 -qsuppress=1500-036")
set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -O0 -g")
set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -O0 -g -DCPP_DEBUG")
set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -I/bgsys/local/libxml2/include/libxml2")
set(FLEUR_DEFINITIONS ${FLEUR_DEFINITIONS} "CPP_AIX")
set(FLEUR_MPI_DEFINITIONS ${FLEUR_MPI_DEFINITIONS} "CPP_AIX")
......@@ -40,5 +40,5 @@ elseif(${CMAKE_Fortran_COMPILER_ID} MATCHES "GNU")
endif()
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-none -fopenmp -fdefault-real-8 ")
set(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE} -O1")
set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -fdump-core -Wall -Wextra -Warray-temporaries -fbacktrace -fcheck=all -finit-real=nan -O0 -g")
set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -fdump-core -Wall -Wextra -Warray-temporaries -fbacktrace -fcheck=all -finit-real=nan -O0 -g -DCPP_DEBUG")
endif()
......@@ -13,11 +13,11 @@ global/triang.f
global/vacudz.f
global/vacuz.f
global/abcrot.f
global/savewigner.f
global/differ.f
)
set(fleur_F90 ${fleur_F90}
global/constants.f90
global/savewigner.f90
#global/differ.f90
global/matrix_copy.F90
global/checkdop.F90
......
......@@ -134,8 +134,8 @@
DO n = 1, natin
DO i = n+1, natin
IF ( all( abs( pos(:,n) - pos(:,i) ) < eps7 ) ) then
WRITE(6,'(/," Error in atomic positions: atoms",i3,
& " and",i3," (at least) are the same")') n,i
WRITE(6,'(/," Error in atomic positions: atoms",i5,
& " and",i5," (at least) are the same")') n,i
CALL juDFT_error("atom positions",calledby="spg_gen")
ENDIF
ENDDO
......
......@@ -17,6 +17,7 @@ juDFT/info.F90
juDFT/init.F90
juDFT/juDFT.F90
juDFT/stop.F90
juDFT/string.f90
juDFT/time.F90
juDFT/args.F90
juDFT/sysinfo.F90
......
module m_juDFT_string
implicit none
character(len=3), parameter :: whitespaces = " " // achar(9) // achar(13) ! list of all whitespaces
contains
function strip(input) result(output)
implicit none
character(len=*), intent(in) :: input
character(:), allocatable :: output
integer :: front, back
front = 1
do while(index(whitespaces, input(front:front)) /= 0 )
front = front + 1
enddo
back = len(input)
do while(index(whitespaces, input(back:back)) /= 0)
back = back - 1
enddo
output = input(front:back)
end function strip
end module m_juDFT_string
......@@ -7,7 +7,7 @@ MODULE m_judft_usage
IMPLICIT NONE
PRIVATE
CHARACTER(LEN=99),PARAMETER:: URL_STRING="www.flapw.de/collect.pl"
INTEGER,PARAMETER :: MAX_NO_KEYS=20
INTEGER,PARAMETER :: MAX_NO_KEYS=40
CHARACTER(LEN=200) :: keys(MAX_NO_KEYS)
CHARACTER(LEN=200) :: values(MAX_NO_KEYS)
INTEGER :: no_keys=0
......@@ -19,10 +19,19 @@ MODULE m_judft_usage
PUBLIC :: add_usage_data,send_usage_data
CONTAINS
SUBROUTINE add_usage_data_s(key,VALUE)
SUBROUTINE add_usage_data_s(key,VALUE,string_val)
use m_juDFT_string
IMPLICIT NONE
CHARACTER(len=*),INTENT(IN) :: key,VALUE
INTEGER :: i
LOGICAL, OPTIONAL :: string_val
LOGICAL :: add_quotes
IF(PRESENT(string_val)) THEN
add_quotes = string_val
ELSE
add_quotes = .True.
ENDIF
! don't add a key twice
do i = 1,no_keys
......@@ -31,8 +40,13 @@ CONTAINS
no_keys=no_keys+1
IF (no_keys>MAX_NO_KEYS) STOP "BUG, too many keys in usage_data"
keys(no_keys) =key
values(no_keys)=VALUE
keys(no_keys) = key
IF(add_quotes) THEN
values(no_keys) = '"' // strip(VALUE) // '"'
ELSE
values(no_keys) = VALUE
ENDIF
END SUBROUTINE add_usage_data_s
SUBROUTINE add_usage_data_i(key,VALUE)
......@@ -42,7 +56,7 @@ CONTAINS
CHARACTER(len=20)::txt
WRITE(txt,*) VALUE
CALL add_usage_data_s(key,txt)
CALL add_usage_data_s(key,txt, string_val=.False.)
END SUBROUTINE add_usage_data_i
SUBROUTINE add_usage_data_r(key,VALUE)
......@@ -52,7 +66,7 @@ CONTAINS
CHARACTER(len=20)::txt
WRITE(txt,'(F18.2)') VALUE
CALL add_usage_data_s(key,txt)
CALL add_usage_data_s(key,txt, string_val=.False.)
END SUBROUTINE add_usage_data_r
SUBROUTINE add_usage_data_l(key,VALUE)
......@@ -61,14 +75,17 @@ CONTAINS
LOGICAL,INTENT(in) :: VALUE
CHARACTER(len=20)::txt
txt=MERGE("TRUE ","FALSE",value)
CALL add_usage_data_s(key,txt)
txt=MERGE("true ","false",value)
CALL add_usage_data_s(key,txt, string_val=.False.)
END SUBROUTINE add_usage_data_l
SUBROUTINE send_usage_data()
use m_juDFT_args
use m_juDFT_string
IMPLICIT NONE
INTEGER :: i,ierr,pid,dt(8)
INTEGER*8 :: r
INTEGER :: i,ierr,pid,dt(8)
CHARACTER(len=200) :: model, modelname, VmPeak, VmSize, VmData, VmStk, VmExe, VmSwap
INTEGER(8) :: r
#ifdef CPP_MPI
INCLUDE 'mpif.h'
......@@ -79,30 +96,55 @@ CONTAINS
!#ifdef CPP_ALLOW_USAGE_DATA
r = random_id()
!add cpuinfos
call get_cpuinfo(model, modelname)
call add_usage_data("cpu_model", model)
call add_usage_data("cpu_modelname", modelname)
!add meminfos
call get_meminfo(VmPeak, VmSize, VmData, VmStk, VmExe, VmSwap)
call add_usage_data("VmPeak", VmPeak, string_val=.False.)
call add_usage_data("VmSize", VmSize, string_val=.False.)
call add_usage_data("VmData", VmData, string_val=.False.)
call add_usage_data("VmStk", VmStk, string_val=.False.)
call add_usage_data("VmExe", VmExe, string_val=.False.)
call add_usage_data("VmSwap", VmSwap, string_val=.False.)
!First write a json file
OPEN(unit=961,file="usage.json",status='replace')
WRITE(961,*) '{'
WRITE(961,*) ' "url":"',TRIM(ADJUSTL(URL_STRING)),'",'
WRITE(961,"(a,Z0.16,a)") ' "calculation-id":"',r,'",'
WRITE(961,'(A)') '{'
WRITE(961,*) ' "url":"',strip(URL_STRING),'",'
WRITE(961,"(a,Z0.16,a)") ' "calculation-id":"',r,'",'
WRITE(961,*) ' "data": {'
DO i=1,no_keys
WRITE(961,*) ' "',TRIM(ADJUSTL(keys(i))),'":"',TRIM(ADJUSTL(values(i))),'",'
if(i < no_keys) then
WRITE(961,*) ' "',strip(keys(i)),'":',strip(values(i)),","
else
WRITE(961,*) ' "',strip(keys(i)),'":',strip(values(i))
endif
ENDDO
WRITE(961,*) ' }'
WRITE(961,*) '}'
WRITE(961,"(A)") '}'
CLOSE(961)
#ifdef CPP_CURL
IF (judft_was_argument("-no_send")) THEN
PRINT *,"As requested by command line option usage data was not send, please send usage.json manually"
ELSE
!Send using curl
CALL system('curl -H "Content-Type: application/json" --data @usage.json '\\URL_STRING)
PRINT *,"Usage data send using curl: usage.json"
ENDIF
#ifdef CPP_DEBUG
WRITE (*,*) "usage.json not send, because this is a debugging run."
#else
PRINT *,'curl not found in compilation. Please send usage.json manually'
!Send using curl
call execute_command_line(&
'curl -X POST -H "Content-Type: application/json" -d @usage.json https://docker.iff.kfa-juelich.de/fleur-usage-stats/',&
exitstat=ierr)
if(ierr == 0) then
write (*,*) "Usage data send using curl: usage.json"
else
write (*,*) "Usage data sending failed"
endif
#endif
ENDIF
!#else
! PRINT *,"No usage data collected"
!#endif
......@@ -127,4 +169,82 @@ CONTAINS
r = ieor(r, ishft(r,17))
enddo
END FUNCTION random_id
SUBROUTINE get_cpuinfo(model, modelname)
implicit none
character(len=200), intent(out) :: model, modelname
character(len=1000) :: line
integer :: openstatus, readstatus
logical :: found_model, found_modelname, done
model = "unknown"
modelname = "unknown"
done = .False.
found_model = .False.
found_modelname = .False.
readstatus = 0
open(unit=77, file="/proc/cpuinfo", iostat=openstatus)
if(openstatus == 0) then
do while(.not. done)
read(77,'(A)', iostat=readstatus) line
if(readstatus == 0) then
if(index(line, "model name") /= 0) then
modelname = trim(line(index(line, ":")+1:1000))
found_modelname = .True.
done = found_modelname .and. found_model
cycle
endif
if(index(line, "model") /= 0) then
model = trim(line(index(line,":")+1:1000))
found_model = .True.
done = found_modelname .and. found_model
cycle
endif
else
exit
endif
enddo
endif
if(openstatus == 0) close(77)
END SUBROUTINE get_cpuinfo
SUBROUTINE get_meminfo(VmPeak, VmSize, VmData, VmStk, VmExe, VmSwap)
use m_juDFT_string
implicit none
character(len=200), intent(out) :: VmPeak, VmSize, VmData, VmStk, VmExe, VmSwap
character(len=1000) :: line
integer :: openstat, readstat
VmPeak = ""
VmSize = ""
VmData = ""
VmStk = ""
VmExe = ""
VmSwap = ""
readstat = 0
open(unit=77, file="/proc/self/status", iostat=openstat)
do while(readstat == 0)
read(77,'(A)', iostat=readstat) line
if(index(line, "VmPeak") /= 0) VmPeak = strip(line(index(line, ":")+1:index(line,"kB", back=.True.)-1))
if(index(line, "VmSize") /= 0) VmSize = strip(line(index(line, ":")+1:index(line,"kB", back=.True.)-1))
if(index(line, "VmData") /= 0) VmData = strip(line(index(line, ":")+1:index(line,"kB", back=.True.)-1))
if(index(line, "VmStk") /= 0) VmStk = strip(line(index(line, ":")+1:index(line,"kB", back=.True.)-1))
if(index(line, "VmExe") /= 0) VmExe = strip(line(index(line, ":")+1:index(line,"kB", back=.True.)-1))
if(index(line, "VmSwap") /= 0) VmSwap = strip(line(index(line, ":")+1:index(line,"kB", back=.True.)-1))
enddo
if(openstat == 0) close(77)
END SUBROUTINE
END MODULE m_judft_usage
......@@ -525,6 +525,12 @@
CALL add_usage_data("LOs",atoms%nlotot)
CALL add_usage_data("Iterations",input%itmax)
CALL add_usage_data("nkpt", kpts%nkpt)
#ifdef CPP_GPU
CALL add_usage_data("gpu_per_node",1)
#else
CALL add_usage_data("gpu_per_node",0)
#endif
CALL results%init(dimension,input,atoms,kpts,noco)
......
......@@ -25,6 +25,8 @@ CONTAINS
#ifdef CPP_MPI
write(*,*) "Number of MPI-tasks: ",mpi%isize
CALL add_usage_data("MPI-PE",mpi%isize)
#else
CALL add_usage_data("MPI-PE",1)
#endif
IF (omp==-1) THEN
write(*,*) "No OpenMP version of FLEUR."
......
MODULE m_atom2
use m_juDFT
MODULE m_atom2
use m_juDFT
! *************************************************************
! fully relativistic atomic program based on the subroutines
! differ, outint and inwint by d.d.koelling
......@@ -7,11 +7,11 @@
! modified for use in start-up generator. m.w. april 1982
! modified by adding stabilizing well. m. weinert may 1990
! *************************************************************
CONTAINS
SUBROUTINE atom2(&
& dimension,atoms,xcpot,input,ntyp,jrc,rnot1,&
& qdel,&
& rhoss,nst,lnum,eig,vbar)
CONTAINS
SUBROUTINE atom2(&
& dimension,atoms,xcpot,input,ntyp,jrc,rnot1,&
& qdel,&
& rhoss,nst,lnum,eig,vbar)
USE m_intgr, ONLY : intgr1,intgr0
USE m_constants
......@@ -27,7 +27,7 @@
TYPE(t_atoms),INTENT(IN) :: atoms
CLASS(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_input),INTENT(IN) :: input
INTEGER,INTENT (IN) :: jrc ,ntyp
INTEGER,INTENT (IN) :: jrc ,ntyp
REAL, INTENT (IN) :: rnot1 ,qdel
REAL, INTENT (OUT) :: rhoss(:,:) !(mshd,input%jspins),
REAL, INTENT (OUT) :: eig(dimension%nstd,input%jspins),vbar(input%jspins)
......@@ -56,7 +56,7 @@
vx (:,:) = 0.0
!
WRITE (6,FMT=8000)
8000 FORMAT (' subroutine atom2 entered')
8000 FORMAT (' subroutine atom2 entered')
z = atoms%zatom(ntyp)
n = jrc
rnot = rnot1
......@@ -73,19 +73,19 @@
rn = rad(n)
bmu_l = atoms%bmu(ntyp)
IF (bmu_l>0.001.AND.atoms%numStatesProvided(ntyp).NE.0) CALL &
judft_warn("You specified both: inital moment and occupation numbers.", &
hint="The inital moment will be ignored, set magMom=0.0",calledby="atom2.f90")
judft_warn("You specified both: inital moment and occupation numbers.", &
hint="The inital moment will be ignored, set magMom=0.0",calledby="atom2.f90")
CALL setcor(ntyp,input%jspins,atoms,input,bmu_l, nst,kappa,nprnc,occ)
!
!---> for electric field case (sigma.ne.0), add the extra charge
!---> to the uppermost level; ignore the possible problem that
!---> the occupations may not be between 0 and 2
IF (input%jspins.EQ.1) THEN
occ(nst,1) = occ(nst,1) + qdel
IF (input%jspins==1) THEN
occ(nst,1) = occ(nst,1) + qdel
ELSE
occ(nst,1) = occ(nst,1) + qdel/2.
occ(nst,input%jspins) = occ(nst,input%jspins) + qdel/2.
occ(nst,1) = occ(nst,1) + qdel/2.
occ(nst,input%jspins) = occ(nst,input%jspins) + qdel/2.
ENDIF
!
CALL stpot1(&
......@@ -105,92 +105,91 @@
DO ispin = 1,input%jspins
!
!----> load potential
DO i = 1,n
vr(i) = vr1(i,ispin)
ENDDO
DO i = 1,n
vr(i) = vr1(i,ispin)
ENDDO
!----> adding stabilizing well: m. weinert
DO i = inr0,n
vr(i) = vr(i) + rad(i)*delrv* (rad(i)-rad(inr0))
ENDDO
DO i = inr0,n
vr(i) = vr(i) + rad(i)*delrv* (rad(i)-rad(inr0))
ENDDO
!----> note that vr contains r*v(r) in hartree units
DO i = 1,n
rhoss(i,ispin) = zero
ENDDO
if (lastit) THEN
inquire(file="startcharges",exist=l_start)
if (l_start) then
OPEN (61,file="startcharges")
DO WHILE (.true.)
read(61,*,end=888,err=888) i,rho
if (i==z) then
occ(nst,1)=occ(nst,1)+rho
goto 888
endif
enddo
888 continue
close(61)
endif
endif
DO 90 k = 1,nst
fn = nprnc(k)
fj = iabs(kappa(k)) - 0.5e0
fl = fj + 0.5e0*isign(1,kappa(k))
e = -2* (z/ (fn+fl))**2
ierr = -1
msh_l = jrc
DO WHILE (ierr.NE.0)
CALL differ(&
& fn,fl,fj,c,z,h,rnot,rn,d,msh_l,vr,&
& e,&
& a,b,ierr)!keep
msh_l = msh_l - 1
IF (jrc-msh_l > 100) CALL juDFT_error(&
& "atom2",calledby ="atom2")
ENDDO
DO i = msh_l+1, jrc
a(i) = a(msh_l)
b(i) = b(msh_l)
ENDDO
DO i = 1,n
rhoss(i,ispin) = zero
ENDDO
if (lastit) THEN
inquire(file="startcharges",exist=l_start)
if (l_start) then
OPEN (61,file="startcharges")
DO WHILE (.true.)
read(61,*,end=888,err=888) i,rho
if (i==z) then
occ(nst,1)=occ(nst,1)+rho
goto 888
endif
enddo
888 continue
close(61)
endif
endif
DO 90 k = 1,nst
fn = nprnc(k)
fj = iabs(kappa(k)) - 0.5e0
fl = fj + 0.5e0*isign(1,kappa(k))
e = -2* (z/ (fn+fl))**2
ierr = -1
msh_l = jrc
DO WHILE (ierr.NE.0)
CALL differ(&
& fn,fl,fj,c,z,h,rnot,rn,d,msh_l,vr,&
& e,&
& a,b,ierr)!keep
msh_l = msh_l - 1
IF (jrc-msh_l > 100) CALL juDFT_error(&
& "atom2",calledby ="atom2")
ENDDO
DO i = msh_l+1, jrc
a(i) = a(msh_l)
b(i) = b(msh_l)
ENDDO
DO i = 1,n
rh(i) = occ(k,ispin)* (a(i)**2+b(i)**2)
ENDDO
DO i = 1,n
rh(i) = occ(k,ispin)* (a(i)**2+b(i)**2)
ENDDO
!+ldau
IF (lastit) THEN ! calculate slater interals
l = int(fl)
! write(*,*) nprnc(k),l
DO kk = 0, 2*l, 2 ! F0 for s, F0 + F2 for p etc.
r = rnot
DO i = 1, n
ain(i) = a(i)**2 * r**(-kk-1) ! prepare inner integrand
r = r * d
ENDDO
CALL intgr1(ain,rnot,h,n, & ! integrate&
&ahelp)
r = rnot
DO i = 1, n-1
ain(i) = a(i)**2 * r**kk * (ahelp(n) - ahelp(i))
r = r * d
ENDDO
CALL intgr0(ain,rnot,h,n-1, & ! integrate 2nd r&
&f(kk/2))
IF (lastit) THEN ! calculate slater interals
l = int(fl)
! write(*,*) nprnc(k),l
DO kk = 0, 2*l, 2 ! F0 for s, F0 + F2 for p etc.
r = rnot
DO i = 1, n
ain(i) = a(i)**2 * r**(-kk-1) ! prepare inner integrand
r = r * d
ENDDO
CALL intgr1(ain,rnot,h,n, & ! integrate&
&ahelp)
r = rnot
DO i = 1, n-1
ain(i) = a(i)**2 * r**kk * (ahelp(n) - ahelp(i))
r = r * d
ENDDO
CALL intgr0(ain,rnot,h,n-1, & ! integrate 2nd r&
&f(kk/2))
ENDDO
ENDDO