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

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."
......
This diff is collapsed.
set(fleur_F90 ${fleur_F90}
xc-pot/libxc_postprocess_gga.f90
xc-pot/potl0.f90
xc-pot/mkgl0.f90
xc-pot/grdchlh.f90
xc-pot/easypbe.f90
xc-pot/corg91.f90
xc-pot/corl91.f90
xc-pot/corpbe.f90
xc-pot/excepbe.f90
xc-pot/exchpbe.f90
xc-pot/vxcepbe.f90
xc-pot/excl91.f90
xc-pot/excpw91.f90
xc-pot/gaunt.f90
xc-pot/excwb91.f90
xc-pot/pbecor2.f90
xc-pot/relcor.f90
xc-pot/vxcl91.f90
xc-pot/vxcpw91.f90
xc-pot/vxcwb91.f90
xc-pot/xcbh.f90
xc-pot/xcpz.f90
xc-pot/xcvwn.f90
xc-pot/xcwgn.f90
xc-pot/xcxal.f90
xc-pot/xch91.f90
)
set(fleur_F77 ${fleur_F77}
xc-pot/corg91.F
xc-pot/corl91.f
xc-pot/corpbe.f
xc-pot/easypbe.f
xc-pot/excepbe.f
xc-pot/exchpbe.F
xc-pot/excl91.f
xc-pot/excpw91.f
xc-pot/excwb91.f
xc-pot/gaunt.f
xc-pot/grdchlh.f
xc-pot/mkgl0.f
xc-pot/pbecor2.f
xc-pot/relcor.f
xc-pot/vxcepbe.f
xc-pot/vxcl91.f
xc-pot/vxcpw91.f
xc-pot/vxcwb91.f
xc-pot/xcbh.f
xc-pot/xch91.F
xc-pot/xcpz.f
xc-pot/xcvwn.f
xc-pot/xcwgn.f
xc-pot/xcxal.f
set(inpgen_F90 ${inpgen_F90}
xc-pot/easypbe.f90
xc-pot/corg91.f90
xc-pot/corl91.f90
xc-pot/corpbe.f90
xc-pot/excepbe.f90
xc-pot/exchpbe.f90
xc-pot/vxcepbe.f90
xc-pot/excl91.f90
xc-pot/excpw91.f90
xc-pot/excwb91.f90
xc-pot/pbecor2.f90
xc-pot/relcor.f90
xc-pot/vxcl91.f90
xc-pot/vxcpw91.f90
xc-pot/vxcwb91.f90
xc-pot/xcbh.f90
xc-pot/xcpz.f90
xc-pot/xcvwn.f90
xc-pot/xcwgn.f90
xc-pot/xcxal.f90
xc-pot/xch91.f90
)
set(inpgen_F77 ${inpgen_F77}
xc-pot/corg91.F
xc-pot/corl91.f
xc-pot/corpbe.f
xc-pot/easypbe.f
xc-pot/excepbe.f
xc-pot/exchpbe.F
xc-pot/excl91.f
xc-pot/excpw91.f
xc-pot/excwb91.f
xc-pot/grdchlh.f
xc-pot/pbecor2.f
xc-pot/relcor.f
xc-pot/vxcepbe.f
xc-pot/vxcl91.f
xc-pot/vxcpw91.f
xc-pot/vxcwb91.f
xc-pot/xcbh.f
xc-pot/xch91.F
xc-pot/xcpz.f
xc-pot/xcvwn.f
xc-pot/xcwgn.f
xc-pot/xcxal.f
)
MODULE m_corg91
c.....-----------------------------------------------------------------
c gga91 correlation
c.....-----------------------------------------------------------------
CONTAINS
SUBROUTINE corg91(fk,sk,gz,ec,ecrs,eczta,rs,zta,t,uu,vv,ww,h,
+ dvcup,dvcdn)
c.....-----------------------------------------------------------------
c input
c rs: seitz radius
c zta: relative spin polarization
c t: abs(grad d)/(d*2.*ks*gz)
c uu: (grad d)*grad(abs(grad d))/(d**2 * (2*ks*gz)**3)
c vv: (laplacian d)/(d * (2*ks*gz)**2)
c ww: (grad d)*(gradzta)/(d * (2*ks*gz)**2
c output
c h: nonlocal part of correlation energy per electron
c dvcup,-dn: nonlocal parts of correlation potentials.
MODULE m_corg91
!.....-----------------------------------------------------------------
! gga91 correlation
!.....-----------------------------------------------------------------
CONTAINS
SUBROUTINE corg91(fk,sk,gz,ec,ecrs,eczta,rs,zta,t,uu,vv,ww,h, &
dvcup,dvcdn)
!.....-----------------------------------------------------------------
! input
! rs: seitz radius
! zta: relative spin polarization
! t: abs(grad d)/(d*2.*ks*gz)
! uu: (grad d)*grad(abs(grad d))/(d**2 * (2*ks*gz)**3)
! vv: (laplacian d)/(d * (2*ks*gz)**2)
! ww: (grad d)*(gradzta)/(d * (2*ks*gz)**2
! output
! h: nonlocal part of correlation energy per electron
! dvcup,-dn: nonlocal parts of correlation potentials.
c with ks=sqrt(4*kf/pai), gz=[(1+zta)**(2/3)+(1-zta)**(2/3)]/2, &
c kf=cbrt(3*pai**2*d).
c.....-----------------------------------------------------------------
c.....-----------------------------------------------------------------
c .. previously untyped names ..
! with ks=sqrt(4*kf/pai), gz=[(1+zta)**(2/3)+(1-zta)**(2/3)]/2, &
! kf=cbrt(3*pai**2*d).
!.....-----------------------------------------------------------------
!.....-----------------------------------------------------------------
! .. previously untyped names ..
IMPLICIT NONE
REAL dvcdn,dvcup,ec,ecrs,eczta,fk,gz,h,rs,sk,t,uu,vv,ww,zta,a4,
+ alf,argmx,b,b2,b2fac,bec,bet,bg,c1,c2,c3,c4,c5,c6,cc,cc0,
+ ccrs,coeff,comm,cx,delt,fact0,fact1,fact2,fact3,fact4,fact5,
+ gm,gz3,gz4,h0,h0b,h0bt,h0rs,h0rst,h0t,h0tt,h0z,h0zt,h1,h1rs,
+ h1rst,h1t,h1tt,h1z,h1zt,hrs,hrst,ht,htt,hz,hzt,pon,pref,q4,
+ q5,q6,q7,q8,q9,r0,r1,r2,r3,r4,rs2,rs3,rsthrd,t2,t4,t6,thrd2,
+ thrdm,xnu,r1t2,expsm
c ..
REAL :: dvcdn,dvcup,ec,ecrs,eczta,fk,gz,h,rs,sk,t,uu,vv,ww,zta,a4, &
alf,argmx,b,b2,b2fac,bec,bet,bg,c1,c2,c3,c4,c5,c6,cc,cc0, &
ccrs,coeff,comm,cx,delt,fact0,fact1,fact2,fact3,fact4,fact5, &
gm,gz3,gz4,h0,h0b,h0bt,h0rs,h0rst,h0t,h0tt,h0z,h0zt,h1,h1rs, &
h1rst,h1t,h1tt,h1z,h1zt,hrs,hrst,ht,htt,hz,hzt,pon,pref,q4, &
q5,q6,q7,q8,q9,r0,r1,r2,r3,r4,rs2,rs3,rsthrd,t2,t4,t6,thrd2, &
thrdm,xnu,r1t2,expsm
! ..
DATA xnu,cc0,cx,alf/15.75592e0,0.00423500,-0.001667212e0,0.0900/
DATA c1,c2,c3,c4/0.00256800,0.02326600,7.389e-6,8.723e0/
DATA c5,c6,a4/0.472e0,7.389e-2,100.00/
DATA thrdm,thrd2/-0.333333333333e0,0.666666666667e0/
c.....-----------------------------------------------------------------
c expsm: argument of exponential-smallest.
!.....-----------------------------------------------------------------
! expsm: argument of exponential-smallest.
expsm=minexponent(expsm)/1.5
argmx = 174.0
bet = xnu*cc0
......@@ -45,10 +45,10 @@ c expsm: argument of exponential-smallest.
gz3 = gz**3
gz4 = gz3*gz
pon = -delt*ec/ (gz3*bet)
IF (pon.gt.argmx) THEN
b = 0.
IF (pon > argmx) THEN
b = 0.
ELSE
b = delt/ (exp(pon)-1.00)
b = delt/ (exp(pon)-1.00)
ENDIF
b2 = b*b
t2 = t*t
......@@ -65,26 +65,26 @@ c expsm: argument of exponential-smallest.
r1 = a4*r0*gz4
coeff = cc - cc0 - 3.e0*cx/7.00
r2 = xnu*coeff*gz3
c+tagu
! tagu
r1t2=max(-r1*t2,expsm)
r3 = exp(r1t2)
c-tagu
! tagu
h0 = gz3* (bet/delt)*log(1.00+delt*q4*t2/q5)
h1 = r3*r2*t2
h = h0 + h1
c local correlation option:
c h=0.0e0
! local correlation option:
! h=0.0e0
c energy done. now the potential:
! energy done. now the potential:
ccrs = (c2+2.*c3*rs)/q7 - q6* (c4+2.*c5*rs+3.*c6*rs2)/q7**2
rsthrd = rs/3.e0
r4 = rsthrd*ccrs/coeff
gm = ((1.00+zta)**thrdm- (1.00-zta)**thrdm)/3.00
IF (pon.gt.argmx) THEN
b2fac = 0.
IF (pon > argmx) THEN
b2fac = 0.
ELSE
b2fac = b2* (delt/b+1.00)
b2fac = b2* (delt/b+1.00)
ENDIF
bg = -3.e0*ec*b2fac/ (bet*gz4)
bec = b2fac/ (bet*gz3)
......@@ -122,9 +122,9 @@ c energy done. now the potential:
dvcup = comm + pref
dvcdn = comm - pref
c local correlation option:
c dvcup=0.0e0
c dvcdn=0.0e0
! local correlation option:
! dvcup=0.0e0
! dvcdn=0.0e0
END SUBROUTINE corg91
END MODULE m_corg91
END SUBROUTINE corg91
END MODULE m_corg91
MODULE m_corl91
c.....-----------------------------------------------------------------
c uniform-gas correlation of perdew and wang 1991
c.....-----------------------------------------------------------------
CONTAINS
SUBROUTINE corl91(
> rs,zta,
< ec,vcup,vcdn,ecrs,eczta,alfc)
c.....-----------------------------------------------------------------
c input: seitz radius (rs), relative spin polarization (zta)
c output: correlation energy per electron (ec),
c up- and down-spin potentials (vcup,vcdn),
c derivatives of ec wrt rs (ecrs) &zta (eczta).
c output: correlation contribution (alfc) to the spin stiffness
c.....-----------------------------------------------------------------
IMPLICIT NONE
REAL, INTENT (IN) :: rs,zta
REAL, INTENT (OUT) :: alfc,ec,ecrs,eczta,vcdn,vcup
REAL :: alfm,alfrsm,comm,ep,eprs,eu,eurs,f,fz,z4
REAL :: fzz,gam,thrd,thrd4
c.....-----------------------------------------------------------------
c ..
DATA gam,fzz/0.5198421,1.709921/
DATA thrd,thrd4/0.333333333333e0,1.333333333333e0/
c.....-----------------------------------------------------------------
f = ((1.0+zta)**thrd4+ (1.0-zta)**thrd4-2.e0)/gam
CALL gcor91(0.0310907,0.21370,7.5957,3.5876,1.6382,
+ 0.49294,1.00,rs,eu,eurs)
CALL gcor91(0.01554535,0.20548,14.1189,6.1977,3.3662,
+ 0.62517,1.00,rs,ep,eprs)
CALL gcor91(0.0168869,0.11125,10.357,3.6231,0.88026,
+ 0.49671,1.00,rs,alfm,alfrsm)
c alfm is minus the spin stiffness alfc
alfc = -alfm
z4 = zta**4
ec = eu* (1.0-f*z4) + ep*f*z4 - alfm*f* (1.0-z4)/fzz
c energy done. now the potential:
ecrs = eurs* (1.0-f*z4) + eprs*f*z4 - alfrsm*f* (1.0-z4)/fzz
fz = thrd4* ((1.0+zta)**thrd- (1.0-zta)**thrd)/gam
eczta = 4.e0* (zta**3)*f* (ep-eu+alfm/fzz) +
+ fz* (z4*ep-z4*eu- (1.0-z4)*alfm/fzz)
comm = ec - rs*ecrs/3.e0 - zta*eczta
vcup = comm + eczta
vcdn = comm - eczta
END SUBROUTINE corl91
c.....-----------------------------------------------------------------
c called by corl91
c.....-----------------------------------------------------------------
SUBROUTINE gcor91(
> a,a1,b1,b2,b3,b4,p,rs,
< gg,ggrs)