Merge pull request #887 from jeffhammond/flang-new-17

Flang 17
This commit is contained in:
Edoardo Aprà 2023-10-16 09:28:06 -07:00 committed by GitHub
commit 8ed4e9d41f
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
13 changed files with 75 additions and 13 deletions

View file

@ -182,6 +182,12 @@ c
call swatch(topdat,toptim)
#ifdef USE_POSIXF
call pxfgetlogin(user, ilen, ierror)
#elif USE_GETENV_LOGNAME
! From https://linux.die.net/man/3/getlogin:
! For most purposes, it is more useful to use the environment variable
! LOGNAME to find out who the user is. This is more flexible precisely
! because the user can set LOGNAME arbitrarily.
call util_getenv('LOGNAME',user)
#else
call getlog(user)
#endif

View file

@ -182,6 +182,11 @@ c
call swatch(topdat,toptim)
#ifdef USE_POSIXF
call pxfgetlogin(user, ilen, ierror)
#elif USE_GETENV_LOGNAME
! From https://linux.die.net/man/3/getlogin:
! For most purposes, it is more useful to use the environment variable
! LOGNAME to find out who the user is. This is more flexible precisely
! because the user can set LOGNAME arbitrarily.
#else
call getlog(user)
#endif

View file

@ -28,6 +28,11 @@ c
call swatch(rdate,rtime)
#ifdef USE_POSIXF
call pxfgetlogin(user, ilen, ierror)
#elif USE_GETENV_LOGNAME
! From https://linux.die.net/man/3/getlogin:
! For most purposes, it is more useful to use the environment variable
! LOGNAME to find out who the user is. This is more flexible precisely
! because the user can set LOGNAME arbitrarily.
#else
call getlog(user)
#endif

View file

@ -39,6 +39,11 @@ c
call swatch(rdate,rtime)
#ifdef USE_POSIXF
call pxfgetlogin(user, ilen, ierror)
#elif USE_GETENV_LOGNAME
! From https://linux.die.net/man/3/getlogin:
! For most purposes, it is more useful to use the environment variable
! LOGNAME to find out who the user is. This is more flexible precisely
! because the user can set LOGNAME arbitrarily.
#else
call getlog(user)
#endif

View file

@ -3129,7 +3129,10 @@ ifneq ($(TARGET),LINUX)
EXTRA_LIBS += -lm
DEFINES += -DUSE_FLANG
endif
# Jeff: F18 does not support GETLOG _or_ PXF
ifeq ($(USE_FLANG),1)
DEFINES += -DUSE_GETENV_LOGNAME
endif
endif
endif

View file

@ -1114,6 +1114,8 @@ ccccccccccccccccccccccccccccccccccccccccccccccccccccccc
real*8 xx(10),gsum,x,y,z
real*8, dimension(:,:), allocatable :: gr
logical ex
integer util_system
external util_system
allocate(gr(3,nat))
@ -1192,7 +1194,8 @@ c write file gradient
close(42)
close(43)
call system('mv gradient.tmp gradient')
if (util_system('mv gradient.tmp gradient').ne.0)
& call errquit('nwpwxc_vdw3b: util_system failed',1197,0)
c write file energy
j=1
@ -1225,7 +1228,8 @@ c write file energy
close(42)
close(43)
call system('mv energy.tmp energy')
if (util_system('mv energy.tmp energy').ne.0)
& call errquit('nwpwxc_vdw3b: util_system failed',1231,0)
end subroutine nwpwxc_wregrad

View file

@ -61,7 +61,7 @@ c
double precision a_first,a2_first,btmp_first, btmp1
c
double precision sqrt_pi,t1,t2,t3,t4,t5,t6,t7
double precision alpha,beta, DERF
double precision alpha,beta
double precision f10, f01, b_first
Parameter (sqrt_pi = 1.77245385090552d0)
@ -132,7 +132,7 @@ c write(luout,*) 'a is medium'
c stop
b = exp(-1d0/(4d0*a*a)) - 1d0
c = 2d0*a*a*b + 0.5d0
btmp = (8d0/3d0)*a*(sqrt_pi*DERF(1/(2d0*a)) + 2d0*a*(b-c))
btmp = (8d0/3d0)*a*(sqrt_pi*ERF(1/(2d0*a)) + 2d0*a*(b-c))
t1 = 1/a
t2 = a*a
t3 = 1/t2
@ -141,7 +141,7 @@ c stop
t6 = t4 -2d0*t2*t5 - 1.5d0
btmp_first = -t7*a *
& (2*a*(t4/(2*a**3) - 4d0*a*t5 - t1*t4) + 2d0*t6 -t3*t4) -
& t7*(2*a*t6 + sqrt_pi*DERF(0.5d0*t1))
& t7*(2*a*t6 + sqrt_pi*ERF(0.5d0*t1))
else
c write(luout,*) 'a is large'
c stop

View file

@ -192,7 +192,7 @@ c
implicit none
double precision q,TwoSqrtPi,OneOverQ,q2,DERF
double precision q,TwoSqrtPi,OneOverQ,q2
double precision nwpwxc_ValueOfPi
OneOverQ = 1.0d0/q
@ -209,7 +209,7 @@ c
return
end if
nwpwxc_HqBNL=1.0d0-q*2.0d0/3.0d0*(TwoSqrtPi*DERF(OneOverQ)-q+
nwpwxc_HqBNL=1.0d0-q*2.0d0/3.0d0*(TwoSqrtPi*ERF(OneOverQ)-q+
$ q*(q2-2.0d0)*(1.0d0-exp(-OneOverQ*OneOverQ)))
return
@ -265,7 +265,7 @@ c
implicit none
double precision q,OneOverQ,q2,q3,DERF
double precision q,OneOverQ,q2,q3
double precision nwpwxc_ValueOfPi
OneOverQ = 1.0d0/q
@ -280,7 +280,7 @@ c
nwpwxc_HqBNLPrime = 4.0d0/3.0d0*(q*(exp(-OneOverQ*OneOverQ)*
$ (2.0d0*q2-1.0d0)+(3.0d0-2.0d0*q2))-dsqrt(nwpwxc_ValueOfPi())*
$ DERF(OneOverQ))
$ ERF(OneOverQ))
return
end

View file

@ -1785,8 +1785,8 @@ c
tmu2 = tmu*tmu
tmu3 = tmu*tmu2
c
W = DExp(-F1o4/tmu2)
ERFV = DErf( F1o2/tmu)
W = Exp(-F1o4/tmu2)
ERFV = Erf( F1o2/tmu)
dtmudR = -F1o3*tmu / Rho
c
Fsr = F1-F4o3*tmu*(-F6*tmu+F8*tmu3+W*

View file

@ -182,6 +182,11 @@ c
call swatch(topdat,toptim)
#ifdef USE_POSIXF
call pxfgetlogin(user, ilen, ierror)
#elif USE_GETENV_LOGNAME
! From https://linux.die.net/man/3/getlogin:
! For most purposes, it is more useful to use the environment variable
! LOGNAME to find out who the user is. This is more flexible precisely
! because the user can set LOGNAME arbitrarily.
#else
call getlog(user)
#endif

View file

@ -563,7 +563,6 @@ c
logical stat
logical oprint_energies
c
double precision derf
logical util_io_unit
external util_io_unit
c

View file

@ -2355,6 +2355,11 @@ c
call swatch(rdate,rtime)
#ifdef USE_POSIXF
call pxfgetlogin(user, ilen, ierror)
#elif USE_GETENV_LOGNAME
! From https://linux.die.net/man/3/getlogin:
! For most purposes, it is more useful to use the environment variable
! LOGNAME to find out who the user is. This is more flexible precisely
! because the user can set LOGNAME arbitrarily.
#else
call getlog(user)
#endif
@ -3939,6 +3944,11 @@ c
call swatch(rdate,rtime)
#ifdef USE_POSIXF
call pxfgetlogin(user, ilen, ierror)
#elif USE_GETENV_LOGNAME
! From https://linux.die.net/man/3/getlogin:
! For most purposes, it is more useful to use the environment variable
! LOGNAME to find out who the user is. This is more flexible precisely
! because the user can set LOGNAME arbitrarily.
#else
call getlog(user)
#endif

20
src/util/util_getlog.F Normal file
View file

@ -0,0 +1,20 @@
! unfinished
subroutine util_getlog(arg)
use iso_c_binding, only: c_char, c_null_char, c_size_t
implicit none
character*(*), intent(inout) :: arg
interface
integer function getlogin_r(buf,bufsize)
& bind(C, name="getlogin_r")
use iso_c_binding, only: c_char, c_size_t
character(kind=c_char), intent(inout) :: buf(*)
integer(kind=c_size_t), intent(in), value :: bufsize
end function
end interface
integer :: rc
integer(kind=c_size_t), parameter :: bufsize = 1024
character(kind=c_char) :: buf(bufsize)
buf = c_null_char
rc = getlogin_r(buf,bufsize)
print*,size(arg)
end subroutine util_getlog