Skip to content

Commit

Permalink
Merge pull request #777 from edoapra/fsync
Browse files Browse the repository at this point in the history 
updates
  • Loading branch information
@nwchemgit
nwchemgit authored May 11, 2023
2 parents d681ac3 + 5209827 commit eb3a293
Show file tree
Hide file tree
Showing 3 changed files with 103 additions and 8 deletions.
2 changes: 2 additions & 0 deletions src/config/makefile.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3096,9 +3096,11 @@ ifneq ($(TARGET),LINUX)
# Jeff: FreeBSD does not link libm automatically with flang
ifeq ($(USE_FLANG),1)
EXTRA_LIBS += -lm
DEFINES += -DUSE_FLANG
endif

endif

endif
#endof of LINUX64

Expand Down
74 changes: 67 additions & 7 deletions src/hessian/analytic/oned_calc.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,9 @@ subroutine oned_calc(nxyz,g_rhs,Ibuf,lbuf,Iscr,lscr,
logical status
double precision qfac
c
integer g_lo(3),g_hi(3),icadd
logical oned_getlohi
external oned_getlohi
integer nxtask
external nxtask
cc AJL/Begin/SPIN ECPs
Expand All @@ -42,14 +45,20 @@ subroutine oned_calc(nxyz,g_rhs,Ibuf,lbuf,Iscr,lscr,
nproc = ga_nnodes()
task_size = 1
ijatom = -1
next = nxtask(nproc,task_size)
c next = nxtask(nproc,task_size)
call nga_distribution(g_rhs,
. ga_nodeid(), g_lo,g_hi)
c write(6,'(i4,"gadis",i4,3(i6,":",i6,","))') ga_nodeid(),g_rhs,
c . g_lo(1),g_hi(1),
c . g_lo(2),g_hi(2),
c . g_lo(3),g_hi(3)
c
do 90 iat1 = 1, nat
do 80 iat2 = 1, nat
c do 80 iat2 = 1, iat1

ijatom = ijatom + 1
if ( ijatom .eq. next ) then
c if ( ijatom .eq. next ) then

status = bas_ce2bfr(basis,iat1,iab1f,iab1l)
status = bas_ce2bfr(basis,iat2,iab2f,iab2l)
Expand Down Expand Up @@ -102,12 +111,26 @@ subroutine oned_calc(nxyz,g_rhs,Ibuf,lbuf,Iscr,lscr,
c * idatom(2)
c
ic = 1
icadd = 0
do i = 1, 2
do icart1 = 1, 3
lo(1) = (idatom(i)-1) * 3 + icart1
hi(1) = (idatom(i)-1) * 3 + icart1
cedo call nga_acc(g_rhs, lo, hi, Ibuf(ic), ld, 1.0d0)
call nga_put(g_rhs, lo, hi, Ibuf(ic), ld)
c check if I own this patch to do a local nga_put
if(oned_getlohi(g_lo,g_hi,ld,
c if1,if2,
c lo,hi,
c icadd)) then

c write(6,'(i4,"gaput",i4,"icadd",i4,
c F 3(i6,":",i6,","))') ga_nodeid(),g_rhs,
c . icadd,
c . lo(1),hi(1),
c . lo(2),hi(2),
c . lo(3),hi(3)
call nga_put(g_rhs,lo,hi,Ibuf(ic+icadd),ld)
endif
ic = ic + nint
enddo
enddo
Expand Down Expand Up @@ -135,7 +158,12 @@ subroutine oned_calc(nxyz,g_rhs,Ibuf,lbuf,Iscr,lscr,
lo(1) = atx
hi(1) = atx
! call nga_acc(g_rhs, lo, hi, Ibuf(ic), ld, 1.0d0)
call nga_put(g_rhs, lo, hi, Ibuf(ic), ld)
if(oned_getlohi(g_lo,g_hi,ld,
c if1,if2,
c lo,hi,
c icadd)) then
call nga_put(g_rhs, lo, hi, Ibuf(ic+icadd), ld)
endif
ic = ic + nint
enddo
endif ! doV and doT
Expand All @@ -144,12 +172,44 @@ subroutine oned_calc(nxyz,g_rhs,Ibuf,lbuf,Iscr,lscr,
70 continue
1010 continue

next = nxtask(nproc,task_size)
endif ! if my task
c next = nxtask(nproc,task_size)
c endif ! if my task

80 continue
90 continue
next = nxtask(-nproc,task_size)
c next = nxtask(-nproc,task_size)
call ga_sync()
c call ga_print(g_rhs)
c
return
end
logical function oned_getlohi(g_lo,g_hi,ld,
c if1,if2,
c lo,hi,
c icadd)
implicit none
integer g_lo(3),g_hi(3),ld(2) ! input
integer if1,if2 ! input
integer lo(3),hi(3) ! input/output
integer icadd ! output
oned_getlohi=.false.
icadd=0
if((lo(1).ge.g_lo(1)).or.(hi(1).le.g_hi(1)).and.
I (lo(2).ge.g_lo(2)).or.(hi(2).le.g_hi(2)).and.
I (lo(3).ge.g_lo(3)).or.(hi(3).le.g_hi(3))) then
lo(1)=max(g_lo(1),lo(1))
hi(1)=min(g_hi(1),hi(1))
lo(2)=max(g_lo(2),lo(2))
icadd=lo(2)-if2
hi(2)=min(g_hi(2),hi(2))
lo(3)=max(g_lo(3),lo(3))
icadd=icadd+(lo(3)-if1)*ld(2)
hi(3)=min(g_hi(3),hi(3))
if((hi(1).ge.lo(1)).and.
I (hi(2).ge.lo(2)).and.
I (hi(3).ge.lo(3))) then
oned_getlohi=.true.
endif
endif
return
end
35 changes: 34 additions & 1 deletion src/util/util_file_name.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -816,7 +816,7 @@ double precision function util_scratch_dir_avail_for_me()
character*(nw_max_path_len) mine
integer nuse
integer avail0,avail1
integer fd
integer fd,fd_in
character*8 fstype
integer l1megabyte,i_k,l_k,nuse_fail,nattpt,
, availmax
Expand Down Expand Up @@ -847,11 +847,14 @@ double precision function util_scratch_dir_avail_for_me()
#else
call util_getppn(ppn)
io_node=mod(me,ppn).eq.0
call ga_sync()
if(io_node) then
call util_file_name('junk',.true.,.true.,mine)
ierr=eaf_delete(mine)
ierr=eaf_open(mine, eaf_rw, fd)
call util_fsync(mine)
ierr = eaf_stat(mine, avail0, fstype)
c write(6,*) ga_nodeid(), 'avail0 ',avail0
if(avail0.gt.fiftytb) toolarge=1
else
ierr=0
Expand Down Expand Up @@ -881,7 +884,9 @@ double precision function util_scratch_dir_avail_for_me()
call ga_sync()
nuse_fail=0
if(io_node) then
call util_fsync(mine)
ierr = eaf_stat(mine, avail1, fstype)
c write(6,*) ga_nodeid(), 'avail1 ',avail1
if (ierr .ne. 0) call errquit(
U 'util_scratch_avail: eaf_stat',ierr,DISK_ERR)
ierr=eaf_delete(mine)
Expand Down Expand Up @@ -1161,3 +1166,31 @@ subroutine cphf_fname_parallel(cphf_str1,cphf_str2)
A cphf_str2(1:inp_strlen(cphf_str2))
return
end
subroutine util_fsync(fname)
implicit none
character*(*),intent(in) :: fname
c
integer iunit
integer*4 fd_in,code
integer ga_nodeid
external ga_nodeid
c
interface
function fsync (fd) bind(c,name="fsync")
use iso_c_binding, only: c_int
integer(c_int), value :: fd
integer(c_int) :: fsync
end function fsync
end interface
iunit=10
open (iunit,file=fname)
call util_flush(iunit)
#if defined(GFORTRAN) && !defined(USE_FLANG) && !defined(__llvm__) && !defined(___PGLLVM__)
fd_in=fnum(iunit)
c Flush and sync
code=fsync(fd_in)
if(code.ne.0) call
c errquit("Error calling FSYNC",ga_nodeid(),0)
#endif
return
end

0 comments on commit eb3a293

Please sign in to comment.