From f9cfbc7096aaff7f92c03e99470eddc0df2b348d Mon Sep 17 00:00:00 2001 From: Jeff Hammond Date: Mon, 16 Oct 2023 09:48:23 +0300 Subject: [PATCH 1/4] derf -> erf --- src/nwpw/nwpwlib/nwpwxc/nwpwxc_x_att.F | 6 +++--- src/nwpw/nwpwlib/nwpwxc/nwpwxc_x_bnl.F | 8 ++++---- src/nwpw/nwpwlib/nwpwxc/nwpwxc_x_m11.F | 4 ++-- src/solvation/hnd_coschg.F | 1 - 4 files changed, 9 insertions(+), 10 deletions(-) diff --git a/src/nwpw/nwpwlib/nwpwxc/nwpwxc_x_att.F b/src/nwpw/nwpwlib/nwpwxc/nwpwxc_x_att.F index 7bcc9ca06d..a57cff7b88 100644 --- a/src/nwpw/nwpwlib/nwpwxc/nwpwxc_x_att.F +++ b/src/nwpw/nwpwlib/nwpwxc/nwpwxc_x_att.F @@ -61,7 +61,7 @@ Subroutine nwpwxc_x_att_d2(param,tol_rho,rho,ipol,Ex, 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 @@ Subroutine nwpwxc_x_att_d2(param,tol_rho,rho,ipol,Ex, 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 @@ Subroutine nwpwxc_x_att_d2(param,tol_rho,rho,ipol,Ex, 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 diff --git a/src/nwpw/nwpwlib/nwpwxc/nwpwxc_x_bnl.F b/src/nwpw/nwpwlib/nwpwxc/nwpwxc_x_bnl.F index 5e5f0bb269..b3bd8013f2 100644 --- a/src/nwpw/nwpwlib/nwpwxc/nwpwxc_x_bnl.F +++ b/src/nwpw/nwpwlib/nwpwxc/nwpwxc_x_bnl.F @@ -192,7 +192,7 @@ double precision function nwpwxc_HqBNL(q) 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 @@ double precision function nwpwxc_HqBNL(q) 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 @@ double precision function nwpwxc_HqBNLPrime(q) 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 @@ double precision function nwpwxc_HqBNLPrime(q) 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 diff --git a/src/nwpw/nwpwlib/nwpwxc/nwpwxc_x_m11.F b/src/nwpw/nwpwlib/nwpwxc/nwpwxc_x_m11.F index 8bcad11b81..f0a65cdf95 100644 --- a/src/nwpw/nwpwlib/nwpwxc/nwpwxc_x_m11.F +++ b/src/nwpw/nwpwlib/nwpwxc/nwpwxc_x_m11.F @@ -1785,8 +1785,8 @@ SUBROUTINE nwpwxc_LRCLSDA(Emu,Rho,F,D1F) 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* diff --git a/src/solvation/hnd_coschg.F b/src/solvation/hnd_coschg.F index ce2e1f4907..c67da779b8 100644 --- a/src/solvation/hnd_coschg.F +++ b/src/solvation/hnd_coschg.F @@ -563,7 +563,6 @@ subroutine hnd_coschg(g_dens,ndens,rtdb,geom,basis,nat,nefc, logical stat logical oprint_energies c - double precision derf logical util_io_unit external util_io_unit c From cac4167734f6729c8ff4e1528dc57c2f3297016a Mon Sep 17 00:00:00 2001 From: Jeff Hammond Date: Mon, 16 Oct 2023 09:55:17 +0300 Subject: [PATCH 2/4] system->util_system --- src/nwpw/nwpwlib/nwpwxc/nwpwxc_vdw3b.F | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/nwpw/nwpwlib/nwpwxc/nwpwxc_vdw3b.F b/src/nwpw/nwpwlib/nwpwxc/nwpwxc_vdw3b.F index 773b07f6f9..3b6c406fd5 100644 --- a/src/nwpw/nwpwlib/nwpwxc/nwpwxc_vdw3b.F +++ b/src/nwpw/nwpwlib/nwpwxc/nwpwxc_vdw3b.F @@ -1114,6 +1114,8 @@ subroutine nwpwxc_wregrad(nat,xyz,iat,edisp,g) 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 @@ subroutine nwpwxc_wregrad(nat,xyz,iat,edisp,g) 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 @@ subroutine nwpwxc_wregrad(nat,xyz,iat,edisp,g) 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 From 3c61fc928b357c7c069b24e919cc16a4d4a498a3 Mon Sep 17 00:00:00 2001 From: Jeff Hammond Date: Mon, 16 Oct 2023 10:36:19 +0300 Subject: [PATCH 3/4] start adding a wrapper for getlogin_r some compilers do not support getlog or pxfgetlogin --- src/util/util_getlog.F | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) create mode 100644 src/util/util_getlog.F diff --git a/src/util/util_getlog.F b/src/util/util_getlog.F new file mode 100644 index 0000000000..f96fd31f33 --- /dev/null +++ b/src/util/util_getlog.F @@ -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 From a8199b54325f9c2de8fc7e0111a844425b8bf666 Mon Sep 17 00:00:00 2001 From: Jeff Hammond Date: Mon, 16 Oct 2023 10:50:08 +0300 Subject: [PATCH 4/4] LOGNAME workaround for GETLOG --- src/argos/argos_prep_wrttop.F | 6 ++++++ src/argos/argos_prepare_wrttop.F | 5 +++++ src/argos/argos_space_wtmro.F | 5 +++++ src/argos/argos_space_wtrst.F | 5 +++++ src/config/makefile.h | 5 ++++- src/prepar/pre_wrttop.F | 5 +++++ src/space/sp_init.F | 10 ++++++++++ 7 files changed, 40 insertions(+), 1 deletion(-) diff --git a/src/argos/argos_prep_wrttop.F b/src/argos/argos_prep_wrttop.F index 0b4c6d4704..b2eb6232f3 100644 --- a/src/argos/argos_prep_wrttop.F +++ b/src/argos/argos_prep_wrttop.F @@ -182,6 +182,12 @@ logical function argos_prep_wrttop(lfnout,title,lfntop,filtop, 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 diff --git a/src/argos/argos_prepare_wrttop.F b/src/argos/argos_prepare_wrttop.F index 37573c6be0..2982c302fb 100644 --- a/src/argos/argos_prepare_wrttop.F +++ b/src/argos/argos_prepare_wrttop.F @@ -182,6 +182,11 @@ logical function argos_prepare_wrttop(lfnout,title,lfntop,filtop, 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 diff --git a/src/argos/argos_space_wtmro.F b/src/argos/argos_space_wtmro.F index ac55bc6d2b..46e371cdb5 100644 --- a/src/argos/argos_space_wtmro.F +++ b/src/argos/argos_space_wtmro.F @@ -28,6 +28,11 @@ subroutine argos_space_wtmro(lfnmro,stime,pres,temp,tempw,temps, 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 diff --git a/src/argos/argos_space_wtrst.F b/src/argos/argos_space_wtrst.F index 1d30a12037..23f7f60ad9 100644 --- a/src/argos/argos_space_wtrst.F +++ b/src/argos/argos_space_wtrst.F @@ -39,6 +39,11 @@ subroutine argos_space_wtrst(lfnrst,filrst,lveloc,pres, 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 diff --git a/src/config/makefile.h b/src/config/makefile.h index db46b9956f..f6cd4e44e9 100644 --- a/src/config/makefile.h +++ b/src/config/makefile.h @@ -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 diff --git a/src/prepar/pre_wrttop.F b/src/prepar/pre_wrttop.F index d7221b50b7..0060f78e4e 100644 --- a/src/prepar/pre_wrttop.F +++ b/src/prepar/pre_wrttop.F @@ -182,6 +182,11 @@ logical function pre_wrttop(lfnout,title,lfntop,filtop, 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 diff --git a/src/space/sp_init.F b/src/space/sp_init.F index e76298a844..4d2a45cf39 100644 --- a/src/space/sp_init.F +++ b/src/space/sp_init.F @@ -2355,6 +2355,11 @@ subroutine sp_wtrst(lfnrst,filrst,lveloc,pres,temp,tempw,temps, 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 @@ subroutine sp_wtmro(lfnmro,stime,pres,temp,tempw,temps, 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