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

Flang 17
nwchemgit · Oct 16, 2023 · 8ed4e9d · 8ed4e9d
2 parents 8efa596 + a8199b5
commit 8ed4e9d
Show file tree

Hide file tree

Showing 13 changed files with 75 additions and 13 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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/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
 

diff --git 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
@@ -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
@@ -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/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/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

diff --git 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

diff --git a/src/util/util_getlog.F 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