Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

updates #777

Merged
merged 5 commits into from
May 11, 2023
Merged

updates #777

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
4997540
add util_fsync to address zfs issue https://github.com/nwchemgit/nwch…
edoapra May 9, 2023
89648c4
fsync code works only with gfortran https://github.com/nwchemgit/nwch…
edoapra May 10, 2023
e7c626e
fix perlmutter parallelization issue https://github.com/nwchemgit/nwc…
edoapra May 10, 2023
03c2588
skip code for flang
edoapra May 10, 2023
5209827
remove debug write
edoapra May 10, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions src/config/makefile.h
View file
Open in desktop
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
Open in desktop
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
Open in desktop
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